Changeset 4050


Ignore:
Timestamp:
Dec 23, 2021, 6:54:17 PM (2 years ago)
Author:
dcugnet
Message:

Second commit for new tracers.

  • include most of the keys in the tracers descriptor vector "tracers(:)".
  • fix in phylmdiso/cv3_routines: fq_* variables were used where their fxt_* counterparts were expected.
  • multiple IF(nqdesc(iq)>0) and IF(nqfils(iq)>0) tests suppressed, because they are not needed: "do ... enddo" loops with 0 upper bound are not executed.
  • remove French accents from comments (encoding problem) in phylmdiso/cv3_routines and phylmdiso/cv30_routines.
  • modifications in "isotopes_verif_mod", where the call to function "iso_verif_tag17_q_deltad_chn" in "iso_verif_tag17_q_deltad_chn" was not detected at linking stage, although defined in the same module (?).
Location:
LMDZ6/trunk/libf
Files:
38 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/advtrac.F90

    r2622 r4050  
    99  !            M.A Filiberti (04/2002)
    1010  !
    11   USE infotrac, ONLY: nqtot, iadv,nqperes,ok_iso_verif
     11  USE infotrac, ONLY: nqtot, tracers, nqperes,ok_iso_verif
    1212  USE control_mod, ONLY: iapp_tracvl, day_step
    1313  USE comconst_mod, ONLY: dtvr
    … …  
    7272  real cflz(ip1jmp1,llm)
    7373  real, save :: cflxmax(llm),cflymax(llm),cflzmax(llm)
     74  INTEGER :: iadv
    7475
    7576  IF(iadvtr.EQ.0) THEN
    … …  
    226227     do iq=1,nqperes
    227228        !        call clock(t_initial)
    228         if(iadv(iq) == 0) cycle
     229       iadv = tracers(iq)%iadv
     230       SELECT CASE(iadv)
     231         CASE(0); CYCLE
     232         CASE(10)
    229233        !   ----------------------------------------------------------------
    230234        !   Schema de Van Leer I MUSCL
    231235        !   ----------------------------------------------------------------
    232         if(iadv(iq).eq.10) THEN
    233236           ! CRisi: on fait passer tout q pour avoir acces aux fils
    234237           
    … …  
    236239           call vlsplt(q,2.,massem,wg,pbarug,pbarvg,dtvr,iq)
    237240           
     241         CASE(14)
    238242           !   ----------------------------------------------------------------
    239243           !   Schema "pseudo amont" + test sur humidite specifique
    240244           !    pour la vapeur d'eau. F. Codron
    241245           !   ----------------------------------------------------------------
    242         else if(iadv(iq).eq.14) then
    243246           !
    244247           !write(*,*) 'advtrac 248: iq,q(1721,19,:)=',iq,q(1721,19,:)
    … …  
    246249                pbarug,pbarvg,dtvr,p,pk,teta,iq)
    247250           
     251         CASE(12)
    248252           !   ----------------------------------------------------------------
    249253           !   Schema de Frederic Hourdin
    250254           !   ----------------------------------------------------------------
    251         else if(iadv(iq).eq.12) then
    252255           !            Pas de temps adaptatif
    253            call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
     256           call adaptdt(iadv,dtbon,n,pbarug,massem)
    254257           if (n.GT.1) then
    255258              write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=', &
    … …  
    259262              call advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,1)
    260263           end do
    261         else if(iadv(iq).eq.13) then
     264         CASE(13)
    262265           !            Pas de temps adaptatif
    263            call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
     266           call adaptdt(iadv,dtbon,n,pbarug,massem)
    264267           if (n.GT.1) then
    265268              write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=', &
    … …  
    269272              call advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,2)
    270273           end do
     274         CASE(20)
    271275           !   ----------------------------------------------------------------
    272276           !   Schema de pente SLOPES
    273277           !   ----------------------------------------------------------------
    274         else if (iadv(iq).eq.20) then
    275278           call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0)
    276279
     280         CASE(30)
    277281           !   ----------------------------------------------------------------
    278282           !   Schema de Prather
    279283           !   ----------------------------------------------------------------
    280         else if (iadv(iq).eq.30) then
    281284           !            Pas de temps adaptatif
    282            call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
     285           call adaptdt(iadv,dtbon,n,pbarug,massem)
    283286           if (n.GT.1) then
    284287              write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=', &
    … …  
    288291                n,dtbon)
    289292
     293         CASE(11,16,17,18)
    290294           !   ----------------------------------------------------------------
    291295           !   Schemas PPM Lin et Rood
    292296           !   ----------------------------------------------------------------
    293         else if (iadv(iq).eq.11.OR.(iadv(iq).GE.16.AND. &
    294              iadv(iq).LE.18)) then
    295297
    296298           !        Test sur le flux horizontal
    297299           !        Pas de temps adaptatif
    298            call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
     300           call adaptdt(iadv,dtbon,n,pbarug,massem)
    299301           if (n.GT.1) then
    300302              write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=', &
    … …  
    316318
    317319           !-----------------------------------------------------------
    318            !        Ss-prg interface LMDZ.4->PPM3d
     320           !        Ss-prg interface LMDZ.4->PPM3d (ss-prg de Lin)
    319321           !-----------------------------------------------------------
    320322
    … …  
    327329              !                         VL (version PPM) horiz. et PPM vert.
    328330              !----------------------------------------------------------------
    329               if (iadv(iq).eq.11) then
    330                  !                  Ss-prg PPM3d de Lin
     331             SELECT CASE(iadv)
     332               CASE(11)
    331333                 call ppm3d(1,qppm(1,1,iq), &
    332334                      psppm,psppm, &
    … …  
    335337                      fill,dum,220.)
    336338
     339               CASE(16)
    337340                 !-------------------------------------------------------------
    338341                 !                           Monotonic PPM
    339342                 !-------------------------------------------------------------
    340               else if (iadv(iq).eq.16) then
    341                  !                  Ss-prg PPM3d de Lin
    342343                 call ppm3d(1,qppm(1,1,iq), &
    343344                      psppm,psppm, &
    … …  
    347348                 !-------------------------------------------------------------
    348349
     350               CASE(17)
    349351                 !-------------------------------------------------------------
    350352                 !                           Semi Monotonic PPM
    351353                 !-------------------------------------------------------------
    352               else if (iadv(iq).eq.17) then
    353                  !                  Ss-prg PPM3d de Lin
    354354                 call ppm3d(1,qppm(1,1,iq), &
    355355                      psppm,psppm, &
    … …  
    359359                 !-------------------------------------------------------------
    360360
     361               CASE(18)
    361362                 !-------------------------------------------------------------
    362363                 !                         Positive Definite PPM
    363364                 !-------------------------------------------------------------
    364               else if (iadv(iq).eq.18) then
    365                  !                  Ss-prg PPM3d de Lin
    366365                 call ppm3d(1,qppm(1,1,iq), &
    367366                      psppm,psppm, &
    … …  
    370369                      fill,dum,220.)
    371370                 !-------------------------------------------------------------
    372               endif
     371             END SELECT
    373372           enddo
    374373           !-----------------------------------------------------------------
    … …  
    376375           !-----------------------------------------------------------------
    377376           call interpost(q(1,1,iq),qppm(1,1,iq))
    378         endif
     377         END SELECT
    379378        !----------------------------------------------------------------------
    380379

  • LMDZ6/trunk/libf/dyn3d/check_isotopes.F

    r4037 r4050  
    11        subroutine check_isotopes_seq(q,ip1jmp1,err_msg)
    2         USE infotrac
     2        USE infotrac, ONLY: nqtot, nqo, niso, ntraciso, ntraceurs_zone,
     3     &                     ok_isotopes, ok_isotrac, use_iso,
     4     &                     iqiso, index_trac,indnum_fn_num, tnat
    35        implicit none
    46

  • LMDZ6/trunk/libf/dyn3d/dynetat0.f90

    r4046 r4050  
    66! Purpose: Initial state reading.
    77!-------------------------------------------------------------------------------
    8   USE infotrac
     8  USE infotrac,    ONLY: nqtot, tracers, iqiso, iso_indnum, tnat, alpha_ideal, &
     9                         ok_isotopes, maxlen
    910  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, &
    1011                         NF90_CLOSE, NF90_GET_VAR
    1112  USE control_mod, ONLY: planet_type
    12   USE strings_mod, ONLY: maxlen
    1313  USE assert_eq_m, ONLY: assert_eq
    1414  USE comvert_mod, ONLY: pa,preff
    … …  
    3939  CHARACTER(LEN=maxlen) :: msg, var, modname
    4040  INTEGER, PARAMETER :: length=100
    41   INTEGER :: iq, fID, vID, idecal!, iml, jml, lml, nqt
     41  INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase
    4242  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
    4343!-------------------------------------------------------------------------------
    … …  
    135135    q(:,:,:,iq)=0.
    136136   !--- CRisi: for isotops, theoretical initialization using very simplified
    137    !           Rayleigh distillation las.
    138     IF(ok_isotopes.AND.iso_num(iq)>0) THEN
    139       IF(zone_num(iq)==0) q(:,:,:,iq)=q(:,:,:,iqpere(iq))*tnat(iso_num(iq))    &
    140      &             *(q(:,:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
    141       IF(zone_num(iq)==1) q(:,:,:,iq)=q(:,:,:,iqiso(iso_indnum(iq),phase_num(iq)))
     137   !           Rayleigh distillation law.
     138    iName = tracers(iq)%iso_iName
     139    iZone = tracers(iq)%iso_iZone
     140    iPhase= tracers(iq)%iso_iPhase
     141    iqParent = tracers(iq)%iqParent
     142    IF(ok_isotopes .AND. iName>0) THEN
     143      IF(iZone==0) q(:,:,:,iq) = q(:,:,:,iqParent)*tnat(iName)    &
     144                               *(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
     145      IF(iZone==1) q(:,:,:,iq) = q(:,:,:,iqiso(iso_indnum(iq),iPhase))
    142146    END IF
    143147  END DO

  • LMDZ6/trunk/libf/dyn3d/dynredem.F90

    r4046 r4050  
    77  USE IOIPSL
    88#endif
    9   USE infotrac
     9  USE infotrac, ONLY: nqtot, tracers, maxlen
    1010  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
    1111                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER,   &
    1212                    NF90_64BIT_OFFSET
    1313  USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil
    14   USE strings_mod, ONLY: maxlen
    1514  USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, &
    1615                              nivsig,nivsigs
    … …  
    167166! Purpose: Write the NetCDF restart file (append).
    168167!-------------------------------------------------------------------------------
    169   USE infotrac
     168  USE infotrac, ONLY: nqtot, tracers, type_trac, maxlen
    170169  USE control_mod
    171170  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &

  • LMDZ6/trunk/libf/dyn3d/iniacademic.F90

    r3976 r4050  
    55
    66  USE filtreg_mod, ONLY: inifilr
    7   USE infotrac
     7  USE infotrac,    ONLY: nqtot,niso_possibles,ok_isotopes,ok_iso_verif,tnat,alpha_ideal, &
     8        & iqiso,iso_indnum, tracers
    89  USE control_mod, ONLY: day_step,planet_type
    910#ifdef CPP_IOIPSL
    … …  
    6162  real tetastrat ! potential temperature in the stratosphere, in K
    6263  real tetajl(jjp1,llm)
    63   INTEGER i,j,l,lsup,ij
     64  INTEGER i,j,l,lsup,ij, iq
    6465
    6566  REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
    … …  
    7071
    7172  real zz,ran1
    72   integer idum
     73  integer idum, iqParent, iName, iZone, iPhase
    7374
    7475  REAL zdtvr
    … …  
    275276        if (planet_type=="earth") then
    276277           ! Earth: first two tracers will be water
    277            do i=1,nqtot
    278               if (i == 1) q(:,:,i)=1.e-10
    279               if (i == 2) q(:,:,i)=1.e-15
    280               if (i.gt.2) q(:,:,i)=0.
     278           do iq=1,nqtot
     279              q(:,:,iq)=0.
     280              IF(tracers(iq)%name == 'H2Ov') q(:,:,iq)=1.e-10
     281              IF(tracers(iq)%name == 'H2Ol') q(:,:,iq)=1.e-15
    281282
    282283              ! CRisi: init des isotopes
    283284              ! distill de Rayleigh très simplifiée
    284               if (ok_isotopes) then
    285                 if ((iso_num(i).gt.0).and.(zone_num(i).eq.0)) then         
    286                    q(:,:,i)=q(:,:,iqpere(i))             &
    287       &                  *tnat(iso_num(i))               &
    288       &                  *(q(:,:,iqpere(i))/30.e-3)      &
    289       &                  **(alpha_ideal(iso_num(i))-1)
    290                 endif               
    291                 if ((iso_num(i).gt.0).and.(zone_num(i).eq.1)) then
    292                   q(:,:,i)=q(:,:,iqiso(iso_indnum(i),phase_num(i)))
    293                 endif
     285              iName = tracers(iq)%iso_iName
     286              iZone = tracers(iq)%iso_iZone
     287              iPhase= tracers(iq)%iso_iPhase
     288              iqParent = tracers(iq)%iqParent
     289              if (ok_isotopes .AND. iName > 0) then
     290                if (iZone == 0) q(:,:,iq) = q(:,:,iqParent)*tnat(iName) &
     291                                          *(q(:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1)
     292                if (iZone == 1) q(:,:,iq) = q(:,:,iqiso(iso_indnum(iq),iPhase))
    294293              endif !if (ok_isotopes) then
    295294

  • LMDZ6/trunk/libf/dyn3d/vlsplt.F

    r4008 r4050  
    44
    55      SUBROUTINE vlsplt(q,pente_max,masse,w,pbaru,pbarv,pdt,iq)
    6       USE infotrac, ONLY: nqtot,nqdesc,iqfils
     6      USE infotrac, ONLY: nqtot,tracers
    77c
    88c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    8383      CALL SCOPY(ijp1llm,masse,1,zm(1,1,iq),1)
    8484       
    85       if (nqdesc(iq).gt.0) then 
    86         do ifils=1,nqdesc(iq)
    87           iq2=iqfils(ifils,iq)
    88           CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1)
    89         enddo 
    90       endif !if (nqfils(iq).gt.0) then
     85      do ifils=1,tracers(iq)%nqDescen
     86        iq2=tracers(iq)%iqDescen(ifils)
     87        CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1)
     88      enddo 
    9189
    9290cprint*,'Entree vlx1'
    … …  
    122120      ENDDO
    123121      ! CRisi: aussi pour les fils
    124       if (nqdesc(iq).gt.0) then
    125       do ifils=1,nqdesc(iq)
    126         iq2=iqfils(ifils,iq)
     122      do ifils=1,tracers(iq)%nqDescen
     123        iq2=tracers(iq)%iqDescen(ifils)
    127124        DO l=1,llm
    128          DO ij=1,ip1jmp1
    129            q(ij,l,iq2)=zq(ij,l,iq2)
    130          ENDDO
    131          DO ij=1,ip1jm+1,iip1
     125          DO ij=1,ip1jmp1
     126            q(ij,l,iq2)=zq(ij,l,iq2)
     127          ENDDO
     128          DO ij=1,ip1jm+1,iip1
    132129            q(ij+iim,l,iq2)=q(ij,l,iq2)
    133          ENDDO
     130          ENDDO
    134131        ENDDO
    135       enddo !do ifils=1,nqdesc(iq)   
    136       endif ! if (nqdesc(iq).gt.0) then   
     132      enddo
    137133
    138134      RETURN
    139135      END
    140136      RECURSIVE SUBROUTINE vlx(q,pente_max,masse,u_m,iq)
    141       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     137      USE infotrac, ONLY : nqtot,tracers, ! CRisi
    142138     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    143139
    … …  
    449445! CRisi: appel récursif de l'advection sur les fils.
    450446! Il faut faire ça avant d'avoir mis à jour q et masse
    451       !write(*,*) 'vlsplt 326: iq,nqfils(iq)=',iq,nqfils(iq)
     447      !write(*,*) 'vlsplt 326: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
    452448     
    453       if (nqdesc(iq).gt.0) then 
    454        do ifils=1,nqdesc(iq)
    455          iq2=iqfils(ifils,iq)
    456          DO l=1,llm
     449      do ifils=1,tracers(iq)%nqDescen
     450        iq2=tracers(iq)%iqDescen(ifils)
     451        DO l=1,llm
    457452          DO ij=iip2,ip1jm
    458            ! On a besoin de q et masse seulement entre iip2 et ip1jm
    459            !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    460            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    461            !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
    462            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    463            if (q(ij,l,iq).gt.qperemin) then
    464              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    465            else
    466              Ratio(ij,l,iq2)=ratiomin
    467            endif
     453            ! On a besoin de q et masse seulement entre iip2 et ip1jm
     454            !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     455            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     456            !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
     457            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     458            if (q(ij,l,iq).gt.qperemin) then
     459              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     460            else
     461              Ratio(ij,l,iq2)=ratiomin
     462            endif
    468463          enddo   
    469          enddo
    470         enddo !do ifils=1,nqdesc(iq)
    471         do ifils=1,nqfils(iq)
    472          iq2=iqfils(ifils,iq)
    473          call vlx(Ratio,pente_max,masseq,u_mq,iq2)
    474         enddo !do ifils=1,nqfils(iq)
    475       endif !if (nqfils(iq).gt.0) then
     464        enddo
     465      enddo
     466      do ifils=1,tracers(iq)%nqDescen
     467        iq2=tracers(iq)%iqDescen(ifils)
     468        call vlx(Ratio,pente_max,masseq,u_mq,iq2)
     469      enddo
    476470! end CRisi
    477471
    … …  
    498492      ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
    499493      ! puis on boucle en longitude
    500       if (nqfils(iq).gt.0) then 
    501        do ifils=1,nqdesc(iq)
    502          iq2=iqfils(ifils,iq) 
    503          DO l=1,llm
     494      do ifils=1,tracers(iq)%nqDescen
     495        iq2=tracers(iq)%iqDescen(ifils)
     496        DO l=1,llm
    504497          DO ij=iip2+1,ip1jm
    505498            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    … …  
    508501             q(ij-iim,l,iq2)=q(ij,l,iq2)
    509502          enddo ! DO ij=ijb+iip1-1,ije,iip1
    510          enddo !DO l=1,llm
    511         enddo !do ifils=1,nqdesc(iq)
    512       endif !if (nqfils(iq).gt.0) then
     503        enddo !DO l=1,llm
     504      enddo
    513505
    514506c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
    … …  
    519511      END
    520512      RECURSIVE SUBROUTINE vly(q,pente_max,masse,masse_adv_v,iq)
    521       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     513      USE infotrac, ONLY : nqtot,tracers, ! CRisi
    522514     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    523515c
    … …  
    778770! CRisi: appel récursif de l'advection sur les fils.
    779771! Il faut faire ça avant d'avoir mis à jour q et masse
    780       !write(*,*) 'vly 689: iq,nqfils(iq)=',iq,nqfils(iq)
     772      !write(*,*) 'vly 689: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
    781773   
    782       if (nqfils(iq).gt.0) then 
    783        do ifils=1,nqdesc(iq)
    784          iq2=iqfils(ifils,iq)
    785          DO l=1,llm
    786          DO ij=1,ip1jmp1
    787            ! attention, chaque fils doit avoir son masseq, sinon, le 1er
    788            ! fils ecrase le masseq de ses freres.
    789            !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    790            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
    791            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    792            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    793            if (q(ij,l,iq).gt.qperemin) then
    794              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    795            else
    796              Ratio(ij,l,iq2)=ratiomin
    797            endif
     774      do ifils=1,tracers(iq)%nqDescen
     775        iq2=tracers(iq)%iqDescen(ifils)
     776        DO l=1,llm
     777          DO ij=1,ip1jmp1
     778            ! attention, chaque fils doit avoir son masseq, sinon, le 1er
     779            ! fils ecrase le masseq de ses freres.
     780            !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     781            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
     782            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     783            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     784            if (q(ij,l,iq).gt.qperemin) then
     785              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     786            else
     787              Ratio(ij,l,iq2)=ratiomin
     788            endif
    798789          enddo   
    799          enddo
    800         enddo !do ifils=1,nqdesc(iq)
    801 
    802         do ifils=1,nqfils(iq)
    803          iq2=iqfils(ifils,iq)
    804          call vly(Ratio,pente_max,masseq,qbyv,iq2)
    805         enddo !do ifils=1,nqfils(iq)
    806       endif !if (nqfils(iq).gt.0) then
     790        enddo
     791      enddo
     792
     793      do ifils=1,tracers(iq)%nqDescen
     794        iq2=tracers(iq)%iqDescen(ifils)
     795        call vly(Ratio,pente_max,masseq,qbyv,iq2)
     796      enddo
    807797
    808798      DO l=1,llm
    … …  
    872862 
    873863! retablir les fils en rapport de melange par rapport a l'air:
    874       if (nqfils(iq).gt.0) then 
    875        do ifils=1,nqdesc(iq)
    876          iq2=iqfils(ifils,iq) 
    877          DO l=1,llm
     864      do ifils=1,tracers(iq)%nqDescen
     865        iq2=tracers(iq)%iqDescen(ifils)
     866        DO l=1,llm
    878867          DO ij=1,ip1jmp1
    879868            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    880869          enddo
    881          enddo
    882         enddo !do ifils=1,nqdesc(iq)
    883       endif !if (nqfils(iq).gt.0) then
     870        enddo
     871      enddo
    884872
    885873      !write(*,*) 'vly 853: sortie'
    … …  
    888876      END
    889877      RECURSIVE SUBROUTINE vlz(q,pente_max,masse,w,iq)
    890       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     878      USE infotrac, ONLY : nqtot,tracers, ! CRisi
    891879     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    892880c
    … …  
    1009997! CRisi: appel récursif de l'advection sur les fils.
    1010998! Il faut faire ça avant d'avoir mis à jour q et masse
    1011       !write(*,*) 'vlsplt 942: iq,nqfils(iq)=',iq,nqfils(iq)
    1012       if (nqfils(iq).gt.0) then 
    1013        do ifils=1,nqdesc(iq)
    1014          iq2=iqfils(ifils,iq)
    1015          DO l=1,llm
     999      !write(*,*) 'vlsplt 942: iq,nqChilds(iq)=',iq,nqChilds(iq)
     1000      do ifils=1,tracers(iq)%nqDescen
     1001        iq2=tracers(iq)%iqDescen(ifils)
     1002        DO l=1,llm
    10161003          DO ij=1,ip1jmp1
    1017            !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    1018            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)       
    1019            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    1020            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    1021            if (q(ij,l,iq).gt.qperemin) then
    1022              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    1023            else
    1024              Ratio(ij,l,iq2)=ratiomin
    1025            endif     
     1004            !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     1005            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)       
     1006            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     1007            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     1008            if (q(ij,l,iq).gt.qperemin) then
     1009              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     1010            else
     1011              Ratio(ij,l,iq2)=ratiomin
     1012            endif     
    10261013          enddo   
    1027          enddo
    1028         enddo !do ifils=1,nqdesc(iq)
     1014        enddo
     1015      enddo
    10291016       
    1030         do ifils=1,nqfils(iq)
    1031          iq2=iqfils(ifils,iq)         
    1032          call vlz(Ratio,pente_max,masseq,wq,iq2)
    1033         enddo !do ifils=1,nqfils(iq)
    1034       endif !if (nqfils(iq).gt.0) then
     1017      do ifils=1,tracers(iq)%nqDescen
     1018        iq2=tracers(iq)%iqDescen(ifils)
     1019        call vlz(Ratio,pente_max,masseq,wq,iq2)
     1020      enddo
    10351021! end CRisi 
    10361022
    … …  
    10451031
    10461032! retablir les fils en rapport de melange par rapport a l'air:
    1047       if (nqfils(iq).gt.0) then 
    1048        do ifils=1,nqdesc(iq)
    1049          iq2=iqfils(ifils,iq) 
    1050          DO l=1,llm
     1033      do ifils=1,tracers(iq)%nqDescen
     1034        iq2=tracers(iq)%iqDescen(ifils)
     1035        DO l=1,llm
    10511036          DO ij=1,ip1jmp1
    10521037            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    10531038          enddo
    1054          enddo
    1055         enddo !do ifils=1,nqdesc(iq)
    1056       endif !if (nqfils(iq).gt.0) then
     1039        enddo
     1040      enddo
    10571041      !write(*,*) 'vlsplt 1032'
    10581042

  • LMDZ6/trunk/libf/dyn3d/vlspltqs.F

    r2603 r4050  
    44       SUBROUTINE vlspltqs ( q,pente_max,masse,w,pbaru,pbarv,pdt,
    55     ,                                  p,pk,teta,iq             )
    6        USE infotrac, ONLY: nqtot,nqdesc,iqfils
     6       USE infotrac, ONLY: nqtot,tracers
    77c
    88c     Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron
    … …  
    121121      CALL SCOPY(ijp1llm,q(1,1,iq),1,zq(1,1,iq),1)
    122122      CALL SCOPY(ijp1llm,masse,1,zm(1,1,iq),1)
    123       if (nqdesc(iq).gt.0) then 
    124        do ifils=1,nqdesc(iq)
    125         iq2=iqfils(ifils,iq)
     123      do ifils=1,tracers(iq)%nqDescen
     124        iq2=tracers(iq)%iqDescen(ifils)
    126125        CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1)
    127        enddo 
    128       endif !if (nqfils(iq).gt.0) then
     126      enddo 
    129127
    130128c      call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
    … …  
    162160      ENDDO
    163161      ! CRisi: aussi pour les fils
    164       if (nqdesc(iq).gt.0) then
    165       do ifils=1,nqdesc(iq)
    166         iq2=iqfils(ifils,iq)
     162      do ifils=1,tracers(iq)%nqDescen
     163        iq2=tracers(iq)%iqDescen(ifils)
    167164        DO l=1,llm
    168          DO ij=1,ip1jmp1
    169            q(ij,l,iq2)=zq(ij,l,iq2)
    170          ENDDO
    171          DO ij=1,ip1jm+1,iip1
     165          DO ij=1,ip1jmp1
     166            q(ij,l,iq2)=zq(ij,l,iq2)
     167          ENDDO
     168          DO ij=1,ip1jm+1,iip1
    172169            q(ij+iim,l,iq2)=q(ij,l,iq2)
    173          ENDDO
     170          ENDDO
    174171        ENDDO
    175       enddo !do ifils=1,nqdesc(iq) 
    176       endif ! if (nqfils(iq).gt.0) then
     172      enddo
    177173      !write(*,*) 'vlspltqs 183: fin de la routine'
    178174
    … …  
    180176      END
    181177      SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat,iq)
    182       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     178      USE infotrac, ONLY : nqtot,tracers ! CRisi
    183179
    184180c
    … …  
    483479! CRisi: appel récursif de l'advection sur les fils.
    484480! Il faut faire ça avant d'avoir mis à jour q et masse
    485       !write(*,*) 'vlspltqs 326: iq,nqfils(iq)=',iq,nqfils(iq)
     481      !write(*,*) 'vlspltqs 326: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds
    486482     
    487       if (nqfils(iq).gt.0) then 
    488        do ifils=1,nqdesc(iq)
    489          iq2=iqfils(ifils,iq)
    490          DO l=1,llm
     483      do ifils=1,tracers(iq)%nqDescen
     484        iq2=tracers(iq)%iqDescen(ifils)
     485        DO l=1,llm
    491486          DO ij=iip2,ip1jm
    492            ! On a besoin de q et masse seulement entre iip2 et ip1jm
    493            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    494            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     487          ! On a besoin de q et masse seulement entre iip2 et ip1jm
     488            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     489            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    495490          enddo   
    496          enddo
    497         enddo !do ifils=1,nqdesc(iq)
    498         do ifils=1,nqfils(iq)
    499          iq2=iqfils(ifils,iq)
    500          call vlx(Ratio,pente_max,masseq,u_mq,iq2)
    501         enddo !do ifils=1,nqfils(iq)
    502       endif !if (nqfils(iq).gt.0) then
     491        enddo
     492      enddo
     493      do ifils=1,tracers(iq)%nqChilds
     494        iq2=tracers(iq)%iqDescen(ifils)
     495        call vlx(Ratio,pente_max,masseq,u_mq,iq2)
     496      enddo
    503497! end CRisi
    504498
    … …  
    523517      ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
    524518      ! puis on boucle en longitude
    525       if (nqdesc(iq).gt.0) then 
    526        do ifils=1,nqdesc(iq)
    527          iq2=iqfils(ifils,iq) 
    528          DO l=1,llm
     519      do ifils=1,tracers(iq)%nqDescen
     520        iq2=tracers(iq)%iqDescen(ifils)
     521        DO l=1,llm
    529522          DO ij=iip2+1,ip1jm
    530523            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    531524          enddo
    532525          DO ij=iip1+iip1,ip1jm,iip1
    533              q(ij-iim,l,iq2)=q(ij,l,iq2)
    534           enddo ! DO ij=ijb+iip1-1,ije,iip1
    535          enddo !DO l=1,llm
    536         enddo !do ifils=1,nqdesc(iq)
    537       endif !if (nqfils(iq).gt.0) then
     526            q(ij-iim,l,iq2)=q(ij,l,iq2)
     527          enddo
     528        enddo
     529      enddo
    538530
    539531c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
    … …  
    544536      END
    545537      SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat,iq)
    546       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     538      USE infotrac, ONLY : nqtot,tracers ! CRisi
    547539c
    548540c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    794786! CRisi: appel récursif de l'advection sur les fils.
    795787! Il faut faire ça avant d'avoir mis à jour q et masse
    796       !write(*,*) 'vlyqs 689: iq,nqfils(iq)=',iq,nqfils(iq)
     788      !write(*,*) 'vlyqs 689: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
    797789   
    798       if (nqfils(iq).gt.0) then 
    799        do ifils=1,nqdesc(iq)
    800          iq2=iqfils(ifils,iq)
    801          DO l=1,llm
    802          DO ij=1,ip1jmp1
    803            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    804            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
     790      do ifils=1,tracers(iq)%nqDescen
     791        iq2=tracers(iq)%iqDescen(ifils)
     792        DO l=1,llm
     793          DO ij=1,ip1jmp1
     794            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     795            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
    805796          enddo   
    806          enddo
    807         enddo !do ifils=1,nqdesc(iq)
    808 
    809         do ifils=1,nqfils(iq)
    810          iq2=iqfils(ifils,iq)
    811          !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2
    812          call vly(Ratio,pente_max,masseq,qbyv,iq2)
    813         enddo !do ifils=1,nqfils(iq)
    814       endif !if (nqfils(iq).gt.0) then
     797        enddo
     798      enddo
     799      do ifils=1,tracers(iq)%nqChilds
     800        iq2=tracers(iq)%iqDescen(ifils)
     801        !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2
     802        call vly(Ratio,pente_max,masseq,qbyv,iq2)
     803      enddo
    815804
    816805      DO l=1,llm
    … …  
    868857
    869858! retablir les fils en rapport de melange par rapport a l'air:
    870       if (nqdesc(iq).gt.0) then 
    871        do ifils=1,nqdesc(iq)
    872          iq2=iqfils(ifils,iq) 
    873          DO l=1,llm
     859      do ifils=1,tracers(iq)%nqDescen
     860        iq2=tracers(iq)%iqDescen(ifils)
     861        DO l=1,llm
    874862          DO ij=1,ip1jmp1
    875863            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    876864          enddo
    877          enddo
    878         enddo !do ifils=1,nqdesc(iq)
    879       endif !if (nqfils(iq).gt.0) then
     865        enddo
     866      enddo
    880867      !write(*,*) 'vly 879'
    881868

  • LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

    r4046 r4050  
    3232  TYPE(isot_type), TARGET,  SAVE, ALLOCATABLE :: isotopes(:)    !=== ISOTOPES PARAMETERS VECTOR
    3333
    34 ! iadv  : index of trasport schema for each tracer
    35   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iadv
    36 
    3734! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the
    3835!         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code.
    3936  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
    4037
    41 ! CRisi: tableaux de fils
    42   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
    43   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les generations
    44   INTEGER, SAVE :: nqdesc_tot
    45   INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    46   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iqpere
    4738  REAL :: qperemin,masseqmin,ratiomin ! MVals et CRisi
    4839  PARAMETER (qperemin=1e-30,masseqmin=1e-18,ratiomin=1e-16) ! MVals
    … …  
    6354  LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
    6455  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    65   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numero iso entre 1 et niso_possibles en fn de nqtot
    6656  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numero iso entre 1 et niso effectif en fn de nqtot
    67   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numero de la zone de tracage en fn de nqtot
    68   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numero de la zone de tracage en fn de nqtot
    6957  INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numero d isotope entre 1 et niso_possibles
    7058  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numero ixt en fn izone, indnum entre 1 et niso
    … …  
    128116 
    129117    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    130     INTEGER :: iq, new_iq, iiq, jq, ierr,itr
    131     INTEGER :: ifils,ipere,generation ! CRisi
     118    INTEGER :: iq, new_iq, iiq, jq, ierr,itr, iadv
     119    INTEGER :: ifils,ipere ! CRisi
    132120    LOGICAL :: continu,nouveau_traceurdef
    133121    INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def
    134122    CHARACTER(len=maxlen) :: tchaine   
     123    INTEGER, ALLOCATABLE  :: iqfils(:,:)
    135124
    136125    character(len=*),parameter :: modname="infotrac_init"
    … …  
    565554!
    566555    ALLOCATE(tracers(nqtot))
    567     ALLOCATE(iadv(nqtot), niadv(nqtot))
     556    ALLOCATE(niadv(nqtot))
    568557
    569558!-----------------------------------------------------------------------
    … …  
    578567       ! Verify choice of advection schema
    579568       IF (hadv(iq)==vadv(iq)) THEN
    580           iadv(new_iq)=hadv(iq)
     569          tracers(new_iq)%iadv=hadv(iq)
    581570       ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
    582           iadv(new_iq)=11
     571          tracers(new_iq)%iadv=11
    583572       ELSE
    584573          WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
    … …  
    588577     
    589578       str1=tnom_0(iq)
    590        tracers(new_iq)%name=TRIM(tnom_0(iq))
    591        IF (iadv(new_iq)==0) THEN
     579       tracers(new_iq)%name = TRIM(tnom_0(iq))
     580       tracers(new_iq)%parent = TRIM(tnom_transp(iq))
     581       IF (tracers(new_iq)%iadv==0) THEN
    592582          tracers(new_iq)%longName=trim(str1)
    593583       ELSE
    594           tracers(new_iq)%longName=trim(tnom_0(iq))//descrq(iadv(new_iq))
     584          tracers(new_iq)%longName=trim(tnom_0(iq))//descrq(tracers(new_iq)%iadv)
    595585       ENDIF
    596586
    597587       ! schemas tenant compte des moments d'ordre superieur
    598588       str2=TRIM(tracers(new_iq)%longName)
    599        IF (iadv(new_iq)==20) THEN
     589       IF (tracers(new_iq)%iadv==20) THEN
    600590          DO jq=1,3
    601591             new_iq=new_iq+1
    602              iadv(new_iq)=-20
     592             tracers(new_iq)%iadv=-20
    603593             tracers(new_iq)%longName=trim(str2)//txts(jq)
    604594             tracers(new_iq)%name=trim(str1)//txts(jq)
    605595          END DO
    606        ELSE IF (iadv(new_iq)==30) THEN
     596       ELSE IF (tracers(new_iq)%iadv==30) THEN
    607597          DO jq=1,9
    608598             new_iq=new_iq+1
    609              iadv(new_iq)=-30
     599             tracers(new_iq)%iadv=-30
    610600             tracers(new_iq)%longName=trim(str2)//txtp(jq)
    611601             tracers(new_iq)%name=trim(str1)//txtp(jq)
    … …  
    620610    iiq=0
    621611    DO iq=1,nqtot
    622        IF(iadv(iq).GE.0) THEN
     612       IF(tracers(iq)%iadv.GE.0) THEN
    623613          ! True tracer
    624614          iiq=iiq+1
    … …  
    632622
    633623    DO iq=1,nqtot
    634        WRITE(lunout,*) iadv(iq),niadv(iq), ' ',trim(tracers(iq)%name),' ',trim(tracers(iq)%longName)
     624       WRITE(lunout,*) tracers(iq)%iadv,niadv(iq), ' ',trim(tracers(iq)%name),' ',trim(tracers(iq)%longName)
    635625    END DO
    636626
    … …  
    640630!
    641631    DO iq=1,nqtot
    642        IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
    643           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     632       iadv=tracers(iq)%iadv
     633       IF (ALL([10, 14, 0]/=iadv)) THEN
     634          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not tested in this version of LMDZ'
    644635          CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
    645        ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
    646           WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     636       ELSE IF (iadv==14 .AND. iq/=1) THEN
     637          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv,' is not tested in this version of LMDZ'
    647638          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
    648639       ENDIF
    … …  
    653644! initialiser tous les tableaux d'indices lies aux traceurs familiaux
    654645! + verifier que tous les peres sont ecrits en premieres positions
    655     ALLOCATE(nqfils(nqtot),nqdesc(nqtot))   
    656646    ALLOCATE(iqfils(nqtot,nqtot))   
    657     ALLOCATE(iqpere(nqtot))
    658647    nqperes=0
    659     nqfils(:)=0
    660     nqdesc(:)=0
    661648    iqfils(:,:)=0
    662     iqpere(:)=0
    663     nqdesc_tot=0   
     649    tracers(:)%iqParent=0
    664650    DO iq=1,nqtot
    665651      if (tnom_transp(iq) == 'air') then
    … …  
    667653        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere'
    668654        nqperes=nqperes+1
    669         iqpere(iq)=0
     655        tracers(iq)%iqParent=0
    670656      else !if (tnom_transp(iq) == 'air') then
    671657        ! ceci est un fils. Qui est son pere?
    … …  
    681667                CALL abort_gcm('infotrac_init','Un fils est son propre pere',1)
    682668            endif
    683             nqfils(ipere)=nqfils(ipere)+1 
    684             iqfils(nqfils(ipere),ipere)=iq
    685             iqpere(iq)=ipere         
     669            tracers(ipere)%nqChilds = tracers(ipere)%nqChilds+1 
     670            iqfils(tracers(ipere)%nqChilds,ipere)=iq
     671            tracers(iq)%iqParent=ipere         
    686672            continu=.false.
    687673          else !if (tnom_transp(iq) == tnom_0(ipere)) then
    … …  
    697683    enddo !DO iq=1,nqtot
    698684    WRITE(lunout,*) 'infotrac: nqperes=',nqperes   
    699     WRITE(lunout,*) 'nqfils=',nqfils
    700     WRITE(lunout,*) 'iqpere=',iqpere
     685    WRITE(lunout,*) 'nqChilds=',tracers(:)%nqChilds
     686    WRITE(lunout,*) 'iqParent=',tracers(:)%iqParent
    701687    WRITE(lunout,*) 'iqfils=',iqfils
    702688
    703689! Calculer le nombre de descendants a partir de iqfils et de nbfils
    704690    DO iq=1,nqtot   
    705       generation=0
     691      tracers(iq)%iGeneration=0
    706692      continu=.true.
    707693      ifils=iq
    708694      do while (continu)
    709         ipere=iqpere(ifils)
     695        ipere=tracers(ifils)%iqParent
    710696        if (ipere.gt.0) then
    711          nqdesc(ipere)=nqdesc(ipere)+1   
    712          nqdesc_tot=nqdesc_tot+1     
    713          iqfils(nqdesc(ipere),ipere)=iq
     697         tracers(ipere)%nqDescen = tracers(ipere)%nqDescen+1   
     698         iqfils(tracers(ipere)%nqDescen,ipere)=iq
    714699         ifils=ipere
    715          generation=generation+1
     700         tracers(iq)%iGeneration=tracers(iq)%iGeneration+1
    716701        else !if (ipere.gt.0) then
    717702         continu=.false.
    718703        endif !if (ipere.gt.0) then
    719704      enddo !do while (continu)   
    720       WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)),' est un traceur de generation: ',generation
     705      WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)), &
     706        ' est un traceur de generation: ',tracers(iq)%iGeneration
    721707    enddo !DO iq=1,nqtot
    722     WRITE(lunout,*) 'infotrac: nqdesc=',nqdesc
     708    DO iq=1,nqtot
     709      ALLOCATE(tracers(iq)%iqDescen(tracers(iq)%nqDescen))
     710      tracers(iq)%iqDescen(:) = iqfils(1:tracers(iq)%nqDescen,iq)
     711    END DO
     712
     713    WRITE(lunout,*) 'infotrac: nqDescen=',tracers(iq)%nqDescen
    723714    WRITE(lunout,*) 'iqfils=',iqfils
    724     WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot
     715    WRITE(lunout,*) 'nqDescen_tot=',SUM(tracers(:)%nqDescen)
    725716
    726717! Interdire autres schemas que 10 pour les traceurs fils, et autres schemas
    727718! que 10 et 14 si des peres ont des fils
    728719    do iq=1,nqtot
    729       if (iqpere(iq).gt.0) then
     720      if (tracers(iq)%iqParent > 0) then
    730721        ! ce traceur a un pere qui n'est pas l'air
    731722        ! Seul le schema 10 est autorise
    732         if (iadv(iq)/=10) then
    733            WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons'
     723        iadv=tracers(iq)%iadv
     724        if (iadv/=10) then
     725           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not implemented for sons'
    734726          CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1)
    735727        endif
    736728        ! Le traceur pere ne peut etre advecte que par schema 10 ou 14:
    737         IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
    738           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers'
     729        IF (ALL([10,14]/=tracers(tracers(iq)%iqParent)%iadv)) THEN
     730          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not implemented for fathers'
    739731          CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1)
    740         endif !IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
    741      endif !if (iqpere(iq).gt.0) the
     732        endif
     733     endif
    742734    enddo !do iq=1,nqtot
    743 
     735    tracers(:)%gen0Name = ancestor(tracers)      !--- Name of the first generation ancestor
    744736
    745737
    … …  
    763755        itr=0
    764756        do iq=nqo+1, nqtot
    765           if (iso_num(iq).eq.0) then
     757          if (tracers(iq)%iso_iName.eq.0) then
    766758            itr=itr+1
    767759            write(*,*) 'itr=',itr
    768760            itr_indice(itr)=iq
    769           endif !if (iso_num(iq).eq.0) then
     761          endif !if (tracers(iq)%iso_iName.eq.0) then
    770762        enddo
    771763        if (itr.ne.nqtottr) then
    … …  
    811803    ALLOCATE(nb_isoind(nqo))
    812804    ALLOCATE(nb_traciso(niso_possibles,nqo))
    813     ALLOCATE(iso_num(nqtot))
    814805    ALLOCATE(iso_indnum(nqtot))
    815     ALLOCATE(zone_num(nqtot))
    816     ALLOCATE(phase_num(nqtot))
    817806     
    818     iso_num(:)=0
    819807    iso_indnum(:)=0
    820     zone_num(:)=0
    821     phase_num(:)=0
    822808    indnum_fn_num(:)=0
    823809    use_iso(:)=.false. 
    … …  
    841827          nb_iso(ixt,phase)=nb_iso(ixt,phase)+1   
    842828          nb_isoind(phase)=nb_isoind(phase)+1   
    843           iso_num(iq)=ixt
     829          tracers(iq)%iso_iName=ixt
    844830          iso_indnum(iq)=nb_isoind(phase)
    845831          indnum_fn_num(ixt)=iso_indnum(iq)
    846           phase_num(iq)=phase
    847 !          write(lunout,*) 'iso_num(iq)=',iso_num(iq)
    848 !          write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)
    849 !          write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)
    850 !          write(lunout,*) 'phase_num(iq)=',phase_num(iq)
     832          tracers(iq)%iso_iPhase=phase
    851833          goto 20
    852          else if (iqpere(iq).gt.0) then         
    853           if (tnom_0(iqpere(iq)) == tnom_trac) then
     834         else if ( tracers(iq)%iqParent> 0) then         
     835          if (tnom_0(tracers(iq)%iqParent) == tnom_trac) then
    854836!           write(lunout,*) 'Ce traceur est le fils d''un isotope'
    855837           ! c'est un traceur d'isotope
    856838           nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1
    857            iso_num(iq)=ixt
     839           tracers(iq)%iso_iName=ixt
    858840           iso_indnum(iq)=indnum_fn_num(ixt)
    859            zone_num(iq)=nb_traciso(ixt,phase)
    860            phase_num(iq)=phase
    861 !           write(lunout,*) 'iso_num(iq)=',iso_num(iq)
    862 !           write(lunout,*) 'phase_num(iq)=',phase_num(iq)
    863 !           write(lunout,*) 'zone_num(iq)=',zone_num(iq)
     841           tracers(iq)%iso_iZone=nb_traciso(ixt,phase)
     842           tracers(iq)%iso_iPhase=phase
    864843           goto 20
    865           endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
     844          endif !if (tnom_0(tracers(iq)%iqParent) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
    866845         endif !IF (tnom_0(iq) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
    867846        enddo !do ixt= niso_possibles
    … …  
    869848  20   continue
    870849      enddo !do iq=1,nqtot
    871 
    872 !      write(lunout,*) 'iso_num=',iso_num
    873 !      write(lunout,*) 'iso_indnum=',iso_indnum
    874 !      write(lunout,*) 'zone_num=',zone_num 
    875 !      write(lunout,*) 'phase_num=',phase_num
    876 !      write(lunout,*) 'indnum_fn_num=',indnum_fn_num
    877850
    878851      do ixt= 1,niso_possibles 
    … …  
    926899 
    927900    ! flags isotopiques:
    928     if (niso.gt.0) then
    929         ok_isotopes=.true.
    930     else
    931         ok_isotopes=.false.
    932     endif
     901    ok_isotopes = niso > 0
    933902!    WRITE(lunout,*) 'ok_isotopes=',ok_isotopes
    934903 
    … …  
    955924    iqiso(:,:)=0     
    956925    do iq=1,nqtot
    957         if (iso_num(iq).gt.0) then
    958           ixt=iso_indnum(iq)+zone_num(iq)*niso
    959           iqiso(ixt,phase_num(iq))=iq
     926        if (tracers(iq)%iso_iName > 0) then
     927          ixt=iso_indnum(iq)+tracers(iq)%iso_iZone*niso
     928          iqiso(ixt,tracers(iq)%iso_iPhase)=iq
    960929        endif
    961930    enddo

  • LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F

    r2270 r4050  
    6464        function iso_verif_aberrant_nostop
    6565     :           (x,iso,q,err_msg)
    66         USE infotrac
     66        USE infotrac, ONLY: tnat
    6767        implicit none
    6868       

  • LMDZ6/trunk/libf/dyn3dmem/advtrac_loc.F

    r4038 r4050  
    2424      USE Vampir
    2525      USE times
    26       USE infotrac, ONLY: nqtot, iadv, ok_iso_verif
     26      USE infotrac, ONLY: nqtot, tracers, ok_iso_verif
    2727      USE control_mod, ONLY: iapp_tracvl, day_step, planet_type
    2828      USE advtrac_mod, ONLY: finmasse
    … …  
    7474      DATA fill/.true./
    7575      DATA dum/.true./
    76       integer ijb,ije,ijbu,ijbv,ijeu,ijev,j
     76      integer ijb,ije,ijbu,ijbv,ijeu,ijev,j, iadv
    7777      type(Request),SAVE :: testRequest
    7878!$OMP THREADPRIVATE(testRequest)
    … …  
    152152                 
    153153          !write(*,*) 'advtrac 157: appel de vlspltgen_loc'
    154           call vlspltgen_loc( q,iadv, 2., massem, wg ,
    155      *                        pbarug,pbarvg,dtvr,p,
     154          call vlspltgen_loc( q, 2., massem, wg,pbarug,pbarvg,dtvr,p,
    156155     *                        pk,teta )
    157156
    … …  
    169168      do iq=1,nqtot
    170169c        call clock(t_initial)
    171         if(iadv(iq) == 0) cycle
     170        iadv = tracers(iq)%iadv
     171        SELECT CASE(iadv)
     172          CASE(0); CYCLE
     173          CASE(10)
    172174c   ----------------------------------------------------------------
    173175c   Schema de Van Leer I MUSCL
    174176c   ----------------------------------------------------------------
    175         if(iadv(iq).eq.10) THEN
    176177     
    177178!LF            call vlsplt_p(q(1,1,iq),2.,massem,wg,pbarug,pbarvg,dtvr)
    178179
     180          CASE(14)
    179181c   ----------------------------------------------------------------
    180182c   Schema "pseudo amont" + test sur humidite specifique
    181183C    pour la vapeur d'eau. F. Codron
    182184c   ----------------------------------------------------------------
    183         else if(iadv(iq).eq.14) then
    184185c
    185186cym           stop 'advtrac : appel à vlspltqs :schema non parallelise'
    186187!LF           CALL vlspltqs_p( q(1,1,1), 2., massem, wg ,
    187188!LF     *                 pbarug,pbarvg,dtvr,p,pk,teta )
     189          CASE(12)
    188190c   ----------------------------------------------------------------
    189191c   Schema de Frederic Hourdin
    190192c   ----------------------------------------------------------------
    191         else if(iadv(iq).eq.12) then
    192193          stop 'advtrac : schema non parallelise'
    193194c            Pas de temps adaptatif
    194            call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
     195           call adaptdt(iadv,dtbon,n,pbarug,massem)
    195196           if (n.GT.1) then
    196197           write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=',
    … …  
    200201            call advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,1)
    201202           end do
    202         else if(iadv(iq).eq.13) then
     203          CASE(13)
    203204          stop 'advtrac : schema non parallelise'
    204205c            Pas de temps adaptatif
    205            call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
     206           call adaptdt(iadv,dtbon,n,pbarug,massem)
    206207           if (n.GT.1) then
    207208           write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=',
    … …  
    211212            call advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,2)
    212213          end do
     214          CASE(20)
    213215c   ----------------------------------------------------------------
    214216c   Schema de pente SLOPES
    215217c   ----------------------------------------------------------------
    216         else if (iadv(iq).eq.20) then
    217218          stop 'advtrac : schema non parallelise'
    218219
    219220            call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0)
    220221
     222          CASE(30)
    221223c   ----------------------------------------------------------------
    222224c   Schema de Prather
    223225c   ----------------------------------------------------------------
    224         else if (iadv(iq).eq.30) then
    225226          stop 'advtrac : schema non parallelise'
    226227c            Pas de temps adaptatif
    227            call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
     228           call adaptdt(iadv,dtbon,n,pbarug,massem)
    228229           if (n.GT.1) then
    229230           write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=',
    … …  
    232233           call  prather(q(1,1,iq),wg,massem,pbarug,pbarvg,
    233234     s                     n,dtbon)
     235          CASE(11,16,17,18)
    234236c   ----------------------------------------------------------------
    235237c   Schemas PPM Lin et Rood
    236238c   ----------------------------------------------------------------
    237        else if (iadv(iq).eq.11.OR.(iadv(iq).GE.16.AND.
    238      s                     iadv(iq).LE.18)) then
    239239
    240240           stop 'advtrac : schema non parallelise'
    … …  
    242242c        Test sur le flux horizontal
    243243c        Pas de temps adaptatif
    244          call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
     244         call adaptdt(iadv,dtbon,n,pbarug,massem)
    245245         if (n.GT.1) then
    246246           write(*,*) 'WARNING horizontal dt=',dtbon,'dtvr=',
    … …  
    273273c                         VL (version PPM) horiz. et PPM vert.
    274274c---------------------------------------------------------------------
    275                 if (iadv(iq).eq.11) then
     275            SELECT CASE(iadv)
     276              CASE(11)
    276277c                  Ss-prg PPM3d de Lin
    277278                  call ppm3d(1,qppm(1,1,iq),
    … …  
    281282     s                       fill,dum,220.)
    282283
     284              CASE(16)
    283285c----------------------------------------------------------------------
    284286c                           Monotonic PPM
    285287c----------------------------------------------------------------------
    286                else if (iadv(iq).eq.16) then
    287288c                  Ss-prg PPM3d de Lin
    288289                  call ppm3d(1,qppm(1,1,iq),
    … …  
    293294c---------------------------------------------------------------------
    294295
     296              CASE(17)
    295297c---------------------------------------------------------------------
    296298c                           Semi Monotonic PPM
    297299c---------------------------------------------------------------------
    298                else if (iadv(iq).eq.17) then
    299300c                  Ss-prg PPM3d de Lin
    300301                  call ppm3d(1,qppm(1,1,iq),
    … …  
    305306c---------------------------------------------------------------------
    306307
     308              CASE(18)
    307309c---------------------------------------------------------------------
    308310c                         Positive Definite PPM
    309311c---------------------------------------------------------------------
    310                 else if (iadv(iq).eq.18) then
    311312c                  Ss-prg PPM3d de Lin
    312313                  call ppm3d(1,qppm(1,1,iq),
    … …  
    316317     s                       fill,dum,220.)
    317318c---------------------------------------------------------------------
    318                 endif
     319            END SELECT
    319320            enddo
    320321c-----------------------------------------------------------------
    … …  
    322323c-----------------------------------------------------------------
    323324                  call interpost(q(1,1,iq),qppm(1,1,iq))
    324             endif
     325        END SELECT
    325326c----------------------------------------------------------------------
    326327

  • LMDZ6/trunk/libf/dyn3dmem/advtrac_mod.F90

    r1907 r4050  
    99  USE allocate_field_mod
    1010  USE parallel_lmdz
    11   USE infotrac
    1211  USE vlspltgen_mod
    1312  IMPLICIT NONE

  • LMDZ6/trunk/libf/dyn3dmem/caladvtrac_mod.F90

    r3435 r4050  
    2323  USE allocate_field_mod
    2424  USE parallel_lmdz
    25   USE infotrac
     25  USE infotrac, ONLY: nqtot
    2626  USE advtrac_mod, ONLY : advtrac_allocate
    2727  USE groupe_mod

  • LMDZ6/trunk/libf/dyn3dmem/call_calfis_mod.F90

    r3435 r4050  
    3737  USE parallel_lmdz
    3838  USE dimensions_mod
    39   USE infotrac
     39  USE infotrac, ONLY: nqtot
    4040  IMPLICIT NONE
    4141    TYPE(distrib),POINTER :: d
    … …  
    8080  USE Bands
    8181  USE vampir
    82   USE infotrac
     82  USE infotrac, ONLY: nqtot
    8383  USE control_mod
    8484  USE write_field_loc

  • LMDZ6/trunk/libf/dyn3dmem/check_isotopes_loc.F

    r4038 r4050  
    11        subroutine check_isotopes(q,ijb,ije,err_msg)
    2         USE infotrac
     2        USE infotrac, ONLY: nqtot, nqo, niso, ntraciso, ntraceurs_zone,
     3     &                ok_isotopes, ok_isotrac, use_iso,
     4     &                iqiso, indnum_fn_num, index_trac, tnat
    35        USE parallel_lmdz
    46        implicit none

  • LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90

    r4046 r4050  
    77!-------------------------------------------------------------------------------
    88  USE parallel_lmdz
    9   USE infotrac
     9  USE infotrac,    ONLY: nqtot, tracers, iqiso, iso_indnum, tnat, alpha_ideal, ok_isotopes, maxlen
    1010  USE netcdf, ONLY: NF90_OPEN,  NF90_INQUIRE_DIMENSION, NF90_INQ_VARID,        &
    1111      NF90_NOWRITE, NF90_CLOSE, NF90_INQUIRE_VARIABLE,  NF90_GET_VAR, NF90_NoErr
    1212  USE control_mod, ONLY: planet_type
    13   USE strings_mod, ONLY: maxlen
    1413  USE assert_eq_m, ONLY: assert_eq
    1514  USE comvert_mod, ONLY: pa,preff
    … …  
    4241  CHARACTER(LEN=maxlen) :: msg, var, modname
    4342  INTEGER, PARAMETER :: length=100
    44   INTEGER :: iq, fID, vID, idecal, ierr
     43  INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase
    4544  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
    4645  REAL,             ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:),   ps_glo(:)
    … …  
    174173   !--- CRisi: for isotops, theoretical initialization using very simplified
    175174   !           Rayleigh distillation las.
    176     IF(ok_isotopes.AND.iso_num(iq)>0) THEN
    177       IF(zone_num(iq)==0) q(:,:,iq)=q(:,:,iqpere(iq))*tnat(iso_num(iq))        &
    178      &           *(q(:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
    179       IF(zone_num(iq)==1) q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq)))
     175    iName = tracers(iq)%iso_iName
     176    iZone = tracers(iq)%iso_iZone
     177    iPhase= tracers(iq)%iso_iPhase
     178    iqParent = tracers(iq)%iqParent
     179    IF(ok_isotopes .AND. iName>0) THEN
     180      IF(iZone==0) q(:,:,iq) = q(:,:,iqParent)*tnat(iName)    &
     181     &           *(q(:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
     182      IF(iZone==1) q(:,:,iq) = q(:,:,iqiso(iso_indnum(iq),iPhase))
    180183    END IF
    181184  END DO

  • LMDZ6/trunk/libf/dyn3dmem/dynredem_loc.F90

    r4046 r4050  
    99  USE parallel_lmdz
    1010  USE mod_hallo
    11   USE infotrac
     11  USE infotrac, ONLY: nqtot, tracers, maxlen
    1212  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
    1313                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER,   &
    1414                    NF90_64BIT_OFFSET
    1515  USE dynredem_mod, ONLY: cre_var, put_var, err, modname, fil
    16   USE strings_mod, ONLY: maxlen
    1716  USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, &
    1817                         nivsig,nivsigs
    … …  
    175174  USE parallel_lmdz
    176175  USE mod_hallo
    177   USE infotrac
     176  USE infotrac, ONLY: nqtot, tracers, type_trac, maxlen
    178177  USE control_mod
    179178  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &

  • LMDZ6/trunk/libf/dyn3dmem/gcm.F90

    r3579 r4050  
    99  USE mod_const_mpi, ONLY: init_const_mpi
    1010  USE parallel_lmdz
    11   USE infotrac
     11  USE infotrac, ONLY: nqtot, infotrac_init
    1212!#ifdef CPP_PHYS
    1313!  USE mod_interface_dyn_phys, ONLY: init_interface_dyn_phys

  • LMDZ6/trunk/libf/dyn3dmem/groupe_mod.F90

    r1907 r4050  
    1010  USE allocate_field_mod
    1111  USE parallel_lmdz
    12   USE infotrac
     12!  USE infotrac
    1313  USE advtrac_mod, ONLY : advtrac_allocate
    1414  IMPLICIT NONE

  • LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90

    r3976 r4050  
    77  use exner_hyb_m, only: exner_hyb
    88  use exner_milieu_m, only: exner_milieu
    9   USE infotrac, ONLY: nqtot,niso_possibles,ok_isotopes,iqpere,ok_iso_verif,tnat,alpha_ideal, &
    10         & iqiso,phase_num,iso_indnum,iso_num,zone_num
     9  USE infotrac, ONLY: nqtot, niso_possibles, ok_isotopes, ok_iso_verif, tnat, alpha_ideal, &
     10                      iqiso, tracers, iso_indnum
    1111  USE control_mod, ONLY: day_step,planet_type
    1212  USE parallel_lmdz, ONLY: ijb_u, ije_u, ijb_v, ije_v
    … …  
    6767  real tetastrat ! potential temperature in the stratosphere, in K
    6868  real tetajl(jjp1,llm)
    69   INTEGER i,j,l,lsup,ij
     69  INTEGER i,j,l,lsup,ij, iq, iName, iZone, iPhase, iqParent
    7070
    7171  REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
    … …  
    282282           ! Earth: first two tracers will be water
    283283
    284            do i=1,nqtot
    285               if (i == 1) q(ijb_u:ije_u,:,i)=1.e-10
    286               if (i == 2) q(ijb_u:ije_u,:,i)=1.e-15
    287               if (i.gt.2) q(ijb_u:ije_u,:,i)=0.
     284           do iq=1,nqtot
     285              q(ijb_u:ije_u,:,iq)=0.
     286              if (tracers(iq)%name == 'H2Ov') q(ijb_u:ije_u,:,iq)=1.e-10
     287              if (tracers(iq)%name == 'H2Ol') q(ijb_u:ije_u,:,iq)=1.e-15
    288288
    289289              ! CRisi: init des isotopes
    290290              ! distill de Rayleigh très simplifiée
    291               if (ok_isotopes) then
    292                 if ((iso_num(i).gt.0).and.(zone_num(i).eq.0)) then         
    293                    q(ijb_u:ije_u,:,i)=q(ijb_u:ije_u,:,iqpere(i))       &
    294       &                  *tnat(iso_num(i))                             &
    295       &                  *(q(ijb_u:ije_u,:,iqpere(i))/30.e-3)                              &
    296      &                   **(alpha_ideal(iso_num(i))-1)
    297                 endif               
    298                 if ((iso_num(i).gt.0).and.(zone_num(i).eq.1)) then
    299                   q(ijb_u:ije_u,:,i)=q(ijb_u:ije_u,:,iqiso(iso_indnum(i),phase_num(i)))
    300                 endif
     291              iName = tracers(iq)%iso_iName
     292              iZone = tracers(iq)%iso_iZone
     293              iPhase= tracers(iq)%iso_iPhase
     294              iqParent = tracers(iq)%iqParent
     295              if (ok_isotopes .AND. iName > 0) then
     296                if (iZone == 0) q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat(iName) &
     297                                                    *(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1)
     298                if (iZone == 1) q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqiso(iso_indnum(iq),iPhase))
    301299              endif !if (ok_isotopes) then
    302300

  • LMDZ6/trunk/libf/dyn3dmem/initdynav_loc.F

    r4046 r4050  
    1111       use Write_field
    1212       use misc_mod
    13        USE infotrac
     13!       USE infotrac
    1414       use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid,       &
    1515     &        dynhistave_file,dynhistvave_file,dynhistuave_file

  • LMDZ6/trunk/libf/dyn3dmem/inithist_loc.F

    r4046 r4050  
    1111       use Write_field
    1212       use misc_mod
    13        USE infotrac
    1413       use com_io_dyn_mod, only : histid,histvid,histuid,               &
    1514     &                        dynhist_file,dynhistv_file,dynhistu_file

  • LMDZ6/trunk/libf/dyn3dmem/vlsplt_loc.F

    r3800 r4050  
    1414c   --------------------------------------------------------------------
    1515      USE parallel_lmdz
    16       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     16      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    1717     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    1818      IMPLICIT NONE
    … …  
    330330! Il faut faire ça avant d'avoir mis à jour q et masse
    331331
    332        if (nqfils(iq).gt.0) then
    333        do ifils=1,nqdesc(iq)
    334        !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020
     332      do ifils=1,tracers(iq)%nqDescen
    335333        ! attention: comme Ratio est utilisé comme q dans l'appel
    336334        ! recursif, il doit contenir à lui seul tous les indices de tous
    337335        ! les descendants!
    338          iq2=iqfils(ifils,iq)
    339 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    340          DO l=1,llm
     336        iq2=tracers(iq)%iqDescen(ifils)
     337c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     338        DO l=1,llm
    341339          DO ij=ijb,ije
    342            ! On a besoin de q et masse seulement entre ijb et ije. On ne
    343            ! les calcule donc que de ijb à ije
    344            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    345            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    346            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
    347              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    348            else
    349              Ratio(ij,l,iq2)=ratiomin
    350            endif
     340            ! On a besoin de q et masse seulement entre ijb et ije. On ne
     341            ! les calcule donc que de ijb à ije
     342            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     343            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     344            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     345              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     346            else
     347              Ratio(ij,l,iq2)=ratiomin
     348            endif
    351349          enddo   
    352          enddo
    353 c$OMP END DO NOWAIT
    354         enddo !do ifils=1,nqdesc(iq)
    355         do ifils=1,nqfils(iq)
    356          iq2=iqfils(ifils,iq)
    357          call vlx_loc(Ratio,pente_max,masse,u_mq,ijb_x,ije_x,iq2)
    358         enddo !do ifils=1,nqfils(iq)
    359       endif !if (nqfils(iq).gt.0) then
     350        enddo
     351c$OMP END DO NOWAIT
     352      enddo !do ifils=1,tracers(iq)%nqDescen
     353      do ifils=1,tracers(iq)%nqChilds
     354        iq2=tracers(iq)%iqDescen(ifils)
     355        call vlx_loc(Ratio,pente_max,masse,u_mq,ijb_x,ije_x,iq2)
     356      enddo
    360357! end CRisi
    361358
    … …  
    383380      ! On calcule q entre ijb+1 et ije -> on fait pareil pour ratio
    384381      ! puis on boucle en longitude
    385       if (nqfils(iq).gt.0) then 
    386        do ifils=1,nqdesc(iq)
    387        !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020
    388          iq2=iqfils(ifils,iq) 
     382      do ifils=1,tracers(iq)%nqDescen
     383        iq2=tracers(iq)%iqDescen(ifils)
    389384c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    390          DO l=1,llm
     385        DO l=1,llm
    391386          DO ij=ijb+1,ije
    392387            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    393388          enddo
    394389          DO ij=ijb+iip1-1,ije,iip1
    395              q(ij-iim,l,iq2)=q(ij,l,iq2)
    396           enddo ! DO ij=ijb+iip1-1,ije,iip1
    397          enddo !DO l=1,llm
    398 c$OMP END DO NOWAIT
    399         enddo !do ifils=1,nqdesc(iq)
    400       endif !if (nqfils(iq).gt.0) then
     390            q(ij-iim,l,iq2)=q(ij,l,iq2)
     391          enddo
     392        enddo
     393c$OMP END DO NOWAIT
     394      enddo
    401395
    402396      !write(*,*) 'vlsplt 399: iq,ijb_x=',iq,ijb_x
    … …  
    422416c   --------------------------------------------------------------------
    423417      USE parallel_lmdz
    424       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     418      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    425419     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi   
    426420      USE comconst_mod, ONLY: pi
    … …  
    732726! CRisi: appel récursif de l'advection sur les fils.
    733727! Il faut faire ça avant d'avoir mis à jour q et masse
    734       !write(*,*) 'vly 689: iq,nqfils(iq)=',iq,nqfils(iq)
     728      !write(*,*) 'vly 689: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
    735729
    736730      ijb=ij_begin-2*iip1
    … …  
    743737      if (pole_sud)  ijem=ij_end
    744738
    745       if (nqfils(iq).gt.0) then 
    746        do ifils=1,nqdesc(iq)
    747        !do ifils=1,nqfils(iq) ! modif C Risi 22nov2020
    748          iq2=iqfils(ifils,iq)
     739      do ifils=1,tracers(iq)%nqDescen
     740        iq2=tracers(iq)%iqDescen(ifils)
    749741c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    750          DO l=1,llm
    751           ! modif des bornes: CRisi 16 nov 2020
    752           ! d'abord masse avec bornes corrigées
     742        DO l=1,llm
     743        ! modif des bornes: CRisi 16 nov 2020
     744        ! d'abord masse avec bornes corrigées
    753745          DO ij=ijbm,ijem
    754            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    755            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    756           enddo !DO ij=ijbm,ijem
     746          !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     747            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     748          enddo
    757749
    758750          ! ensuite Ratio avec anciennes bornes
    759          DO ij=ijb,ije
    760            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    761            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
    762              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    763            else
    764              Ratio(ij,l,iq2)=ratiomin 
    765            endif     
     751          DO ij=ijb,ije
     752          !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     753            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     754              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     755            else
     756              Ratio(ij,l,iq2)=ratiomin 
     757            endif     
    766758          enddo !DO ij=ijbm,ijem 
    767          enddo !DO l=1,llm
    768 c$OMP END DO NOWAIT
    769         enddo !do ifils=1,nqdesc(iq)
    770 
    771         do ifils=1,nqfils(iq)
    772          iq2=iqfils(ifils,iq)
    773          call vly_loc(Ratio,pente_max,masse,qbyv,iq2)
    774         enddo !do ifils=1,nqfils(iq)
    775       endif !if (nqfils(iq).gt.0) then
     759        enddo !DO l=1,llm
     760c$OMP END DO NOWAIT
     761      enddo
     762
     763      do ifils=1,tracers(iq)%nqChilds
     764        iq2=tracers(iq)%iqDescen(ifils)
     765        call vly_loc(Ratio,pente_max,masse,qbyv,iq2)
     766      enddo
    776767! end CRisi
    777768     
    … …  
    862853!      if (pole_sud)  ije=ij_end
    863854
    864       if (nqfils(iq).gt.0) then 
    865        do ifils=1,nqdesc(iq)
    866          iq2=iqfils(ifils,iq) 
     855      do ifils=1,tracers(iq)%nqDescen
     856        iq2=tracers(iq)%iqDescen(ifils)
    867857c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    868          DO l=1,llm
     858        DO l=1,llm
    869859          DO ij=ijb,ije
    870860            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    871861          enddo
    872          enddo
    873 c$OMP END DO NOWAIT
    874         enddo !do ifils=1,nqdesc(iq)
    875       endif !if (nqfils(iq).gt.0) then
     862        enddo
     863c$OMP END DO NOWAIT
     864      enddo
    876865
    877866
    … …  
    895884      USE parallel_lmdz
    896885      USE vlz_mod
    897       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     886      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    898887     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    899888     
    … …  
    11591148! CRisi: appel récursif de l'advection sur les fils.
    11601149! Il faut faire ça avant d'avoir mis à jour q et masse
    1161       !write(*,*) 'vlsplt 942: iq,nqfils(iq)=',iq,nqfils(iq)
    1162       if (nqfils(iq).gt.0) then 
    1163        do ifils=1,nqdesc(iq)
    1164        !do ifils=1,nqfils(iq) ! modif C Risi 22 nov 2020
    1165          iq2=iqfils(ifils,iq)
    1166 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1167          DO l=1,llm
     1150      !write(*,*) 'vlsplt 942: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds
     1151      do ifils=1,tracers(iq)%nqDescen
     1152        iq2=tracers(iq)%iqDescen(ifils)
     1153c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1154        DO l=1,llm
    11681155          DO ij=ijb,ije
    11691156           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    1170            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    1171            if (q(ij,l,iq).gt.qperemin) then
    1172              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    1173            else
    1174              Ratio(ij,l,iq2)=ratiomin
    1175            endif
    1176            !wq(ij,l,iq2)=wq(ij,l,iq) ! correction bug le 15mai2015
    1177            w(ij,l,iq2)=wq(ij,l,iq)
     1157            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     1158            if (q(ij,l,iq).gt.qperemin) then
     1159              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     1160            else
     1161              Ratio(ij,l,iq2)=ratiomin
     1162            endif
     1163            !wq(ij,l,iq2)=wq(ij,l,iq) ! correction bug le 15mai2015
     1164            w(ij,l,iq2)=wq(ij,l,iq)
    11781165          enddo   
    1179          enddo
    1180 c$OMP END DO NOWAIT
    1181         enddo !do ifils=1,nqdesc(iq)
     1166        enddo
     1167c$OMP END DO NOWAIT
     1168      enddo
    11821169c$OMP BARRIER
    11831170
    1184         do ifils=1,nqfils(iq)
    1185          iq2=iqfils(ifils,iq)
    1186          call vlz_loc(Ratio,pente_max,masse,w,ijb_x,ije_x,iq2)
    1187         enddo !do ifils=1,nqfils(iq)
    1188       endif !if (nqfils(iq).gt.0) then
     1171      do ifils=1,tracers(iq)%nqChilds
     1172        iq2=tracers(iq)%iqDescen(ifils)
     1173        call vlz_loc(Ratio,pente_max,masse,w,ijb_x,ije_x,iq2)
     1174      enddo
    11891175! end CRisi 
    11901176
    … …  
    12071193     
    12081194! retablir les fils en rapport de melange par rapport a l'air:
    1209       if (nqfils(iq).gt.0) then 
    1210        do ifils=1,nqdesc(iq)
    1211          iq2=iqfils(ifils,iq) 
     1195      do ifils=1,tracers(iq)%nqDescen
     1196        iq2=tracers(iq)%iqDescen(ifils)
    12121197c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    1213          DO l=1,llm
     1198        DO l=1,llm
    12141199          DO ij=ijb,ije
    12151200            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    12161201          enddo
    1217          enddo
    1218 c$OMP END DO NOWAIT
    1219         enddo !do ifils=1,nqdesc(iq)
    1220       endif !if (nqfils(iq).gt.0) then
     1202        enddo
     1203c$OMP END DO NOWAIT
     1204      enddo
    12211205
    12221206      RETURN

  • LMDZ6/trunk/libf/dyn3dmem/vlspltgen_loc.F

    r2603 r4050  
    22! $Header$
    33!
    4        SUBROUTINE vlspltgen_loc( q,iadv,pente_max,masse,w,pbaru,pbarv,
     4       SUBROUTINE vlspltgen_loc( q,pente_max,masse,w,pbaru,pbarv,
    55     &                           pdt, p,pk,teta                 )
    66     
    … …  
    2828      USE VAMPIR
    2929      ! CRisi: on rajoute variables utiles d'infotrac 
    30       USE infotrac, ONLY : nqtot,nqperes,nqdesc,nqfils,iqfils,
    31      &    ok_iso_verif
     30      USE infotrac, ONLY : nqtot,nqperes, tracers,ok_iso_verif
    3231      USE vlspltgen_mod
    3332      USE comconst_mod, ONLY: cpp
    … …  
    4140c   Arguments:
    4241c   ----------
    43       INTEGER iadv(nqtot)
    4442      REAL masse(ijb_u:ije_u,llm),pente_max
    4543      REAL pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
    … …  
    200198!      DO iq=1,nqtot
    201199      DO iq=1,nqperes ! CRisi: on ne boucle que sur les pères= ceux qui sont transportés directement par l'air
    202        !write(*,*) 'vlspltgen 192: iq,iadv=',iq,iadv(iq)
     200       !write(*,*) 'vlspltgen 192: iq,iadv=',iq,tracers(iq)%iadv
    203201#ifdef DEBUG_IO   
    204202       CALL WriteField_u('zq',zq(:,:,iq))
    205203       CALL WriteField_u('zm',zm(:,:,iq))
    206204#endif
    207         if(iadv(iq) == 0) then
    208        
    209           cycle
    210        
    211         else if (iadv(iq)==10) then
    212 
     205        SELECT CASE(tracers(iq)%iadv)
     206          CASE(0); CYCLE
     207          CASE(10)
    213208#ifdef _ADV_HALO       
    214209! CRisi: on ajoute les nombres de fils et tableaux des fils
    … …  
    229224          call Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
    230225! CRisi
    231           do ifils=1,nqdesc(iq)
    232             iq2=iqfils(ifils,iq)
     226          do ifils=1,tracers(iq)%nqDescen
     227            iq2=tracers(iq)%iqDescen(ifils)
    233228            call Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
    234229            call Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
    … …  
    238233          call VTe(VTHallo)
    239234c$OMP END MASTER
    240         else if (iadv(iq)==14) then
    241 
     235          CASE(14)
    242236#ifdef _ADV_HALO           
    243237          call vlxqs_loc(zq,pente_max,zm,mu,
    … …  
    256250          call Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
    257251          call Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
    258           do ifils=1,nqdesc(iq)
    259             iq2=iqfils(ifils,iq)
     252          do ifils=1,tracers(iq)%nqDescen
     253            iq2=tracers(iq)%iqDescen(ifils)
    260254            call Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
    261255            call Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
    … …  
    265259          call VTe(VTHallo)
    266260c$OMP END MASTER
    267         else
    268        
     261          CASE DEFAULT
    269262          stop 'vlspltgen_p : schema non parallelise'
    270263     
    271         endif
     264        END SELECT
    272265     
    273266      enddo !DO iq=1,nqperes
    … …  
    298291        !write(*,*) 'vlspltgen 279: iq=',iq
    299292
    300         if(iadv(iq) == 0) then
    301        
    302           cycle
    303        
    304         else if (iadv(iq)==10) then
    305 
     293        SELECT CASE(tracers(iq)%iadv)
     294          CASE(0); CYCLE
     295          CASE(10)
    306296#ifdef _ADV_HALLO
    307297          call vlx_loc(zq,pente_max,zm,mu,
    308298     &                 ij_begin+2*iip1,ij_end-2*iip1,iq)
    309299#endif       
    310         else if (iadv(iq)==14) then
     300          CASE(14)
    311301#ifdef _ADV_HALLO
    312302          call vlxqs_loc(zq,pente_max,zm,mu,
    313303     &                    qsat,ij_begin+2*iip1,ij_end-2*iip1,iq)
    314304#endif   
    315         else
    316        
     305          CASE DEFAULT
    317306          stop 'vlspltgen_p : schema non parallelise'
    318307     
    319         endif
     308        END SELECT
    320309     
    321310      enddo
    … …  
    355344#endif
    356345
    357         if(iadv(iq) == 0) then
    358        
    359           cycle
    360        
    361         else if (iadv(iq)==10) then
    362        
    363           call vly_loc(zq,pente_max,zm,mv,iq)
    364  
    365         else if (iadv(iq)==14) then
    366      
    367           call vlyqs_loc(zq,pente_max,zm,mv,
    368      &                   qsat,iq)
    369  
    370         else
    371        
     346        SELECT CASE(tracers(iq)%iadv)
     347          CASE(0); CYCLE
     348          CASE(10); call vly_loc(zq,pente_max,zm,mv,iq)
     349          CASE(14); call vlyqs_loc(zq,pente_max,zm,mv,qsat,iq)
     350          CASE DEFAULT
    372351          stop 'vlspltgen_p : schema non parallelise'
    373      
    374         endif
     352        END SELECT
    375353       
    376354       enddo
    … …  
    386364       CALL WriteField_u('zm',zm(:,:,iq))
    387365#endif
    388         if(iadv(iq) == 0) then
    389          
    390           cycle
    391        
    392         else if (iadv(iq)==10 .or. iadv(iq)==14 ) then
    393 
     366        SELECT CASE(tracers(iq)%iadv)
     367          CASE(0); CYCLE
     368          CASE(10,14)
    394369c$OMP BARRIER       
    395370#ifdef _ADV_HALLO
    … …  
    411386          call Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest2)
    412387          ! CRisi
    413           do ifils=1,nqdesc(iq)
    414             iq2=iqfils(ifils,iq)
     388          do ifils=1,tracers(iq)%nqDescen
     389            iq2=tracers(iq)%iqDescen(ifils)
    415390            call Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest2)
    416391            call Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest2)
    … …  
    420395c$OMP END MASTER       
    421396c$OMP BARRIER
    422         else
    423        
     397          CASE DEFAULT
    424398          stop 'vlspltgen_p : schema non parallelise'
    425399     
    426         endif
     400        END SELECT
    427401     
    428402      enddo
    … …  
    448422      !write(*,*) 'vlspltgen 409: iq=',iq
    449423
    450         if(iadv(iq) == 0) then
    451          
    452           cycle
    453        
    454         else if (iadv(iq)==10 .or. iadv(iq)==14 ) then
     424        SELECT CASE(tracers(iq)%iadv)
     425          CASE(0); CYCLE
     426          CASE(10,14)
    455427c$OMP BARRIER       
    456428
    … …  
    461433
    462434c$OMP BARRIER       
    463         else
    464        
     435          CASE DEFAULT
    465436          stop 'vlspltgen_p : schema non parallelise'
    466      
    467         endif
     437        END SELECT
    468438     
    469439      enddo
    … …  
    498468       CALL WriteField_u('zm',zm(:,:,iq))
    499469#endif
    500         if(iadv(iq) == 0) then
    501        
    502           cycle
    503        
    504         else if (iadv(iq)==10) then
    505        
    506           call vly_loc(zq,pente_max,zm,mv,iq)
    507  
    508         else if (iadv(iq)==14) then
    509      
    510           call vlyqs_loc(zq,pente_max,zm,mv,
    511      &                   qsat,iq)
    512  
    513         else
    514        
    515           stop 'vlspltgen_p : schema non parallelise'
    516      
    517         endif
     470        SELECT CASE(tracers(iq)%iadv)
     471          CASE(0); CYCLE
     472          CASE(10); call   vly_loc(zq,pente_max,zm,mv,     iq)
     473          CASE(14); call vlyqs_loc(zq,pente_max,zm,mv,qsat,iq)
     474          CASE DEFAULT; stop 'vlspltgen_p : schema non parallelise'
     475        END SELECT
    518476       
    519477       enddo !do iq=1,nqperes
    … …  
    529487       CALL WriteField_u('zm',zm(:,:,iq))
    530488#endif
    531         if(iadv(iq) == 0) then
    532          
    533           cycle
    534        
    535         else if (iadv(iq)==10) then
    536        
    537           call vlx_loc(zq,pente_max,zm,mu,
     489        SELECT CASE(tracers(iq)%iadv)
     490          CASE(0); CYCLE
     491          CASE(10); call   vlx_loc(zq,pente_max,zm,mu,
    538492     &               ij_begin,ij_end,iq)
    539  
    540         else if (iadv(iq)==14) then
    541      
    542           call vlxqs_loc(zq,pente_max,zm,mu,
     493          CASE(14); call vlxqs_loc(zq,pente_max,zm,mu,
    543494     &                 qsat, ij_begin,ij_end,iq)
    544  
    545         else
    546        
    547           stop 'vlspltgen_p : schema non parallelise'
    548      
    549         endif
     495          CASE DEFAULT; stop 'vlspltgen_p : schema non parallelise'
     496        END SELECT
    550497       
    551498       enddo !do iq=1,nqperes

  • LMDZ6/trunk/libf/dyn3dmem/vlspltqs_loc.F

    r3800 r4050  
    1212c   --------------------------------------------------------------------
    1313      USE parallel_lmdz
    14       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     14      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    1515     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    1616      IMPLICIT NONE
    … …  
    337337! CRisi: appel récursif de l'advection sur les fils.
    338338! Il faut faire ça avant d'avoir mis à jour q et masse
    339       !write(*,*) 'vlspltqs 336: iq,ijb_x,nqfils(iq)=',
    340 !     &     iq,ijb_x,nqfils(iq) 
    341 
    342       if (nqfils(iq).gt.0) then 
    343        do ifils=1,nqdesc(iq)
    344          iq2=iqfils(ifils,iq)
     339      !write(*,*) 'vlspltqs 336: iq,ijb_x,iqDescen(iq)=',
     340!     &     iq,ijb_x,tracers(iq)%iqDescen 
     341
     342      do ifils=1,tracers(iq)%nqDescen
     343        iq2=tracers(iq)%iqDescen(ifils)
    345344c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    346          DO l=1,llm
     345        DO l=1,llm
    347346          DO ij=ijb,ije
    348            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    349            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    350            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
    351              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    352            else
    353              Ratio(ij,l,iq2)=ratiomin
    354            endif
     347            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     348            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     349            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     350              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     351            else
     352              Ratio(ij,l,iq2)=ratiomin
     353            endif
    355354          enddo   
    356          enddo
    357 c$OMP END DO NOWAIT
    358         enddo !do ifils=1,nqfils(iq)
    359         do ifils=1,nqfils(iq)
    360          iq2=iqfils(ifils,iq)
    361          !write(*,*) 'vlxqs 349: on appelle vlx pour iq2=',iq2
    362          call vlx_loc(Ratio,pente_max,masse,u_mq,ijb_x,ije_x,iq2)
    363         enddo !do ifils=1,nqfils(iq)
    364       endif !if (nqfils(iq).gt.0) then
     355        enddo
     356c$OMP END DO NOWAIT
     357      enddo
     358      do ifils=1,tracers(iq)%nqDescen
     359        iq2=tracers(iq)%iqDescen(ifils)
     360        !write(*,*) 'vlxqs 349: on appelle vlx pour iq2=',iq2
     361        call vlx_loc(Ratio,pente_max,masse,u_mq,ijb_x,ije_x,iq2)
     362      enddo
    365363! end CRisi
    366364
    … …  
    389387
    390388! retablir les fils en rapport de melange par rapport a l'air:
    391       if (nqfils(iq).gt.0) then 
    392        do ifils=1,nqdesc(iq)
    393          iq2=iqfils(ifils,iq) 
     389      do ifils=1,tracers(iq)%nqDescen
     390        iq2=tracers(iq)%iqDescen(ifils)
    394391c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    395          DO l=1,llm
     392        DO l=1,llm
    396393          DO ij=ijb+1,ije
    397394            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    398395          enddo
    399396          DO ij=ijb+iip1-1,ije,iip1
    400              q(ij-iim,l,iq2)=q(ij,l,iq2)
     397            q(ij-iim,l,iq2)=q(ij,l,iq2)
    401398          enddo ! DO ij=ijb+iip1-1,ije,iip1
    402          enddo
    403 c$OMP END DO NOWAIT
    404         enddo !do ifils=1,nqdesc(iq)
    405       endif !if (nqfils(iq).gt.0) then
     399        enddo
     400c$OMP END DO NOWAIT
     401      enddo
    406402
    407403      !write(*,*) 'vlspltqs 399: iq,ijb_x=',iq,ijb_x
    … …  
    426422c   --------------------------------------------------------------------
    427423      USE parallel_lmdz
    428       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi                 &
     424      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    429425     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    430426      USE comconst_mod, ONLY: pi
    … …  
    733729! CRisi: appel récursif de l'advection sur les fils.
    734730! Il faut faire ça avant d'avoir mis à jour q et masse
    735       !write(*,*) 'vlyqs 689: iq,nqfils(iq)=',iq,nqfils(iq)
     731      !write(*,*) 'vlyqs 689: iq,iqDescen(iq)=',iq,tracers(iq)%iqDescen
    736732     
    737733      ijb=ij_begin-2*iip1
    … …  
    747743      !write(lunout,*) 'ij_begin,ij_end=',ij_begin,ij_end
    748744      !write(lunout,*) 'pole_nord,pole_sud=',pole_nord,pole_sud
    749       if (nqfils(iq).gt.0) then 
    750        do ifils=1,nqdesc(iq)
    751          iq2=iqfils(ifils,iq)
     745      do ifils=1,tracers(iq)%nqDescen
     746        iq2=tracers(iq)%iqDescen(ifils)
    752747c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    753          DO l=1,llm
     748        DO l=1,llm
    754749          ! modif des bornes: CRisi 16 nov 2020
    755750          ! d'abord masse avec bornes corrigées
    756751          DO ij=ijbm,ijem
    757            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    758            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     752            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     753            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    759754          enddo !DO ij=ijbm,ijem
    760755
    761756          ! ensuite Ratio avec anciennes bornes
    762757          DO ij=ijb,ije
    763            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    764            !write(lunout,*) 'ij,l,q(ij,l,iq)=',ij,l,q(ij,l,iq)
    765            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
    766              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    767            else
    768              Ratio(ij,l,iq2)=ratiomin   
    769            endif
     758            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     759            !write(lunout,*) 'ij,l,q(ij,l,iq)=',ij,l,q(ij,l,iq)
     760            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     761              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     762            else
     763              Ratio(ij,l,iq2)=ratiomin   
     764            endif
    770765          enddo !DO ij=ijbm,ijem
    771          enddo !DO l=1,llm
    772 c$OMP END DO NOWAIT
    773         enddo !do ifils=1,nqdesc(iq)
    774         do ifils=1,nqfils(iq)
    775          iq2=iqfils(ifils,iq)
    776          !write(lunout,*) 'vly: appel recursiv vly iq2=',iq2
    777          call vly_loc(Ratio,pente_max,masse,qbyv,iq2)
    778         enddo !do ifils=1,nqfils(iq)
    779       endif !if (nqfils(iq).gt.0) then
     766        enddo !DO l=1,llm
     767c$OMP END DO NOWAIT
     768      enddo
     769      do ifils=1,tracers(iq)%nqDescen
     770        iq2=tracers(iq)%iqDescen(ifils)
     771        !write(lunout,*) 'vly: appel recursiv vly iq2=',iq2
     772        call vly_loc(Ratio,pente_max,masse,qbyv,iq2)
     773      enddo
    780774
    781775       
    … …  
    856850!      if (pole_sud)  ije=ij_end-iip1
    857851 
    858       if (nqfils(iq).gt.0) then 
    859        do ifils=1,nqdesc(iq)
    860          iq2=iqfils(ifils,iq) 
     852      do ifils=1,tracers(iq)%nqDescen
     853        iq2=tracers(iq)%iqDescen(ifils)
    861854c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    862          DO l=1,llm
     855        DO l=1,llm
    863856          DO ij=ijb,ije
    864857            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
    865858          enddo
    866          enddo
    867 c$OMP END DO NOWAIT
    868         enddo !do ifils=1,nqdesc(iq)
    869       endif !if (nqfils(iq).gt.0) then
     859        enddo
     860c$OMP END DO NOWAIT
     861      enddo
    870862
    871863

  • LMDZ6/trunk/libf/dyn3dmem/vlz_mod.F90

    r2281 r4050  
    55  REAL,POINTER,SAVE :: dzqw(:,:)
    66  REAL,POINTER,SAVE :: adzqw(:,:)
    7   ! CRisi: pour les traceurs: 
    8   !REAL,POINTER,SAVE :: masseq(:,:,:)
     7  ! CRisi: pour les traceurs:
    98  REAL,POINTER,SAVE :: Ratio(:,:,:)
    109 
    … …  
    2524    CALL allocate_u(dzqw,llm,d)
    2625    CALL allocate_u(adzqw,llm,d)
    27     if (nqdesc_tot.gt.0) then
    28     !CALL allocate_u(masseq,llm,nqtot,d)
    29     CALL allocate_u(Ratio,llm,nqtot,d)
    30     endif !if (nqdesc_tot.gt.0) then
     26    IF(ANY(tracers(:)%nqDescen > 0)) CALL allocate_u(Ratio,llm,nqtot,d)
    3127
    3228  END SUBROUTINE vlz_allocate
    … …  
    4440    CALL switch_u(dzqw,distrib_vanleer,dist)
    4541    CALL switch_u(adzqw,distrib_vanleer,dist)
    46     ! CRisi:
    47     if (nqdesc_tot.gt.0) then   
    48     !CALL switch_u(masseq,distrib_vanleer,dist)
    49     CALL switch_u(Ratio,distrib_vanleer,dist)
    50     endif !if (nqdesc_tot.gt.0) then     
     42    IF(ANY(tracers(:)%nqDescen > 0)) CALL switch_u(Ratio,distrib_vanleer,dist)
    5143
    5244  END SUBROUTINE vlz_switch_vanleer 

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90

    r4049 r4050  
    150150    CALL regr_lat_time_coefoz
    151151    CALL press_coefoz
    152     CALL regr_pr_o3(p3d, q3d(:,:,:,i))
    153     q3d(:,:,:,i)=q3d(:,:,:,i)*48./ 29.                  !--- Mole->mass fraction         
     152    CALL regr_pr_o3(p3d, q3d(:,:,:,iq))
     153    q3d(:,:,:,iq)=q3d(:,:,:,iq)*48./ 29.                !--- Mole->mass fraction         
    154154  END IF
    155155#endif

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90

    r4046 r4050  
    1818  USE infotrac, ONLY: nqtot,nqo,nbtr,nqCO2,tracers,type_trac,&
    1919                      niadv,conv_flg,pbl_flg,solsym,&
    20                       nqfils,nqdesc,nqdesc_tot,iqfils,iqpere,&
    2120                      ok_isotopes,ok_iso_verif,ok_isotrac,&
    2221                      ok_init_iso,niso_possibles,tnat,&
    23                       alpha_ideal,use_iso,iqiso,iso_num,&
    24                       iso_indnum,zone_num,phase_num,&
     22                      alpha_ideal,use_iso,iqiso,iso_indnum,&
    2523                      indnum_fn_num,index_trac,&
    2624                      niso,ntraceurs_zone,ntraciso,nqtottr,itr_indice
    … …  
    148146  CALL init_infotrac_phy(nqtot,nqo,nbtr,nqtottr,nqCO2,tracers,type_trac,&
    149147                         niadv,conv_flg,pbl_flg,solsym,&
    150                          nqfils,nqdesc,nqdesc_tot,iqfils,iqpere,&
    151148                         ok_isotopes,ok_iso_verif,ok_isotrac,&
    152149                         ok_init_iso,niso_possibles,tnat,&
    153                          alpha_ideal,use_iso,iqiso,iso_num,&
    154                          iso_indnum,zone_num,phase_num,&
     150                         alpha_ideal,use_iso,iqiso,iso_indnum,&
    155151                         indnum_fn_num,index_trac,&
    156152                         niso,ntraceurs_zone,ntraciso,itr_indice &

  • LMDZ6/trunk/libf/phylmd/infotrac_phy.F90

    r4046 r4050  
    5151  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
    5252!$OMP THREADPRIVATE(niadv)
    53 
    54 ! CRisi: tableaux de fils
    55   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
    56   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations
    57   INTEGER, SAVE :: nqdesc_tot
    58   INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    59   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iqpere
    60 !$OMP THREADPRIVATE(nqfils,nqdesc,nqdesc_tot,iqfils,iqpere)
    6153
    6254! conv_flg(it)=0 : convection desactivated for tracer number it
    … …  
    8476    INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    8577!$OMP THREADPRIVATE(iqiso)
    86     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
    87 !$OMP THREADPRIVATE(iso_num)
    8878    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
    8979!$OMP THREADPRIVATE(iso_indnum)
    90     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
    91 !$OMP THREADPRIVATE(zone_num)
    92     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
    93 !$OMP THREADPRIVATE(phase_num)
    9480    INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
    9581!$OMP THREADPRIVATE(indnum_fn_num)
    … …  
    10692  SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,nqtottr_,nqCO2_,tracers_,type_trac_,&
    10793                               niadv_,conv_flg_,pbl_flg_,solsym_,&
    108                                nqfils_,nqdesc_,nqdesc_tot_,iqfils_,iqpere_,&
    10994                               ok_isotopes_,ok_iso_verif_,ok_isotrac_,&
    11095                               ok_init_iso_,niso_possibles_,tnat_,&
    111                                alpha_ideal_,use_iso_,iqiso_,iso_num_,&
    112                                iso_indnum_,zone_num_,phase_num_,&
     96                               alpha_ideal_,use_iso_,iqiso_,iso_indnum_,&
    11397                               indnum_fn_num_,index_trac_,&
    11498                               niso_,ntraceurs_zone_,ntraciso_,itr_indice_&
    … …  
    143127    CHARACTER(len=*),INTENT(IN) :: solsym_(nbtr_)
    144128    ! Isotopes:
    145     INTEGER,INTENT(IN) :: nqfils_(nqtot_)
    146     INTEGER,INTENT(IN) :: nqdesc_(nqtot_)
    147     INTEGER,INTENT(IN) :: nqdesc_tot_
    148     INTEGER,INTENT(IN) :: iqfils_(nqtot_,nqtot_)
    149     INTEGER,INTENT(IN) :: iqpere_(nqtot_)
    150129    LOGICAL,INTENT(IN) :: ok_isotopes_
    151130    LOGICAL,INTENT(IN) :: ok_iso_verif_
    … …  
    157136    LOGICAL,INTENT(IN) :: use_iso_(niso_possibles_)
    158137    INTEGER,INTENT(IN) :: iqiso_(ntraciso_,nqo_)
    159     INTEGER,INTENT(IN) :: iso_num_(nqtot_)
    160138    INTEGER,INTENT(IN) :: iso_indnum_(nqtot_)
    161     INTEGER,INTENT(IN) :: zone_num_(nqtot_)
    162     INTEGER,INTENT(IN) :: phase_num_(nqtot_)
    163139    INTEGER,INTENT(IN) :: indnum_fn_num_(niso_possibles_)
    164140    INTEGER,INTENT(IN) :: index_trac_(ntraceurs_zone_,niso_)
    … …  
    169145
    170146    CHARACTER(LEN=30) :: modname="init_infotrac_phy"
     147    INTEGER :: iq
    171148
    172149    nqtot=nqtot_
    … …  
    176153    nqtottr=nqtottr_
    177154    ALLOCATE(tracers(nqtot)); tracers(:) = tracers_(:)
     155    tracers(:)%isAdvected = tracers(:)%iadv  >   0
     156!    tracers(:)%isH2Ofamily = delPhase(tracers(:)%gen0Name) == 'H2O'
     157    tracers(:)%isH2Ofamily = [(tracers(iq)%gen0Name(1:3) == 'H2O', iq=1, nqtot)]
    178158#ifdef CPP_StratAer
    179159    nbtr_bin=nbtr_bin_
    … …  
    216196   
    217197    IF (ok_isotopes) THEN
    218       ALLOCATE(nqfils(nqtot))
    219       nqfils(:)=nqfils_(:)
    220       ALLOCATE(nqdesc(nqtot))
    221       nqdesc(:)=nqdesc_(:)
    222       nqdesc_tot=nqdesc_tot_
    223       ALLOCATE(iqfils(nqtot,nqtot))
    224       iqfils(:,:)=iqfils_(:,:)
    225       ALLOCATE(iqpere(nqtot))
    226       iqpere(:)=iqpere_(:)
    227    
    228198      tnat(:)=tnat_(:)
    229199      alpha_ideal(:)=alpha_ideal_(:)
    … …  
    232202      ALLOCATE(iqiso(ntraciso,nqo))
    233203      iqiso(:,:)=iqiso_(:,:)
    234       ALLOCATE(iso_num(nqtot))
    235       iso_num(:)=iso_num_(:)
    236204      ALLOCATE(iso_indnum(nqtot))
    237205      iso_indnum(:)=iso_indnum_(:)
    238       ALLOCATE(zone_num(nqtot))
    239       zone_num(:)=zone_num_(:)
    240       ALLOCATE(phase_num(nqtot))
    241       phase_num(:)=phase_num_(:)
    242206     
    243207      indnum_fn_num(:)=indnum_fn_num_(:)

  • LMDZ6/trunk/libf/phylmd/tracco2i_mod.F90

    r3857 r4050  
    3030
    3131    USE dimphy
    32     USE infotrac_phy
     32    USE infotrac_phy, ONLY: nbtr
    3333    USE geometry_mod, ONLY: cell_area
    3434    USE carbon_cycle_mod, ONLY: id_CO2, nbcf_in, fields_in, cfname_in
    … …  
    336336
    337337    USE dimphy
    338     USE infotrac_phy
     338!    USE infotrac_phy
    339339    USE geometry_mod, ONLY : cell_area
    340340    USE mod_grid_phy_lmdz

  • LMDZ6/trunk/libf/phylmd/traclmdz_mod.F90

    r4046 r4050  
    6767   
    6868    USE dimphy
    69     USE infotrac_phy
     69    USE infotrac_phy, ONLY: nbtr, tracers, niadv, solsym
    7070   
    7171    ! Input argument
    … …  
    8989    ! Initialization of the tracers should be done here only for those not found in the restart file.
    9090    USE dimphy
    91     USE infotrac_phy
     91    USE infotrac_phy, ONLY: nbtr, nqo, tracers, pbl_flg, conv_flg, niadv
    9292    USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz
    9393    USE press_coefoz_m, ONLY: press_coefoz
    … …  
    176176!!       iiq=niadv(it+2)                                                            ! jyg
    177177       iiq=niadv(it+nqo)                                                            ! jyg
    178 print*,'###'//TRIM(tracers(iiq)%name)//'###'
    179 print*,'###'//TRIM(strLower(tracers(iiq)%name))//'###'
    180178       SELECT CASE(strLower(tracers(iiq)%name))
    181179         CASE("rn");      id_rn     = it ! radon
    … …  
    311309   
    312310    USE dimphy
    313     USE infotrac_phy
     311    USE infotrac_phy, ONLY: nbtr, pbl_flg, solsym
    314312    USE regr_pr_comb_coefoz_m, ONLY: regr_pr_comb_coefoz
    315313    USE o3_chem_m, ONLY: o3_chem
    … …  
    586584    ! variable trs is written to restart file (restartphy.nc)
    587585    USE dimphy
    588     USE infotrac_phy
     586    USE infotrac_phy, ONLY: nbtr
    589587   
    590588    REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out

  • LMDZ6/trunk/libf/phylmd/tracreprobus_mod.F90

    r3666 r4050  
    1212
    1313    USE dimphy
    14     USE infotrac_phy
     14    USE infotrac_phy, ONLY: nbtr, solsym
    1515#ifdef REPROBUS
    1616    USE CHEM_REP, ONLY : pdt_rep, &  ! pas de temps reprobus

  • LMDZ6/trunk/libf/phylmdiso/cv30_routines.F90

    r4004 r4050  
    449449
    450450#ifdef ISOVERIF
    451         write(*,*) 'cv30_routine undilute 1 413: entrée'
     451        write(*,*) 'cv30_routine undilute 1 413: entree'
    452452#endif
    453453
    … …  
    602602          zfice(i) = MIN(MAX(zfice(i),0.0),1.0)         
    603603       enddo
    604        ! calcul de la composition du condensat glacé et liquide
     604       ! calcul de la composition du condensat glace et liquide
    605605
    606606       do i=1,len
    … …  
    647647
    648648#ifdef ISOVERIF
    649             write(*,*) 'cv30_routine undilute 1 598: après condiso'
     649            write(*,*) 'cv30_routine undilute 1 598: apres condiso'
    650650         
    651651          if (iso_eau.gt.0) then
    … …  
    10121012            else
    10131013              q(i,k)=0.0
    1014               clw(i,k)=0.0 ! mise en commentaire le 5 avril pour vérif
     1014              clw(i,k)=0.0 ! mise en commentaire le 5 avril pour verif
    10151015!            convergence
    10161016            endif  !f (negation(essai_convergence)) then
    … …  
    19081908      real xtrti(ntraciso,nloc)
    19091909      real xtres(ntraciso)
    1910       ! on ajoute la dimension nloc à xtrti pour vérifs dans les tags: 5 fev
     1910      ! on ajoute la dimension nloc a xtrti pour verifs dans les tags: 5 fev
    19111911      ! 2010
    19121912      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
    … …  
    19231923#ifdef ISO
    19241924#ifdef ISOVERIF
    1925       write(*,*) 'cv30_routines 1820: entrée dans cv3_mixing'
     1925      write(*,*) 'cv30_routines 1820: entree dans cv3_mixing'
    19261926      if (iso_eau.gt.0) then
    19271927      call iso_verif_egalite_vect2D( &
    … …  
    19651965             xtelij(ixt,i,k,j)=0.0
    19661966            enddo !do ixt =1,niso
    1967             ! on initialise mieux que ça qent et elij, même si au final les
    1968             ! valeurs en nd=nl+1 ne sont pas utilisées
     1967            ! on initialise mieux que ca qent et elij, meme si au final les
     1968            ! valeurs en nd=nl+1 ne sont pas utilisees
    19691969            qent(i,k,j)=rr(i,j)
    19701970            elij(i,k,j)=0.0   
    … …  
    21212121!     :           'tcond(il),rs(il,j)=',
    21222122!     :            il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
    2123         ! colorier la vapeur résiduelle selon température de
    2124         ! condensation, et le condensat en un tag spécifique
     2123        ! colorier la vapeur residuelle selon temperature de
     2124        ! condensation, et le condensat en un tag spEcifique
    21252125          if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) then 
    21262126            if (option_traceurs.eq.17) then       
    … …  
    22412241#ifdef ISOTRAC         
    22422242        if (option_tmin.ge.1) then
    2243         ! colorier la vapeur résiduelle selon température de
    2244         ! condensation, et le condensat en un tag spécifique
     2243        ! colorier la vapeur residuelle selon temperature de
     2244        ! condensation, et le condensat en un tag specifique
    22452245!        write(*,*) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=',
    22462246!     :            il,i,j,xtent(:,il,i,j)
    … …  
    24752475#ifdef ISOTRAC         
    24762476        if (option_tmin.ge.1) then
    2477         ! colorier la vapeur résiduelle selon température de
    2478         ! condensation, et le condensat en un tag spécifique
     2477        ! colorier la vapeur residuelle selon temperature de
     2478        ! condensation, et le condensat en un tag specifique
    24792479!        write(*,*) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=',
    24802480!     :            il,i,j,xtent(:,il,i,j)
    … …  
    25792579#ifdef ISO
    25802580#ifdef ISOTRAC
    2581         ! seulement à la fin on taggue le condensat
     2581        ! seulement a la fin on taggue le condensat
    25822582        if (option_cond.ge.1) then
    25832583         do im = 1, nd
    25842584         do jm = 1, nd
    25852585         do il = 1, ncum   
    2586            ! colorier le condensat en un tag spécifique
     2586           ! colorier le condensat en un tag specifique
    25872587           do ixt=niso+1,ntraciso
    25882588             if (index_zone(ixt).eq.izone_cond) then
    … …  
    26032603         do im = 1, nd
    26042604         do il = 1, ncum   
    2605            ! colorier le condensat en un tag spécifique
     2605           ! colorier le condensat en un tag specifique
    26062606           do ixt=niso+1,ntraciso
    26072607             if (index_zone(ixt).eq.izone_cond) then
    … …  
    27392739  ! ------------------------------------------------------
    27402740!#ifdef ISOVERIF
    2741 !        write(*,*) 'cv30_routines 2382: entrée dans cv3_unsat'
     2741!        write(*,*) 'cv30_routines 2382: entree dans cv3_unsat'
    27422742!#endif
    27432743
    … …  
    27472747  mp(:, :) = 0.
    27482748#ifdef ISO
    2749   ! initialisation plus complète de water et rp
     2749  ! initialisation plus complete de water et rp
    27502750  water(:,:)=0.0
    27512751  xtwater(:,:,:)=0.0
    … …  
    29362936        call iso_verif_traceur(xtwdtrain(1,il),'cv30_routine 2540')
    29372937        if (option_cond.ge.1) then
    2938            ! on vérifie que tout le détrainement est taggé condensat
     2938           ! on verifie que tout le detrainement est tagge condensat
    29392939           if (iso_verif_positif_nostop( &
    29402940     &          xtwdtrain(index_trac(izone_cond,iso_eau),il) &
    … …  
    30323032
    30333033#ifdef ISO
    3034       ! ajout cam: éviter les evaporations ou eaux négatives
    3035 !      water(il,i)=max(0.0,water(il,i)) ! ceci est toujours vérifié
     3034      ! ajout cam: eviter les evaporations ou eaux negatives
     3035!      water(il,i)=max(0.0,water(il,i)) ! ceci est toujours verifie
    30363036#ifdef ISOVERIF
    30373037          call iso_verif_positif(water(il,i),'cv30_unsat 2376')
    … …  
    31893189#ifdef ISO
    31903190#ifdef ISOVERIF
    3191 ! verif des inputs à appel stewart
     3191! verif des inputs a appel stewart
    31923192!        write(*,*) 'cv30_routines 2842 tmp: appel de appel_stewart'
    31933193      do il=1,ncum
    … …  
    32083208       enddo
    32093209#endif
    3210         ! appel de appel_stewart_vectorisé
     3210        ! appel de appel_stewart_vectorise
    32113211        call appel_stewart_vectall(lwork,ncum, &
    32123212     &                   ph,t,evap,xtwdtrain, &
    … …  
    32683268#endif
    32693269       
    3270 ! équivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
     3270! equivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
    32713271       do il=1,ncum
    32723272        if (i.lt.inb(il) .and. lwork(il)) then
    … …  
    34633463      real xtbx(ntraciso), xtawat(ntraciso)
    34643464      ! cam debug
    3465       ! pour l'homogénéisation sous le nuage:
     3465      ! pour l'homogeneisation sous le nuage:
    34663466      real frsum(nloc), bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
    3467       ! correction dans calcul tendance liée à Am:
     3467      ! correction dans calcul tendance liee a Am:
    34683468      real dq_tmp,k_tmp,dx_tmp,R_tmp,dqreste_tmp,dxreste_tmp,kad_tmp
    34693469      logical correction_excess_aberrant
    34703470      parameter (correction_excess_aberrant=.false.)
    3471         ! correction qui permettait d'éviter deltas et dexcess aberrants. Mais
     3471        ! correction qui permettait d'eviter deltas et dexcess aberrants. Mais
    34723472        ! pb: ne conserve pas la masse d'isotopes!
    34733473#ifdef DIAGISO
    3474         ! diagnostiques juste: tendance des différents processus
     3474        ! diagnostiques juste: tendance des differents processus
    34753475      real fxt_detrainement(ntraciso,nloc,nd)
    34763476      real fxt_fluxmasse(ntraciso,nloc,nd)
    … …  
    35173517#ifdef ISO
    35183518       ! cam debug
    3519 !       write(*,*) 'cv30_routines 3082: entrée dans cv3_yield'
     3519!       write(*,*) 'cv30_routines 3082: entree dans cv3_yield'
    35203520       ! en cam debug
    35213521       do ixt = 1, ntraciso
    … …  
    37493749        do ixt = 1, ntraciso
    37503750!        fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) &
    3751 !     &      +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) ! déplacé
    3752 !     plus haut car il existe différents cas
     3751!     &      +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) ! deplace
     3752!     plus haut car il existe differents cas
    37533753        fxt_ddft(ixt,il,1)=fxt_ddft(ixt,il,1) &
    37543754     &      +0.01*grav*mp(il,2)*(xtp(ixt,il,2)-xt(ixt,il,1))*work(il)
    … …  
    37593759
    37603760
    3761         ! pour l'ajout de la tendance liée au flux de masse Am, il faut être
     3761        ! pour l'ajout de la tendance liee au flux de masse Am, il faut etre
    37623762        ! prudent.
    37633763        ! On a dq1=k*(q2-q1) avec k=dt*0.01*grav*am(il)*work(il)
    3764         ! Pour les isotopes, la formule utilisée depuis 2006 et qui avait toujours marché est:
     3764        ! Pour les isotopes, la formule utilisee depuis 2006 et qui avait toujours marche est:
    37653765        ! dx1=k*(x2-x1)
    3766         ! Mais on plante dans un cas pathologique en décembre 2017 lors du test
    3767         ! d'un cas d'Anne Cozic: les isotopes deviennent négatifs.
     3766        ! Mais on plante dans un cas pathologique en decembre 2017 lors du test
     3767        ! d'un cas d'Anne Cozic: les isotopes deviennent negatifs.
    37683768        ! C'est un cas pas physique: on perd 99% de la masse de vapeur d'eau!
    37693769        ! q2=1.01e-3 et q1=1.25e-3 kg/kg
    3770         ! et dq=-1.24e-3: comment est-ce possible qu'un flux venant d'un air à
    3771         ! q2= 1.01e-3 assèche q1 jusqu'à 0.01e-3kg/kg!
    3772         ! Pour les isotopes, ça donne des x1+dx négatifs.
    3773         ! Ce n'est pas physique mais il faut quand même s'adapter.
    3774         ! Pour cela, on considère que d'abord on fait rentrer le flux de masse
     3770        ! et dq=-1.24e-3: comment est-ce possible qu'un flux venant d'un air a
     3771        ! q2= 1.01e-3 asseche q1 jusqu'a 0.01e-3kg/kg!
     3772        ! Pour les isotopes, ca donne des x1+dx negatifs.
     3773        ! Ce n'est pas physique mais il faut quand meme s'adapter.
     3774        ! Pour cela, on considere que d'abord on fait rentrer le flux de masse
    37753775        ! descendant, et ensuite seulement on fait sortir le flux de masse
    37763776        ! sortant.
    … …  
    37783778        ! isotopique de la vapeur d'eau q1.
    37793779        ! A la fin, on a R=(x1+dx)/(q1+dq)=(x1+k*x2)/(q1+k*q2)
    3780         ! On vérifie que quand k est petit, on tend vers la formulation
     3780        ! On verifie que quand k est petit, on tend vers la formulation
    37813781        ! habituelle.
    3782         ! Comme on est habitués à la formulation habituelle, qu'elle a fait ses
    3783         ! preuves, on la garde sauf dans le cas où dq/q<-0.9 où on utilise la
     3782        ! Comme on est habitues a la formulation habituelle, qu'elle a fait ses
     3783        ! preuves, on la garde sauf dans le cas ou dq/q<-0.9 ou on utilise la
    37843784        ! nouvelle formulation.
    37853785        ! rappel: dq_tmp=0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)*delt
    3786         ! Même avec cette nouvelle foirmulation, on a encore des isotopes
    3787         ! négatifs, cette fois à cause des ddfts
    3788         ! On considère donc les tendances et série et non en parallèle quand on
     3786        ! Meme avec cette nouvelle foirmulation, on a encore des isotopes
     3787        ! negatifs, cette fois a cause des ddfts
     3788        ! On considere donc les tendances et serie et non en parallele quand on
    37893789        ! calcule R_tmp.
    37903790        dq_tmp=0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)*delt ! utile ci-dessous
    37913791        if ((dq_tmp/rr(il,1).lt.-0.9).and.correction_excess_aberrant) then
    3792                 ! nouvelle formulation où on fait d'abord entrer k*q2 et ensuite
     3792                ! nouvelle formulation ou on fait d'abord entrer k*q2 et ensuite
    37933793                ! seulement on fait sortir k*q1 sans changement de composition
    37943794                ! isotopique
    … …  
    38283828           enddo ! do ixt = 1, ntraciso
    38293829        else !if (dq_tmp/rr(il,1).lt.-0.9) then
    3830                 ! formulation habituelle qui avait toujours marché de 2006 à
    3831                 ! décembre 2017.
     3830                ! formulation habituelle qui avait toujours marche de 2006 a
     3831                ! decembre 2017.
    38323832           do ixt = 1, ntraciso     
    38333833                fxt(ixt,il,1)=fxt(ixt,il,1) &
    … …  
    42324232        ! ad.
    42334233#endif
    4234        ! ici, on sépare 2 cas, pour éviter le cas pathologique décrit plus haut
    4235        ! pour la tendance liée à Am en i=1, qui peut conduire à des isotopes
    4236        ! négatifs dans les cas où les flux de masse soustrait plus de 90% de la
    4237        ! vapeur de la couche. Voir plus haut le détail des équations.
    4238        ! La différence ici est qu'on considère les flux de masse amp1 et ad en
    4239        ! même temps.
     4234       ! ici, on separe 2 cas, pour eviter le cas pathologique decrit plus haut
     4235       ! pour la tendance liee a Am en i=1, qui peut conduire a des isotopes
     4236       ! negatifs dans les cas ou les flux de masse soustrait plus de 90% de la
     4237       ! vapeur de la couche. Voir plus haut le detail des equations.
     4238       ! La difference ici est qu'on considere les flux de masse amp1 et ad en
     4239       ! meme temps.
    42404240       dq_tmp= 0.01*grav*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i)) &
    42414241    &            -ad(il)*(rr(il,i)-rr(il,i-1)))*delt
    4242        ! c'est équivalent à dqi= kamp1*qip1+kad*qim1-(kamp1+kad)*qi
     4242       ! c'est equivalent a dqi= kamp1*qip1+kad*qim1-(kamp1+kad)*qi
    42434243       if ((dq_tmp/rr(il,i).lt.-0.9).and.correction_excess_aberrant) then
    42444244        ! nouvelle formulation
    … …  
    44304430        ! on change le traitement de cette ligne le 8 mai 2009:
    44314431        ! avant, on avait: xtawat=xtelij(il,k,i)-(1.-xtep(il,i))*xtclw(il,i)
    4432         ! c'est à dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
    4433         ! si Relij!=Rclw, alors un fractionnement isotopique non physique était
     4432        ! c'est a dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
     4433        ! si Relij!=Rclw, alors un fractionnement isotopique non physique etait
    44344434        ! introduit.
    4435         ! En fait, awat représente le surplus de condensat dans le mélange par
    4436         ! rapport à celui restant dans la colonne adiabatique
    4437         ! ce surplus à la même compo que le elij, sans fractionnement.
    4438         ! d'où le nouveau traitement ci-dessous.
     4435        ! En fait, awat represente le surplus de condensat dans le melange par
     4436        ! rapport a celui restant dans la colonne adiabatique
     4437        ! ce surplus a la meme compo que le elij, sans fractionnement.
     4438        ! d'ou le nouveau traitement ci-dessous.
    44394439      if (elij(il,k,i).gt.0.0) then
    44404440        do ixt = 1, ntraciso
    44414441          xtawat(ixt)=awat*(xtelij(ixt,il,k,i)/elij(il,k,i))
    4442 !          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas nécessaire
     4442!          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
    44434443        enddo
    44444444      else !if (elij(il,k,i).gt.0.0) then
    44454445          ! normalement, si elij(il,k,i)<=0, alors awat=0
    4446           ! on le vérifie. Si c'est vrai -> xtawat=0 aussi
     4446          ! on le verifie. Si c'est vrai -> xtawat=0 aussi
    44474447#ifdef ISOVERIF
    44484448        call iso_verif_egalite(awat,0.0,'cv30_yield 3779')
    … …  
    49424942     &       'cv30_yield 5029,O18, evap')
    49434943          if ((il.eq.1636).and.(i.eq.9)) then
    4944             write(*,*) 'cv30_yield 5057: ici, on vérifie deltaD_nobx'
     4944            write(*,*) 'cv30_yield 5057: ici, on verifie deltaD_nobx'
    49454945            write(*,*) 'il,i=',il,i
    49464946            write(*,*) 'fr(il,i),bx,fr(il,i)-bx=',fr(il,i),bx,fr(il,i)-bx
    … …  
    49734973        else ! taggage des ddfts:
    49744974        ! la formule pour fq_ddft suppose que le ddft est en RP. Ce n'est pas le
    4975         ! cas pour le water tagging puisqu'il y a conversion des molécules
    4976         ! blances entrainées en molécule rouges.
     4975        ! cas pour le water tagging puisqu'il y a conversion des molecules
     4976        ! blances entrainees en molecule rouges.
    49774977        ! Il faut donc prendre en compte ce taux de conversion quand
    49784978        ! entrainement d'env vers ddft
    … …  
    49834983!     :           -conversion(iiso)   
    49844984
    4985         ! Pb: quand on discretise, dqp/dt n'est pas vérifée numériquement.
    4986         ! on se retrouve donc avec des d Ye/dt différents de 0 même si ye=0 ( on
    4987         ! note X les molécules poubelles et Y les molécules ddfts).
     4985        ! Pb: quand on discretise, dqp/dt n'est pas verifee numeriquement.
     4986        ! on se retrouve donc avec des d Ye/dt differents de 0 meme si ye=0 ( on
     4987        ! note X les molecules poubelles et Y les molecules ddfts).
    49884988
    49894989        ! Solution alternative: Dans le cas entrainant, Ye ne varie que par
    49904990        ! ascendance compensatoire des ddfts et par perte de Ye vers le ddft. On
    4991         ! calcule donc ce terme directement avec schéma amont:
    4992 
    4993         ! ajout déjà de l'évap
     4991        ! calcule donc ce terme directement avec schema amont:
     4992
     4993        ! ajout deja de l'evap
    49944994        do ixt = 1+niso,ntraciso
    49954995             fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    50695069#endif
    50705070                else !if (abs(dXe).gt.ridicule) then
    5071                     ! dans ce cas, fxtXe doit être faible
     5071                    ! dans ce cas, fxtXe doit etre faible
    50725072                   
    50735073#ifdef ISOVERIF
    … …  
    50855085                      fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
    50865086                    else !if (izone.eq.izone_poubelle) then
    5087                         ! pas de tendance pour ce tag là
     5087                        ! pas de tendance pour ce tag la
    50885088                    endif !if (izone.eq.izone_poubelle) then
    50895089                   endif !if ((izone.ne.izone_revap).and.
    … …  
    50995099               
    51005100            else !if (mp(il,i).gt.mp(il,i+1)) then
    5101                 ! cas détrainant: pas de problèmes
     5101                ! cas detrainant: pas de problemes
    51025102                do ixt=1+niso,ntraciso
    51035103                fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    53895389  DO il = 1, ncum
    53905390
    5391 ! attention, on corrige un problème C Risi
     5391! attention, on corrige un probleme C Risi
    53925392      IF (cvflag_grav) then
    53935393
    … …  
    57225722!             write(*,*) 'cv30_routine 3990: fin des il pour i=',i
    57235723          enddo !do i=1,nl
    5724 !          write(*,*) 'cv30_routine 3990: fin des vérifs sur homogen'
     5724!          write(*,*) 'cv30_routine 3990: fin des verifs sur homogen'
    57255725#endif
    57265726
    … …  
    60276027
    60286028  ! fraction deau condensee dans les melanges convertie en precip : epm
    6029   ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
     6029  ! et eau condensee precipitee dans masse d'air sature : l_m*dM_m/dzdz.dzdz
    60306030  DO j = 1, nam1
    60316031    DO k = 1, j - 1
    … …  
    62266226
    62276227#ifdef ISOVERIF
    6228         write(*,*) 'cv30_routines 4293: entrée dans cv3_uncompress'
     6228        write(*,*) 'cv30_routines 4293: entree dans cv3_uncompress'
    62296229#endif
    62306230  DO i = 1, ncum
    … …  
    63466346
    63476347        ! On fait varier epmax en fn de la cape
    6348         ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
    6349         ! qui en dépend
    6350         ! Toutes les autres variables fn de ep sont calculées plus bas.
     6348        ! Il faut donc recalculer ep, et hp qui a deja ete calcule et
     6349        ! qui en depend
     6350        ! Toutes les autres variables fn de ep sont calculees plus bas.
    63516351
    63526352#include "cvthermo.h"

  • LMDZ6/trunk/libf/phylmdiso/cv3_routines.F90

    r4033 r4050  
    403403        enddo !do i=1,len
    404404#endif         
    405 ! initialiser quelques variables oubliées
     405! initialiser quelques variables oubliees
    406406       do i=1,len
    407407          plcllo(i)=0.0
    … …  
    900900          zfice(i) = MIN(MAX(zfice(i),0.0),1.0)         
    901901       enddo
    902        ! calcul de la composition du condensat glacé et liquide
     902       ! calcul de la composition du condensat glace et liquide
    903903
    904904       do i=1,len
    … …  
    959959
    960960#ifdef ISOVERIF
    961             write(*,*) 'cv3_routine undilute 1 598: après condiso'
     961            write(*,*) 'cv3_routine undilute 1 598: apres condiso'
    962962         
    963963          if (iso_eau.gt.0) then
    … …  
    14351435
    14361436!JAM--------------------------------------------------------------------
    1437 ! Calcul de la quantité d'eau sous forme de glace
     1437! Calcul de la quantite d'eau sous forme de glace
    14381438! --------------------------------------------------------------------
    14391439  INTEGER nl, len
    … …  
    28562856      real xtrti(ntraciso,nloc)
    28572857      real xtres(ntraciso)
    2858       ! on ajoute la dimension nloc à xtrti pour vérifs dans les tags: 5 fev
     2858      ! on ajoute la dimension nloc a xtrti pour verifs dans les tags: 5 fev
    28592859      ! 2010
    28602860      real zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)
    … …  
    28732873#ifdef ISO
    28742874#ifdef ISOVERIF
    2875 !       write(*,*) 'cv3_routines 1820: entrée dans cv3_mixing'
     2875!       write(*,*) 'cv3_routines 1820: entree dans cv3_mixing'
    28762876       do i=minorig+1,nl
    28772877        do il=1,ncum
    … …  
    30833083!     :           'tcond(il),rs(il,j)=',
    30843084!     :            il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
    3085         ! colorier la vapeur résiduelle selon température de
    3086         ! condensation, et le condensat en un tag spécifique
     3085        ! colorier la vapeur residuelle selon temperature de
     3086        ! condensation, et le condensat en un tag specifique
    30873087          if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) then 
    30883088            if (option_traceurs.eq.17) then       
    … …  
    31943194#ifdef ISOTRAC         
    31953195        if (option_tmin.ge.1) then
    3196         ! colorier la vapeur résiduelle selon température de
    3197         ! condensation, et le condensat en un tag spécifique
     3196        ! colorier la vapeur residuelle selon temperature de
     3197        ! condensation, et le condensat en un tag specifique
    31983198!        write(*,*) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=',
    31993199!     :            il,i,j,xtent(:,il,i,j)
    … …  
    34313431#ifdef ISOTRAC         
    34323432        if (option_tmin.ge.1) then
    3433         ! colorier la vapeur résiduelle selon température de
    3434         ! condensation, et le condensat en un tag spécifique
     3433        ! colorier la vapeur residuelle selon temperature de
     3434        ! condensation, et le condensat en un tag specifique
    34353435!        write(*,*) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=',
    34363436!     :            il,i,j,xtent(:,il,i,j)
    … …  
    35433543#ifdef ISO
    35443544#ifdef ISOTRAC
    3545         ! seulement à la fin on taggue le condensat
     3545        ! seulement a la fin on taggue le condensat
    35463546        if (option_cond.ge.1) then
    35473547         do im = 1, nd
    35483548         do jm = 1, nd
    35493549         do il = 1, ncum   
    3550            ! colorier le condensat en un tag spécifique
     3550           ! colorier le condensat en un tag specifique
    35513551           do ixt=niso+1,ntraciso
    35523552             if (index_zone(ixt).eq.izone_cond) then
    … …  
    35673567         do im = 1, nd
    35683568         do il = 1, ncum   
    3569            ! colorier le condensat en un tag spécifique
     3569           ! colorier le condensat en un tag specifique
    35703570           do ixt=niso+1,ntraciso
    35713571             if (index_zone(ixt).eq.izone_cond) then
    … …  
    39913991        call iso_verif_traceur(xtwdtrain(1,il),'cv3_routine 2540')
    39923992        if (option_cond.ge.1) then
    3993           ! on vérifie que tout le détrainement est taggé condensat
     3993          ! on verifie que tout le detrainement est tagge condensat
    39943994          if (iso_verif_positif_nostop( &
    39953995     &          xtwdtrain(index_trac(izone_cond,iso_eau),il) &
    … …  
    41564156!!---end jyg---
    41574157
    4158 ! --------retour à la formulation originale d'Emanuel.
     4158! --------retour a la formulation originale d'Emanuel.
    41594159        IF (cvflag_ice) THEN
    41604160
    … …  
    41704170
    41714171!JAM  Attention: evap=sigt*E
    4172 !    Modification: evap devient l'évaporation en milieu de couche
    4173 !    car nécessaire dans cv3_yield
    4174 !    Du coup, il faut modifier pas mal d'équations...
     4172!    Modification: evap devient l'evaporation en milieu de couche
     4173!    car necessaire dans cv3_yield
     4174!    Du coup, il faut modifier pas mal d'equations...
    41754175!    et l'expression de afac qui devient afac1
    41764176!    revap=sqrt((prec(i+1)+prec(i))/2)
    … …  
    41914191!JYG    Dans sa formulation originale, Emanuel calcule l'evaporation par:
    41924192! c             evap(il,i)=sigt*afac*revap
    4193 ! ce qui n'est pas correct. Dans cv_routines, la formulation a été modifiee.
     4193! ce qui n'est pas correct. Dans cv_routines, la formulation a ete modifiee.
    41944194! Ici,l'evaporation evap est simplement calculee par l'equation de
    41954195! conservation.
    … …  
    45254525#ifdef ISO
    45264526#ifdef ISOVERIF
    4527 ! verif des inputs à appel stewart
     4527! verif des inputs a appel stewart
    45284528      do il=1,ncum
    45294529       if (i.le.inb(il) .and. lwork(il)) then
    … …  
    45434543       enddo
    45444544#endif
    4545         ! appel de appel_stewart_vectorisé
     4545        ! appel de appel_stewart_vectorise
    45464546        call appel_stewart_vectall_np(lwork,ncum, &
    45474547     &                   ph,t,evap,xtwdtrain, &
    … …  
    46114611#endif
    46124612       
    4613 ! équivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
     4613! equivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i))
    46144614       do il=1,ncum
    46154615        if (i.lt.inb(il) .and. lwork(il)) then
    … …  
    46514651#endif
    46524652          rpprec(il,i)=rs(il,i)     
    4653          ! sous cas rajouté le 11dec 2011. Normalement, pas utile
     4653         ! sous cas rajoute le 11dec 2011. Normalement, pas utile
    46544654         else if (rp(il,i).eq.0.0) then                 
    46554655            do ixt=1,ntraciso
    … …  
    48644864      real xtbx(ntraciso), xtawat(ntraciso,nloc)
    48654865      ! cam debug
    4866       ! pour l'homogénéisation sous le nuage:
     4866      ! pour l'homogeneisation sous le nuage:
    48674867      real bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)
    48684868#ifdef DIAGISO
    4869         ! diagnostiques juste: tendance des différents processus
     4869        ! diagnostiques juste: tendance des differents processus
    48704870      real fxt_detrainement(niso,nloc,nd)
    48714871      real fxt_fluxmasse(niso,nloc,nd)
    … …  
    49174917#ifdef ISO
    49184918       ! cam debug
    4919 !       write(*,*) 'cv3_routines 3082: entrée dans cv3_yield'
     4919!       write(*,*) 'cv3_routines 3082: entree dans cv3_yield'
    49204920       ! en cam debug
    49214921       do ixt = 1, ntraciso
    … …  
    49944994  END DO
    49954995#ifdef ISO
    4996 ! on initialise mieux fr et fxt par securité
     4996! on initialise mieux fr et fxt par securite
    49974997  fr(:,:)=0.0
    49984998  fxt(:,:,:)=0.0
    … …  
    58455845        else ! taggage des ddfts:
    58465846        ! la formule pour fq_ddft suppose que le ddft est en RP. Ce n'est pas le
    5847         ! cas pour le water tagging puisqu'il y a conversion des molécules
    5848         ! blances entrainées en molécule rouges.
     5847        ! cas pour le water tagging puisqu'il y a conversion des molecules
     5848        ! blances entrainees en molecule rouges.
    58495849        ! Il faut donc prendre en compte ce taux de conversion quand
    58505850        ! entrainement d'env vers ddft
    … …  
    58555855!     :           -conversion(iiso)   
    58565856
    5857         ! Pb: quand on discretise, dqp/dt n'est pas vérifée numériquement.
    5858         ! on se retrouve donc avec des d Ye/dt différents de 0 même si ye=0 ( on
    5859         ! note X les molécules poubelles et Y les molécules ddfts).
     5857        ! Pb: quand on discretise, dqp/dt n'est pas verifee numeriquement.
     5858        ! on se retrouve donc avec des d Ye/dt differents de 0 meme si ye=0 ( on
     5859        ! note X les molecules poubelles et Y les molecules ddfts).
    58605860
    58615861        ! Solution alternative: Dans le cas entrainant, Ye ne varie que par
    58625862        ! ascendance compensatoire des ddfts et par perte de Ye vers le ddft. On
    5863         ! calcule donc ce terme directement avec schéma amont:
    5864 
    5865         ! ajout déjà de l'évap
     5863        ! calcule donc ce terme directement avec schema amont:
     5864
     5865        ! ajout deja de l'evap
    58665866        do ixt = 1+niso,ntraciso
    58675867             fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    59415941#endif
    59425942                else !if (abs(dXe).gt.ridicule) then
    5943                     ! dans ce cas, fxtXe doit être faible
     5943                    ! dans ce cas, fxtXe doit etre faible
    59445944                   
    59455945#ifdef ISOVERIF
    … …  
    59575957                      fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
    59585958                    else !if (izone.eq.izone_poubelle) then
    5959                         ! pas de tendance pour ce tag là
     5959                        ! pas de tendance pour ce tag la
    59605960                    endif !if (izone.eq.izone_poubelle) then
    59615961                   endif !if ((izone.ne.izone_revap).and.
    … …  
    59715971               
    59725972            else !if (mp(il,i).gt.mp(il,i+1)) then
    5973                 ! cas détrainant: pas de problèmes
     5973                ! cas detrainant: pas de problemes
    59745974                do ixt=1+niso,ntraciso
    59755975                fxt(ixt,il,i)=fxt(ixt,il,i) &
    … …  
    61766176        ! on change le traitement de cette ligne le 8 mai 2009:
    61776177        ! avant, on avait: xtawat=xtelij(il,k,i)-(1.-xtep(il,i))*xtclw(il,i)
    6178         ! c'est à dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
    6179         ! si Relij!=Rclw, alors un fractionnement isotopique non physique était
     6178        ! c'est a dire que Rawat=Relij+(1-ep)*clw/awat*(Relij-Rclw)
     6179        ! si Relij!=Rclw, alors un fractionnement isotopique non physique etait
    61806180        ! introduit.
    6181         ! En fait, awat représente le surplus de condensat dans le mélange par
    6182         ! rapport à celui restant dans la colonne adiabatique
    6183         ! ce surplus à la même compo que le elij, sans fractionnement.
    6184         ! d'où le nouveau traitement ci-dessous.
     6181        ! En fait, awat represente le surplus de condensat dans le melange par
     6182        ! rapport a celui restant dans la colonne adiabatique
     6183        ! ce surplus a la meme compo que le elij, sans fractionnement.
     6184        ! d'ou le nouveau traitement ci-dessous.
    61856185      if (elij(il,k,i).gt.0.0) then
    61866186        do ixt = 1, ntraciso
    61876187          xtawat(ixt,il)=awat(il)*(xtelij(ixt,il,k,i)/elij(il,k,i))
    6188 !          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas nécessaire
     6188!          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
    61896189        enddo !do ixt = 1, ntraciso
    61906190      else !if (elij(il,k,i).gt.0.0) then
    61916191          ! normalement, si elij(il,k,i)<=0, alors awat=0
    6192           ! on le vérifie. Si c'est vrai -> xtawat=0 aussi
     6192          ! on le verifie. Si c'est vrai -> xtawat=0 aussi
    61936193#ifdef ISOVERIF
    61946194        call iso_verif_egalite(awat(il),0.0,'cv3_yield 3779')
    … …  
    68506850        fq_detrainement(il, i) = fq_detrainement(il, i)/alpha_qpos(il)
    68516851        do ixt=1,ntraciso
    6852           fq_ddft(ixt,il, i) = fq_ddft(ixt,il, i)/alpha_qpos(il)
    6853           fq_evapprecip(ixt,il, i) = fq_evapprecip(ixt,il, i)/alpha_qpos(il)
    6854           fq_fluxmasse(ixt,il, i) = fq_fluxmasse(ixt,il, i)/alpha_qpos(il)
    6855           fq_detrainement(ixt,il, i) = fq_detrainement(ixt,il, i)/alpha_qpos(il)
     6852          fxt_ddft(ixt,il, i) = fxt_ddft(ixt,il, i)/alpha_qpos(il)
     6853          fxt_evapprecip(ixt,il, i) = fxt_evapprecip(ixt,il, i)/alpha_qpos(il)
     6854          fxt_fluxmasse(ixt,il, i) = fxt_fluxmasse(ixt,il, i)/alpha_qpos(il)
     6855          fxt_detrainement(ixt,il, i) = fxt_detrainement(ixt,il, i)/alpha_qpos(il)
    68566856        enddo ! do ixt=1,ntraciso
    68576857#endif       
    … …  
    71797179    ENDDO       ! k
    71807180
    7181 ! 14/01/15 AJ delta n'a rien à faire là...                                                 
     7181! 14/01/15 AJ delta n'a rien a faire la...                                                 
    71827182    DO il = 1, ncum                                                  ! cld
    71837183!!      IF (wa(il,i)>0.0 .AND. iflag(il)<=1) &                         ! cld
    … …  
    71957195
    71967196! IM cf. FH
    7197 ! 14/01/15 AJ ne correspond pas à ce qui a été codé par JYG et SB           
     7197! 14/01/15 AJ ne correspond pas a ce qui a ete code par JYG et SB           
    71987198                                                         
    71997199      IF (iflag_clw==0) THEN                                         ! cld
    … …  
    72907290
    72917291! fraction deau condensee dans les melanges convertie en precip : epm
    7292 ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
     7292! et eau condensee precipitee dans masse d'air sature : l_m*dM_m/dzdz.dzdz
    72937293  DO j = 1, nl
    72947294    DO k = 1, nl
    … …  
    75767576
    75777577        ! On fait varier epmax en fn de la cape
    7578         ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
    7579         ! qui en dépend
    7580         ! Toutes les autres variables fn de ep sont calculées plus bas.
     7578        ! Il faut donc recalculer ep, et hp qui a deja ete calcule et
     7579        ! qui en depend
     7580        ! Toutes les autres variables fn de ep sont calculees plus bas.
    75817581
    75827582  include "cvthermo.h"
    … …  
    76137613
    76147614        ! il faut calculer la cape: on fait un calcule simple car tant qu'on ne
    7615         ! connait pas ep, on ne connait pas les mélanges, ddfts etc... qui sont
     7615        ! connait pas ep, on ne connait pas les melanges, ddfts etc... qui sont
    76167616        ! necessaires au calcul de la cape dans la nouvelle physique
    76177617       

  • LMDZ6/trunk/libf/phylmdiso/infotrac_phy.F90

    r4048 r4050  
    5151  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
    5252!$OMP THREADPRIVATE(niadv)
    53 
    54 ! CRisi: tableaux de fils
    55   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
    56   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations
    57   INTEGER, SAVE :: nqdesc_tot
    58   INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    59   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iqpere
    60 !$OMP THREADPRIVATE(nqfils,nqdesc,nqdesc_tot,iqfils,iqpere)
    6153
    6254! conv_flg(it)=0 : convection desactivated for tracer number it
    … …  
    8476    INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    8577!$OMP THREADPRIVATE(iqiso)
    86     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
    87 !$OMP THREADPRIVATE(iso_num)
    8878    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
    8979!$OMP THREADPRIVATE(iso_indnum)
    90     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
    91 !$OMP THREADPRIVATE(zone_num)
    92     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
    93 !$OMP THREADPRIVATE(phase_num)
    9480    INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
    9581!$OMP THREADPRIVATE(indnum_fn_num)
    … …  
    10692  SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,nqtottr_,nqCO2_,tracers_,type_trac_,&
    10793                               niadv_,conv_flg_,pbl_flg_,solsym_,&
    108                                nqfils_,nqdesc_,nqdesc_tot_,iqfils_,iqpere_,&
    10994                               ok_isotopes_,ok_iso_verif_,ok_isotrac_,&
    11095                               ok_init_iso_,niso_possibles_,tnat_,&
    111                                alpha_ideal_,use_iso_,iqiso_,iso_num_,&
    112                                iso_indnum_,zone_num_,phase_num_,&
     96                               alpha_ideal_,use_iso_,iqiso_,iso_indnum_,&
    11397                               indnum_fn_num_,index_trac_,&
    11498                               niso_,ntraceurs_zone_,ntraciso_,itr_indice_&
    … …  
    143127    CHARACTER(len=*),INTENT(IN) :: solsym_(nbtr_)
    144128    ! Isotopes:
    145     INTEGER,INTENT(IN) :: nqfils_(nqtot_)
    146     INTEGER,INTENT(IN) :: nqdesc_(nqtot_)
    147     INTEGER,INTENT(IN) :: nqdesc_tot_
    148     INTEGER,INTENT(IN) :: iqfils_(nqtot_,nqtot_)
    149     INTEGER,INTENT(IN) :: iqpere_(nqtot_)
    150129    LOGICAL,INTENT(IN) :: ok_isotopes_
    151130    LOGICAL,INTENT(IN) :: ok_iso_verif_
    … …  
    157136    LOGICAL,INTENT(IN) :: use_iso_(niso_possibles_)
    158137    INTEGER,INTENT(IN) :: iqiso_(ntraciso_,nqo_)
    159     INTEGER,INTENT(IN) :: iso_num_(nqtot_)
    160138    INTEGER,INTENT(IN) :: iso_indnum_(nqtot_)
    161     INTEGER,INTENT(IN) :: zone_num_(nqtot_)
    162     INTEGER,INTENT(IN) :: phase_num_(nqtot_)
    163139    INTEGER,INTENT(IN) :: indnum_fn_num_(niso_possibles_)
    164140    INTEGER,INTENT(IN) :: index_trac_(ntraceurs_zone_,niso_)
    … …  
    216192   
    217193    IF (ok_isotopes) THEN
    218       ALLOCATE(nqfils(nqtot))
    219       nqfils(:)=nqfils_(:)
    220       ALLOCATE(nqdesc(nqtot))
    221       nqdesc(:)=nqdesc_(:)
    222       nqdesc_tot=nqdesc_tot_
    223       ALLOCATE(iqfils(nqtot,nqtot))
    224       iqfils(:,:)=iqfils_(:,:)
    225       ALLOCATE(iqpere(nqtot))
    226       iqpere(:)=iqpere_(:)
    227    
    228194      tnat(:)=tnat_(:)
    229195      alpha_ideal(:)=alpha_ideal_(:)
    … …  
    232198      ALLOCATE(iqiso(ntraciso,nqo))
    233199      iqiso(:,:)=iqiso_(:,:)
    234       ALLOCATE(iso_num(nqtot))
    235       iso_num(:)=iso_num_(:)
    236200      ALLOCATE(iso_indnum(nqtot))
    237201      iso_indnum(:)=iso_indnum_(:)
    238       ALLOCATE(zone_num(nqtot))
    239       zone_num(:)=zone_num_(:)
    240       ALLOCATE(phase_num(nqtot))
    241       phase_num(:)=phase_num_(:)
    242202     
    243203      indnum_fn_num(:)=indnum_fn_num_(:)
    … …  
    255215        write(*,*) 'itr_indice=',itr_indice
    256216#ifdef ISOVERIF
    257         write(*,*) 'iso_num=',iso_num
     217        write(*,*) 'iso_iName=',tracers(:)%iso_iName
    258218#endif
    259219 

  • LMDZ6/trunk/libf/phylmdiso/isotopes_verif_mod.F90

    r4033 r4050  
    21232123       end function iso_verif_tracdD_choix_nostop
    21242124
    2125        subroutine iso_verif_trac17_q_deltaD(x,err_msg)
    2126         use isotrac_mod, only: nzone_temp,option_traceurs
    2127         USE infotrac_phy, ONLY: ntraciso
    2128        implicit none
    2129 
    2130         ! inputs
    2131         real x(ntraciso)
    2132         character*(*) err_msg
    2133         ! local
    2134         integer iso_verif_tag17_q_deltaD_chns
    2135 
    2136        if ((option_traceurs.eq.17).or. &
    2137      &           (option_traceurs.eq.18)) then
    2138        if (nzone_temp.ge.5) then
    2139           if (iso_verif_tag17_q_deltaD_chns(x,err_msg).eq.1) then
    2140                 stop
    2141           endif
    2142         endif
    2143         endif !if (option_traceurs.eq.17) then
    2144 
    2145         end subroutine iso_verif_trac17_q_deltaD
     2125INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
     2126  USE infotrac_phy, ONLY: index_trac, ntraciso
     2127  USE isotopes_mod, ONLY: iso_HDO, iso_eau, ridicule
     2128  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
     2129  IMPLICIT NONE
     2130  REAL,             INTENT(IN) :: x(ntraciso)
     2131  CHARACTER(LEN=*), INTENT(IN) :: err_msg
     2132  INTEGER :: ieau, ixt, ieau1
     2133  res = 0
     2134  IF(ALL([17,18]/=option_traceurs)) RETURN
     2135  !--- Check whether * deltaD(highest tagging layer) < 200 permil
     2136  !                  * q <
     2137  ieau=index_trac(nzone_temp,iso_eau)
     2138  ixt=index_trac(nzone_temp,iso_HDO)
     2139  IF(x(ieau)>ridicule) THEN
     2140    IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
     2141      res=1; write(*,*) 'x=',x
     2142    END IF
     2143  END IF
     2144  IF(iso_verif_positif_nostop(2.0e-3-x(ieau),err_msg//': qt05 trop fort')==1) THEN
     2145    res=1; write(*,*) 'x=',x
     2146  END IF
     2147  !--- Check whether q is small ; then, qt01 < 10%
     2148  IF(x(iso_eau)<2.0e-3) THEN
     2149    ieau1= index_trac(1,iso_eau)
     2150    IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
     2151      res=1; write(*,*) 'x=',x
     2152    END IF
     2153  END IF
     2154END FUNCTION iso_verif_tag17_q_deltaD_chns
     2155
     2156SUBROUTINE iso_verif_trac17_q_deltaD(x,err_msg)
     2157  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
     2158  USE infotrac_phy, ONLY: ntraciso
     2159  IMPLICIT NONE
     2160  REAL,             INTENT(IN) :: x(ntraciso)
     2161  CHARACTER(LEN=*), INTENT(IN) :: err_msg
     2162  IF(ALL([17,18]/=option_traceurs)) RETURN
     2163  IF(nzone_temp>=5) THEN
     2164    IF(iso_verif_tag17_q_deltaD_chns(x,err_msg)==1) STOP
     2165  END IF
     2166END SUBROUTINE iso_verif_trac17_q_deltaD
    21462167
    21472168      subroutine iso_verif_traceur(x,err_msg)
    … …  
    26762697       
    26772698        end function iso_verif_traceur_jm_nostop
    2678 
    2679         function iso_verif_tag17_q_deltaD_chns(x,err_msg)
    2680         USE infotrac_phy, ONLY: index_trac,ntraciso
    2681         use isotopes_mod, ONLY: iso_HDO,iso_eau,ridicule
    2682         use isotrac_mod, only: nzone_temp,option_traceurs
    2683         implicit none
    2684 
    2685         ! inputs
    2686         real x(ntraciso)
    2687         character*(*) err_msg
    2688         ! output
    2689         integer iso_verif_tag17_q_deltaD_chns
    2690         ! locals
    2691         !integer iso_verif_positif_nostop
    2692         !real deltaD
    2693         integer ieau,ixt,ieau1
    2694 
    2695         iso_verif_tag17_q_deltaD_chns=0
    2696 
    2697         if ((option_traceurs.eq.17).or. &
    2698      &           (option_traceurs.eq.18)) then
    2699         ! verifier que deltaD du tag de la couche la plus haute <
    2700         ! 200 permil, et vérifier que son q est inférieur à
    2701         ieau=index_trac(nzone_temp,iso_eau)
    2702         ixt=index_trac(nzone_temp,iso_HDO)
    2703 
    2704         if (x(ieau).gt.ridicule) then
    2705           if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), &
    2706      &           err_msg//': deltaDt05 trop fort').eq.1) then
    2707                 write(*,*) 'x=',x
    2708                 iso_verif_tag17_q_deltaD_chns=1
    2709           endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
    2710         endif !if (x(ieau).gt.ridicule) then
    2711 
    2712         if (iso_verif_positif_nostop(2.0e-3-x(ieau), &
    2713      &           err_msg//': qt05 trop fort').eq.1) then
    2714                 write(*,*) 'x=',x
    2715                 iso_verif_tag17_q_deltaD_chns=1
    2716         endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
    2717 
    2718         ! on vérifie que si q est petit, alors qt01 fait moins de 10%
    2719         if (x(iso_eau).lt.2.0e-3) then
    2720            ieau1= index_trac(1,iso_eau)
    2721            if (iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)), &
    2722      &            err_msg//': qt01 trop abondant').eq.1) then
    2723              write(*,*) 'x=',x
    2724                 iso_verif_tag17_q_deltaD_chns=1
    2725            endif ! if (iso_verif_positif(0.1-(x(ixt)/x(ieau)),
    2726         endif !if (x(ieau).lt.2.0e-3) then
    2727 
    2728         endif !if (option_traceurs.eq.17) then
    2729 
    2730         end function iso_verif_tag17_q_deltaD_chns
    27312699
    27322700        subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)

  • LMDZ6/trunk/libf/phylmdiso/phyetat0.F90

    r4046 r4050  
    4545  use config_ocean_skin_m, only: activate_ocean_skin
    4646#ifdef ISO
    47   USE infotrac_phy, ONLY: ntraciso,niso,iso_num
     47  USE infotrac_phy, ONLY: niso
    4848  USE isotopes_routines_mod, ONLY: phyisoetat0
    4949  USE isotopes_mod, ONLY: iso_eau

  • LMDZ6/trunk/libf/phylmdiso/phys_output_mod.F90

    r4048 r4050  
    3535    USE iophy
    3636    USE dimphy
    37     USE infotrac_phy, ONLY: nqtot, nqo, niadv, tracers, type_trac, &
     37    USE infotrac_phy, ONLY: nqtot, nqo, niadv, tracers, type_trac, maxlen, &
    3838        nqtottr,itr_indice ! C Risi
    39     USE strings_mod,  ONLY: maxlen
    4039    USE ioipsl
    4140    USE phys_cal_mod, only : hour, calend
    … …  
    537536        write(lunout,*) 'itr_indice=',itr_indice
    538537!       IF (nqtot>=nqo+1) THEN
    539          IF (nqtottr>=1) THEN
    540538!
    541539            !DO iq=nqo+1,nqtot
    … …  
    579577            tnam = 'cum'//TRIM(tracers(iiq)%name); o_trac_cum(itr)= ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    580578          ENDDO
    581        ENDIF
    582579
    583580   ENDDO !  iff

  • LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90

    r4040 r4050  
    123123#ifdef ISO
    124124    USE infotrac_phy, ONLY:  &
    125         iqiso,iso_num,iso_indnum,zone_num,ok_isotrac, &
     125        iqiso,iso_indnum,tracers,ok_isotrac, &
    126126        niso,ntraciso,nqtottr,itr_indice ! ajout C Risi pour isos
    127127     USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO, &
    … …  
    141141        & iso_verif_aberrant_choix,iso_verif_positif, &
    142142        & iso_verif_positif_choix_vect,iso_verif_o18_aberrant_nostop, &
    143         & iso_verif_init, &
     143        & iso_verif_init,&
    144144        & iso_verif_positif_strict_nostop,iso_verif_O18_aberrant_enc_vect2D
    145145#endif
    … …  
    155155&       iso_verif_traceur_justmass,iso_verif_traceur_vect, &
    156156&       iso_verif_trac17_q_deltad,iso_verif_trac_masse_vect, &
    157 &       iso_verif_tracpos_choix_nostop
     157&       iso_verif_tag17_q_deltaD_vect, iso_verif_tracpos_choix_nostop
    158158#endif
    159159#endif
    … …  
    23662366#endif
    23672367      if (ixt.gt.niso) then
    2368       write(*,*) 'izone,iiso=',zone_num(iqiso(ixt,ivap)),iso_indnum(iqiso(ixt,ivap)) 
     2368      write(*,*) 'izone,iiso=',tracers(iqiso(ixt,ivap))%iso_iZone,iso_indnum(iqiso(ixt,ivap)) 
    23692369      endif
    23702370      DO k = 1, klev
Note: See TracChangeset for help on using the changeset viewer.