Ignore:
Timestamp:
Feb 22, 2021, 5:28:31 PM (3 years ago)
Author:
dcugnet
Message:

Extension of the tracers management.

The tracers files can be:

1) "traceur.def": old format, with:

  • the number of tracers on the first line
  • one line for each tracer: <tracer name> <hadv> <vadv> [<parent name>]

2) "tracer.def": new format with one section each model component.
3) "tracer_<name>.def": new format with a single section.

The formats 2 and 3 reading is driven by the "type_trac" key, which can be a

coma-separated list of components.

  • Format 2: read the sections from the "tracer.def" file.
  • format 3: read one section each "tracer_<section name>.def" file.
  • the first line of a section is "&<section name>
  • the other lines start with a tracer name followed by <key>=<val> pairs.
  • the "default" tracer name is reserved ; the other tracers of the section inherit its <key>=<val>, except for the keys that are redefined locally.

This format helps keeping the tracers files compact, thanks to the "default"
special tracer and the three levels of factorization:

  • on the tracers names: a tracer name can be a coma-separated list of tracers => all the tracers of the list have the same <key>=<val> properties
  • on the parents names: the value of the "parent" property can be a coma-separated list of tracers => only possible for geographic tagging tracers
  • on the phases: the property "phases" is [g](l][s] (gas/liquid/solid)

Read information is stored in the vector "tracers(:)", of derived type "tra".

"isotopes_params.def" is a similar file, with one section each isotopes family.
It contains a database of isotopes properties ; if there are second generation
tracers (isotopes), the corresponding sections are read.

Read information is stored in the vector "isotopes(:)", of derived type "iso".

The "getKey" function helps to get the values of the parameters stored in
"tracers" or "isotopes".

