Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (3 months 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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_cv30.F90

    r5141 r5158  
    55  ! Parameters for convectL, iflag_con=30:
    66  ! (includes - microphysical parameters,
    7   !                     - parameters that control the rate of approach
     7  !            - parameters that control the rate of approach
    88  !               to quasi-equilibrium)
    9   !                     - noff & minorig (previously in input of convect1)
     9  !            - noff & minorig (previously in input of convect1)
    1010  !------------------------------------------------------------
    1111
    … …  
    322322      qsnk(i) = qs(i, nk(i))
    323323#ifdef ISO
    324       do ixt=1,ntraciso
     324      DO ixt=1,ntraciso
    325325        xtnk(ixt,i) = xt(ixt,i, nk(i))
    326326      enddo
    … …  
    531531      clw(i, k) = 0.0 ! convect3
    532532#ifdef ISO
    533         do ixt=1,ntraciso
     533        DO ixt=1,ntraciso
    534534         xtclw(ixt,i,k) = 0.0
    535535        enddo
    … …  
    626626#ifdef ISO
    627627       ! calcul de zfice
    628        do i=1,len
     628       DO i=1,len
    629629          zfice(i) = 1.0-(t(i,icbs(i))-pxtice)/(pxtmelt-pxtice)
    630630          zfice(i) = MIN(MAX(zfice(i),0.0),1.0)         
    … …  
    632632       ! calcul de la composition du condensat glace et liquide
    633633
    634        do i=1,len
     634       DO i=1,len
    635635         clw_k(i)=clw(i,icbs(i))
    636636         tg_k(i)=t(i,icbs(i))
    637          do ixt=1,ntraciso
     637         DO ixt=1,ntraciso
    638638            xt_k(ixt,i)=xt(ixt,i,nk(i))
    639639          enddo         
    … …  
    642642        WRITE(*,*) 'cv30_routine undilute1 573: avant condiso'
    643643        WRITE(*,*) 't(1,1)=',t(1,1)
    644         do i=1,len
     644        DO i=1,len
    645645           CALL iso_verif_positif(t(i,icbs(i))-Tmin_verif, &
    646646              'cv30_routines 654')
    647647        enddo
    648648        IF (iso_HDO.gt.0) THEN
    649          do i=1,len
     649         DO i=1,len
    650650          IF (qnk(i).gt.ridicule) THEN
    651651           CALL iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), &
    … …  
    667667              zfice(1),zxtice(1,1),zxtliq(1,1),len)
    668668#endif
    669        do i=1,len
    670          do ixt = 1, ntraciso   
     669       DO i=1,len
     670         DO ixt = 1, ntraciso
    671671           xtclw(ixt,i,icbs(i))=  zxtice(ixt,i)+zxtliq(ixt,i)   
    672672           xtclw(ixt,i,icbs(i))=max(0.0,xtclw(ixt,i,icbs(i)))
    … …  
    678678         
    679679          IF (iso_eau.gt.0) THEN
    680             do i=1,len
     680            DO i=1,len
    681681              CALL iso_verif_egalite_choix(xtclw(iso_eau,i,icbs(i)), &
    682682               clw(i,icbs(i)),'cv30_routines 577',errmax,errmaxrel)
    … …  
    684684          endif !if (iso_eau.gt.0) THEN
    685685#ifdef ISOTRAC   
    686         do i=1,len
     686        DO i=1,len
    687687           CALL iso_verif_traceur(xtclw(1,i,k),'cv30_routines 603')
    688688        enddo
    … …  
    796796
    797797#ifdef ISO
    798         do i=1,len
     798        DO i=1,len
    799799         zfice(i) = 1.0-(t(i,icb(i)+1)-pxtice)/(pxtmelt-pxtice)
    800800         zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
    801801!         CALL calcul_zfice(tp(i,icb(i)+1),zfice)
    802802        enddo !do i=1,len
    803         do i=1,len
     803        DO i=1,len
    804804         clw_k(i)=clw(i,icb(i)+1)
    805805         tg_k(i)=t(i,icb(i)+1)
    … …  
    807807        CALL iso_verif_positif(tg_k(i)-Tmin_verif,'cv30_routines 750')
    808808#endif         
    809          do ixt=1,ntraciso
     809         DO ixt=1,ntraciso
    810810            xt_k(ixt,i)=xt(ixt,i,nk(i))
    811811          enddo   
    … …  
    814814        WRITE(*,*) 'cv30_routines 739: avant condiso'
    815815        IF (iso_HDO.gt.0) THEN
    816          do i=1,len
     816         DO i=1,len
    817817           CALL iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), &
    818818                  'cv30_routines 725')
    … …  
    820820        endif !if (iso_HDO.gt.0) THEN
    821821#ifdef ISOTRAC   
    822         do i=1,len
     822        DO i=1,len
    823823           CALL iso_verif_traceur(xtclw(1,i,k),'cv30_routines 738')
    824824        enddo
    … …  
    833833              zfice(1),zxtice(1,1),zxtliq(1,1),len)
    834834#endif
    835         do i=1,len
    836          do ixt = 1, ntraciso
     835        DO i=1,len
     836         DO ixt = 1, ntraciso
    837837          xtclw(ixt,i,icb(i)+1)=zxtice(ixt,i)+zxtliq(ixt,i)         
    838838          xtclw(ixt,i,icb(i)+1)=max(0.0,xtclw(ixt,i,icb(i)+1))
    … …  
    842842#ifdef ISOVERIF           
    843843!WRITE(*,*) 'DEBUG ISO B'
    844           do i=1,len
     844          DO i=1,len
    845845            IF (iso_eau.gt.0) THEN
    846846             CALL iso_verif_egalite_choix(xtclw(iso_eau,i,icb(i)+1), &
    … …  
    10361036#ifdef ISO
    10371037        ! initialisation des champs compresses:
    1038         do k=1,nd
    1039           do i=1,nloc
     1038        DO k=1,nd
     1039          DO i=1,nloc
    10401040            IF (essai_convergence) THEN
    10411041            else
    … …  
    10441044!            convergence
    10451045            endif  !f (negation(essai_convergence)) THEN
    1046             do ixt=1,ntraciso
     1046            DO ixt=1,ntraciso
    10471047              xt(ixt,i,k)=0.0
    10481048              xtclw(ixt,i,k)=0.0
    … …  
    10771077        th(nn, k) = th1(i, k)
    10781078#ifdef ISO
    1079         do ixt = 1, ntraciso
     1079        DO ixt = 1, ntraciso
    10801080           xt(ixt,nn,k)=xt1(ixt,i,k)
    10811081           xtclw(ixt,nn,k)=xtclw1(ixt,i,k)
    … …  
    11211121      iflag(nn) = iflag1(i)
    11221122#ifdef ISO
    1123       do ixt=1,ntraciso
     1123      DO ixt=1,ntraciso
    11241124        xtnk(ixt,nn) = xtnk1(ixt,i)
    11251125      enddo
    … …  
    11311131#ifdef ISOVERIF
    11321132       IF (iso_eau.gt.0) THEN
    1133         do k = 1, nd
    1134          do i = 1, nloc 
     1133        DO k = 1, nd
     1134         DO i = 1, nloc
    11351135        !WRITE(*,*) 'i,k=',i,k
    11361136        CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
    … …  
    11411141        enddo
    11421142       endif !if (iso_eau.gt.0) THEN
    1143        do k = 1, nd
    1144          do i = 1, nn
     1143       DO k = 1, nd
     1144         DO i = 1, nn
    11451145           CALL iso_verif_positif(q(i,k),'compress 1004')
    11461146         enddo
    … …  
    12721272  DO k = minorig + 1, nl
    12731273    DO i = 1, ncum
    1274       ! ori         IF(k.ge.(icb(i)+1))THEN
     1274      ! ori        IF(k.ge.(icb(i)+1))THEN
    12751275      IF (k>=(icbs(i)+1)) THEN ! convect3
    12761276        tg = t(i, k)
    12771277        qg = qs(i, k)
    1278         ! debug       alv=lv0-clmcpv*(t(i,k)-t0)
     1278        ! debug          alv=lv0-clmcpv*(t(i,k)-t0)
    12791279        alv = lv0 - clmcpv*(t(i,k)-273.15)
    12801280
    12811281        ! First iteration.
    12821282
    1283         ! ori          s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
     1283        ! ori           s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
    12841284        s = cpd*(1.-qnk(i)) + cl*qnk(i) & ! convect3
    12851285          +alv*alv*qg/(rrv*t(i,k)*t(i,k)) ! convect3
    12861286        s = 1./s
    1287         ! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
     1287        ! ori           ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
    12881288        ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gz(i, k) ! convect3
    12891289        tg = tg + s*(ah0(i)-ahg)
    1290         ! ori          tg=max(tg,35.0)
    1291         ! debug        tc=tg-t0
     1290        ! ori           tg=max(tg,35.0)
     1291        ! debug           tc=tg-t0
    12921292        tc = tg - 273.15
    12931293        denom = 243.5 + tc
    12941294        denom = max(denom, 1.0) ! convect3
    1295         ! ori          IF(tc.ge.0.0)THEN
     1295        ! ori           IF(tc.ge.0.0)THEN
    12961296        es = 6.112*exp(17.67*tc/denom)
    1297         ! ori          else
    1298         ! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
    1299         ! ori          endif
     1297        ! ori           else
     1298        ! ori            es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
     1299        ! ori           endif
    13001300        qg = eps*es/(p(i,k)-es*(1.-eps))
    13011301!        qg=max(0.0,qg) ! C Risi
    … …  
    13031303        ! Second iteration.
    13041304
    1305         ! ori          s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
    1306         ! ori          s=1./s
    1307         ! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
     1305        ! ori           s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
     1306        ! ori           s=1./s
     1307        ! ori           ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
    13081308        ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gz(i, k) ! convect3
    13091309        tg = tg + s*(ah0(i)-ahg)
    1310         ! ori          tg=max(tg,35.0)
    1311         ! debug        tc=tg-t0
     1310        ! ori           tg=max(tg,35.0)
     1311        ! debug           tc=tg-t0
    13121312        tc = tg - 273.15
    13131313        denom = 243.5 + tc
    13141314        denom = max(denom, 1.0) ! convect3
    1315         ! ori          IF(tc.ge.0.0)THEN
     1315        ! ori           IF(tc.ge.0.0)THEN
    13161316        es = 6.112*exp(17.67*tc/denom)
    1317         ! ori          else
    1318         ! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
    1319         ! ori          endif
     1317        ! ori           else
     1318        ! ori            es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
     1319        ! ori           endif
    13201320        qg = eps*es/(p(i,k)-es*(1.-eps))
    13211321!        qg=max(0.0,qg) ! C Risi
    13221322
    1323         ! debug        alv=lv0-clmcpv*(t(i,k)-t0)
     1323        ! debug           alv=lv0-clmcpv*(t(i,k)-t0)
    13241324        alv = lv0 - clmcpv*(t(i,k)-273.15)
    13251325        ! PRINT*,'cpd dans convect2 ',cpd
    … …  
    13451345#ifdef ISO
    13461346       ! calcul de zfice
    1347        do i=1,ncum
     1347       DO i=1,ncum
    13481348          zfice(i) = 1.0-(t(i,k)-pxtice)/(pxtmelt-pxtice)
    13491349          zfice(i) = MIN(MAX(zfice(i),0.0),1.0)         
    13501350       enddo
    1351        do i=1,ncum
     1351       DO i=1,ncum
    13521352         clw_k(i)=clw(i,k)
    13531353         tg_k(i)=t(i,k)
    … …  
    13561356        !WRITE(*,*) 'cv30_routine 1259: avant condiso'
    13571357        IF (iso_HDO.gt.0) THEN
    1358          do i=1,ncum
     1358         DO i=1,ncum
    13591359           CALL iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), &
    13601360                  'cv30_routines 1231')
    … …  
    13621362        endif !if (iso_HDO.gt.0) THEN
    13631363        IF (iso_eau.gt.0) THEN
    1364          do i=1,ncum
     1364         DO i=1,ncum
    13651365           CALL iso_verif_egalite(xtnk(iso_eau,i),qnk(i), &
    13661366                  'cv30_routines 1373')
    13671367         enddo       
    13681368        endif !if (iso_HDO.gt.0) THEN
    1369         do i=1,ncum
     1369        DO i=1,ncum
    13701370         IF ((iso_verif_positif_nostop(qnk(i)-clw_k(i), &
    13711371             'cv30_routines 1275').EQ.1).OR. &
    … …  
    13811381        enddo !do i=1,ncum   
    13821382#ifdef ISOTRAC   
    1383         do i=1,ncum
     1383        DO i=1,ncum
    13841384           CALL iso_verif_traceur(xtnk(1,i),'cv30_routines 1251')
    13851385        enddo !do i=1,ncum
    … …  
    13971397              zfice(1),zxtice(1,1),zxtliq(1,1),ncum)
    13981398#endif
    1399         do i=1,ncum
    1400          do ixt=1,ntraciso
     1399        DO i=1,ncum
     1400         DO ixt=1,ntraciso
    14011401          xtclw(ixt,i,k)=zxtice(ixt,i)+zxtliq(ixt,i)
    14021402          xtclw(ixt,i,k)=max(0.0,xtclw(ixt,i,k))
    … …  
    14051405#ifdef ISOVERIF
    14061406        IF (iso_eau.gt.0) THEN
    1407           do i=1,ncum       
     1407          DO i=1,ncum
    14081408           CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k), &
    14091409                clw(i,k),'cv30_routines 1223',errmax,errmaxrel)
    … …  
    14111411        endif !if (iso_eau.gt.0) THEN
    14121412#ifdef ISOTRAC   
    1413         do i=1,ncum
     1413        DO i=1,ncum
    14141414           CALL iso_verif_traceur(xtclw(1,i,k),'cv30_routines 1275')
    14151415        enddo
    … …  
    19841984
    19851985#ifdef ISO
    1986       do j=1,nd
    1987        do k=1,nd
    1988           do i=1,ncum
    1989             do ixt =1,ntraciso
     1986      DO j=1,nd
     1987       DO k=1,nd
     1988          DO i=1,ncum
     1989            DO ixt =1,ntraciso
    19901990             xtent(ixt,i,k,j)=xt(ixt,i,j)
    19911991             xtelij(ixt,i,k,j)=0.0
    … …  
    20742074        !WRITE(*,*) 'cv30_routines tmp 2078'
    20752075#endif
    2076        do il=1,ncum
     2076       DO il=1,ncum
    20772077         zfice(il) = 1.0-(t(il,j)-pxtice)/(pxtmelt-pxtice)
    20782078         zfice(il) = MIN(MAX(zfice(il),0.0),1.0)       
    20792079         IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
    20802080            (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN
    2081           do ixt=1,ntraciso
     2081          DO ixt=1,ntraciso
    20822082!           xtrti(ixt)=xt(ixt,il,1)-xtep(ixt,il,i)*xtclw(ixt,il,i) ! le 7 mai: on supprime xtep
    20832083           xtrti(ixt,il)=xt(ixt,il,1)-ep(il,i)*xtclw(ixt,il,i)     
    … …  
    20902090!     :        / ( cpd*(bf2-1.0)/lv(il,j) )
    20912091                   
    2092           do ixt = 1, ntraciso
     2092          DO ixt = 1, ntraciso
    20932093! total mixing ratio in the mixtures before precipitation:
    20942094           xtent(ixt,il,i,j)=sij(il,i,j)*xt(ixt,il,i) &
    … …  
    21072107                 t(1,j),zfice(1),zxtice(1,1),zxtliq(1,1),ncum)
    21082108#ifdef ISOVERIF
    2109         do il=1,ncum
     2109        DO il=1,ncum
    21102110          CALL iso_verif_traceur(xt(1,il,i),'cv30_routines 1967')
    21112111          IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
    … …  
    21182118#endif     
    21192119#endif     
    2120         do il=1,ncum
    2121          do ixt = 1, ntraciso
     2120        DO il=1,ncum
     2121         DO ixt = 1, ntraciso
    21222122          xtelij(ixt,il,i,j)=zxtice(ixt,il)+zxtliq(ixt,il)
    21232123         enddo !do ixt = 1, ntraciso
    … …  
    21432143!     :           option_traceurs
    21442144        IF (option_tmin.ge.1) THEN
    2145         do il=1,ncum   
     2145        DO il=1,ncum
    21462146!        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
    21472147!     :           'tcond(il),rs(il,j)=',
    … …  
    21612161                 seuil_tag_tmin)
    21622162            endif !if (option_traceurs.EQ.17) THEN
    2163             do ixt=1+niso,ntraciso
     2163            DO ixt=1+niso,ntraciso
    21642164               xtent(ixt,il,i,j)=xtres(ixt)
    21652165            enddo     
    … …  
    21672167        enddo !do il=1,ncum
    21682168#ifdef ISOVERIF
    2169         do il=1,ncum
     2169        DO il=1,ncum
    21702170          CALL iso_verif_traceur(xtent(1,il,i,j),'cv30_routines 1996')
    21712171          CALL iso_verif_traceur(xtelij(1,il,i,j),'cv30_routines 1997')
    … …  
    21802180#ifdef ISOVERIF
    21812181!        WRITE(*,*) 'cv30_routines 2050: avant condiso'
    2182         do il=1,ncum
     2182        DO il=1,ncum
    21832183        IF ((i.ge.icb(il)).AND.(i.le.inb(il)).AND. &
    21842184            (j.ge.(icb(il)-1)).AND.(j.le.inb(il))) THEN
    … …  
    22512251        sij(il, i, i) = 0.0
    22522252#ifdef ISO
    2253       do ixt = 1, ntraciso
     2253      DO ixt = 1, ntraciso
    22542254       xtent(ixt,il,i,i)=xt(ixt,il,nk(il))-ep(il,i)*xtclw(ixt,il,i)
    22552255!      xtent(ixt,il,i,i)=xt(ixt,il,nk(il))-xtep(ixt,il,i)*xtclw(ixt,il,i)
    … …  
    22852285                 seuil_tag_tmin)
    22862286            endif !if (option_traceurs.EQ.17) THEN
    2287             do ixt=1+niso,ntraciso
     2287            DO ixt=1+niso,ntraciso
    22882288              xtent(ixt,il,i,i)=xtres(ixt)
    22892289            enddo
    22902290#ifdef ISOVERIF           
    2291             do ixt=1,niso
     2291            DO ixt=1,niso
    22922292            CALL iso_verif_egalite_choix(xtres(ixt),xtent(ixt,il,i,i), &
    22932293                 'cv30_routines 2102',errmax,errmaxrel)
    … …  
    24842484        sij(il, i, i) = 0.0
    24852485#ifdef ISO
    2486       do ixt = 1, ntraciso
     2486      DO ixt = 1, ntraciso
    24872487!      xtent(ixt,il,i,i)=xt(ixt,il,1)-xtep(ixt,il,i)*xtclw(ixt,il,i)
    24882488        xtent(ixt,il,i,i)=xt(ixt,il,1)-ep(il,i)*xtclw(ixt,il,i)
    … …  
    25182518                 seuil_tag_tmin)
    25192519            endif ! if (option_traceurs.EQ.17) THEN
    2520             do ixt=1+niso,ntraciso
     2520            DO ixt=1+niso,ntraciso
    25212521              xtent(ixt,il,i,i)=xtres(ixt)
    25222522            enddo 
    25232523#ifdef ISOVERIF               
    2524             do ixt=1,niso
     2524            DO ixt=1,niso
    25252525              CALL iso_verif_egalite_choix(xtres(ixt),xtent(ixt,il,i,i), &
    25262526                 'cv30_routines 2318',errmax,errmaxrel)
    … …  
    25832583!c--debug
    25842584#ifdef ISOVERIF
    2585        do im = 1, nd
    2586        do jm = 1, nd
    2587         do il = 1, ncum
     2585       DO im = 1, nd
     2586       DO jm = 1, nd
     2587        DO il = 1, ncum
    25882588          IF (iso_eau.gt.0) THEN
    25892589            CALL iso_verif_egalite_choix(xtelij(iso_eau,il,im,jm), &
    … …  
    26062606        ! seulement a la fin on taggue le condensat
    26072607        IF (option_cond.ge.1) THEN
    2608          do im = 1, nd
    2609          do jm = 1, nd
    2610          do il = 1, ncum   
     2608         DO im = 1, nd
     2609         DO jm = 1, nd
     2610         DO il = 1, ncum
    26112611           ! colorier le condensat en un tag specifique
    2612            do ixt=niso+1,ntraciso
     2612           DO ixt=niso+1,ntraciso
    26132613             IF (index_zone(ixt).EQ.izone_cond) THEN
    26142614                xtelij(ixt,il,im,jm)=xtelij(index_iso(ixt),il,im,jm)
    … …  
    26262626         enddo !do jm = 1, nd
    26272627         enddo !do im = 1, nd
    2628          do im = 1, nd
    2629          do il = 1, ncum   
     2628         DO im = 1, nd
     2629         DO il = 1, ncum
    26302630           ! colorier le condensat en un tag specifique
    2631            do ixt=niso+1,ntraciso
     2631           DO ixt=niso+1,ntraciso
    26322632             IF (index_zone(ixt).EQ.izone_cond) THEN
    26332633                xtclw(ixt,il,im)=xtclw(index_iso(ixt),il,im)
    … …  
    27902790#ifdef ISO
    27912791          rpprec(il,i)=rp(il,i)
    2792           do ixt=1,ntraciso
     2792          DO ixt=1,ntraciso
    27932793           xtp(ixt,il,i)=xt(ixt,il,i)
    27942794           xtwater(ixt,il,i)=0.0
    … …  
    28692869          wdtraina(il, i) = wdtrain(il)/grav !   Pa  26/08/10   RomP
    28702870#ifdef ISO
    2871           do ixt=1,ntraciso
     2871          DO ixt=1,ntraciso
    28722872!           xtwdtrain(ixt,il)=grav*xtep(ixt,il,i)*m(il,i)*xtclw(ixt,il,i)
    28732873           xtwdtrain(ixt,il)=grav*ep(il,i)*m(il,i)*xtclw(ixt,il,i)
    … …  
    28902890          wdtraina(il, i) = wdtrain(il)/10. !   Pa  26/08/10   RomP
    28912891#ifdef ISO
    2892           do ixt=1,ntraciso
     2892          DO ixt=1,ntraciso
    28932893!           xtwdtrain(ixt,il)=10.0*xtep(ixt,il,i)*m(il,i)*xtclw(ixt,il,i)
    28942894            xtwdtrain(ixt,il)=10.0*ep(il,i)*m(il,i)*xtclw(ixt,il,i)
    … …  
    29102910! precip mixed drafts computed from: xtawat/xtelij = awat/elij           
    29112911            IF (elij(il,j,i).NE.0.0) THEN
    2912              do ixt=1,ntraciso
     2912             DO ixt=1,ntraciso
    29132913               xtawat(ixt)=xtelij(ixt,il,j,i)*(awat/elij(il,j,i))
    29142914               xtawat(ixt)=amax1(xtawat(ixt),0.0)
    … …  
    29162916!!             xtawat(ixt)=amin1(xtawat(ixt),xtelij(ixt,il,j,i)) !security..
    29172917            else
    2918              do ixt=1,ntraciso
     2918             DO ixt=1,ntraciso
    29192919               xtawat(ixt)=0.0
    29202920             enddo !do ixt=1,niso
    … …  
    29342934              wdtrain(il) = wdtrain(il) + grav*awat*ment(il, j, i)
    29352935#ifdef ISO
    2936            do ixt=1,ntraciso
     2936           DO ixt=1,ntraciso
    29372937             xtwdtrain(ixt,il)=xtwdtrain(ixt,il) &
    29382938                               +grav*xtawat(ixt)*ment(il,j,i)
    … …  
    29422942              wdtrain(il) = wdtrain(il) + 10.0*awat*ment(il, j, i)
    29432943#ifdef ISO           
    2944            do ixt=1,ntraciso
     2944           DO ixt=1,ntraciso
    29452945             xtwdtrain(ixt,il)=xtwdtrain(ixt,il) &
    29462946                               +10.0*xtawat(ixt)*ment(il,j,i)
    … …  
    32133213! verif des inputs a appel stewart
    32143214!        WRITE(*,*) 'cv30_routines 2842 tmp: appel de appel_stewart'
    3215       do il=1,ncum
     3215      DO il=1,ncum
    32163216       IF (i.le.inb(il) .AND. lwork(il)) THEN
    32173217         IF (iso_eau.gt.0) THEN
    … …  
    32533253!        WRITE(*,*) 'cv30_routines 2864 tmp: sortie de appel_stewart'
    32543254! verif des outputs de appel stewart
    3255        do il=1,ncum
     3255       DO il=1,ncum
    32563256        IF (i.le.inb(il) .AND. lwork(il)) THEN
    3257          do ixt=1,ntraciso       
     3257         DO ixt=1,ntraciso
    32583258          CALL iso_verif_noNAN(xtp(ixt,il,i),'cv30_unsat 3382')
    32593259          CALL iso_verif_noNAN(xtwater(ixt,il,i),'cv30_unsat 3381')
    … …  
    33003300       
    33013301! equivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
    3302        do il=1,ncum
     3302       DO il=1,ncum
    33033303        IF (i.lt.inb(il) .AND. lwork(il)) THEN
    33043304         IF (rpprec(il,i).gt.rs(il,i)) THEN
    … …  
    33073307                stop
    33083308            endif
    3309             do ixt=1,ntraciso
     3309            DO ixt=1,ntraciso
    33103310              xtp(ixt,il,i)=xtp(ixt,il,i)/rpprec(il,i)*rs(il,i)
    33113311              xtp(ixt,il,i)=max(0.0,xtp(ixt,il,i))
    33123312            enddo !do ixt=1,niso
    33133313#ifdef ISOVERIF
    3314            do ixt=1,ntraciso       
     3314           DO ixt=1,ntraciso
    33153315           CALL iso_verif_noNaN(xtp(ixt,il,i),'cv3unsat 2641')
    33163316           enddo !do ixt=1,niso
    … …  
    33483348      WRITE(*,*) 'nl=',nl,'nd=',nd,'; ncum=',ncum
    33493349#ifdef ISOVERIF
    3350       do i=1,nl !nl
    3351         do il=1,ncum
     3350      DO i=1,nl !nl
     3351        DO il=1,ncum
    33523352        IF (iso_eau.gt.0) THEN
    33533353!            WRITE(*,*) 'cv30_routines 2767:i,il,lwork(il),inb(il)=',
    … …  
    35453545!       WRITE(*,*) 'cv30_routines 3082: entree dans cv3_yield'
    35463546       ! en cam debug
    3547        do ixt = 1, ntraciso
     3547       DO ixt = 1, ntraciso
    35483548        xtprecip(ixt,il)=0.0
    35493549        xtVprecip(ixt,il,nd+1)=0.0
    … …  
    35633563      nqcond(il, i) = 0.0 ! cld
    35643564#ifdef ISO
    3565          do ixt = 1, ntraciso
     3565         DO ixt = 1, ntraciso
    35663566          fxt(ixt,il,i)=0.0
    35673567          xtVprecip(ixt,il,i)=0.0
    … …  
    35743574        fq_evapprecip(il,i)=0.0
    35753575        fq_ddft(il,i)=0.0
    3576         do ixt = 1, niso
     3576        DO ixt = 1, niso
    35773577          fxt_fluxmasse(ixt,il,i)=0.0
    35783578          fxt_detrainement(ixt,il,i)=0.0
    … …  
    36103610
    36113611#ifdef ISO
    3612          do ixt = 1, ntraciso
     3612         DO ixt = 1, ntraciso
    36133613          xtprecip(ixt,il)=wt(il,1)*sigd*xtwater(ixt,il,1) &
    36143614                            *86400.*1000./(rowl*grav) ! en mm/jour
    … …  
    36483648        precip(il) = wt(il, 1)*sigd*water(il, 1)*8640.
    36493649#ifdef ISO
    3650          do ixt = 1, ntraciso
     3650         DO ixt = 1, ntraciso
    36513651          xtprecip(ixt,il)=wt(il,1)*sigd*xtwater(ixt,il,1)*8640.
    36523652         enddo
    … …  
    36773677          vprecip(il, k) = wt(il, k)*sigd*water(il, k)/grav
    36783678#ifdef ISO
    3679              do ixt=1,ntraciso
     3679             DO ixt=1,ntraciso
    36803680               xtVPrecip(ixt,il,k) = wt(il,k)*sigd &
    36813681                *xtwater(ixt,il,k)/grav
    … …  
    36853685          vprecip(il, k) = wt(il, k)*sigd*water(il, k)/10.
    36863686#ifdef ISO
    3687              do ixt=1,ntraciso
     3687             DO ixt=1,ntraciso
    36883688               xtVPrecip(ixt,il,k) = wt(il,k)*sigd &
    36893689                *xtwater(ixt,il,k)/10.0
    … …  
    37593759#ifdef ISO   
    37603760        ! juste Mp et evap pour l'instant, voir plus bas pour am
    3761        do ixt = 1, ntraciso
     3761       DO ixt = 1, ntraciso
    37623762        fxt(ixt,il,1)= &
    37633763               0.01*grav*mp(il,2)*(xtp(ixt,il,2)-xt(ixt,il,1))*work(il) &
    … …  
    37733773        fq_fluxmasse(il,1)=fq_fluxmasse(il,1) &
    37743774                 +0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)
    3775         do ixt = 1, ntraciso
     3775        DO ixt = 1, ntraciso
    37763776!        fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) &
    37773777!     &      +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) ! deplace
    … …  
    38223822             dqreste_tmp= 0.01*grav*mp(il, 2)*(rp(il,2)-rr(il,1))*work(il)*delt + &
    38233823                         sigd*0.5*(evap(il,1)+evap(il,2))*delt
    3824              do ixt = 1, ntraciso
     3824             DO ixt = 1, ntraciso
    38253825                dxreste_tmp= 0.01*grav*mp(il,2)*(xtp(ixt,il,2)-xt(ixt,il,1))*work(il)*delt &
    38263826                        +sigd*0.5*(xtevap(ixt,il,1)+xtevap(ixt,il,2))*delt
    … …  
    38563856                ! formulation habituelle qui avait toujours marche de 2006 a
    38573857                ! decembre 2017.
    3858            do ixt = 1, ntraciso     
     3858           DO ixt = 1, ntraciso
    38593859                fxt(ixt,il,1)=fxt(ixt,il,1) &
    38603860             +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il)
    … …  
    38983898#ifdef ISOTRAC
    38993899        CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3417')
    3900         do ixt=1,ntraciso
     3900        DO ixt=1,ntraciso
    39013901          xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
    39023902        enddo
    … …  
    39363936
    39373937#ifdef ISO
    3938        do ixt = 1, ntraciso
     3938       DO ixt = 1, ntraciso
    39393939       fxt(ixt,il,1)=0.1*mp(il,2)*(xtp(ixt,il,2)-xt(ixt,il,1))*work(il) &
    39403940                +sigd*0.5*(xtevap(ixt,il,1)+xtevap(ixt,il,2))
    … …  
    39503950       fq_fluxmasse(il,1)=fq_fluxmasse(il,1) &
    39513951                 +0.1*am(il)*(rr(il,2)-rr(il,1))*work(il)
    3952        do ixt = 1, niso
     3952       DO ixt = 1, niso
    39533953        fxt_fluxmasse(ixt,il,1)=fxt(ixt,il,1) &
    39543954                +0.1*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il)
    … …  
    39783978        CALL iso_verif_traceur_justmass(fxt(1,il,1), &
    39793979                 'cv30_routine 3417')
    3980         do ixt=1,ntraciso
     3980        DO ixt=1,ntraciso
    39813981          xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
    39823982        enddo
    … …  
    40274027
    40284028#ifdef ISO
    4029        do ixt = 1, ntraciso
     4029       DO ixt = 1, ntraciso
    40304030       fxt(ixt,il,1)=fxt(ixt,il,1) &
    40314031                +0.01*grav*work(il)*ment(il,j,1)*(xtent(ixt,il,j,1)-xt(ixt,il,1))
    … …  
    40394039        q_detrainement(il,1)=q_detrainement(il,1) &
    40404040                +0.01*grav*work(il)*ment(il,j,1)*qent(il,j,1)
    4041         do ixt = 1, niso
     4041        DO ixt = 1, niso
    40424042          fxt_detrainement(ixt,il,1)=fxt_detrainement(ixt,il,1) &
    40434043                +0.01*grav*work(il)*ment(il,j,1)*(xtent(ixt,il,j,1)-xt(ixt,il,1))
    … …  
    40614061#ifdef ISOTRAC
    40624062        CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3417')
    4063         do ixt=1,ntraciso
     4063        DO ixt=1,ntraciso
    40644064          xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
    40654065        enddo
    … …  
    40874087
    40884088#ifdef ISO
    4089        do ixt = 1, ntraciso
     4089       DO ixt = 1, ntraciso
    40904090       fxt(ixt,il,1)=fxt(ixt,il,1) &
    40914091       +0.1*work(il)*ment(il,j,1)*(xtent(ixt,il,j,1)-xt(ixt,il,1))
    … …  
    40994099        q_detrainement(il,1)=q_detrainement(il,1) &
    41004100               +0.1*work(il)*ment(il,j,1)*qent(il,j,1)
    4101         do ixt = 1, niso
     4101        DO ixt = 1, niso
    41024102          fxt_detrainement(ixt,il,1)=fxt_detrainement(ixt,il,1) &
    41034103                +0.1*work(il)*ment(il,j,1)*(xtent(ixt,il,j,1)-xt(ixt,il,1))
    … …  
    41214121#ifdef ISOTRAC
    41224122        CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3462')
    4123         do ixt=1,ntraciso
     4123        DO ixt=1,ntraciso
    41244124          xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
    41254125        enddo
    … …  
    42694269        k_tmp=0.01*grav*dpinv*amp1(il)*delt
    42704270        kad_tmp=0.01*grav*dpinv*ad(il)*delt
    4271         do ixt = 1, ntraciso
     4271        DO ixt = 1, ntraciso
    42724272            R_tmp=(xt(ixt,il,i)+k_tmp*xt(ixt,il,i+1)+kad_tmp*xt(ixt,il,i-1)) &
    42734273                  /(rr(il,i)+k_tmp*rr(il,i+1)+kad_tmp*rr(il,i-1))
    … …  
    42924292        enddo ! do ixt = 1, ntraciso 
    42934293#ifdef DIAGISO
    4294         do ixt = 1, niso
     4294        DO ixt = 1, niso
    42954295                fxt_fluxmasse(ixt,il,i)=fxt(ixt,il,i)
    42964296        enddo
    … …  
    42984298       else !if (dq_tmp/rr(il,i).lt.-0.9) THEN
    42994299        ! ancienne formulation
    4300          do ixt = 1, ntraciso
     4300         DO ixt = 1, ntraciso
    43014301         fxt(ixt,il,i)= &
    43024302                0.01*grav*dpinv*(amp1(il)*(xt(ixt,il,i+1)-xt(ixt,il,i)) &
    … …  
    43044304         enddo
    43054305#ifdef DIAGISO
    4306         do ixt = 1, niso
     4306        DO ixt = 1, niso
    43074307           fxt_fluxmasse(ixt,il,i)=fxt_fluxmasse(ixt,il,i)+ &
    43084308                0.01*grav*dpinv*(amp1(il)*(xt(ixt,il,i+1)-xt(ixt,il,i)) &
    … …  
    43174317                 fr(il,i),'cv30_routines 3226',errmax,errmaxrel)
    43184318        endif !if (iso_eau.gt.0) THEN
    4319         do ixt=1,niso
     4319        DO ixt=1,niso
    43204320            CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3229')
    43214321        enddo
    … …  
    43364336#ifdef ISOTRAC
    43374337        CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3626')
    4338         do ixt=1,ntraciso
     4338        DO ixt=1,ntraciso
    43394339          xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
    43404340        enddo
    … …  
    43634363
    43644364#ifdef ISO
    4365        do ixt = 1, ntraciso
     4365       DO ixt = 1, ntraciso
    43664366       fxt(ixt,il,i)= &
    43674367         0.1*dpinv*(amp1(il)*(xt(ixt,il,i+1)-xt(ixt,il,i)) &
    … …  
    43734373                 +0.1*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i)) &
    43744374                 -ad(il)*(rr(il,i)-rr(il,i-1)))
    4375         do ixt = 1, niso
     4375        DO ixt = 1, niso
    43764376        fxt_fluxmasse(ixt,il,i)=fxt_fluxmasse(ixt,il,i)+ &
    43774377         0.1*dpinv*(amp1(il)*(xt(ixt,il,i+1)-xt(ixt,il,i)) &
    … …  
    43864386                 fr(il,i),'cv30_routines 3252',errmax,errmaxrel)
    43874387          endif !if (iso_eau.gt.0) THEN
    4388           do ixt=1,niso
     4388          DO ixt=1,niso
    43894389            CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3229')
    43904390          enddo
    … …  
    44064406#ifdef ISOTRAC
    44074407        CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3674')
    4408         do ixt=1,ntraciso
     4408        DO ixt=1,ntraciso
    44094409          xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
    44104410        enddo
    … …  
    44604460        ! d'ou le nouveau traitement ci-dessous.
    44614461      IF (elij(il,k,i).gt.0.0) THEN
    4462         do ixt = 1, ntraciso
     4462        DO ixt = 1, ntraciso
    44634463          xtawat(ixt)=awat*(xtelij(ixt,il,k,i)/elij(il,k,i))
    44644464!          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
    … …  
    44704470        CALL iso_verif_egalite(awat,0.0,'cv30_yield 3779')
    44714471#endif
    4472         do ixt = 1, ntraciso
     4472        DO ixt = 1, ntraciso
    44734473          xtawat(ixt)=0.0
    44744474        enddo       
    … …  
    44974497
    44984498#ifdef ISO
    4499       do ixt = 1, ntraciso
     4499      DO ixt = 1, ntraciso
    45004500      fxt(ixt,il,i)=fxt(ixt,il,i) &
    45014501            +0.01*grav*dpinv*ment(il,k,i) &
    … …  
    45114511        q_detrainement(il,i)=q_detrainement(il,i) &
    45124512                +0.01*grav*dpinv*ment(il,k,i)*qent(il,k,i)
    4513         do ixt = 1, niso
     4513        DO ixt = 1, niso
    45144514        fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
    45154515                +0.01*grav*dpinv*ment(il,k,i) &
    … …  
    45254525                 fr(il,i),'cv30_routines 3325',errmax,errmaxrel)
    45264526        endif !if (iso_eau.gt.0) THEN
    4527         do ixt=1,niso
     4527        DO ixt=1,niso
    45284528            CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3328')
    45294529        enddo
    … …  
    45674567#ifdef ISOTRAC
    45684568        CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3784')
    4569         do ixt=1,ntraciso
     4569        DO ixt=1,ntraciso
    45704570          xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
    45714571        enddo
    … …  
    45874587
    45884588#ifdef ISO
    4589       do ixt = 1, ntraciso
     4589      DO ixt = 1, ntraciso
    45904590      fxt(ixt,il,i)=fxt(ixt,il,i) &
    45914591            +0.1*dpinv*ment(il,k,i) &
    … …  
    46004600        q_detrainement(il,i)=q_detrainement(il,i) &
    46014601                +0.1*dpinv*ment(il,k,i)*qent(il,k,i)
    4602        do ixt = 1, niso
     4602       DO ixt = 1, niso
    46034603        fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
    46044604            +0.1*dpinv*ment(il,k,i) &
    … …  
    46154615                 fr(il,i),'cv30_routines 3350',errmax,errmaxrel)
    46164616        endif !if (iso_eau.gt.0) THEN
    4617         do ixt=1,niso
     4617        DO ixt=1,niso
    46184618            CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3353')
    46194619        enddo
    … …  
    46334633#ifdef ISOTRAC
    46344634        CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3828')
    4635         do ixt=1,ntraciso
     4635        DO ixt=1,ntraciso
    46364636          xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
    46374637        enddo
    … …  
    46874687              ,i)-v(il,i))
    46884688#ifdef ISO
    4689        do ixt = 1, ntraciso
     4689       DO ixt = 1, ntraciso
    46904690        fxt(ixt,il,i)=fxt(ixt,il,i) &
    46914691                +0.01*grav*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
    … …  
    46994699       q_detrainement(il,i)=q_detrainement(il,i) &
    47004700               +0.01*grav*dpinv*ment(il,k,i)*qent(il,k,i)
    4701        do ixt = 1, niso
     4701       DO ixt = 1, niso
    47024702        fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
    47034703         +0.01*grav*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
    … …  
    47144714                WRITE(*,*) 'q,qe=',rr(il,i),qent(il,k,i)
    47154715                bx=0.01*grav*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))
    4716                 do ixt=1,niso
     4716                DO ixt=1,niso
    47174717                 xtbx(ixt)=0.01*grav*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
    47184718                enddo
    47194719        endif
    4720         do ixt=1,niso
     4720        DO ixt=1,niso
    47214721           CALL iso_verif_noNaN(fxt(ixt,il,i),'cv30_yield 4351')
    47224722        enddo   
    … …  
    47274727                 fr(il,i),'cv30_routines 3408',errmax,errmaxrel)
    47284728        endif !if (iso_eau.gt.0) THEN
    4729         do ixt=1,niso
     4729        DO ixt=1,niso
    47304730            CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3411')
    47314731        enddo
    … …  
    47674767#ifdef ISOTRAC
    47684768        CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3921')
    4769         do ixt=1,ntraciso
     4769        DO ixt=1,ntraciso
    47704770          xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
    47714771        enddo
    … …  
    47884788
    47894789#ifdef ISO
    4790        do ixt = 1, ntraciso
     4790       DO ixt = 1, ntraciso
    47914791        fxt(ixt,il,i)=fxt(ixt,il,i) &
    47924792         +0.1*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
    … …  
    48004800       q_detrainement(il,i)=q_detrainement(il,i) &
    48014801               +0.1*dpinv*ment(il,k,i)*qent(il,k,i)
    4802        do ixt = 1, niso
     4802       DO ixt = 1, niso
    48034803        fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) &
    48044804         +0.1*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))
    … …  
    48194819                 fr(il,i),'cv30_routines 3433',errmax,errmaxrel)
    48204820          endif !if (iso_eau.gt.0) THEN
    4821           do ixt=1,niso
     4821          DO ixt=1,niso
    48224822            CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3436')
    48234823          enddo
    … …  
    48384838#ifdef ISOTRAC
    48394839        CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3972')
    4840         do ixt=1,ntraciso
     4840        DO ixt=1,ntraciso
    48414841          xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
    48424842        enddo
    … …  
    48904890            i))-mp(il,i)*(vp(il,i)-v(il,i-1)))*dpinv
    48914891#ifdef ISO
    4892         do ixt = 1, niso
     4892        DO ixt = 1, niso
    48934893        fxt(ixt,il,i)=fxt(ixt,il,i) &
    48944894                +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1)) &
    … …  
    49044904              +0.01*grav*(mp(il,i+1)*(rp(il,i+1)-rr(il,i))-mp(il,i) &
    49054905                     *(rp(il,i)-rr(il,i-1)))*dpinv
    4906        do ixt = 1, niso
     4906       DO ixt = 1, niso
    49074907        fxt_evapprecip(ixt,il,i)=fxt_evapprecip(ixt,il,i) &
    49084908         +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
    … …  
    49144914
    49154915#ifdef ISOVERIF
    4916         do ixt=1,niso
     4916        DO ixt=1,niso
    49174917           CALL iso_verif_noNaN(xt(ixt,il,i),'cv30_yield 4514')
    49184918           CALL iso_verif_noNaN(fxt(ixt,il,i),'cv30_yield 4515')
    … …  
    49854985        IF ((option_traceurs.NE.6).AND.(option_traceurs.NE.19)) THEN
    49864986            ! facile: on fait comme l'eau
    4987             do ixt = 1+niso,ntraciso
     4987            DO ixt = 1+niso,ntraciso
    49884988             fxt(ixt,il,i)=fxt(ixt,il,i) &
    49894989                +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1)) &
    … …  
    50135013
    50145014        ! ajout deja de l'evap
    5015         do ixt = 1+niso,ntraciso
     5015        DO ixt = 1+niso,ntraciso
    50165016             fxt(ixt,il,i)=fxt(ixt,il,i) &
    50175017                +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
    … …  
    50225022
    50235023        IF (option_traceurs.EQ.6) THEN
    5024           do iiso = 1, niso
     5024          DO iiso = 1, niso
    50255025             
    50265026             ixt_ddft=itZonIso(izone_ddft,iiso) 
    … …  
    50475047                ! cas entrainant: faire attention
    50485048               
    5049                 do iiso = 1, niso
     5049                DO iiso = 1, niso
    50505050                fxtqe(iiso)=0.01*grav*dpinv* &
    50515051                    (mp(il,i+1)*(xtp(iiso,il,i+1)-xt(iiso,il,i)) &
    … …  
    50685068                         -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i)
    50695069                IF (Xe(iiso).gt.ridicule) THEN
    5070                   do izone=1,nzone
     5070                  DO izone=1,nzone
    50715071                   IF ((izone.NE.izone_revap).AND. &
    50725072                         (izone.NE.izone_ddft)) THEN
    … …  
    50975097                endif
    50985098#endif                   
    5099                 do izone=1,nzone
     5099                DO izone=1,nzone
    51005100                   IF ((izone.NE.izone_revap).AND. &
    51015101                         (izone.NE.izone_ddft)) THEN
    … …  
    51185118            else !if (mp(il,i).gt.mp(il,i+1)) THEN
    51195119                ! cas detrainant: pas de problemes
    5120                 do ixt=1+niso,ntraciso
     5120                DO ixt=1+niso,ntraciso
    51215121                fxt(ixt,il,i)=fxt(ixt,il,i) &
    51225122                        +0.01*grav*(mp(il,i+1)*(xtp(ixt,il,i+1)-xt(ixt,il,i)) &
    … …  
    51385138        ! cam verif
    51395139#ifdef ISOVERIF
    5140           do ixt=1,niso
     5140          DO ixt=1,niso
    51415141            CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3496')
    51425142          enddo
    … …  
    51915191!        WRITE(*,*) 'tmp cv3_yield 4224: i,il=',i,il
    51925192        CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 4107')
    5193         do ixt=1,ntraciso
     5193        DO ixt=1,ntraciso
    51945194          xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i)
    51955195        enddo
    … …  
    52255225            i))-mp(il,i)*(vp(il,i)-v(il,i-1)))*dpinv
    52265226#ifdef ISO
    5227         do ixt = 1, ntraciso
     5227        DO ixt = 1, ntraciso
    52285228        fxt(ixt,il,i)=fxt(ixt,il,i) &
    52295229         +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1)) &
    … …  
    52355235        IF (option_traceurs.NE.6) THEN
    52365236            ! facile: on fait comme l'eau
    5237             do ixt = 1+niso,ntraciso
     5237            DO ixt = 1+niso,ntraciso
    52385238             fxt(ixt,il,i)=fxt(ixt,il,i) &
    52395239                +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1)) &
    … …  
    52445244        else  !if (option_traceurs.NE.6) THEN
    52455245            ! taggage des ddfts:  voir blabla + haut
    5246         do ixt = 1+niso,ntraciso
     5246        DO ixt = 1+niso,ntraciso
    52475247             fxt(ixt,il,i)=fxt(ixt,il,i) &
    52485248                +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
    … …  
    52555255!        WRITE(*,*) 'delt*fxt(ixt_ddft,il,i)=',delt*fxt(ixt_ddft,il,i)
    52565256!        WRITE(*,*) 'xt(iso_eau,il,i)=',xt(iso_eau,il,i)
    5257           do iiso = 1, niso
     5257          DO iiso = 1, niso
    52585258             ixt_poubelle=itZonIso(izone_poubelle,iiso)
    52595259             ixt_ddft=itZonIso(izone_ddft,iiso) 
    … …  
    52855285              +0.1*(mp(il,i+1)*(rp(il,i+1)-rr(il,i))-mp(il,i) &
    52865286                     *(rp(il,i)-rr(il,i-1)))*dpinv
    5287        do ixt = 1, niso
     5287       DO ixt = 1, niso
    52885288        fxt_evapprecip(ixt,il,i)=fxt_evapprecip(ixt,il,i) &
    52895289         +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
    … …  
    52975297
    52985298#ifdef ISOVERIF
    5299        do ixt=1,niso
     5299       DO ixt=1,niso
    53005300        CALL iso_verif_noNaN(fxt(ixt,il,i),'cv30_yield 5083')
    53015301       enddo
    … …  
    53295329#ifdef ISOTRAC
    53305330        CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 4172')
    5331         do ixt=1,ntraciso
     5331        DO ixt=1,ntraciso
    53325332          xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1)
    53335333        enddo
    … …  
    54315431     
    54325432#ifdef ISO
    5433       do ixt = 1, ntraciso
     5433      DO ixt = 1, ntraciso
    54345434       xtbx(ixt)=0.01*grav*ment(il,inb(il),inb(il)) &
    54355435          *(xtent(ixt,il,inb(il),inb(il)) &
    … …  
    54725472     
    54735473#ifdef ISO
    5474       do ixt = 1, ntraciso
     5474      DO ixt = 1, ntraciso
    54755475       xtbx(ixt)=0.1*ment(il,inb(il),inb(il)) &
    54765476          *(xtent(ixt,il,inb(il),inb(il)) &
    … …  
    54925492         +bx*(ph(il,inb(il))-ph(il,inb(il)+1)) &
    54935493            /(ph(il,inb(il)-1)-ph(il,inb(il)))
    5494        do ixt = 1, niso
     5494       DO ixt = 1, niso
    54955495        fxt_detrainement(ixt,il,inb(il))= &
    54965496                 fxt_detrainement(ixt,il,inb(il))-xtbx(ixt)
    … …  
    55035503      ! cam verif
    55045504#ifdef ISOVERIF
    5505        do ixt=1,niso
     5505       DO ixt=1,niso
    55065506        CALL iso_verif_noNaN(fxt(ixt,il,inb(il)),'cv30_yield 5083')
    55075507       enddo
    … …  
    55605560        CALL iso_verif_traceur_justmass(fxt(1,il,inb(il)), &
    55615561                 'cv30_routine 4364b')
    5562         do ixt=1,ntraciso
     5562        DO ixt=1,ntraciso
    55635563          xtnew(ixt)=xt(ixt,il,inb(il))+delt*fxt(ixt,il,inb(il))
    55645564        enddo
    … …  
    55985598#ifdef ISO
    55995599        frsum(il)=0.0
    5600         do ixt=1,ntraciso
     5600        DO ixt=1,ntraciso
    56015601          fxtsum(ixt,il)=0.0
    56025602          bxtsum(ixt,il)=0.0
    … …  
    56175617       
    56185618      frsum(il)=frsum(il)+fr(il,i)
    5619       do ixt=1,ntraciso
     5619      DO ixt=1,ntraciso
    56205620        fxtsum(ixt,il)=fxtsum(ixt,il)+fxt(ixt,il,i)
    56215621        bxtsum(ixt,il)=bxtsum(ixt,il)+fxt(ixt,il,i) &
    … …  
    56365636#ifdef ISO
    56375637        IF (abs(csum(il)).gt.0.0) THEN
    5638           do ixt=1,ntraciso
     5638          DO ixt=1,ntraciso
    56395639            fxt(ixt,il,i)=bxtsum(ixt,il)/csum(il)           
    56405640          enddo
    56415641        else !if (frsum(il).gt.ridicule) THEN
    56425642           IF (abs(frsum(il)).gt.0.0) THEN
    5643             do ixt=1,ntraciso
     5643            DO ixt=1,ntraciso
    56445644             fxt(ixt,il,i)=fr(il,i)*fxtsum(ixt,il)/frsum(il)       
    56455645            enddo
    … …  
    56495649               stop
    56505650             else !if (abs(fr(il,i))*delt.gt.ridicule) THEN
    5651                do ixt=1,ntraciso
     5651               DO ixt=1,ntraciso
    56525652                 fxt(ixt,il,i)=0.0
    56535653               enddo
    … …  
    56665666#ifdef ISO
    56675667#ifdef ISOVERIF
    5668         do i=1,nl
    5669           do il=1,ncum
    5670            do ixt=1,ntraciso
     5668        DO i=1,nl
     5669          DO il=1,ncum
     5670           DO ixt=1,ntraciso
    56715671            CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_yield 3826')
    56725672           enddo
    … …  
    56755675#endif               
    56765676#ifdef ISOVERIF
    5677           do i=1,nl
     5677          DO i=1,nl
    56785678!             WRITE(*,*) 'cv30_routines temp 3967: i=',i
    5679              do il=1,ncum
     5679             DO il=1,ncum
    56805680!                WRITE(*,*) 'cv30_routines 3969: il=',il
    56815681!                WRITE(*,*) 'cv30_routines temp 3967: il,i,inb(il),ncum=',
    … …  
    57375737#ifdef ISOVERIF
    57385738        ! verif finale des tendances:
    5739           do i=1,nl
    5740              do il=1,ncum
     5739          DO i=1,nl
     5740             DO il=1,ncum
    57415741                IF (iso_eau.gt.0) THEN
    57425742                  CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), &
    … …  
    62466246    epmax_diag1(idcum(i))=epmax_diag(i) ! epmax_cape
    62476247#ifdef ISO
    6248          do ixt = 1, ntraciso
     6248         DO ixt = 1, ntraciso
    62496249          xtprecip1(ixt,idcum(i))=xtprecip(ixt,i)
    62506250         enddo
    … …  
    62796279      ! RomP <<<
    62806280#ifdef ISO
    6281             do ixt = 1, ntraciso
     6281            DO ixt = 1, ntraciso
    62826282             fxt1(ixt,idcum(i),k)=fxt(ixt,i,k)
    62836283             xtVPrecip1(ixt,idcum(i),k)=xtVPrecip(ixt,i,k)
    … …  
    62996299#ifdef ISO
    63006300#ifdef DIAGISO
    6301         do k=1,nl
    6302           do i=1,ncum   
     6301        DO k=1,nl
     6302          DO i=1,ncum
    63036303            water1(idcum(i),k)=water(i,k)
    63046304            qp1(idcum(i),k)=qp(i,k)
    … …  
    63106310            fq_evapprecip1(idcum(i),k)=fq_evapprecip(i,k)
    63116311            fq_fluxmasse1(idcum(i),k)=fq_fluxmasse(i,k)
    6312             do ixt = 1, ntraciso
     6312            DO ixt = 1, ntraciso
    63136313             xtwater1(ixt,idcum(i),k)=xtwater(ixt,i,k)
    63146314             xtp1(ixt,idcum(i),k)=xtp(ixt,i,k)
    … …  
    63216321           enddo
    63226322         enddo
    6323          do i=1,ncum   
     6323         DO i=1,ncum
    63246324            epmax_diag1(idcum(i))=epmax_diag(i)
    63256325         enddo
    … …  
    63846384       
    63856385        IF (coef_epmax_cape.gt.1e-12) THEN
    6386         do i=1,ncum
     6386        DO i=1,ncum
    63876387           epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
    6388            do k=1,nl
     6388           DO k=1,nl
    63896389                ep(i,k)=ep(i,k)/epmax*epmax_diag(i)
    63906390                ep(i,k)=amax1(ep(i,k),0.0)
    … …  
    63946394
    63956395! On recalcule hp:
    6396       do k=1,nl
    6397         do i=1,ncum
    6398           hp_bak(i,k)=hp(i,k)
    6399         enddo
     6396      DO k=1,nl
     6397        DO i=1,ncum
     6398      hp_bak(i,k)=hp(i,k)
     6399    enddo
    64006400      enddo
    6401       do k=1,nlp
    6402         do i=1,ncum
    6403           hp(i,k)=h(i,k)
    6404         enddo
     6401      DO k=1,nlp
     6402        DO i=1,ncum
     6403      hp(i,k)=h(i,k)
     6404    enddo
    64056405      enddo
    6406       do k=minorig+1,nl
    6407        do i=1,ncum
     6406      DO k=minorig+1,nl
     6407       DO i=1,ncum
    64086408        IF((k.ge.icb(i)).AND.(k.le.inb(i)))THEN
    64096409          hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
    … …  
    64126412      enddo !do k=minorig+1,n
    64136413!     WRITE(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
    6414       do i=1,ncum 
    6415        do k=1,nl
     6414      DO i=1,ncum
     6415       DO k=1,nl
    64166416        IF (abs(hp_bak(i,k)-hp(i,k)).gt.0.01) THEN
    64176417           WRITE(*,*) 'i,k=',i,k
Note: See TracChangeset for help on using the changeset viewer.