Ignore:
Timestamp:
May 9, 2022, 12:35:40 PM (3 years ago)
Author:
dcugnet
Message:
  • Some variables are renamed or replaced by direct equivalents:
    • iso_indnum -> tracers(:)%iso_iName
    • niso_possibles -> niso
    • iqiso -> iqIsoPha ; index_trac -> itZonIso
    • ok_iso_verif -> isoCheck
    • ntraceurs_zone -> nzone ; ntraciso -> ntiso
    • qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio
  • Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times.
  • Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18).
  • The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).
Location:
LMDZ6/trunk/libf/dyn3dmem
Files:
9 edited
1 moved

Legend:

Unmodified
Added
Removed

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

    r4064 r4143  
    1010   !            M.A Filiberti (04/2002)
    1111   !
    12    USE infotrac,     ONLY: nqtot, tracers, ok_iso_verif
     12   USE infotrac,     ONLY: nqtot, tracers
    1313   USE control_mod,  ONLY: iapp_tracvl, day_step, planet_type
    1414   USE comconst_mod, ONLY: dtvr

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

    r4142 r4143  
    1         subroutine check_isotopes(q,ijb,ije,err_msg)
    2         USE infotrac, ONLY: nqtot, nqo, niso, ntraciso, nzone,
    3      &                use_iso, ntraceurs_zone,
    4      &                iqiso, indnum_fn_num, index_trac, tnat
    5         USE parallel_lmdz
    6         implicit none
     1SUBROUTINE check_isotopes(q, ijb, ije, err_msg)
     2   USE parallel_lmdz
     3   USE strings_mod, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
     4   USE infotrac,    ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, &
     5                          ntiso, iH2O, nzone, tracers, isoName,  itZonIso, tnat
     6   IMPLICIT NONE
     7   include "dimensions.h"
     8   REAL,             INTENT(INOUT) :: q(ijb_u:ije_u,llm,nqtot)
     9   INTEGER,          INTENT(IN)    :: ijb, ije   !--- Can be local and different from ijb_u,ije_u, for example in qminimum
     10   CHARACTER(LEN=*), INTENT(IN)    :: err_msg    !--- Error message to display
     11   CHARACTER(LEN=maxlen) :: modname, msg1, nm(2)
     12   INTEGER :: ixt, ipha, k, i, iq, iiso, izon, ieau, iqeau, iqpar
     13   INTEGER, ALLOCATABLE :: ix(:)
     14   REAL    :: xtractot, xiiso, deltaD, q1, q2
     15   REAL, PARAMETER :: borne     = 1e19,  &
     16                      errmax    = 1e-8,  &       !--- Max. absolute error
     17                      errmaxrel = 1e-3,  &       !--- Max. relative error
     18                      qmin      = 1e-11, &
     19                      deltaDmax =1000.0, &
     20                      deltaDmin =-999.0, &
     21                      ridicule  = 1e-12
     22   INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, & !--- OpenMP shared variables
     23                             iso_O17, iso_HTO
     24   LOGICAL, SAVE :: first=.TRUE.
     25!$OMP THREADPRIVATE(first)
    726
    8 #include "dimensions.h"
     27   modname='check_isotopes'
     28   IF(.NOT.isoCheck)    RETURN                   !--- No need to check => finished
     29   IF(isoSelect('H2O')) RETURN                   !--- No H2O isotopes group found
     30   IF(niso == 0)        RETURN                   !--- No isotopes => finished
     31   IF(first) THEN
     32!$OMP MASTER
     33      iso_eau = strIdx(isoName,'H2[16]O')
     34      iso_HDO = strIdx(isoName,'H[2]HO')
     35      iso_O18 = strIdx(isoName,'H2[18]O')
     36      iso_O17 = strIdx(isoName,'H2[17]O')
     37      iso_HTO = strIdx(isoName,'H[3]HO')
     38!$OMP END MASTER
     39!$OMP BARRIER
     40      first = .FALSE.
     41   END IF
     42   CALL msg('31: err_msg='//TRIM(err_msg), modname)
    943
    10         ! inputs
    11         integer ijb,ije ! peut être local et différent de ijb_u,ije_u, ex: dans qminimum
    12         real q(ijb_u:ije_u,llm,nqtot)
    13         character*(*) err_msg ! message d''erreur à afficher
     44   !--- CHECK FOR NaNs (FOR ALL THE ISOTOPES, INCLUDING GEOGRAPHIC TAGGING TRACERS)
     45   modname = 'check_isotopes:iso_verif_noNaN'
     46   DO ixt = 1, ntiso
     47      DO ipha = 1, nphas
     48         iq = iqIsoPha(ixt,ipha)
     49!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     50         DO k = 1, llm
     51            DO i = ijb, ije
     52               IF(ABS(q(i,k,iq))<=borne) CYCLE
     53               WRITE(msg1,'(s,"(",i0,",",i0,",",i0,") = ",ES12.4)')TRIM(isoName(ixt)),i,k,iq,q(i,k,iq)
     54               CALL msg(msg1, modname)
     55               CALL abort_gcm(modname, 'Error with isotopes: '//TRIM(err_msg), 1)
     56            END DO
     57         END DO
     58!$OMP END DO NOWAIT
     59      END DO
     60   END DO
    1461
    15         ! locals
    16         integer ixt,phase,k,i,iq,iiso,izone,ieau,iqeau
    17         real xtractot,xiiso
    18         real borne
    19         real qmin
    20         real errmax ! erreur maximale en absolu.
    21         real errmaxrel ! erreur maximale en relatif autorisée
    22         real deltaDmax,deltaDmin
    23         real ridicule
    24         parameter (borne=1e19)
    25         parameter (errmax=1e-8)
    26         parameter (errmaxrel=1e-3)
    27         parameter (qmin=1e-11)
    28         parameter (deltaDmax=1000.0,deltaDmin=-999.0)
    29         parameter (ridicule=1e-12)
    30         real deltaD
     62   !--- CHECK CONSERVATION (MAIN ISOTOPE AND PARENT CONCENTRATIONS MUST BE EQUAL)
     63   modname = 'check_isotopes:iso_verif_egalite'
     64   ixt = iso_eau
     65   IF(ixt /= 0) THEN
     66      DO ipha = 1, nphas
     67         iq = iqIsoPha(ixt,ipha)
     68         iqpar = tracers(iq)%iqParent
     69!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     70         DO k = 1, llm
     71            DO i = ijb, ije
     72               q1 = q(i,k,iqpar)
     73               q2 = q(i,k,iq)
     74!--- IMPROVEMENT in case at least one isotope is not negligible compared to the main isotopic form.
     75!    This would be probably required to sum from smallest to highest concentrations ; the corresponding
     76!    indices vector can be computed once only (in the initializations stage), using mean concentrations.
     77!              q2 = SUM(q(i,k,tracers(iqPar)%iqDesc), DIM=3)
     78               IF(ABS(q1-q2) <= errmax .OR. ABS(q1-q2)/MAX(MAX(ABS(q1),ABS(q2)),1e-18) <= errmaxrel) THEN
     79                  q(i,k,iq) = q1                 !--- Bidouille pour convergence
     80!                 q(i,k,tracers(iqPar)%iqDesc) = q(i,k,tracers(iqPar)%iqDesc) * q1 / q2
     81                  CYCLE
     82               END IF
     83               CALL msg('ixt, iq = '//TRIM(strStack(int2str([ixt,iq]))), modname)
     84               msg1 = '('//TRIM(strStack(int2str([i,k])))//')'
     85               CALL msg(TRIM(tracers(iqpar)%name)//TRIM(msg1)//' = '//TRIM(real2str(q1)), modname)
     86               CALL msg(TRIM(tracers(iq   )%name)//TRIM(msg1)//' = '//TRIM(real2str(q2)), modname)
     87               CALL abort_gcm(modname, 'Error with isotopes: '//TRIM(err_msg), 1)
     88            END DO
     89         END DO
     90!$OMP END DO NOWAIT
     91      END DO
     92   END IF
    3193
    32         if (niso > 0) then
     94   !--- CHECK DELTA ANOMALIES
     95   modname = 'check_isotopes:iso_verif_aberrant'
     96   ix = [ iso_HDO  ,   iso_O18 ]
     97   nm = ['deltaD  ', 'deltaO18']
     98   DO iiso = 1, SIZE(ix)
     99      ixt = ix(iiso)
     100      IF(ixt  == 0) CYCLE
     101      DO ipha = 1, nphas
     102         iq = iqIsoPha(ixt,ipha)
     103         iqpar = tracers(iq)%iqParent
     104!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     105         DO k = 1, llm
     106            DO i = ijb, ije
     107               q1 = q(i,k,iqpar)
     108               q2 = q(i,k,iq)
     109!--- IMPROVEMENT in case at least one isotope is not negligible compared to the main isotopic form.
     110!    This would be probably required to sum from smallest to highest concentrations ; the corresponding
     111!    indices vector can be computed once only (in the initializations stage), using mean concentrations.
     112!              q2 = SUM(q(i,k,tracers(iqPar)%iqDesc), DIM=3)
     113               IF(q2 <= qmin) CYCLE
     114               deltaD = (q2/q1/tnat(ixt)-1.)*1000.
     115               IF(deltaD <= deltaDmax .AND. deltaD >= deltaDmin) CYCLE
     116               CALL msg('ixt, iq = '//TRIM(strStack(int2str([ixt,iq]))), modname)
     117               msg1 = '('//TRIM(strStack(int2str([i,k])))//')'
     118               CALL msg(TRIM(tracers(iqpar)%name)//TRIM(msg1)//' = '//TRIM(real2str(q1)), modname)
     119               CALL msg(TRIM(tracers(iq   )%name)//TRIM(msg1)//' = '//TRIM(real2str(q2)), modname)
     120               CALL msg(TRIM(nm(iiso))//TRIM(real2str(deltaD)), modname)
     121               CALL abort_gcm(modname, 'Error with isotopes: '//TRIM(err_msg), 1)
     122            END DO
     123         END DO
     124!$OMP END DO NOWAIT
     125      END DO
     126   END DO
    33127
    34 !        write(*,*) 'check_isotopes 31: err_msg=',err_msg
    35         ! verifier que rien n'est NaN
    36         do ixt=1,ntraciso
    37           do phase=1,nqo
    38             iq=iqiso(ixt,phase)
    39 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    40             do k=1,llm
    41               DO i = ijb,ije
    42                 if ((q(i,k,iq).gt.-borne).and.
    43      :            (q(i,k,iq).lt.borne)) then
    44                 else !if ((x(ixt,i,j).gt.-borne).and.
    45                   write(*,*) 'erreur detectee par iso_verif_noNaN:'
    46                   write(*,*) err_msg
    47                   write(*,*) 'q,i,k,iq=',q(i,k,iq),i,k,iq
    48                   write(*,*) 'borne=',borne
    49                   call abort_gcm('check_isotopes_loc','plantage iso',0)
    50                 endif  !if ((x(ixt,i,j).gt.-borne).and.
    51               enddo !DO i = ijb,ije
    52             enddo !do k=1,llm
    53 c$OMP END DO NOWAIT
    54           enddo !do phase=1,nqo
    55         enddo !do ixt=1,ntraciso
     128   IF(nzone == 0) RETURN
    56129
    57 !        write(*,*) 'check_isotopes 52'
    58         ! verifier que l'eau normale est OK
    59         if (use_iso(1)) then
    60           ixt=indnum_fn_num(1)
    61           do phase=1,nqo
    62             iq=iqiso(ixt,phase)
    63 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    64             do k=1,llm
    65             DO i = ijb,ije 
    66               if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
    67      :          (abs((q(i,k,phase)-q(i,k,iq))/
    68      :           max(max(abs(q(i,k,phase)),abs(q(i,k,iq))),1e-18))
    69      :           .gt.errmaxrel)) then
    70                   write(*,*) 'erreur detectee par iso_verif_egalite:'
    71                   write(*,*) err_msg
    72                   write(*,*) 'ixt,phase,ijb=',ixt,phase,ijb
    73                   write(*,*) 'q,iq,i,k=',q(i,k,iq),iq,i,k
    74                   write(*,*) 'q(i,k,phase)=',q(i,k,phase)
    75                   call abort_gcm('check_isotopes_loc','plantage iso',0)
    76               endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
    77               ! bidouille pour éviter divergence:
    78               q(i,k,iq)= q(i,k,phase)
    79             enddo ! DO i = ijb,ije
    80             enddo !do k=1,llm
    81 c$OMP END DO NOWAIT
    82           enddo ! do phase=1,nqo
    83         endif !if (use_iso(1)) then
    84        
    85 !        write(*,*) 'check_isotopes 78'
    86         ! verifier que HDO est raisonable
    87         if (use_iso(2)) then
    88           ixt=indnum_fn_num(2)
    89           do phase=1,nqo
    90             iq=iqiso(ixt,phase)
    91 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    92             do k=1,llm
    93             DO i = ijb,ije
    94             if (q(i,k,iq).gt.qmin) then
    95              deltaD=(q(i,k,iq)/q(i,k,phase)/tnat(2)-1)*1000
    96              if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    97                   write(*,*) 'erreur detectee par iso_verif_aberrant:'
    98                   write(*,*) err_msg
    99                   write(*,*) 'ixt,phase=',ixt,phase
    100                   write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k
    101                   write(*,*) 'q=',q(i,k,:)
    102                   write(*,*) 'deltaD=',deltaD
    103                   call abort_gcm('check_isotopes_loc','plantage iso',0)
    104              endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    105             endif !if (q(i,k,iq).gt.qmin) then
    106             enddo !DO i = ijb,ije
    107             enddo !do k=1,llm
    108 c$OMP END DO NOWAIT
    109           enddo ! do phase=1,nqo
    110         endif !if (use_iso(2)) then
     130   !--- CHECK FOR TAGGING TRACERS DELTAD ANOMALIES
     131   modname = 'check_isotopes:iso_verif_aberrant'
     132   IF(iso_eau /= 0 .AND. iso_HDO /= 0) THEN
     133      DO izon = 1, nzone
     134         ixt  = itZonIso(izon, iso_HDO)
     135         ieau = itZonIso(izon, iso_eau)
     136         DO ipha = 1, nphas
     137            iq    = iqIsoPha(ixt,  ipha)
     138            iqeau = iqIsoPha(ieau, ipha)
     139!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     140            DO k = 1, llm
     141               DO i = ijb, ije
     142                  q1 = q(i,k,iqeau)
     143                  q2 = q(i,k,iq)
     144                  IF(q2<=qmin) CYCLE
     145                  deltaD = (q2/q1/tnat(iso_HDO)-1.)*1000.
     146                  IF(deltaD <= deltaDmax .AND. deltaD >= deltaDmin) CYCLE
     147                  CALL msg('izon, ipha = '//TRIM(strStack(int2str([izon, ipha]))), modname)
     148                  CALL msg( 'ixt, ieau = '//TRIM(strStack(int2str([ ixt, ieau]))), modname)
     149                  msg1 = '('//TRIM(strStack(int2str([i,k])))//')'
     150                  CALL msg(TRIM(tracers(iqeau)%name)//TRIM(msg1)//' = '//TRIM(real2str(q1)), modname)
     151                  CALL msg(TRIM(tracers(iq   )%name)//TRIM(msg1)//' = '//TRIM(real2str(q2)), modname)
     152                  CALL msg('deltaD = '//TRIM(real2str(deltaD)), modname)
     153                  CALL abort_gcm(modname, 'Error with isotopes: '//TRIM(err_msg), 1)
     154               END DO
     155            END DO
     156!$OMP END DO NOWAIT
     157         END DO
     158      END DO
     159   END IF
    111160
    112 !        write(*,*) 'check_isotopes 103'
    113         ! verifier que O18 est raisonable
    114         if (use_iso(3)) then
    115           ixt=indnum_fn_num(3)
    116           do phase=1,nqo
    117             iq=iqiso(ixt,phase)
    118 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    119             do k=1,llm
    120             DO i = ijb,ije
    121             if (q(i,k,iq).gt.qmin) then
    122              deltaD=(q(i,k,iq)/q(i,k,phase)/tnat(3)-1)*1000
    123              if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    124                   write(*,*) 'erreur detectee iso_verif_aberrant O18:'
    125                   write(*,*) err_msg
    126                   write(*,*) 'ixt,phase=',ixt,phase
    127                   write(*,*) 'q,iq,i,k,=',q(i,k,phase),iq,i,k
    128                   write(*,*) 'xt=',q(i,k,:)
    129                   write(*,*) 'deltaO18=',deltaD
    130                   call abort_gcm('check_isotopes_loc','plantage iso',0)
    131              endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    132             endif !if (q(i,k,iq).gt.qmin) then
    133             enddo !DO i = ijb,ije
    134             enddo !do k=1,llm
    135 c$OMP END DO NOWAIT
    136           enddo ! do phase=1,nqo
    137         endif !if (use_iso(2)) then
     161   !--- CHECK FOR TAGGING TRACERS CONSERVATION (PARENT AND TAGGING TRACERS SUM OVER ALL REGIONS MUST BE EQUAL)
     162   DO iiso = 1, niso
     163      DO ipha = 1, nphas
     164         iq = iqIsoPha(iiso, ipha)
     165!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     166         DO k = 1, llm
     167            DO i = ijb, ije
     168               xiiso = q(i,k,iq)
     169               xtractot = SUM(q(i, k, iqIsoPha(itZonIso(1:nzone,iiso), ipha)))
     170               IF(ABS(xtractot-xiiso) > errmax .AND. ABS(xtractot-xiiso)/MAX(MAX(ABS(xtractot),ABS(xiiso)),1e-18) > errmaxrel) THEN
     171                  CALL msg('Error in iso_verif_aberrant trac: '//TRIM(err_msg))
     172                  CALL msg('iiso, ipha = '//TRIM(strStack(int2str([iiso, ipha]))), modname)
     173                  CALL msg('q('//TRIM(strStack(int2str([i,k])))//',:) = '//TRIM(strStack(real2str(q(i,k,:)))), modname)
     174                  CALL abort_gcm(modname, 'Error with isotopes: '//TRIM(err_msg), 1)
     175               END IF
     176               IF(ABS(xtractot) <= ridicule) CYCLE
     177               DO izon = 1, nzone
     178                  q(i,k,iq) = q(i,k,iq) / xtractot * xiiso !--- Bidouille pour convergence
     179               END DO
     180            END DO
     181         END DO
     182!$OMP END DO NOWAIT
     183      END DO
     184   END DO
    138185
     186END SUBROUTINE check_isotopes
    139187
    140 !        write(*,*) 'check_isotopes 129'
    141         if (nzone > 0) then
    142 
    143           if (use_iso(2).and.use_iso(1)) then
    144             do izone=1,ntraceurs_zone
    145              ixt=index_trac(izone,indnum_fn_num(2))
    146              ieau=index_trac(izone,indnum_fn_num(1))
    147              do phase=1,nqo
    148                iq=iqiso(ixt,phase)
    149                iqeau=iqiso(ieau,phase)
    150 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    151                do k=1,llm
    152                 DO i = ijb,ije
    153                 if (q(i,k,iq).gt.qmin) then
    154                  deltaD=(q(i,k,iq)/q(i,k,iqeau)/tnat(2)-1)*1000
    155                  if ((deltaD.gt.deltaDmax).or.
    156      &                   (deltaD.lt.deltaDmin)) then
    157                   write(*,*) 'erreur dans iso_verif_aberrant trac:'
    158                   write(*,*) err_msg
    159                   write(*,*) 'izone,phase=',izone,phase
    160                   write(*,*) 'ixt,ieau=',ixt,ieau
    161                   write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k
    162                   write(*,*) 'deltaD=',deltaD                 
    163                   call abort_gcm('check_isotopes_loc','plantage iso',0)
    164                  endif !if ((deltaD.gt.deltaDmax).or.
    165                 endif !if (q(i,k,iq).gt.qmin) then
    166                 enddo !DO i = ijb,ije
    167                 enddo  ! do k=1,llm
    168 c$OMP END DO NOWAIT
    169               enddo ! do phase=1,nqo   
    170             enddo !do izone=1,ntraceurs_zone
    171           endif !if (use_iso(2).and.use_iso(1)) then
    172 
    173           do iiso=1,niso
    174            do phase=1,nqo
    175               iq=iqiso(iiso,phase)
    176 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    177               do k=1,llm
    178                 DO i = ijb,ije
    179                    xtractot=0.0
    180                    xiiso=q(i,k,iq)
    181                    do izone=1,ntraceurs_zone
    182                       iq=iqiso(index_trac(izone,iiso),phase)
    183                       xtractot=xtractot+ q(i,k,iq)
    184                    enddo !do izone=1,ntraceurs_zone
    185                    if ((abs(xtractot-xiiso).gt.errmax).and.
    186      :                  (abs(xtractot-xiiso)/
    187      :                  max(max(abs(xtractot),abs(xiiso)),1e-18)
    188      :                  .gt.errmaxrel)) then
    189                   write(*,*) 'erreur detectee par iso_verif_traceurs:'
    190                   write(*,*) err_msg
    191                   write(*,*) 'iiso,phase=',iiso,phase
    192                   write(*,*) 'i,k,=',i,k
    193                   write(*,*) 'q(i,k,:)=',q(i,k,:)
    194                   call abort_gcm('check_isotopes_loc','plantage iso',0)
    195                  endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
    196                  
    197                  ! bidouille pour éviter divergence:
    198                  if (abs(xtractot).gt.ridicule) then
    199                    do izone=1,ntraceurs_zone
    200                      ixt=index_trac(izone,iiso)
    201                      q(i,k,iq)=q(i,k,iq)/xtractot*xiiso
    202                    enddo !do izone=1,ntraceurs_zone               
    203                   endif !if ((abs(xtractot).gt.ridicule) then
    204                 enddo !DO i = ijb,ije
    205               enddo !do k=1,llm
    206 c$OMP END DO NOWAIT
    207            enddo !do phase=1,nqo
    208           enddo !do iiso=1,niso
    209 
    210         endif !if (nzone > 0)
    211 
    212         endif ! if (niso > 0)
    213 !        write(*,*) 'check_isotopes 198'
    214        
    215         end
    216 
    217 

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

    r4124 r4143  
    77!-------------------------------------------------------------------------------
    88  USE parallel_lmdz
    9   USE infotrac,    ONLY: nqtot, tracers, niso, iqiso, iso_indnum, iso_num, tnat, alpha_ideal, iH2O
     9  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, tnat, alpha_ideal, iH2O
    1010  USE strings_mod, ONLY: maxlen, msg, strStack, real2str
    1111  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, &
    … …  
    169169#endif
    170170    ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
    171 !     iName    = tracers(iq)%iso_iName  ! (next commit)
    172       iName    = iso_num(iq)
     171      iName    = tracers(iq)%iso_iName
    173172      iPhase   = tracers(iq)%iso_iPhase
    174173      iqParent = tracers(iq)%iqParent
    … …  
    178177      ELSE
    179178         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
    180          q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqiso(iso_indnum(iq),iPhase))
     179         q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
    181180      END IF
    182181    !--------------------------------------------------------------------------------------------------------------------------

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

    r4124 r4143  
    55
    66  USE filtreg_mod, ONLY: inifilr
    7   USE infotrac,    ONLY: nqtot, niso, niso_possibles, ok_iso_verif, tnat, alpha_ideal, &
    8                          iqiso, tracers, iso_indnum, iso_num
     7  USE infotrac,    ONLY: nqtot, niso, tnat, alpha_ideal, iqIsoPha, tracers
    98  USE control_mod, ONLY: day_step,planet_type
    109  use exner_hyb_m, only: exner_hyb
    … …  
    286285              ! CRisi: init des isotopes
    287286              ! distill de Rayleigh très simplifiée
    288 !             iName    = tracers(iq)%iso_iName  ! (next commit)
    289               iName    = iso_num(iq)
     287              iName    = tracers(iq)%iso_iName
    290288              if (niso <= 0 .OR. iName <= 0) CYCLE
    291289              iPhase   = tracers(iq)%iso_iPhase
    … …  
    295293                                     *(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
    296294              ELSE
    297                  q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqiso(iso_indnum(iq),iPhase))
     295                 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
    298296              END IF
    299297           enddo
    … …  
    302300        endif ! of if (planet_type=="earth")
    303301
    304         if (ok_iso_verif) call check_isotopes(q,ijb_u,ije_u,'iniacademic_loc')
     302        call check_isotopes(q,ijb_u,ije_u,'iniacademic_loc')
    305303
    306304        ! add random perturbation to temperature

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

    r2603 r4143  
    1111      USE write_field
    1212      USE integrd_mod
    13       USE infotrac, ONLY: ok_iso_verif ! ajout CRisi
    1413      USE comconst_mod, ONLY: pi
    1514      USE logic_mod, ONLY: leapf
    … …  
    347346c$OMP BARRIER
    348347
    349         if (ok_iso_verif) then
    350            call check_isotopes(q,ijb,ije,'integrd 342')
    351         endif !if (ok_iso_verif) then
     348        call check_isotopes(q,ijb,ije,'integrd 342')
    352349
    353350        !write(*,*) 'integrd 341'
    … …  
    355352        !write(*,*) 'integrd 343'
    356353
    357         if (ok_iso_verif) then
    358            call check_isotopes(q,ijb,ije,'integrd 346')
    359         endif !if (ok_iso_verif) then
     354        call check_isotopes(q,ijb,ije,'integrd 346')
    360355c
    361356c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
    … …  
    408403      ENDIF
    409404
    410         if (ok_iso_verif) then
    411            call check_isotopes(q,ijb,ije,'integrd 409')
    412         endif !if (ok_iso_verif) then
     405      call check_isotopes(q,ijb,ije,'integrd 409')
    413406     
    414407! Ehouarn: forget about finvmaold

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

    r4139 r4143  
    204204      TYPE(distrib),SAVE :: new_dist
    205205
    206       if (ok_iso_verif) then
    207          call check_isotopes(q0,ijb_u,ije_u,'leapfrog204: debut')
    208       endif !if (ok_iso_verif) then
     206      call check_isotopes(q0,ijb_u,ije_u,'leapfrog204: debut')
    209207     
    210208c$OMP MASTER
    … …  
    226224      itaufinp1 = itaufin +1
    227225
    228       if (ok_iso_verif) then
    229         call check_isotopes(q0,ijb_u,ije_u,'leapfrog 226')
    230       endif !if (ok_iso_verif) then
     226      call check_isotopes(q0,ijb_u,ije_u,'leapfrog 226')
    231227
    232228      itau = 0
    … …  
    243239      q=q0
    244240
    245       if (ok_iso_verif) then
    246         call check_isotopes(q,ijb_u,ije_u,'leapfrog 239')
    247       endif !if (ok_iso_verif) then
     241      call check_isotopes(q,ijb_u,ije_u,'leapfrog 239')
    248242     
    249243!      iday = day_ini+itau/day_step
    … …  
    324318      endif
    325319
    326         if (ok_iso_verif) then
    327            call check_isotopes(q,ijb_u,ije_u,'leapfrog 321')
    328         endif !if (ok_iso_verif) then
     320      call check_isotopes(q,ijb_u,ije_u,'leapfrog 321')
    329321
    330322#ifdef CPP_IOIPSL
    … …  
    406398
    407399
    408         if (ok_iso_verif) then
    409            call check_isotopes(q,ijb_u,ije_u,'leapfrog 400')
    410         endif !if (ok_iso_verif) then
     400         call check_isotopes(q,ijb_u,ije_u,'leapfrog 400')
    411401
    412402   2  CONTINUE ! Matsuno backward or leapfrog step begins here
    413403
    414404
    415         if (ok_iso_verif) then
    416            call check_isotopes(q,ijb_u,ije_u,'leapfrog 402')
    417         endif !if (ok_iso_verif) then
     405      call check_isotopes(q,ijb_u,ije_u,'leapfrog 402')
    418406
    419407c$OMP MASTER
    … …  
    497485
    498486
    499         if (ok_iso_verif) then
    500            call check_isotopes(q,ijb_u,ije_u,'leapfrog 471')
    501         endif !if (ok_iso_verif) then
     487      call check_isotopes(q,ijb_u,ije_u,'leapfrog 471')
    502488
    503489!ym  PAS D'AJUSTEMENT POUR LE MOMENT     
    … …  
    619605     
    620606     
    621         if (ok_iso_verif) then
    622            call check_isotopes(q,ijb_u,ije_u,'leapfrog 589')
    623         endif !if (ok_iso_verif) then
     607      call check_isotopes(q,ijb_u,ije_u,'leapfrog 589')
    624608     
    625609c-----------------------------------------------------------------------
    … …  
    684668      CALL geopot_loc  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
    685669       
    686         if (ok_iso_verif) then
    687            call check_isotopes(q,ijb_u,ije_u,'leapfrog 651')
    688         endif !if (ok_iso_verif) then
     670      call check_isotopes(q,ijb_u,ije_u,'leapfrog 651')
    689671     
    690672      call VTb(VTcaldyn)
    … …  
    725707c   -------------------------------------------------------------
    726708
    727         if (ok_iso_verif) then
    728            call check_isotopes(q,ijb_u,ije_u,
     709      call check_isotopes(q,ijb_u,ije_u,
    729710     &           'leapfrog 686: avant caladvtrac')
    730         endif !if (ok_iso_verif) then
    731711     
    732712      IF( forward. OR . leapf )  THEN
    … …  
    743723
    744724         !write(*,*) 'leapfrog 719'
    745          if (ok_iso_verif) then
    746            call check_isotopes(q,ijb_u,ije_u,
     725         call check_isotopes(q,ijb_u,ije_u,
    747726     &           'leapfrog 698: apres caladvtrac')
    748          endif !if (ok_iso_verif) then
    749727
    750728!      do j=1,nqtot
    … …  
    780758
    781759       !write(*,*) 'leapfrog 720'
    782         if (ok_iso_verif) then
    783            call check_isotopes(q,ijb_u,ije_u,'leapfrog 756')
    784         endif !if (ok_iso_verif) then
     760       call check_isotopes(q,ijb_u,ije_u,'leapfrog 756')
    785761
    786762       ! CRisi: pourquoi aller jusqu'à 2 et non pas jusqu'à nqtot??
    … …  
    790766
    791767       !write(*,*) 'leapfrog 724'       
    792         if (ok_iso_verif) then
    793            call check_isotopes(q,ijb_u,ije_u,'leapfrog 762')
    794         endif !if (ok_iso_verif) then
     768       call check_isotopes(q,ijb_u,ije_u,'leapfrog 762')
    795769 
    796770!       CALL FTRACE_REGION_END("integrd")
    … …  
    807781#endif   
    808782
    809         if (ok_iso_verif) then
    810            call check_isotopes(q,ijb_u,ije_u,'leapfrog 775')
    811         endif !if (ok_iso_verif) then
     783      call check_isotopes(q,ijb_u,ije_u,'leapfrog 775')
    812784
    813785c      do j=1,nqtot
    … …  
    11691141       ENDIF ! of IF( apphys )
    11701142
    1171         if (ok_iso_verif) then
    1172            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1132')
    1173         endif !if (ok_iso_verif) then
     1143       call check_isotopes(q,ijb_u,ije_u,'leapfrog 1132')
    11741144        !write(*,*) 'leapfrog 1134: iflag_phys=',iflag_phys
    11751145
    … …  
    12381208
    12391209cc$OMP END PARALLEL
    1240         if (ok_iso_verif) then
    1241            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1196')
    1242         endif !if (ok_iso_verif) then
     1210        call check_isotopes(q,ijb_u,ije_u,'leapfrog 1196')
    12431211
    12441212c-----------------------------------------------------------------------
    … …  
    14751443c              ENDIF
    14761444
    1477         if (ok_iso_verif) then
    1478            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1430')
    1479         endif !if (ok_iso_verif) then     
     1445       call check_isotopes(q,ijb_u,ije_u,'leapfrog 1430')
    14801446 
    14811447c   ********************************************************************
    … …  
    15671533      ENDIF
    15681534     
    1569         if (ok_iso_verif) then
    1570            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1509')
    1571         endif !if (ok_iso_verif) then
     1535      call check_isotopes(q,ijb_u,ije_u,'leapfrog 1509')
    15721536
    15731537      IF ( .NOT.purmats ) THEN
    … …  
    16561620            ENDIF
    16571621
    1658         if (ok_iso_verif) then
    1659            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1584')
    1660         endif !if (ok_iso_verif) then
     1622            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1584')
    16611623
    16621624c-----------------------------------------------------------------------
    … …  
    17011663            ENDIF ! of IF (itau.EQ.itaufin)
    17021664
    1703         if (ok_iso_verif) then
    1704            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1624')
    1705         endif !if (ok_iso_verif) then
     1665            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1624')
    17061666
    17071667c-----------------------------------------------------------------------
    … …  
    17411701
    17421702
    1743         if (ok_iso_verif) then
    1744            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1664')
    1745         endif !if (ok_iso_verif) then
     1703        call check_isotopes(q,ijb_u,ije_u,'leapfrog 1664')
    17461704
    17471705c       ........................................................
    … …  
    17881746
    17891747             
    1790         if (ok_iso_verif) then
    1791            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1698')
    1792         endif !if (ok_iso_verif) then 
     1748              call check_isotopes(q,ijb_u,ije_u,'leapfrog 1698')
    17931749
    17941750              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    … …  
    18571813
    18581814
    1859         if (ok_iso_verif) then
    1860            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1750')
    1861         endif !if (ok_iso_verif) then
     1815            call check_isotopes(q,ijb_u,ije_u,'leapfrog 1750')
    18621816
    18631817      END IF ! of IF(.not.purmats)

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

    r4124 r4143  
    44      SUBROUTINE qminimum_loc( q,nqtot,deltap )
    55      USE parallel_lmdz
    6       USE infotrac, ONLY: niso,ntraciso,iqiso,ok_iso_verif,             &
    7      &   ratiomin,qperemin ! CRisi 23nov2020
     6      USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers,
     7     &                    isoCheck, min_qParent
     8      USE strings_mod, ONLY: strIdx
     9      USE readTracFiles_mod, ONLY: addPhase
    810      IMPLICIT none
    911c
    … …  
    1820      REAL q(ijb_u:ije_u,llm,nqtot), deltap(ijb_u:ije_u,llm)
    1921c
    20       INTEGER iq_vap, iq_liq
    21       PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur
    22       PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide
    23       REAL seuil_vap, seuil_liq
    24       PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur
    25       PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide
     22      LOGICAL, SAVE :: first=.TRUE.
     23      INTEGER, SAVE :: iq_vap, iq_liq        ! indices pour l'eau vapeur/liquide
     24c$OMP THREADPRIVATE(iq_vap, iq_liq, first)
     25      REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur
     26      REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide
    2627c
    2728c  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
    … …  
    5455c
    5556
    56         !write(lunout,*) 'qminimum 52: entree'
    57         if (ok_iso_verif) then
    58            call check_isotopes(q,ij_begin,ij_end,'qminimum 52')   
    59         endif !if (ok_iso_verif) then     
     57      !write(lunout,*) 'qminimum 52: entree'
     58      IF(first) THEN
     59         iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
     60         iq_liq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
     61         first = .FALSE.
     62      END IF
     63      call check_isotopes(q,ij_begin,ij_end,'qminimum 52')   
    6064
    6165      ijb=ij_begin
    … …  
    169173!              write(lunout,*) 'i,k,q_follow(i,k-1,iq_vap)=',
    170174!     :                 i,k,q_follow(i,k-1,iq_vap)         
    171               if (q_follow(i,k-1,iq_vap).lt.qperemin) then
     175              if (q_follow(i,k-1,iq_vap).lt.min_qParent) then
    172176                write(lunout,*) 'tmp qmin: on stoppe'
    173177                write(lunout,*) 'zx_pump(i)=',zx_pump(i)
    … …  
    177181                call abort_gcm("qminimum","not enough vapor",1)
    178182              endif 
    179             do ixt=1,ntraciso
     183            do ixt=1,ntiso
    180184!                write(lunout,*) 'qmin 168: ixt=',ixt
    181 !                write(lunout,*) 'q(i,k,iqiso(ixt,iq_vap)=',
    182 !     :             q(i,k,iqiso(ixt,iq_vap))
     185!                write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap)=',
     186!     :             q(i,k,iqIsoPha(ixt,iq_vap))
    183187!                write(lunout,*) 'zx_defau_diag(i,k,iq_vap)=',
    184188!     :                  zx_defau_diag(i,k,iq_vap)
    185 !                write(lunout,*) 'q(i,k-1,iqiso(ixt,iq_vap)=',
    186 !     :                   q(i,k-1,iqiso(ixt,iq_vap))     
    187 
    188                q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
    189      :              +zx_defau_diag(i,k,iq_vap)
    190      :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
     189!                write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap)=',
     190!     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))     
     191
     192               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
     193     :           +zx_defau_diag(i,k,iq_vap)
     194     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
    191195               
    192               if (ok_iso_verif) then
    193                 if (iso_verif_noNaN_nostop(q(i,k,iqiso(ixt,iq_vap)),
     196              if (isoCheck) then
     197                if(iso_verif_noNaN_nostop(q(i,k,iqIsoPha(ixt,iq_vap)),
    194198     :                   'qminimum 155').eq.1) then
    195199                   write(*,*) 'i,k,ixt=',i,k,ixt
    196200                   write(*,*) 'q_follow(i,k-1,iq_vap)=',
    197201     :                   q_follow(i,k-1,iq_vap)
    198                    write(*,*) 'q(i,k,iqiso(ixt,iq_vap))=',
    199      :                   q(i,k,iqiso(ixt,iq_vap))
     202                   write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
     203     :                   q(i,k,iqIsoPha(ixt,iq_vap))
    200204                   write(*,*) 'zx_defau_diag(i,k,iq_vap)=',
    201205     :                   zx_defau_diag(i,k,iq_vap)
    202                    write(*,*) 'q(i,k-1,iqiso(ixt,iq_vap))=',
    203      :                   q(i,k-1,iqiso(ixt,iq_vap))
     206                   write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
     207     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
    204208                   stop
    205209                endif
    … …  
    207211
    208212              ! et on la retranche en k-1
    209                q(i,k-1,iqiso(ixt,iq_vap))=q(i,k-1,iqiso(ixt,iq_vap))
     213               q(i,k-1,iqIsoPha(ixt,iq_vap)) =
     214     :            q(i,k-1,iqIsoPha(ixt,iq_vap))
    210215     :              -zx_defau_diag(i,k,iq_vap)
    211216     :              *deltap(i,k)/deltap(i,k-1)
    212      :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
    213 
    214                if (ok_iso_verif) then
    215                 if (iso_verif_noNaN_nostop(q(i,k-1,iqiso(ixt,iq_vap)),
     217     :              *q(i,k-1,iqIsoPha(ixt,iq_vap))
     218     :              /q_follow(i,k-1,iq_vap)
     219
     220               if (isoCheck) then
     221                if (iso_verif_noNaN_nostop(
     222     :              q(i,k-1,iqIsoPha(ixt,iq_vap)),
    216223     :                   'qminimum 175').eq.1) then
    217224                   write(*,*) 'k,i,ixt=',k,i,ixt
    218225                   write(*,*) 'q_follow(i,k-1,iq_vap)=',
    219226     :                   q_follow(i,k-1,iq_vap)
    220                    write(*,*) 'q(i,k,iqiso(ixt,iq_vap))=',
    221      :                   q(i,k,iqiso(ixt,iq_vap))
     227                   write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
     228     :                   q(i,k,iqIsoPha(ixt,iq_vap))
    222229                   write(*,*) 'zx_defau_diag(i,k,iq_vap)=',
    223230     :                   zx_defau_diag(i,k,iq_vap)
    224                    write(*,*) 'q(i,k-1,iqiso(ixt,iq_vap))=',
    225      :                   q(i,k-1,iqiso(ixt,iq_vap))
     231                   write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
     232     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
    226233                   stop
    227234                endif
    … …  
    239246        enddo !do k=2,llm
    240247
    241         if (ok_iso_verif) then
    242            call check_isotopes(q,ijb,ije,'qminimum 168')
    243         endif !if (ok_iso_verif) then
     248        call check_isotopes(q,ijb,ije,'qminimum 168')
    244249       
    245250     
    … …  
    252257
    253258              ! on ajoute eau liquide en k en k             
    254               do ixt=1,ntraciso
    255                q(i,k,iqiso(ixt,iq_liq))=q(i,k,iqiso(ixt,iq_liq))
     259              do ixt=1,ntiso
     260               q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq))
    256261     :              +zx_defau_diag(i,k,iq_liq)
    257      :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)
     262     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)
    258263              ! et on la retranche à la vapeur en k
    259                q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
     264               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
    260265     :              -zx_defau_diag(i,k,iq_liq)
    261      :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)   
     266     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)   
    262267              enddo !do ixt=1,niso
    263268              q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
    … …  
    270275       enddo !do k=2,llm 
    271276
    272         if (ok_iso_verif) then
    273            call check_isotopes(q,ijb,ije,'qminimum 197')
    274         endif !if (ok_iso_verif) then
     277       call check_isotopes(q,ijb,ije,'qminimum 197')
    275278
    276279      endif !if (niso > 0) then

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

    r4103 r4143  
    1515      USE parallel_lmdz
    1616      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    17      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     17     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    1818      IMPLICIT NONE
    1919c
    … …  
    341341            ! les calcule donc que de ijb à ije
    342342            !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
     343            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
     344            if (q(ij,l,iq).gt.min_qParent) then ! modif 13 nov 2020
    345345              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    346346            else
    347               Ratio(ij,l,iq2)=ratiomin
     347              Ratio(ij,l,iq2)=min_ratio
    348348            endif
    349349          enddo   
    … …  
    363363         DO ij=ijb+1,ije
    364364            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    365             new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
     365            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),min_qMass)
    366366            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    367367     &        u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    417417      USE parallel_lmdz
    418418      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    419      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi   
     419     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi   
    420420      USE comconst_mod, ONLY: pi
    421421      IMPLICIT NONE
    … …  
    745745          DO ij=ijbm,ijem
    746746          !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)
     747            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
    748748          enddo
    749749
    … …  
    751751          DO ij=ijb,ije
    752752          !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
     753            if (q(ij,l,iq).gt.min_qParent) then ! modif 13 nov 2020
    754754              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    755755            else
    756               Ratio(ij,l,iq2)=ratiomin 
     756              Ratio(ij,l,iq2)=min_ratio 
    757757            endif     
    758758          enddo !DO ij=ijbm,ijem 
    … …  
    885885      USE vlz_mod
    886886      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    887      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     887     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    888888     
    889889      IMPLICIT NONE
    … …  
    11551155          DO ij=ijb,ije
    11561156           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    1157             masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    1158             if (q(ij,l,iq).gt.qperemin) then
     1157            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
     1158            if (q(ij,l,iq).gt.min_qParent) then
    11591159              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    11601160            else
    1161               Ratio(ij,l,iq2)=ratiomin
     1161              Ratio(ij,l,iq2)=min_ratio
    11621162            endif
    11631163            !wq(ij,l,iq2)=wq(ij,l,iq) ! correction bug le 15mai2015

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

    r4056 r4143  
    2828      USE VAMPIR
    2929      ! CRisi: on rajoute variables utiles d'infotrac 
    30       USE infotrac, ONLY : nqtot, tracers,ok_iso_verif
     30      USE infotrac, ONLY : nqtot, tracers, isoCheck
    3131      USE vlspltgen_mod
    3232      USE comconst_mod, ONLY: cpp
    … …  
    191191      ijb=ij_begin
    192192      ije=ij_end 
    193       if (ok_iso_verif) then
    194         call check_isotopes(zq,ijb,ije,'vlspltgen_loc 191')
    195       endif !if (ok_iso_verif) then   
     193      call check_isotopes(zq,ijb,ije,'vlspltgen_loc 191')
    196194
    197195c$OMP BARRIER           
    … …  
    285283      if (pole_nord) ijb=ij_begin
    286284      if (pole_sud)  ije=ij_end 
    287       if (ok_iso_verif) then
    288            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 280')
    289       endif !if (ok_iso_verif) then
     285      call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 280')
    290286
    291287      do iq=1,nqtot
    … …  
    328324
    329325     
    330       if (ok_iso_verif) then
     326      IF(isoCheck) THEN
    331327           call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 326')
    332328           ijb=ij_begin-2*iip1
    … …  
    335331           if (pole_sud)  ije=ij_end
    336332           call check_isotopes(zq,ijb,ije,'vlspltgen_loc 336')
    337       endif !if (ok_iso_verif) then 
     333      END IF
    338334
    339335      do iq = 1, nqtot
    … …  
    355351       enddo
    356352
    357       if (ok_iso_verif) then
    358            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 357')
    359       endif !if (ok_iso_verif) then
     353      call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 357')
    360354
    361355      do iq = 1, nqtot
    … …  
    416410
    417411
    418       if (ok_iso_verif) then
    419            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 429')
    420       endif !if (ok_iso_verif) then
     412      call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 429')
    421413
    422414c$OMP BARRIER
    … …  
    461453
    462454      !write(*,*) 'vlspltgen_loc 494'
    463       if (ok_iso_verif) then
    464            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 461')
    465       endif !if (ok_iso_verif) then
     455      call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 461')
    466456
    467457      do iq=1,nqtot
    … …  
    481471       enddo !do iq=1,nqtot
    482472
    483       if (ok_iso_verif) then
    484            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 493')
    485       endif !if (ok_iso_verif) then
     473      call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 493')
    486474
    487475      do iq=1,nqtot
    … …  
    504492
    505493      !write(*,*) 'vlspltgen 550: apres derniere serie de call vlx'
    506       if (ok_iso_verif) then
    507            call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 521')
    508       endif !if (ok_iso_verif) then
     494      call check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 521')
    509495     
    510496      ijb=ij_begin
    … …  
    541527      ENDDO !DO iq=1,nqtot
    542528       
    543       if (ok_iso_verif) then
    544            call check_isotopes(q,ij_begin,ij_end,'vlspltgen_loc 557')
    545       endif !if (ok_iso_verif) then
     529      call check_isotopes(q,ij_begin,ij_end,'vlspltgen_loc 557')
    546530
    547531c$OMP BARRIER

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

    r4052 r4143  
    1313      USE parallel_lmdz
    1414      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    15      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     15     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    1616      IMPLICIT NONE
    1717c
    … …  
    346346          DO ij=ijb,ije
    347347            !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
     348            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
     349            if (q(ij,l,iq).gt.min_qParent) then ! modif 13 nov 2020
    350350              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    351351            else
    352               Ratio(ij,l,iq2)=ratiomin
     352              Ratio(ij,l,iq2)=min_ratio
    353353            endif
    354354          enddo   
    … …  
    370370         DO ij=ijb+1,ije
    371371            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    372             new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
     372            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),min_qMass)
    373373            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    374374     &      u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    423423      USE parallel_lmdz
    424424      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    425      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     425     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    426426      USE comconst_mod, ONLY: pi
    427427      IMPLICIT NONE
    … …  
    751751          DO ij=ijbm,ijem
    752752            !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)
     753            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
    754754          enddo !DO ij=ijbm,ijem
    755755
    … …  
    758758            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    759759            !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
     760            if (q(ij,l,iq).gt.min_qParent) then ! modif 13 nov 2020
    761761              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    762762            else
    763               Ratio(ij,l,iq2)=ratiomin   
     763              Ratio(ij,l,iq2)=min_ratio   
    764764            endif
    765765          enddo !DO ij=ijbm,ijem
Note: See TracChangeset for help on using the changeset viewer.