Changeset 4067

Timestamp:

Jan 27, 2022, 8:47:29 PM (2 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.

Location:

LMDZ6/trunk/libf

Files:

• dyn3d_common/infotrac.F90 (modified) (8 diffs)
• misc/readTracFiles_mod.f90 (modified) (3 diffs)
• misc/strings_mod.F90 (modified) (3 diffs)
• phylmd/physiq_mod.F90 (modified) (1 diff)

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

LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

@@ -15 +15 @@
 
   PUBLIC :: known_phases, old_phases, nphases, phases_names, &       !--- VARIABLES RELATED TO THE PHASES
-            phases_sep, delPhase, addPhase                           !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
+            phases_sep, delPhase, addPhase, &                        !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
+            old2newPhase, new2oldPhase
 
   PUBLIC :: tran0, idxAncestor, ancestor                             !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
@@ -1255 +1256 @@
   CHARACTER(LEN=*), INTENT(IN) :: s
   INTEGER :: l, i, ix
+  CHARACTER(LEN=maxlen) :: sh, st
   out = s
   IF(s == '') RETURN                                                           !--- Empty string: nothing to do
 
   !--- Special case: old phases for water, no phases separator
-  IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == s)) THEN; out='H2O'; RETURN; END IF
+  i = INDEX(s,'_'); sh = s; IF(i/=0) sh=s(1:i-1); st='H2O'; IF(i/=0) st='H2O_'//s(i+1:LEN_TRIM(s))
+  IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == sh)) THEN; out=st; RETURN; END IF
 
   !--- Index of found phase in "known_phases"
@@ -1300 +1303 @@
 !------------------------------------------------------------------------------------------------------------------------------
 
+CHARACTER(LEN=1) FUNCTION old2newPhase(op) RESULT(np)
+  CHARACTER(LEN=1), INTENT(IN) :: op
+  np = known_phases(INDEX(old_phases,op):INDEX(old_phases,op))
+END FUNCTION old2newPhase
+
+CHARACTER(LEN=1) FUNCTION new2oldPhase(np) RESULT(op)
+  CHARACTER(LEN=1), INTENT(IN) :: np
+  op = old_phases(INDEX(known_phases,np):INDEX(known_phases,np))
+END FUNCTION new2oldPhase
 
 !==============================================================================================================================

LMDZ6/trunk/libf/misc/strings_mod.F90

@@ -5 +5 @@
   PRIVATE
   PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level
-  PUBLIC :: strLower, strHead, strStack,  strClean,  strIdx,  strCount, strReplace
-  PUBLIC :: strUpper, strTail, strStackm, strReduce, strFind, strParse, cat, find
+  PUBLIC :: strLower, strHead, strStack,  strReduce,  strClean, strFind,  strIdx, find
+  PUBLIC :: strUpper, strTail, strStackm, strReducef, strParse, strCount, strReplace, cat
   PUBLIC :: dispTable, dispOutliers, dispNameList
   PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
@@ -343 +343 @@
 !=== strReduce_2(str1,str2): Append str1 with new elements of str2. ===========================================================
 !==============================================================================================================================
-SUBROUTINE strReduce_1(str1, nb)
-  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str1(:)
+SUBROUTINE strReduce_1(str, nb)
+  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
   INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
   CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
-  INTEGER :: k, n, n1
-  IF(PRESENT(nb)) nb = 0
-  CALL MOVE_ALLOC(FROM = str1, TO = s1); CALL strClean(s1)
-  n1 = SIZE(s1, DIM=1)                                     !--- Total nb of  elements in "s1"
-  n  = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] )       !--- Nb of unique elements in "s1"
-  ALLOCATE(str1(n)); IF(n==0) RETURN; str1(1) = s1(1)
-  n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str1(n)=s1(k); END DO
+  INTEGER :: n
+  s1 = strReducef(str, n); CALL MOVE_ALLOC(FROM=s1, TO=str)
   IF(PRESENT(nb)) nb = n
 END SUBROUTINE strReduce_1
@@ -375 +370 @@
   END IF
 END SUBROUTINE strReduce_2
+!==============================================================================================================================
+FUNCTION strReducef(str_in, nb) RESULT(str_ou)
+  CHARACTER(LEN=*),           INTENT(IN)  :: str_in(:)
+  INTEGER,          OPTIONAL, INTENT(OUT) :: nb
+  CHARACTER(LEN=LEN(str_in)), ALLOCATABLE :: str_ou(:)
+  CHARACTER(LEN=LEN(str_in)), ALLOCATABLE :: s1(:)
+  INTEGER :: k, n, n1
+  IF(PRESENT(nb)) nb = 0
+  s1 = str_in; CALL strClean(s1)
+  n1 = SIZE(s1, DIM=1)                                     !--- Total nb of  elements in "s1"
+  n  = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] )       !--- Nb of unique elements in "s1"
+  ALLOCATE(str_ou(n)); IF(n==0) RETURN; str_ou(1) = s1(1)
+  n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str_ou(n)=s1(k); END DO
+  IF(PRESENT(nb)) nb = n
+END FUNCTION strReducef
 !==============================================================================================================================
 

LMDZ6/trunk/libf/phylmd/physiq_mod.F90

@@ -2270 +2270 @@
        itr = 0
        DO iq = 1, nqtot
-         IF(tracers(iq)%isH2Ofamily) CYCLE
+         IF(tracers(iq)%isH2Ofamily .OR. .NOT.tracers(iq)%isAdvected) CYCLE
          itr = itr+1
           DO  k = 1, klev