Changeset 12 for readTracFiles_mod.f90

Timestamp:

Feb 4, 2022, 3:39:33 PM (3 years ago)

Author:

dcugnet

Message:

• Fix in sortTracers
• New version of the addPhase routine taking the phase index as a second argument instead of the phase itself.

File:

• readTracFiles_mod.f90 (modified) (14 diffs)

readTracFiles_mod.f90

@@ -33 +33 @@
   INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m; END INTERFACE idxAncestor
   INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m; END INTERFACE    ancestor
-  INTERFACE    addPhase;   MODULE PROCEDURE    addPhase_1,    addPhase_m; END INTERFACE    addPhase
+  INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
 !------------------------------------------------------------------------------------------------------------------------------
 
@@ -152 +152 @@
       CLOSE(90)
       DO ip = 1, nphases                                             !--- Deal with old water names
-        oldH2O = 'H2O'//old_phases(ip:ip)
-        newH2O = 'H2O'//phases_sep//known_phases(ip:ip)
+        oldH2O = addPhase('H2O', ip, '')
+        newH2O = addPhase('H2O', ip)
         ix = strIdx(tracs(:)%name, oldH2O)
         IF(ix == 0) CYCLE
@@ -565 +565 @@
         trn=TRIM(tr(iq)%name); nam=trn                               !--- Tracer name (regular case)
         IF(lTg) nam = TRIM(tr(iq)%parent)                            !--- Parent name (tagging case)
-        IF(lEx) nam = TRIM(nam)//phases_sep//pha(ip:ip)              !--- Phase extension needed
+        IF(lEx) nam = addPhase(nam, ip)                              !--- Phase extension needed
         IF(lTg) nam = TRIM(nam)//'_'//TRIM(trn)                      !--- <parent>_<name> for tags
         ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
@@ -572 +572 @@
         ttr(it)%phase = pha(ip:ip)                                   !--- Single phase entry
         IF(lEx.AND.tr(iq)%iGeneration>1) THEN
-          ttr(it)%parent   = TRIM(ttr(it)%parent)//phases_sep//pha(ip:ip)
-          ttr(it)%gen0Name = TRIM(ttr(it)%gen0Name)//phases_sep//pha(ip:ip)
+          ttr(it)%parent   = addPhase(ttr(it)%parent,   ip)          !--- Modify parent name
+          ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, ip)          !--- Modify generation 0 ancestor name
         END IF
         it=it+1
@@ -602 +602 @@
   iy = [(k, k=1, nq)]
   DO ip = nphases, 1, -1
-    iq = strIdx(tracers(:)%name, 'H2O'//phases_sep//known_phases(ip:ip))
-    IF(iq/=0) iy = [iq, iy(1:iq-1), iy(iq:nq)]
+    iq = strIdx(tr(:)%name, addPhase('H2O', ip))
+    IF(iq/=0) iy = [iq, iy(1:iq-1), iy(iq+1:nq)]
   END DO
   tr = tr(iy)                                                        !--- Water displaces at first positions
@@ -724 +724 @@
       tnam = TRIM(t1(iq)%name)                                       !--- Original name
       IF(COUNT(t1%name == tnam) == 1) CYCLE                          !--- Current tracer is not duplicated: finished
-      tnam_new = TRIM(tnam)//phases_sep//TRIM(sections(is)%name)     !--- Same with section extension
+      tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name)            !--- Same with section extension
       nq = SUM(nt(1:is-1))                                           !--- Number of tracers in previous sections
       ns = nt(is)                                                    !--- Number of tracers in the current section
@@ -1154 +1154 @@
   lerr = .FALSE.
   IF(PRESENT(ky)) THEN
-    val = getKeyByName_prv(keyn, tname , ky);    IF(val /= '') RETURN          !--- "ky" and "tnam"
+    val = getKeyByName_prv(keyn, tname, ky);              IF(val /= '') RETURN !--- "ky" and "tnam"
     val = getKeyByName_prv(keyn, delPhase(strHead(tname,'_')), ky)             !--- "ky" and "tnam" without phase
   ELSE
@@ -1186 +1186 @@
   CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tnam(:)
   TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::   ky(:)
-  CHARACTER(LEN=maxlen),    POINTER :: n(:)
+  TYPE(keys_type),       POINTER :: k(:)
+  CHARACTER(LEN=maxlen), POINTER :: n(:)
   INTEGER :: iq
-  n => tracers(:)%keys%name; IF(PRESENT(tnam)) n => tnam(:)
+  k => tracers(:)%keys; IF(PRESENT(ky  )) k => ky
+  n => k(:)%name;       IF(PRESENT(tnam)) n => tnam
   ALLOCATE(val(SIZE(n)))
