Ignore:
Timestamp:
Dec 23, 2021, 6:54:17 PM (3 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/dyn3d
Files:
7 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
Note: See TracChangeset for help on using the changeset viewer.