Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (7 weeks ago)
Author:
abarral
Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

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

Legend:

Unmodified
Added
Removed

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

    r5133 r5158  
    256256 
    257257
    258   do k=1,klon
     258  DO k=1,klon
    259259      maskdustloc(k)=0
    260       do i=1,ntyp
     260      DO i=1,ntyp
    261261         IF (masklisa(k,i)>0) THEN
    262262             maskdustloc(k)=1
    … …  
    358358  auxr3=9999.
    359359  auxr4=9999.
    360   do i=1,nbins+1
     360  DO i=1,nbins+1
    361361   IF (abs(sizeacclow-itv(i))<auxr1) THEN
    362362          auxr1=abs( sizeacclow-itv(i))
    … …  
    380380IF (writeaerosoldistrib) THEN
    381381!JEdbg<<
    382   do j=1,klon
    383   do i=1,nbins
     382  DO j=1,klon
     383  DO i=1,nbins
    384384    itvmean(j,i)=(itv(i)+itv(i+1))/2.
    385385    itv2(j,i)=itv(i)
    … …  
    405405  ALLOCATE(emisbinlocalmean(klon,nbins))
    406406  ALLOCATE(emisbinlocalmean2(klon,nbins))
    407   do i=1,nbins
    408     do j=1,klon
     407  DO i=1,nbins
     408    DO j=1,klon
    409409       emisbinlocalmean(j,i)=0.0
    410410       emisbinlocalmean2(j,i)=0.0
    … …  
    433433auxr2=0.0
    434434auxr3=0.0
    435   do i=iminacclow,iminacchigh-1
     435  DO i=iminacclow,iminacchigh-1
    436436   auxr1=auxr1+emisbinlocal(k,i)
    437437  enddo
    438438  emdustacc(k)=(auxr1 + basesumacc(k))*tuningfactorfine
    439   do i=imincoalow,imincoahigh-1
     439  DO i=imincoalow,imincoahigh-1
    440440    auxr2=auxr2+emisbinlocal(k,i)
    441441  enddo
    442442  emdustcoa(k)=(auxr2 + basesumcoa(k))*tuningfactorcoa
    443   do i=iminscolow,iminscohigh-1
     443  DO i=iminscolow,iminscohigh-1
    444444    auxr3=auxr3+emisbinlocal(k,i)
    445445  enddo
    … …  
    468468!JEdbg<<
    469469IF (writeaerosoldistrib) THEN
    470   do i=1,nbins
    471     do j=1,klon
     470  DO i=1,nbins
     471    DO j=1,klon
    472472        emisbinlocalmean(j,i)=emisbinlocalmean(j,i)+emisbinlocal(j,i)
    473473    enddo
    … …  
    479479IF (MOD(counter,1440)== 0) THEN
    480480   !if (MOD(counter,480).EQ. 0) THEN
    481    do k = 1,klon
    482    do i=1,nbins
     481   DO k = 1,klon
     482   DO i=1,nbins
    483483     emisbinlocalmean2(k,i)=emisbinlocalmean(k,i)/float(counter1)
    484484   enddo
    … …  
    493493!!$OMP END MASTER
    494494!!$OMP BARRIER
    495    do i=1,nbins
    496      do j=1,klon
     495   DO i=1,nbins
     496     DO j=1,klon
    497497        emisbinlocalmean(j,i)=0.0
    498498     enddo
    … …  
    751751      dstep=0.0005
    752752      dp=dmin
    753       do i=1,nclass
     753      DO i=1,nclass
    754754         dp=dp*exp(dstep)
    755755         sizeclass(i)=dp
    … …  
    770770!c 0: Iversen and White 1982
    771771       print *,'Using  Iversen and White 1982 Uth'
    772          do i=1,ncl
     772         DO i=1,ncl
    773773            bb=adust*(sizeclass(i)**xdust)+bdust
    774774            cc=sqrt(1+ddust*(sizeclass(i)**(-2.5)))
    … …  
    789789            an=0.0123
    790790            gam=0.3
    791             do i=1,ncl
     791            DO i=1,ncl
    792792               sigshao=rop/roa
    793793               x1=sigshao*gravity*sizeclass(i)
    … …  
    845845  !wind friction velocity.
    846846      !    feff(:,:)=0.
    847        do i=1,klon
    848           do k=1,ntyp
     847       DO i=1,klon
     848          DO k=1,ntyp
    849849     !     PRINT*,'IKKK ',i,klon,k,ntyp
    850850             IF (zos(i,k)==0..or.z01(i,k)==0.) THEN
    … …  
    887887  IF (flag_feff == 0) THEN
    888888    print *,'JE_dbg FORCED deactivated feff'
    889     do i=1,klon
    890       do k=1,ntyp
     889    DO i=1,klon
     890      DO k=1,ntyp
    891891        feff(i,k)=1.
    892892      enddo
    … …  
    12731273
    12741274!                  CALL def_ag01(kfin,ft1,ft2,ft3)
    1275       do ni=1,kfin
     1275      DO ni=1,kfin
    12761276         fdp1=1.-(uth2(ni)/(ceff*ustarsalt))
    12771277         IF (fdp1<=0..or.srel2(nat,ni)==0.) THEN
    … …  
    13881388! readaptation of large sizes particles
    13891389         kfin=0
    1390          do i=ideb,ifin
     1390         DO i=ideb,ifin
    13911391            kfin=kfin+1
    13921392            sizeclass2(kfin)=sizeclass(i)
    … …  
    13971397         kfin2=kfin
    13981398         istep=50
    1399          do i=ifin,ncl,istep
     1399         DO i=ifin,ncl,istep
    14001400            kfin=kfin+1
    14011401            sizeclass2(kfin)=sizeclass(i)
    … …  
    14331433      ismax=i2
    14341434      ihalf=int((ismax+ismin)/2.)
    1435       do k2=1,1000000
     1435      DO k2=1,1000000
    14361436          IF(ds>siz(ihalf))THEN
    14371437             ismin=ihalf

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

    r5135 r5158  
    44  USE infotrac
    55  USE lmdz_libmath, ONLY: ismax, ismin
     6
     7  IMPLICIT NONE
     8
    69  INCLUDE "dimensions.h"
    710
    … …  
    912  CHARACTER(LEN = *) :: comment
    1013  REAL :: qmin, qmax
     14  REAL :: zqmin, zqmax
    1115  REAL :: zq(klon, klev)
    1216
    … …  
    2428  zqmax = zq(ijmax, lmax)
    2529
    26   IF(zqmin<qmin.OR.zqmax>qmax) &
    27           WRITE(*, 9999) comment, &
    28                   ijmin, lmin, zqmin, ijmax, lmax, zqmax
     30  IF(zqmin<qmin.OR.zqmax>qmax) WRITE(*, 9999) comment, ijmin, lmin, zqmin, ijmax, lmax, zqmax
    2931
    3032  RETURN

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

    r5135 r5158  
    55  USE lmdz_libmath, ONLY: ismax, ismin
    66
     7  IMPLICIT NONE
     8
    79  INCLUDE "dimensions.h"
    810
    … …  
    1012  CHARACTER(LEN = *) :: comment
    1113  REAL :: qmin, qmax
     14  REAL :: zqmin, zqmax
    1215  REAL :: zq(klon, nbtr)
    1316
    … …  
    2528  zqmax = zq(ijmax, lmax)
    2629
    27   IF(zqmin<qmin.OR.zqmax>qmax) &
    28           WRITE(*, 9999) comment, &
    29                   ijmin, lmin, zqmin, ijmax, lmax, zqmax
     30  IF(zqmin<qmin.OR.zqmax>qmax) WRITE(*, 9999) comment, ijmin, lmin, zqmin, ijmax, lmax, zqmax
    3031
    3132  RETURN

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

    r5117 r5158  
    4141
    4242  psi = 0.
    43   do i = 1, klon
     43  DO i = 1, klon
    4444
    4545    IF (u10_mps(i) < 0.) u10_mps(i) = 0.0

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

    r5144 r5158  
    13431343
    13441344    !JE_dbg
    1345     do i = 1, klon
     1345    DO i = 1, klon
    13461346      tsol(i) = 0.0
    1347       do j = 1, nbsrf
     1347      DO j = 1, nbsrf
    13481348        tsol(i) = tsol(i) + ftsol(i, j) * pctsrf(i, j)
    13491349      enddo
    … …  
    13821382      id_scdu = -1
    13831383      itr = 0
    1384       do iq = 1, nqtot
     1384      DO iq = 1, nqtot
    13851385        IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    13861386        itr = itr + 1
    … …  
    19411941      !$OMP END MASTER
    19421942      !$OMP BARRIER
    1943       do i = 1, klon
     1943      DO i = 1, klon
    19441944        aux_var2(i) = pctsrf(i, is_oce)
    19451945      enddo
    … …  
    19541954      !$OMP BARRIER
    19551955
    1956       do i = 1, klon
     1956      DO i = 1, klon
    19571957        aux_var2(i) = pctsrf(i, is_sic)
    19581958      enddo
    … …  
    19671967      !$OMP BARRIER
    19681968
    1969       do i = 1, klon
     1969      DO i = 1, klon
    19701970        aux_var2(i) = pctsrf(i, is_ter)
    19711971      enddo
    … …  
    19801980      !$OMP BARRIER
    19811981
    1982       do i = 1, klon
     1982      DO i = 1, klon
    19831983        aux_var2(i) = pctsrf(i, is_lic)
    19841984      enddo
    … …  
    20662066    !     .                                         MAXVAL(tr_seri(:,:,3))
    20672067#ifdef IOPHYS_DUST
    2068       do itr=1,nbtr
     2068      DO itr=1,nbtr
    20692069         WRITE(str2,'(i2.2)') itr
    20702070         CALL iophys_ecrit('sav'//str2,1,'SOURCE','',source_tr(:,itr))
    20712071         CALL iophys_ecrit('fav'//str2,1,'SOURCE','',source_tr(:,itr))
    20722072      enddo
    2073       do itr=1,nbtr
     2073      DO itr=1,nbtr
    20742074         WRITE(str2,'(i2.2)') itr
    20752075         CALL iophys_ecrit('TRB'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    20992099
    21002100#ifdef IOPHYS_DUST
    2101       do itr=1,nbtr
     2101      DO itr=1,nbtr
    21022102         WRITE(str2,'(i2.2)') itr
    21032103         CALL iophys_ecrit('sap'//str2,1,'SOURCE','',source_tr(:,itr))
    … …  
    21962196#ifdef IOPHYS_DUST
    21972197
    2198       do itr=1,nbtr
     2198      DO itr=1,nbtr
    21992199         WRITE(str2,'(i2.2)') itr
    22002200         CALL iophys_ecrit('tpr'//str2,1,'SOURCE','',source_tr(:,itr))
    … …  
    22402240
    22412241#ifdef IOPHYS_DUST
    2242       do itr=1,nbtr
     2242      DO itr=1,nbtr
    22432243         WRITE(str2,'(i2.2)') itr
    22442244         CALL iophys_ecrit('t'//str2,1,'SOURCE','',source_tr(:,itr))
    … …  
    22962296
    22972297#ifdef IOPHYS_DUST
    2298       do itr=1,nbtr
     2298      DO itr=1,nbtr
    22992299         WRITE(str2,'(i2.2)') itr
    23002300         CALL iophys_ecrit('TRC'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    23362336
    23372337#ifdef IOPHYS_DUST
    2338       do itr=1,nbtr
     2338      DO itr=1,nbtr
    23392339         WRITE(str2,'(i2.2)') itr
    23402340         CALL iophys_ecrit('TRD'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    24102410      CALL iophys_ecrit('yv1',1,'yv1','',yv1)
    24112411      CALL iophys_ecrit('delp',klev,'delp','',delp)
    2412       do itr=1,nbtr
     2412      DO itr=1,nbtr
    24132413         WRITE(str2,'(i2.2)') itr
    24142414         CALL iophys_ecrit('TRE'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    26022602    !=======================================================================
    26032603#ifdef IOPHYS_DUST
    2604       do itr=1,nbtr
     2604      DO itr=1,nbtr
    26052605         WRITE(str2,'(i2.2)') itr
    26062606         CALL iophys_ecrit('TRF'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    26892689
    26902690#ifdef IOPHYS_DUST
    2691       do itr=1,nbtr
     2691      DO itr=1,nbtr
    26922692         WRITE(str2,'(i2.2)') itr
    26932693         CALL iophys_ecrit('TRG'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    28542854
    28552855#ifdef IOPHYS_DUST
    2856       do itr=1,nbtr
     2856      DO itr=1,nbtr
    28572857         WRITE(str2,'(i2.2)') itr
    28582858         CALL iophys_ecrit('TRH'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    30533053      CALL iophys_ecrit('wdtrainM',klev,'wdtrainM','',wdtrainM)
    30543054
    3055       do itr=1,nbtr
     3055      DO itr=1,nbtr
    30563056         WRITE(str2,'(i2.2)') itr
    30573057         CALL iophys_ecrit('TRI'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    31743174    !=======================================================================
    31753175#ifdef IOPHYS_DUST
    3176       do itr=1,nbtr
     3176      DO itr=1,nbtr
    31773177         WRITE(str2,'(i2.2)') itr
    31783178         CALL iophys_ecrit('TRJ'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    34403440    !======================================================================
    34413441#ifdef IOPHYS_DUST
    3442       do itr=1,nbtr
     3442      DO itr=1,nbtr
    34433443         WRITE(str2,'(i2.2)') itr
    34443444         CALL iophys_ecrit('TRK'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    … …  
    43064306    IF (is_mpi_root .AND. is_omp_root) THEN
    43074307      OPEN(1, file = trim(adjustl(filescaleparams)), form = 'unformatted')
    4308       do k = 1, nbreg
     4308      DO k = 1, nbreg
    43094309        read(1)  scale_param(k)
    43104310      enddo
    … …  
    44544454      ierr = nf90_open(trim(adjustl(filescaleparams)), nf90_nowrite, nid)
    44554455      IF (ierr == nf90_noerr) THEN
    4456         do i = 1, nbreg
     4456        DO i = 1, nbreg
    44574457          WRITE(aux_2s, '(i2.2)') i
    44584458          varname = trim(adjustl(paramname)) // aux_2s

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

    r5135 r5158  
    5252      latstr='null'
    5353      isinversed=.FALSE.
    54       do i=1,5
     54      DO i=1,5
    5555       IF (i==1) aux4s='latu'
    5656       IF (i==2) aux4s='LATU'

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

    r5117 r5158  
    111111  REAL :: zz
    112112
    113   do l = 1, nl
    114     do i = 2, iim - 1
     113  DO l = 1, nl
     114    DO i = 2, iim - 1
    115115      IF(abs(x(i, l))>1.e10) THEN
    116116        zz = 0.5 * (x(i - 1, l) + x(i + 1, l))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/spla_output_dat.h

    r5099 r5158  
    192192!      (/ 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)',  &
    193193!         't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)' /))
    194        
     194
    195195  type(ctrl_out),save :: o_trm01     = ctrl_out((/ 4, 4, 4, 10, 10, 10, 10, 10, 10, 10 /), &
    196196  'trm01','Burden PREC','', (/ ('', i=1, 10) /))
Note: See TracChangeset for help on using the changeset viewer.