Ignore:
Timestamp:
Dec 23, 2021, 6:54:17 PM (4 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/dyn3dmem
Files:
16 edited

Legend:

Unmodified
Added
Removed

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