Changeset 4064


Ignore:
Timestamp:
Jan 25, 2022, 7:14:39 PM (2 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.

Location:
LMDZ6/trunk/libf
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/advtrac.F90

    r4056 r4064  
    4343   !     Variables locales
    4444   !---------------------------------------------------------------------------
    45    INTEGER :: ij, l, iq, iiq, iadv
    46    REAL(KIND=KIND(1.d0)) :: t_initial, t_final, tps_cpu
     45   INTEGER :: ij, l, iq, iadv
     46!   REAL(KIND=KIND(1.d0)) :: t_initial, t_final, tps_cpu
    4747   REAL :: zdp(ip1jmp1), zdpmin, zdpmax
    4848   INTEGER, SAVE :: iadvtr=0

  • LMDZ6/trunk/libf/dyn3d/dynetat0.f90

    r4063 r4064  
    162162    s1='value of '//TRIM(str1)//' ='
    163163    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
    164     WRITE(msg,'(10x,a,i4,2x,a,i4)'),TRIM(ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2
     164    WRITE(msg,'(10x,a,i4,2x,a,i4)')TRIM(ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2
    165165    CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
    166166  END IF
    … …  
    203203    CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
    204204  END SELECT
    205   CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
     205  CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
    206206END SUBROUTINE err
    207207

  • LMDZ6/trunk/libf/dyn3d/dynredem.F90

    r4063 r4064  
    1313                    NF90_64BIT_OFFSET
    1414  USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil
    15   USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, &
    16                               nivsig,nivsigs
     15  USE comvert_mod,  ONLY: ap, bp, presnivs, pa, preff, nivsig, nivsigs
    1716  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, kappa, omeg, rad
    1817  USE logic_mod, ONLY: fxyhypb, ysinus
    … …  
    3534!===============================================================================
    3635! Local variables:
    37   INTEGER :: iq, l
     36  INTEGER :: iq
    3837  INTEGER, PARAMETER :: length=100
    3938  REAL    :: tab_cntrl(length)                     !--- RUN PARAMETERS TABLE
    … …  
    4241  INTEGER :: indexID
    4342  INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID
    44   INTEGER :: sID, sigID, nID, vID, timID
     43  INTEGER :: sID, sigID, nID, timID
    4544  INTEGER :: yyears0, jjour0, mmois0
    46   REAL    :: zan0, zjulian, hours
     45  REAL    :: zjulian, hours
    4746!===============================================================================
    4847  modname='dynredem0'; fil=fichnom
    … …  
    139138
    140139!--- Define fields saved later
    141   WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
     140  WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')") &
    142141               yyears0,mmois0,jjour0
    143142  CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
    … …  
    194193!===============================================================================
    195194! Local variables:
    196   INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
     195  INTEGER :: iq, nid, vID, ierr, nid_trac, vID_trac
    197196  INTEGER, SAVE :: nb=0
    198197  INTEGER, PARAMETER :: length=100

  • LMDZ6/trunk/libf/dyn3d/vlsplt.F

    r4052 r4064  
    3838c   ---------
    3939c
    40       INTEGER i,ij,l,j,ii
    41       INTEGER ijlqmin,iqmin,jqmin,lqmin
    42 c
    43       REAL zm(ip1jmp1,llm,nqtot),newmasse
     40      INTEGER ij,l
     41c
     42      REAL zm(ip1jmp1,llm,nqtot)
    4443      REAL mu(ip1jmp1,llm)
    4544      REAL mv(ip1jm,llm)
    4645      REAL mw(ip1jmp1,llm+1)
    47       REAL zq(ip1jmp1,llm,nqtot),zz
    48       REAL dqx(ip1jmp1,llm),dqy(ip1jmp1,llm),dqz(ip1jmp1,llm)
    49       REAL second,temps0,temps1,temps2,temps3
    50       REAL ztemps1,ztemps2,ztemps3
     46      REAL zq(ip1jmp1,llm,nqtot)
    5147      REAL zzpbar, zzw
    52       LOGICAL testcpu
    53       SAVE testcpu
    54       SAVE temps1,temps2,temps3
    55       INTEGER iminn,imaxx
    5648      INTEGER ifils,iq2 ! CRisi
    5749
    5850      REAL qmin,qmax
    5951      DATA qmin,qmax/0.,1.e33/
    60       DATA testcpu/.false./
    61       DATA temps1,temps2,temps3/0.,0.,0./
    62 
    6352
    6453        zzpbar = 0.5 * pdt
    … …  
    157146c   ----------
    158147      REAL masse(ip1jmp1,llm,nqtot),pente_max
    159       REAL u_m( ip1jmp1,llm ),pbarv( iip1,jjm,llm)
     148      REAL u_m( ip1jmp1,llm )
    160149      REAL q(ip1jmp1,llm,nqtot)
    161       REAL w(ip1jmp1,llm)
    162150      INTEGER iq ! CRisi
    163151c
    … …  
    169157c
    170158      REAL new_m,zu_m,zdum(ip1jmp1,llm)
    171       REAL sigu(ip1jmp1),dxq(ip1jmp1,llm),dxqu(ip1jmp1)
     159c      REAL sigu(ip1jmp1)
     160      REAL dxq(ip1jmp1,llm),dxqu(ip1jmp1)
    172161      REAL zz(ip1jmp1)
    173162      REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
    … …  
    178167      INTEGER ifils,iq2 ! CRisi
    179168
    180       Logical extremum,first,testcpu
    181       SAVE first,testcpu
    182 
    183       REAL      SSUM
    184       REAL temps0,temps1,temps2,temps3,temps4,temps5,second
    185       SAVE temps0,temps1,temps2,temps3,temps4,temps5
    186 
    187       REAL z1,z2,z3
    188 
    189       DATA first,testcpu/.true.,.false./
    190 
    191       IF(first) THEN
    192          temps1=0.
    193          temps2=0.
    194          temps3=0.
    195          temps4=0.
    196          temps5=0.
    197          first=.false.
    198       ENDIF
     169      Logical first
     170      SAVE first
     171      DATA first/.true./
    199172
    200173c   calcul de la pente a droite et a gauche de la maille
    … …  
    432405         ENDDO
    433406      ENDIF  ! n0.gt.0
    434 9999    continue
     407c9999    continue
    435408
    436409
    … …  
    536509      REAL masse(ip1jmp1,llm,nqtot),pente_max
    537510      REAL masse_adv_v( ip1jm,llm)
    538       REAL q(ip1jmp1,llm,nqtot), dq( ip1jmp1,llm)
     511      REAL q(ip1jmp1,llm,nqtot)
    539512      INTEGER iq ! CRisi
    540513c
    … …  
    545518c
    546519      REAL airej2,airejjm,airescb(iim),airesch(iim)
    547       REAL dyq(ip1jmp1,llm),dyqv(ip1jm),zdvm(ip1jmp1,llm)
     520      REAL dyq(ip1jmp1,llm),dyqv(ip1jm)
    548521      REAL adyqv(ip1jm),dyqmax(ip1jmp1)
    549522      REAL qbyv(ip1jm,llm)
    550523
    551       REAL qpns,qpsn,appn,apps,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
     524      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
     525c     REAL appn apps
    552526c     REAL newq,oldmasse
    553       Logical extremum,first,testcpu
    554       REAL temps0,temps1,temps2,temps3,temps4,temps5,second
    555       SAVE temps0,temps1,temps2,temps3,temps4,temps5
    556       SAVE first,testcpu
     527      LOGICAL first
     528      SAVE first
    557529
    558530      REAL convpn,convps,convmpn,convmps
    … …  
    570542      REAL      SSUM
    571543
    572       DATA first,testcpu/.true.,.false./
    573       DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
     544      DATA first/.true./
    574545
    575546      !write(*,*) 'vly 578: entree, iq=',iq
    … …  
    905876c   ---------
    906877c
    907       INTEGER i,ij,l,j,ii
     878      INTEGER ij,l
    908879c
    909880      REAL wq(ip1jmp1,llm+1),newmasse
    … …  
    918889      SAVE testcpu
    919890
    920       REAL temps0,temps1,temps2,temps3,temps4,temps5,second
    921       SAVE temps0,temps1,temps2,temps3,temps4,temps5
    922       REAL      SSUM
     891#ifdef BIDON
     892      REAL temps0,temps1,second
     893      SAVE temps0,temps1
    923894
    924895      DATA testcpu/.false./
    925       DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
     896      DATA temps0,temps1/0.,0./
     897#endif
    926898
    927899c    On oriente tout dans le sens de la pression c'est a dire dans le
    … …  
    10831055      real zzq(iip1,jjp1,llm)
    10841056
     1057#ifdef isminmax
    10851058      integer imin,jmin,lmin,ijlmin
    10861059      integer imax,jmax,lmax,ijlmax
    … …  
    10881061      integer ismin,ismax
    10891062
    1090 #ifdef isminismax
    10911063      call scopy (ip1jmp1*llm,zq,1,zzq,1)
    10921064
    … …  
    11161088#endif
    11171089      return
    1118 9999  format(a20,'  q(',i3,',',i2,',',i2,')=',e12.5,e12.5)
     1090c9999  format(a20,'  q(',i3,',',i2,',',i2,')=',e12.5,e12.5)
    11191091      end
    11201092

  • 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.

  • LMDZ6/trunk/libf/dyn3dmem/advtrac_loc.F90

    r4058 r4064  
    4949   !     Variables locales
    5050   !---------------------------------------------------------------------------
    51    INTEGER :: ij, l, iq, iiq, iadv
     51   INTEGER :: ij, l, iq, iadv
    5252   REAL(KIND=KIND(1.d0)) :: t_initial, t_final, tps_cpu
    5353   REAL :: zdp(ijb_u:ije_u), zdpmin, zdpmax
Note: See TracChangeset for help on using the changeset viewer.