Changeset 4067 for LMDZ6/trunk/libf/dyn3d_common

Timestamp:

Jan 27, 2022, 8:47:29 PM (3 years ago)

Author:

dcugnet

Message:

Fixes mainly for isotopes (more to be done).
Fix (to be confirmed) in physiq to avoid attempting to send a non-transported (iadv==0) tracer to the physics.

File:

• LMDZ6/trunk/libf/dyn3d_common/infotrac.F90 (modified) (8 diffs)

LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

@@ -3 +3 @@
 MODULE infotrac
 
-   USE       strings_mod, ONLY: msg, find, strIdx,  strFind, strParse, dispTable, int2str,  reduceExpr,  &
-                          cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile
+   USE       strings_mod, ONLY: msg, find, strIdx,  strFind, strParse, dispTable,  int2str,  reduceExpr, &
+                          cat, fmsg, test, strTail, strHead, strStack, strReducef, bool2str, maxlen, testFile
    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, addPhase,  phases_sep,  nphases, ancestor,  &
                                 isot_type, readIsotopesFile, delPhase,   old_phases, getKey_init, tran0, &
-                                keys_type, initIsotopes,  indexUpdate, known_phases, getKey, setGeneration
+                                keys_type, initIsotopes,  indexUpdate, known_phases, getKey, setGeneration, &
+                                new2oldPhase
 
    IMPLICIT NONE
@@ -225 +226 @@
    descrq(30)    =  'PRA'
     
