Changeset 4143


Ignore:
Timestamp:
May 9, 2022, 12:35:40 PM (2 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
Files:
62 edited
2 moved

Legend:

Unmodified
Added
Removed

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

    r4064 r4143  
    1111   !            M.A Filiberti (04/2002)
    1212   !
    13    USE infotrac,     ONLY: nqtot, tracers,ok_iso_verif
     13   USE infotrac,     ONLY: nqtot, tracers, isoCheck
    1414   USE control_mod,  ONLY: iapp_tracvl, day_step
    1515   USE comconst_mod, ONLY: dtvr
    … …  
    215215#endif
    216216
    217    IF(ok_iso_verif) THEN
    218       WRITE(*,*) 'advtrac 227'
    219       CALL check_isotopes_seq(q,ip1jmp1,'advtrac 162')
    220    END IF
     217   IF(isoCheck) WRITE(*,*) 'advtrac 227'
     218   CALL check_isotopes_seq(q,ip1jmp1,'advtrac 162')
    221219
    222220   !-------------------------------------------------------------------------
    … …  
    346344   END DO
    347345
    348    IF(ok_iso_verif) then
    349       WRITE(*,*) 'advtrac 402'
    350       CALL check_isotopes_seq(q,ip1jmp1,'advtrac 397')
    351    END IF
     346   IF(isoCheck) WRITE(*,*) 'advtrac 402'
     347   CALL check_isotopes_seq(q,ip1jmp1,'advtrac 397')
    352348
    353349   !-------------------------------------------------------------------------

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

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

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

    r4124 r4143  
    66! Purpose: Initial state reading.
    77!-------------------------------------------------------------------------------
    8   USE infotrac,    ONLY: nqtot, tracers, niso, iqiso, iso_indnum, iso_num, tnat, alpha_ideal, iH2O
     8  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, tnat, alpha_ideal, iH2O
    99  USE strings_mod, ONLY: maxlen, msg, strStack, real2str
    1010  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, &
    … …  
    145145#endif
    146146    ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
    147 !     iName    = tracers(iq)%iso_iName  ! (next commit)
    148       iName    = iso_num(iq)
     147      iName    = tracers(iq)%iso_iName
    149148      iPhase   = tracers(iq)%iso_iPhase
    150149      iqParent = tracers(iq)%iqParent
    … …  
    154153      ELSE
    155154         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
    156          q(:,:,:,iq) = q(:,:,:,iqiso(iso_indnum(iq),iPhase))
     155         q(:,:,:,iq) = q(:,:,:,iqIsoPha(iName,iPhase))
    157156      END IF
    158157    !--------------------------------------------------------------------------------------------------------------------------

  • LMDZ6/trunk/libf/dyn3d/iniacademic.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
    … …  
    282281              ! CRisi: init des isotopes
    283282              ! distill de Rayleigh très simplifiée
    284 !             iName    = tracers(iq)%iso_iName  ! (next commit)
    285               iName    = iso_num(iq)
     283              iName    = tracers(iq)%iso_iName
    286284              if (niso <= 0 .OR. iName <= 0) CYCLE
    287285              iPhase   = tracers(iq)%iso_iPhase
    … …  
    290288                 q(:,:,iq) = q(:,:,iqParent)*tnat(iName)*(q(:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
    291289              ELSE
    292                  q(:,:,iq) = q(:,:,iqiso(iso_indnum(iq),iPhase))
     290                 q(:,:,iq) = q(:,:,iqIsoPha(iName,iPhase))
    293291              END IF
    294292           enddo
    … …  
    297295        endif ! of if (planet_type=="earth")
    298296
    299         if (ok_iso_verif) call check_isotopes_seq(q,1,ip1jmp1,'iniacademic_loc')
     297        call check_isotopes_seq(q,1,ip1jmp1,'iniacademic_loc')
    300298
    301299        ! add random perturbation to temperature

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

    r4120 r4143  
    1111      use IOIPSL
    1212#endif
    13       USE infotrac, ONLY: nqtot,ok_iso_verif
     13      USE infotrac, ONLY: nqtot, isoCheck
    1414      USE guide_mod, ONLY : guide_main
    1515      USE write_field, ONLY: writefield
    … …  
    2626      USE temps_mod, ONLY: jD_ref,jH_ref,itaufin,day_ini,day_ref,
    2727     &                        start_time,dt
     28      USE strings_mod, ONLY: msg
    2829
    2930      IMPLICIT NONE
    … …  
    237238      jH_cur = jH_cur - int(jH_cur)
    238239
    239         if (ok_iso_verif) then
    240            call check_isotopes_seq(q,ip1jmp1,'leapfrog 321')
    241         endif !if (ok_iso_verif) then
     240      call check_isotopes_seq(q,ip1jmp1,'leapfrog 321')
    242241
    243242#ifdef CPP_IOIPSL
    … …  
    271270!      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
    272271
    273         if (ok_iso_verif) then
    274            call check_isotopes_seq(q,ip1jmp1,'leapfrog 400')
    275         endif !if (ok_iso_verif) then
     272      call check_isotopes_seq(q,ip1jmp1,'leapfrog 400')
    276273
    277274   2  CONTINUE ! Matsuno backward or leapfrog step begins here
    … …  
    324321
    325322
    326         if (ok_iso_verif) then
    327            call check_isotopes_seq(q,ip1jmp1,'leapfrog 589')
    328         endif !if (ok_iso_verif) then
     323      call check_isotopes_seq(q,ip1jmp1,'leapfrog 589')
    329324
    330325c-----------------------------------------------------------------------
    … …  
    345340c   -------------------------------------------------------------
    346341
    347         if (ok_iso_verif) then
    348            call check_isotopes_seq(q,ip1jmp1,
     342      call check_isotopes_seq(q,ip1jmp1,
    349343     &           'leapfrog 686: avant caladvtrac')
    350         endif !if (ok_iso_verif) then
    351344
    352345      IF( forward. OR . leapf )  THEN
    … …  
    376369c   ----------------------------------
    377370
    378         if (ok_iso_verif) then
    379            write(*,*) 'leapfrog 720'
    380            call check_isotopes_seq(q,ip1jmp1,'leapfrog 756')
    381         endif !if (ok_iso_verif) then
     371       CALL msg('720', modname, isoCheck)
     372       call check_isotopes_seq(q,ip1jmp1,'leapfrog 756')
    382373       
    383374       CALL integrd ( nqtot,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    … …  
    385376!     $              finvmaold                                    )
    386377
    387        if (ok_iso_verif) then
    388           write(*,*) 'leapfrog 724'
    389            call check_isotopes_seq(q,ip1jmp1,'leapfrog 762')
    390         endif !if (ok_iso_verif) then
     378       CALL msg('724', modname, isoCheck)
     379       call check_isotopes_seq(q,ip1jmp1,'leapfrog 762')
    391380
    392381c .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
    … …  
    552541        CALL massdair(p,masse)
    553542
    554         if (ok_iso_verif) then
    555            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1196')
    556         endif !if (ok_iso_verif) then
     543        call check_isotopes_seq(q,ip1jmp1,'leapfrog 1196')
    557544
    558545c-----------------------------------------------------------------------
    … …  
    639626c   preparation du pas d'integration suivant  ......
    640627
    641         if (ok_iso_verif) then
    642            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1509')
    643         endif !if (ok_iso_verif) then
     628      call check_isotopes_seq(q,ip1jmp1,'leapfrog 1509')
    644629
    645630      IF ( .NOT.purmats ) THEN
    … …  
    703688            ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin))
    704689
    705         if (ok_iso_verif) then
    706            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1584')
    707         endif !if (ok_iso_verif) then
     690            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1584')
    708691
    709692c-----------------------------------------------------------------------
    … …  
    790773      ELSE ! of IF (.not.purmats)
    791774
    792         if (ok_iso_verif) then
    793            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1664')
    794         endif !if (ok_iso_verif) then
     775            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1664')
    795776
    796777c       ........................................................
    … …  
    817798            ELSE ! of IF(forward) i.e. backward step
    818799 
    819         if (ok_iso_verif) then
    820            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1698')
    821         endif !if (ok_iso_verif) then 
     800              call check_isotopes_seq(q,ip1jmp1,'leapfrog 1698')
    822801
    823802              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN

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

    r4124 r4143  
    44      SUBROUTINE qminimum( q,nqtot,deltap )
    55
    6       USE infotrac, ONLY: niso, ntraciso,iqiso,ok_iso_verif
     6      USE infotrac, ONLY: niso, ntiso,iqIsoPha, tracers
     7      USE strings_mod, ONLY: strIdx
     8      USE readTracFiles_mod, ONLY: addPhase
    79      IMPLICIT none
    810c
    … …  
    1618      REAL q(ip1jmp1,llm,nqtot), deltap(ip1jmp1,llm)
    1719c
    18       INTEGER iq_vap, iq_liq
    19       PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur
    20       PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide
    21       REAL seuil_vap, seuil_liq
    22       PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur
    23       PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide
     20      LOGICAL, SAVE :: first=.TRUE.
     21      INTEGER, SAVE :: iq_vap, iq_liq        ! indices pour l'eau vapeur/liquide
     22      REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur
     23      REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide
    2424c
    2525c  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
    … …  
    4343      !INTEGER nb_pump
    4444      INTEGER ixt
     45
     46      IF(first) THEN
     47         iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
     48         iq_liq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
     49         first = .FALSE.
     50      END IF
    4551c
    4652c Quand l'eau liquide est trop petite (ou negative), on prend
    … …  
    4955c
    5056
    51         if (ok_iso_verif) then
    52            call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   
    53         endif !if (ok_iso_verif) then     
     57      call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   
    5458
    5559      zx_defau_diag(:,:,:)=0.0
    … …  
    127131          if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
    128132              ! on ajoute la vapeur en k             
    129               do ixt=1,ntraciso
    130                q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
    131      :              +zx_defau_diag(i,k,iq_vap)
    132      :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
     133              do ixt=1,ntiso
     134               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
     135     :           +zx_defau_diag(i,k,iq_vap)
     136     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
    133137               
    134138              ! et on la retranche en k-1
    135                q(i,k-1,iqiso(ixt,iq_vap))=q(i,k-1,iqiso(ixt,iq_vap))
     139               q(i,k-1,iqIsoPha(ixt,iq_vap))=
     140     :            q(i,k-1,iqIsoPha(ixt,iq_vap))
    136141     :              -zx_defau_diag(i,k,iq_vap)
    137142     :              *deltap(i,k)/deltap(i,k-1)
    138      :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
     143     :              *q(i,k-1,iqIsoPha(ixt,iq_vap))
     144     :              /q_follow(i,k-1,iq_vap)
    139145
    140146              enddo !do ixt=1,niso
    … …  
    148154       enddo !do k=2,llm
    149155
    150         if (ok_iso_verif) then     
    151            call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
    152         endif !if (ok_iso_verif) then
     156       call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
    153157       
    154158     
    … …  
    160164
    161165              ! on ajoute eau liquide en k en k             
    162               do ixt=1,ntraciso
    163                q(i,k,iqiso(ixt,iq_liq))=q(i,k,iqiso(ixt,iq_liq))
     166              do ixt=1,ntiso
     167               q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq))
    164168     :              +zx_defau_diag(i,k,iq_liq)
    165      :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)
     169     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)
    166170              ! et on la retranche à la vapeur en k
    167                q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
     171               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
    168172     :              -zx_defau_diag(i,k,iq_liq)
    169      :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)   
     173     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)   
    170174              enddo !do ixt=1,niso
    171175              q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
    … …  
    177181       enddo !do k=2,llm 
    178182
    179         if (ok_iso_verif) then
    180            call check_isotopes_seq(q,ip1jmp1,'qminimum 197')
    181         endif !if (ok_iso_verif) then
     183       call check_isotopes_seq(q,ip1jmp1,'qminimum 197')
    182184
    183185      endif !if (niso > 0) then

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

    r4064 r4143  
    125125      RECURSIVE SUBROUTINE vlx(q,pente_max,masse,u_m,iq)
    126126      USE infotrac, ONLY : nqtot,tracers, ! CRisi
    127      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     127     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    128128
    129129c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    428428            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    429429            !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
    430             masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    431             if (q(ij,l,iq).gt.qperemin) then
     430            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
     431            if (q(ij,l,iq).gt.min_qParent) then
    432432              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    433433            else
    434               Ratio(ij,l,iq2)=ratiomin
     434              Ratio(ij,l,iq2)=min_ratio
    435435            endif
    436436          enddo   
    … …  
    449449         DO ij=iip2+1,ip1jm
    450450            !MVals: veiller a ce qu'on ait pas de denominateur nul
    451             new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
     451            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),min_qMass)
    452452            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    453453     &      u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    485485      RECURSIVE SUBROUTINE vly(q,pente_max,masse,masse_adv_v,iq)
    486486      USE infotrac, ONLY : nqtot,tracers, ! CRisi
    487      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     487     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    488488c
    489489c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    752752            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
    753753            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    754             masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    755             if (q(ij,l,iq).gt.qperemin) then
     754            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
     755            if (q(ij,l,iq).gt.min_qParent) then
    756756              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    757757            else
    758               Ratio(ij,l,iq2)=ratiomin
     758              Ratio(ij,l,iq2)=min_ratio
    759759            endif
    760760          enddo   
    … …  
    848848      RECURSIVE SUBROUTINE vlz(q,pente_max,masse,w,iq)
    849849      USE infotrac, ONLY : nqtot,tracers, ! CRisi
    850      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     850     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    851851c
    852852c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    977977            !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)       
    978978            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    979             masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    980             if (q(ij,l,iq).gt.qperemin) then
     979            masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
     980            if (q(ij,l,iq).gt.min_qParent) then
    981981              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    982982            else
    983               Ratio(ij,l,iq2)=ratiomin
     983              Ratio(ij,l,iq2)=min_ratio
    984984            endif     
    985985          enddo   

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

    r4130 r4143  
    2828   PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases
    2929   PUBLIC :: niso,    nzone,   nphas,   ntiso              !---  " " numbers + isotopes & tagging tracers number
    30    PUBLIC :: itZonIso, index_trac                          !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
    31    PUBLIC :: iqTraPha, iqiso                               !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
     30   PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
     31   PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
    3232   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
    3333   !=== FOR BOTH TRACERS AND ISOTOPES
    3434   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
    35 
    36    !=== OLD QUANTITIES OR ALIASES FOR OLDER NAMES (TO BE REMOVED SOON)
    37    PUBLIC :: ntraciso, ntraceurs_zone
    38    PUBLIC :: ok_iso_verif, use_iso
    39    PUBLIC :: iso_num, iso_indnum, indnum_fn_num, niso_possibles
    40    PUBLIC :: qperemin, masseqmin, ratiomin
    4135
    4236   INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
    … …  
    10195!  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
    10296!  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3  |
    103 !  | iqTraPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
     97!  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
    10498!  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |
    10599!  +-----------------+--------------------------------------------------+--------------------+-----------------+
    … …  
    131125                                             nphas, ntiso, &    !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
    132126                                            itZonIso(:,:), &    !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
    133                                             iqTraPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
    134 
    135    !--- Aliases for older names + quantities to be removed soon
    136    INTEGER,                 SAVE, POINTER ::  index_trac(:,:)   ! numero ixt en fn izone, indnum entre 1 et niso
    137    INTEGER,                 SAVE, POINTER ::  iqiso(:,:)        ! donne indice iq en fn de (ixt,phase)
    138    INTEGER,                 SAVE, POINTER :: ntraciso, ntraceurs_zone
    139    REAL,    SAVE :: qperemin, masseqmin, ratiomin
    140    INTEGER, SAVE :: niso_possibles
    141    LOGICAL, SAVE :: ok_iso_verif
    142    LOGICAL, SAVE, ALLOCATABLE ::       use_iso(:)
    143    INTEGER, SAVE, ALLOCATABLE ::       iso_num(:)               !--- idx in [1,niso_possibles] = f(1<=iq <=nqtot)
    144    INTEGER, SAVE, ALLOCATABLE ::    iso_indnum(:)               !--- idx in [1,niso]           = f(1<=iq <=nqtot)
    145    INTEGER, SAVE, ALLOCATABLE :: indnum_fn_num(:)               !--- idx in [1,niso]           = f(1<=idx<=niso_possibles)
     127                                            iqIsoPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
    146128
    147129   !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA
    … …  
    359341   DEALLOCATE(tnom_0, tnom_transp)
    360342#ifdef INCA
    361    DEALLOCATE(hadv_inca, vadv_inca, solsym_inca)
     343   DEALLOCATE(hadv_inca, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
    362344#endif
    363345
    … …  
    377359      nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
    378360      IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
    379       ALLOCATE(hadv(nqtrue), conv_flg(nbtr), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
    380       ALLOCATE(vadv(nqtrue),  pbl_flg(nbtr), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
     361      ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
     362      ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
    381363      CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
    382       !--- Passive CO2 tracer is at position 1 because: H2O has been removed ; nqCO2/=0 in "inco" case only
    383       conv_flg(1:nbtr) = [(1,          k=1, nqCO2), conv_flg_inca]
    384        pbl_flg(1:nbtr) = [(1,          k=1, nqCO2),  pbl_flg_inca]
    385364      ALLOCATE(ttr(nqtrue))
    386365      ttr(1:nqo+nqCO2)                    = tracers
    … …  
    407386      lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
    408387      lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
    409       ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr))
    410       conv_flg(1:nbtr) = [(1, it=1, nbtr)]                           !--- Convection activated for all tracers
    411        pbl_flg(1:nbtr) = [(1, it=1, nbtr)]                           !--- Boundary layer activated for all tracers
    412388   !---------------------------------------------------------------------------------------------------------------------------
    413389   END IF
    … …  
    531507   nbtr    = nbtr -nqo*   ntiso             !--- ISOTOPIC TAGGING TRACERS ARE NOT PASSED TO THE PHYSICS
    532508   nqtottr = nqtot-nqo*(1+ntiso)            !--- NO H2O-FAMILY    TRACER  IS      PASSED TO THE PHYSICS
    533 
    534    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr))
    535 #ifndef INCA
    536    conv_flg(1:nbtr) = 1                                              !--- Convection activated for all tracers
    537     pbl_flg(1:nbtr) = 1                                              !--- Boundary layer activated for all tracers
    538 #else
    539    !--- Passive CO2 tracer is at position 1 because: H2O has been removed ; nqCO2/=0 in "inco" case only
    540    conv_flg(1:nbtr) = [(1, ic=1, nqCO2),conv_flg_inca]
    541     pbl_flg(1:nbtr) = [(1, ic=1, nqCO2), pbl_flg_inca]
    542 #endif
    543509
    544510ELSE
    … …  
    578544END IF
    579545
     546   !--- Convection / boundary layer activation for all tracers
     547   ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
     548   ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
     549
    580550   !--- Note: nqtottr can differ from nbtr when nmom/=0
    581551!   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    582552!      CALL abort_gcm('infotrac_init', 'pb dans le calcul de nqtottr', 1)
    583 
    584    !--- Some aliases to be removed later
    585    ntraciso       => ntiso
    586    ntraceurs_zone => nzone
    587    qperemin       =  min_qParent
    588    masseqmin      =  min_qMass
    589    ratiomin       =  min_ratio
    590    iqiso          => iqTraPha
    591    index_trac     => itZonIso
    592553
    593554   !=== DISPLAY THE RESULTS
    … …  
    704665   USE readTracFiles_mod, ONLY: tnom_iso => newH2OIso
    705666   IMPLICIT NONE
    706    INTEGER, ALLOCATABLE  :: nb_iso(:), nb_tiso(:), nb_zone(:), ix(:)
     667   INTEGER, ALLOCATABLE  :: nb_iso(:), nb_tiso(:), nb_zone(:), ix(:), iy(:)
    707668   INTEGER               :: ii, ip, iq, it, iz, ixt
    708669   TYPE(isot_type), POINTER :: i
    … …  
    765726   END DO
    766727
    767    niso_possibles = SIZE(tnom_iso)
    768 !   ix = strIdx(tnom_iso, i%trac)
    769 !   tnat        = tnat0       (PACK(ix, MASK=ix/=0))
    770 !   alpha_ideal = alpha_ideal0(PACK(ix, MASK=ix/=0))
    771    tnat        = tnat0
    772    alpha_ideal = alpha_ideal0
     728   !--- Get vectors, one value each "isotope%trac" element (and in the same order)
     729   ix = strIdx(tnom_iso, i%trac)
     730   iy =   PACK(ix, MASK = ix/=0)
     731   tnat        = tnat0       (iy)
     732   alpha_ideal = alpha_ideal0(iy)
    773733
    774734   !--- Tests
    … …  
    786746
    787747   !--- Table: index in "qx(:)" of an isotope, knowing its indices "it","ip" in "isotope%iName,%iPhase"
    788    i%iqTraPha = RESHAPE([((strIdx(t%name, TRIM(addPhase(i%trac(it),ip,i%phase))),it=1,i%ntiso),ip=1,i%nphas)],[i%ntiso,i%nphas])
     748   i%iqIsoPha = RESHAPE([((strIdx(t%name, TRIM(addPhase(i%trac(it),ip,i%phase))),it=1,i%ntiso),ip=1,i%nphas)],[i%ntiso,i%nphas])
    789749
    790750   !--- Table: index in "isotope%tracs(:)%name" of an isotopic tagging tracer, knowing its indices "iz","ip" in "isotope%iZone,%iName"
    791751   i%itZonIso = RESHAPE([((strIdx(i%trac,TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))),iz=1,i%nzone),it=1,i%niso )],[i%nzone,i%niso])
    792752
    793    DO it=1,i%ntiso; CALL msg('iqTraPha('//TRIM(int2str(it))//',:) = '//strStack(int2str(i%iqTraPha(it,:))), modname); END DO
     753   DO it=1,i%ntiso; CALL msg('iqIsoPha('//TRIM(int2str(it))//',:) = '//strStack(int2str(i%iqIsoPha(it,:))), modname); END DO
    794754   DO iz=1,i%nzone; CALL msg('itZonIso('//TRIM(int2str(iz))//',:) = '//strStack(int2str(i%itZonIso(iz,:))), modname); END DO
    795 
    796    !--- Isotopic quantities (to be removed soon)
    797    ok_iso_verif  = i%check
    798    niso_possibles = SIZE(tnom_iso)
    799    iso_num       = [(strIdx(tnom_iso(:),    strHead(delPhase(tracers(iq)%name), '_')), iq=1, nqtot)]
    800    iso_indnum    = [(strIdx(i%keys(:)%name, strHead(delPhase(tracers(iq)%name), '_')), iq=1, nqtot)]
    801    indnum_fn_num = [(strIdx(i%keys(:)%name, tnom_iso(ixt)), ixt=1, niso_possibles)]
    802    use_iso       = indnum_fn_num /= 0            !--- .TRUE. for the effectively used isotopes of the possible isotopes list
    803755
    804756   !--- Finalize :
    … …  
    845797   isoPhas  => isotope%phase;    nphas    => isotope%nphas
    846798   itZonIso => isotope%itZonIso; isoCheck => isotope%check
    847    iqTraPha => isotope%iqTraPha
     799   iqIsoPha => isotope%iqIsoPha
    848800END FUNCTION isoSelectByIndex
    849801!==============================================================================================================================

  • 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

  • LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

    r4140 r4143  
    866866!=== NOTES:                                                                                                                ====
    867867!===  * Most of the "isot" components have been defined in the calling routine (initIsotopes):                             ====
    868 !===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqTraPha(:,:),  itZonPhi(:,:)      ====
     868!===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqIsoPha(:,:),  itZonPhi(:,:)      ====
    869869!===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
    870870!===  * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values             ====
    … …  
    986986    str = PACK(delPhase(t(:)%name), MASK=ll)
    987987    CALL strReduce(str)
    988     i%ntiso = i%niso + SIZE(str)                                     !--- Number of isotopes + their geographic tracers [ntraciso]
     988    i%ntiso = i%niso + SIZE(str)                                     !--- Number of isotopes + their geographic tracers [ntiso]
    989989    ALLOCATE(i%trac(i%ntiso))
    990990    FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
    … …  
    10091009    !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
    10101010    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
    1011     i%iqTraPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),    it=1, i%ntiso), ip=1, i%nphas)], &
     1011    i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),    it=1, i%ntiso), ip=1, i%nphas)], &
    10121012                         [i%ntiso, i%nphas] )
    10131013    !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
    … …  
    14071407  IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
    14081408  lH2O=.FALSE.
    1409   IF(LEN_TRIM(oldName)>3) THEN
    1410     lH2O = oldName(1:3)=='H2O' .AND. INDEX(old_phases,oldName(4:4))/=0     !---H2O<phase>*, with phase=="v", "l", "i" or "r"
    1411     IF(LEN_TRIM(oldName) > 4) lH2O = lH2O .AND. oldName(5:5)=='_'          !---H2O<phase>_*, with phase=="v", "l", "i" or "r"
     1409  IF(LEN_TRIM(oldName) > 3) THEN
     1410    lH2O = oldName(1:3)=='H2O' .AND. INDEX(old_phases,oldName(4:4))/=0         !--- H2O<phase>*, with phase=="v", "l", "i" or "r"
     1411    IF(LEN_TRIM(oldName) > 4) lH2O = lH2O .AND. oldName(5:5) == '_'            !--- H2O<phase>_*, with phase=="v", "l", "i" or "r"
    14121412  END IF
    14131413  IF(.NOT.lH2O) RETURN
    14141414  IF(LEN_TRIM(oldName)>3) THEN; IF(INDEX(old_Phases,oldName(4:4))==0) RETURN; END IF
    1415 
    1416 
    14171415  lerr = strParse(oldName, '_', tmp, n=nt)
    14181416  ip = strIdx([('H2O'//old_phases(ip:ip), ip=1, nphases)], tmp(1))             !--- Phase index (/=0 if any)

  • LMDZ6/trunk/libf/misc/trac_types_mod.F90

    r4120 r4143  
    4747    INTEGER                            :: ntiso = 0        !--- Number of isotopes, including tagging tracers
    4848    INTEGER                            :: nphas = 0        !--- Number phases
    49     INTEGER,               ALLOCATABLE :: iqTraPha(:,:)    !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
    50                                                            !---        "iqTraPha" former name: "iqiso"
     49    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)    !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
     50                                                           !---        "iqIsoPha" former name: "iqiso"
    5151    INTEGER,               ALLOCATABLE :: itZonIso(:,:)    !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
    5252                                                           !---        "itZonIso" former name: "index_trac"

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

    r4089 r4143  
    3030      USE print_control_mod, ONLY: prt_level,lunout
    3131#ifdef ISO
    32       use infotrac_phy, ONLY: ntraciso
     32      use infotrac_phy, ONLY: ntiso
    3333#ifdef ISOVERIF
    3434      USE isotopes_mod, ONLY: iso_eau,iso_HDO
    … …  
    145145
    146146#ifdef ISO
    147       REAL xt_seri(ntraciso,klon,klev),xtmemoire(ntraciso,klon,klev)
    148       REAL d_xt_ajs(ntraciso,klon,klev)
    149       real d_xt_the(ntraciso,klon,klev)
     147      REAL xt_seri(ntiso,klon,klev),xtmemoire(ntiso,klon,klev)
     148      REAL d_xt_ajs(ntiso,klon,klev)
     149      real d_xt_the(ntiso,klon,klev)
    150150#ifdef DIAGISO
    151151      real q_the(klon,klev)
    152       real xt_the(ntraciso,klon,klev)
     152      real xt_the(ntiso,klon,klev)
    153153#endif
    154154      real qprec(klon,klev)
    … …  
    205205                nbptspb=nbptspb+1
    206206#ifdef ISO
    207                 do ixt=1,ntraciso
     207                do ixt=1,ntiso
    208208                  xt_seri(ixt,i,k)=1.e-15*(xt_seri(ixt,i,k)/qprec(i,k))
    209209                  ! xt_seri(ixt,i,k)=1.e-15*(Rdefault(index_iso(ixt)))
    … …  
    228228       call iso_verif_egalite_vect2D( &
    229229     &           xt_seri,q_seri, &
    230      &           'calltherm 174',ntraciso,klon,klev)
     230     &           'calltherm 174',ntiso,klon,klev)
    231231      endif !if (iso_eau.gt.0) then
    232232#endif   
    … …  
    360360     &       +zdetr_therm(:,k)*fact(:)
    361361#ifdef ISO
    362             do ixt=1,ntraciso
     362            do ixt=1,ntiso
    363363              d_xt_the(ixt,:,k)=d_xt_the(ixt,:,k)*dtime*fact(:)
    364364            enddo
    … …  
    398398      call iso_verif_aberrant_enc_vect2D( &
    399399     &        xt_seri,q_seri, &
    400      &        'calltherm 353, apres ajout d_xt_the',ntraciso,klon,klev)
     400     &        'calltherm 353, apres ajout d_xt_the',ntiso,klon,klev)
    401401      endif     
    402402#endif
    … …  
    424424                nbptspb=nbptspb+1
    425425#ifdef ISO
    426                 do ixt=1,ntraciso
     426                do ixt=1,ntiso
    427427                  xt_seri(ixt,i,k)=1.e-15*(xtmemoire(ixt,i,k)/qmemoire(i,k))
    428428                enddo
    … …  
    440440      call iso_verif_aberrant_enc_vect2D( &
    441441     &        xt_seri,q_seri, &
    442      &        'calltherm 393, apres bidouille q<0',ntraciso,klon,klev)
     442     &        'calltherm 393, apres bidouille q<0',ntiso,klon,klev)
    443443      endif     
    444444#endif

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

    r4138 r4143  
    2727   PUBLIC :: niso,    nzone,   nphas,   ntiso              !---  " " numbers + isotopes & tagging tracers number
    2828   PUBLIC :: itZonIso                                      !--- iq = function(tagging zone idx, isotope idx)
    29    PUBLIC :: iqTraPha                                      !--- idx of tagging tracer in iName = function(isotope idx, phase idx)
     29   PUBLIC :: iqIsoPha                                      !--- idx of tagging tracer in iName = function(isotope idx, phase idx)
    3030   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
    3131   !=== FOR BOTH TRACERS AND ISOTOPES
    3232   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
    33 
    34    PUBLIC :: ntraciso, ntraceurs_zone, indnum_fn_num, use_iso, index_trac, iqiso
    35    PUBLIC :: niso_possibles, ok_iso_verif
    3633
    3734   INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
    … …  
    9693!  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
    9794!  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3  |
    98 !  | iqTraPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
     95!  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
    9996!  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |
    10097!  +-----------------+--------------------------------------------------+--------------------+-----------------+
    … …  
    126123                                             nphas, ntiso, &    !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
    127124                                            itZonIso(:,:), &    !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
    128                                             iqTraPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
    129 !$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzone,nphas,ntiso, itZonIso,iqTraPha)
     125                                            iqIsoPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
     126!$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzone,nphas,ntiso, itZonIso,iqIsoPha)
    130127
    131128   !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA
    … …  
    133130                                             pbl_flg(:)         !--- Boundary layer activation ; needed for INCA        (nbtr)
    134131!$OMP THREADPRIVATE(conv_flg, pbl_flg)
    135 
    136    !--- Aliases for older names + quantities to be removed             (will be replaced by:)
    137    INTEGER, POINTER, SAVE :: ntraciso, ntraceurs_zone           !--- -> ntiso, nzone
    138 !$OMP THREADPRIVATE         (ntraciso, ntraceurs_zone)   
    139    INTEGER, POINTER, SAVE :: index_trac(:,:), iqiso(:,:)        !--- -> itZonIso, iqTraPha
    140 !$OMP THREADPRIVATE         (index_trac,      iqiso)
    141    INTEGER, SAVE :: niso_possibles                              !--- suppressed (use effective niso instead)
    142 !$OMP THREADPRIVATE(niso_possibles)
    143    LOGICAL, SAVE :: ok_iso_verif                                !--- -> isoCheck
    144 !$OMP THREADPRIVATE(ok_iso_verif)
    145    LOGICAL, SAVE, ALLOCATABLE :: use_iso(:)                     !--- suppressed
    146 !$OMP THREADPRIVATE             (use_iso)
    147    INTEGER, SAVE, ALLOCATABLE :: indnum_fn_num(:)
    148 !$OMP THREADPRIVATE             (indnum_fn_num)
    149132
    150133#ifdef CPP_StratAer
    … …  
    190173
    191174   !=== Determine selected isotopes class related quantities:
    192    !    ixIso, isotope, niso,isoKeys, ntiso,isoName, nzone,isoZone, nphas,isoPhas, itZonIso, iqTraPha, isoCheck
     175   !    ixIso, isotope, niso,isoKeys, ntiso,isoName, nzone,isoZone, nphas,isoPhas, itZonIso, iqIsoPha, isoCheck
    193176   IF(.NOT.isoSelect('H2O')) iH2O = ixIso
    194177   IF(prt_level > 1) THEN
    … …  
    221204   END IF
    222205#endif
    223 
    224    !--- Isotopic quantities (to be removed soon)
    225    ntraciso       => ntiso
    226    ntraceurs_zone => nzone
    227    iqiso          => iqTraPha
    228    index_trac     => itZonIso
    229    ok_iso_verif   = isoCheck
    230    niso_possibles = SIZE(tnom_iso)
    231    indnum_fn_num  = [(strIdx(isotope%keys(:)%name, tnom_iso(ixt)), ixt=1, niso_possibles)]
    232    use_iso        = indnum_fn_num /= 0
    233206#ifdef ISOVERIF
    234207   CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
    … …  
    275248   isoPhas  => isotope%phase;    nphas    => isotope%nphas
    276249   itZonIso => isotope%itZonIso; isoCheck => isotope%check
    277    iqTraPha => isotope%iqTraPha
     250   iqIsoPha => isotope%iqIsoPha
    278251END FUNCTION isoSelectByIndex
    279252!==============================================================================================================================

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

    r4120 r4143  
    3535    USE iophy
    3636    USE dimphy
    37     USE infotrac_phy, ONLY: nqtot, tracers, type_trac, niso, ntraciso
     37    USE infotrac_phy, ONLY: nqtot, tracers, type_trac, niso
    3838    USE strings_mod,  ONLY: maxlen
    3939    USE ioipsl

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

    r4120 r4143  
    2525
    2626    USE dimphy, ONLY: klon, klev, klevp1
    27     USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntraciso
     27    USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntiso
    2828    USE strings_mod,  ONLY: maxlen
    2929    USE mod_phys_lmdz_para, ONLY: is_north_pole_phy,is_south_pole_phy
    … …  
    25982598
    25992599#ifdef ISO
    2600     do ixt=1,ntraciso
     2600    do ixt=1,ntiso
    26012601!        write(*,*) 'ixt'
    26022602        IF (vars_defined) zx_tmp_fi2d(:) = xtrain_fall(ixt,:) + xtsnow_fall(ixt,:)
    … …  
    26522652
    26532653    !write(*,*) 'phys_output_write_mod 2531'
    2654     enddo !do ixt=1,ntraciso   
     2654    enddo
    26552655#endif
    26562656

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

    r4088 r4143  
    499499USE infotrac_phy, ONLY : nbtr
    500500#ifdef ISO
    501 USE infotrac_phy, ONLY : ntraciso,niso
     501USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
    502502#endif
    503503USE indice_sol_mod

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

    r4140 r4143  
    444444    !======================================================================
    445445    !
    446     INTEGER ivap          ! indice de traceurs pour vapeur d'eau
    447     PARAMETER (ivap=1)
    448     INTEGER iliq          ! indice de traceurs pour eau liquide
    449     PARAMETER (iliq=2)
    450     INTEGER isol          ! indice de traceurs pour eau glace
    451     PARAMETER (isol=3)
    452     INTEGER irneb         ! indice de traceurs pour fraction nuageuse LS (optional)
    453     PARAMETER (irneb=4)   
     446    ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional)
     447    INTEGER,SAVE :: ivap, iliq, isol, irneb
     448!$OMP THREADPRIVATE(ivap, iliq, isol, irneb)
    454449    !
    455450    !
    … …  
    12551250
    12561251    IF (first) THEN
     1252       ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
     1253       iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
     1254       isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
     1255       irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))
    12571256       CALL init_etat0_limit_unstruct
    12581257       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)

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

    r4133 r4143  
    2222
    2323#ifdef ISO
    24   USE infotrac_phy, ONLY : ntraciso
     24  USE infotrac_phy, ONLY : ntiso
    2525#ifdef ISOVERIF
    2626  USE isotopes_mod, ONLY : iso_eau,iso_HDO
    … …  
    140140
    141141#ifdef ISO
    142       REAL xtpo(ntraciso,ngrid,nlay),xtpdoadj(ntraciso,ngrid,nlay)
    143       REAL xtzo(ntraciso,ngrid,nlay)
     142      REAL xtpo(ntiso,ngrid,nlay),xtpdoadj(ntiso,ngrid,nlay)
     143      REAL xtzo(ntiso,ngrid,nlay)
    144144      REAL xtpdoadj_tmp(ngrid,nlay)
    145145      REAL xtpo_tmp(ngrid,nlay)
    … …  
    368368     &           zlev,lmax,zmax,zmax0,zmix,wmax)
    369369! Attention, w2 est transforme en sa racine carree dans cette routine
    370 ! Le probleme vient du fait que linter et lmix sont souvent égaux à 1.
     370! Le probleme vient du fait que linter et lmix sont souvent egaux a 1.
    371371      wmax_tmp=0.
    372372      do  l=1,nlay
    … …  
    488488
    489489#ifdef ISO
    490         ! C Risi: on utilise directement la même routine
    491         do ixt=1,ntraciso
     490        ! C Risi: on utilise directement la meme routine
     491        do ixt=1,ntiso
    492492          do ll=1,nlay
    493493            DO ig=1,ngrid
    … …  
    503503            enddo
    504504          enddo
    505         enddo !do ixt=1,ntraciso
     505        enddo
    506506#endif
    507507
    … …  
    749749! nrlmd le 10/04/2012   Transport de la TKE par le thermique moyen pour la fermeture en ALP
    750750!                       On transporte pbl_tke pour donner therm_tke
    751 !                       Copie conforme de la subroutine DTKE dans physiq.F écrite par Frederic Hourdin
     751!                       Copie conforme de la subroutine DTKE dans physiq.F ecrite par Frederic Hourdin
    752752
    753753!=======================================================================

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

    r4004 r4143  
    3939  USE mod_grid_phy_lmdz, ONLY: nbp_lev
    4040#ifdef ISO
    41   USE infotrac_phy, ONLY: ntraciso
     41  USE infotrac_phy, ONLY: ntraciso=>ntiso
    4242  USE isotopes_mod, ONLY: iso_eau
    4343#endif
    … …  
    154154
    155155#ifdef ISO
    156     USE infotrac_phy, ONLY: ntraciso 
     156    USE infotrac_phy, ONLY: ntraciso=>ntiso
    157157#ifdef ISOVERIF
    158158    USE isotopes_mod, ONLY: iso_eau

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

    r4004 r4143  
    1818USE print_control_mod, ONLY: prt_level
    1919#ifdef ISO
    20     USE infotrac_phy, ONLY: ntraciso   
     20    USE infotrac_phy, ONLY: ntiso   
    2121    USE phys_state_var_mod, ONLY:  wake_deltaxt   
    2222#endif
    … …  
    3131  INTEGER,                       INTENT (IN)         :: abortphy
    3232#ifdef ISO
    33   REAL, DIMENSION(ntraciso,klon, klev),   INTENT (IN)         :: zddeltaxt
     33  REAL, DIMENSION(ntiso, klon, klev), INTENT (IN)    :: zddeltaxt
    3434#endif
    3535
    … …  
    6161               wake_deltaq(i, l) = wake_deltaq(i, l) + zddeltaq(i,l)
    6262#ifdef ISO
    63                do ixt=1,ntraciso
     63               do ixt=1,ntiso
    6464                 wake_deltaxt(ixt,i, l) = wake_deltaxt(ixt,i, l) + zddeltaxt(ixt,i,l)
    6565               enddo
    … …  
    6969               wake_deltaq(i, l) = 0.
    7070#ifdef ISO
    71                do ixt=1,ntraciso
     71               do ixt=1,ntiso
    7272                 wake_deltaxt(ixt,i, l) = 0.0
    7373               enddo

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

    r4004 r4143  
    99  USE dimphy
    1010#ifdef ISO
    11     USE infotrac_phy, ONLY: ntraciso    
     11    USE infotrac_phy, ONLY: ntraciso =>ntiso   
    1212#ifdef ISOVERIF
    1313  USE isotopes_mod, ONLY : iso_eau,iso_HDO
    … …  
    303303  USE dimphy
    304304#ifdef ISO
    305     USE infotrac_phy, ONLY: ntraciso      
     305    USE infotrac_phy, ONLY: ntraciso=>ntiso   
    306306#ifdef ISOVERIF
    307307  USE isotopes_mod, ONLY : iso_eau,iso_HDO

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

    r4033 r4143  
    3535  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
    3636#ifdef ISO
    37   USE infotrac_phy, ONLY : ntraciso
     37  USE infotrac_phy, ONLY : ntraciso=>ntiso
    3838#ifdef ISOVERIF
    3939  USE isotopes_mod, ONLY: iso_eau

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

    r4004 r4143  
    3939    USE print_control_mod, ONLY: lunout
    4040#ifdef ISO
    41   USE infotrac_phy, ONLY: ntraciso   
     41  USE infotrac_phy, ONLY: ntiso   
    4242#endif
    4343   
    … …  
    6666!albedo SB <<<
    6767#ifdef ISO
    68     REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT)        :: xtevap
     68    REAL, DIMENSION(ntiso,klon,nbsrf), INTENT(INOUT)        :: xtevap
    6969#endif
    7070

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

    r4124 r4143  
    66  USE dimphy
    77#ifdef ISO
    8   USE infotrac_phy, ONLY: ntraciso ! ajout C Risi pour isos     
     8  USE infotrac_phy, ONLY: ntraciso=>ntiso ! ajout C Risi pour isos     
    99#endif
    1010
    … …  
    5959            )
    6060#ifdef ISOVERIF
    61 !USE infotrac_phy, ONLY: use_iso
    6261USE isotopes_mod, ONLY: iso_eau,iso_HDO
    6362!USE isotopes_verif_mod, ONLY: errmax, errmaxrel

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

    r4004 r4143  
    4444  USE infotrac_phy, ONLY: nbtr
    4545#ifdef ISO
    46   USE infotrac_phy, ONLY: ntraciso
     46  USE infotrac_phy, ONLY: ntraciso=>ntiso
    4747  USE isotopes_mod, ONLY: iso_eau, bidouille_anti_divergence, ridicule, &
    4848        iso_eau,iso_HDO

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

    r4050 r4143  
    165165    )
    166166#ifdef ISO
    167     USE infotrac_phy, ONLY: ntraciso   
     167    USE infotrac_phy, ONLY: ntraciso=>ntiso
    168168#endif
    169169  IMPLICIT NONE
    … …  
    370370
    371371#ifdef ISO
    372 USE infotrac_phy, ONLY: ntraciso
     372USE infotrac_phy, ONLY: ntraciso=>ntiso
    373373USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, &
    374374        iso_eau,iso_HDO, ridicule
    … …  
    947947  USE print_control_mod, ONLY: lunout
    948948#ifdef ISO
    949     use infotrac_phy, ONLY: ntraciso
     949    use infotrac_phy, ONLY: ntraciso=>ntiso
    950950    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
    951951#ifdef ISOVERIF
    … …  
    11331133    ! epmax_cape: ajout arguments
    11341134#ifdef ISO
    1135 use infotrac_phy, ONLY: ntraciso
     1135use infotrac_phy, ONLY: ntraciso=>ntiso
    11361136USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, iso_eau,iso_HDO
    11371137USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
    … …  
    18281828
    18291829#ifdef ISO
    1830 use infotrac_phy, ONLY: ntraciso,niso,index_trac
     1830use infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
    18311831USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax, iso_eau,iso_HDO, &
    18321832        ridicule
    … …  
    26162616        call iso_verif_traceur(xtclw(1,il,im), &
    26172617     &          'condiso_liq_ice_vectiso_trac 358')
    2618         if (iso_verif_positif_nostop(xtclw(index_trac( &
     2618        if (iso_verif_positif_nostop(xtclw(itZonIso( &
    26192619     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    26202620     &           ,'cv30_routines 909').eq.1) then
    … …  
    26242624     &             niso,ntraciso,index_zone,izone_cond       
    26252625               stop
    2626          endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     2626         endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    26272627#endif             
    26282628         enddo !do il = 1, ncum   
    … …  
    26472647     &          )
    26482648#ifdef ISO
    2649     use infotrac_phy, ONLY: ntraciso
     2649    use infotrac_phy, ONLY: ntraciso=>ntiso
    26502650    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO,ridicule
    26512651    use isotopes_routines_mod, ONLY: appel_stewart_vectall
    … …  
    26592659#ifdef ISOTRAC
    26602660    use isotrac_mod, only: option_cond,izone_cond
    2661     use infotrac_phy, ONLY: index_trac
     2661    use infotrac_phy, ONLY: itZonIso
    26622662#ifdef ISOVERIF
    26632663    use isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
    … …  
    29382938           ! on verifie que tout le detrainement est tagge condensat
    29392939           if (iso_verif_positif_nostop( &
    2940      &          xtwdtrain(index_trac(izone_cond,iso_eau),il) &
     2940     &          xtwdtrain(itZonIso(izone_cond,iso_eau),il) &
    29412941     &          -xtwdtrain(iso_eau,il), &
    29422942     &          'cv30_routines 2795').eq.1) then
    … …  
    32003200!        if (option_tmin.ge.1) then
    32013201!           call iso_verif_positif(xtwater(
    3202 !     :           index_trac(izone_cond,iso_eau),il,i+1)
     3202!     :           itZonIso(izone_cond,iso_eau),il,i+1)
    32033203!     :           -xtwater(iso_eau,il,i+1),
    32043204!     :          'cv30_routines 3083')
    … …  
    32593259!        if (option_tmin.ge.1) then
    32603260!         call iso_verif_positif(xtwater(
    3261 !     :           index_trac(izone_cond,iso_eau),il,i)
     3261!     :           itZonIso(izone_cond,iso_eau),il,i)
    32623262!     :           -xtwater(iso_eau,il,i),
    32633263!     :          'cv30_routines 3143')
    … …  
    33693369     &                    )
    33703370#ifdef ISO
    3371     use infotrac_phy, ONLY: ntraciso,niso, &
    3372 &       ntraceurs_zone,index_trac
     3371    use infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso
    33733372    use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
    33743373#ifdef ISOVERIF
    … …  
    50035002          do iiso = 1, niso
    50045003             
    5005              ixt_ddft=index_trac(izone_ddft,iiso) 
     5004             ixt_ddft=itZonIso(izone_ddft,iiso) 
    50065005             if (mp(il,i).gt.mp(il,i+1)) then
    50075006                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    … …  
    50165015     &              -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
    50175016       
    5018              ixt_poubelle=index_trac(izone_poubelle,iiso)
     5017             ixt_poubelle=itZonIso(izone_poubelle,iiso)
    50195018             fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso)
    50205019             fxt(ixt_poubelle,il,i)=fxt(ixt_poubelle,il,i) &
    … …  
    50335032     &              -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
    50345033
    5035                 ixt_ddft=index_trac(izone_ddft,iiso)
     5034                ixt_ddft=itZonIso(izone_ddft,iiso)
    50365035                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    50375036     &           *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
    50385037                fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso) 
    50395038
    5040                ixt_revap=index_trac(izone_revap,iiso) 
     5039               ixt_revap=itZonIso(izone_revap,iiso) 
    50415040               fxt_revap(iiso)=0.01*grav*dpinv*(mp(il,i+1)* &
    50425041     &                  (xtp(ixt_revap,il,i+1)-xt(ixt_revap,il,i)) &
    … …  
    50495048     &                   -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i)
    50505049                if (Xe(iiso).gt.ridicule) then
    5051                   do izone=1,ntraceurs_zone
     5050                  do izone=1,nzone
    50525051                   if ((izone.ne.izone_revap).and. &
    50535052     &                   (izone.ne.izone_ddft)) then
    5054                     ixt=index_trac(izone,iiso)
     5053                    ixt=itZonIso(izone,iiso)
    50555054                    fxt(ixt,il,i)=fxt(ixt,il,i) &
    50565055     &                   +xt(ixt,il,i)/Xe(iiso)*fxtXe(iiso)
    50575056                   endif !if ((izone.ne.izone_revap).and.
    5058                   enddo !do izone=1,ntraceurs_zone   
     5057                  enddo !do izone=1,nzone   
    50595058#ifdef ISOVERIF
    50605059!                write(*,*) 'iiso=',iiso
    … …  
    50785077                endif
    50795078#endif                   
    5080                 do izone=1,ntraceurs_zone
     5079                do izone=1,nzone
    50815080                   if ((izone.ne.izone_revap).and. &
    50825081     &                   (izone.ne.izone_ddft)) then                   
    5083                     ixt=index_trac(izone,iiso)
     5082                    ixt=itZonIso(izone,iiso)
    50845083                    if (izone.eq.izone_poubelle) then
    50855084                      fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
    … …  
    50885087                    endif !if (izone.eq.izone_poubelle) then
    50895088                   endif !if ((izone.ne.izone_revap).and.
    5090                 enddo !do izone=1,ntraceurs_zone
     5089                enddo !do izone=1,nzone
    50915090#ifdef ISOVERIF
    50925091                  call iso_verif_traceur_justmass(fxt(1,il,i), &
    … …  
    52375236        enddo !do ixt = 1+niso,ntraciso
    52385237!        write(*,*) 'tmp cv3_yield 4165: i,il=',i,il
    5239 !        ixt_poubelle=index_trac(izone_poubelle,iso_eau)
    5240 !        ixt_ddft=index_trac(izone_ddft,iso_eau)
     5238!        ixt_poubelle=itZonIso(izone_poubelle,iso_eau)
     5239!        ixt_ddft=itZonIso(izone_ddft,iso_eau)
    52415240!        write(*,*) 'delt*fxt(ixt_poubelle,il,i)=',
    52425241!     :           delt*fxt(ixt_poubelle,il,i)
    … …  
    52445243!        write(*,*) 'xt(iso_eau,il,i)=',xt(iso_eau,il,i)
    52455244          do iiso = 1, niso
    5246              ixt_poubelle=index_trac(izone_poubelle,iiso)
    5247              ixt_ddft=index_trac(izone_ddft,iiso) 
     5245             ixt_poubelle=itZonIso(izone_poubelle,iiso)
     5246             ixt_ddft=itZonIso(izone_ddft,iiso) 
    52485247             if (mp(il,i).gt.mp(il,i+1)) then
    52495248                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    … …  
    61116110
    61126111#ifdef ISO
    6113     use infotrac_phy, ONLY: ntraciso
     6112    use infotrac_phy, ONLY: ntraciso=>ntiso
    61146113#ifdef ISOVERIF
    61156114    use isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &

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

    r4004 r4143  
    77                       )
    88#ifdef ISO
    9     use infotrac_phy, ONLY: ntraciso
     9    use infotrac_phy, ONLY: ntiso
    1010#endif
    1111  ! **************************************************************
    … …  
    4343  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
    4444#ifdef ISO
    45   REAL, DIMENSION (ntraciso,len,nd), INTENT (IN)     :: xt
     45  REAL, DIMENSION (ntiso,len,nd), INTENT (IN)     :: xt
    4646#endif
    4747!input/output:
    … …  
    5454  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
    5555#ifdef ISO
    56   REAL, DIMENSION (ntraciso,len), INTENT (OUT)     :: xtmix
     56  REAL, DIMENSION (ntiso,len), INTENT (OUT)     :: xtmix
    5757#endif
    5858!internal variables :
    … …  
    153153        vmix(i) = vmix(i) + v(i, j)*wi(i, j)
    154154#ifdef ISO
    155         do ixt=1,ntraciso
     155        do ixt=1,ntiso
    156156          xtmix(ixt,i) = xtmix(ixt,i) +  xt(ixt,i, j)*wi(i, j)
    157157        enddo

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

    r4004 r4143  
    77                       )
    88#ifdef ISO
    9     use infotrac_phy, ONLY: ntraciso
     9    use infotrac_phy, ONLY: ntiso
    1010#endif
    1111  ! **************************************************************
    … …  
    4646  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
    4747#ifdef ISO
    48   REAL, DIMENSION (ntraciso,len,nd), INTENT (IN)     :: xt
     48  REAL, DIMENSION (ntiso,len,nd), INTENT (IN)     :: xt
    4949#endif
    5050!input/output:
    … …  
    5757  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
    5858#ifdef ISO
    59   REAL, DIMENSION (ntraciso,len), INTENT (OUT)     :: xtmix
     59  REAL, DIMENSION (ntiso,len), INTENT (OUT)     :: xtmix
    6060#endif
    6161!internal variables :
    … …  
    153153        vmix(i) = vmix(i) +  v(i, j)*wi(i, j)
    154154#ifdef ISO
    155         do ixt=1,ntraciso
     155        do ixt=1,ntiso
    156156          xtmix(ixt,i) = xtmix(ixt,i) +  xt(ixt,i, j)*wi(i, j)
    157157        enddo

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

    r4123 r4143  
    314314     &   )
    315315#ifdef ISO
    316     use infotrac_phy, ONLY: ntraciso
     316    use infotrac_phy, ONLY: ntraciso=>ntiso
    317317#ifdef ISOVERIF
    318318    use isotopes_verif_mod, ONLY: iso_verif_positif,iso_verif_noNaN,iso_verif_egalite
    … …  
    685685     &                   )
    686686#ifdef ISO
    687 USE infotrac_phy, ONLY: ntraciso
     687USE infotrac_phy, ONLY: ntraciso=>ntiso
    688688USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, &
    689689        iso_eau,iso_HDO,ridicule
    … …  
    12741274  USE print_control_mod, ONLY: lunout
    12751275#ifdef ISO
    1276     use infotrac_phy, ONLY: ntraciso
     1276    use infotrac_phy, ONLY: ntraciso=>ntiso
    12771277    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
    12781278#ifdef ISOVERIF
    … …  
    14741474  USE print_control_mod, ONLY: prt_level
    14751475#ifdef ISO
    1476 use infotrac_phy, ONLY: ntraciso
     1476use infotrac_phy, ONLY: ntraciso=>ntiso
    14771477USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, &
    14781478        iso_eau,iso_HDO
    … …  
    27772777
    27782778#ifdef ISO
    2779 use infotrac_phy, ONLY: ntraciso,niso,index_trac
     2779use infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
    27802780USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax, iso_eau,iso_HDO, &
    27812781        ridicule
    … …  
    35803580        call iso_verif_traceur(xtclw(1,il,im), &
    35813581     &          'condiso_liq_ice_vectiso_trac 358')
    3582         if (iso_verif_positif_nostop(xtclw(index_trac( &
     3582        if (iso_verif_positif_nostop(xtclw(itZonIso( &
    35833583     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    35843584     &           ,'cv3_routines 909').eq.1) then
    … …  
    35883588     &             niso,ntraciso,index_zone,izone_cond     
    35893589               stop
    3590          endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     3590         endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    35913591#endif             
    35923592         enddo !do il = 1, ncum   
    … …  
    36153615  USE print_control_mod, ONLY: prt_level, lunout
    36163616#ifdef ISO
    3617     use infotrac_phy, ONLY: ntraciso
     3617    use infotrac_phy, ONLY: ntraciso=>ntiso
    36183618    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO, &
    36193619        ridicule
    … …  
    36283628#ifdef ISOTRAC
    36293629    use isotrac_mod, only: option_cond,izone_cond
    3630     use infotrac_phy, ONLY: index_trac
     3630    use infotrac_phy, ONLY: itZonIso
    36313631#ifdef ISOVERIF
    36323632    use isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &
    … …  
    39933993          ! on verifie que tout le detrainement est tagge condensat
    39943994          if (iso_verif_positif_nostop( &
    3995      &          xtwdtrain(index_trac(izone_cond,iso_eau),il) &
     3995     &          xtwdtrain(itZonIso(izone_cond,iso_eau),il) &
    39963996     &          -xtwdtrain(iso_eau,il), &
    39973997     &          'cv3_routines 2795').eq.1) then
    … …  
    45354535!        if (option_tmin.ge.1) then
    45364536!           call iso_verif_positif(xtwater(
    4537 !     :           index_trac(izone_cond,iso_eau),il,i+1)
     4537!     :           itZonIso(izone_cond,iso_eau),il,i+1)
    45384538!     :           -xtwater(iso_eau,il,i+1),
    45394539!     :          'cv3_routines 3083')
    … …  
    46024602!        if (option_tmin.ge.1) then
    46034603!         call iso_verif_positif(xtwater(
    4604 !     :           index_trac(izone_cond,iso_eau),il,i)
     4604!     :           itZonIso(izone_cond,iso_eau),il,i)
    46054605!     :           -xtwater(iso_eau,il,i),
    46064606!     :          'cv3_routines 3143')
    … …  
    47414741
    47424742#ifdef ISO
    4743     use infotrac_phy, ONLY: ntraciso,niso, &
    4744 &       ntraceurs_zone,index_trac
     4743    use infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso
    47454744    use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18
    47464745#ifdef ISOVERIF
    … …  
    58895888          do iiso = 1, niso
    58905889             
    5891              ixt_ddft=index_trac(izone_ddft,iiso) 
     5890             ixt_ddft=itZonIso(izone_ddft,iiso) 
    58925891             if (mp(il,i).gt.mp(il,i+1)) then
    58935892                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    … …  
    59025901     &              -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
    59035902       
    5904              ixt_poubelle=index_trac(izone_poubelle,iiso)
     5903             ixt_poubelle=itZonIso(izone_poubelle,iiso)
    59055904             fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso)
    59065905             fxt(ixt_poubelle,il,i)=fxt(ixt_poubelle,il,i) &
    … …  
    59195918     &              -mp(il,i)*(xtp(iiso,il,i)-xt(iiso,il,i-1)))
    59205919
    5921                 ixt_ddft=index_trac(izone_ddft,iiso)
     5920                ixt_ddft=itZonIso(izone_ddft,iiso)
    59225921                fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) &
    59235922     &           *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i))
    59245923                fxt(ixt_ddft,il,i)=fxt(ixt_ddft,il,i)+fxtYe(iiso) 
    59255924
    5926                ixt_revap=index_trac(izone_revap,iiso) 
     5925               ixt_revap=itZonIso(izone_revap,iiso) 
    59275926               fxt_revap(iiso)=0.01*grav*dpinv*(mp(il,i+1)* &
    59285927     &                  (xtp(ixt_revap,il,i+1)-xt(ixt_revap,il,i)) &
    … …  
    59355934     &                   -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i)
    59365935                if (Xe(iiso).gt.ridicule) then
    5937                   do izone=1,ntraceurs_zone
     5936                  do izone=1,nzone
    59385937                   if ((izone.ne.izone_revap).and. &
    59395938     &                   (izone.ne.izone_ddft)) then
    5940                     ixt=index_trac(izone,iiso)
     5939                    ixt=itZonIso(izone,iiso)
    59415940                    fxt(ixt,il,i)=fxt(ixt,il,i) &
    59425941     &                   +xt(ixt,il,i)/Xe(iiso)*fxtXe(iiso)
    59435942                   endif !if ((izone.ne.izone_revap).and.
    5944                   enddo !do izone=1,ntraceurs_zone   
     5943                  enddo !do izone=1,nzone   
    59455944#ifdef ISOVERIF
    59465945!                write(*,*) 'iiso=',iiso
    … …  
    59645963                endif
    59655964#endif                   
    5966                 do izone=1,ntraceurs_zone
     5965                do izone=1,nzone
    59675966                   if ((izone.ne.izone_revap).and. &
    59685967     &                   (izone.ne.izone_ddft)) then                   
    5969                     ixt=index_trac(izone,iiso)
     5968                    ixt=itZonIso(izone,iiso)
    59705969                    if (izone.eq.izone_poubelle) then
    59715970                      fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso)
    … …  
    59745973                    endif !if (izone.eq.izone_poubelle) then
    59755974                   endif !if ((izone.ne.izone_revap).and.
    5976                 enddo !do izone=1,ntraceurs_zone
     5975                enddo !do izone=1,nzone
    59775976#ifdef ISOVERIF
    59785977                  call iso_verif_traceur_justmass(fxt(1,il,i), &
    … …  
    74597458     &     )   
    74607459#ifdef ISO
    7461     use infotrac_phy, ONLY: ntraciso
     7460    use infotrac_phy, ONLY: ntraciso=>ntiso
    74627461#ifdef ISOVERIF
    74637462    use isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &

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

    r4004 r4143  
    3434  ! **************************************************************
    3535#ifdef ISO
    36     use infotrac_phy, ONLY: ntraciso
     36    use infotrac_phy, ONLY: ntraciso=>ntiso
    3737    use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO
    3838#ifdef ISOVERIF

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

    r4004 r4143  
    5454
    5555#ifdef ISO
    56   USE infotrac_phy, ONLY : ntraciso
     56  USE infotrac_phy, ONLY : ntraciso=>ntiso
    5757#endif
    5858  IMPLICIT NONE

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

    r4033 r4143  
    2121  USE add_phys_tend_mod, ONLY: fl_cor_ebil
    2222#ifdef ISO
    23   USE infotrac_phy, ONLY: ntraciso
     23  USE infotrac_phy, ONLY: ntraciso=>ntiso
    2424  USE isotopes_mod, ONLY: pxtmelt,pxtice
    2525  USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
    … …  
    13011301            call iso_verif_egalite_choix(xtent(iso_eau,il,im,jm), &
    13021302              qent(il,im,jm),'cv3p_mixing 2112',errmax,errmaxrel)
    1303           endif !if (use_iso_eau) then
     1303          endif !if (iso_eau>0) then
    13041304#ifdef ISOTRAC
    13051305        call iso_verif_traceur_justmass(xtelij(1,il,im,jm), &   
    … …  
    13531353!        call iso_verif_traceur(xtclw(1,il,im), &
    13541354!               'cv3p_mixing 358')
    1355 !        if (iso_verif_positif_nostop(xtclw(index_trac( &
     1355!        if (iso_verif_positif_nostop(xtclw(itZonIso( &
    13561356!                izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    13571357!                ,'cv3p_mixing 909').eq.1) then
    … …  
    13611361!                  niso,ntraciso,index_zone,izone_cond     
    13621362!               stop
    1363 !         endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     1363!         endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    13641364!#endif             
    13651365!         enddo !do il = 1, ncum   

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

    r4004 r4143  
    2525  USE dimphy
    2626#ifdef ISO
    27   USE infotrac_phy, ONLY: ntraciso,niso,index_trac,ntraceurs_zone
     27  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso,nzone
    2828  USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule,bidouille_anti_divergence
    2929#ifdef ISOVERIF
    … …  
    511511    CALL cv_param(nd)
    512512#ifdef ISO
    513        write(*,*) 'cv_driver 454: isos pas prévus ici'
     513       write(*,*) 'cv_driver 454: isos pas prevus ici'
    514514       stop
    515515#endif
    … …  
    687687!c--debug
    688688#ifdef ISOVERIF
    689        write(*,*) 'cv_driver 621: après cv3_undilute1'
     689       write(*,*) 'cv_driver 621: apres cv3_undilute1'
    690690       do k = 1, klev
    691691        do i = 1, klon
    … …  
    752752        !write(*,*) 'xt1(iso_eau,1,1),q1(1,1)=',xt1(iso_eau,1,1),q1(1,1)
    753753        !write(*,*) 'xt1(iso_eau,14,1),q1(14,1)=',xt1(iso_eau,14,1),q1(14,1)
    754         !write(*,*) 'iso_eau,use_iso=',iso_eau,use_iso
    755754       do k = 1, klev
    756755        do i = 1, nloc
    … …  
    783782#ifdef ISO
    784783#ifdef ISOVERIF
    785        write(*,*) 'cv_driver 720: après cv3_compress'           
     784       write(*,*) 'cv_driver 720: apres cv3_compress'           
    786785       do k = 1, klev
    787786        do i = 1, ncum
    … …  
    883882                ,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
    884883                ,epmax_diag)
    885         ! on écrase ep et recalcule hp
     884        ! on écrase ep et recalcule hp
    886885    END IF
    887886
    … …  
    910909#ifdef ISO
    911910#ifdef ISOVERIF
    912        write(*,*) 'cv_driver 837: après cv3_mixing'
     911       write(*,*) 'cv_driver 837: apres cv3_mixing'
    913912       do k = 1, klev
    914913       do j = 1, klev
    … …  
    925924           call iso_verif_traceur_justmass(xtelij(1,i,j,k), &
    926925     &           'cv_driver 847')
    927            ! on ne vérfier pas le deltaD ici car peut dépasser le seuil
    928            ! raisonable pour températures très froides.
     926           ! on ne verifie pas le deltaD ici car peut depasser le seuil
     927           ! raisonable pour temperatures tres froides.
    929928#endif               
    930929        enddo
    … …  
    940939           call iso_verif_traceur(xt(1,i,k),'cv_driver 856')
    941940           if (option_tmin.eq.1) then
    942              if (iso_verif_positif_nostop(xtclw(index_trac( &
     941             if (iso_verif_positif_nostop(xtclw(itZonIso( &
    943942     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    944943     &           ,'cv_driver 909').eq.1) then
    … …  
    946945               write(*,*) 'xtclw=',xtclw(:,i,k)
    947946               stop
    948              endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     947             endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    949948           endif !if ((option_traceurs.eq.17).or.
    950949#endif 
    … …  
    1000999       write(*,*) 'klev=',klev
    10011000#ifdef ISOVERIF
    1002        write(*,*) 'cv_driver 930: après cv3_unsat'
     1001       write(*,*) 'cv_driver 930: apres cv3_unsat'
    10031002       do k = 1, klev
    10041003        do i = 1, ncum
    … …  
    10481047            do i = 1, ncum
    10491048               do iiso=1,niso
    1050                   ixt_ddft=index_trac(izone_ddft,iiso)
    1051                   ixt_poubelle=index_trac(izone_poubelle,iiso)
     1049                  ixt_ddft=itZonIso(izone_ddft,iiso)
     1050                  ixt_poubelle=itZonIso(izone_poubelle,iiso)
    10521051                  xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
    10531052     &                    +xtp(ixt_poubelle,i,k)
    … …  
    10631062          do k = 1, klev
    10641063            do i = 1, ncum
    1065                do izone=1,ntraceurs_zone
     1064               do izone=1,nzone
    10661065                 if (izone.eq.izone_ddft) then
    10671066                   do iiso=1,niso
    1068                      ixt_ddft=index_trac(izone,iiso)
    1069                      ixt_revap=index_trac(izone_revap,iiso)
     1067                     ixt_ddft=itZonIso(izone,iiso)
     1068                     ixt_revap=itZonIso(izone_revap,iiso)
    10701069                     xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
    10711070                   enddo !do iiso=1,niso
    10721071                 elseif (izone.eq.izone_ddft) then
    1073                     ! rien à faire
     1072                    ! rien a faire
    10741073                 else !if (izone.eq.izone_ddft) then
    10751074                   do iiso=1,niso
    1076                      ixt=index_trac(izone,iiso)
     1075                     ixt=itZonIso(izone,iiso)
    10771076                     xtp(ixt,i,k)=0.0
    10781077                   enddo !do iiso=1,niso
    10791078                 endif !if (izone.eq.izone_ddft) then
    1080                enddo !do izone=1,ntraceurs_zone
     1079               enddo !do izone=1,nzone
    10811080#ifdef ISOVERIF
    10821081               call iso_verif_traceur(xtp(1,i,k),'cv_driver 1059')
    … …  
    12471246! si icvflag_Tpa=0, alors la fraction de glace dans l'ascendance adiabatique est
    12481247  ! fonction de la temperature de l'environnement et la temperature de l'ascendance est
    1249   ! calculee en deux itérations, une en supposant qu'il n'y a pas de glace et l'autre
    1250   ! en ajoutant la glace (ancien schéma d'Arnaud Jam).
     1248  ! calculee en deux iterations, une en supposant qu'il n'y a pas de glace et l'autre
     1249  ! en ajoutant la glace (ancien schema d'Arnaud Jam).
    12511250! si icvflag_Tpa=1, alors la fraction de glace dans l'ascendance adiabatique est
    12521251  ! fonction de la temperature de l'environnement et la temperature de l'ascendance est

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

    r4033 r4143  
    5454  USE add_phys_tend_mod, ONLY: fl_cor_ebil
    5555#ifdef ISO
    56   USE infotrac_phy, ONLY: ntraciso,niso,niso,index_trac,ntraceurs_zone
     56  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,niso,itZonIso,nzone
    5757  USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,ridicule,bidouille_anti_divergence
    5858#ifdef ISOVERIF
    … …  
    13881388           call iso_verif_traceur(xt(1,i,k),'cva_driver 856')
    13891389           if (option_tmin.eq.1) then
    1390              if (iso_verif_positif_nostop(xtclw(index_trac( &
     1390             if (iso_verif_positif_nostop(xtclw(itZonIso( &
    13911391     &           izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
    13921392     &           ,'cva_driver 909').eq.1) then
    … …  
    13941394               write(*,*) 'xtclw=',xtclw(:,i,k)
    13951395               stop
    1396              endif !if (iso_verif_positif_nostop(xtclw(index_trac(
     1396             endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
    13971397           endif !if ((option_traceurs.eq.17).or.
    13981398#endif 
    … …  
    15091509            do i = 1, ncum
    15101510               do iiso=1,niso
    1511                   ixt_ddft=index_trac(izone_ddft,iiso)
    1512                   ixt_poubelle=index_trac(izone_poubelle,iiso)
     1511                  ixt_ddft=itZonIso(izone_ddft,iiso)
     1512                  ixt_poubelle=itZonIso(izone_poubelle,iiso)
    15131513                  xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
    15141514     &                    +xtp(ixt_poubelle,i,k)
    … …  
    15241524          do k=1,nd
    15251525            do i = 1, ncum
    1526                do izone=1,ntraceurs_zone
     1526               do izone=1,nzone
    15271527                 if (izone.eq.izone_ddft) then
    15281528                   do iiso=1,niso
    1529                      ixt_ddft=index_trac(izone,iiso)
    1530                      ixt_revap=index_trac(izone_revap,iiso)
     1529                     ixt_ddft=itZonIso(izone,iiso)
     1530                     ixt_revap=itZonIso(izone_revap,iiso)
    15311531                     xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
    15321532                   enddo !do iiso=1,niso
    … …  
    15351535                 else !if (izone.eq.izone_ddft) then
    15361536                   do iiso=1,niso
    1537                      ixt=index_trac(izone,iiso)
     1537                     ixt=itZonIso(izone,iiso)
    15381538                     xtp(ixt,i,k)=0.0
    15391539                   enddo !do iiso=1,niso
    15401540                 endif !if (izone.eq.izone_ddft) then
    1541                enddo !do izone=1,ntraceurs_zone
     1541               enddo !do izone=1,nzone
    15421542#ifdef ISOVERIF
    15431543               call iso_verif_traceur(xtp(1,i,k),'cva_driver 1059')

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

    r3927 r4143  
    2727  USE add_phys_tend_mod, only : fl_cor_ebil
    2828#ifdef ISO
    29   USE infotrac_phy, ONLY: ntraciso,niso,index_trac,ntraceurs_zone
     29  USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso
    3030  USE isotopes_mod
    3131!, ONLY: essai_convergence,bidouille_anti_divergence, &
    … …  
    15101510                   zxtn(iso_eau,i)=zqn(i)
    15111511#ifdef ISOTRAC
    1512                    zxtn(index_trac(izone_poubelle,iso_eau),i)=zqn(i) 
     1512                   zxtn(itZonIso(izone_poubelle,iso_eau),i)=zqn(i) 
    15131513                   if (option_tmin.eq.1) then                   
    15141514                     zxtcs(iso_eau,i)=zqcs(i)
    … …  
    18481848           ! part le tag résuel et le condensat
    18491849           if (iso_verif_positif_choix_nostop( &
    1850      &           zxt_ancien(index_trac(izone,iso_eau),i) &
    1851      &          -zxt(index_trac(izone,iso_eau),i),1e-8,'ilp 1270') &
     1850     &           zxt_ancien(itZonIso(izone,iso_eau),i) &
     1851     &          -zxt(itZonIso(izone,iso_eau),i),1e-8,'ilp 1270') &
    18521852     &          .eq.1) then
    18531853            write(*,*) 'i,izone,rneb=',i,izone,rneb(i,k)

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

    r4033 r4143  
    629629        ! de dépendance circulaire.
    630630
    631     USE infotrac_phy, ONLY: ntraciso,niso
     631    USE infotrac_phy, ONLY: ntiso,niso
    632632    USE isotopes_mod, ONLY: iso_eau   
    633633  USE indice_sol_mod   
    … …  
    639639         ! inputs
    640640        integer klon,knon
    641         real xtprecip_snow(ntraciso,klon),xtprecip_rain(ntraciso,klon)
     641        real xtprecip_snow(ntiso,klon),xtprecip_rain(ntiso,klon)
    642642    INTEGER, INTENT(IN)                  :: nisurf
    643643    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex

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

    r4124 r4143  
    33
    44MODULE isotopes_mod
    5 USE infotrac_phy, ONLY: ntraciso,niso,indnum_fn_num,use_iso, &
    6 &       niso_possibles
    7 IMPLICIT NONE
    8 SAVE
    9 
    10 ! contient toutes les variables isotopiques et leur initialisation
    11 ! les routines specifiquement isotopiques sont dans
    12 ! isotopes_routines_mod pour éviter dépendance circulaire avec
    13 ! isotopes_verif_mod.
    14 
    15 
    16 ! indices des isotopes
    17 integer, save :: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO ! indices de 1 à niso: les isos n'existant pas sont mis à 0
    18 !$OMP THREADPRIVATE(iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO)
    19 
    20 integer :: iso_eau_possible,iso_HDO_possible,iso_O18_possible,iso_O17_possible,iso_HTO_possible ! indices de 1 à niso_possibles: ils correspondent aux tableaux définis dans infotrac:
    21 ! tnom_iso=(/'eau','HDO','O18','O17','HTO'/)
    22 ! ce sont ces indices qui doivent être utilisés avec use_iso, puisque use_iso est défini comme DIMENSION(niso_possibles)
    23 parameter (iso_eau_possible=1)
    24 parameter (iso_HDO_possible=2)
    25 parameter (iso_O18_possible=3)
    26 parameter (iso_O17_possible=4)
    27 parameter (iso_HTO_possible=5)
    28 
    29 integer, save :: ntracisoOR
     5   USE strings_mod, ONLY: msg, real2str, int2str, bool2str, maxlen, strIdx, strStack
     6   IMPLICIT NONE
     7   INTERFACE get_in; MODULE PROCEDURE getinp_s, getinp_i, getinp_r, getinp_l;  END INTERFACE get_in
     8   SAVE
     9
     10  !--- Contains all isotopic variables + their initialization
     11  !--- Isotopes-specific routines are in isotopes_routines_mod to avoid circular dependencies with isotopes_verif_mod.
     12
     13   !--- Isotopes indices (in [1,niso] ; non-existing => 0 index)
     14   INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO
     15!$OMP THREADPRIVATE(iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO)
     16
     17   INTEGER, SAVE :: ntracisoOR
    3018!$OMP THREADPRIVATE(ntracisoOR)
    3119
    32 ! variables indépendantes des isotopes
    33 
    34 real, save :: pxtmelt,pxtice,pxtmin,pxtmax
    35 !$OMP THREADPRIVATE(pxtmelt,pxtice,pxtmin,pxtmax)
    36 real, save ::  tdifexp, tv0cin, thumxt1
     20   !--- Variables not depending on isotopes
     21   REAL,    SAVE :: pxtmelt, pxtice, pxtmin, pxtmax
     22!$OMP THREADPRIVATE(pxtmelt, pxtice, pxtmin, pxtmax)
     23   REAL,    SAVE :: tdifexp, tv0cin, thumxt1
    3724!$OMP THREADPRIVATE(tdifexp, tv0cin, thumxt1)
    38 integer, save :: ntot
     25   INTEGER, SAVE :: ntot
    3926!$OMP THREADPRIVATE(ntot)
    40 real, save :: h_land_ice
     27   REAL,    SAVE :: h_land_ice
    4128!$OMP THREADPRIVATE(h_land_ice)
    42 real, save :: P_veg
     29   REAL,    SAVE :: P_veg
    4330!$OMP THREADPRIVATE(P_veg)
    44 real, save ::  musi,lambda_sursat
    45 !$OMP THREADPRIVATE(lambda_sursat)
    46 real, save :: Kd
     31   REAL,    SAVE :: musi, lambda_sursat
     32!$OMP THREADPRIVATE(musi, lambda_sursat)
     33   REAL,    SAVE :: Kd
    4734!$OMP THREADPRIVATE(Kd)
    48 real, save ::  rh_cste_surf_cond,T_cste_surf_cond
    49 !$OMP THREADPRIVATE(rh_cste_surf_cond,T_cste_surf_cond)
    50 
    51 logical, save ::   bidouille_anti_divergence
    52                 ! si true, rappel régulier de xteau vers q, pour éviter dérives lentes
     35   REAL,    SAVE :: rh_cste_surf_cond, T_cste_surf_cond
     36!$OMP THREADPRIVATE(rh_cste_surf_cond, T_cste_surf_cond)
     37   LOGICAL, SAVE :: bidouille_anti_divergence    ! T: regularly, xteau <- q to avoid slow drifts
    5338!$OMP THREADPRIVATE(bidouille_anti_divergence)
    54 logical, save ::   essai_convergence
    55                 ! si false, on fait rigoureusement comme dans LMDZ sans isotopes,
    56                 ! meme si c'est génant pour les isotopes
     39   LOGICAL, SAVE :: essai_convergence            ! F: as in LMDZ without isotopes (bad for isotopes)
    5740!$OMP THREADPRIVATE(essai_convergence)
    58 integer, save ::   initialisation_iso
    59                 ! 0: dans fichier
    60                 ! 1: R=0
    61                 ! 2: R selon distill rayleigh
    62                 ! 3: R=Rsmow
     41   INTEGER, SAVE :: initialisation_iso           ! 0: file ; 1: R=0 ; 2: R=distill. Rayleigh ; 3: R=Rsmow
    6342!$OMP THREADPRIVATE(initialisation_iso)
    64 integer, save ::  modif_SST ! 0 par defaut, 1 si on veut modifier la sst
    65                 ! 2 et 3: profils de SST
     43   INTEGER, SAVE :: modif_SST                    ! 0: default ; 1: modified SST ; 2, 3: SST profiles
    6644!$OMP THREADPRIVATE(modif_SST)
    67 real, save ::  deltaTtest ! modif de la SST, uniforme.
     45   REAL,    SAVE :: deltaTtest                   ! Uniform modification of the SST
    6846!$OMP THREADPRIVATE(deltaTtest)
    69 integer, save ::  modif_sic ! on met des trous dans glace de mer
     47   INTEGER, SAVE :: modif_sic                    ! Holes in the Sea Ice
    7048!$OMP THREADPRIVATE(modif_sic)
    71 real, save ::  deltasic ! fraction de trous minimale
     49   REAL,    SAVE :: deltasic                     ! Minimal holes fraction
    7250!$OMP THREADPRIVATE(deltasic)
    73 real, save :: deltaTtestpoles
     51   REAL,    SAVE :: deltaTtestpoles
    7452!$OMP THREADPRIVATE(deltaTtestpoles)
    75 real, save ::  sstlatcrit
    76 !$OMP THREADPRIVATE(sstlatcrit)
    77 real, save ::  dsstlatcrit
    78 !$OMP THREADPRIVATE(dsstlatcrit)
    79 real, save ::  deltaO18_oce
     53   REAL,    SAVE :: sstlatcrit, dsstlatcrit
     54!$OMP THREADPRIVATE(sstlatcrit, dsstlatcrit)
     55   REAL,    SAVE :: deltaO18_oce
    8056!$OMP THREADPRIVATE(deltaO18_oce)
    81 integer, save ::  albedo_prescrit ! 0 par defaut
    82                         ! 1 si on veut garder albedo constant
     57   INTEGER, SAVE :: albedo_prescrit              ! 0: default ; 1: constant albedo
    8358!$OMP THREADPRIVATE(albedo_prescrit)
    84 real, save ::  lon_min_albedo,lon_max_albedo
    85 !$OMP THREADPRIVATE(lon_min_albedo,lon_max_albedo)
    86 real, save :: lat_min_albedo,lat_max_albedo
    87 !$OMP THREADPRIVATE(lat_min_albedo,lat_max_albedo)
    88 real, save ::  deltaP_BL,tdifexp_sol
     59   REAL,    SAVE :: lon_min_albedo, lon_max_albedo, lat_min_albedo, lat_max_albedo
     60!$OMP THREADPRIVATE(lon_min_albedo, lon_max_albedo, lat_min_albedo, lat_max_albedo)
     61   REAL,    SAVE :: deltaP_BL,tdifexp_sol
    8962!$OMP THREADPRIVATE(deltaP_BL,tdifexp_sol)
    90 integer, save ::  ruissellement_pluie,alphak_stewart
    91 !$OMP THREADPRIVATE(ruissellement_pluie,alphak_stewart)
    92 integer, save :: calendrier_guide
     63   INTEGER, SAVE :: ruissellement_pluie, alphak_stewart
     64!$OMP THREADPRIVATE(ruissellement_pluie, alphak_stewart)
     65   INTEGER, SAVE :: calendrier_guide
    9366!$OMP THREADPRIVATE(calendrier_guide)
    94 integer, save :: cste_surf_cond
     67   INTEGER, SAVE :: cste_surf_cond
    9568!$OMP THREADPRIVATE(cste_surf_cond)
    96 real, save :: mixlen
     69   REAL,    SAVE :: mixlen
    9770!$OMP THREADPRIVATE(mixlen)
    98 integer, save :: evap_cont_cste
     71   INTEGER, SAVE :: evap_cont_cste
    9972!$OMP THREADPRIVATE(evap_cont_cste)
    100 real, save ::  deltaO18_evap_cont,d_evap_cont
    101 !$OMP THREADPRIVATE(deltaO18_evap_cont,d_evap_cont)
    102 integer, save ::  nudge_qsol,region_nudge_qsol
    103 !$OMP THREADPRIVATE(nudge_qsol,region_nudge_qsol)
    104 integer, save :: nlevmaxO17
     73   REAL,    SAVE :: deltaO18_evap_cont, d_evap_cont
     74!$OMP THREADPRIVATE(deltaO18_evap_cont, d_evap_cont)
     75   INTEGER, SAVE :: nudge_qsol, region_nudge_qsol
     76!$OMP THREADPRIVATE(nudge_qsol, region_nudge_qsol)
     77   INTEGER, SAVE :: nlevmaxO17
    10578!$OMP THREADPRIVATE(nlevmaxO17)
    106 integer, save ::  no_pce
    107 !       real, save :: slope_limiterxy,slope_limiterz
     79   INTEGER, SAVE :: no_pce
    10880!$OMP THREADPRIVATE(no_pce)
    109 real, save :: A_satlim
     81   REAL,    SAVE :: A_satlim
    11082!$OMP THREADPRIVATE(A_satlim)
    111 integer, save ::  ok_restrict_A_satlim,modif_ratqs
    112 !$OMP THREADPRIVATE(ok_restrict_A_satlim,modif_ratqs)
    113 real, save ::  Pcrit_ratqs,ratqsbasnew
    114 !$OMP THREADPRIVATE(Pcrit_ratqs,ratqsbasnew)
    115 real, save :: fac_modif_evaoce
     83   INTEGER, SAVE :: ok_restrict_A_satlim, modif_ratqs
     84!$OMP THREADPRIVATE(ok_restrict_A_satlim, modif_ratqs)
     85   REAL,    SAVE :: Pcrit_ratqs, ratqsbasnew
     86!$OMP THREADPRIVATE(Pcrit_ratqs, ratqsbasnew)
     87   REAL,    SAVE :: fac_modif_evaoce
    11688!$OMP THREADPRIVATE(fac_modif_evaoce)
    117 integer, save :: ok_bidouille_wake
     89   INTEGER, SAVE :: ok_bidouille_wake
    11890!$OMP THREADPRIVATE(ok_bidouille_wake)
    119 logical :: cond_temp_env
     91   LOGICAL, SAVE :: cond_temp_env
    12092!$OMP THREADPRIVATE(cond_temp_env)
    12193
    122 
    123 ! variables tableaux fn de niso
    124 real, ALLOCATABLE, DIMENSION(:), save :: tnat, toce, tcorr
    125 !$OMP THREADPRIVATE(tnat, toce, tcorr)
    126 real, ALLOCATABLE, DIMENSION(:), save :: tdifrel
    127 !$OMP THREADPRIVATE(tdifrel)
    128 real, ALLOCATABLE, DIMENSION(:), save :: talph1, talph2, talph3
    129 !$OMP THREADPRIVATE(talph1, talph2, talph3)
    130 real, ALLOCATABLE, DIMENSION(:), save :: talps1, talps2
    131 !$OMP THREADPRIVATE(talps1, talps2)
    132 real, ALLOCATABLE, DIMENSION(:), save :: tkcin0, tkcin1, tkcin2
     94   !--- Vectors of length "niso"
     95   REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
     96                    tnat, toce, tcorr, tdifrel
     97!$OMP THREADPRIVATE(tnat, toce, tcorr, tdifrel)
     98   REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
     99                    talph1, talph2, talph3, talps1, talps2
     100!$OMP THREADPRIVATE(talph1, talph2, talph3, talps1, talps2)
     101   REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
     102                    tkcin0, tkcin1, tkcin2
    133103!$OMP THREADPRIVATE(tkcin0, tkcin1, tkcin2)
    134 real, ALLOCATABLE, DIMENSION(:), save :: alpha_liq_sol
    135 !$OMP THREADPRIVATE(alpha_liq_sol)
    136 real, ALLOCATABLE, DIMENSION(:), save :: Rdefault, Rmethox
    137 !$OMP THREADPRIVATE(Rdefault, Rmethox)
     104   REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
     105                    alpha_liq_sol, Rdefault, Rmethox
     106!$OMP THREADPRIVATE(alpha_liq_sol, Rdefault, Rmethox)
    138107character*3, ALLOCATABLE, DIMENSION(:), save :: striso
    139108!$OMP THREADPRIVATE(striso)
    140 real, save :: fac_coeff_eq17_liq, fac_coeff_eq17_ice
     109   REAL, SAVE ::    fac_coeff_eq17_liq, fac_coeff_eq17_ice
    141110!$OMP THREADPRIVATE(fac_coeff_eq17_liq, fac_coeff_eq17_ice)
    142111
    143       real ridicule ! valeur maximale pour qu'une variable de type
    144                     ! rapoport de mélange puisse être considérée comme négligeable. Si
    145                     ! négligeable, alors on ne verifie pas si sa compo iso esta bérrante.
    146       parameter (ridicule=1e-12)     
    147 !      parameter (ridicule=1)
    148 !
    149       real ridicule_rain ! valeur limite de ridicule pour les flux de pluies (rain, zrfl...)
    150       parameter (ridicule_rain=1e-8) ! en kg/s <-> 1e-3mm/day
    151 
    152       real ridicule_evap ! valeur limite de ridicule pour les evap
    153       parameter (ridicule_evap=ridicule_rain*1e-2) ! en kg/s <-> 1e-3mm/day
    154 
    155       real ridicule_qsol ! valeur limite de ridicule pour les qsol
    156       parameter (ridicule_qsol=ridicule_rain) ! en kg <-> 1e-8kg
    157 
    158       real ridicule_snow ! valeur limite de ridicule pour les snow
    159       parameter (ridicule_snow=ridicule_qsol) ! en kg/s <-> 1e-8kg
    160      
    161         real expb_max
    162         parameter (expb_max=30.0)
    163 
    164         ! spécifique au tritium:
    165        
    166 
    167 logical, save :: ok_prod_nucl_tritium ! si oui, production de tritium par essais nucleaires
     112   !--- Negligible lower thresholds: no need to check for absurd values under these lower limits
     113   REAL, PARAMETER :: &
     114      ridicule      = 1e-12,              & ! For mixing ratios
     115      ridicule_rain = 1e-8,               & ! For rain fluxes (rain, zrfl...) in kg/s <-> 1e-3 mm/day
     116      ridicule_evap = ridicule_rain*1e-2, & ! For evaporations                in kg/s <-> 1e-3 mm/day
     117      ridicule_qsol = ridicule_rain,      & ! For qsol                        in kg <-> 1e-8 kg
     118      ridicule_snow = ridicule_qsol         ! For snow                        in kg <-> 1e-8 kg
     119   REAL, PARAMETER :: expb_max = 30.0
     120!$OMP THREADPRIVATE(ridicule, ridicule_rain, ridicule_evap, ridicule_qsol, ridicule_snow, expb_max)
     121
     122   !--- Specific to HTO:
     123   LOGICAL, SAVE :: ok_prod_nucl_tritium    !--- TRUE => HTO production by nuclear tests
    168124!$OMP THREADPRIVATE(ok_prod_nucl_tritium)
    169         integer nessai
    170         parameter (nessai=486)
    171         integer, save :: day_nucl(nessai)
    172 !$OMP THREADPRIVATE(day_nucl)
    173         integer, save :: month_nucl(nessai)
    174 !$OMP THREADPRIVATE(month_nucl)
    175         integer, save :: year_nucl(nessai)
    176 !$OMP THREADPRIVATE(year_nucl)
    177         real, save :: lat_nucl(nessai)
    178 !$OMP THREADPRIVATE(lat_nucl)
    179         real, save :: lon_nucl(nessai)
    180 !$OMP THREADPRIVATE(lon_nucl)
    181         real, save :: zmin_nucl(nessai)
    182 !$OMP THREADPRIVATE(zmin_nucl)
    183         real, save :: zmax_nucl(nessai)
    184 !$OMP THREADPRIVATE(zmax_nucl)
    185         real, save :: HTO_nucl(nessai)
    186 !$OMP THREADPRIVATE(HTO_nucl)
    187 
     125   INTEGER, PARAMETER :: nessai = 486
     126   INTEGER, DIMENSION(nessai), SAVE :: &
     127                    day_nucl, month_nucl, year_nucl
     128!$OMP THREADPRIVATE(day_nucl, month_nucl, year_nucl)
     129   REAL,    DIMENSION(nessai), SAVE :: &
     130                    lat_nucl, lon_nucl, zmin_nucl, zmax_nucl, HTO_nucl
     131!$OMP THREADPRIVATE(lat_nucl, lon_nucl, zmin_nucl, zmax_nucl, HTO_nucl)
     132 
    188133 
    189134CONTAINS
    190135
    191   SUBROUTINE iso_init()
    192       use ioipsl_getin_p_mod, ONLY : getin_p
    193       implicit none
    194 
    195 ! -- local variables:
    196 
    197       integer ixt
    198       ! référence O18
    199       real fac_enrichoce18
    200       real alpha_liq_sol_O18, &
    201      &     talph1_O18,talph2_O18,talph3_O18, &
    202      &     talps1_O18,talps2_O18, &
    203      &     tkcin0_O18,tkcin1_O18,tkcin2_O18, &
    204      &     tdifrel_O18 
     136SUBROUTINE iso_init()
     137   USE ioipsl_getin_p_mod, ONLY: getin_p
     138   USE infotrac_phy,       ONLY: ntiso, niso, isoName
     139   IMPLICIT NONE
     140
     141   !=== Local variables:
     142   INTEGER :: ixt
     143
     144   !--- H2[18]O reference
     145   REAL :: fac_enrichoce18, alpha_liq_sol_O18, &
     146           talph1_O18, talph2_O18, talph3_O18, talps1_O18, talps2_O18, &
     147           tkcin0_O18, tkcin1_O18, tkcin2_O18, tdifrel_O18 
     148
     149   !--- For H2[17]O
     150   REAL    :: fac_kcin, pente_MWL
     151   INTEGER :: ierr
    205152     
    206       ! cas de l'O17
    207       real fac_kcin
    208       real pente_MWL
    209       integer ierr
    210      
    211       logical ok_nocinsat, ok_nocinsfc !sensi test
    212       parameter (ok_nocinsfc=.FALSE.)  ! if T: no kinetic effect in sfc evap
    213       parameter (ok_nocinsat=.FALSE.)  ! if T: no sursaturation effect for ice
    214       logical Rdefault_smow
    215       parameter (Rdefault_smow=.FALSE.) ! si T: Rdefault=smow; si F: nul
    216       ! pour le tritium
    217       integer iessai
    218 
    219     write(*,*) 'iso_init 219: entree'
    220 
    221 ! allocations mémoire
    222 allocate (tnat(niso))
    223 allocate (toce(niso))
    224 allocate (tcorr(niso))
    225 allocate (tdifrel(niso))
    226 allocate (talph1(niso))
    227 allocate (talph2(niso))
    228 allocate (talph3(niso))
    229 allocate (talps1(niso))
    230 allocate (talps2(niso))
    231 allocate (tkcin0(niso))
    232 allocate (tkcin1(niso))
    233 allocate (tkcin2(niso))
    234 allocate (alpha_liq_sol(niso))
    235 allocate (Rdefault(niso))
    236 allocate (Rmethox(niso))
    237 allocate (striso(niso))
    238 
    239 
    240 !--------------------------------------------------------------
    241 ! General:
    242 !--------------------------------------------------------------
    243 
    244 ! -- verif du nombre d'isotopes:
    245       write(*,*) 'iso_init 64: niso=',niso
    246 
    247 ! init de ntracisoOR: on écrasera en cas de nzone>0 si complications avec
    248 ! ORCHIDEE
    249       ntracisoOR=ntraciso 
    250              
    251 ! -- Type of water isotopes:
    252 
    253         iso_eau=indnum_fn_num(1)
    254         iso_HDO=indnum_fn_num(2)
    255         iso_O18=indnum_fn_num(3)
    256         iso_O17=indnum_fn_num(4)
    257         iso_HTO=indnum_fn_num(5)
    258         write(*,*) 'iso_init 59: iso_eau=',iso_eau
    259         write(*,*) 'iso_HDO=',iso_HDO
    260         write(*,*) 'iso_O18=',iso_O18
    261         write(*,*) 'iso_O17=',iso_O17
    262         write(*,*) 'iso_HTO=',iso_HTO
    263         write(*,*) 'iso_init 251: use_iso=',use_iso
    264 
    265       ! initialisation
    266         lambda_sursat=0.004
    267         thumxt1=0.75*1.2
    268         ntot=20
    269         h_land_ice=20. ! à comparer aux 3000mm de snow_max
    270         P_veg=1.0
    271         bidouille_anti_divergence=.false.
    272         essai_convergence=.false.
    273         initialisation_iso=0
    274         modif_sst=0
    275         modif_sic=0
    276         deltaTtest=0.0
    277         deltasic=0.1
    278         deltaTtestpoles=0.0
    279         sstlatcrit=30.0
    280         deltaO18_oce=0.0
    281         albedo_prescrit=0
    282         lon_min_albedo=-200
    283         lon_max_albedo=200
    284         lat_min_albedo=-100
    285         lat_max_albedo=100
    286         deltaP_BL=10.0
    287         ruissellement_pluie=0
    288         alphak_stewart=1
    289         tdifexp_sol=0.67
    290         calendrier_guide=0
    291         cste_surf_cond=0
    292 mixlen=35.0       
    293 evap_cont_cste=0.0
    294 deltaO18_evap_cont=0.0
    295 d_evap_cont=0.0
    296 nudge_qsol=0
    297 region_nudge_qsol=1
    298 nlevmaxO17=50
    299 no_pce=0
    300 A_satlim=1.0
    301 ok_restrict_A_satlim=0
    302 !        slope_limiterxy=2.0
    303 !        slope_limiterz=2.0
    304 modif_ratqs=0
    305 Pcrit_ratqs=500.0
    306 ratqsbasnew=0.05
    307 
    308 fac_modif_evaoce=1.0
    309 ok_bidouille_wake=0
    310 cond_temp_env=.false.
    311 ! si oui, la temperature de cond est celle de l'environnement,
    312 ! pour eviter bugs quand temperature dans ascendances convs est
    313 ! mal calculee
    314 ok_prod_nucl_tritium=.false.
    315 
    316 ! lecture des paramètres isotopiques:
    317 ! pour que ça marche en openMP, il faut utiliser getin_p. Car le getin ne peut
    318 ! être appelé que par un thread à la fois, et ça pose tout un tas de problème,
    319 ! d'où tout un tas de magouilles comme dans conf_phys_m. A terme, tout le monde
    320 ! lira par getin_p.
    321 call getin_p('lambda',lambda_sursat)
    322 call getin_p('thumxt1',thumxt1)
    323 call getin_p('ntot',ntot)
    324 call getin_p('h_land_ice',h_land_ice)
    325 call getin_p('P_veg',P_veg)
    326 call getin_p('bidouille_anti_divergence',bidouille_anti_divergence)
    327 call getin_p('essai_convergence',essai_convergence)
    328 call getin_p('initialisation_iso',initialisation_iso)
    329 !if (nzone>0) then     
    330 !if (initialisation_iso.eq.0) then
    331 !  call getin_p('initialisation_isotrac',initialisation_isotrac)
    332 !endif !if (initialisation_iso.eq.0) then
    333 !endif !if (nzone>0)
    334 call getin_p('modif_sst',modif_sst)
    335 if (modif_sst.ge.1) then
    336 call getin_p('deltaTtest',deltaTtest)
    337 if (modif_sst.ge.2) then
    338   call getin_p('deltaTtestpoles',deltaTtestpoles)
    339   call getin_p('sstlatcrit',sstlatcrit)
     153   !--- Sensitivity tests
     154   LOGICAL, PARAMETER ::   ok_nocinsfc = .FALSE. ! if T: no kinetic effect in sfc evap
     155   LOGICAL, PARAMETER ::   ok_nocinsat = .FALSE. ! if T: no sursaturation effect for ice
     156   LOGICAL, PARAMETER :: Rdefault_smow = .FALSE. ! if T: Rdefault=smow; if F: nul
     157
     158   !--- For [3]H
     159   INTEGER :: iessai
     160
     161   CHARACTER(LEN=maxlen) :: modname, sxt
     162
     163   modname = 'iso_init'
     164   CALL msg('219: entree', modname)
     165
     166   !--- Memory allocations
     167   ALLOCATE(talph1(niso), tkcin0(niso),  talps1(niso),  tnat(niso))
     168   ALLOCATE(talph2(niso), tkcin1(niso),  talps2(niso),  toce(niso))
     169   ALLOCATE(talph3(niso), tkcin2(niso), tdifrel(niso), tcorr(niso))
     170   ALLOCATE(alpha_liq_sol(niso),   Rdefault(niso),   Rmethox(niso))
     171   ALLOCATE(striso(niso))
     172
     173
     174   !--------------------------------------------------------------
     175   ! General:
     176   !--------------------------------------------------------------
     177
     178   !--- Check number of isotopes
     179   CALL msg('64: niso = '//TRIM(int2str(niso)), modname)
     180
     181   !--- Init de ntracisoOR: on ecrasera en cas de traceurs de tagging isotopiques
     182   !                     (nzone>0) si complications avec ORCHIDEE
     183   ntracisoOR = ntiso 
     184
     185   !--- Type of water isotopes:
     186   iso_eau = strIdx(isoName, 'H2[16]O'); CALL msg('59: iso_eau='//int2str(iso_eau), modname)
     187   iso_O17 = strIdx(isoName, 'H2[17]O'); CALL msg('iso_HDO='//int2str(iso_HDO), modname)
     188   iso_O18 = strIdx(isoName, 'H2[18]O'); CALL msg('iso_O18='//int2str(iso_O18), modname)
     189   iso_HDO = strIdx(isoName, 'H[2]HO');  CALL msg('iso_O17='//int2str(iso_O17), modname)
     190   iso_HTO = strIdx(isoName, 'H[3]HO');  CALL msg('iso_HTO='//int2str(iso_HTO), modname)
     191
     192   ! initialisation
     193   ! lecture des parametres isotopiques:
     194   ! pour que ca marche en openMP, il faut utiliser getin_p. Car le getin ne peut
     195   ! etre appele que par un thread a la fois, et ca pose tout un tas de problemes,
     196   ! d'ou tout un tas de magouilles comme dans conf_phys_m. A terme, tout le monde
     197   ! lira par getin_p.
     198   CALL get_in('lambda',     lambda_sursat, 0.004)
     199   CALL get_in('thumxt1',    thumxt1,       0.75*1.2)
     200   CALL get_in('ntot',       ntot,          20,  .FALSE.)
     201   CALL get_in('h_land_ice', h_land_ice,    20., .FALSE.)
     202   CALL get_in('P_veg',      P_veg,         1.0, .FALSE.)
     203   CALL get_in('bidouille_anti_divergence', bidouille_anti_divergence, .FALSE.)
     204   CALL get_in('essai_convergence',         essai_convergence,         .FALSE.)
     205   CALL get_in('initialisation_iso',        initialisation_iso,        0)
     206
     207!  IF(nzone>0 .AND. initialisation_iso==0) &
     208!      CALL get_in('initialisation_isotrac',initialisation_isotrac)
     209   CALL get_in('modif_sst',      modif_sst,         0)
     210   CALL get_in('deltaTtest',     deltaTtest,      0.0)     !--- For modif_sst>=1
     211   CALL get_in('deltaTtestpoles',deltaTtestpoles, 0.0)     !--- For modif_sst>=2
     212   CALL get_in( 'sstlatcrit',    sstlatcrit,     30.0)     !--- For modif_sst>=3
     213   CALL get_in('dsstlatcrit',   dsstlatcrit,      0.0)     !--- For modif_sst>=3
    340214#ifdef ISOVERIF
    341       !call iso_verif_positif(sstlatcrit,'iso_init 107')
    342       if (sstlatcrit.lt.0.0) then
    343         write(*,*) 'iso_init 270: sstlatcrit=',sstlatcrit
    344         stop
    345       endif
     215   CALL msg('iso_init 270:  sstlatcrit='//real2str( sstlatcrit), modname, sstlatcrit < 0.0) !--- For modif_sst>=2
     216   CALL msg('iso_init 279: dsstlatcrit='//real2str(dsstlatcrit), modname, sstlatcrit < 0.0) !--- For modif_sst>=3
     217   IF(modif_sst >= 2 .AND. sstlatcrit < 0.0) STOP
    346218#endif             
    347   if (modif_sst.ge.3) then 
    348       call getin_p('dsstlatcrit',dsstlatcrit)
     219
     220   CALL get_in('modif_sic', modif_sic,  0)
     221   IF(modif_sic >= 1) &
     222   CALL get_in('deltasic',  deltasic, 0.1)
     223
     224   CALL get_in('albedo_prescrit', albedo_prescrit, 0)
     225   IF(albedo_prescrit == 1) THEN
     226      CALL get_in('lon_min_albedo', lon_min_albedo, -200.)
     227      CALL get_in('lon_max_albedo', lon_max_albedo,  200.)
     228      CALL get_in('lat_min_albedo', lat_min_albedo, -100.)
     229      CALL get_in('lat_max_albedo', lat_max_albedo,  100.)
     230   END IF
     231   CALL get_in('deltaO18_oce',        deltaO18_oce,   0.0)
     232
     233   CALL get_in('deltaP_BL',           deltaP_BL,     10.0)
     234   CALL get_in('ruissellement_pluie', ruissellement_pluie, 0)
     235   CALL get_in('alphak_stewart',      alphak_stewart,      1)
     236   CALL get_in('tdifexp_sol',         tdifexp_sol,      0.67)
     237   CALL get_in('calendrier_guide',    calendrier_guide,    0)
     238   CALL get_in('cste_surf_cond',      cste_surf_cond,      0)
     239   CALL get_in('mixlen',              mixlen,           35.0)
     240   CALL get_in('evap_cont_cste',      evap_cont_cste,      0)
     241   CALL get_in('deltaO18_evap_cont',  deltaO18_evap_cont,0.0)
     242   CALL get_in('d_evap_cont',         d_evap_cont,       0.0)
     243   CALL get_in('nudge_qsol',          nudge_qsol,          0)
     244   CALL get_in('region_nudge_qsol',   region_nudge_qsol,   1)
     245   nlevmaxO17 = 50
     246   CALL msg('nlevmaxO17='//TRIM(int2str(nlevmaxO17)))
     247   CALL get_in('no_pce',   no_pce,     0)
     248   CALL get_in('A_satlim', A_satlim, 1.0)
     249   CALL get_in('ok_restrict_A_satlim', ok_restrict_A_satlim, 0)
    349250#ifdef ISOVERIF
    350       !call iso_verif_positif(dsstlatcrit,'iso_init 110')
    351       if (sstlatcrit.lt.0.0) then
    352         write(*,*) 'iso_init 279: dsstlatcrit=',dsstlatcrit
    353         stop
    354       endif
    355 #endif             
    356   endif !if (modif_sst.ge.3) then
    357 endif !if (modif_sst.ge.2) then
    358 endif !  if (modif_sst.ge.1) then   
    359 call getin_p('modif_sic',modif_sic)
    360 if (modif_sic.ge.1) then
    361 call getin_p('deltasic',deltasic)
    362 endif !if (modif_sic.ge.1) then
    363 
    364 call getin_p('albedo_prescrit',albedo_prescrit)
    365 call getin_p('lon_min_albedo',lon_min_albedo)
    366 call getin_p('lon_max_albedo',lon_max_albedo)
    367 call getin_p('lat_min_albedo',lat_min_albedo)
    368 call getin_p('lat_max_albedo',lat_max_albedo)
    369 call getin_p('deltaO18_oce',deltaO18_oce)
    370 call getin_p('deltaP_BL',deltaP_BL)
    371 call getin_p('ruissellement_pluie',ruissellement_pluie)
    372 call getin_p('alphak_stewart',alphak_stewart)
    373 call getin_p('tdifexp_sol',tdifexp_sol)
    374 call getin_p('calendrier_guide',calendrier_guide)
    375 call getin_p('cste_surf_cond',cste_surf_cond)
    376 call getin_p('mixlen',mixlen)
    377 call getin_p('evap_cont_cste',evap_cont_cste)
    378 call getin_p('deltaO18_evap_cont',deltaO18_evap_cont)
    379 call getin_p('d_evap_cont',d_evap_cont) 
    380 call getin_p('nudge_qsol',nudge_qsol)
    381 call getin_p('region_nudge_qsol',region_nudge_qsol)
    382 call getin_p('no_pce',no_pce)
    383 call getin_p('A_satlim',A_satlim)
    384 call getin_p('ok_restrict_A_satlim',ok_restrict_A_satlim)
    385 #ifdef ISOVERIF     
    386 !call iso_verif_positif(1.0-A_satlim,'iso_init 158')
    387       if (A_satlim.gt.1.0) then
    388         write(*,*) 'iso_init 315: A_satlim=',A_satlim
    389         stop
    390       endif
    391 #endif         
    392 !      call getin_p('slope_limiterxy',slope_limiterxy)
    393 !      call getin_p('slope_limiterz',slope_limiterz)
    394 call getin_p('modif_ratqs',modif_ratqs)
    395 call getin_p('Pcrit_ratqs',Pcrit_ratqs)
    396 call getin_p('ratqsbasnew',ratqsbasnew)
    397 call getin_p('fac_modif_evaoce',fac_modif_evaoce)
    398 call getin_p('ok_bidouille_wake',ok_bidouille_wake)
    399 call getin_p('cond_temp_env',cond_temp_env)
    400 if (use_iso(iso_HTO_possible)) then
    401   ok_prod_nucl_tritium=.true.
    402   call getin_p('ok_prod_nucl_tritium',ok_prod_nucl_tritium)
    403 endif
    404 
    405 write(*,*) 'lambda,thumxt1=',lambda_sursat,thumxt1
    406 write(*,*) 'bidouille_anti_divergence=',bidouille_anti_divergence
    407 write(*,*) 'essai_convergence=',essai_convergence
    408 write(*,*) 'initialisation_iso=',initialisation_iso
    409 write(*,*) 'modif_sst=',modif_sst
    410 if (modif_sst.ge.1) then
    411 write(*,*) 'deltaTtest=',deltaTtest
    412 if (modif_sst.ge.2) then 
    413 write(*,*) 'deltaTtestpoles,sstlatcrit=', &
    414 &           deltaTtestpoles,sstlatcrit
    415 if (modif_sst.ge.3) then   
    416  write(*,*) 'dsstlatcrit=',dsstlatcrit
    417 endif !if (modif_sst.ge.3) then
    418 endif !if (modif_sst.ge.2) then
    419 endif !if (modif_sst.ge.1) then
    420 write(*,*) 'modif_sic=',modif_sic
    421 if (modif_sic.ge.1) then 
    422 write(*,*) 'deltasic=',deltasic
    423 endif !if (modif_sic.ge.1) then
    424 write(*,*) 'deltaO18_oce=',deltaO18_oce
    425 write(*,*) 'albedo_prescrit=',albedo_prescrit
    426 if (albedo_prescrit.eq.1) then
    427  write(*,*) 'lon_min_albedo,lon_max_albedo=', &
    428 &           lon_min_albedo,lon_max_albedo
    429  write(*,*) 'lat_min_albedo,lat_max_albedo=', &
    430 &           lat_min_albedo,lat_max_albedo
    431 endif !if (albedo_prescrit.eq.1) then
    432 write(*,*) 'deltaP_BL,ruissellement_pluie,alphak_stewart=', &
    433 &       deltaP_BL,ruissellement_pluie,alphak_stewart
    434 write(*,*) 'cste_surf_cond=',cste_surf_cond
    435 write(*,*) 'mixlen=',mixlen
    436 write(*,*) 'tdifexp_sol=',tdifexp_sol
    437 write(*,*) 'calendrier_guide=',calendrier_guide
    438 write(*,*) 'evap_cont_cste=',evap_cont_cste
    439 write(*,*) 'deltaO18_evap_cont,d_evap_cont=', &
    440 &           deltaO18_evap_cont,d_evap_cont
    441 write(*,*) 'nudge_qsol,region_nudge_qsol=', &
    442 &  nudge_qsol,region_nudge_qsol 
    443 write(*,*) 'nlevmaxO17=',nlevmaxO17
    444 write(*,*) 'no_pce=',no_pce
    445 write(*,*) 'A_satlim=',A_satlim
    446 write(*,*) 'ok_restrict_A_satlim=',ok_restrict_A_satlim
    447 !      write(*,*) 'slope_limiterxy=',slope_limiterxy
    448 !      write(*,*) 'slope_limiterz=',slope_limiterz
    449 write(*,*) 'modif_ratqs=',modif_ratqs
    450 write(*,*) 'Pcrit_ratqs=',Pcrit_ratqs
    451 write(*,*) 'ratqsbasnew=',ratqsbasnew
    452 write(*,*) 'fac_modif_evaoce=',fac_modif_evaoce
    453 write(*,*) 'ok_bidouille_wake=',ok_bidouille_wake
    454 write(*,*) 'cond_temp_env=',cond_temp_env
    455 write(*,*) 'ok_prod_nucl_tritium=',ok_prod_nucl_tritium
    456          
    457 
    458 !--------------------------------------------------------------
    459 ! Parameters that do not depend on the nature of water isotopes:
    460 !--------------------------------------------------------------
    461 
    462 ! -- temperature at which ice condensate starts to form (valeur ECHAM?):
    463 pxtmelt=273.15
    464 !      pxtmelt=273.15-10.0 ! test PHASE
    465 
    466 ! -- temperature at which all condensate is ice:
    467 pxtice=273.15-10.0
    468 !      pxtice=273.15-30.0 ! test PHASE
    469 
    470 ! -- minimum temperature to calculate fractionation coeff
    471 pxtmin=273.15-120.0 ! On ne calcule qu'au dessus de -120°C
    472 pxtmax=273.15+60.0 ! On ne calcule qu'au dessus de +60°C
    473 ! remarque: les coeffs ont été mesurés seulement jusq'à -40!
    474 
    475 ! -- a constant for alpha_eff for equilibrium below cloud base:
    476 tdifexp=0.58
    477 tv0cin=7.0
    478 
    479 ! facteurs lambda et mu dans Si=musi-lambda*T
    480 musi=1.0
    481 if (ok_nocinsat) then
    482 lambda_sursat = 0.0 ! no sursaturation effect
    483 endif           
    484 
    485 
    486 ! diffusion dans le sol
    487 Kd=2.5e-9 ! m2/s   
    488 
    489 ! cas où cste_surf_cond: on met rhs ou/et Ts cste pour voir
    490 rh_cste_surf_cond=0.6
    491 T_cste_surf_cond=288.0
    492 
    493 !--------------------------------------------------------------
    494 ! Parameters that depend on the nature of water isotopes:
    495 !--------------------------------------------------------------
    496 ! ** constantes locales
    497 fac_enrichoce18=0.0005
    498 ! on a alors tcor018=1+fac_enrichoce18
    499 ! tcorD=1+fac_enrichoce18*8
    500 ! tcorO17=1+fac_enrichoce18*0.528
    501 alpha_liq_sol_O18=1.00291 ! valeur de Lehmann & Siegenthaler, 1991,
    502   ! Journal of Glaciology, vol 37, p 23
    503 talph1_O18=1137.
    504 talph2_O18=-0.4156
    505 talph3_O18=-2.0667E-3
    506 talps1_O18=11.839
    507 talps2_O18=-0.028244
    508 tkcin0_O18 = 0.006
    509 tkcin1_O18 = 0.000285
    510 tkcin2_O18 = 0.00082
    511 tdifrel_O18= 1./0.9723
    512 
    513 ! rapport des ln(alphaeq) entre O18 et O17
    514 fac_coeff_eq17_liq=0.529 ! donné par Amaelle
    515 !      fac_coeff_eq17_ice=0.528 ! slope MWL
    516 fac_coeff_eq17_ice=0.529
    517 
    518 
    519 write(*,*) 'iso_O18,iso_HDO,iso_eau=',iso_O18,iso_HDO,iso_eau
    520 do 999 ixt = 1, niso
    521 write(*,*) 'iso_init 80: ixt=',ixt
    522 
    523 
    524 ! -- kinetic factor for surface evaporation:
    525 ! (cf: kcin = tkcin0                  if |V|<tv0cin
    526 !      kcin = tkcin1*|Vsurf| + tkcin2 if |V|>tv0cin )
    527 ! (Rq: formula discontinuous for |V|=tv0cin... )       
    528 
    529 ! -- main:
    530 if (ixt.eq.iso_HTO) then ! Tritium
    531   tkcin0(ixt) = 0.01056
    532   tkcin1(ixt) = 0.0005016
    533   tkcin2(ixt) = 0.0014432
    534   tnat(ixt)=0.
    535   !toce(ixt)=2.2222E-8 ! corrigé par Alex Cauquoin
    536   !toce(ixt)=1.0E-18 ! rapport 3H/1H ocean
    537   toce(ixt)=4.0E-19 ! rapport T/H = 0.2 TU Dreisigacker and Roether 1978
    538   tcorr(ixt)=1.
    539   tdifrel(ixt)=1./0.968
    540   talph1(ixt)=46480.
    541   talph2(ixt)=-103.87
    542   talph3(ixt)=0.
    543   talps1(ixt)=46480.
    544   talps2(ixt)=-103.87
    545   alpha_liq_sol(ixt)=1.
    546   Rdefault(ixt)=0.0
    547   Rmethox(ixt)=0.0
    548   striso(ixt)='HTO'
    549 endif     
    550 if (ixt.eq.iso_O17) then ! Deuterium
    551   pente_MWL=0.528
    552 !          tdifrel(ixt)=1./0.985452 ! donné par Amaelle
    553   tdifrel(ixt)=1./0.98555 ! valeur utilisée en 1D et dans modèle de LdG
    554 !          fac_kcin=0.5145 ! donné par Amaelle
    555   fac_kcin= (tdifrel(ixt)-1.0)/(tdifrel_O18-1.0)
    556   tkcin0(ixt) = tkcin0_O18*fac_kcin
    557   tkcin1(ixt) = tkcin1_O18*fac_kcin
    558   tkcin2(ixt) = tkcin2_O18*fac_kcin
    559   tnat(ixt)=0.004/100. ! O17 représente 0.004% de l'oxygène
    560   toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)**pente_MWL
    561   tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL ! donné par Amaelle           
    562   talph1(ixt)=talph1_O18
    563   talph2(ixt)=talph2_O18
    564   talph3(ixt)=talph3_O18
    565   talps1(ixt)=talps1_O18
    566   talps2(ixt)=talps2_O18     
    567   alpha_liq_sol(ixt)=(alpha_liq_sol_O18)**fac_coeff_eq17_liq
    568   if (Rdefault_smow) then   
    569         Rdefault(ixt)=tnat(ixt)*(-3.15/1000.0+1.0)
    570   else
    571         Rdefault(ixt)=0.0
    572   endif
    573   Rmethox(ixt)=(230./1000.+1.)*tnat(ixt) !Zahn et al 2006
    574   striso(ixt)='O17'
    575 endif
    576 
    577 if (ixt.eq.iso_O18) then ! Oxygene18
    578   tkcin0(ixt) = tkcin0_O18
    579   tkcin1(ixt) = tkcin1_O18
    580   tkcin2(ixt) = tkcin2_O18
    581   tnat(ixt)=2005.2E-6
    582   toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)
    583   tcorr(ixt)=1.0+fac_enrichoce18
    584   tdifrel(ixt)=tdifrel_O18
    585   talph1(ixt)=talph1_O18
    586   talph2(ixt)=talph2_O18
    587   talph3(ixt)=talph3_O18
    588   talps1(ixt)=talps1_O18
    589   talps2(ixt)=talps2_O18
    590   alpha_liq_sol(ixt)=alpha_liq_sol_O18   
    591   if (Rdefault_smow) then   
    592         Rdefault(ixt)=tnat(ixt)*(-6.0/1000.0+1.0)
    593   else
    594         Rdefault(ixt)=0.0
    595   endif
    596   Rmethox(ixt)=(130./1000.+1.)*tnat(ixt) !Zahn et al 2006   
    597 !       write(*,*) 'iso_init 163: ZXalpha_liq_sol=',ZXalpha_liq_sol
    598   striso(ixt)='O18'
    599   write(*,*) 'isotopes_mod 519: ixt,striso(ixt)=',ixt,striso(ixt)
    600 endif
    601 
    602 if (ixt.eq.iso_HDO) then ! Deuterium
    603   pente_MWL=8.0
    604 !          fac_kcin=0.88
    605   tdifrel(ixt)=1./0.9755
    606   fac_kcin= (tdifrel(ixt)-1)/(tdifrel_O18-1)
    607   tkcin0(ixt) = tkcin0_O18*fac_kcin
    608   tkcin1(ixt) = tkcin1_O18*fac_kcin
    609   tkcin2(ixt) = tkcin2_O18*fac_kcin
    610   tnat(ixt)=155.76E-6
    611   toce(ixt)=tnat(ixt)*(1.0+pente_MWL*deltaO18_oce/1000.0)
    612   tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL         
    613   talph1(ixt)=24844.
    614   talph2(ixt)=-76.248
    615   talph3(ixt)=52.612E-3
    616   talps1(ixt)=16288.
    617   talps2(ixt)=-0.0934
    618   !ZXalpha_liq_sol=1.0192 ! Weston, Ralph, 1955
    619   alpha_liq_sol(ixt)=1.0212
    620   ! valeur de Lehmann & Siegenthaler, 1991, Journal of
    621   ! Glaciology, vol 37, p 23
    622   if (Rdefault_smow) then   
    623     Rdefault(ixt)=tnat(ixt)*((-6.0*pente_MWL+10.0)/1000.0+1.0)
    624   else
    625     Rdefault(ixt)=0.0
    626   endif
    627   Rmethox(ixt)=tnat(ixt)*(-25.0/1000.+1.) ! Zahn et al 2006
    628   striso(ixt)='HDO'
    629   write(*,*) 'isotopes_mod 548: ixt,striso(ixt)=',ixt,striso(ixt)
    630 endif
    631 
    632 !       write(*,*) 'iso_init 163: ZXalpha_liq_sol=',ZXalpha_liq_sol
    633 if (ixt.eq.iso_eau) then ! Oxygene16
    634   tkcin0(ixt) = 0.0
    635   tkcin1(ixt) = 0.0
    636   tkcin2(ixt) = 0.0
    637   tnat(ixt)=1.
    638   toce(ixt)=tnat(ixt)
    639   tcorr(ixt)=1.0
    640   tdifrel(ixt)=1.
    641   talph1(ixt)=0.
    642   talph2(ixt)=0.
    643   talph3(ixt)=0.
    644   talps1(ixt)=0.
    645   talph3(ixt)=0.
    646   alpha_liq_sol(ixt)=1.
    647   if (Rdefault_smow) then
    648         Rdefault(ixt)=tnat(ixt)*1.0
    649   else
    650         Rdefault(ixt)=1.0
    651   endif
    652   Rmethox(ixt)=1.0
    653   striso(ixt)='eau'
    654 endif
    655 
    656 999   continue
    657 
    658 ! test de sensibilité:
    659 if (ok_nocinsfc) then ! no kinetic effect in sfc evaporation
    660  do ixt=1,niso
    661   tkcin0(ixt) = 0.0
    662   tkcin1(ixt) = 0.0
    663   tkcin2(ixt) = 0.0
    664  enddo
    665 endif
    666 
    667 ! nom des isotopes
    668 
    669 ! verif
    670 write(*,*) 'iso_init 285: verif initialisation:'
    671 
    672 do ixt=1,niso
    673   write(*,*) '* striso(',ixt,')=<'//striso(ixt)//'>'
    674   write(*,*) 'tnat(',ixt,')=',tnat(ixt)
    675 !          write(*,*) 'alpha_liq_sol(',ixt,')=',alpha_liq_sol(ixt)
    676 !          write(*,*) 'tkcin0(',ixt,')=',tkcin0(ixt)
    677 !          write(*,*) 'tdifrel(',ixt,')=',tdifrel(ixt)
    678 enddo
    679 write(*,*) 'iso_init 69: lambda=',lambda_sursat
    680 write(*,*) 'iso_init 69: thumxt1=',thumxt1
    681 write(*,*) 'iso_init 69: h_land_ice=',h_land_ice
    682 write(*,*) 'iso_init 69: P_veg=',P_veg   
    683 
    684     return
     251   CALL msg(' 315: A_satlim='//real2str(A_satlim), modname, A_satlim > 1.0)
     252   IF(A_satlim > 1.0) STOP
     253#endif
     254!  CALL get_in('slope_limiterxy',   slope_limiterxy,  2.0)
     255!  CALL get_in('slope_limiterz',    slope_limiterz,   2.0)
     256   CALL get_in('modif_ratqs',       modif_ratqs,        0)
     257   CALL get_in('Pcrit_ratqs',       Pcrit_ratqs,    500.0)
     258   CALL get_in('ratqsbasnew',       ratqsbasnew,     0.05)
     259   CALL get_in('fac_modif_evaoce',  fac_modif_evaoce, 1.0)
     260   CALL get_in('ok_bidouille_wake', ok_bidouille_wake,  0)
     261   ! si oui, la temperature de cond est celle de l'environnement, pour eviter
     262   ! bugs quand temperature dans ascendances convs est mal calculee
     263   CALL get_in('cond_temp_env',        cond_temp_env,        .FALSE.)
     264   IF(ANY(isoName == 'H[3]HO')) &
     265   CALL get_in('ok_prod_nucl_tritium', ok_prod_nucl_tritium, .FALSE., .FALSE.)
     266
     267   !--------------------------------------------------------------
     268   ! Parameters that do not depend on the nature of water isotopes:
     269   !--------------------------------------------------------------
     270   ! -- temperature at which ice condensate starts to form (valeur ECHAM?):
     271   pxtmelt = 273.15
     272
     273   ! -- temperature at which all condensate is ice:
     274   pxtice  = 273.15-10.0
     275
     276   !- -- test PHASE
     277!   pxtmelt = 273.15 - 10.0
     278!   pxtice  = 273.15 - 30.0
     279
     280   ! -- minimum temperature to calculate fractionation coeff
     281   pxtmin = 273.15 - 120.0   ! On ne calcule qu'au dessus de -120°C
     282   pxtmax = 273.15 +  60.0   ! On ne calcule qu'au dessus de +60°C
     283   !    Remarque: les coeffs ont ete mesures seulement jusq'à -40!
     284
     285   ! -- a constant for alpha_eff for equilibrium below cloud base:
     286   tdifexp = 0.58
     287   tv0cin  = 7.0
     288
     289   ! facteurs lambda et mu dans Si=musi-lambda*T
     290   musi=1.0
     291   if (ok_nocinsat) lambda_sursat = 0.0          ! no sursaturation effect
     292
     293   ! diffusion dans le sol
     294   Kd=2.5e-9 ! m2/s   
     295
     296   ! cas où cste_surf_cond: on met rhs ou/et Ts cste pour voir
     297   rh_cste_surf_cond = 0.6
     298    T_cste_surf_cond = 288.0
     299   
     300   !--------------------------------------------------------------
     301   ! Parameters that depend on the nature of water isotopes:
     302   !--------------------------------------------------------------
     303   ! Local constants
     304   fac_enrichoce18 = 0.0005            ! Then: tcorO18 = 1 + fac_enrichoce18
     305                                       !       tcorD   = 1 + fac_enrichoce18*8
     306                                       !       tcorO17 = 1 + fac_enrichoce18*0.528
     307   alpha_liq_sol_O18 = 1.00291         ! From Lehmann & Siegenthaler, 1991,
     308                                       ! Journal of Glaciology, vol 37, p 23
     309   talph1_O18 = 1137.  ; talph2_O18 = -0.4156   ; talph3_O18 = -2.0667E-3
     310   talps1_O18 = 11.839 ; talps2_O18 = -0.028244
     311   tkcin0_O18 = 0.006  ; tkcin1_O18 =  0.000285 ; tkcin2_O18 =  0.00082
     312   tdifrel_O18 = 1./0.9723
     313
     314   ! ln(alphaeq) ratio between O18 and O17
     315   fac_coeff_eq17_liq = 0.529          ! From Amaelle
     316  !fac_coeff_eq17_ice = 0.528          ! slope MWL
     317   fac_coeff_eq17_ice = 0.529
     318
     319   CALL msg('iso_O18, iso_HDO, iso_eau = '//TRIM(strStack(int2str([iso_O18, iso_HDO, iso_eau]))), modname)
     320
     321   !--- Kinetic factor for surface evaporation:
     322   ! (cf: kcin = tkcin0                  if |V|<tv0cin
     323   !      kcin = tkcin1*|Vsurf| + tkcin2 if |V|>tv0cin )
     324   ! (Rq: formula discontinuous for |V|=tv0cin... )       
     325
     326   DO ixt = 1, niso
     327      sxt=int2str(ixt)
     328      WRITE(*,*) 'iso_init 80: ixt=',ixt
     329
     330      Rdefault(ixt) = 0.0
     331      IF(ixt == iso_HTO) THEN          !=== H[3]HO
     332         tdifrel(ixt) = 1./0.968
     333         tkcin0(ixt) = 0.01056
     334         tkcin1(ixt) = 0.0005016
     335         tkcin2(ixt) = 0.0014432
     336         tnat  (ixt) = 0.
     337         toce  (ixt) = 4.0E-19         ! Ratio T/H = 0.2 TU, Dreisigacker and Roether 1978
     338        !toce  (ixt) = 2.2222E-8       ! Corrected by Alex Cauquoin
     339        !toce  (ixt) = 1.0E-18         ! Ratio 3H/1H ocean
     340         tcorr (ixt) = 1.
     341         talph1(ixt) = 46480. ; talph2(ixt) = -103.87 ; talph3(ixt) = 0.
     342         talps1(ixt) = 46480. ; talps2(ixt) = -103.87
     343         alpha_liq_sol(ixt) = 1.
     344         Rmethox(ixt) = 0.0
     345         striso (ixt) = 'HTO'
     346      ELSE IF(ixt == iso_O17) THEN     !=== H2[17]O
     347         tdifrel(ixt)=1./0.98555       ! Used in 1D and in LdG's model
     348        !tdifrel(ixt)=1./0.985452      ! From Amaelle
     349        !fac_kcin=0.5145               ! From Amaelle
     350         fac_kcin= (tdifrel(ixt)-1.0)/(tdifrel_O18-1.0)
     351         tkcin0(ixt) = tkcin0_O18*fac_kcin
     352         tkcin1(ixt) = tkcin1_O18*fac_kcin
     353         tkcin2(ixt) = tkcin2_O18*fac_kcin
     354         tnat  (ixt) = 0.004/100.      ! O17 = 0.004% of oxygen
     355         pente_MWL=0.528
     356         toce  (ixt) = tnat(ixt)*(1.0+deltaO18_oce/1000.0)**pente_MWL
     357         tcorr (ixt) = 1.0+fac_enrichoce18*pente_MWL  ! From Amaelle           
     358         talph1(ixt) = talph1_O18 ; talph2(ixt) = talph2_O18 ; talph3(ixt) = talph3_O18
     359         talps1(ixt) = talps1_O18 ; talps2(ixt) = talps2_O18     
     360         alpha_liq_sol(ixt) = (alpha_liq_sol_O18)**fac_coeff_eq17_liq
     361         IF(Rdefault_smow) Rdefault(ixt) = tnat(ixt)*(-3.15/1000.0+1.0)
     362         Rmethox(ixt) = (230./1000.+1.)*tnat(ixt)     ! Zahn et al 2006
     363         striso (ixt) = 'O17'
     364      ELSE IF(ixt == iso_O18) THEN     !=== H2[18]O
     365         tdifrel(ixt) = tdifrel_O18
     366         tkcin0(ixt) = tkcin0_O18
     367         tkcin1(ixt) = tkcin1_O18
     368         tkcin2(ixt) = tkcin2_O18
     369         tnat  (ixt) = 2005.2E-6
     370         toce  (ixt) = tnat(ixt)*(1.0+deltaO18_oce/1000.0)
     371         tcorr (ixt) = 1.0+fac_enrichoce18
     372         talph1(ixt) = talph1_O18 ; talph2(ixt) = talph2_O18 ; talph3(ixt) = talph3_O18
     373         talps1(ixt) = talps1_O18 ; talps2(ixt) = talps2_O18
     374         alpha_liq_sol(ixt) = alpha_liq_sol_O18   
     375         IF(Rdefault_smow) Rdefault(ixt) = tnat(ixt)*(-6.0/1000.0+1.0)
     376         Rmethox(ixt) = (130./1000.+1.)*tnat(ixt) ! Zahn et al 2006   
     377         striso (ixt) = 'O18'
     378         CALL msg('519: ixt, striso(ixt) = '//TRIM(sxt)//', '//TRIM(striso(ixt)), modname)
     379      ELSE IF(ixt == iso_HDO) THEN     !=== H[2]HO
     380         tdifrel(ixt) = 1./0.9755
     381        !fac_kcin=0.88
     382         fac_kcin= (tdifrel(ixt)-1.0)/(tdifrel_O18-1.0)
     383         tkcin0(ixt) = tkcin0_O18*fac_kcin
     384         tkcin1(ixt) = tkcin1_O18*fac_kcin
     385         tkcin2(ixt) = tkcin2_O18*fac_kcin
     386         tnat  (ixt) = 155.76E-6
     387         pente_MWL = 8.0
     388         toce  (ixt) = tnat(ixt)*(1.0+pente_MWL*deltaO18_oce/1000.0)
     389         tcorr (ixt) = 1.0+fac_enrichoce18*pente_MWL         
     390         talph1(ixt) = 24844. ; talph2(ixt) = -76.248 ; talph3(ixt) = 52.612E-3
     391         talps1(ixt) = 16288. ; talps2(ixt) = -0.0934
     392        !alpha_liq_sol(ixt)=1.0192 ZX  ! From Weston, Ralph, 1955
     393         alpha_liq_sol(ixt)=1.0212     ! From Lehmann & Siegenthaler, 1991,
     394                                       ! Journal of Glaciology, vol 37, p 23
     395         IF(Rdefault_smow) Rdefault(ixt) = tnat(ixt)*((-6.0*pente_MWL+10.0)/1000.0+1.0)
     396         Rmethox(ixt) = tnat(ixt)*(-25.0/1000.+1.) ! Zahn et al 2006
     397         striso (ixt) = 'HDO'
     398         CALL msg('548: ixt,striso(ixt) = '//TRIM(sxt)//', '//striso(ixt), modname)
     399      ELSE IF(ixt  == iso_eau) THEN    !=== H2O[16]
     400         tkcin0(ixt) = 0.0
     401         tkcin1(ixt) = 0.0
     402         tkcin2(ixt) = 0.0
     403         tnat  (ixt) = 1.
     404         toce  (ixt)=tnat(ixt)
     405         tcorr (ixt) = 1.0
     406         tdifrel(ixt) = 1.
     407         talph1(ixt) = 0. ; talph2(ixt) = 0. ; talph3(ixt) = 0.
     408         talps1(ixt) = 0. ; talph3(ixt) = 0.
     409         alpha_liq_sol(ixt)=1.
     410         IF(Rdefault_smow) Rdefault(ixt) = tnat(ixt)*1.0
     411         Rmethox(ixt) = 1.0
     412         striso(ixt) = 'eau'
     413      END IF
     414   END DO
     415
     416   !--- Sensitivity test: no kinetic effect in sfc evaporation
     417   IF(ok_nocinsfc) THEN
     418      tkcin0(1:niso) = 0.0
     419      tkcin1(1:niso) = 0.0
     420      tkcin2(1:niso) = 0.0
     421   END IF
     422
     423   CALL msg('285: verif initialisation:', modname)
     424   DO ixt=1,niso
     425      CALL msg(' * striso('//TRIM(sxt)//') = <'//TRIM(striso(ixt))//'>',   modname)
     426      CALL msg(  '   tnat('//TRIM(sxt)//') = '//TRIM(real2str(tnat(ixt))), modname)
     427!     CALL msg('   alpha_liq_sol('//TRIM(sxt)//') = '//TRIM(real2str(alpha_liq_sol(ixt))), modname)
     428!     CALL msg(       '   tkcin0('//TRIM(sxt)//') = '//TRIM(real2str(tkcin0(ixt))),        modname)
     429!     CALL msg(      '   tdifrel('//TRIM(sxt)//') = '//TRIM(real2str(tdifrel(ixt))),       modname)
     430   END DO
     431   CALL msg('69:     lambda = '//TRIM(real2str(lambda_sursat)), modname)
     432   CALL msg('69:    thumxt1 = '//TRIM(real2str(thumxt1)),       modname)
     433   CALL msg('69: h_land_ice = '//TRIM(real2str(h_land_ice)),    modname)
     434   CALL msg('69:      P_veg = '//TRIM(real2str(P_veg)),         modname)
     435
    685436END SUBROUTINE iso_init
    686437
     438
     439SUBROUTINE getinp_s(nam, val, def, lDisp)
     440   USE ioipsl_getincom, ONLY: getin
     441   USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     442   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     443   USE mod_phys_lmdz_transfert_para, ONLY : bcast
     444   CHARACTER(LEN=*),  INTENT(IN)    :: nam
     445   CHARACTER(LEN=*),  INTENT(INOUT) :: val
     446   CHARACTER(LEN=*),  INTENT(IN)    :: def
     447   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
     448   LOGICAL :: lD
     449!$OMP BARRIER
     450   IF(.NOT.(is_mpi_root.AND.is_omp_root)) RETURN
     451   val=def; CALL getin(nam,val); CALL bcast(val)
     452   lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
     453   IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(val))
     454END SUBROUTINE getinp_s
     455
     456SUBROUTINE getinp_i(nam, val, def, lDisp)
     457   USE ioipsl_getincom, ONLY: getin
     458   USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     459   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     460   USE mod_phys_lmdz_transfert_para, ONLY : bcast
     461   CHARACTER(LEN=*),  INTENT(IN)    :: nam
     462   INTEGER,           INTENT(INOUT) :: val
     463   INTEGER,           INTENT(IN)    :: def
     464   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
     465   LOGICAL :: lD
     466!$OMP BARRIER
     467   IF(.NOT.(is_mpi_root.AND.is_omp_root)) RETURN
     468   val=def; CALL getin(nam,val); CALL bcast(val)
     469   lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
     470   IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(int2str(val)))
     471END SUBROUTINE getinp_i
     472
     473SUBROUTINE getinp_r(nam, val, def, lDisp)
     474   USE ioipsl_getincom, ONLY: getin
     475   USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     476   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     477   USE mod_phys_lmdz_transfert_para, ONLY : bcast
     478   CHARACTER(LEN=*),  INTENT(IN)    :: nam
     479   REAL,              INTENT(INOUT) :: val
     480   REAL,              INTENT(IN)    :: def
     481   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
     482   LOGICAL :: lD
     483!$OMP BARRIER
     484   IF(.NOT.(is_mpi_root.AND.is_omp_root)) RETURN
     485   val=def; CALL getin(nam,val); CALL bcast(val)
     486   lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
     487   IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(real2str(val)))
     488END SUBROUTINE getinp_r
     489
     490SUBROUTINE getinp_l(nam, val, def, lDisp)
     491   USE ioipsl_getincom, ONLY: getin
     492   USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     493   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     494   USE mod_phys_lmdz_transfert_para, ONLY : bcast
     495   CHARACTER(LEN=*),  INTENT(IN)    :: nam
     496   LOGICAL,           INTENT(INOUT) :: val
     497   LOGICAL,           INTENT(IN)    :: def
     498   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
     499   LOGICAL :: lD
     500!$OMP BARRIER
     501   IF(.NOT.(is_mpi_root.AND.is_omp_root)) RETURN
     502   val=def; CALL getin(nam,val); CALL bcast(val)
     503   lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
     504   IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(bool2str(val)))
     505END SUBROUTINE getinp_l
    687506
    688507END MODULE isotopes_mod

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

    r4089 r4143  
    33
    44MODULE isotopes_routines_mod
     5  USE infotrac_phy, ONLY: niso, ntraciso=>ntiso, index_trac=>itZonIso, ntraceurs_zone=>nzone
    56IMPLICIT NONE
    67
    … …  
    1314&            zqs,zq_ancien,zqev_diag,zq)
    1415
    15 USE infotrac_phy, ONLY: ntraciso,niso, &
    16         ntraceurs_zone,index_trac
    1716USE isotopes_mod, ONLY: ridicule, ridicule_rain, thumxt1, no_pce,  &
    1817&       bidouille_anti_divergence, &
    … …  
    846845&    L, xtnu,Pveg)
    847846
    848 USE infotrac_phy, ONLY: niso
    849847USE isotopes_mod, ONLY: ridicule_qsol, ridicule, &
    850848&       ridicule_evap,P_veg,iso_HDO,iso_eau,iso_O17,iso_O18
    … …  
    13011299
    13021300subroutine calcul_kcin(Vsurf,KCIN)
    1303 USE infotrac_phy, ONLY: niso
    13041301USE isotopes_mod, ONLY: tv0cin,tkcin0,tkcin1,tkcin2
    13051302implicit none
    … …  
    13281325
    13291326     subroutine fractcalk(kt, ptin, pxtfra, pfraice)
    1330 !USE infotrac_phy, ONLY: use_iso
    13311327USE isotopes_mod, ONLY: talph1,talph2,talph3,pxtmin,iso_O17, &
    13321328&       fac_coeff_eq17_liq, pxtmelt, &
    … …  
    14571453      subroutine fractcalk_liq(kt, ptin, pxtfra)
    14581454
    1459 !      USE infotrac_phy, ONLY: use_iso
    14601455      USE isotopes_mod, ONLY: pxtmin,talph1,talph2,talph3, &
    14611456&       fac_coeff_eq17_liq, pxtice, &
    … …  
    15221517      subroutine fractcalk_glace(kt, ptin, pfraice)
    15231518
    1524 !      use infotrac_phy, ONLY: use_iso
    15251519      use isotopes_mod, ONLY: talps1,talps2, iso_O17,fac_coeff_eq17_ice, &
    15261520        & pxtmelt,musi, lambda_sursat, tdifrel, &
    … …  
    16311625      subroutine fractcalk_vectall(ptin, pxtfra, pfraice,n)
    16321626
    1633         USE infotrac_phy, ONLY: niso
    16341627        USE isotopes_mod, ONLY: talph1,talph2,talph3,tdifrel,pxtmin, &
    16351628&      iso_O17, iso_HTO, iso_eau, iso_O18, iso_HDO, musi, lambda_sursat, &
    … …  
    18031796      subroutine fractcalk_vectall_liq(ptin, pxtfra, n)
    18041797
    1805       USE infotrac_phy, ONLY: niso
    18061798      USE isotopes_mod, ONLY: pxtmin,talph1,talph2,talph3, &
    18071799&       iso_eau,iso_HDO, iso_O18, iso_O17,iso_HTO,fac_coeff_eq17_liq, &
    … …  
    18821874      subroutine fractcalk_vectall_ice(ptin, pfraice,n)
    18831875
    1884       use infotrac_phy, ONLY: niso
    18851876      use isotopes_mod, ONLY: talps1,talps2, fac_coeff_eq17_ice, &
    18861877        & pxtmelt,musi, lambda_sursat, tdifrel, &
    … …  
    20232014&            i,Rsol,klon)
    20242015
    2025   USE infotrac_phy, ONLY: niso,ntraciso
    20262016  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule, &
    20272017&        ridicule_qsol,iso_O17,iso_O18
    … …  
    22332223&          i,xtevap,klon) 
    22342224
    2235   USE infotrac_phy, ONLY: ntraciso,niso
    22362225  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule,ridicule_rain, &
    22372226        iso_O18,iso_O17
    … …  
    24442433&   )
    24452434
    2446   USE infotrac_phy, ONLY: ntraciso,niso
    24472435  USE isotopes_mod, ONLY: iso_eau, iso_HDO,expb_max,tdifrel,tdifexp, &
    24482436&       ridicule,thumxt1,ridicule_rain,bidouille_anti_divergence, &
    … …  
    45004488&           Tevap)
    45014489
    4502   USE infotrac_phy, ONLY: niso,ntraciso
    45034490  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
    45044491&       ridicule,ridicule_rain
    … …  
    46584645&           ,fac_ftmr)
    46594646
    4660   USE infotrac_phy, ONLY: niso,ntraciso
    46614647  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
    46624648&       Rdefault,ridicule,ridicule_rain
    … …  
    49044890     &           Pqiinf_cas,Pqiinf)
    49054891
    4906   USE infotrac_phy, ONLY: niso,ntraciso
    49074892  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    49084893
    … …  
    50665051     &           xtnew_cas,xtnew,Pxtiinf_cas,Pxtiinf)
    50675052
    5068   USE infotrac_phy, ONLY: niso
    50695053  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    50705054#ifdef ISOVERIF
    … …  
    51115095     &           ncum)
    51125096
    5113   USE infotrac_phy, ONLY: niso,ntraciso
    51145097  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    51155098
    … …  
    51765159     &    nloc,ncum,nd,i)
    51775160
    5178   USE infotrac_phy, ONLY: niso, ntraciso
    51795161  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    51805162
    … …  
    52525234     &    nloc,ncum,nd,i)
    52535235
    5254   USE infotrac_phy, ONLY: niso,ntraciso
    52555236  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    52565237
    … …  
    53265307     &    nloc,ncum,nd,i)
    53275308
    5328   USE infotrac_phy, ONLY: niso,ntraciso
    53295309  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    53305310
    … …  
    53965376     &    nloc,ncum,nd,i)
    53975377
    5398   USE infotrac_phy, ONLY: niso,ntraciso
    53995378  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule
    54005379
    … …  
    55665545     &    nloc,ncum,nd,i,frac_sublim)
    55675546
    5568   USE infotrac_phy, ONLY: niso,ntraciso
    55695547  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule
    55705548
    … …  
    57035681     &       zxtrfln_cas,zxt_cas,zxtrfl,zxtrfln,zxt,klon)
    57045682
    5705   USE infotrac_phy, ONLY: niso,ntraciso
    57065683  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    57075684
    … …  
    57395716     &       delP,paprs,k,klon,klev)
    57405717
    5741   USE infotrac_phy, ONLY: niso
    57425718  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    57435719         implicit none
    … …  
    57775753     &       delP,paprs,k,klon,klev)
    57785754
    5779   USE infotrac_phy, ONLY: niso,ntraciso
    57805755  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    57815756         implicit none
    … …  
    58285803     &       delP,paprs,k,klon,klev,frac_sublim)
    58295804
    5830   USE infotrac_phy, ONLY: niso,ntraciso
    58315805  USE isotopes_mod, ONLY: iso_eau, iso_HDO
    58325806#ifdef ISOVERIF
    … …  
    59055879     &          qp0,A,m0,beta,gama,g0) 
    59065880
    5907   USE infotrac_phy, ONLY: niso
    59085881  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ntot
    59095882#ifdef ISOVERIF
    … …  
    61006073 
    61016074
    6102   USE infotrac_phy, ONLY: ntraciso,niso,ntraceurs_zone, &
    6103 &       index_trac
    61046075  USE isotopes_mod, ONLY: iso_eau, iso_HDO,thumxt1, &
    61056076&       bidouille_anti_divergence,ridicule
    … …  
    76807651     &          )   
    76817652
    7682   USE infotrac_phy, ONLY: niso,ntraciso
    76837653  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
    76847654#ifdef ISOVERIF
    … …  
    80488018     &  )
    80498019
    8050   USE infotrac_phy, ONLY: niso,ntraciso
    80518020  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault,ridicule
    80528021#ifdef ISOVERIF
    … …  
    82538222     &          )
    82548223
    8255   USE infotrac_phy, ONLY: niso,ntraciso
    82568224  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault,ridicule
    82578225#ifdef ISOVERIF
    … …  
    83908358     &          ,xtp_cas,xtwater_cas,xtevap_cas)
    83918359
    8392   USE infotrac_phy, ONLY: niso,ntraciso
    83938360  USE isotopes_mod, ONLY: iso_eau, iso_HDO,no_pce, Rdefault,ridicule       
    83948361#ifdef ISOVERIF
    … …  
    89278894     &          ,xtp_cas,xtwater_cas,xtevap_cas)
    89288895
    8929   USE infotrac_phy, ONLY: niso,ntraciso
    89308896  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
    89318897#ifdef ISOVERIF
    … …  
    93179283 
    93189284
    9319   USE infotrac_phy, ONLY: niso,ntraciso, &
    9320 &       ntraceurs_zone,index_trac
    93219285  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
    93229286&       thumxt1, ridicule
    … …  
    1102210986     &          )
    1102310987
    11024   USE infotrac_phy, ONLY: niso,ntraciso
    1102510988  USE isotopes_mod, ONLY: iso_eau, iso_HDO,Rdefault,ridicule
    1102610989#ifdef ISOVERIF
    … …  
    1117211135     &          ,xtp_cas,xtwater_cas,xtevap_cas)
    1117311136
    11174   USE infotrac_phy, ONLY: niso,ntraciso
    1117511137  USE isotopes_mod, ONLY: iso_eau, iso_HDO,Rdefault,no_pce,ridicule
    1117611138#ifdef ISOVERIF
    … …  
    1177011732     &          ,xtp_cas,xtwater_cas,xtevap_cas)
    1177111733
    11772   USE infotrac_phy, ONLY: niso,ntraciso
    1177311734  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
    1177411735#ifdef ISOVERIF
    … …  
    1219812159     &          tcond,zfice,zxtice,zxtliq)
    1219912160
    12200     USE infotrac_phy, ONLY: ntraciso,niso
    1220112161    USE isotopes_mod, ONLY: iso_eau,iso_HDO,essai_convergence, &
    1220212162&       bidouille_anti_divergence,ridicule
    … …  
    1243212392     &          tcond,zfice,zxtice,zxtliq,n)
    1243312393
    12434     USE infotrac_phy, ONLY: ntraciso,niso
    1243512394    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,bidouille_anti_divergence, &
    1243612395&       ridicule
    … …  
    1289012849     &          tcond,zfice,zxtice,zxtliq)
    1289112850
    12892     USE infotrac_phy, ONLY: ntraciso
    1289312851    USE isotopes_mod, ONLY: iso_eau,iso_HDO,bidouille_anti_divergence, &
    1289412852&       ridicule,iso_O18
    … …  
    1308813046     &           xt1lay,q1lay,tsurf,t_coup,nisurf,Rland_ice)
    1308913047
    13090     USE infotrac_phy, ONLY: ntraciso,niso
    1309113048    USE isotopes_mod, ONLY: Rdefault,iso_eau,iso_HDO, &
    1309213049&       bidouille_anti_divergence, ridicule,ridicule_snow, &
    … …  
    1365813615     &   )
    1365913616
    13660     USE infotrac_phy, ONLY: ntraciso,niso
    1366113617    USE isotopes_mod, ONLY: iso_eau,iso_HDO,cste_surf_cond, &
    1366213618&       rh_cste_surf_cond,Rdefault,T_cste_surf_cond,iso_O17,iso_O18, &
    … …  
    1398213938     &   )
    1398313939
    13984     USE infotrac_phy, ONLY: ntraciso,niso
    1398513940    USE isotopes_mod, ONLY: tcorr, toce, alpha_liq_sol,ridicule_evap, &
    1398613941        iso_eau,iso_HDO
    … …  
    1423814193     &   )
    1423914194
    14240     USE infotrac_phy, ONLY: ntraciso,niso
    1424114195    USE isotopes_mod, ONLY: h_land_ice, ridicule,ridicule_snow,ridicule_evap, &
    1424214196        iso_eau,iso_HDO,iso_O18
    … …  
    1457314527     &   )
    1457414528
    14575 USE infotrac_phy, ONLY: niso,ntraciso
    1457614529USE isotopes_mod, ONLY: tdifrel,tdifexp_sol, iso_eau, iso_HDO, &
    1457714530&       bidouille_anti_divergence,ruissellement_pluie, Rdefault,Kd, &
    … …  
    1600115954      !USE write_field_phy
    1600215955      USE indice_sol_mod, only: nbsrf 
    16003   USE infotrac_phy, ONLY: ntraciso,niso
    1600415956  USE isotopes_mod, ONLY: initialisation_iso, iso_eau,iso_HDO, &
    1600515957        ridicule_qsol,tnat, P_veg,iso_O18,ridicule, ridicule_snow,iso_O17, &
    … …  
    1618716139      !USE write_field_phy
    1618816140      USE indice_sol_mod, only: nbsrf
    16189   USE infotrac_phy, ONLY: ntraciso,niso
    1619016141  USE isotopes_mod, ONLY: tnat,iso_HDO,iso_O18,iso_HTO, iso_eau,toce, &
    1619116142&       Rdefault,iso_O17,ridicule,ridicule_qsol
    … …  
    1657416525      !USE write_field_phy
    1657516526      USE indice_sol_mod, only: nbsrf 
    16576   USE infotrac_phy, ONLY: ntraciso,niso
    1657716527  USE isotopes_mod, ONLY: striso,iso_HDO,iso_eau
    1657816528#ifdef ISOVERIF
    … …  
    1684916799     &           d_xt_decroiss, &
    1685016800     &           xt_seri)
    16851         USE infotrac_phy, only: ntraciso
    1685216801        USE isotopes_mod, only: iso_HTO,ok_prod_nucl_tritium
    1685316802        USE dimphy, only: klon,klev
    … …  
    1837118320!     &                         prod_nucl_HTO)
    1837218321
    18373         USE infotrac_phy, only: ntraciso
    1837418322        use isotopes_mod, only: nessai, lat_nucl, lon_nucl, &
    1837518323&               zmin_nucl, zmax_nucl, HTO_nucl
    … …  
    1859318541     &                                paprs, &
    1859418542     &                                prod_nucl)
    18595         USE infotrac_phy, only: ntraciso
    1859618543        USE isotopes_mod, ONLY: iso_HTO
    1859718544        use geometry_mod, only: cell_area
    … …  
    1873918686     &           tcond,zfice,zxtice,zxtliq)
    1874018687
    18741     USE infotrac_phy, ONLY: ntraciso,niso,index_trac,ntraceurs_zone
    1874218688    USE isotopes_mod, ONLY: iso_eau,iso_HDO,essai_convergence, &
    1874318689&       bidouille_anti_divergence,ridicule
    … …  
    1886918815     &           tcond,zfice,zxtice,zxtliq,n)
    1887018816
    18871     USE infotrac_phy, ONLY: ntraciso,niso,index_trac,ntraceurs_zone
    1887218817    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,bidouille_anti_divergence, &
    1887318818&       ridicule

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

    r4050 r4143  
    55MODULE isotopes_verif_mod
    66!use isotopes_mod, ONLY:
    7 !#ifdef ISOTRAC
    8 !use isotrac_mod, ONLY:
    9 !#endif
     7#ifdef ISOTRAC
     8   USE isotrac_mod, ONLY: nzone
     9#endif
     10USE infotrac_phy, ONLY: ntraciso=>ntiso, niso, itZonIso
    1011implicit none
    1112save
    … …  
    9394        SUBROUTINE iso_verif_init()
    9495        use ioipsl_getin_p_mod, ONLY : getin_p
    95         !USE infotrac_phy, ONLY: use_iso
    9696        use isotopes_mod, ONLY: iso_O17, iso_O18, iso_HDO
    9797        implicit none
    … …  
    196196
    197197        subroutine iso_verif_aberrant(R,err_msg)
    198         !USE infotrac_phy, ONLY: use_iso
    199198        use isotopes_mod, ONLY: ridicule, iso_HDO
    200199        implicit none
    … …  
    227226
    228227        subroutine iso_verif_aberrant_encadre(R,err_msg)
    229         !use infotrac_phy, ONLY: use_iso
    230228        use isotopes_mod, ONLY: ridicule, iso_HDO
    231229        implicit none
    … …  
    263261
    264262        subroutine iso_verif_aberrant_choix(xt,q,qmin,deltaDmax,err_msg)
    265         !use infotrac_phy, ONLY: use_iso
    266263        use isotopes_mod, ONLY: iso_HDO
    267264        implicit none
    … …  
    298295
    299296        function iso_verif_aberrant_nostop(R,err_msg)
    300         !use infotrac_phy, ONLY: use_iso
    301297        use isotopes_mod, ONLY: ridicule,iso_HDO
    302298        implicit none
    … …  
    330326
    331327        function iso_verif_aberrant_enc_nostop(R,err_msg)
    332         !use infotrac_phy, ONLY: use_iso
    333328        use isotopes_mod, ONLY: ridicule,iso_HDO
    334329        implicit none
    … …  
    366361     &            qmin,deltaDmax,err_msg)
    367362
    368         !use infotrac_phy, ONLY: use_iso
    369363        use isotopes_mod, ONLY: iso_HDO
    370364        implicit none
    … …  
    428422        function iso_verif_aberrant_enc_choix_nostop(xt,q,   &
    429423     &            qmin,deltaDmax,err_msg)
    430         !use infotrac_phy, ONLY: use_iso
    431424        use isotopes_mod, ONLY: iso_HDO
    432425        implicit none
    … …  
    10651058        ! **********
    10661059        function deltaD(R)
    1067         !use infotrac_phy, ONLY: use_iso
    10681060        USE isotopes_mod, ONLY: tnat,iso_HDO
    10691061        implicit none
    … …  
    10821074        ! **********
    10831075        function deltaO(R)
    1084         !use infotrac_phy, ONLY: use_iso
    10851076        USE isotopes_mod, ONLY: tnat,iso_O18
    10861077        implicit none
    … …  
    10981089        ! **********
    10991090        function dexcess(RD,RO)
    1100         !use infotrac_phy, ONLY: use_iso
    11011091        USE isotopes_mod, ONLY: tnat,iso_O18,iso_HDO
    11021092        implicit none
    … …  
    11381128         ! **********
    11391129        function o17excess(R17,R18)
    1140         !use infotrac_phy, ONLY: use_iso
    11411130        USE isotopes_mod, ONLY: tnat,iso_O18,iso_O17
    11421131        implicit none
    … …  
    11601149     &           xt,q,err_msg,ni,n,m)
    11611150       
    1162         !use infotrac_phy, ONLY: use_iso
    11631151        USE isotopes_mod, ONLY: iso_eau
    11641152          implicit none
    … …  
    12121200     &           xt,q,err_msg,ni,n)
    12131201
    1214         !use infotrac_phy, ONLY: use_iso
    12151202        USE isotopes_mod, ONLY: iso_eau
    12161203        implicit none
    … …  
    12961283        subroutine iso_verif_aberrant_vect2D( &
    12971284     &           xt,q,err_msg,ni,n,m)
    1298         !use infotrac_phy, ONLY: use_iso
    12991285        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    13001286          implicit none
    … …  
    13451331     &           xt,q,err_msg,ni,n,m)
    13461332
    1347         !use infotrac_phy, ONLY: use_iso
    13481333        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    13491334          implicit none
    … …  
    13991384     &           xt,q,err_msg,ni,n,m)
    14001385
    1401         !use infotrac_phy, ONLY: use_iso
    14021386        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    14031387          implicit none
    … …  
    14501434     &           xt,q,err_msg,ni,n,m,deltaDmax)
    14511435
    1452         !use infotrac_phy, ONLY: use_iso
    14531436        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    14541437          implicit none
    … …  
    15011484     &           xt,q,err_msg,ni,n,m)
    15021485
    1503         !use infotrac_phy, ONLY: use_iso
    15041486        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO,iso_O18
    15051487          implicit none
    … …  
    17661748     &           xt,q,err_msg,ni,n,m,ib,ie)
    17671749
    1768         !use infotrac_phy, ONLY: use_iso
    17691750        use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
    17701751          implicit none
    … …  
    18171798     &           xt,q,err_msg,ni,n,m,ib,ie)
    18181799       
    1819         !use infotrac_phy, ONLY: use_iso
    18201800        USE isotopes_mod, ONLY: iso_eau
    18211801          implicit none
    … …  
    18631843      function iso_verif_traceur_choix_nostop(x,err_msg, &
    18641844     &       errmax,errmaxrel,ridicule_trac,deltalimtrac)
    1865         USE infotrac_phy, ONLY: ntraciso
    18661845        use isotopes_mod, ONLY: iso_HDO
    18671846        implicit none
    … …  
    19151894        function iso_verif_tracnps_choix_nostop(x,err_msg, &
    19161895     &       errmax,errmaxrel,ridicule_trac,deltalimtrac)
    1917         USE infotrac_phy, ONLY: ntraciso
    19181896        USE isotopes_mod, ONLY: iso_HDO
    19191897        implicit none
    … …  
    19611939
    19621940        function iso_verif_tracpos_choix_nostop(x,err_msg,seuil)
    1963         use infotrac_phy, ONLY: ntraciso,niso
    19641941        use isotrac_mod, only: index_iso,strtrac,index_zone
    19651942        use isotopes_mod, only: striso
    … …  
    19941971
    19951972        function iso_verif_traceur_noNaN_nostop(x,err_msg)
    1996         use infotrac_phy, ONLY: ntraciso,niso
    19971973        use isotrac_mod, only: index_iso
    19981974        use isotopes_mod, only: striso
    … …  
    20292005     &           errmaxin,errmaxrelin)
    20302006
    2031         use infotrac_phy, ONLY: index_trac,ntraciso,niso
    20322007        use isotopes_mod, ONLY: ridicule,striso
    2033         use isotrac_mod, only: ntraceurs_zone
    20342008        ! on vérifie juste bilan de masse
    20352009        implicit none
    … …  
    20532027
    20542028          xtractot=0.0
    2055           do izone=1,ntraceurs_zone 
    2056             ixt=index_trac(izone,iiso)
     2029          do izone=1,nzone 
     2030            ixt=itZonIso(izone,iiso)
    20572031            xtractot=xtractot+x(ixt)
    2058           enddo !do izone=1,ntraceurs_zone
     2032          enddo
    20592033
    20602034          if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
    … …  
    20822056     &           ridicule_trac,deltalimtrac)
    20832057
    2084         use infotrac_phy, ONLY: index_trac,ntraciso
    20852058        USE isotopes_mod, ONLY: iso_eau, iso_HDO
    2086         use isotrac_mod, only: strtrac,ntraceurs_zone
     2059        use isotrac_mod, only: strtrac
    20872060        ! on vérifie juste deltaD
    20882061        implicit none
    … …  
    21032076
    21042077        if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
    2105         do izone=1,ntraceurs_zone
    2106              ieau=index_trac(izone,iso_eau)
    2107              ixt=index_trac(izone,iso_HDO)
     2078        do izone=1,nzone
     2079             ieau=itZonIso(izone,iso_eau)
     2080             ixt=itZonIso(izone,iso_HDO)
    21082081
    21092082             if (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
    … …  
    21182091!     :           //strtrac(izone))
    21192092!             endif
    2120         enddo !do izone=1,ntraceurs_zone
     2093        enddo !do izone=1,nzone
    21212094       endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
    21222095
    … …  
    21242097
    21252098INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
    2126   USE infotrac_phy, ONLY: index_trac, ntraciso
    21272099  USE isotopes_mod, ONLY: iso_HDO, iso_eau, ridicule
    21282100  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
    … …  
    21352107  !--- Check whether * deltaD(highest tagging layer) < 200 permil
    21362108  !                  * q <
    2137   ieau=index_trac(nzone_temp,iso_eau)
    2138   ixt=index_trac(nzone_temp,iso_HDO)
     2109  ieau=itZonIso(nzone_temp,iso_eau)
     2110  ixt=itZonIso(nzone_temp,iso_HDO)
    21392111  IF(x(ieau)>ridicule) THEN
    21402112    IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
    … …  
    21472119  !--- Check whether q is small ; then, qt01 < 10%
    21482120  IF(x(iso_eau)<2.0e-3) THEN
    2149     ieau1= index_trac(1,iso_eau)
     2121    ieau1= itZonIso(1,iso_eau)
    21502122    IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
    21512123      res=1; write(*,*) 'x=',x
    … …  
    21562128SUBROUTINE iso_verif_trac17_q_deltaD(x,err_msg)
    21572129  USE isotrac_mod,  ONLY: nzone_temp, option_traceurs
    2158   USE infotrac_phy, ONLY: ntraciso
    21592130  IMPLICIT NONE
    21602131  REAL,             INTENT(IN) :: x(ntraciso)
    … …  
    21672138
    21682139      subroutine iso_verif_traceur(x,err_msg)
    2169         USE infotrac_phy, ONLY: ntraciso
    21702140        use isotrac_mod, only: ridicule_trac
    21712141        implicit none
    … …  
    21952165      subroutine iso_verif_traceur_retourne3D(x,n1,n2,n3, &
    21962166     &           i1,i2,i3,err_msg)
    2197         USE infotrac_phy, ONLY: ntraciso
    21982167        use isotrac_mod, only: ridicule_trac
    21992168
    … …  
    22282197        subroutine iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
    22292198     &           i1,i2,i3,i4,err_msg)
    2230         USE infotrac_phy, ONLY: ntraciso
    22312199        use isotrac_mod, only: ridicule_trac
    22322200
    … …  
    22622230      subroutine iso_verif_traceur_retourne2D(x,n1,n2, &
    22632231     &           i1,i2,err_msg)
    2264         USE infotrac_phy, ONLY: ntraciso
    22652232        use isotrac_mod, only: ridicule_trac
    22662233        implicit none
    … …  
    22932260
    22942261        subroutine iso_verif_traceur_vect(x,n,m,err_msg)
    2295         USE infotrac_phy, ONLY: ntraciso
    22962262        USE isotopes_mod, ONLY: iso_HDO
    22972263        implicit none
    … …  
    23292295
    23302296        subroutine iso_verif_tracnps_vect(x,n,m,err_msg)
    2331         USE infotrac_phy, ONLY: ntraciso
    23322297        USE isotopes_mod, ONLY: iso_HDO
    23332298        implicit none
    … …  
    23632328
    23642329        subroutine iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
    2365         USE infotrac_phy, ONLY: ntraciso,niso
    23662330        implicit none
    23672331       
    … …  
    24072371        subroutine iso_verif_trac_masse_vect(x,n,m,err_msg, &
    24082372     &            errmax,errmaxrel)
    2409         USE infotrac_phy, ONLY: index_trac,ntraciso,niso
    24102373        use isotopes_mod, only: striso
    2411         use isotrac_mod, only: ntraceurs_zone
    24122374        implicit none
    24132375       
    … …  
    24302392          xtractot(i,j)=0.0
    24312393          xiiso(i,j)=x(iiso,i,j)
    2432           do izone=1,ntraceurs_zone 
    2433             ixt=index_trac(izone,iiso)
     2394          do izone=1,nzone
     2395            ixt=itZonIso(izone,iiso)
    24342396            xtractot(i,j)=xtractot(i,j)+x(ixt,i,j)           
    2435           enddo !do izone=1,ntraceurs_zone
     2397          enddo !do izone=1,nzone
    24362398         enddo !do i=1,n
    24372399        enddo !do j=1,m
    … …  
    24472409
    24482410        subroutine iso_verif_tracdd_vect(x,n,m,err_msg)
    2449         use infotrac_phy, only: index_trac,ntraciso,niso
    24502411        use isotopes_mod, only: iso_HDO,iso_eau
    2451         use isotrac_mod, only: strtrac,ntraceurs_zone
     2412        use isotrac_mod, only: strtrac
    24522413        implicit none
    24532414       
    … …  
    24642425
    24652426       if (iso_HDO.gt.0) then
    2466         do izone=1,ntraceurs_zone
    2467           ieau=index_trac(izone,iso_eau)
     2427        do izone=1,nzone
     2428          ieau=itZonIso(izone,iso_eau)
    24682429          do iiso=1,niso
    2469            ixt=index_trac(izone,iiso)
     2430           ixt=itZonIso(izone,iiso)
    24702431           do j=1,m
    24712432            do i=1,n
    … …  
    24842445     &           xiiso,xeau,err_msg//strtrac(izone),niso,n,m, &
    24852446     &           deltalimtrac)
    2486          enddo !do izone=1,ntraceurs_zone
     2447         enddo !do izone=1,nzone
    24872448        endif !if (iso_HDO.gt.0) then
    24882449
    … …  
    24902451
    24912452        subroutine iso_verif_tracpos_vect(x,n,m,err_msg,seuil)
    2492         USE infotrac_phy, ONLY: ntraciso,niso
    24932453        implicit none
    24942454
    … …  
    25322492
    25332493        subroutine iso_verif_tracnps(x,err_msg)
    2534         USE infotrac_phy, ONLY: ntraciso
    25352494        use isotrac_mod, only: ridicule_trac
    25362495
    … …  
    25592518
    25602519        subroutine iso_verif_tracpos_choix(x,err_msg,seuil)
    2561         USE infotrac_phy, ONLY: ntraciso
    25622520        implicit none
    25632521        ! vérifier des choses sur les traceurs
    … …  
    25852543        subroutine iso_verif_traceur_choix(x,err_msg, &
    25862544     &       errmax,errmaxrel,ridicule_trac_loc,deltalimtrac)
    2587         USE infotrac_phy, ONLY: ntraciso
    25882545        implicit none
    25892546        ! vérifier des choses sur les traceurs
    … …  
    26082565
    26092566        function iso_verif_traceur_nostop(x,err_msg)
    2610         USE infotrac_phy, ONLY: ntraciso
    26112567        use isotrac_mod, only: ridicule_trac
    26122568        !use isotopes_verif, only: errmax,errmaxrel,deltalimtrac
    … …  
    26372593
    26382594      subroutine iso_verif_traceur_justmass(x,err_msg)
    2639         USE infotrac_phy, ONLY: ntraciso
    26402595        implicit none
    26412596        ! on vérifie que noNaN et masse
    … …  
    26662621
    26672622        function iso_verif_traceur_jm_nostop(x,err_msg)
    2668         USE infotrac_phy, ONLY: ntraciso
    26692623        implicit none
    26702624        ! on vérifie que noNaN et masse
    … …  
    26992653
    27002654        subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
    2701         USE infotrac_phy, ONLY: index_trac,ntraciso
    27022655        USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
    27032656        use isotrac_mod, only: option_traceurs,nzone_temp
    … …  
    27192672        ! verifier que deltaD du tag de la couche la plus haute <
    27202673        ! 200 permil, et vérifier que son q est inférieur à
    2721         ieau=index_trac(nzone_temp,iso_eau)
    2722         ixt=index_trac(nzone_temp,iso_HDO)
    2723         ieau1=index_trac(1,iso_eau)
     2674        ieau=itZonIso(nzone_temp,iso_eau)
     2675        ixt=itZonIso(nzone_temp,iso_HDO)
     2676        ieau1=itZonIso(1,iso_eau)
    27242677        do i=1,n
    27252678         do k=1,m
    … …  
    27592712
    27602713        subroutine iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
    2761         USE infotrac_phy, ONLY: index_trac,ntraciso
    27622714        USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
    27632715        use isotrac_mod, only: option_traceurs,nzone_temp
    … …  
    27792731        ! verifier que deltaD du tag de la couche la plus haute <
    27802732        ! 200 permil, et vérifier que son q est inférieur à
    2781         ieau=index_trac(nzone_temp,iso_eau)
    2782         ixt=index_trac(nzone_temp,iso_HDO)
    2783         ieau1=index_trac(1,iso_eau)
     2733        ieau=itZonIso(nzone_temp,iso_eau)
     2734        ixt=itZonIso(nzone_temp,iso_HDO)
     2735        ieau1=itZonIso(1,iso_eau)
    27842736        do iq=1,nq
    27852737        do i=1,n

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

    r3927 r4143  
    44
    55MODULE isotrac_mod
    6 use infotrac_phy, ONLY: niso,ntraciso,ntraceurs_zone
     6use infotrac_phy, ONLY: niso,ntiso,ntraceurs_zone=>nzone
    77use isotopes_mod, only: ridicule
    88
    … …  
    120120        ! ces variables sont initialisées dans traceurs_init
    121121       
    122 !integer ntraciso
    123 !parameter (ntraciso=(ntraceurs_zone+1)*niso)
    124 !integer ntracisoOR ! défini dans traceurs_init
    125122integer, ALLOCATABLE, DIMENSION(:), save :: index_iso
    126123!$OMP THREADPRIVATE(index_iso)
    127124integer, ALLOCATABLE, DIMENSION(:), save ::  index_zone
    128125!$OMP THREADPRIVATE(index_zone)
    129 integer, ALLOCATABLE, DIMENSION(:,:), save ::  index_trac_loc ! il y a déjà un index_trac dans infotrac: vérifier que c'est le même
    130 !$OMP THREADPRIVATE(index_trac_loc)
     126integer, ALLOCATABLE, DIMENSION(:,:), save ::  itZonIso_loc ! il y a déjà un itZonIso dans infotrac: vérifier que c'est le même
     127!$OMP THREADPRIVATE(itZonIso_loc)
    131128character*3, ALLOCATABLE, DIMENSION(:), save :: strtrac
    132129!$OMP THREADPRIVATE(strtrac)
    … …  
    211208
    212209      use IOIPSL ! getin
    213       USE infotrac_phy, ONLY: ntraciso,niso,ntraceurs_zone,index_trac
    214       USE isotopes_mod, ONLY: iso_eau,ntracisoOR,initialisation_iso, &
    215 &               iso_eau_possible
     210      USE infotrac_phy, ONLY: itZonIso
     211      USE isotopes_mod, ONLY: iso_eau,ntracisoOR,initialisation_iso
    216212      USE dimphy, only: klon,klev
    217213
    … …  
    244240
    245241        ! allouer
    246         allocate (index_iso(ntraciso))
    247         allocate (index_zone(ntraciso))
    248         allocate (index_trac_loc(ntraceurs_zone,niso))
     242        allocate (index_iso(ntiso))
     243        allocate (index_zone(ntiso))
     244        allocate (itZonIso_loc(ntraceurs_zone,niso))
    249245        allocate (strtrac(ntraceurs_zone))
    250246        allocate (bassin_map(klon))
    … …  
    779775
    780776          ! dans ce cas particulier, il y a des traceurs dans ORCHIDEE
    781           ntracisoOR=ntraciso
     777          ntracisoOR=ntiso
    782778
    783779        else if ((option_traceurs.eq.17).or. &
    … …  
    990986            index_zone(itrac)=izone
    991987            index_iso(itrac)=ixt
    992             index_trac_loc(izone,ixt)=itrac
    993             if (index_trac(izone,ixt).ne.index_trac_loc(izone,ixt)) then
     988            itZonIso_loc(izone,ixt)=itrac
     989            if (itZonIso(izone,ixt).ne.itZonIso_loc(izone,ixt)) then
    994990                write(*,*) 'isotrac 989: izone,ixt,itrac=',izone,ixt,itrac
    995991                CALL abort_physic ('isotrac','isotrac 989',1)
    … …  
    998994        enddo
    999995#ifdef ISOVERIF
    1000 !        call iso_verif_egalite(float(itrac),float(ntraciso), &
     996!        call iso_verif_egalite(float(itrac),float(ntiso), &
    1001997!     &           'traceurs_init 50')
    1002         if (itrac.ne.ntraciso) then
     998        if (itrac.ne.ntiso) then
    1003999          write(*,*) 'traceurs_init 50'
    10041000          stop
    … …  
    10061002     
    10071003        write(*,*) 'traceurs_init 65: bilan de l''init:'
    1008         write(*,*) 'index_zone=',index_zone(1:ntraciso)
    1009         write(*,*) 'index_iso=',index_iso(1:ntraciso)
    1010         write(*,*) 'index_trac=',index_trac(1:ntraceurs_zone,1:niso)
     1004        write(*,*) 'index_zone=',index_zone(1:ntiso)
     1005        write(*,*) 'index_iso=',index_iso(1:ntiso)
     1006        write(*,*) 'itZonIso=',itZonIso(1:ntraceurs_zone,1:niso)
    10111007        do izone=1,ntraceurs_zone
    10121008          write(*,*) 'strtrac(',izone,')=',strtrac(izone)

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

    r3927 r4143  
    88! isotopes_verif a besoin de isotopes et isotrac
    99! isotrac n'a besoin que de isotopes
     10    USE infotrac_phy, ONLY: ntraciso=>ntiso, niso, index_trac=>itZonIso, ntraceurs_zone=>nzone
    1011IMPLICIT NONE
    1112
    … …  
    1718     &           ncum,izone)
    1819
    19     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    2020    USE isotopes_mod, ONLY: ridicule,iso_eau
    2121
    … …  
    6363     &          xtp_avantevap_cas,liq,hdiag)
    6464
    65     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    6665    USE isotopes_mod, ONLY: ridicule,iso_eau,iso_HDO,ridicule_evap
    6766    USE isotrac_mod, only: option_revap,evap_franche,izone_revap, &
    … …  
    231230     &    nloc,ncum,nd,i,izone)
    232231
    233     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    234232    USE isotopes_mod, ONLY: iso_eau
    235233#ifdef ISOVERIF       
    … …  
    320318     &    nloc,ncum,nd,i,izone)
    321319
    322     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    323320    USE isotopes_mod, ONLY: iso_eau
    324321#ifdef ISOVERIF
    … …  
    408405     &    nloc,ncum,nd,i,izone)
    409406
    410     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    411407    USE isotopes_mod, ONLY: ridicule,iso_eau
    412408#ifdef ISOVERIF
    … …  
    476472     &    nloc,ncum,nd,izone)
    477473
    478     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    479474    USE isotopes_mod, ONLY: ridicule,iso_eau
    480475#ifdef ISOVERIF
    … …  
    643638     &    nloc,ncum,nd,i,frac_sublim,izone)
    644639
    645     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    646640    USE isotopes_mod, ONLY: ridicule,iso_eau
    647641#ifdef ISOVERIF
    … …  
    802796     &       xtrevap_tag,liq,hdiag)
    803797
    804     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    805798    USE isotopes_mod, ONLY: ridicule,iso_eau
    806799    USE isotrac_mod, only: option_revap,evap_franche
    … …  
    899892     &       klon,izone,ptrac)
    900893
    901     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    902894    USE isotopes_mod, ONLY: ridicule,iso_eau
    903895#ifdef ISOVERIF
    … …  
    986978     &       klon,izone)
    987979
    988     USE infotrac_phy, ONLY: ntraciso,niso,index_trac
    989980    USE isotopes_mod, ONLY: ridicule,iso_eau
    990981#ifdef ISOVERIF
    … …  
    10521043     &    klon,izone,zxt,xtrevap_tag)
    10531044
    1054 USE infotrac_phy, ONLY: ntraciso,niso, &
    1055         ntraceurs_zone,index_trac
    10561045#ifdef ISOVERIF
    10571046USE isotopes_verif_mod
    … …  
    13421331
    13431332      subroutine find_bassin(lat,lon,bassin)
    1344       use isotrac_mod, only: izone_poubelle,ntraceurs_zone,option_traceurs, &
     1333      use isotrac_mod, only: izone_poubelle,ntraceurs_zone=>ntiso,option_traceurs, &
    13451334&        bassin_map
    13461335#ifdef ISOVERIF
    … …  
    15171506        subroutine isotrac_recolorise_tmin(xt,t)
    15181507        USE dimphy, only: klon, klev
    1519         USE infotrac_phy, ONLY: ntraciso,niso, &
    1520         ntraceurs_zone,index_trac
    15211508        USE isotrac_mod, only: zone_temp,nzone_temp
    15221509#ifdef ISOVERIF
    … …  
    16031590        subroutine isotrac_recolorise_tmin_sfrev(xt,t)
    16041591        USE dimphy, only: klon,klev
    1605         USE infotrac_phy, ONLY: ntraciso,niso, &
    1606         ntraceurs_zone,index_trac
    16071592        USE isotrac_mod, only: nzone_temp,zone_temp
    16081593#ifdef ISOVERIF
    … …  
    16611646        subroutine isotrac_recolorise_saturation(xt,rh,lat,pres)
    16621647        USE dimphy, only: klon,klev
    1663         USE infotrac_phy, ONLY: ntraciso,niso, &
    1664         ntraceurs_zone,index_trac
    16651648#ifdef ISOVERIF
    16661649        USE isotopes_verif_mod
    … …  
    17271710        subroutine isotrac_recolorise_boite(xt,boite_map)
    17281711        USE dimphy, only: klon,klev
    1729         USE infotrac_phy, ONLY: ntraciso,niso, &
    1730         ntraceurs_zone,index_trac
    17311712#ifdef ISOVERIF
    17321713        USE isotopes_verif_mod
    … …  
    17811762        subroutine isotrac_recolorise_extra(xt,rlat)
    17821763        USE dimphy, only: klon,klev
    1783         USE infotrac_phy, ONLY: ntraciso,niso, &
    1784         ntraceurs_zone,index_trac
    17851764        usE isotrac_mod, only: lim_tag20,izone_trop,izone_extra
    17861765#ifdef ISOVERIF
    … …  
    18301809        subroutine isotrac_recolorise_conv(xt,rlat,presnivs,rain_con)
    18311810        USE dimphy, only: klon,klev
    1832         USE infotrac_phy, ONLY: ntraciso,niso, &
    1833         ntraceurs_zone,index_trac
    18341811        use isotrac_mod, only: lim_precip_tag22, &
    18351812&       izone_conv_BT,izone_conv_UT
    … …  
    19021879        subroutine boite_AMMA_init(lat,lon,presnivs,boite_map)
    19031880        USE dimphy, only: klon,klev
    1904         USE infotrac_phy, ONLY: ntraciso,niso, &
    1905         ntraceurs_zone,index_trac
    19061881#ifdef ISOVERIF
    19071882        USE isotopes_verif_mod
    … …  
    19571932        subroutine boite_UT_extra_init(lat,lon,presnivs,boite_map)
    19581933        USE dimphy, only: klon,klev
    1959         USE infotrac_phy, ONLY: ntraciso,niso, &
    1960         ntraceurs_zone,index_trac
    19611934        use isotrac_mod, only: izone_extra,izone_trop
    19621935#ifdef ISOVERIF
    … …  
    20952068     &           seuil_in)
    20962069        USE dimphy, only: klon,klev
    2097         USE infotrac_phy, ONLY: ntraciso,niso, &
    2098         ntraceurs_zone,index_trac
    20992070        USE isotopes_mod, only: bidouille_anti_divergence,iso_eau
    21002071        use isotrac_mod, only: option_seuil_tag_tmin,izone_cond, &
    … …  
    23042275        subroutine bassin_map_init_opt20(lat,bassin_map)
    23052276        USE dimphy, only: klon
    2306         USE infotrac_phy, ONLY: ntraciso,niso, &
    2307         ntraceurs_zone,index_trac
    23082277        use isotrac_mod, only: izone_cont,izone_trop,lim_tag20
    23092278#ifdef ISOVERIF
    … …  
    23342303        USE geometry_mod, ONLY : latitude_deg
    23352304        USE dimphy, only: klon,klev
    2336         use infotrac_phy, only: ntraciso
    23372305        use isotrac_mod, only: option_traceurs,boite_map
    23382306        implicit none
    … …  
    23652333        subroutine iso_verif_traceur_jbid_vect(x,n,m)
    23662334        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2367         USE infotrac_phy, ONLY: index_trac,niso,ntraciso
    2368         use isotrac_mod, only: ntraceurs_zone
     2335        use isotrac_mod, only: ntraceurs_zone=>nzone
    23692336        implicit none
    23702337       
    … …  
    24302397        subroutine iso_verif_traceur_jbidouille(x)
    24312398        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2432         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    24332399        implicit none
    24342400       
    … …  
    24702436        subroutine iso_verif_traceur_jbid_pos(x)
    24712437        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2472         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    24732438!#ifdef ISOVERIF
    24742439!        use isotopes_verif_mod, only: iso_verif_traceur_pbidouille
    … …  
    25442509        subroutine iso_verif_traceur_jbid_pos_vect(n,m,x)
    25452510        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2546         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    25472511#ifdef ISOVERIF
    25482512        USE isotopes_verif_mod
    … …  
    26252589        subroutine iso_verif_traceur_jbid_pos2(x,q)
    26262590        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2627         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    26282591#ifdef ISOVERIF
    26292592        use isotopes_verif_mod
    … …  
    26962659        subroutine iso_verif_traceur_jbid_vect1D(x,n)
    26972660        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
    2698         USE infotrac_phy, ONLY: index_trac,niso,ntraciso,ntraceurs_zone
    26992661        implicit none
    27002662       
    … …  
    27392701
    27402702        subroutine iso_verif_traceur_pbidouille(x,err_msg)
    2741         USE infotrac_phy, ONLY: ntraciso
    27422703        use isotopes_verif_mod
    27432704        implicit none
    … …  
    27652726
    27662727        function iso_verif_traceur_pbid_ns(x,err_msg)
    2767         USE infotrac_phy, ONLY: ntraciso
    27682728        use isotopes_mod, ONLY: iso_HDO,bidouille_anti_divergence
    27692729        use isotrac_mod, only: ridicule_trac
    … …  
    28282788
    28292789        subroutine iso_verif_traceur_pbid_vect(x,n,m,err_msg)
    2830         USE infotrac_phy, ONLY: ntraciso
    28312790        use isotopes_mod, ONLY: iso_HDO,bidouille_anti_divergence
    28322791        use isotopes_verif_mod

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

    r3927 r4143  
    281281    USE indice_sol_mod
    282282#ifdef ISO
    283     !USE infotrac_phy, ONLY: use_iso
    284283    USE isotopes_mod, ONLY : iso_HTO,ok_prod_nucl_tritium
    285284#ifdef ISOVERIF

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

    r4033 r4143  
    4242    use config_ocean_skin_m, only: activate_ocean_skin
    4343#ifdef ISO
    44   USE infotrac_phy, ONLY: ntraciso,niso
     44  USE infotrac_phy, ONLY: ntiso,niso
    4545    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, &
    4646&       calcul_iso_surf_sic_vectall   
    … …  
    7373
    7474#ifdef ISO
    75     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
    76     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtspechum
     75    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow
     76    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtspechum
    7777    real, dimension(klon), intent(IN) :: rlat
    7878#endif
    … …  
    9898
    9999#ifdef ISO     
    100     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)    :: xtevap ! isotopes in evaporation flux
     100    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap ! isotopes in evaporation flux
    101101    REAL, DIMENSION(klon), INTENT(out)    :: h1 ! just a diagnostic, not useful for the simulation
    102102#endif
    … …  
    271271    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
    272272#ifdef ISO
    273   USE infotrac_phy, ONLY: niso,ntraciso
     273  USE infotrac_phy, ONLY: niso, ntiso
    274274    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, &
    275275&       calcul_iso_surf_sic_vectall
    … …  
    303303    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
    304304#ifdef ISO
    305     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
    306     REAL, DIMENSION(ntraciso,klon), INTENT(IN)    :: xtspechum
    307     REAL, DIMENSION(niso,klon), INTENT(IN)    :: Roce
    308     REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
     305    REAL, DIMENSION(ntiso,klon), INTENT(IN)    :: xtprecip_rain, xtprecip_snow
     306    REAL, DIMENSION(ntiso,klon), INTENT(IN)    :: xtspechum
     307    REAL, DIMENSION(niso,klon),  INTENT(IN)    :: Roce
     308    REAL, DIMENSION(niso,klon),  INTENT(IN)    :: Rland_ice
    309309#endif
    310310
    … …  
    330330    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
    331331#ifdef ISO     
    332     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)    :: xtevap
     332    REAL, DIMENSION(ntiso,klon), INTENT(OUT)    :: xtevap
    333333#endif     
    334334

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

    r4036 r4143  
    3131                                  wx_pbl_check, wx_pbl_dts_check, wx_evappot
    3232  use config_ocean_skin_m, only: activate_ocean_skin
     33#ifdef ISO
     34  USE infotrac_phy, ONLY: niso,ntraciso=>ntiso   
     35#endif
    3336
    3437  IMPLICIT NONE
    … …  
    193196    USE indice_sol_mod
    194197    USE print_control_mod, ONLY: lunout
    195   USE infotrac_phy, ONLY: niso,ntraciso ! ajout C Risi pour isos 
    196198#ifdef ISOVERIF
    197199    USE isotopes_mod, ONLY: iso_eau,ridicule
    … …  
    395397    USE print_control_mod,  ONLY : prt_level,lunout
    396398#ifdef ISO
    397   USE infotrac_phy, ONLY: ntraciso,niso ! ajout C Risi pour isos   
    398399  USE isotopes_mod, ONLY: Rdefault,iso_eau
    399400#ifdef ISOVERIF
    … …  
    40514052    USE indice_sol_mod
    40524053#ifdef ISO
    4053   USE infotrac_phy, ONLY: ntraciso,niso ! ajout C Risi pour isos 
    40544054#ifdef ISOVERIF
    40554055    USE isotopes_mod, ONLY: iso_eau,ridicule
    … …  
    41304130    use phys_state_var_mod, only: delta_sal, ds_ns, dt_ns, delta_sst
    41314131    use config_ocean_skin_m, only: activate_ocean_skin
    4132 #ifdef ISO
    4133   USE infotrac_phy, ONLY: ntraciso   
    4134 #endif
    41354132
    41364133

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

    r4089 r4143  
    3939  USE iostart, ONLY: open_restartphy, close_restartphy, enddef_restartphy, put_field, put_var
    4040  USE traclmdz_mod, ONLY : traclmdz_to_restart
    41   USE infotrac_phy, ONLY: type_trac, nqtot, tracers, nbtr, niso, ntraciso
     41  USE infotrac_phy, ONLY: type_trac, nqtot, tracers, nbtr, niso
    4242#ifdef ISO
    4343#ifdef ISOVERIF
    … …  
    485485        xtrain_fall,xtsnow_fall, ql_ancien,xtl_ancien,qs_ancien,xts_ancien, &
    486486        xtsol,fxtevap
    487       USE infotrac_phy,ONLY: niso, ntraciso
     487      USE infotrac_phy,ONLY: niso, ntiso
    488488      !USE control_mod
    489489      USE indice_sol_mod, ONLY: nbsrf
    … …  
    509509      !REAL xtsol(niso,klon)
    510510      REAL xtsnow(niso,klon,nbsrf)
    511       !REAL xtevap(ntraciso,klon,nbsrf)     
     511      !REAL xtevap(ntiso,klon,nbsrf)     
    512512      REAL xtrun_off_lic_0(niso,klon)
    513513      REAL Rland_ice(niso,klon)
    … …  
    566566#endif
    567567
    568    do ixt=1,ntraciso
     568   do ixt=1,ntiso
    569569
    570570     if (ixt.le.niso) then
    … …  
    576576        outiso=striso(iiso)//strtrac(izone)
    577577#else
    578         write(*,*) 'phyredem 546: ixt,ntraciso=', ixt,ntraciso
     578        write(*,*) 'phyredem 546: ixt,ntiso=', ixt,ntiso
    579579        stop
    580580#endif

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

    r4118 r4143  
    726726USE infotrac_phy, ONLY : nbtr
    727727#ifdef ISO
    728 USE infotrac_phy, ONLY : ntraciso,niso
     728USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
    729729#endif
    730730USE aero_mod

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

    r4120 r4143  
    3535    USE iophy
    3636    USE dimphy
    37     USE infotrac_phy, ONLY: nqtot, tracers, type_trac, niso, ntraciso
     37    USE infotrac_phy, ONLY: nqtot, tracers, type_trac, niso, ntraciso=>ntiso
    3838    USE strings_mod,  ONLY: maxlen
    3939    USE ioipsl

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

    r4124 r4143  
    3939    USE ioipsl_getin_p_mod, ONLY : getin_p
    4040    USE indice_sol_mod
    41     USE infotrac, ONLY: iso_num, iso_indnum
    42     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, nqCO2, indnum_fn_num
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, nqCO2
    4342    USE readTracFiles_mod, ONLY: addPhase
    4443    USE strings_mod,  ONLY: strIdx, strStack, int2str
    … …  
    126125
    127126#ifdef ISO
    128     USE infotrac_phy, ONLY: iqiso,niso, ntraciso, nzone
     127    USE infotrac_phy, ONLY: iqIsoPha,niso, ntraciso=>ntiso, nzone
    129128    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO, &
    130129        & bidouille_anti_divergence,ok_bidouille_wake, &
    … …  
    509508    !======================================================================
    510509    !
    511     INTEGER ivap          ! indice de traceurs pour vapeur d'eau
    512     PARAMETER (ivap=1)
    513     INTEGER iliq          ! indice de traceurs pour eau liquide
    514     PARAMETER (iliq=2)
    515     !CR: on ajoute la phase glace
    516     INTEGER isol          ! indice de traceurs pour eau glace
    517     PARAMETER (isol=3)
    518     INTEGER irneb         ! indice de traceurs pour fraction nuageuse LS (optional)
    519     PARAMETER (irneb=4)   
     510    ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional)
     511    INTEGER,SAVE :: ivap, iliq, isol, irneb
     512!$OMP THREADPRIVATE(ivap, iliq, isol, irneb)
    520513    !
    521514    !
    … …  
    13541347
    13551348    IF (first) THEN
     1349       ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
     1350       iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
     1351       isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
     1352       irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))
    13561353       CALL init_etat0_limit_unstruct
    13571354       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
    … …  
    24122409    do ixt=1,ntraciso
    24132410#ifdef ISOVERIF
    2414       write(*,*) 'physiq tmp 1762a: ixt,iqiso_vap=',ixt,iqiso(ixt,ivap)
    2415       write(*,*) 'physiq tmp 1762b: ixt,iqiso_liq=',ixt,iqiso(ixt,iliq)
     2411      write(*,*) 'physiq tmp 1762a: ixt,iqiso_vap=',ixt,iqIsoPha(ixt,ivap)
     2412      write(*,*) 'physiq tmp 1762b: ixt,iqiso_liq=',ixt,iqIsoPha(ixt,iliq)
    24162413      if (nqo.eq.3) then 
    2417         write(*,*) 'physiq tmp 1762c: ixt,iqiso_liq=',ixt,iqiso(ixt,iliq)
     2414        write(*,*) 'physiq tmp 1762c: ixt,iqiso_liq=',ixt,iqIsoPha(ixt,iliq)
    24182415      endif !if (nqo.eq.3) then
    24192416#endif
    2420       if (ixt.gt.niso) write(*,*) 'izone=',tracers(iqiso(ixt,ivap))%iso_iZone
     2417      if (ixt.gt.niso) write(*,*) 'izone=',tracers(iqIsoPha(ixt,ivap))%iso_iZone
    24212418      DO k = 1, klev
    24222419       DO i = 1, klon
    2423           xt_seri(ixt,i,k)  = qx(i,k,iqiso(ixt,ivap))
    2424           xtl_seri(ixt,i,k) = qx(i,k,iqiso(ixt,iliq))
     2420          xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
     2421          xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
    24252422          if (nqo.eq.2) then
    24262423             xts_seri(ixt,i,k) = 0.
    24272424          else if (nqo.eq.3) then
    2428              xts_seri(ixt,i,k) = qx(i,k,iqiso(ixt,isol))
     2425             xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol))
    24292426          endif
    24302427       enddo !DO i = 1, klon
    … …  
    30323029      ! verif iso_eau
    30333030      !write(*,*) 'physiq tmp 2748: iso_eau=',iso_eau
    3034       !write(*,*) 'use_iso=',use_iso
    30353031      !write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
    30363032      !write(*,*) 'd_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)=',d_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)
    … …  
    64966492      DO k = 1, klev
    64976493       DO i = 1, klon
    6498           iq=iqiso(ixt,ivap)
     6494          iq=iqIsoPha(ixt,ivap)
    64996495          d_qx(i,k,iq) = ( xt_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
    6500           iq=iqiso(ixt,iliq)
     6496          iq=iqIsoPha(ixt,iliq)
    65016497          d_qx(i,k,iq) = ( xtl_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
    65026498          if (nqo.eq.3) then
    6503              iq=iqiso(ixt,isol)
     6499             iq=iqIsoPha(ixt,isol)
    65046500             d_qx(i,k,iq) = ( xts_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
    65056501          endif

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

    r3927 r4143  
    99    USE add_phys_tend_mod, only : fl_cor_ebil
    1010#ifdef ISO
    11     USE infotrac_phy, ONLY: ntraciso   
     11    USE infotrac_phy, ONLY: ntiso   
    1212#ifdef ISOVERIF
    1313    USE isotopes_verif_mod
    … …  
    3030
    3131#ifdef ISO
    32     REAL, DIMENSION(ntraciso,klon,klev), INTENT(in) :: xt_seri,xtl_seri,xts_seri
    33     REAL, DIMENSION(ntraciso,klon,klev), INTENT(out) :: d_xt_eva,d_xtl_eva,d_xts_eva
     32    REAL, DIMENSION(ntiso,klon,klev), INTENT(in) :: xt_seri,xtl_seri,xts_seri
     33    REAL, DIMENSION(ntiso,klon,klev), INTENT(out) :: d_xt_eva,d_xtl_eva,d_xts_eva
    3434    integer ixt
    3535#endif
    … …  
    7676
    7777#ifdef ISO
    78          do ixt=1,ntraciso
     78         do ixt=1,ntiso
    7979            zb = MAX(0.0,xtl_seri(ixt,i,k))
    8080            d_xt_eva(ixt,i,k) = zb
    8181            d_xtl_eva(ixt,i,k) = -xtl_seri(ixt,i,k)
    8282            d_xts_eva(ixt,i,k) = 0.
    83          enddo ! do ixt=1,ntraciso
     83         enddo
    8484#ifdef ISOVERIF
    85       do ixt=1,ntraciso
     85      do ixt=1,ntiso
    8686        call iso_verif_noNaN(xt_seri(ixt,i,k), &
    8787     &     'physiq 2417: apres evap tot')
    … …  
    136136
    137137#ifdef ISO
    138          do ixt=1,ntraciso
     138         do ixt=1,ntiso
    139139            zb = MAX(0.0,xtl_seri(ixt,i,k)+xts_seri(ixt,i,k))
    140140            d_xt_eva(ixt,i,k) = zb
    141141            d_xtl_eva(ixt,i,k) = -xtl_seri(ixt,i,k)
    142142            d_xts_eva(ixt,i,k) = -xts_seri(ixt,i,k)
    143          enddo ! do ixt=1,ntraciso
     143         enddo
    144144
    145145#ifdef ISOVERIF
    146       do ixt=1,ntraciso
     146      do ixt=1,ntiso
    147147      call iso_verif_noNaN(xt_seri(ixt,i,k), &
    148148     &     'physiq 2417: apres evap tot')

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

    r4033 r4143  
    3535    USE indice_sol_mod
    3636#ifdef ISO
    37     use infotrac_phy, ONLY: ntraciso,niso
     37    use infotrac_phy, ONLY: ntiso,niso
    3838    USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
    3939        ridicule_qsol
    … …  
    6969    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
    7070#ifdef ISO
    71     REAL, DIMENSION(ntraciso,klon), INTENT(IN)      :: xtprecip_rain, xtprecip_snow
    72     REAL, DIMENSION(ntraciso,klon), INTENT(IN)      :: xtspechum   
     71    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
     72    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum   
    7373#endif
    7474
    … …  
    9191    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l         
    9292#ifdef ISO
    93     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)      :: xtevap
    94     REAL, DIMENSION(klon), INTENT(OUT)      :: h1
    95     REAL, DIMENSION(niso,klon), INTENT(OUT)      :: xtrunoff_diag
    96     REAL, DIMENSION(klon), INTENT(OUT)      :: runoff_diag
    97     REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
     93    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
     94    REAL, DIMENSION(klon),       INTENT(OUT) :: h1
     95    REAL, DIMENSION(niso,klon),  INTENT(OUT) :: xtrunoff_diag
     96    REAL, DIMENSION(klon),       INTENT(OUT) :: runoff_diag
     97    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
    9898#endif
    9999

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

    r4033 r4143  
    6161    USE indice_sol_mod
    6262#ifdef ISO
    63     use infotrac_phy, ONLY: ntraciso,niso
     63    use infotrac_phy, ONLY: ntiso,niso
    6464    use isotopes_mod, ONLY: nudge_qsol, iso_eau
    6565#ifdef ISOVERIF
    … …  
    104104    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
    105105#ifdef ISO
    106     REAL, DIMENSION(ntraciso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
    107     REAL, DIMENSION(ntraciso,klon), INTENT(IN)       :: xtspechum
     106    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
     107    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum
    108108#endif
    109109
    … …  
    135135    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
    136136#ifdef ISO
    137     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)      :: xtevap
     137    REAL, DIMENSION(ntiso,klon), INTENT(OUT)      :: xtevap
    138138    REAL, DIMENSION(klon), INTENT(OUT)      :: h1
    139139    REAL, DIMENSION(niso,klon), INTENT(OUT)      :: xtrunoff_diag
    … …  
    181181!       write(*,*) 'surf_land 169: ok_veget=',ok_veget
    182182        do i=1,knon
    183          do ixt=1,ntraciso
     183         do ixt=1,ntiso
    184184           call iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146')
    185185         enddo

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

    r4033 r4143  
    3737#ifdef ISO   
    3838    USE fonte_neige_mod,  ONLY : xtrun_off_lic
    39     USE infotrac_phy, ONLY : ntraciso,niso
     39    USE infotrac_phy, ONLY : ntiso,niso
    4040    USE isotopes_routines_mod, ONLY: calcul_iso_surf_lic_vectall
    4141#ifdef ISOVERIF
    … …  
    8282    REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
    8383#ifdef ISO
    84     REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow
    85     REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtspechum
     84    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
     85    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum
    8686#endif
    8787
    … …  
    129129    REAL, DIMENSION(klon), INTENT(OUT)           :: runoff  !Land ice runoff
    130130#ifdef ISO
    131     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)        :: xtevap     
     131    REAL, DIMENSION(ntiso,klon), INTENT(OUT)     :: xtevap     
    132132!    real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de
    133133!    fonte_neige

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

    r3940 r4143  
    3737    USE indice_sol_mod, ONLY : nbsrf, is_oce
    3838#ifdef ISO
    39   USE infotrac_phy, ONLY : ntraciso,niso
     39  USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
    4040#ifdef ISOVERIF
    4141    USE isotopes_mod, ONLY: iso_eau,ridicule

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

    r3940 r4143  
    3535  USE indice_sol_mod
    3636#ifdef ISO
    37   USE infotrac_phy, ONLY : ntraciso,niso
     37  USE infotrac_phy, ONLY : ntiso,niso
    3838#endif
    3939
    … …  
    7171    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
    7272#ifdef ISO
    73     REAL, DIMENSION(ntraciso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow
     73    REAL, DIMENSION(ntiso,klon), INTENT(IN)        :: xtprecip_rain, xtprecip_snow
    7474    REAL, DIMENSION(klon), INTENT(IN)        :: xtspechum
    7575    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Roce
    … …  
    101101    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    102102#ifdef ISO
    103     REAL, DIMENSION(ntraciso,klon), INTENT(OUT)        :: xtevap 
     103    REAL, DIMENSION(ntiso,klon), INTENT(OUT)        :: xtevap 
    104104#endif
    105105

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

    r4036 r4143  
    3434  USE print_control_mod, ONLY: prt_level
    3535#ifdef ISO
    36   USE infotrac_phy, ONLY : ntraciso
     36  USE infotrac_phy, ONLY : ntraciso=>ntiso
    3737#ifdef ISOVERIF
    3838  USE isotopes_verif_mod
Note: See TracChangeset for help on using the changeset viewer.