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

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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
Note: See TracChangeset for help on using the changeset viewer.