Ignore:
Timestamp:
Jul 23, 2024, 3:29:36 PM (4 months ago)
Author:
abarral
Message:

Handle CPP_INLANDSIS in lmdz_cppkeys_wrapper.F90
Remove obsolete key wrgrads_thermcell, _ADV_HALO, _ADV_HALLO, isminmax
Remove redundant uses of CPPKEY_INCA (thanks acozic)
Remove obsolete misc/write_field.F90
Remove unused ioipsl_* wrappers
Remove calls to WriteField_u with wrong signature
Convert .F -> .[fF]90
(lint) uppercase fortran operators
[note: 1d and iso still broken - working on it]

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust
Files:
19 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/bl_for_dms.F

    r4593 r5103  
    99c Monin-Obukhov (obklen), necessaires pour calculer les flux de DMS
    1010c par la methode de Nightingale.
    11 c Cette subroutine est plus que fortement inspiree de la subroutine
     11c Cette SUBROUTINE est plus que fortement inspiree de la subroutine
    1212c 'nonlocal' dans clmain.F .
    1313c reference :  Holtslag, A.A.M., and B.A. Boville, 1993:

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.F

    r5101 r5103  
    1 c This subroutine calculates the emissions of SEA SALT and DUST, part of
     1c This SUBROUTINE calculates the emissions of SEA SALT and DUST, part of
    22C which goes to tracer 2 and other part to tracer 3.
    33      SUBROUTINE coarsemission(pctsrf,pdtphys,

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/deposition.F

    r4593 r5103  
    11c Subroutine that estimates the Deposition velocities and the depostion
    22C for the different tracers
    3       subroutine deposition(vdep_oce,vdep_sic,vdep_ter,vdep_lic,pctsrf,
     3      SUBROUTINE deposition(vdep_oce,vdep_sic,vdep_ter,vdep_lic,pctsrf,
    44     .                      zrho,zdz,pdtphys,RHcl,masse,t_seri,pplay,
    55     .                      paprs,lminmax,qmin,qmax,

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90

    r5101 r5103  
    3838!  real   , parameter :: cd=1.*roa/gravity
    3939! new values
    40 !  logical, parameter :: ok_splatuning=.true.
     40!  logical, parameter :: ok_splatuning=.TRUE.
    4141! Div=3 from S. Alfaro (Sow et al ACPD 2011)
    4242!JE 20150206
    … …  
    158158    USE dimphy
    159159
    160     !AS: moved here from subroutine initdust
     160    !AS: moved here from SUBROUTINE initdust
    161161    ALLOCATE( m1dflux(klon) )
    162162    ALLOCATE( m2dflux(klon) )
    … …  
    345345!$OMP THREADPRIVATE(iminacclow,iminacchigh,imincoalow,imincoahigh)
    346346
    347 writeaerosoldistrib=.false.
    348 if (debutphy) then
     347writeaerosoldistrib=.FALSE.
     348IF (debutphy) then
    349349
    350350  if (sizedustmin>sizeacclow .or. sizedustmax<sizescohigh) then
    … …  
    379379   endif
    380380  enddo
    381 if (writeaerosoldistrib) then
     381IF (writeaerosoldistrib) then
    382382!JEdbg<<
    383383  do j=1,klon
    … …  
    385385    itvmean(j,i)=(itv(i)+itv(i+1))/2.
    386386    itv2(j,i)=itv(i)
    387     !print*, itv(i),itvmean(i),itv(i+1)
    388     !print*, sizedust(i)
     387    !PRINT*, itv(i),itvmean(i),itv(i+1)
     388    !PRINT*, sizedust(i)
    389389  enddo
    390390  itv2(j,nbins+1)=itv(nbins+1)
    … …  
    415415  counter1=0
    416416!JEdbg>>
    417 endif
    418 endif
     417END IF
     418END IF
    419419
    420420
    … …  
    423423
    424424! estimate and integrate bins into only accumulation and coarse
    425 do k=1,klon
     425DO k=1,klon
    426426  basesumacc(k)=basesumemission*(pctsrf(k,is_ter))*1.e-6 ! from mg/m2/s
    427427  basesumcoa(k)=basesumemission*(pctsrf(k,is_ter))*1.e-6
    428428  basesumsco(k)=basesumemission*(pctsrf(k,is_ter))*1.e-6
    429 enddo
    430 
    431 
    432 do k=1,klon
     429END DO
     430
     431
     432DO k=1,klon
    433433auxr1=0.0
    434434auxr2=0.0
    … …  
    446446  enddo
    447447  emdustsco(k)=(auxr3 + basesumsco(k))*tuningfactorsco
    448 enddo
     448END DO
    449449
    450450
    … …  
    468468
    469469!JEdbg<<
    470 if (writeaerosoldistrib) then
     470IF (writeaerosoldistrib) then
    471471  do i=1,nbins
    472472    do j=1,klon
    … …  
    478478! 1440 = 15 days
    479479! 480 = 5 days
    480 if (MOD(counter,1440)== 0) THEN
     480IF (MOD(counter,1440)== 0) THEN
    481481   !if (MOD(counter,480).eq. 0) THEN
    482482   do k = 1,klon
    … …  
    499499     enddo
    500500   enddo
    501 endif
     501END IF
    502502counter=counter+1
    503 endif
     503END IF
    504504!JEdbg>>
    505505
    … …  
    700700
    701701! print *,'JEOK2',mpi_rank,omp_rank
    702 if ( 1==1 ) then
     702IF ( 1==1 ) then
    703703
    704704! print *,'JEOK4',mpi_rank,omp_rank
    … …  
    717717!print *,'JEOK6',mpi_rank,omp_rank
    718718
    719 endif
     719END IF
    720720
    721721  !CALL abort_gcm('initdustemission', 'OK1',1)
    … …  
    741741!     WRITE(18,*)i,alfa(i)
    742742  END DO
    743 !     print*,'solspe(14,10)= ',solspe(14,10)
     743!     PRINT*,'solspe(14,10)= ',solspe(14,10)
    744744  CLOSE(10)
    745745ENDIF
    … …  
    761761      enddo
    76276230   continue
    763       print*,'IK5'
     763      PRINT*,'IK5'
    764764      ncl=i-1
    765       print*,'   soil size classes used   ',ncl,' / ',nclass
    766       print*,'   soil size min: ',sizeclass(1),' soil size max: ',sizeclass(ncl)
     765      PRINT*,'   soil size classes used   ',ncl,' / ',nclass
     766      PRINT*,'   soil size min: ',sizeclass(1),' soil size max: ',sizeclass(ncl)
    767767      if(ncl>nclass)stop
    768768
    769769! Threshold velocity:
    770 if (.false.) then
    771 !if (.true.) then
     770IF (.FALSE.) then
     771!if (.TRUE.) then
    772772!c 0: Iversen and White 1982
    773773       print *,'Using  Iversen and White 1982 Uth'
    … …  
    785785            endif
    786786         enddo
    787 endif
    788 if(.true.) then
     787END IF
     788IF(.TRUE.) then
    789789! 1: Shao and Lu 2000
    790790       print *,'Using  Shao and Lu 2000 Uth'
    … …  
    797797               uth(i)=sqrt(an*(x1+x2))
    798798            enddo
    799 endif
     799END IF
    800800
    801801
    … …  
    849849       do i=1,klon
    850850          do k=1,ntyp
    851      !     print*,'IKKK ',i,klon,k,ntyp
     851     !     PRINT*,'IKKK ',i,klon,k,ntyp
    852852             if (zos(i,k)==0..or.z01(i,k)==0.) then
    853853     !       if (zos(i,k)<=0..or.z01(i,k)<=0.) then
    854854!              if (zos(i,k)<0..or.z01(i,k)<0.) then
    855      !            print*,'INI DUST WARNING zos ou z01<0',zos(i,k),z01(i,k)
     855     !            PRINT*,'INI DUST WARNING zos ou z01<0',zos(i,k),z01(i,k)
    856856!              endif
    857857              feff(i,k)=0.
    858858              feffdbg(i,k)=0.
    859  !         print*,'IKKK A ',i,klon,k,ntyp
     859 !         PRINT*,'IKKK A ',i,klon,k,ntyp
    860860            else
    861861! drag partition betzeen the erodable surface and zo1
    862      !     print*,'IKKK B0 ',i,klon,k,ntyp,z01(i,k),zos(i,k),xeff,aeff
     862     !     PRINT*,'IKKK B0 ',i,klon,k,ntyp,z01(i,k),zos(i,k),xeff,aeff
    863863              aa=log(z01(i,k)/zos(i,k))
    864864              tmp1(i,k)=aa
    … …  
    866866              cc=1.-aa/bb
    867867              feffdbg(i,k)=cc
    868        !   print*,'IKKK B1 ',i,klon,k,ntyp
     868       !   PRINT*,'IKKK B1 ',i,klon,k,ntyp
    869869! drag partition between zo1 and zo2
    870870! feff: total efficient fraction
    871871              if(D(i,k)==0.)then
    872872                 feff(i,k)=cc
    873    !       print*,'IKKK C ',i,klon,k,ntyp
     873   !       PRINT*,'IKKK C ',i,klon,k,ntyp
    874874              else
    875875                 dd=log(z02(i,k)/z01(i,k))
    876876                 ee=log(aeff*(D(i,k)/z01(i,k))**0.8)
    877877                 feff(i,k)=(1.-dd/ee)*cc
    878    !       print*,'IKKK D ',i,klon,k,ntyp
     878   !       PRINT*,'IKKK D ',i,klon,k,ntyp
    879879              endif
    880880              if (feff(i,k)<0.)feff(i,k)=0.
    … …  
    882882              if (feff(i,k)>1.)feff(i,k)=1.
    883883              if (feffdbg(i,k)>1.)feffdbg(i,k)=1.
    884     !      print*,'IKKK E ',i,klon,k,ntyp
     884    !      PRINT*,'IKKK E ',i,klon,k,ntyp
    885885            endif
    886886          enddo
    … …  
    898898
    899899
    900 if (1==1) then
     900IF (1==1) then
    901901!  !  CALL writefield_phy("AA",tmp1(1:klon,1:5),5)
    902902
    903903    CALL writefield_phy("REPART5",feff(1:klon,1:5),5)
    904904    CALL writefield_phy("REPART5dbg",feffdbg(1:klon,1:5),5)
    905 endif
     905END IF
    906906
    907907
    … …  
    919919
    920920
    921 !  if (.false.) then
     921!  if (.FALSE.) then
    922922!!**************L718
    923923
    … …  
    983983!     END DO
    984984! 50  CONTINUE
    985 !print*,'IK10'
     985!PRINT*,'IK10'
    986986!! building the optimized distribution
    987987!  logvdISOGRAD(1)=log(vdHR(1))
    … …  
    10271027! 60  CONTINUE
    10281028!  END DO
    1029 !print*,'IK11'
     1029!PRINT*,'IK11'
    10301030!  binsISOGRAD(nbinsout)=binsHR(nbinsHR)
    10311031!  vdISOGRAD(nbinsout)=vdHR(nbinsHR)
    … …  
    12421242
    12431243                 !IF(n.eq.1.and.nat.eq.99)GOTO 80
    1244              !      if(n.eq.1) print*,'nat1=',nat,'sol1=',sol(i,n)
     1244             !      if(n.eq.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n)
    12451245                   IF(n==1.and.nat==99)GOTO 80
    12461246
    … …  
    12701270
    12711271                   IF(ustarsalt<umin/ceff)GOTO 80
    1272 !                      print*,'ustarsalt = ',ustarsalt
     1272!                      PRINT*,'ustarsalt = ',ustarsalt
    12731273!----------------------------------------
    12741274                    CALL def_copyncl(kfin)
    … …  
    13821382         dsmin=var3a*(ustarsalt**(-2./3.))
    13831383         dsmax=var3b*(ustarsalt**(-2./3.))
    1384 !      print*,'ustarsalt = ',ustarsalt,'dsmin=',dsmin,'dsmax=',dsmax
     1384!      PRINT*,'ustarsalt = ',ustarsalt,'dsmin=',dsmin,'dsmax=',dsmax
    13851385! dichotomy
    13861386         CALL def_dichotomy(sizeclass,nclass,1,ncl,dsmin,ideb)
    1387    !      print*,'ideb = ',ideb
     1387   !      PRINT*,'ideb = ',ideb
    13881388         CALL def_dichotomy(sizeclass,nclass,ideb,ncl,dsmax,ifin)
    1389    !      print*,'ifin = ',ifin
     1389   !      PRINT*,'ifin = ',ifin
    13901390! readaptation of large sizes particles
    13911391         kfin=0
    … …  
    13961396            srel2(nat,kfin)=srel(nat,i)
    13971397         enddo
    1398   !          print*,'je suis la'
     1398  !          PRINT*,'je suis la'
    13991399         kfin2=kfin
    14001400         istep=50
    … …  
    14061406         enddo
    14071407         if(kfin>=nclass)then
    1408             print*,'$$$$ Tables dimension problem:',kfin,'>',nclass
     1408            PRINT*,'$$$$ Tables dimension problem:',kfin,'>',nclass
    14091409         endif
    14101410!---------------       
    … …  
    14191419!--------------------------------------------------------------------------------------
    14201420
    1421 subroutine def_dichotomy(siz,nclass,i1,i2,ds,iout)
     1421SUBROUTINE def_dichotomy(siz,nclass,i1,i2,ds,iout)
    14221422!c---------------------------------------------------------------
    14231423!c 'size' is the table to scan
    … …  
    14501450 52   continue
    14511451      if(iout==0)then
    1452         print*,'$$$$ Tables dimension problem: ',iout
     1452        PRINT*,'$$$$ Tables dimension problem: ',iout
    14531453      endif
    14541454
    1455       end subroutine def_dichotomy
     1455      END SUBROUTINE def_dichotomy
    14561456
    14571457!--------------------------------------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/finemission.F

    r5101 r5103  
    1 C This subroutine calculates the emissions of BLACK CARBON and ORGANIC
     1C This SUBROUTINE calculates the emissions of BLACK CARBON and ORGANIC
    22C MATTER
    33      SUBROUTINE finemission(zdz,pdtphys,zalt,kminbc,kmaxbc,

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90

    r5101 r5103  
    5050
    5151!  variables locales     
    52  LOGICAL,SAVE :: debut=.true.
     52 LOGICAL,SAVE :: debut=.TRUE.
    5353!$OMP THREADPRIVATE(debut)
    5454
    … …  
    9696  IF (debut) THEN
    9797
    98 !  inscav_fisrt=.true.
     98!  inscav_fisrt=.TRUE.
    9999!  CALL getin('inscav_fisrt',inscav_fisrt)
    100100!  if(inscav_fisrt) then
    101 !   print*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt
     101!   PRINT*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt
    102102!  else
    103 !   print*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
     103!   PRINT*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
    104104!  endif
    105105
    … …  
    128128!9999  Continue
    129129
    130 !   print*,'alpha_r',alpha_r
    131 !   print*,'alpha_s',alpha_s
    132 !   print*,'R_r',R_r
    133 !   print*,'R_s',R_s
    134 !   print*,'frac_fine_scav',frac_fine_scav
    135 !   print*,'frac_coar_scav',frac_coar_scav
    136 !   print*,'frac_aer ev',frac_aer
     130!   PRINT*,'alpha_r',alpha_r
     131!   PRINT*,'alpha_s',alpha_s
     132!   PRINT*,'R_r',R_r
     133!   PRINT*,'R_s',R_s
     134!   PRINT*,'frac_fine_scav',frac_fine_scav
     135!   PRINT*,'frac_coar_scav',frac_coar_scav
     136!   PRINT*,'frac_aer ev',frac_aer
    137137
    138138! JE endcomment
    … …  
    255255       his_dh(i)=0.
    256256      endif
    257 !      print*,  k, 'beta_ev',beta_ev
     257!      PRINT*,  k, 'beta_ev',beta_ev
    258258! remove tracers from precipitation owing to release by evaporation in his_dh
    259259!!      dxev=frac_ev*deltaP(i,k)*pdtime * his_dh(i) /(zrho(i,k)*zdz(i,k))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_spl.F90

    r5101 r5103  
    5353
    5454!  variables locales     
    55  LOGICAL,SAVE :: debut=.true.
     55 LOGICAL,SAVE :: debut=.TRUE.
    5656!$OMP THREADPRIVATE(debut)
    5757
    … …  
    106106  IF (debut) THEN
    107107
    108 !  inscav_fisrt=.true.
     108!  inscav_fisrt=.TRUE.
    109109!  CALL getin('inscav_fisrt',inscav_fisrt)
    110110!  if(inscav_fisrt) then
    111 !   print*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt
     111!   PRINT*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt
    112112!  else
    113 !   print*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
     113!   PRINT*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
    114114!  endif
    115115
    … …  
    138138!9999  Continue
    139139
    140 !   print*,'JE alpha_r',alpha_r
    141 !   print*,'JE alpha_s',alpha_s
    142 !   print*,'JE R_r',R_r
    143 !   print*,'JE R_s',R_s
    144 !   print*,'frac_fine_scav',frac_fine_scav
    145 !   print*,'frac_coar_scav',frac_coar_scav
    146 !   print*,'frac_aer ev',frac_aer
     140!   PRINT*,'JE alpha_r',alpha_r
     141!   PRINT*,'JE alpha_s',alpha_s
     142!   PRINT*,'JE R_r',R_r
     143!   PRINT*,'JE R_s',R_s
     144!   PRINT*,'frac_fine_scav',frac_fine_scav
     145!   PRINT*,'frac_coar_scav',frac_coar_scav
     146!   PRINT*,'frac_aer ev',frac_aer
    147147
    148148! JE endcomment
    … …  
    266266       his_dh(i)=0.
    267267      endif
    268 !      print*,  k, 'beta_ev',beta_ev
     268!      PRINT*,  k, 'beta_ev',beta_ev
    269269! remove tracers from precipitation owing to release by evaporation in his_dh
    270270!!      dxev=frac_ev*deltaP(i,k)*pdtime * his_dh(i) /(zrho(i,k)*zdz(i,k))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.F

    r5082 r5103  
    1       subroutine minmaxqfi2(zq,qmin,qmax,comment)
     1      SUBROUTINE minmaxqfi2(zq,qmin,qmax,comment)
    22c
    33      USE dimphy

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.F

    r5082 r5103  
    1       subroutine minmaxsource(zq,qmin,qmax,comment)
     1      SUBROUTINE minmaxsource(zq,qmin,qmax,comment)
    22
    33      USE dimphy

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.F

    r5101 r5103  
    11c***********************************************************************
    2         subroutine neutral(u10_mps,ustar_mps,obklen_m,
     2        SUBROUTINE neutral(u10_mps,ustar_mps,obklen_m,
    33     +         u10n_mps )
    44c-----------------------------------------------------------------------       
    5 c subroutine to compute u10 neutral wind speed
     5c SUBROUTINE to compute u10 neutral wind speed
    66c inputs
    77c       u10_mps - wind speed at 10 m (m/s)
    … …  
    1818c Current Theory, Geernaert and W.J. Plant, editors, Kluwer Academic
    1919c Publishers, Boston, MA, 1990.
    20 c subroutine written Feb 2001 by eg chapman
     20c SUBROUTINE written Feb 2001 by eg chapman
    2121c adapted to LMD-ZT by E. Cosme 310801
    2222c Following Will Shaw (PNL, Seattle) the theory applied for flux

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phys_output_write_spl_mod.F90

    r5101 r5103  
    8989       d_t, qx, d_qx, d_tr_dyn, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc)
    9090
    91     ! This subroutine does the actual writing of diagnostics that were
    92     ! defined and initialised mainly in phytracr_spl_mod.F90 (SPLA tracers, subroutine phytracr_spl_out_init)
     91    ! This SUBROUTINE does the actual writing of diagnostics that were
     92    ! defined and initialised mainly in phytracr_spl_mod.F90 (SPLA tracers, SUBROUTINE phytracr_spl_out_init)
    9393
    9494    USE dimphy, ONLY: klon, klev, klevp1
    … …  
    828828       !       ENDIF
    829829
    830 #ifdef CPP_IOIPSL
    831830  IF (.NOT. using_xios) THEN
    832831    IF (.NOT.ok_all_xml) THEN
    … …  
    836835           ll=0
    837836            DO k=1, nlevSTD
    838                bb2=clevSTD(k) 
     837               bb2=clevSTD(k)
    839838               IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
    840839                    bb2.EQ."500".OR.bb2.EQ."200".OR. &
    … …  
    856855    ENDIF
    857856  ENDIF !.NOT.using_xios
    858 #endif
    859857
    860858  IF (using_xios) THEN
    … …  
    14701468       ENDIF
    14711469!!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!!
    1472 #ifdef CPP_IOIPSL
    14731470
    14741471  IF (.NOT. using_xios) THEN
    1475     IF (.NOT.ok_all_xml) THEN 
     1472    IF (.NOT.ok_all_xml) THEN
    14761473         ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX:
    14771474         ! Champs interpolles sur des niveaux de pression
    … …  
    15411538    ENDIF
    15421539  ENDIF
    1543 #endif
    15441540
    15451541IF (using_xios) THEN

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90

    r5101 r5103  
    8989  !$OMP THREADPRIVATE(tsol)
    9090  INTEGER :: ijulday
    91   LOGICAL, parameter :: edgar = .true.
     91  LOGICAL, parameter :: edgar = .TRUE.
    9292  INTEGER, parameter :: flag_dms = 4
    9393  INTEGER(kind = 4)  nbjour
    … …  
    424424  SUBROUTINE phytracr_spl_out_init()
    425425    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    426     !AS : This subroutine centralises the ALLOCATE needed for the 1st CALL of
     426    !AS : This SUBROUTINE centralises the ALLOCATE needed for the 1st CALL of
    427427    !     phys_output_write_spl in physiq
    428428
    … …  
    690690    !AS: IF permettant le debranchage des coefs de Jeronimo Escribano: fichiers *_meta
    691691    ! nbreg_* sont initialisés à 1 dans phytracr_spl, if debutphy,
    692     ! avant d'appeler la subroutine presente, phytracr_spl_ini
     692    ! avant d'appeler la SUBROUTINE presente, phytracr_spl_ini
    693693    ! (phytracr_spl_ini appele readregionsdims2_spl,
    694694    ! qui lit et fait "bcast" de nbreg_ind,_bb,_dust,_wstardust dans fichiers regions_*_meta)
    … …  
    750750    !temporal hardcoded null inicialization of assimilation emmision factors
    751751    !AS: scale_param sont ensuite lus dans modvalues.nc
    752     ! par la subroutine read_scalenc, appelee par readscaleparamsnc_spl
     752    ! par la SUBROUTINE read_scalenc, appelee par readscaleparamsnc_spl
    753753    scale_param_ssacc = 1.
    754754    scale_param_sscoa = 1.
    … …  
    11131113    CHARACTER*2 str2
    11141114    !!AS:      LOGICAL ok_histrac
    1115     !!!JE2014124      PARAMETER (ok_histrac=.true.)
    1116     !!      PARAMETER (ok_histrac=.false.)
     1115    !!!JE2014124      PARAMETER (ok_histrac=.TRUE.)
     1116    !!      PARAMETER (ok_histrac=.FALSE.)
    11171117    INTEGER ndex2d(iim * (jjm + 1)), ndex3d(iim * (jjm + 1) * klev)
    11181118    INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert
    … …  
    11441144    LOGICAL convection, lessivage, lminmax, lcheckmass
    11451145    DATA convection, lessivage, lminmax, lcheckmass &
    1146             /.true., .true., .true., .false./
     1146            /.TRUE., .TRUE., .TRUE., .FALSE./
    11471147
    11481148    REAL xconv(nbtr)
    11491149
    11501150    LOGICAL anthropo, bateau, edgar
    1151     DATA anthropo, bateau, edgar/.true., .true., .true./
     1151    DATA anthropo, bateau, edgar/.TRUE., .TRUE., .TRUE./
    11521152
    11531153    !c bc_source
    … …  
    13571357
    13581358    ! computing time
    1359     !        logitime=.true.
    1360     logitime = .false.
     1359    !        logitime=.TRUE.
     1360    logitime = .FALSE.
    13611361    IF (logitime) THEN
    13621362      clock_start = 0
    … …  
    13711371
    13721372    ! Definition of tracers index.
    1373     print*, 'OK ON PASSSE BIEN LA'
     1373    PRINT*, 'OK ON PASSSE BIEN LA'
    13741374    CALL minmaxsource(source_tr, qmin, qmax, 'A1 maxsource init phytracr')
    13751375
    … …  
    15201520    !vdep_lic = (/0.2, 0.17, 1.2, 1.2/)
    15211521
    1522     iscm3 = .false.
     1522    iscm3 = .FALSE.
    15231523    if (debutphy) then
    15241524      !$OMP MASTER
    … …  
    20232023      ENDDO
    20242024    ENDDO
    2025     iscm3 = .true.
     2025    iscm3 = .TRUE.
    20262026
    20272027    !=======================================================================
    … …  
    21372137         CALL iophys_ecrit('q_seri',klev,'q_seri','',q_seri)
    21382138         CALL iophys_ecrit('tsol',1,'tsol','',tsol)
    2139          print*,'fracso2emis,frach2sofso2,bateau',fracso2emis,frach2sofso2,bateau
    2140          print*,'kminbc,kmaxbc,pdtphys',kminbc,kmaxbc,pdtphys
    2141          print*,'scale_param_bb,scale_param_ind',scale_param_bb,scale_param_ind
    2142          print*,'iregion_ind,iregion_bb,nbreg_ind, nbreg_bb',iregion_ind,iregion_bb,nbreg_ind, nbreg_bb
    2143          print*,'id_prec,id_fine',id_prec,id_fine
     2139         PRINT*,'fracso2emis,frach2sofso2,bateau',fracso2emis,frach2sofso2,bateau
     2140         PRINT*,'kminbc,kmaxbc,pdtphys',kminbc,kmaxbc,pdtphys
     2141         PRINT*,'scale_param_bb,scale_param_ind',scale_param_bb,scale_param_ind
     2142         PRINT*,'iregion_ind,iregion_bb,nbreg_ind, nbreg_bb',iregion_ind,iregion_bb,nbreg_ind, nbreg_bb
     2143         PRINT*,'id_prec,id_fine',id_prec,id_fine
    21442144         CALL iophys_ecrit('zdz',klev,'zdz','',zdz)
    21452145         CALL iophys_ecrit('zalt',klev,'zalt','',zalt)
    … …  
    21642164
    21652165
    2166     print*, 'ON PASSE DANS precuremission'
     2166    PRINT*, 'ON PASSE DANS precuremission'
    21672167    CALL precuremission(ftsol, u10m_ec, v10m_ec, pctsrf, &
    21682168            u_seri, v_seri, paprs, pplay, cdragh, cdragm, &
    … …  
    22772277      ENDDO
    22782278    ENDDO
    2279     iscm3 = .false.
     2279    iscm3 = .FALSE.
    22802280    !----------------------------
    22812281    IF (lminmax) THEN
    … …  
    24052405
    24062406#ifdef IOPHYS_DUST
    2407       print*,'iflag_conv=',iflag_conv
     2407      PRINT*,'iflag_conv=',iflag_conv
    24082408      CALL iophys_ecrit('coefh',klev,'coefh','',coefh)
    24092409      CALL iophys_ecrit('yu1',1,'yu1','',yu1)
    … …  
    25542554      ENDDO
    25552555    ENDDO !--end itr loop
    2556     iscm3 = .true.
     2556    iscm3 = .TRUE.
    25572557    !--------------------------------------
    25582558    print *, ' BEFORE Sediment'
    … …  
    26292629      ENDDO
    26302630    ENDDO
    2631     iscm3 = .false.
     2631    iscm3 = .FALSE.
    26322632
    26332633
    … …  
    27152715        ENDDO
    27162716      ENDDO
    2717       iscm3 = .true.
     2717      iscm3 = .TRUE.
    27182718      !------------------------------
    27192719
    … …  
    27482748        IF (iflag_conv==2) THEN
    27492749          ! Tiedke
    2750           CALL incloud_scav(.false., qmin, qmax, masse, henry, kk, prfl, &
     2750          CALL incloud_scav(.FALSE., qmin, qmax, masse, henry, kk, prfl, &
    27512751                  psfl, pmflxr, pmflxs, zrho, zdz, t_seri, pdtphys, &
    27522752                  his_dhlsc, his_dhcon, tr_seri)
    … …  
    27552755          !        ELSE IF (iflag_conv.GE.3) THEN
    27562756
    2757           !      CALL incloud_scav_lsc(.false.,qmin,qmax,masse,henry,kk,prfl,
     2757          !      CALL incloud_scav_lsc(.FALSE.,qmin,qmax,masse,henry,kk,prfl,
    27582758          !     .                  psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
    27592759          !     .                                     his_dhlsc,his_dhcon,tr_seri)
    … …  
    27862786          ! Tiedke
    27872787
    2788           CALL blcloud_scav(.false., qmin, qmax, pdtphys, prfl, psfl, &
     2788          CALL blcloud_scav(.FALSE., qmin, qmax, pdtphys, prfl, psfl, &
    27892789                  pmflxr, pmflxs, zdz, alpha_r, alpha_s, masse, &
    27902790                  his_dhbclsc, his_dhbccon, tr_seri)
    … …  
    27962796          !        ELSE IF (iflag_conv.GE.3) THEN
    27972797
    2798           !      CALL blcloud_scav_lsc(.false.,qmin,qmax,pdtphys,prfl,psfl,
     2798          !      CALL blcloud_scav_lsc(.FALSE.,qmin,qmax,pdtphys,prfl,psfl,
    27992799          !     .                  pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
    28002800          !     .                                  his_dhbclsc,his_dhbccon,tr_seri)
    … …  
    28362836        ENDDO
    28372837      ENDDO
    2838       iscm3 = .false.
     2838      iscm3 = .FALSE.
    28392839
    28402840      IF (logitime) THEN
    … …  
    28932893        ! Tiedke
    28942894        CALL trconvect(pplay, t_seri, pdtphys, pmfu, pmfd, pen_u, pde_u, &
    2895                 pen_d, pde_d, paprs, zdz, xconv, qmin, qmax, .false., masse, &
     2895                pen_d, pde_d, paprs, zdz, xconv, qmin, qmax, .FALSE., masse, &
    28962896                dtrconv, tr_seri)
    28972897        DO itr = 1, nbtr
    … …  
    29962996            IF (lcheckmass) THEN
    29972997              CALL checkmass(d_tr_cv(:, :, itr), RNAVO, masse(itr), zdz, &
    2998                       pplay, t_seri, .false., 'd_tr_cv:')
     2998                      pplay, t_seri, .FALSE., 'd_tr_cv:')
    29992999            ENDIF
    30003000          ENDIF
    … …  
    30893089        ! choix du lessivage
    30903090        IF (iflag_lscav == 3 .OR. iflag_lscav == 4) THEN
    3091           !IF (.false.) THEN  ! test #DFB (Binta) sans lsc_scav_spl
     3091          !IF (.FALSE.) THEN  ! test #DFB (Binta) sans lsc_scav_spl
    30923092          print *, 'JE iflag_lscav', iflag_lscav
    30933093          DO itr = 1, nbtr
    … …  
    31973197      ENDDO
    31983198    ENDDO
    3199     iscm3 = .true.
     3199    iscm3 = .TRUE.
    32003200
    32013201    ! Computing burden in mg/m2
    … …  
    34633463      ENDDO
    34643464    ENDDO
    3465     iscm3 = .false.
     3465    iscm3 = .FALSE.
    34663466
    34673467
    … …  
    41974197      tia_nophytracr = tia_nophytracr + REAL(ti_nophytracr) / REAL(clock_rate)
    41984198      print *, 'Time outside phytracr; Time accum outside phytracr'
    4199       print*, REAL(ti_nophytracr) / REAL(clock_rate), tia_nophytracr
     4199      PRINT*, REAL(ti_nophytracr) / REAL(clock_rate), tia_nophytracr
    42004200
    42014201      clock_start_outphytracr = clock_end

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_newemissions.F

    r5101 r5103  
    11C Routine to read the emissions of the different species
    22C
    3       subroutine read_newemissions(julien, jH_emi ,edgar, flag_dms,
     3      SUBROUTINE read_newemissions(julien, jH_emi ,edgar, flag_dms,
    44     I                             debutphy,
    55     I                             pdtphys,lafinphy, nbjour, pctsrf,
    … …  
    157157        test_vent=0
    158158        test_day=0
    159         CALL read_vent(.true.,step_vent,nbjour,u10m_ec2,v10m_ec2)
     159        CALL read_vent(.TRUE.,step_vent,nbjour,u10m_ec2,v10m_ec2)
    160160        print *,'Read (debut) dust emissions: step_vent,julien,nbjour',
    161161     .                                   step_vent,julien,nbjour
    162         CALL read_dust(.true.,step_vent,nbjour,dust_ec2)
     162        CALL read_dust(.TRUE.,step_vent,nbjour,dust_ec2)
    163163C Threshold velocity map
    164164!$OMP MASTER
    … …  
    208208        step_vent=step_vent+1
    209209        !PRINT *,'step_vent=', step_vent
    210         CALL read_vent(.false.,step_vent,nbjour,u10m_ec2,v10m_ec2)
     210        CALL read_vent(.FALSE.,step_vent,nbjour,u10m_ec2,v10m_ec2)
    211211        print *,'Reading dust emissions: step_vent, julien, nbjour ',
    212212     .                                   step_vent, julien, nbjour
    213213        !print *,'test_vent, julien = ',test_vent, julien
    214         CALL read_dust(.false.,step_vent,nbjour,dust_ec2)
     214        CALL read_dust(.FALSE.,step_vent,nbjour,dust_ec2)
    215215     
    216216      ENDIF !--test_vent
    … …  
    224224      tau_2=(jH_vent-jH_init)*24./(vent_resol)
    225225      tau_1=1.-tau_2
    226 !      print*,'JEdec jHv,JHi,ventres',jH_vent,jH_init,vent_resol
    227 !      print*,'JEdec tau2,tau1',tau_2,tau_1
    228 !      print*,'JEdec step_vent',step_vent
     226!      PRINT*,'JEdec jHv,JHi,ventres',jH_vent,jH_init,vent_resol
     227!      PRINT*,'JEdec tau2,tau1',tau_2,tau_1
     228!      PRINT*,'JEdec step_vent',step_vent
    229229      DO i=1, klon
    230230!      PRINT*,'JE tau_2,tau_2j',tau_2,tau_2j

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90

    r5101 r5103  
    1        subroutine read_surface(name,surfa)
     1       SUBROUTINE read_surface(name,surfa)
    22
    33     
    … …  
    4545       IF (is_mpi_root .AND. is_omp_root) THEN
    4646
    47        print*,'Lecture du fichier donnees_lisa.nc'
     47       PRINT*,'Lecture du fichier donnees_lisa.nc'
    4848       ncid=nf90_open('donnees_lisa.nc',nf90_nowrite,rcode)
    4949
    5050!JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa
    51       outcycle=.false.
     51      outcycle=.FALSE.
    5252      latstr='null'
    53       isinversed=.false.
     53      isinversed=.FALSE.
    5454      do i=1,5
    5555       if (i==1) aux4s='latu'
    … …  
    6060       status = nf90_inq_varid (ncid, aux4s, rcode)
    6161!       print *,'stat,i',status,i,outcycle,aux4s
    62 !       print *,'ifclause',status.NE. nf90_noerr ,outcycle == .false.
     62!       print *,'ifclause',status.NE. nf90_noerr ,outcycle == .FALSE.
    6363       IF ((.not.(status/= nf90_noerr) ).and.( .not. outcycle )) THEN
    64          outcycle=.true.
     64         outcycle=.TRUE.
    6565         latstr=aux4s
    6666       ENDIF
    … …  
    7373          status=nf90_get_var(ncid,varid,lats_glo,startj,endj)
    7474!      print *,latstr,varid,status,jjp1,rcode
    75 !      IF (status .NE. nf90_noerr) print*,'NOOOOOOO'
     75!      IF (status .NE. nf90_noerr) PRINT*,'NOOOOOOO'
    7676!      print *,lats
    7777!stop
    7878
    7979! check if netcdf is latitude inversed or not.
    80       if (lats_glo(1)<lats_glo(2)) isinversed=.true.
     80      if (lats_glo(1)<lats_glo(2)) isinversed=.TRUE.
    8181! JE20140526>>
    8282
    … …  
    8585          write(str1,'(i1)') i
    8686          varname=trim(name)//str1
    87        print*,'lecture variable:',varname
     87       PRINT*,'lecture variable:',varname
    8888          varid=nf90_inq_varid(ncid,trim(varname),rcode)
    8989
    … …  
    139139
    140140       ENDDO ! Fin boucle 1 a 5
    141        print*,'Passage Grille Dyn -> Phys'
     141       PRINT*,'Passage Grille Dyn -> Phys'
    142142
    143143
    … …  
    149149
    150150       return
    151        end subroutine read_surface
     151       END SUBROUTINE read_surface

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90

    r5101 r5103  
    106106
    107107! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
    108 subroutine correctbid(iim, nl, x)
     108SUBROUTINE correctbid(iim, nl, x)
    109109  integer :: iim, nl
    110110  real :: x(iim + 1, nl)
    … …  
    116116      if(abs(x(i, l))>1.e10) then
    117117        zz = 0.5 * (x(i - 1, l) + x(i + 1, l))
    118         ! print*,'correction ',i,l,x(i,l),zz
     118        ! PRINT*,'correction ',i,l,x(i,l),zz
    119119        x(i, l) = zz
    120120      endif
    … …  
    123123
    124124  return
    125 end subroutine correctbid
     125END SUBROUTINE correctbid
    126126
    127127

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/satellite_out_spla.F90

    r5099 r5103  
    2222
    2323  CALL ju2ymds(jD_cur+jH_cur, year_cur, mth_cur, day_cur, hour)
    24 !  print*,'JDcur=',jD_cur,'JHcur=',jH_cur,'year_cur' ,year_cur,'mth_cur' ,mth_cur, 'day_cur',day_cur,'hour' ,hour
     24!  PRINT*,'JDcur=',jD_cur,'JHcur=',jH_cur,'year_cur' ,year_cur,'mth_cur' ,mth_cur, 'day_cur',day_cur,'hour' ,hour
    2525
    2626!  IF ( (year_cur*100.+mth_cur .GE. 199611 ) .AND. (year_cur*100.+mth_cur .LE. 199706)) THEN

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/seasalt.F

    r4593 r5103  
    1 c       This subroutine estimateis Sea Salt emission fluxes over
     1c       This SUBROUTINE estimateis Sea Salt emission fluxes over
    22c       Oceanic surfaces.
    33c

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/sediment_mod.F

    r5099 r5103  
    1 c----- This subroutine calculates the sedimentation flux of Tracers
     1c----- This SUBROUTINE calculates the sedimentation flux of Tracers
    22c
    33      SUBROUTINE sediment_mod(t_seri,pplay,zrho,paprs,time_step,RHcl,

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/tiedqneg.f90

    r5099 r5103  
    1616
    1717  INCLUDE "dimensions.h"
    18   ! INCLUDE "dimphy.h"
    1918  REAL :: pres_h(klon, klev + 1)
    2019  REAL :: q(klon, klev)
Note: See TracChangeset for help on using the changeset viewer.