-  IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), n(iq), ky), iq=1, SIZE(n))])
-  IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), n(iq)),     iq=1, SIZE(n))])
+  lerr = ANY([(getKeyByName_s1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
 END FUNCTION getKeyByName_sm
 !==============================================================================================================================
@@ -1213 +1214 @@
   CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tnam(:)
   TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::   ky(:)
+  TYPE(keys_type),       POINTER :: k(:)
   CHARACTER(LEN=maxlen), POINTER :: n(:)
   INTEGER :: iq
-  n => tracers(:)%name; IF(PRESENT(tnam)) n => tnam(:)
+  k => tracers(:)%keys; IF(PRESENT(ky  )) k => ky
+  n => k(:)%name;       IF(PRESENT(tnam)) n => tnam
   ALLOCATE(val(SIZE(n)))
-  IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), n(iq), ky), iq=1, SIZE(n))])
-  IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), n(iq)),     iq=1, SIZE(n))])
+  lerr = ANY([(getKeyByName_i1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
 END FUNCTION getKeyByName_im
 !==============================================================================================================================
@@ -1240 +1242 @@
   CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tnam(:)
   TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::   ky(:)
+  TYPE(keys_type),       POINTER :: k(:)
   CHARACTER(LEN=maxlen), POINTER :: n(:)
   INTEGER :: iq
-  n => tracers(:)%name;  IF(PRESENT(tnam)) n => tnam(:)
+  k => tracers(:)%keys; IF(PRESENT(ky  )) k => ky
+  n => k(:)%name;       IF(PRESENT(tnam)) n => tnam
   ALLOCATE(val(SIZE(n)))
-  IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), n(iq), ky), iq=1, SIZE(n))])
-  IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), n(iq)),     iq=1, SIZE(n))])
+  lerr = ANY([(getKeyByName_r1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
 END FUNCTION getKeyByName_rm
 !==============================================================================================================================
@@ -1276 +1279 @@
 END FUNCTION delPhase
 !------------------------------------------------------------------------------------------------------------------------------
-CHARACTER(LEN=maxlen) FUNCTION addPhase_1(s,pha,ph_sep) RESULT(out)
+CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha,ph_sep) RESULT(out)
   CHARACTER(LEN=*),           INTENT(IN) :: s
   CHARACTER(LEN=1),           INTENT(IN) :: pha
@@ -1289 +1292 @@
   IF(i == 0) out =  TRIM(s)//TRIM(psep)//pha                                   !--- <var>       => return <var><sep><pha>
   IF(i /= 0) out = s(1:i-1)//TRIM(psep)//pha//'_'//s(i+1:l)                    !--- <var>_<tag> => return <var><sep><pha>_<tag>
-END FUNCTION addPhase_1
-!------------------------------------------------------------------------------------------------------------------------------
-FUNCTION addPhase_m(s,pha,ph_sep) RESULT(out)
+END FUNCTION addPhase_s1
+!------------------------------------------------------------------------------------------------------------------------------
+FUNCTION addPhase_sm(s,pha,ph_sep) RESULT(out)
   CHARACTER(LEN=*),           INTENT(IN) :: s(:)
   CHARACTER(LEN=1),           INTENT(IN) :: pha
@@ -1299 +1302 @@
   INTEGER :: k
   psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
-  out = [( addPhase_1(s(k), pha, psep), k=1, SIZE(s) )]
-END FUNCTION addPhase_m
+  out = [( addPhase_s1(s(k), pha, psep), k=1, SIZE(s) )]
+END FUNCTION addPhase_sm
+!------------------------------------------------------------------------------------------------------------------------------
+CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,ph_sep) RESULT(out)
+  CHARACTER(LEN=*),           INTENT(IN) :: s
+  INTEGER,                    INTENT(IN) :: ipha
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
+  CHARACTER(LEN=1) :: psep
+  out = s
+  IF(s == '') RETURN                                                           !--- Empty string: nothing to do
+  psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
+  IF(psep == '') out = addPhase_s1(s,   old_phases(ipha:ipha), psep)
+  IF(psep /= '') out = addPhase_s1(s, known_phases(ipha:ipha), psep)
+END FUNCTION addPhase_i1
+!------------------------------------------------------------------------------------------------------------------------------
+FUNCTION addPhase_im(s,ipha,ph_sep) RESULT(out)
+  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
+  INTEGER,                    INTENT(IN) :: ipha
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
+  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
+  CHARACTER(LEN=1) :: psep
+  INTEGER :: k
+  psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
+  out = [( addPhase_i1(s(k), ipha, psep), k=1, SIZE(s) )]
+END FUNCTION addPhase_im
 !------------------------------------------------------------------------------------------------------------------------------
 
@@ -1372 +1398 @@
 
 END MODULE readTracFiles_mod
-