-   CALL msg('type_trac='//TRIM(type_trac), modname)
+   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
    IF(lOldCode) THEN
       str = [type_trac]; nt = 1
@@ -377 +378 @@
    tracers(:)%phase     = 'g'
    tracers(:)%component = type_trac
-   DO ip = 1, nphases
-      p = old_phases(ip:ip)
-      iq = strIdx(tracers(:)%name, 'H2O'//p)
-      IF(iq /= 0) CYCLE
-      tracers(iq)%phase = p
+   DO iq = 1, nqtrue
       IF(lINCA) tracers(iq)%component = 'lmdz'
+      ip = strIdx([('H2O'//old_phases(ix:ix), ix=1, nphases)], strHead(tracers(iq)%name,'_'))
+      IF(ip == 0) CYCLE
+      tracers(iq)%phase = known_phases(ip:ip)
    END DO
    IF(lINCA) tracers(1+nqo:nqCO2+nqo)%component = 'co2i'
    CALL setGeneration(tracers)                                       !--- SET FIELDS %iGeneration, %gen0Name
-
 ! manque "type"
 
@@ -709 +708 @@
    IMPLICIT NONE
    CHARACTER(LEN=3)      :: tnom_iso(niso_possibles)
-   INTEGER, ALLOCATABLE  :: nb_iso(:,:), nb_traciso(:,:)
-   INTEGER               :: ii, ip, iq, it, iz, ixt, nb_isoind, nzone_prec
+   INTEGER, ALLOCATABLE  :: nb_iso(:,:), nb_traciso(:,:), nb_isoind(:)
+   INTEGER               :: ii, ip, iq, it, iz, ixt, nzone_prec
    TYPE(isot_type), POINTER :: i
    TYPE(trac_type), POINTER :: t(:)
    CHARACTER(LEN=maxlen)    :: tnom_trac
    CHARACTER(LEN=maxlen), ALLOCATABLE :: str(:)
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: mask
    INCLUDE "iniprint.h"
 
@@ -723 +723 @@
    ALLOCATE(indnum_fn_num(niso_possibles))
    ALLOCATE(iso_indnum(nqtot))
+   ALLOCATE(nb_isoind(nqo))
 
    iso_indnum   (:) = 0
@@ -729 +730 @@
    nb_iso     (:,:) = 0  
    nb_traciso (:,:) = 0
+   nb_isoind    (:) = 0
 
    DO iq=1, nqtot
       IF(delPhase(tracers(iq)%name) == 'H2O' .OR. .NOT.tracers(iq)%isAdvected) CYCLE
 outer:DO ip = 1, nqo
-         nb_isoind = 0
          DO ixt= 1,niso_possibles
             tnom_trac = 'H2O'//old_phases(ip:ip)//'_'//TRIM(tnom_iso(ixt))
             IF (tracers(iq)%name == tnom_trac) THEN
                nb_iso(ixt,ip)         = nb_iso(ixt,ip)+1
-               nb_isoind              = nb_isoind+1
+               nb_isoind (ip)         = nb_isoind (ip)+1
                tracers(iq)%type       = 'tracer'
                tracers(iq)%iso_iGroup = 1
                tracers(iq)%iso_iName  = ixt
-               iso_indnum(iq)         = nb_isoind
+               iso_indnum(iq)         = nb_isoind(ip)
                indnum_fn_num(ixt)     = iso_indnum(iq)
                tracers(iq)%iso_iPhase = ip
@@ -748 +749 @@
             ELSE IF(tracers(iq)%iqParent> 0) THEN
                IF(tracers(tracers(iq)%iqParent)%name == tnom_trac) THEN
-                  nb_traciso(ixt,ip)  = nb_traciso(ixt,ip)+1
+                  nb_traciso(ixt,ip)     = nb_traciso(ixt,ip)+1
                   iso_indnum(iq)         = indnum_fn_num(ixt)
-                  tracers(iq)%type    = 'tag'
+                  tracers(iq)%type       = 'tag'
                   tracers(iq)%iso_iGroup = 1
                   tracers(iq)%iso_iName  = ixt
@@ -814 +815 @@
    ALLOCATE(isotopes(1))                                             !--- Only water
    nbIso = 1
+   t => tracers
    i => isotopes(1)
-   t => tracers
-   str = PACK(delPhase(t%name), MASK = t%type=='tracer' .AND. delPhase(t%parent) == 'H2O' .AND. t%phase == 'g')
    i%parent = 'H2O'
-   i%niso  = SIZE(str)
+
+   !--- Isotopes names list (embedded in the "keys" field)
+   i%niso  = niso
+   ALLOCATE(i%keys(i%niso))
+   mask = t%type=='tracer' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%phase == 'g' .AND. t%iGeneration==1
+   i%keys(:)%name = strReducef(strTail(PACK(delPhase(t%name), MASK = mask), '_'))
+
+   !--- Full isotopes list, with isotopes tagging tracers (if any) following the previous list
+   i%ntiso = ntiso; ALLOCATE(i%trac(i%ntiso))
+   mask = t%type=='tag'    .AND. delPhase(t%gen0Name)=='H2O' .AND. t%phase == 'g' .AND. t%iGeneration==2
+   i%trac(:) = [i%keys(:)%name, strReducef(PACK(delPhase(t%name), MASK = mask))]
+
+   !--- Tagging zones names list
    i%nzone = nzone
+   i%zone = strTail(str, '_', .TRUE.)
+
+   !--- Effective phases list
    i%nphas = nqo
-   FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
-   i%zone = PACK(strTail(t%name,'_',.TRUE.), MASK = t%type=='tag' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%iGeneration==3)
-   CALL strReduce(i%zone)
-   i%phase = strStack([(known_phases(ip:ip), ip=1, nphases)], MASK=[(strIdx(t%name,addPhase('H2O',known_phases(ip:ip)))/=0)])
-   i%iTraPha = RESHAPE([((strIdx(t(:)%name,addPhase(i%trac(it),i%phase(ip:ip))) ,it=1,i%ntiso),ip=1,i%nphas)],[i%ntiso,i%nphas])
+   i%phase = ''
+   DO ip=1,nphases; IF(strIdx(t%name, addPhase('H2O',old_phases(ip:ip),''))/=0) i%phase=TRIM(i%phase)//known_phases(ip:ip); END DO
+
+   !--- Table: index in "qx" of an isotope, knowing its indices "it","ip" in "isotope%iName,%iPhase"
+   i%iTraPha = RESHAPE([((strIdx(t%name, TRIM(addPhase('H2O', new2oldPhase(i%phase(ip:ip)), ''))//'_'//TRIM(i%trac(it))), &
+                          it=1,i%ntiso), ip=1,i%nphas)], [i%ntiso,i%nphas])
+
+   !--- Table: index in "isotope%tracs(:)%name" of an isotopic tagging tracer, knowing its indices "iz","ip" in "isotope%iZone,%iName"
    i%iZonIso = RESHAPE([((strIdx(i%trac,TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))),iz=1,i%nzone),it=1,i%niso )],[i%nzone,i%niso ])
    DO it=1,ntiso