Location:
LMDZ6/branches/LMDZ-tracers/libf/dyn3d
Files:
9 edited
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/advtrac.F90

    r2622 r3852  
    99  !            M.A Filiberti (04/2002)
    1010  !
    11   USE infotrac, ONLY: nqtot, iadv,nqperes,ok_iso_verif
     11  USE infotrac, ONLY: nqtot, tracers
    1212  USE control_mod, ONLY: iapp_tracvl, day_step
    1313  USE comconst_mod, ONLY: dtvr
    … …  
    4848  INTEGER iadvtr
    4949  INTEGER ij,l,iq,iiq
     50  INTEGER, POINTER :: iadv(:)
    5051  REAL zdpmin, zdpmax
    5152  EXTERNAL  minmax
    … …  
    7374  real, save :: cflxmax(llm),cflymax(llm),cflzmax(llm)
    7475
     76  iadv => tracers(:)%iadv
     77
    7578  IF(iadvtr.EQ.0) THEN
    7679     pbaruc(:,:)=0
    … …  
    219222     !-----------------------------------------------------------
    220223
    221      if (ok_iso_verif) then
    222            write(*,*) 'advtrac 227'
    223            call check_isotopes_seq(q,ip1jmp1,'advtrac 162')
    224      endif !if (ok_iso_verif) then
    225 
    226      do iq=1,nqperes
     224     call check_isotopes_seq(q,ip1jmp1,'advtrac 162')
     225
     226     do iq=1,nqtot
    227227        !        call clock(t_initial)
    228         if(iadv(iq) == 0) cycle
     228        if(iadv(iq) == 0 .OR. tracers(iq)%igen /= 1) cycle
    229229        !   ----------------------------------------------------------------
    230230        !   Schema de Van Leer I MUSCL
    … …  
    394394     end DO
    395395
    396      if (ok_iso_verif) then
    397            write(*,*) 'advtrac 402'
    398            call check_isotopes_seq(q,ip1jmp1,'advtrac 397')
    399      endif !if (ok_iso_verif) then
     396     call check_isotopes_seq(q,ip1jmp1,'advtrac 397')
    400397
    401398     !------------------------------------------------------------------

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/check_isotopes.F90

    r3850 r3852  
    1         subroutine check_isotopes_seq(q,ip1jmp1,err_msg)
    2         USE infotrac
    3         implicit none
     1SUBROUTINE check_isotopes_seq(q, ip1jmp1, err_msg)
     2  USE strings_mod, ONLY: strIdx, msg, modname, prt_level
     3  USE infotrac,    ONLY: isotope, isoSelect, iH2O, isoCheck, isoName, nqtot, niso, nitr, nzon, npha, iTraPha, iZonIso, tnat
     4  IMPLICIT NONE
     5  include "dimensions.h"
     6  REAL,             INTENT(INOUT) :: q(ip1jmp1,llm,nqtot)
     7  INTEGER,          INTENT(IN)    :: ip1jmp1
     8  CHARACTER(LEN=*), INTENT(IN)    :: err_msg     !--- Error message to display
     9  CHARACTER(LEN=256) :: msg1
     10  INTEGER :: ixt, ipha, k, i, iq, iiso, izon, ieau, iqeau
     11  INTEGER, ALLOCATABLE :: ix(:)
     12  REAL    :: xtractot, xiiso, deltaD, q1, q2
     13  REAL, PARAMETER :: borne     = 1e19,  &
     14                     errmax    = 1e-8,  &        !--- Max. absolute error
     15                     errmaxrel = 1e-8,  &        !--- Max. relative error
     16                     qmin      = 1e-11, &
     17                     deltaDmax = 200.0, &
     18                     deltaDmin =-999.9, &
     19                     ridicule  = 1e-12
     20  INTEGER, SAVE :: ixH2O, ixHDO, ixO18
     21  LOGICAL, SAVE :: first=.TRUE.
    422
    5 #include "dimensions.h"
     23  modname = 'check_isotopes'
     24  IF(first) THEN
     25    IF(isoSelect('H2O')) RETURN
     26    ixH2O = strIdx(isoName,'H2[16]O')
     27    ixHDO = strIdx(isoName,'H[2]HO')
     28    ixO18 = strIdx(isoName,'H2[18]O')
     29    first = .FALSE.
     30  ELSE
     31    IF(isoSelect(iH2O)) RETURN
     32  END IF
     33  IF(.NOT.isoCheck .OR. niso == 0) RETURN        !--- No need to check or no isotopes => finished
    634
    7         ! inputs
    8         integer ip1jmp1
    9         real q(ip1jmp1,llm,nqtot)
    10         character*(*) err_msg ! message d''erreur à afficher
     35  !--- CHECK FOR NaNs (FOR ALL THE ISOTOPES, INCLUDING GEOGRAPHIC TAGGING TRACERS)
     36  DO ixt = 1, nitr
     37    DO ipha = 1, npha
     38      iq = iTraPha(ixt,ipha)
     39      DO k = 1, llm
     40        DO i = 1, ip1jmp1
     41          IF(ABS(q(i,k,iq))<=borne) CYCLE
     42          WRITE(msg1,'(s,"(",i0,",",i0,",",i0,") = ",ES12.4)')isoName(ixt),i,k,iq,q(i,k,iq); CALL msg(msg1)
     43          CALL abort_gcm(modname, 'Error in iso_verif_noNaN: '//TRIM(err_msg), 1)
     44          STOP
     45        END DO
     46      END DO
     47    END DO
     48  END DO
    1149
    12         ! locals
    13         integer ixt,phase,k,i,iq,iiso,izone,ieau,iqeau
    14         real xtractot,xiiso
    15         real borne
    16         real qmin
    17         real errmax ! erreur maximale en absolu.
    18         real errmaxrel ! erreur maximale en relatif autorisée
    19         real deltaDmax,deltaDmin
    20         real ridicule
    21         parameter (borne=1e19)
    22         parameter (errmax=1e-8)
    23         parameter (errmaxrel=1e-3)
    24         parameter (qmin=1e-11)
    25         parameter (deltaDmax=200.0,deltaDmin=-999.9)
    26         parameter (ridicule=1e-12)
    27         real deltaD
     50  !--- CHECK CONSERVATION (MAIN ISOTOPE AND PARENT CONCENTRATIONS MUST BE EQUAL)
     51  ixt = ixH2O
     52  IF(ixt /= 0) THEN
     53    DO ipha = 1, npha
     54      iq = iTraPha(ixt,ipha)
     55      DO k = 1, llm
     56        DO i = 1, ip1jmp1
     57          q1 = q(i,k,ipha); q2 = q(i,k,iq)
     58          IF(ABS(q1-q2) <= errmax .OR. ABS(q1-q2)/MAX(MAX(ABS(q1),ABS(q2)),1e-18) < errmaxrel) CYCLE
     59          WRITE(msg1,'("ixt = ",i0)')ixt;                                      CALL msg(msg1)
     60          WRITE(msg1,'("q(",i0,",",i0,",iq=",i0,") = ",ES12.4)')i, k, iq, q2;  CALL msg(msg1)
     61          WRITE(msg1,'("q(",i0,",",i0,",ipha=",i0,") = ",ES12.4)')i,k,ipha,q1; CALL msg(msg1)
     62          CALL abort_gcm(modname, 'Error in iso_verif_egalite: '//TRIM(err_msg), 1)
     63          q(i,k,iq) = q(i,k,ipha)                !--- Bidouille pour convergence
     64        END DO
     65      END DO
     66    END DO
     67  END IF
    2868
    29         if (ok_isotopes) then
     69  !--- CHECK DELTA ANOMALIES
     70  ix = [ixHDO, ixO18]
     71  DO iiso = 1, SIZE(ix)
     72    ixt = ix(iiso)
     73    IF(ixt  == 0) CYCLE
     74    DO ipha = 1, npha
     75      iq = iTraPha(ixt,ipha)
     76      DO k = 1, llm
     77        DO i = 1, ip1jmp1
     78          q1 = q(i,k,ipha); q2 = q(i,k,iq)
     79          IF(q2 <= qmin) CYCLE
     80          deltaD = (q2/q1/tnat(ixt)-1)*1000
     81          IF(deltaD <= deltaDmax .AND. deltaD >= deltaDmin) CYCLE
     82          WRITE(msg1,'("ixt = ",i0)')ixt;                                     CALL msg(msg1)
     83          WRITE(msg1,'("q(",i0,",",i0,",iq=",i0,") = ",ES12.4)')i, k, iq, q2; CALL msg(msg1)
     84          WRITE(msg1,'("q=",ES12.4)')q(i,k,:);                                CALL msg(msg1)
     85          WRITE(msg1,'("deltaD=",ES12.4)')deltaD;                             CALL msg(msg1)
     86          CALL abort_gcm(modname, 'Error in iso_verif_aberrant: '//TRIM(err_msg), 1)
     87        END DO
     88      END DO
     89    END DO
     90  END DO
    3091
    31         write(*,*) 'check_isotopes 31: err_msg=',err_msg
    32         ! verifier que rien n'est NaN
    33         do ixt=1,ntraciso
    34           do phase=1,nqo
    35             iq=iqiso(ixt,phase)
    36             do k=1,llm
    37               DO i = 1,ip1jmp1
    38                 if ((q(i,k,iq).gt.-borne).and.
    39      :            (q(i,k,iq).lt.borne)) then
    40                 else !if ((x(ixt,i,j).gt.-borne).and.
    41                   write(*,*) 'erreur detectee par iso_verif_noNaN:'
    42                   write(*,*) err_msg
    43                   write(*,*) 'q,i,k,iq=',q(i,k,iq),i,k,iq
    44                   write(*,*) 'borne=',borne
    45                   stop
    46                 endif  !if ((x(ixt,i,j).gt.-borne).and.
    47               enddo !DO i = 1,ip1jmp1
    48             enddo !do k=1,llm
    49           enddo !do phase=1,nqo
    50         enddo !do ixt=1,ntraciso
     92  !--- CHECK FOR TAGGING TRACERS DELTAD ANOMALIES
     93  IF(nitr == 0) RETURN
     94  IF(ixH2O /= 0 .AND. ixHDO /= 0) THEN
     95    DO izon = 1, nzon
     96      ixt  = iZonIso(izon, ixHDO)
     97      ieau = iZonIso(izon, ixH2O)
     98      DO ipha = 1, npha
     99        iq    = iTraPha(ixt,  ipha)
     100        iqeau = iTraPha(ieau, ipha)
     101        DO k = 1, llm
     102          DO i = 1, ip1jmp1
     103            IF(q(i,k,iq)<=qmin) CYCLE
     104            deltaD = (q(i,k,iq)/q(i,k,iqeau)/tnat(ixHDO)-1)*1000
     105            IF(deltaD <= deltaDmax .AND. deltaD >= deltaDmin) CYCLE
     106            WRITE(msg1,'("izon, ipha =",2i0)')izon, ipha;                              CALL msg(msg1)
     107            WRITE(msg1,'( "ixt, ieau =",2i0)') ixt, ieau;                              CALL msg(msg1)
     108            WRITE(msg1,'("q(",i0,",",i0,",iq=",i0,") = ",ES12.4)')i, k, iq, q(i,k,iq); CALL msg(msg1)
     109            WRITE(msg1,'("deltaD=",ES12.4)')deltaD;                                    CALL msg(msg1)
     110            CALL abort_gcm(modname, 'Error in iso_verif_aberrant trac: '//TRIM(err_msg), 1)
     111          END DO
     112        END DO
     113      END DO
     114    END DO
     115  END IF
    51116
    52         !write(*,*) 'check_isotopes 52'
    53         ! verifier que l'eau normale est OK
    54         if (use_iso(1)) then
    55           ixt=indnum_fn_num(1)
    56           do phase=1,nqo
    57             iq=iqiso(ixt,phase)
    58             do k=1,llm
    59             DO i = 1,ip1jmp1 
    60               if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
    61      :          (abs((q(i,k,phase)-q(i,k,iq))/
    62      :           max(max(abs(q(i,k,phase)),abs(q(i,k,iq))),1e-18))
    63      :           .gt.errmaxrel)) then
    64                   write(*,*) 'erreur detectee par iso_verif_egalite:'
    65                   write(*,*) err_msg
    66                   write(*,*) 'ixt,phase=',ixt,phase
    67                   write(*,*) 'q,iq,i,k=',q(i,k,iq),iq,i,k
    68                   write(*,*) 'q(i,k,phase)=',q(i,k,phase)
    69                   stop
    70               endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
    71               ! bidouille pour éviter divergence:
    72               q(i,k,iq)= q(i,k,phase)
    73             enddo ! DO i = 1,ip1jmp1
    74             enddo !do k=1,llm
    75           enddo ! do phase=1,nqo
    76         endif !if (use_iso(1)) then
    77        
    78         !write(*,*) 'check_isotopes 78'
    79         ! verifier que HDO est raisonable
    80         if (use_iso(2)) then
    81           ixt=indnum_fn_num(2)
    82           do phase=1,nqo
    83             iq=iqiso(ixt,phase)
    84             do k=1,llm
    85             DO i = 1,ip1jmp1
    86             if (q(i,k,iq).gt.qmin) then
    87              deltaD=(q(i,k,iq)/q(i,k,phase)/tnat(2)-1)*1000
    88              if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    89                   write(*,*) 'erreur detectee par iso_verif_aberrant:'
    90                   write(*,*) err_msg
    91                   write(*,*) 'ixt,phase=',ixt,phase
    92                   write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k
    93                   write(*,*) 'q=',q(i,k,:)
    94                   write(*,*) 'deltaD=',deltaD
    95                   stop
    96              endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    97             endif !if (q(i,k,iq).gt.qmin) then
    98             enddo !DO i = 1,ip1jmp1
    99             enddo !do k=1,llm
    100           enddo ! do phase=1,nqo
    101         endif !if (use_iso(2)) then
     117  !--- CHECK FOR TAGGING TRACERS CONSERVATION (PARENT AND TAGGING TRACERS SUM OVER ALL REGIONS MUST BE EQUAL)
     118  DO iiso = 1, niso
     119    DO ipha = 1, npha
     120      iq = iTraPha(iiso, ipha)
     121      DO k = 1, llm
     122        DO i = 1, ip1jmp1
     123          xiiso = q(i,k,iq)
     124          xtractot = SUM(q(i, k, iTraPha(iZonIso(1:nzon,iiso), ipha)))
     125          IF(ABS(xtractot-xiiso) > errmax .AND. ABS(xtractot-xiiso)/MAX(MAX(ABS(xtractot),ABS(xiiso)),1e-18) > errmaxrel) THEN
     126            CALL msg('Error in iso_verif_aberrant trac: '//TRIM(err_msg))
     127            WRITE(msg1,'("iiso, ipha =",2i0)')iiso, ipha;              CALL msg(msg1)
     128            WRITE(msg1,'("i, k =",2i0)')i, k;                          CALL msg(msg1)
     129            WRITE(msg1,'("q(",i0,",",i0,":) = ",ES12.4)')i,k,q(i,k,:); CALL msg(msg1)
     130            STOP
     131          END IF
     132          IF(ABS(xtractot) <= ridicule) CYCLE
     133          DO izon = 1, nzon
     134            ixt = iZonIso(izon, iiso)
     135            q(i,k,iq) = q(i,k,iq) / xtractot * xiiso
     136          END DO
     137        END DO
     138      END DO
     139    END DO
     140  END DO
    102141
    103         !write(*,*) 'check_isotopes 103'
    104         ! verifier que O18 est raisonable
    105         if (use_iso(3)) then
    106           ixt=indnum_fn_num(3)
    107           do phase=1,nqo
    108             iq=iqiso(ixt,phase)
    109             do k=1,llm
    110             DO i = 1,ip1jmp1
    111             if (q(i,k,iq).gt.qmin) then
    112              deltaD=(q(i,k,iq)/q(i,k,phase)/tnat(3)-1)*1000
    113              if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    114                   write(*,*) 'erreur detectee iso_verif_aberrant O18:'
    115                   write(*,*) err_msg
    116                   write(*,*) 'ixt,phase=',ixt,phase
    117                   write(*,*) 'q,iq,i,k,=',q(i,k,phase),iq,i,k
    118                   write(*,*) 'xt=',q(i,k,:)
    119                   write(*,*) 'deltaO18=',deltaD
    120                   stop
    121              endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    122             endif !if (q(i,k,iq).gt.qmin) then
    123             enddo !DO i = 1,ip1jmp1
    124             enddo !do k=1,llm
    125           enddo ! do phase=1,nqo
    126         endif !if (use_iso(2)) then
     142END SUBROUTINE check_isotopes_seq
    127143
    128 
    129         !write(*,*) 'check_isotopes 129'
    130         if (ok_isotrac) then
    131 
    132           if (use_iso(2).and.use_iso(1)) then
    133             do izone=1,ntraceurs_zone
    134              ixt=index_trac(izone,indnum_fn_num(2))
    135              ieau=index_trac(izone,indnum_fn_num(1))
    136              do phase=1,nqo
    137                iq=iqiso(ixt,phase)
    138                iqeau=iqiso(ieau,phase)
    139                do k=1,llm
    140                 DO i = 1,ip1jmp1
    141                 if (q(i,k,iq).gt.qmin) then
    142                  deltaD=(q(i,k,iq)/q(i,k,iqeau)/tnat(2)-1)*1000
    143                  if ((deltaD.gt.deltaDmax).or.
    144      &                   (deltaD.lt.deltaDmin)) then
    145                   write(*,*) 'erreur dans iso_verif_aberrant trac:'
    146                   write(*,*) err_msg
    147                   write(*,*) 'izone,phase=',izone,phase
    148                   write(*,*) 'ixt,ieau=',ixt,ieau
    149                   write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k
    150                   write(*,*) 'deltaD=',deltaD
    151                   stop
    152                  endif !if ((deltaD.gt.deltaDmax).or.
    153                 endif !if (q(i,k,iq).gt.qmin) then
    154                 enddo !DO i = 1,ip1jmp1
    155                 enddo  ! do k=1,llm
    156               enddo ! do phase=1,nqo   
    157             enddo !do izone=1,ntraceurs_zone
    158           endif !if (use_iso(2).and.use_iso(1)) then
    159 
    160           do iiso=1,niso
    161            do phase=1,nqo
    162               iq=iqiso(iiso,phase)
    163               do k=1,llm
    164                 DO i = 1,ip1jmp1
    165                    xtractot=0.0
    166                    xiiso=q(i,k,iq)
    167                    do izone=1,ntraceurs_zone
    168                       iq=iqiso(index_trac(izone,iiso),phase)
    169                       xtractot=xtractot+ q(i,k,iq)
    170                    enddo !do izone=1,ntraceurs_zone
    171                    if ((abs(xtractot-xiiso).gt.errmax).and.
    172      :                  (abs(xtractot-xiiso)/
    173      :                  max(max(abs(xtractot),abs(xiiso)),1e-18)
    174      :                  .gt.errmaxrel)) then
    175                   write(*,*) 'erreur detectee par iso_verif_traceurs:'
    176                   write(*,*) err_msg
    177                   write(*,*) 'iiso,phase=',iiso,phase
    178                   write(*,*) 'i,k,=',i,k
    179                   write(*,*) 'q(i,k,:)=',q(i,k,:)
    180                   stop
    181                  endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
    182                  
    183                  ! bidouille pour éviter divergence:
    184                  if (abs(xtractot).gt.ridicule) then
    185                    do izone=1,ntraceurs_zone
    186                      ixt=index_trac(izone,iiso)
    187                      q(i,k,iq)=q(i,k,iq)/xtractot*xiiso
    188                    enddo !do izone=1,ntraceurs_zone               
    189                   endif !if ((abs(xtractot).gt.ridicule) then
    190                 enddo !DO i = 1,ip1jmp1
    191               enddo !do k=1,llm
    192            enddo !do phase=1,nqo
    193           enddo !do iiso=1,niso
    194 
    195         endif !if (ok_isotrac) then
    196 
    197         endif ! if (ok_isotopes)
    198         !write(*,*) 'check_isotopes 198'
    199        
    200         end
    201 

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/dynetat0.f90

    r2859 r3852  
    66! Purpose: Initial state reading.
    77!-------------------------------------------------------------------------------
    8   USE infotrac
     8  USE infotrac,    ONLY: nqtot, niso, tracers, iTraPha, tnat, alpha_ideal, tra
    99  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, &
    1010                         NF90_CLOSE, NF90_GET_VAR
     11  USE strings_mod, ONLY: strIdx
    1112  USE control_mod, ONLY: planet_type
    1213  USE assert_eq_m, ONLY: assert_eq
    … …  
    3637!===============================================================================
    3738! Local variables:
    38   CHARACTER(LEN=256) :: msg, var, modname
     39  CHARACTER(LEN=256) :: sdum, var, modname, oldH2O(3), newH2O(3)
    3940  INTEGER, PARAMETER :: length=100
    40   INTEGER :: iq, fID, vID, idecal!, iml, jml, lml, nqt
     41  INTEGER :: iq, fID, vID, idecal, ix!, iml, jml, lml, nqt
    4142  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
     43 TYPE(tra), POINTER :: tr
    4244!-------------------------------------------------------------------------------
    4345  modname="dynetat0"
     46  oldH2O=['H2Ov ','H2Ol ','H2Oi ']
     47  newH2O=['H2O-g','H2O-l','H2O-s']
    4448
    4549!--- Initial state file opening
    … …  
    126130!--- Tracers
    127131  DO iq=1,nqtot
    128     var=tname(iq)
     132    tr => tracers(iq)
     133    var = tr%name
    129134    IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN
    130135      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
     136#ifdef INCA
     137    ELSE IF(var == "O3") THEN          !--- INCA and O3 missing: take OX instead
     138      WRITE(lunout,*) 'Tracer O3 is missing - it is initialized to OX'
     139        IF(NF90_INQ_VARID(fID,"OX",vID) == NF90_NoErr) THEN
     140           CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
     141        END IF
     142#endif
     143    ELSE                               !--- Old file, water: H2Ov/l/i instead of H2O-g/-l/-s
     144      ix = strIdx(newH2O, var)         !--- Current tracer is water (new name) ?
     145      IF(ix /= 0) THEN                 !--- Then read the field, using the old name.
     146        IF(NF90_INQ_VARID(fID,oldH2O(ix),vID) == NF90_NoErr) THEN
     147           CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
     148        END IF
     149      END IF
    131150    END IF
    132151    WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
    133152    WRITE(lunout,*)"         It is hence initialized to zero"
    134153    q(:,:,:,iq)=0.
    135    !--- CRisi: for isotops, theoretical initialization using very simplified
    136    !           Rayleigh distillation las.
    137     IF(ok_isotopes.AND.iso_num(iq)>0) THEN
    138       IF(zone_num(iq)==0) q(:,:,:,iq)=q(:,:,:,iqpere(iq))*tnat(iso_num(iq))    &
    139      &             *(q(:,:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
    140       IF(zone_num(iq)==1) q(:,:,:,iq)=q(:,:,:,iqiso(iso_indnum(iq),phase_num(iq)))
     154    !--- CRisi: for isotops, theoretical initialization using very simplified
     155    !           Rayleigh distillation las.
     156    IF(niso > 0 .AND. tr%iso_num > 0) THEN
     157      IF(tr%iso_zon == 0) q(:,:,:,iq) = q(:,:,:,tr%iprnt)         *        tnat(tr%iso_num)  &
     158                                      *(q(:,:,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1)
     159      IF(tr%iso_zon == 1) q(:,:,:,iq) = q(:,:,:,iTraPha(tr%iso_num,tr%iso_pha))
    141160    END IF
    142161  END DO
    … …  
    153172  INTEGER,          INTENT(IN) :: n1, n2
    154173  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
    155   CHARACTER(LEN=100) :: s1, s2
     174  CHARACTER(LEN=256) :: s1, s2
    156175  IF(n1/=n2) THEN
    157176    s1='value of '//TRIM(str1)//' ='
    158177    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
    159     WRITE(msg,'(10x,a,i4,2x,a,i4)'),TRIM(ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2
    160     CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
     178    WRITE(sdum,'(10x,a,i4,2x,a,i4)'),TRIM(ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2
     179    CALL ABORT_gcm(TRIM(modname),TRIM(sdum),1)
    161180  END IF
    162181END SUBROUTINE check_dim
    … …  
    193212  IF(ierr==NF90_NoERR) RETURN
    194213  SELECT CASE(typ)
    195     CASE('inq');   msg="Field <"//TRIM(nam)//"> is missing"
    196     CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
    197     CASE('open');  msg="File opening failed for <"//TRIM(nam)//">"
    198     CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
     214    CASE('inq');   sdum="Field <"//TRIM(nam)//"> is missing"
     215    CASE('get');   sdum="Reading failed for <"//TRIM(nam)//">"
     216    CASE('open');  sdum="File opening failed for <"//TRIM(nam)//">"
     217    CASE('close'); sdum="File closing failed for <"//TRIM(nam)//">"
    199218  END SELECT
    200   CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
     219  CALL ABORT_gcm(TRIM(modname),TRIM(sdum),ierr)
    201220END SUBROUTINE err
    202221

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/dynredem.F90

    r3851 r3852  
    77  USE IOIPSL
    88#endif
    9   USE infotrac
     9  USE infotrac, ONLY: nqtot, tracers
    1010  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
    1111                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER,   &
    … …  
    145145  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
    146146  DO iq=1,nqtot
    147     CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
     147    CALL cre_var(nid,tracers(iq)%name,tracers(iq)%lnam,[rlonvID,rlatuID,sID,timID])
    148148  END DO
    149149  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
    … …  
    166166! Purpose: Write the NetCDF restart file (append).
    167167!-------------------------------------------------------------------------------
    168   USE infotrac
     168  USE infotrac, ONLY: nqtot, tracers, type_trac
    169169  USE control_mod
    170170  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
    … …  
    226226
    227227!--- Tracers in file "start_trac.nc" (added by Anne)
    228   lread_inca=.FALSE.; fil="start_trac.nc"
    229   IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
     228  fil="start_trac.nc"
     229  INQUIRE(FILE=fil, EXIST=lread_inca)
     230  lread_inca = lread_inca .AND. type_trac == 'inca'
    230231  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
    231232
    232233!--- Save tracers
    233   DO iq=1,nqtot; var=tname(iq); ierr=-1
     234  DO iq=1,nqtot; var=tracers(iq)%name; ierr=-1
    234235    IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
    235236      fil="start_trac.nc"
    … …  
    237238      dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
    238239      WRITE(lunout,*)msg(dum,var)
    239 
    240 
    241240      IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm)
    242241    END IF

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/iniacademic.F90

    r2622 r3852  
    55
    66  USE filtreg_mod, ONLY: inifilr
    7   USE infotrac
     7  USE infotrac, ONLY: nqtot, niso, tracers, iTraPha, tnat, alpha_ideal, tra
    88  USE control_mod, ONLY: day_step,planet_type
    99#ifdef CPP_IOIPSL
    … …  
    7373
    7474  REAL zdtvr
    75  
     75
     76  TYPE(tra), POINTER :: tr
     77 
    7678  character(len=*),parameter :: modname="iniacademic"
    7779  character(len=80) :: abort_message
    … …  
    9698  time_0=0.
    9799  day_ref=1
    98   annee_ref=0
     100!  annee_ref=0
    99101
    100102  im         = iim
    … …  
    265267              ! CRisi: init des isotopes
    266268              ! distill de Rayleigh très simplifiée
    267               if (ok_isotopes) then
    268                 if ((iso_num(i).gt.0).and.(zone_num(i).eq.0)) then         
    269                    q(:,:,i)=q(:,:,iqpere(i))             &
    270       &                  *tnat(iso_num(i))               &
    271       &                  *(q(:,:,iqpere(i))/30.e-3)      &
    272       &                  **(alpha_ideal(iso_num(i))-1)
    273                 endif               
    274                 if ((iso_num(i).gt.0).and.(zone_num(i).eq.1)) then
    275                   q(:,:,i)=q(:,:,iqiso(iso_indnum(i),phase_num(i)))
    276                 endif
    277               endif !if (ok_isotopes) then
     269              tr => tracers(i)
     270              if (niso > 0 .AND. tr%iso_num > 0) then
     271                 if(tr%iso_zon == 0) q(:,:,i) =         &
     272      &            q(:,:,tr%iprnt)*tnat(tr%iso_num)     &
     273      &          *(q(:,:,tr%iprnt)/30.e-3)              &
     274      &           **(alpha_ideal(tr%iso_num)-1)
     275                 if (tr%iso_zon == 1) q(:,:,i) =        &
     276                   q(:,:,iTraPha(tr%iso_num,tr%iso_pha))
     277              endif !if (niso > 0 .AND. tr%iso_num > 0)
    278278
    279279           enddo
    … …  
    282282        endif ! of if (planet_type=="earth")
    283283
    284         if (ok_iso_verif) then
    285            call check_isotopes_seq(q,1,ip1jmp1,'iniacademic_loc')
    286         endif !if (ok_iso_verif) then
     284        call check_isotopes_seq(q,1,ip1jmp1,'iniacademic_loc')
    287285
    288286        ! add random perturbation to temperature

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/integrd.F

    r2603 r3852  
    212212        ENDDO
    213213
     214        CALL check_isotopes_seq(q,ip1jmp1,'integrd 342')
     215
    214216        CALL qminimum( q, nq, deltap )
     217
     218        CALL check_isotopes_seq(q,ip1jmp1,'integrd 346')
    215219
    216220c
    … …  
    235239        ENDDO
    236240       ENDDO
     241       CALL check_isotopes_seq(q,ip1jmp1,'integrd 409')
    237242
    238243! Ehouarn: forget about finvmaold

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/leapfrog.F

    r3416 r3852  
    1111      use IOIPSL
    1212#endif
    13       USE infotrac, ONLY: nqtot,ok_iso_verif
     13      USE infotrac, ONLY: nqtot
    1414      USE guide_mod, ONLY : guide_main
    1515      USE write_field, ONLY: writefield
    … …  
    237237      jH_cur = jH_cur - int(jH_cur)
    238238
    239         if (ok_iso_verif) then
    240            call check_isotopes_seq(q,ip1jmp1,'leapfrog 321')
    241         endif !if (ok_iso_verif) then
     239      call check_isotopes_seq(q,ip1jmp1,'leapfrog 321')
    242240
    243241#ifdef CPP_IOIPSL
    … …  
    271269!      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
    272270
    273         if (ok_iso_verif) then
    274            call check_isotopes_seq(q,ip1jmp1,'leapfrog 400')
    275         endif !if (ok_iso_verif) then
     271      call check_isotopes_seq(q,ip1jmp1,'leapfrog 400')
    276272
    277273   2  CONTINUE ! Matsuno backward or leapfrog step begins here
    … …  
    323319      endif
    324320
    325 
    326         if (ok_iso_verif) then
    327            call check_isotopes_seq(q,ip1jmp1,'leapfrog 589')
    328         endif !if (ok_iso_verif) then
     321      call check_isotopes_seq(q,ip1jmp1,'leapfrog 589')
    329322
    330323c-----------------------------------------------------------------------
    … …  
    345338c   -------------------------------------------------------------
    346339
    347         if (ok_iso_verif) then
    348            call check_isotopes_seq(q,ip1jmp1,
     340      call check_isotopes_seq(q,ip1jmp1,
    349341     &           'leapfrog 686: avant caladvtrac')
    350         endif !if (ok_iso_verif) then
    351342
    352343      IF( forward. OR . leapf )  THEN
    … …  
    376367c   ----------------------------------
    377368
    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
     369       call check_isotopes_seq(q,ip1jmp1,'leapfrog 756')
    382370       
    383371       CALL integrd ( nqtot,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    … …  
    385373!     $              finvmaold                                    )
    386374
    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
     375       call check_isotopes_seq(q,ip1jmp1,'leapfrog 762')
    391376
    392377c .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
    … …  
    552537        CALL massdair(p,masse)
    553538
    554         if (ok_iso_verif) then
    555            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1196')
    556         endif !if (ok_iso_verif) then
     539        call check_isotopes_seq(q,ip1jmp1,'leapfrog 1196')
    557540
    558541c-----------------------------------------------------------------------
    … …  
    639622c   preparation du pas d'integration suivant  ......
    640623
    641         if (ok_iso_verif) then
    642            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1509')
    643         endif !if (ok_iso_verif) then
     624      call check_isotopes_seq(q,ip1jmp1,'leapfrog 1509')
    644625
    645626      IF ( .NOT.purmats ) THEN
    … …  
    703684            ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin))
    704685
    705         if (ok_iso_verif) then
    706            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1584')
    707         endif !if (ok_iso_verif) then
     686            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1584')
    708687
    709688c-----------------------------------------------------------------------
    … …  
    785764      ELSE ! of IF (.not.purmats)
    786765
    787         if (ok_iso_verif) then
    788            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1664')
    789         endif !if (ok_iso_verif) then
     766        call check_isotopes_seq(q,ip1jmp1,'leapfrog 1664')
    790767
    791768c       ........................................................
    … …  
    812789            ELSE ! of IF(forward) i.e. backward step
    813790 
    814         if (ok_iso_verif) then
    815            call check_isotopes_seq(q,ip1jmp1,'leapfrog 1698')
    816         endif !if (ok_iso_verif) then 
     791              call check_isotopes_seq(q,ip1jmp1,'leapfrog 1698')
    817792
    818793              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/qminimum.F

    r2600 r3852  
    44      SUBROUTINE qminimum( q,nqtot,deltap )
    55
    6       USE infotrac, ONLY: ok_isotopes,ntraciso,iqiso,ok_iso_verif
     6      USE infotrac, ONLY: niso, nitr, iTraPha
    77      IMPLICIT none
    88c
    … …  
    4949c
    5050
    51         if (ok_iso_verif) then
    52            call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   
    53         endif !if (ok_iso_verif) then     
     51      call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   
    5452
    5553      zx_defau_diag(:,:,:)=0.0
    … …  
    5957          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
    6058
    61               if (ok_isotopes) then
    62                  zx_defau_diag(i,k,iq_liq)=AMAX1
     59              if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX1
    6360     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
    64               endif !if (ok_isotopes) then
    6561
    6662             q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
    … …  
    8076          if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
    8177
    82             if (ok_isotopes) then
    83               zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
    84             endif !if (ok_isotopes) then
     78            zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
    8579
    8680            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
    … …  
    110104
    111105      !write(*,*) 'qminimum 128'
    112       if (ok_isotopes) then
     106      if (niso > 0) then
    113107      ! CRisi: traiter de même les traceurs d'eau
    114108      ! Mais il faut les prendre à l'envers pour essayer de conserver la
    … …  
    130124          if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
    131125              ! on ajoute la vapeur en k             
    132               do ixt=1,ntraciso
    133                q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
     126              do ixt=1,nitr
     127               q(i,k,iTraPha(ixt,iq_vap))=q(i,k,iTraPha(ixt,iq_vap))
    134128     :              +zx_defau_diag(i,k,iq_vap)
    135      :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
     129     :              *q(i,k-1,iTraPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
    136130               
    137131              ! et on la retranche en k-1
    138                q(i,k-1,iqiso(ixt,iq_vap))=q(i,k-1,iqiso(ixt,iq_vap))
     132               q(i,k-1,iTraPha(ixt,iq_vap))=q(i,k-1,iTraPha(ixt,iq_vap))
    139133     :              -zx_defau_diag(i,k,iq_vap)
    140134     :              *deltap(i,k)/deltap(i,k-1)
    141      :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
     135     :              *q(i,k-1,iTraPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
    142136
    143               enddo !do ixt=1,niso
     137              enddo !do ixt=1,nitr
    144138              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
    145139     :               +zx_defau_diag(i,k,iq_vap)
    … …  
    151145       enddo !do k=2,llm
    152146
    153         if (ok_iso_verif) then     
    154            call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
    155         endif !if (ok_iso_verif) then
     147       call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
    156148       
    157149     
    … …  
    163155
    164156              ! on ajoute eau liquide en k en k             
    165               do ixt=1,ntraciso
    166                q(i,k,iqiso(ixt,iq_liq))=q(i,k,iqiso(ixt,iq_liq))
     157              do ixt=1,nitr
     158               q(i,k,iTraPha(ixt,iq_liq))=q(i,k,iTraPha(ixt,iq_liq))
    167159     :              +zx_defau_diag(i,k,iq_liq)
    168      :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)
     160     :              *q(i,k,iTraPha(ixt,iq_vap))/q_follow(i,k,iq_vap)
    169161              ! et on la retranche à la vapeur en k
    170                q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
     162               q(i,k,iTraPha(ixt,iq_vap))=q(i,k,iTraPha(ixt,iq_vap))
    171163     :              -zx_defau_diag(i,k,iq_liq)
    172      :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)   
     164     :              *q(i,k,iTraPha(ixt,iq_vap))/q_follow(i,k,iq_vap)   
    173165              enddo !do ixt=1,niso
    174166              q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
    … …  
    180172       enddo !do k=2,llm 
    181173
    182         if (ok_iso_verif) then
    183            call check_isotopes_seq(q,ip1jmp1,'qminimum 197')
    184         endif !if (ok_iso_verif) then
     174       call check_isotopes_seq(q,ip1jmp1,'qminimum 197')
    185175
    186       endif !if (ok_isotopes) then
     176      endif !if (niso > 0) then
    187177      !write(*,*) 'qminimum 188'
    188178     

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/vlsplt.F

    r2603 r3852  
    44
    55      SUBROUTINE vlsplt(q,pente_max,masse,w,pbaru,pbarv,pdt,iq)
    6       USE infotrac, ONLY: nqtot,nqdesc,iqfils
     6      USE infotrac, ONLY: nqtot, tracers, tra
    77c
    88c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    5454      SAVE temps1,temps2,temps3
    5555      INTEGER iminn,imaxx
    56       INTEGER ifils,iq2 ! CRisi
     56      INTEGER ichld,iq2 ! CRisi
     57      TYPE(tra), POINTER :: tr
    5758
    5859      REAL qmin,qmax
    … …  
    6162      DATA temps1,temps2,temps3/0.,0.,0./
    6263
     64       tr => tracers(iq)
    6365
    6466        zzpbar = 0.5 * pdt
    … …  
    8385      CALL SCOPY(ijp1llm,masse,1,zm(1,1,iq),1)
    8486       
    85       if (nqdesc(iq).gt.0) then 
    86         do ifils=1,nqdesc(iq)
    87           iq2=iqfils(ifils,iq)
     87      if (tr%ndesc > 0) then 
     88        do ichld=1,tr%ndesc
     89          iq2=tr%idesc(ichld)
    8890          CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1)
    8991        enddo 
    90       endif !if (nqfils(iq).gt.0) then
     92      endif !if (tr%ndesc > 0) then
    9193
    9294cprint*,'Entree vlx1'
    … …  
    122124      ENDDO
    123125      ! CRisi: aussi pour les fils
    124       if (nqdesc(iq).gt.0) then
    125       do ifils=1,nqdesc(iq)
    126         iq2=iqfils(ifils,iq)
     126      if(tr%ndesc > 0) then
     127      do ichld=1,tr%ndesc
     128        iq2=tr%idesc(ichld)
    127129        DO l=1,llm
    128130         DO ij=1,ip1jmp1
    … …  
    133135         ENDDO
    134136        ENDDO
    135       enddo !do ifils=1,nqdesc(iq)   
    136       endif ! if (nqdesc(iq).gt.0) then   
     137      enddo !do ichld=1,tr%ndesc
     138      endif ! if (tr%ndesc > 0)   
    137139
    138140      RETURN
    139141      END
    140142      RECURSIVE SUBROUTINE vlx(q,pente_max,masse,u_m,iq)
    141       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     143      USE infotrac, ONLY : nqtot, tracers, tra ! CRisi
    142144
    143145c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    179181      ! CRisi
    180182      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot)
    181       INTEGER ifils,iq2 ! CRisi
     183      INTEGER ichld,iq2 ! CRisi
     184      TYPE(tra), POINTER :: tr
    182185
    183186      Logical extremum,first,testcpu
    … …  
    200203         first=.false.
    201204      ENDIF
     205
     206      tr => tracers(iq)
    202207
    203208c   calcul de la pente a droite et a gauche de la maille
    … …  
    450455      !write(*,*) 'vlsplt 326: iq,nqfils(iq)=',iq,nqfils(iq)
    451456     
    452       if (nqdesc(iq).gt.0) then 
    453        do ifils=1,nqdesc(iq)
    454          iq2=iqfils(ifils,iq)
     457      if (tr%ndesc > 0) then 
     458       do ichld=1,tr%ndesc
     459         iq2=tr%idesc(ichld)
    455460         DO l=1,llm
    456461          DO ij=iip2,ip1jm
    … …  
    460465          enddo   
    461466         enddo
    462         enddo !do ifils=1,nqdesc(iq)
    463         do ifils=1,nqfils(iq)
    464          iq2=iqfils(ifils,iq)
     467        enddo !do ichld=1,tr%ndesc
     468        do ichld=1,tr%nchld
     469         iq2=tr%idesc(ichld)
    465470         call vlx(Ratio,pente_max,masseq,u_mq,iq2)
    466         enddo !do ifils=1,nqfils(iq)
    467       endif !if (nqfils(iq).gt.0) then
     471        enddo !do ichld=1,tr%nchld
     472      endif !if (tr%nchld > 0) then
    468473! end CRisi
    469474
    … …  
    489494      ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
    490495      ! puis on boucle en longitude
    491       if (nqdesc(iq).gt.0) then 
    492        do ifils=1,nqdesc(iq)
    493          iq2=iqfils(ifils,iq) 
     496      if (tr%ndesc > 0) then 
     497       do ichld=1,tr%ndesc
     498         iq2=tr%idesc(ichld) 
    494499         DO l=1,llm
    495500          DO ij=iip2+1,ip1jm
    … …  
    500505          enddo ! DO ij=ijb+iip1-1,ije,iip1
    501506         enddo !DO l=1,llm
    502         enddo !do ifils=1,nqdesc(iq)
    503       endif !if (nqfils(iq).gt.0) then
     507        enddo !do ichld=1,tr%ndesc
     508      endif !if (tr%ndesc > 0) then
    504509
    505510c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
    … …  
    510515      END
    511516      RECURSIVE SUBROUTINE vly(q,pente_max,masse,masse_adv_v,iq)
    512       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     517      USE infotrac, ONLY : nqtot, tracers, tra ! CRisi
    513518c
    514519c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    562567
    563568      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) ! CRisi
    564       INTEGER ifils,iq2 ! CRisi
    565 
     569      INTEGER ichld,iq2 ! CRisi
     570      TYPE(tra), POINTER :: tr
    566571c
    567572c
    … …  
    590595      ENDIF
    591596
     597      tr => tracers(iq)
    592598c
    593599cPRINT*,'CALCUL EN LATITUDE'
    … …  
    770776      !write(*,*) 'vly 689: iq,nqfils(iq)=',iq,nqfils(iq)
    771777   
    772       if (nqfils(iq).gt.0) then 
    773        do ifils=1,nqdesc(iq)
    774          iq2=iqfils(ifils,iq)
     778      if (tr%ndesc > 0) then 
     779       do ichld=1,tr%ndesc
     780         iq2=tr%idesc(ichld)
    775781         DO l=1,llm
    776782         DO ij=1,ip1jmp1
    … …  
    781787          enddo   
    782788         enddo
    783         enddo !do ifils=1,nqdesc(iq)
    784 
    785         do ifils=1,nqfils(iq)
    786          iq2=iqfils(ifils,iq)
     789        enddo !do ichld=1,tr%ndesc
     790
     791        do ichld=1,tr%nchld
     792         iq2=tr%idesc(ichld)
    787793         call vly(Ratio,pente_max,masseq,qbyv,iq2)
    788         enddo !do ifils=1,nqfils(iq)
    789       endif !if (nqfils(iq).gt.0) then
     794        enddo !do ichld=1,tr%nchld
     795      endif !if (tr%ndesc > 0)
    790796
    791797      DO l=1,llm
    … …  
    855861 
    856862! retablir les fils en rapport de melange par rapport a l'air:
    857       if (nqfils(iq).gt.0) then 
    858        do ifils=1,nqdesc(iq)
    859          iq2=iqfils(ifils,iq) 
     863      if (tr%ndesc > 0) then 
     864       do ichld=1,tr%ndesc
     865         iq2=tr%idesc(ichld) 
    860866         DO l=1,llm
    861867          DO ij=1,ip1jmp1
    … …  
    863869          enddo
    864870         enddo
    865         enddo !do ifils=1,nqdesc(iq)
    866       endif !if (nqfils(iq).gt.0) then
     871        enddo !do ichld=1,tr%ndesc
     872      endif !if (tr%ndesc > 0)
    867873
    868874      !write(*,*) 'vly 853: sortie'
    … …  
    871877      END
    872878      RECURSIVE SUBROUTINE vlz(q,pente_max,masse,w,iq)
    873       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     879      USE infotrac, ONLY : nqtot, tracers, tra ! CRisi
    874880c
    875881c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    907913
    908914      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) ! CRisi
    909       INTEGER ifils,iq2 ! CRisi
     915      INTEGER ichld,iq2 ! CRisi
     916      TYPE(tra), POINTER :: tr
    910917
    911918      LOGICAL testcpu
    … …  
    923930
    924931      !write(*,*) 'vlz 923: entree'
     932
     933      tr => tracers(iq)
    925934
    926935#ifdef BIDON
    … …  
    9921001! Il faut faire ça avant d'avoir mis à jour q et masse
    9931002      !write(*,*) 'vlsplt 942: iq,nqfils(iq)=',iq,nqfils(iq)
    994       if (nqfils(iq).gt.0) then 
    995        do ifils=1,nqdesc(iq)
    996          iq2=iqfils(ifils,iq)
     1003      if (tr%ndesc > 0) then 
     1004       do ichld=1,tr%ndesc
     1005         iq2=tr%idesc(ichld)
    9971006         DO l=1,llm
    9981007          DO ij=1,ip1jmp1
    … …  
    10011010          enddo   
    10021011         enddo
    1003         enddo !do ifils=1,nqdesc(iq)
     1012        enddo !do ichld=1,tr%ndesc
    10041013       
    1005         do ifils=1,nqfils(iq)
    1006          iq2=iqfils(ifils,iq)         
     1014        do ichld=1,tr%nchld
     1015         iq2=tr%idesc(ichld)         
    10071016         call vlz(Ratio,pente_max,masseq,wq,iq2)
    1008         enddo !do ifils=1,nqfils(iq)
    1009       endif !if (nqfils(iq).gt.0) then
     1017        enddo !do ichld=1,tr%nchld
     1018      endif !if (tr%ndesc > 0)
    10101019! end CRisi 
    10111020
    … …  
    10201029
    10211030! retablir les fils en rapport de melange par rapport a l'air:
    1022       if (nqfils(iq).gt.0) then 
    1023        do ifils=1,nqdesc(iq)
    1024          iq2=iqfils(ifils,iq) 
     1031      if (tr%ndesc > 0) then 
     1032       do ichld=1,tr%ndesc
     1033         iq2=tr%idesc(ichld)
    10251034         DO l=1,llm
    10261035          DO ij=1,ip1jmp1
    … …  
    10281037          enddo
    10291038         enddo
    1030         enddo !do ifils=1,nqdesc(iq)
    1031       endif !if (nqfils(iq).gt.0) then
     1039        enddo !do ichld=1,tr%ndesc
     1040      endif !if (tr%ndesc > 0)
    10321041      !write(*,*) 'vlsplt 1032'
    10331042

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/vlspltqs.F

    r2603 r3852  
    44       SUBROUTINE vlspltqs ( q,pente_max,masse,w,pbaru,pbarv,pdt,
    55     ,                                  p,pk,teta,iq             )
    6        USE infotrac, ONLY: nqtot,nqdesc,iqfils
     6       USE infotrac, ONLY: nqtot, tracers, tra
    77c
    88c     Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron
    … …  
    4545c
    4646      INTEGER i,ij,l,j,ii
    47       INTEGER ifils,iq2 ! CRisi
     47      INTEGER ichld,iq2 ! CRisi
     48      TYPE(tra), POINTER :: tr
    4849c
    4950      REAL qsat(ip1jmp1,llm)
    … …  
    8485        rtt  = 273.16
    8586
     87        tr => tracers(iq)
     88
    8689c-- Calcul de Qsat en chaque point
    8790c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
    … …  
    121124      CALL SCOPY(ijp1llm,q(1,1,iq),1,zq(1,1,iq),1)
    122125      CALL SCOPY(ijp1llm,masse,1,zm(1,1,iq),1)
    123       if (nqdesc(iq).gt.0) then 
    124        do ifils=1,nqdesc(iq)
    125         iq2=iqfils(ifils,iq)
     126      if (tr%ndesc > 0) then 
     127       do ichld=1,tr%ndesc
     128        iq2=tr%idesc(ichld)
    126129        CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1)
    127130       enddo 
    128       endif !if (nqfils(iq).gt.0) then
     131      endif !if (tr%ndesc > 0)
    129132
    130133c      call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
    … …  
    162165      ENDDO
    163166      ! CRisi: aussi pour les fils
    164       if (nqdesc(iq).gt.0) then
    165       do ifils=1,nqdesc(iq)
    166         iq2=iqfils(ifils,iq)
     167      if (tr%ndesc > 0) then
     168      do ichld=1,tr%ndesc
     169        iq2=tr%idesc(ichld)
    167170        DO l=1,llm
    168171         DO ij=1,ip1jmp1
    … …  
    173176         ENDDO
    174177        ENDDO
    175       enddo !do ifils=1,nqdesc(iq) 
    176       endif ! if (nqfils(iq).gt.0) then
     178      enddo !do ichld=1,tr%ndesc
     179      endif ! if (tr%ndesc > 0)
    177180      !write(*,*) 'vlspltqs 183: fin de la routine'
    178181
    … …  
    180183      END
    181184      SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat,iq)
    182       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     185      USE infotrac, ONLY : nqtot, tracers, tra ! CRisi
    183186
    184187c
    … …  
    218221      ! CRisi
    219222      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot)
    220       INTEGER ifils,iq2 ! CRisi
     223      INTEGER ichld,iq2 ! CRisi
     224      TYPE(tra), POINTER :: tr
    221225
    222226      Logical first,testcpu
    … …  
    238242         first=.false.
    239243      ENDIF
     244
     245      tr => tracers(iq)
    240246
    241247c   calcul de la pente a droite et a gauche de la maille
    … …  
    485491      !write(*,*) 'vlspltqs 326: iq,nqfils(iq)=',iq,nqfils(iq)
    486492     
    487       if (nqfils(iq).gt.0) then 
    488        do ifils=1,nqdesc(iq)
    489          iq2=iqfils(ifils,iq)
     493      if (tr%ndesc > 0) then
     494       do ichld=1,tr%ndesc
     495         iq2=tr%idesc(ichld)
    490496         DO l=1,llm
    491497          DO ij=iip2,ip1jm
    … …  
    495501          enddo   
    496502         enddo
    497         enddo !do ifils=1,nqdesc(iq)
    498         do ifils=1,nqfils(iq)
    499          iq2=iqfils(ifils,iq)
     503        enddo !do ichld=1,nqdesc(iq)
     504        do ichld=1,tr%nchld
     505         iq2=tr%idesc(ichld)
    500506         call vlx(Ratio,pente_max,masseq,u_mq,iq2)
    501         enddo !do ifils=1,nqfils(iq)
    502       endif !if (nqfils(iq).gt.0) then
     507        enddo !do ichld=1,tr%nchld
     508      endif !if (tr%ndesc > 0)
    503509! end CRisi
    504510
    … …  
    523529      ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
    524530      ! puis on boucle en longitude
    525       if (nqdesc(iq).gt.0) then 
    526        do ifils=1,nqdesc(iq)
    527          iq2=iqfils(ifils,iq) 
     531      if (tr%ndesc > 0) then
     532       do ichld=1,tr%ndesc
     533         iq2=tr%idesc(ichld)
    528534         DO l=1,llm
    529535          DO ij=iip2+1,ip1jm
    … …  
    534540          enddo ! DO ij=ijb+iip1-1,ije,iip1
    535541         enddo !DO l=1,llm
    536         enddo !do ifils=1,nqdesc(iq)
    537       endif !if (nqfils(iq).gt.0) then
     542        enddo !do ichld=1,tr%ndesc
     543      endif !if (tr%ndesc > 0)
    538544
    539545c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
    … …  
    544550      END
    545551      SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat,iq)
    546       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     552      USE infotrac, ONLY : nqtot, tracers, tra ! CRisi
    547553c
    548554c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    598604
    599605      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) ! CRisi
    600       INTEGER ifils,iq2 ! CRisi
     606      INTEGER ichld,iq2 ! CRisi
     607      TYPE(tra), POINTER :: tr
    601608c
    602609c
    … …  
    623630      ENDIF
    624631
     632      tr => tracers(iq)
    625633c
    626634
    … …  
    796804      !write(*,*) 'vlyqs 689: iq,nqfils(iq)=',iq,nqfils(iq)
    797805   
    798       if (nqfils(iq).gt.0) then 
    799        do ifils=1,nqdesc(iq)
    800          iq2=iqfils(ifils,iq)
     806      if (tr%ndesc > 0) then
     807       do ichld=1,tr%ndesc
     808         iq2=tr%idesc(ichld)
    801809         DO l=1,llm
    802810         DO ij=1,ip1jmp1
    … …  
    805813          enddo   
    806814         enddo
    807         enddo !do ifils=1,nqdesc(iq)
    808 
    809         do ifils=1,nqfils(iq)
    810          iq2=iqfils(ifils,iq)
     815        enddo !do ichld=1,tr%ndesc
     816
     817        do ichld=1,tr%nchld
     818         iq2=tr%idesc(ichld)
    811819         !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2
    812820         call vly(Ratio,pente_max,masseq,qbyv,iq2)
    813         enddo !do ifils=1,nqfils(iq)
    814       endif !if (nqfils(iq).gt.0) then
     821        enddo !do ichld=1,tr%nchld
     822      endif !if (tr%ndesc > 0)
    815823
    816824      DO l=1,llm
    … …  
    868876
    869877! retablir les fils en rapport de melange par rapport a l'air:
    870       if (nqdesc(iq).gt.0) then 
    871        do ifils=1,nqdesc(iq)
    872          iq2=iqfils(ifils,iq) 
     878      if (tr%ndesc > 0) then
     879       do ichld=1,tr%ndesc
     880         iq2=tr%idesc(ichld)
    873881         DO l=1,llm
    874882          DO ij=1,ip1jmp1
    … …  
    876884          enddo
    877885         enddo
    878         enddo !do ifils=1,nqdesc(iq)
    879       endif !if (nqfils(iq).gt.0) then
     886        enddo !do ichld=1,tr%ndesc
     887      endif !if (tr%ndesc > 0)
    880888      !write(*,*) 'vly 879'
    881889
Note: See TracChangeset for help on using the changeset viewer.