Changeset 20 for readTracFiles_mod.f90

Timestamp:

Jul 4, 2022, 11:49:29 PM (2 years ago)

Author:

dcugnet

Message:

• Modifications in readSections to allow a continuation line character "\": in both "tracer.def" and "isotopes_params.def", information for a single tracer or isotope can now be stored on several lines.
• Modifications in "dispTable" and associated routines to allow too wide tables to be displayed as several shorter sub-tables: each sub-table is at most "nMaxCol" characters wide (typically: number of characters displayable in a tandard screen window) and the first "nHead" columns (typically: name, index, etc.) are duplicated in each sub-table. A default value for nMaxCol, called maxTableWidth (currently = 192) is available in readTracFiles_mod.
• Subroutine "readIsotopesFile" becomes a function with a boolean returned error value "lerr" used to trigger an external aborting function (no STOP).

File:

• readTracFiles_mod.f90 (modified) (10 diffs)

readTracFiles_mod.f90

@@ -21 +21 @@
 
   PUBLIC :: tran0, idxAncestor, ancestor                             !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
+  PUBLIC :: maxTableWidth
 !------------------------------------------------------------------------------------------------------------------------------
   TYPE :: dataBase_type                                              !=== TYPE FOR TRACERS SECTION
@@ -59 +60 @@
   CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO ']
 
-
   !=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
   TYPE(trac_type), ALLOCATABLE, TARGET, SAVE ::  tracers(:)
   TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
 
+  INTEGER,    PARAMETER :: maxTableWidth = 192                       !--- Maximum width of a table displayed with "dispTable"
   CHARACTER(LEN=maxlen) :: modname
 
@@ -267 +268 @@
   TYPE(trac_type),       ALLOCATABLE :: tt(:)
   TYPE(trac_type)       :: tmp
-  CHARACTER(LEN=1024)   :: str
+  CHARACTER(LEN=1024)   :: str, str2
   CHARACTER(LEN=maxlen) :: secn
   INTEGER               :: ierr, n
@@ -273 +274 @@
   IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
   OPEN(90, FILE=fnam, FORM='formatted', STATUS='old')
-  DO; READ(90,'(a)', IOSTAT=ierr)str
+  DO; str=''
+    DO
+      READ(90,'(a)', IOSTAT=ierr)str2                                !--- Read a full line
+      str=TRIM(str)//' '//TRIM(str2)                                 !--- Append "str" with the current line
+      n=LEN_TRIM(str); IF(n == 0) EXIT                               !--- Empty line (probably end of file)
+      IF(IACHAR(str(n:n))  /= 92) EXIT                               !--- No "\" continuing line symbol found => end of line
+      str = str(1:n-1)                                               !--- Remove the "\" continuing line symbol
+    END DO
+    str = ADJUSTL(str)                                               !--- Remove the front space
     IF(ierr    /= 0 ) EXIT                                           !--- Finished: error or end of file
     IF(str(1:1)=='#') CYCLE                                          !--- Skip comments lines
@@ -777 +786 @@
   phas =         [(fgetKey(iq, 'phases',tm(:)%keys, 'g' ), iq=1, nq)]
   CALL msg(TRIM(message)//':', modname)
-  IF(tm(1)%parent == '') THEN
-    IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '], cat(tm%name, phas), cat([(iq, iq=1, nq)], &
-                                            hadv,    vadv),                 sub=modname), lerr)) RETURN
+  IF(ALL(tm(:)%parent == '')) THEN
+    IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '], cat(tm%name, phas), &
+                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
   ELSE
     IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, tm%parent, &
-           tm%phase), cat([(iq, iq=1, nq)], hadv,    vadv, tm%iGeneration), sub=modname), lerr)) RETURN
+      tm%phase), cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
   END IF
 END FUNCTION dispTraSection
@@ -933 +942 @@
   CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
 
-  lerr = dispIsotopes(isot, 'Isotopes parameters read from file', modname)
+  lerr = dispIsotopes(isot, 'Isotopes parameters read from file "'//TRIM(fnam)//'"', modname)
 
 END FUNCTION readIsotopesFile
@@ -945 +954 @@
 !===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
 !==============================================================================================================================
-SUBROUTINE initIsotopes(trac, isot)
+LOGICAL FUNCTION initIsotopes(trac, isot) RESULT(lerr)
   TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: trac(:)
   TYPE(isot_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:)
@@ -955 +964 @@
   TYPE(trac_type), POINTER   ::  t(:), t1
   TYPE(isot_type), POINTER   ::  i
+  lerr = .FALSE.
 
   t => trac
@@ -1019 +1029 @@
   !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
   !    DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat AND alpha_ideal)
-  IF(readIsotopesFile('isotopes_params.def',isot)) CALL abort_gcm(modname,'Problem when reading isotopes parameters',1)
-
-END SUBROUTINE initIsotopes
+  lerr = readIsotopesFile('isotopes_params.def',isot)
+
+END FUNCTION initIsotopes
 !==============================================================================================================================
 
@@ -1046 +1056 @@
       END DO
     END DO
-    IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)',     &
-       sub=modname)), lerr)) RETURN
+    IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
+            cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
     DEALLOCATE(ttl, val)
   END DO