Ignore:
Timestamp:
Jan 23, 2023, 11:28:51 AM (17 months ago)
Author:
dcugnet
Message:
  • revert to original "type_trac" management:
    • 4 characters keyword (lmdz, Inca, repr, co2i, into, aeNP, coag
    • no longer a list of component with "|" separator
    • the parsed (with "|" separator) version "types_trac" is no longer used
    • the sole routine using a list of component is readTracFiles
  • fix for INCA and CO2Aer modes: setGeneration is now a function, index corrections for had/vadv.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

    r4367 r4389  
    179179!     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
    180180!==============================================================================================================================
    181 LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, lRepr) RESULT(lerr)
     181LOGICAL FUNCTION readTracersFiles(type_trac, lRepr) RESULT(lerr)
    182182!------------------------------------------------------------------------------------------------------------------------------
    183183  CHARACTER(LEN=*),  INTENT(IN)  :: type_trac                        !--- List of components used
    184   INTEGER, OPTIONAL, INTENT(OUT) :: fTyp                             !--- Type of input file found
    185184  LOGICAL, OPTIONAL, INTENT(IN)  :: lRepr                            !--- Activate the HNNO3 exceptions for REPROBUS
    186185  CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
     
    196195
    197196  !--- Required sections + corresponding files names (new style single section case) for tests
    198   IF(test(testTracersFiles(modname, type_trac, fType, .TRUE., trac_files, sections), lerr)) RETURN
    199   IF(PRESENT(fTyp)) fTyp = fType
     197  IF(test(testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections), lerr)) RETURN
    200198  nsec = SIZE(sections)
    201199
     
    290288  CHARACTER(LEN=*),                             INTENT(IN)  :: modname, type_trac
    291289  INTEGER,                                      INTENT(OUT) :: fType
    292   LOGICAL,                                      INTENT(IN)  :: lDisp
     290  LOGICAL,                            OPTIONAL, INTENT(IN)  :: lDisp
    293291  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
    294292  CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
    295293  LOGICAL, ALLOCATABLE :: ll(:)
     294  LOGICAL :: lD
    296295  INTEGER :: is, nsec
    297 
    298   !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINNGLE SECTION PER FILE)
     296  lD = .FALSE.; IF(PRESENT(lDisp)) lD = lDisp
     297  lerr = .FALSE.
     298
     299  !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
     300  !--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
    299301  IF(test(strParse(type_trac, '|', sections,  n=nsec), lerr)) RETURN !--- Parse "type_trac" list
    300302  IF(PRESENT(sects)) sects = sections
    301303  ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
    302304  IF(PRESENT(tracf)) tracf = trac_files
    303 
    304   nsec = SIZE(trac_files, DIM=1)
    305305  ll = .NOT.testFile(trac_files)
    306306  fType = 0
    307   IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1           !--- OLD STYLE FILE
    308   IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
    309   IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
    310   IF(.NOT.test(lDisp, lerr)) RETURN                                  !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
     307  IF(.NOT.testFile('traceur.def')) fType = 1                         !--- OLD STYLE FILE
     308  IF(.NOT.testFile('tracer.def'))  fType = 2                         !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
     309  IF(ALL(ll))                      fType = 3                         !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
     310  IF(.NOT.lD) RETURN                                                 !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
    311311  IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
    312312    IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
    313313  END IF
    314 
    315   !--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
    316   IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = nsec>1 .AND. fType==1), lerr)) RETURN
    317314
    318315  !--- TELLS WHAT WAS IS ABOUT TO BE USED
Note: See TracChangeset for help on using the changeset viewer.