Ignore:
Timestamp:
Jan 25, 2022, 7:14:39 PM (3 years ago)
Author:
dcugnet
Message:
  • minor fixes (unused variables suppressed, comas after a WRITE() statement, etc.)
  • parser routines taken from version 7 of ​https://svn.lmd.jussieu.fr/tracers-parser
  • few changes in infotrac, and few fixes of (at least) the sequential version:
    • uadv and vadv were deallocated twice (fix was lost by mistake just before last commit)
    • in [( dum(im), im=1, nm)] implicit loops, ifort evaluates "dum(im)" even if nm==0,

resulting in a crash, "im" being unitialized.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

    r4063 r4064  
    1 ! $Id$
     1!$Id$
    22!
    33MODULE infotrac
    44
    5    USE       strings_mod, ONLY: msg, find, strIdx,  strFind, strParse, dispTable, int2str, reduceExpr,   &
    6                                fmsg, test, strTail, strHead, strStack, strReduce, maxlen,  testFile, cat
     5   USE       strings_mod, ONLY: msg, find, strIdx,  strFind, strParse, dispTable, int2str,  reduceExpr,  &
     6                          cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile
    77   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, addPhase,  phases_sep,  nphases, ancestor,  &
    88                                isot_type, readIsotopesFile, delPhase,   old_phases, getKey_init, tran0, &
    … …  
    140140   !--- Aliases for older names
    141141   INTEGER, POINTER, SAVE :: ntraciso, ntraceurs_zone
    142    REAL,    POINTER, SAVE :: qperemin, masseqmin, ratiomin
     142   REAL,            SAVE :: qperemin, masseqmin, ratiomin
    143143
    144144! CRisi: cas particulier des isotopes
    … …  
    189189!------------------------------------------------------------------------------------------------------------------------------
    190190! Local variables
    191    INTEGER, ALLOCATABLE :: &
    192                   hadv(:), had(:), hadv_inca(:), conv_flg_inca(:), & !--- Horizontal/vertical transport scheme number
    193                   vadv(:), vad(:), vadv_inca(:),  pbl_flg_inca(:)    !---   + specific variables for INCA
     191   INTEGER, ALLOCATABLE :: hadv(:), vadv(:)                          !--- Horizontal/vertical transport scheme number
     192#ifdef INCA
     193   INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
     194                           vad (:), vadv_inca(:),  pbl_flg_inca(:)
    194195   CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA
     196   INTEGER :: nqINCA
     197#endif
    195198   CHARACTER(LEN=2)      ::   suff(9)                                !--- Suffixes for schemes of order 3 or 4 (Prather)
    196199   CHARACTER(LEN=3)      :: descrq(30)                               !--- Advection scheme description tags
    197    CHARACTER(LEN=maxlen) :: oldH2O, newH2O                           !--- Old and new water names
    198    CHARACTER(LEN=maxlen) :: msg1, msg2                               !--- Strings for messages
     200   CHARACTER(LEN=maxlen) :: msg1                                     !--- String for messages
    199201   CHARACTER(LEN=maxlen), ALLOCATABLE :: str(:)                      !--- Temporary storage
    200202   INTEGER :: fType                                                  !--- Tracers description file type ; 0: none
    … …  
    206208   CHARACTER(LEN=1) :: p
    207209   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    208    TYPE(trac_type), POINTER             :: t1, tp, t(:)
     210   TYPE(trac_type), POINTER             :: t1, t(:)
    209211   TYPE(isot_type), POINTER             :: iso
    210212
    211213   CHARACTER(LEN=maxlen), ALLOCATABLE :: tnom_0(:), tnom_transp(:)        !--- Tracer short name + transporting fluid name
    212214   CHARACTER(LEN=maxlen)              :: tchaine
    213    INTEGER :: ierr, nqINCA
     215   INTEGER :: ierr
    214216   LOGICAL :: lINCA
    215217
    … …  
    523525      IF(iad == 20) nm = 3                                             !--- 2nd order scheme
    524526      IF(iad == 30) nm = 9                                             !--- 3rd order scheme
     527      IF(nm == 0) CYCLE                                                !--- No higher moments
    525528      ttr(jq+1:jq+nm)             = t1
    526529      ttr(jq+1:jq+nm)%name        = [(TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
    … …  
    564567
    565568   CALL infotrac_setHeredity                !--- SET FIELDS %iqParent, %nqChilds, %iGeneration, %gen0Name, %iqDescen, %nqDescen
    566    CALL infotrac_isoinit(tnom_0, nqtrue)    !--- SET FIELDS %type, %iso_iName, %iso_iZone, %iso_iPhase
     569   CALL infotrac_isoinit                    !--- SET FIELDS %type, %iso_iName, %iso_iZone, %iso_iPhase
    567570   CALL getKey_init(tracers, isotopes)
    568571   IF(isoSelect('H2O')) RETURN                                    !--- Select water isotopes ; finished if no water isotopes
    … …  
    579582
    580583   !--- Finalize :
    581    DEALLOCATE(tnom_0, hadv, vadv, tnom_transp)
     584   DEALLOCATE(tnom_0, tnom_transp)
    582585
    583586ELSE
    … …  
    618621   t => tracers
    619622   CALL msg('Information stored in infotrac :')
    620    IF(dispTable('issssiii', ['iq      ', 'name    ', 'longName', 'gen0Name', 'parent  ', 'iadv    ', 'iqParent', 'iGenerat'], &
    621                 cat(t%name, t%longName, t%gen0Name, t%parent), cat([(iq, iq=1, nqtot)], t%iadv, t%iqParent, t%iGeneration)))  &
     623   IF(dispTable('isssssssssiiiiiiiii', &
     624      ['iq      ', 'name    ', 'longN.  ', 'gen0N.  ', 'parent  ', 'type    ', 'phase   ', 'compon. ', 'isAdv.  ', 'isH2O.  '&
     625      ,'iadv    ', 'iGen.   ', 'iqPar.  ', 'nqDes.  ', 'nqChil. ', 'iso_iG. ', 'iso_iN. ', 'iso_iZ. ', 'iso_iP. '],          &
     626      cat(t%name,  t%longName,  t%gen0Name,  t%parent,  t%type,  t%phase, &
     627          t%component, bool2str(t%isAdvected), bool2str(t%isH2Ofamily)),  &
     628      cat([(iq, iq=1, nqtot)],  t%iadv,  t%iGeneration, t%iqParent, t%nqDescen, &
     629         t%nqChilds, t%iso_iGroup, t%iso_iName, t%iso_iZone, t%iso_iPhase))) &
    622630      CALL abort_gcm(modname, "problem with the tracers table content", 1)
    623631
    624632   !--- Some aliases to be removed later
    625    ntraciso       => iso%ntiso
    626    ntraceurs_zone => iso%nzone
     633   ntraciso       => isotope%ntiso
     634   ntraceurs_zone => isotope%nzone
    627635   qperemin       =  min_qParent
    628636   masseqmin      =  min_qMass
    … …  
    664672   CALL msg('nqChilds = '//strStack(int2str(tracers(:)%nqChilds)),     modname)
    665673   CALL msg('iqParent = '//strStack(int2str(tracers(:)%iqParent)),     modname)
    666    WRITE(lunout,*)TRIM(modname)//': iqfils = ',iqfils
     674   CALL msg('iqChilds = '//strStack(int2str(PACK(iqfils,MASK=.TRUE.))),modname)
    667675
    668676   !=== SET FIELDS %iGeneration, %iqDescen, %nqDescen
    … …  
    686694   CALL msg('nqDescen = '//TRIM(strStack(int2str(tracers(:)%nqDescen))), modname)
    687695   CALL msg('nqDescen_tot = ' //TRIM(int2str(SUM(tracers(:)%nqDescen))), modname)
    688    WRITE(lunout,*)TRIM(modname)//': iqfils = ',iqfils
     696   CALL msg('iqChilds = '//strStack(int2str(PACK(iqfils, MASK=.TRUE.))), modname)
    689697
    690698END SUBROUTINE infotrac_setHeredity
    … …  
    692700
    693701
    694 SUBROUTINE infotrac_isoinit(tnom_0, nqtrue)
     702SUBROUTINE infotrac_isoinit
    695703
    696704#ifdef CPP_IOIPSL
    … …  
    700708#endif
    701709   IMPLICIT NONE
    702    INTEGER,          INTENT(IN) :: nqtrue
    703    CHARACTER(LEN=*), INTENT(IN) :: tnom_0(nqtrue)
    704710   CHARACTER(LEN=3)      :: tnom_iso(niso_possibles)
    705711   INTEGER, ALLOCATABLE  :: nb_iso(:,:), nb_traciso(:,:)
    706    INTEGER               :: ii, ip, iq, it, iz, ixt, n, nb_isoind, nzone_prec
     712   INTEGER               :: ii, ip, iq, it, iz, ixt, nb_isoind, nzone_prec
    707713   TYPE(isot_type), POINTER :: i
    708714   TYPE(trac_type), POINTER :: t(:)
    709    CHARACTER(LEN=1)         :: p
    710715   CHARACTER(LEN=maxlen)    :: tnom_trac
    711716   CHARACTER(LEN=maxlen), ALLOCATABLE :: str(:)
    … …  
    718723   ALLOCATE(indnum_fn_num(niso_possibles))
    719724   ALLOCATE(iso_indnum(nqtot))
    720      
     725
    721726   iso_indnum   (:) = 0
    722727   use_iso      (:) = .FALSE.
Note: See TracChangeset for help on using the changeset viewer.