Ignore:
Timestamp:
Jul 24, 2024, 4:23:34 PM (6 months ago)
Author:
abarral
Message:

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

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

Legend:

Unmodified
Added
Removed

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

    r5116 r5117  
    4949  ! REAL prfl(klon,klev),   psfl(klon,klev)     !--large-scale
    5050  LOGICAL :: debutphy, lafinphy
    51   REAL, intent(in) :: xlat(klon)    ! latitudes pour chaque point
    52   REAL, intent(in) :: xlon(klon)    ! longitudes pour chaque point
     51  REAL, INTENT(IN) :: xlat(klon)    ! latitudes pour chaque point
     52  REAL, INTENT(IN) :: xlon(klon)    ! longitudes pour chaque point
    5353  REAL, DIMENSION(klon), INTENT(IN) :: zu10m
    5454  REAL, DIMENSION(klon), INTENT(IN) :: zv10m
    … …  
    195195
    196196    DO i = 1, klon
    197       if (maskd(i)>0) THEN
     197      IF (maskd(i)>0) THEN
    198198        IF(id_fine>0)    source_tr(i, id_fine) = &
    199199                scale_param_dustacc(iregion_dust(i)) * &

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

    r5116 r5117  
    3535
    3636  ierr = nf90_open ("limitcarbon.nc", nf90_nowrite, nid1)
    37   if (ierr/=nf90_noerr) THEN
     37  IF (ierr/=nf90_noerr) THEN
    3838    WRITE(6, *)' Pb d''ouverture du fichier limitbc.nc'
    3939    WRITE(6, *)' ierr = ', ierr
    4040    CALL exit(1)
    41   endif
     41  ENDIF
    4242
    4343  ! Tranche a lire:

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

    r5116 r5117  
    5858
    5959    ierr = nf90_open ("carbon_emissions.nc", nf90_nowrite, nid1)
    60     if (ierr/=nf90_noerr) THEN
     60    IF (ierr/=nf90_noerr) THEN
    6161      WRITE(6, *)' Pb d''ouverture du fichier limitbc.nc'
    6262      WRITE(6, *)' ierr = ', ierr

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

    r5116 r5117  
    3636
    3737  ierr = nf90_open ("limitsoufre.nc", nf90_nowrite, nid)
    38   if (ierr/=nf90_noerr) THEN
     38  IF (ierr/=nf90_noerr) THEN
    3939    WRITE(6, *)' Pb d''ouverture du fichier limitsoufre.nc'
    4040    WRITE(6, *)' ierr = ', ierr
    4141    CALL exit(1)
    42   endif
     42  ENDIF
    4343
    4444  ! Tranche a lire:

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

    r5116 r5117  
    6161
    6262    ierr = nf90_open ("sulphur_emissions_antro.nc", nf90_nowrite, nid)
    63     if (ierr/=nf90_noerr) THEN
     63    IF (ierr/=nf90_noerr) THEN
    6464      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_antro'
    6565      WRITE(6, *)' ierr = ', ierr
    … …  
    130130    !=======================================================================
    131131    ierr = nf90_open ("sulphur_emissions_nat.nc", nf90_nowrite, nid)
    132     if (ierr/=nf90_noerr) THEN
     132    IF (ierr/=nf90_noerr) THEN
    133133      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_nat'
    134134      WRITE(6, *)' ierr = ', ierr
    … …  
    185185    print *, ' Jour = ', jour
    186186    ierr = nf90_open ("sulphur_emissions_volc.nc", nf90_nowrite, nid)
    187     if (ierr/=nf90_noerr) THEN
     187    IF (ierr/=nf90_noerr) THEN
    188188      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_volc'
    189189      WRITE(6, *)' ierr = ', ierr

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

    r5116 r5117  
    1717  INTEGER, PARAMETER    :: nats=14 !number of mineral types (14 here for sand,
    1818                                   ! silt, clay etc.)
    19   integer, parameter :: nclass=200000
     19  INTEGER, parameter :: nclass=200000
    2020
    2121
    2222  real   , parameter :: dmin=0.0001
    2323  real   , parameter :: dmax=0.2
    24   integer, parameter :: nspe=nmode*3+1
     24  INTEGER, parameter :: nspe=nmode*3+1
    2525  real   ,parameter     :: vkarm=0.41
    2626!JE20150202 : updating scheme to chimere13b <<<
    2727! original values
    28 !  integer, parameter :: div1=3.
    29 !  integer, parameter :: div2=3.
    30 !  integer, parameter :: div3=3.
     28!  INTEGER, parameter :: div1=3.
     29!  INTEGER, parameter :: div2=3.
     30!  INTEGER, parameter :: div3=3.
    3131!  real   , parameter :: e1=3.61/div1
    3232!  real   , parameter :: e2=3.52/div2
    … …  
    4141! Div=3 from S. Alfaro (Sow et al ACPD 2011)
    4242!JE 20150206
    43 !  integer, parameter :: div1=3.
    44 !  integer, parameter :: div2=3.
    45 !  integer, parameter :: div3=3.
    46   integer, parameter :: div1=6.
    47   integer, parameter :: div2=6.
    48   integer, parameter :: div3=6.
     43!  INTEGER, parameter :: div1=3.
     44!  INTEGER, parameter :: div2=3.
     45!  INTEGER, parameter :: div3=3.
     46  INTEGER, parameter :: div1=6.
     47  INTEGER, parameter :: div2=6.
     48  INTEGER, parameter :: div3=6.
    4949  real   , parameter :: e1=3.61/div1
    5050  real   , parameter :: e2=3.52/div2
    … …  
    5959!  real   , parameter :: cd=1.0*roa/gravity
    6060!JE20150202>>>>
    61   real,parameter     :: beta=16300.
    62   real, parameter, dimension(3) :: diam=(/1.5,6.7,14.2/)
     61  REAL,parameter     :: beta=16300.
     62  REAL, parameter, DIMENSION(3) :: diam=(/1.5,6.7,14.2/)
    6363  INTEGER, PARAMETER     :: ndistb=3
    64   real, parameter, dimension(3) :: sig=(/1.7,1.6,1.5/)
     64  REAL, parameter, DIMENSION(3) :: sig=(/1.7,1.6,1.5/)
    6565
    6666!   INTEGER, PARAMETER     :: nbinsHR=3000 !original
    … …  
    259259      maskdustloc(k)=0
    260260      do i=1,ntyp
    261          if (masklisa(k,i)>0) THEN
     261         IF (masklisa(k,i)>0) THEN
    262262             maskdustloc(k)=1
    263263         endif
    … …  
    296296  INTEGER,DIMENSION(klon) :: maskdust ! where the emissions were calculated
    297297  REAL,DIMENSION(klon,nbsrf),     INTENT(IN)     :: pctsrf
    298 !  real,parameter :: sizeacclow=0.03
    299 !  real,parameter :: sizeacchigh=0.5
    300 !  real,parameter :: sizecoalow=0.5
    301 !  real,parameter :: sizecoahigh=10.  ! in micrometers
    302   real,parameter :: sizeacclow=0.06
    303   real,parameter :: sizeacchigh=1.0
    304   real,parameter :: sizecoalow=1.0
    305   real,parameter :: sizecoahigh=6.  !20 ! diameter in micrometers
    306   real,parameter :: sizescolow=6.
    307   real,parameter :: sizescohigh=30.  ! in micrometers
     298!  REAL,parameter :: sizeacclow=0.03
     299!  REAL,parameter :: sizeacchigh=0.5
     300!  REAL,parameter :: sizecoalow=0.5
     301!  REAL,parameter :: sizecoahigh=10.  ! in micrometers
     302  REAL,parameter :: sizeacclow=0.06
     303  REAL,parameter :: sizeacchigh=1.0
     304  REAL,parameter :: sizecoalow=1.0
     305  REAL,parameter :: sizecoahigh=6.  !20 ! diameter in micrometers
     306  REAL,parameter :: sizescolow=6.
     307  REAL,parameter :: sizescohigh=30.  ! in micrometers
    308308!--------------------------------
    309 !  real,parameter :: tuningfactorfine=0.9  ! factor for fine bins!!! important!!
    310   real,parameter :: tuningfactorfine=0.8  ! factor for fine bins!!! important!!
    311 !  real,parameter :: tuningfactorfine=4.5  ! factor for fine bins!!! important!!
    312 !  real,parameter :: tuningfactorcoa=3.6 ! factor for coarse bins!!! important!!
    313   real,parameter :: tuningfactorcoa=3.25 ! factor for coarse bins!!! important!!
    314 !  real,parameter :: tuningfactorcoa=4.5  ! factor for coarse bins!!! important!!
    315 !  real,parameter :: tuningfactorsco=3.6  ! factor for supercoarse bins!!! important!!
    316   real,parameter :: tuningfactorsco=3.25  ! factor for supercoarse bins!!! important!!
    317 !  real,parameter :: tuningfactorsco=4.5  ! factor for supercoarse bins!!! important!!
    318   real,parameter :: basesumemission= 0.0  !1.e-6  ! emissions to SUM to each land pixel FOR ASSIMILATION ONLY important!!  in mg/m2/s, per bin
     309!  REAL,parameter :: tuningfactorfine=0.9  ! factor for fine bins!!! important!!
     310  REAL,parameter :: tuningfactorfine=0.8  ! factor for fine bins!!! important!!
     311!  REAL,parameter :: tuningfactorfine=4.5  ! factor for fine bins!!! important!!
     312!  REAL,parameter :: tuningfactorcoa=3.6 ! factor for coarse bins!!! important!!
     313  REAL,parameter :: tuningfactorcoa=3.25 ! factor for coarse bins!!! important!!
     314!  REAL,parameter :: tuningfactorcoa=4.5  ! factor for coarse bins!!! important!!
     315!  REAL,parameter :: tuningfactorsco=3.6  ! factor for supercoarse bins!!! important!!
     316  REAL,parameter :: tuningfactorsco=3.25  ! factor for supercoarse bins!!! important!!
     317!  REAL,parameter :: tuningfactorsco=4.5  ! factor for supercoarse bins!!! important!!
     318  REAL,parameter :: basesumemission= 0.0  !1.e-6  ! emissions to SUM to each land pixel FOR ASSIMILATION ONLY important!!  in mg/m2/s, per bin
    319319 !basesumemission = 1.e-6 increase the AOD in about 12%  (0.03 of AOD) ,
    320320 !while 1e-8 increase in about 0.12%  (0.003 of AOD)
    321321
    322   real,dimension(klon) :: basesumacc,basesumcoa,basesumsco
     322  REAL,DIMENSION(klon) :: basesumacc,basesumcoa,basesumsco
    323323!--------------------------------
    324 !JE20140915  real,parameter :: sizeacclow=0.06
    325 !JE20140915  real,parameter :: sizeacchigh=1.0
    326 !JE20140915  real,parameter :: sizecoalow=1.0
    327 !JE20140915  real,parameter :: sizecoahigh=10.  !20 ! diameter in micrometers
    328 !JE20140915  real,parameter :: sizescolow=10.
    329 !JE20140915  real,parameter :: sizescohigh=30.  ! in micrometers
    330 
    331 
    332 
    333   logical ::  debutphy
     324!JE20140915  REAL,parameter :: sizeacclow=0.06
     325!JE20140915  REAL,parameter :: sizeacchigh=1.0
     326!JE20140915  REAL,parameter :: sizecoalow=1.0
     327!JE20140915  REAL,parameter :: sizecoahigh=10.  !20 ! diameter in micrometers
     328!JE20140915  REAL,parameter :: sizescolow=10.
     329!JE20140915  REAL,parameter :: sizescohigh=30.  ! in micrometers
     330
     331
     332
     333  LOGICAL ::  debutphy
    334334  REAL :: diff, auxr1,auxr2,auxr3,auxr4
    335   real,dimension(klon,nbins) :: itvmean
    336   real,dimension(klon,nbins+1) :: itv2
    337 !  real,dimension(klon_glo,nbins) :: itvmean_glo
    338 !  real,dimension(:,:) , allocatable  :: itvmean_glo
    339 !  real,dimension(:,:), allocatable :: itv2_glo
     335  REAL,DIMENSION(klon,nbins) :: itvmean
     336  REAL,DIMENSION(klon,nbins+1) :: itv2
     337!  REAL,DIMENSION(klon_glo,nbins) :: itvmean_glo
     338!  REAL,DIMENSION(:,:) , ALLOCATABLE  :: itvmean_glo
     339!  REAL,DIMENSION(:,:), ALLOCATABLE :: itv2_glo
    340340 
    341   integer, save :: counter,counter1 !dbg
     341  INTEGER, save :: counter,counter1 !dbg
    342342  REAL, DIMENSION(:,:),ALLOCATABLE,SAVE :: emisbinlocalmean,emisbinlocalmean2 !dbg
    343343  REAL, DIMENSION(:,:),ALLOCATABLE :: emisbinlocalmean2_glo
    344   logical :: writeaerosoldistrib
     344  LOGICAL :: writeaerosoldistrib
    345345!$OMP THREADPRIVATE(iminacclow,iminacchigh,imincoalow,imincoahigh)
    346346
    347347writeaerosoldistrib=.FALSE.
    348348IF (debutphy) THEN
    349   if (sizedustmin>sizeacclow .or. sizedustmax<sizescohigh) THEN
     349  IF (sizedustmin>sizeacclow .OR. sizedustmax<sizescohigh) THEN
    350350   CALL abort_gcm('adaptdustemission', 'Dust range problem',1)
    351   endif
     351  ENDIF
    352352  print *,'FINE DUST BIN: tuning EMISSION factor= ',tuningfactorfine
    353353  print *,'COA DUST BIN: tuning EMISSION factor= ',tuningfactorcoa
    … …  
    359359  auxr4=9999.
    360360  do i=1,nbins+1
    361    if (abs(sizeacclow-itv(i))<auxr1) THEN
     361   IF (abs(sizeacclow-itv(i))<auxr1) THEN
    362362          auxr1=abs( sizeacclow-itv(i))
    363363          iminacclow=i
    364364   endif
    365    if (abs(sizeacchigh-itv(i))<auxr2) THEN
     365   IF (abs(sizeacchigh-itv(i))<auxr2) THEN
    366366          auxr2=abs( sizeacchigh-itv(i))
    367367          iminacchigh=i
    368368          imincoalow=i
    369369   endif
    370    if (abs(sizecoahigh-itv(i))<auxr3) THEN
     370   IF (abs(sizecoahigh-itv(i))<auxr3) THEN
    371371          auxr3=abs( sizecoahigh-itv(i))
    372372          imincoahigh=i
    373373          iminscolow=i
    374374   endif
    375    if (abs(sizescohigh-itv(i))<auxr4) THEN
     375   IF (abs(sizescohigh-itv(i))<auxr4) THEN
    376376          auxr4=abs( sizescohigh-itv(i))
    377377          iminscohigh=i
    … …  
    478478! 480 = 5 days
    479479IF (MOD(counter,1440)== 0) THEN
    480    !if (MOD(counter,480).eq. 0) THEN
     480   !if (MOD(counter,480).EQ. 0) THEN
    481481   do k = 1,klon
    482482   do i=1,nbins
    … …  
    671671    !print *,Pini(i,1),Pini(i,2),Pini(i,3),Pini(i,4),Pini(i,5)
    672672    DO nts=1,ntyp
    673       !IF(xlon(i).ge.longmin.and.xlon(i).le.longmax.and. &
    674       !&      xlat(i).ge.latmin.and.xlat(i).le.latmax    &
    675       !&      .and.pctsrf(i)>0.5.and.Pini(i,nts)>0.)THEN
     673      !IF(xlon(i).ge.longmin.AND.xlon(i).le.longmax.AND. &
     674      !&      xlat(i).ge.latmin.AND.xlat(i).le.latmax    &
     675      !&      .AND.pctsrf(i)>0.5.AND.Pini(i,nts)>0.)THEN
    676676  ! JE20150605<< easier to read
    677       IF(pctsrf(i,is_ter)>0.5.and.Pini(i,nts)>0.)THEN
     677      IF(pctsrf(i,is_ter)>0.5.AND.Pini(i,nts)>0.)THEN
    678678  ! JE20150605>>
    679679           sol(i,nts) = solini(i,nts)
    … …  
    774774            cc=sqrt(1+ddust*(sizeclass(i)**(-2.5)))
    775775            xk=sqrt(abs(rop*gravity*sizeclass(i)/roa))
    776             if (bb<10.) THEN
     776            IF (bb<10.) THEN
    777777               dd=sqrt(1.928*(bb**0.092)-1.)
    778778               uth(i)=0.129*xk*cc/dd
    … …  
    848848          do k=1,ntyp
    849849     !     PRINT*,'IKKK ',i,klon,k,ntyp
    850              if (zos(i,k)==0..or.z01(i,k)==0.) THEN
     850             IF (zos(i,k)==0..or.z01(i,k)==0.) THEN
    851851     !       if (zos(i,k)<=0..or.z01(i,k)<=0.) THEN
    852852!              if (zos(i,k)<0..or.z01(i,k)<0.) THEN
    … …  
    876876   !       PRINT*,'IKKK D ',i,klon,k,ntyp
    877877              endif
    878               if (feff(i,k)<0.)feff(i,k)=0.
    879               if (feffdbg(i,k)<0.)feffdbg(i,k)=0.
    880               if (feff(i,k)>1.)feff(i,k)=1.
    881               if (feffdbg(i,k)>1.)feffdbg(i,k)=1.
     878              IF (feff(i,k)<0.)feff(i,k)=0.
     879              IF (feffdbg(i,k)<0.)feffdbg(i,k)=0.
     880              IF (feff(i,k)>1.)feff(i,k)=1.
     881              IF (feffdbg(i,k)>1.)feffdbg(i,k)=1.
    882882    !      PRINT*,'IKKK E ',i,klon,k,ntyp
    883883            endif
    … …  
    885885        enddo
    886886! JE20150120<<
    887   if (flag_feff == 0) THEN
     887  IF (flag_feff == 0) THEN
    888888    print *,'JE_dbg FORCED deactivated feff'
    889889    do i=1,klon
    … …  
    892892      enddo
    893893    enddo
    894   endif
     894  ENDIF
    895895! JE20150120>>
    896896
    … …  
    10111011!           GOTO 60
    10121012!        END IF
    1013 !        IF(nb.eq.miniso)THEN
     1013!        IF(nb.EQ.miniso)THEN
    10141014!           binsISOGRAD(k)=binsHR(nb)
    10151015!           istart=nb+1
    … …  
    12391239 
    12401240
    1241                  !IF(n.eq.1.and.nat.eq.99)GOTO 80
    1242              !      IF(n.eq.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n)
    1243                    IF(n==1.and.nat==99)GOTO 80
     1241                 !IF(n.EQ.1.AND.nat.EQ.99)GOTO 80
     1242             !      IF(n.EQ.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n)
     1243                   IF(n==1.AND.nat==99)GOTO 80
    12441244
    12451245             ENDIF
    12461246             IF(.TRUE.) THEN
    12471247                nat=int(sol(i,n))
    1248                 IF(n == 1 .and. nat >= 14 .or. nat < 1 .or. nat > 19) GOTO 80
     1248                IF(n == 1 .AND. nat >= 14 .OR. nat < 1 .OR. nat > 19) GOTO 80
    12491249             ENDIF
    12501250!JE20150129>>>>
    … …  
    12561256                      ustarsalt=0.
    12571257                   IF(ceff<=0..or.z0salt==0.)GOTO 80
    1258                    IF(cerod==0.or.cpcent==0.)GOTO 80
     1258                   IF(cerod==0.OR.cpcent==0.)GOTO 80
    12591259! in cm: utmin, umin, z10m, z0salt, ustarns
    12601260! in meters: modwm
    … …  
    12751275      do ni=1,kfin
    12761276         fdp1=1.-(uth2(ni)/(ceff*ustarsalt))
    1277          if (fdp1<=0..or.srel2(nat,ni)==0.) THEN
     1277         IF (fdp1<=0..or.srel2(nat,ni)==0.) THEN
    12781278            ad1=0.
    12791279            ad2=0.
    … …  
    13741374      IMPLICIT NONE
    13751375
    1376  integer i,n,kfin,ideb,ifin,istep,kfin2
    1377     real dsmin,dsmax
     1376 INTEGER i,n,kfin,ideb,ifin,istep,kfin2
     1377    REAL dsmin,dsmax
    13781378
    13791379! estimation of the reduced soil size distribution
    … …  
    14261426
    14271427      IMPLICIT NONE
    1428       integer i1,i2,nclass,iout,ismin,ismax,k2,ihalf,idiff
    1429       real siz(nclass),ds
     1428      INTEGER i1,i2,nclass,iout,ismin,ismax,k2,ihalf,idiff
     1429      REAL siz(nclass),ds
    14301430!c-----------------------------
    14311431      iout=0

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

    r5116 r5117  
    102102!  else
    103103!   PRINT*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
    104 !  endif
     104!  ENDIF
    105105
    106106      alpha_r=0.001        !  coefficient d'impaction pour la pluie
    … …  
    201201!  incloud scavenging
    202202!   IF(inscav_fisrt) THEN
    203    if (iflag_lscav == 4) THEN
     203   IF (iflag_lscav == 4) THEN
    204204      beta=beta_fisrt(i,k)*rneb(i,k)
    205205   else
    … …  
    208208      beta=beta/zmass(i,k)/oliq
    209209      beta=MAX(0.,beta)
    210    endif ! (iflag_lscav .eq. 4)
     210   endif ! (iflag_lscav .EQ. 4)
    211211   beta_v1(i,k)=beta    !! for output
    212212
    … …  
    282282!                +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG  &
    283283!                +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG
    284 !      IF(it.eq.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
     284!      IF(it.EQ.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
    285285!      k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it)
    286286!       ENDDO

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

    r5116 r5117  
    112112!  else
    113113!   PRINT*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
    114 !  endif
     114!  ENDIF
    115115
    116116!JE      alpha_r=0.001        !  coefficient d'impaction pour la pluie
    … …  
    212212!  incloud scavenging
    213213!   IF(inscav_fisrt) THEN
    214    if (iflag_lscav == 4) THEN
     214   IF (iflag_lscav == 4) THEN
    215215      beta=beta_fisrt(i,k)*rneb(i,k)
    216216   else
    … …  
    219219      beta=beta/zmass(i,k)/oliq
    220220      beta=MAX(0.,beta)
    221    endif ! (iflag_lscav .eq. 4)
     221   endif ! (iflag_lscav .EQ. 4)
    222222   beta_v1(i,k)=beta    !! for output
    223223
    … …  
    293293!                +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG  &
    294294!                +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG
    295 !      IF(it.eq.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
     295!      IF(it.EQ.3) WRITE(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),&
    296296!      k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it)
    297297!       ENDDO

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

    r5116 r5117  
    2424  zqmax = zq(ijmax, lmax)
    2525
    26   IF(zqmin<qmin.or.zqmax>qmax) &
     26  IF(zqmin<qmin.OR.zqmax>qmax) &
    2727          WRITE(*, 9999) comment, &
    2828                  ijmin, lmin, zqmin, ijmax, lmax, zqmax

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

    r5116 r5117  
    2525  zqmax = zq(ijmax, lmax)
    2626
    27   IF(zqmin<qmin.or.zqmax>qmax) &
     27  IF(zqmin<qmin.OR.zqmax>qmax) &
    2828          WRITE(*, 9999) comment, &
    2929                  ijmin, lmin, zqmin, ijmax, lmax, zqmax

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

    r5116 r5117  
    4343  do i = 1, klon
    4444
    45     if (u10_mps(i) < 0.) u10_mps(i) = 0.0
     45    IF (u10_mps(i) < 0.) u10_mps(i) = 0.0
    4646
    47     if  (obklen_m(i) < 0.) THEN
     47    IF  (obklen_m(i) < 0.) THEN
    4848      phi = (1. - 160. / obklen_m(i))**(-0.25)
    4949      phi_inv = 1. / phi
    … …  
    5555      f3 = atan(dum1)
    5656      psi = 2. * log(f1) + log(f2) - 2. * f3 + pi / 2.
    57     else if (obklen_m(i) > 0.) THEN
     57    ELSE IF (obklen_m(i) > 0.) THEN
    5858      psi = -50. / obklen_m(i)
    5959    end if
    … …  
    6161    u10n_mps(i) = u10_mps(i) + (ustar_mps(i) * psi / von_karman)
    6262    ! u10n set to 0. if -1 < obklen < 20
    63     if ((obklen_m(i)>-1.).and.(obklen_m(i)<20.)) THEN
     63    IF ((obklen_m(i)>-1.).AND.(obklen_m(i)<20.)) THEN
    6464      u10n_mps(i) = 0.
    6565    endif
    66     if (u10n_mps(i) < 0.) u10n_mps(i) = 0.0
     66    IF (u10n_mps(i) < 0.) u10n_mps(i) = 0.0
    6767
    6868  enddo

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

    r5116 r5117  
    393393    ! ug Pour les sorties XIOS
    394394    USE lmdz_xios, ONLY: xios_update_calendar, using_xios
    395     USE wxios, ONLY: wxios_closedef, missing_val_xios => missing_val
     395    USE lmdz_wxios, ONLY: wxios_closedef, missing_val_xios => missing_val
    396396    USE phys_cal_mod, ONLY: mth_len
    397397    USE lmdz_yomcst
    … …  
    928928          CALL histwrite_phy(o_wdtrainA, wdtrainA)
    929929          CALL histwrite_phy(o_wdtrainM, wdtrainM)
    930        ENDIF !(iflag_con.EQ.3.or.iflag_con.EQ.30)
     930       ENDIF !(iflag_con.EQ.3.OR.iflag_con.EQ.30)
    931931!!! nrlmd le 10/04/2012
    932932       IF (iflag_trig_bl>=1) THEN
    … …  
    10671067          CALL histwrite_phy(o_swsrfcs_ant, solsw0_aero(:,2))
    10681068          !cf
    1069           IF (.not. aerosol_couple) THEN
     1069          IF (.NOT. aerosol_couple) THEN
    10701070             CALL histwrite_phy(o_swtoacf_nat, topswcf_aero(:,1))
    10711071             CALL histwrite_phy(o_swsrfcf_nat, solswcf_aero(:,1))
    … …  
    12191219          ENDIF
    12201220          CALL histwrite_phy(o_tntc, zx_tmp_fi3d)
    1221        ELSEIF (iflag_thermals>=1.and.iflag_wake==1)THEN
     1221       ELSEIF (iflag_thermals>=1.AND.iflag_wake==1)THEN
    12221222          IF (vars_defined) THEN
    12231223             zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + &

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

    r5116 r5117  
    828828    !  -------
    829829
    830     real, intent(in) :: pdtphys  ! pas d'integration pour la physique (seconde)
    831     REAL, intent(in) :: jD_cur, jH_cur
    832     real, intent(in) :: ftsol(klon, nbsrf)  ! temperature du sol par type
    833     real, intent(in) :: t_seri(klon, klev)  ! temperature
    834     real, intent(in) :: u_seri(klon, klev)  ! vent
    835     real, intent(in) :: v_seri(klon, klev)  ! vent
    836     real, intent(in) :: q_seri(klon, klev)  ! vapeur d eau kg/kg
     830    REAL, INTENT(IN) :: pdtphys  ! pas d'integration pour la physique (seconde)
     831    REAL, INTENT(IN) :: jD_cur, jH_cur
     832    REAL, INTENT(IN) :: ftsol(klon, nbsrf)  ! temperature du sol par type
     833    REAL, INTENT(IN) :: t_seri(klon, klev)  ! temperature
     834    REAL, INTENT(IN) :: u_seri(klon, klev)  ! vent
     835    REAL, INTENT(IN) :: v_seri(klon, klev)  ! vent
     836    REAL, INTENT(IN) :: q_seri(klon, klev)  ! vapeur d eau kg/kg
    837837
    838838    LOGICAL, INTENT(IN) :: lafin
    839839
    840     real tr_seri(klon, klev, nbtr) ! traceur
    841     real tmp_var(klon, klev) ! auxiliary variable to replace traceur
    842     real tmp_var2(klon, nbtr) ! auxiliary variable to replace source
    843     real tmp_var3(klon, klev, nbtr) ! auxiliary variable 3D
    844     real dummy1d ! JE auxiliary variable
    845     real aux_var2(klon) ! auxiliary variable to replace traceur
    846     real aux_var3(klon, klev) ! auxiliary variable to replace traceur
    847     real d_tr(klon, klev, nbtr)    ! traceur  tendance
    848     real sconc_seri(klon, nbtr) ! surface concentration of traceur
    849 
    850     integer nbjour
     840    REAL tr_seri(klon, klev, nbtr) ! traceur
     841    REAL tmp_var(klon, klev) ! auxiliary variable to replace traceur
     842    REAL tmp_var2(klon, nbtr) ! auxiliary variable to replace source
     843    REAL tmp_var3(klon, klev, nbtr) ! auxiliary variable 3D
     844    REAL dummy1d ! JE auxiliary variable
     845    REAL aux_var2(klon) ! auxiliary variable to replace traceur
     846    REAL aux_var3(klon, klev) ! auxiliary variable to replace traceur
     847    REAL d_tr(klon, klev, nbtr)    ! traceur  tendance
     848    REAL sconc_seri(klon, nbtr) ! surface concentration of traceur
     849
     850    INTEGER nbjour
    851851    save nbjour
    852852    !$OMP THREADPRIVATE(nbjour)
    … …  
    898898    !JE20150518>>
    899899
    900     real, intent(in) :: paprs(klon, klev + 1)  ! pression pour chaque inter-couche (en Pa)
    901     real, intent(in) :: pplay(klon, klev)  ! pression pour le mileu de chaque couche (en Pa)
    902     real, intent(in) :: RHcl(klon, klev)  ! humidite relativen ciel clair
    903     real znivsig(klev)  ! indice des couches
    904     real paire(klon)
    905     real, intent(in) :: pphis(klon)
    906     real, intent(in) :: pctsrf(klon, nbsrf)
    907     logical, intent(in) :: debutphy   ! le flag de l'initialisation de la physique
     900    REAL, INTENT(IN) :: paprs(klon, klev + 1)  ! pression pour chaque inter-couche (en Pa)
     901    REAL, INTENT(IN) :: pplay(klon, klev)  ! pression pour le mileu de chaque couche (en Pa)
     902    REAL, INTENT(IN) :: RHcl(klon, klev)  ! humidite relativen ciel clair
     903    REAL znivsig(klev)  ! indice des couches
     904    REAL paire(klon)
     905    REAL, INTENT(IN) :: pphis(klon)
     906    REAL, INTENT(IN) :: pctsrf(klon, nbsrf)
     907    logical, INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
    908908
    909909    !  Scaling Parameters:
    … …  
    950950    !  -----------
    951951
    952     REAL, intent(in) :: pmfu(klon, klev)  ! flux de masse dans le panache montant
    953     REAL, intent(in) :: pmfd(klon, klev)  ! flux de masse dans le panache descendant
    954     REAL, intent(in) :: pen_u(klon, klev) ! flux entraine dans le panache montant
    955     REAL, intent(in) :: pde_u(klon, klev) ! flux detraine dans le panache montant
    956     REAL, intent(in) :: pen_d(klon, klev) ! flux entraine dans le panache descendant
    957     REAL, intent(in) :: pde_d(klon, klev) ! flux detraine dans le panache descendant
     952    REAL, INTENT(IN) :: pmfu(klon, klev)  ! flux de masse dans le panache montant
     953    REAL, INTENT(IN) :: pmfd(klon, klev)  ! flux de masse dans le panache descendant
     954    REAL, INTENT(IN) :: pen_u(klon, klev) ! flux entraine dans le panache montant
     955    REAL, INTENT(IN) :: pde_u(klon, klev) ! flux detraine dans le panache montant
     956    REAL, INTENT(IN) :: pen_d(klon, klev) ! flux entraine dans le panache descendant
     957    REAL, INTENT(IN) :: pde_d(klon, klev) ! flux detraine dans le panache descendant
    958958
    959959    !  Convection KE scheme:
    … …  
    10231023    !  ---------
    10241024
    1025     REAL, intent(in) :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1)   !--convection
    1026     REAL, intent(in) :: prfl(klon, klev + 1), psfl(klon, klev + 1)     !--large-scale
     1025    REAL, INTENT(IN) :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1)   !--convection
     1026    REAL, INTENT(IN) :: prfl(klon, klev + 1), psfl(klon, klev + 1)     !--large-scale
    10271027    REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
    10281028    REAL :: ql_incloud_ref    ! ref value of in-cloud condensed water content
    … …  
    10471047    !  --------------
    10481048
    1049     REAL, intent(in) :: coefh(klon, klev) ! coeff melange CL
    1050     REAL, intent(in) :: cdragh(klon), cdragm(klon)
    1051     REAL, intent(in) :: yu1(klon)        ! vent dans la 1iere couche
    1052     REAL, intent(in) :: yv1(klon)        ! vent dans la 1iere couche
     1049    REAL, INTENT(IN) :: coefh(klon, klev) ! coeff melange CL
     1050    REAL, INTENT(IN) :: cdragh(klon), cdragm(klon)
     1051    REAL, INTENT(IN) :: yu1(klon)        ! vent dans la 1iere couche
     1052    REAL, INTENT(IN) :: yv1(klon)        ! vent dans la 1iere couche
    10531053
    10541054
    … …  
    10711071    !  -----------
    10721072
    1073     REAL, intent(in) :: rlat(klon)       ! latitudes pour chaque point
    1074     REAL, intent(in) :: rlon(klon)       ! longitudes pour chaque point
     1073    REAL, INTENT(IN) :: rlat(klon)       ! latitudes pour chaque point
     1074    REAL, INTENT(IN) :: rlon(klon)       ! longitudes pour chaque point
    10751075
    10761076    INTEGER i, k, iq, itr, j, ig
    … …  
    11641164    !      REAL his_g2paer(klon)      ! gastoparticle in aerosol units (check!)
    11651165
    1166     INTEGER, intent(in) :: iflag_conv
     1166    INTEGER, INTENT(IN) :: iflag_conv
    11671167    LOGICAL iscm3  ! debug variable. for checkmass ! JE
    11681168
    … …  
    12131213    source_tr = 0.
    12141214
    1215     if (debutphy) THEN
     1215    IF (debutphy) THEN
    12161216#ifdef IOPHYS_DUST
    12171217         CALL iophys_ini(pdtphys)
    … …  
    13941394      enddo
    13951395      ! check consistency with dust emission scheme:
    1396       if (ok_chimeredust) THEN
    1397         if (.not.(id_scdu>0 .and. id_codu>0 .and. id_fine>0)) THEN
     1396      IF (ok_chimeredust) THEN
     1397        IF (.NOT.(id_scdu>0 .AND. id_codu>0 .AND. id_fine>0)) THEN
    13981398          CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 0', 1)
    13991399        endif
    14001400      else
    1401         if (id_scdu>0) THEN
     1401        IF (id_scdu>0) THEN
    14021402          CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU', 1)
    14031403        endif
    1404         if ((id_codu <= 0) .or. (id_fine<=0)) THEN
     1404        IF ((id_codu <= 0) .OR. (id_fine<=0)) THEN
    14051405          CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 1', 1)
    14061406        endif
    … …  
    15211521
    15221522    iscm3 = .FALSE.
    1523     if (debutphy) THEN
     1523    IF (debutphy) THEN
    15241524      !$OMP MASTER
    15251525      CALL suphel
    … …  
    44424442    REAL scale_param(nbreg)
    44434443    !local vars
    4444     integer nid, ierr, nvarid
    4445     real rcode, auxreal
    4446     integer start(4), count(4), status
     4444    INTEGER nid, ierr, nvarid
     4445    REAL rcode, auxreal
     4446    INTEGER start(4), count(4), status
    44474447    !      local
    44484448    CHARACTER*104 varname
    44494449    CHARACTER*2 aux_2s
    4450     integer i, j, ig
     4450    INTEGER i, j, ig
    44514451    !$OMP MASTER
    44524452    IF (is_mpi_root .AND. is_omp_root) THEN
    44534453      ierr = nf90_open(trim(adjustl(filescaleparams)), nf90_nowrite, nid)
    4454       if (ierr == nf90_noerr) THEN
     4454      IF (ierr == nf90_noerr) THEN
    44554455        do i = 1, nbreg
    44564456          WRITE(aux_2s, '(i2.2)') i

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

    r5104 r5117  
    9898          tsol, pctsrf, lmt_dmsconc, lmt_dms)
    9999
    100   IF (.not.bateau) THEN
     100  IF (.NOT.bateau) THEN
    101101    DO i = 1, klon
    102102      lmt_so2ba(i) = 0.0

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

    r5116 r5117  
    2626  !$OMP MASTER
    2727  IF (is_mpi_root .AND. is_omp_root) THEN
    28     if (debutphy) THEN
     28    IF (debutphy) THEN
    2929      ncid1 = nf90_open('dust.nc', nf90_nowrite, rcode)
    3030      varid1 = nf90_inq_varid(ncid1, 'EMISSION', rcode)

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

    r5113 r5117  
    3030  INCLUDE 'chem_spla.h'
    3131
    32   logical :: debutphy, lafinphy, edgar
     32  LOGICAL :: debutphy, lafinphy, edgar
    3333  INTEGER :: test_vent, test_day, step_vent, flag_dms, nbjour
    3434  INTEGER :: julien, i, iday

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

    r5116 r5117  
    1818       character*10 varname
    1919
    20        real tmp_dyn(iip1,jjp1)
    21        real tmp_dyn_glo(nbp_lon+1,nbp_lat)
     20       REAL tmp_dyn(iip1,jjp1)
     21       REAL tmp_dyn_glo(nbp_lon+1,nbp_lat)
    2222       REAL tmp_dyn_invers(iip1,jjp1)
    23        real tmp_dyn_invers_glo(nbp_lon+1,nbp_lat)
    24        real tmp_fi(klon)
    25        real tmp_fi_glo(klon_glo)
    26        real surfa(klon,5)
    27        real surfa_glo(klon_glo,5)
     23       REAL tmp_dyn_invers_glo(nbp_lon+1,nbp_lat)
     24       REAL tmp_fi(klon)
     25       REAL tmp_fi_glo(klon_glo)
     26       REAL surfa(klon,5)
     27       REAL surfa_glo(klon_glo,5)
    2828
    29        integer ncid
    30        integer varid
    31        integer rcode
    32        integer start(2),count(2),status
    33        integer i,j,l,ig
     29       INTEGER ncid
     30       INTEGER varid
     31       INTEGER rcode
     32       INTEGER start(2),count(2),status
     33       INTEGER i,j,l,ig
    3434       character*1 str1
    3535
    3636!JE20140526<<
    3737      character*4 ::  latstr,aux4s
    38       logical :: outcycle, isinversed
    39       real, dimension(jjp1) :: lats
    40       real, dimension(nbp_lat) :: lats_glo
     38      LOGICAL :: outcycle, isinversed
     39      REAL, DIMENSION(jjp1) :: lats
     40      REAL, DIMENSION(nbp_lat) :: lats_glo
    4141      REAL :: rcode2
    42       integer, dimension(1) :: startj,endj
     42      INTEGER, DIMENSION(1) :: startj,endj
    4343!JE20140526>>
    4444!$OMP MASTER
    … …  
    5353      isinversed=.FALSE.
    5454      do i=1,5
    55        if (i==1) aux4s='latu'
    56        if (i==2) aux4s='LATU'
    57        if (i==3) aux4s='LatU'
    58        if (i==4) aux4s='Latu'
    59        if (i==5) aux4s='latU'
     55       IF (i==1) aux4s='latu'
     56       IF (i==2) aux4s='LATU'
     57       IF (i==3) aux4s='LatU'
     58       IF (i==4) aux4s='Latu'
     59       IF (i==5) aux4s='latU'
    6060       status = nf90_inq_varid (ncid, aux4s, rcode)
    6161!       print *,'stat,i',status,i,outcycle,aux4s
    6262!       print *,'ifclause',status.NE. nf90_noerr ,outcycle == .FALSE.
    63        IF ((.not.(status/= nf90_noerr) ).and.( .not. outcycle )) THEN
     63       IF ((.NOT.(status/= nf90_noerr) ).AND.( .NOT. outcycle )) THEN
    6464         outcycle=.TRUE.
    6565         latstr=aux4s
    … …  
    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
    … …  
    118118!JE20140526<<
    119119!              CALL gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi)
    120            if (isinversed) THEN
     120           IF (isinversed) THEN
    121121                        CALL gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, &
    122122   tmp_dyn_invers_glo, tmp_fi_glo)

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

    r5116 r5117  
    2626  !$OMP MASTER
    2727  IF (is_mpi_root .AND. is_omp_root) THEN
    28     if (debutphy) THEN
     28    IF (debutphy) THEN
    2929      ncidu1 = nf90_open('u10m.nc', nf90_nowrite, rcode)
    3030      varidu1 = nf90_inq_varid(ncidu1, 'U10M', rcode)

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

    r5112 r5117  
    1616  INTEGER :: i
    1717  REAL :: overpassaqua, overpassterra
    18   REAL,dimension(klon) :: rlat,rlon
     18  REAL,DIMENSION(klon) :: rlat,rlon
    1919
    2020
Note: See TracChangeset for help on using the changeset viewer.