Index: LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 =================================================================== --- LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 (revision 4362) +++ LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 (revision 4363) @@ -185,7 +185,6 @@ LOGICAL, OPTIONAL, INTENT(IN) :: lRepr !--- Activate the HNNO3 exceptions for REPROBUS CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:) - CHARACTER(LEN=maxlen) :: str, fname, mesg, tname, pname, cname + CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname INTEGER :: nsec, ierr, it, ntrac, ns, ip, ix, fType - LOGICAL, ALLOCATABLE :: ll(:), lGen3(:) LOGICAL :: lRep TYPE(keys_type), POINTER :: k @@ -194,5 +193,5 @@ modname = 'readTracersFiles' IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0)) - lRep=0; IF(PRESENT(lRepr)) lRep = lRepr + lRep=.FALSE.; IF(PRESENT(lRepr)) lRep = lRepr !--- Required sections + corresponding files names (new style single section case) for tests @@ -338,5 +337,4 @@ INTEGER, ALLOCATABLE :: ndb(:) !--- Number of sections for each file INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list - LOGICAL, ALLOCATABLE :: lTg(:) !--- Tagging tracers mask CHARACTER(LEN=maxlen) :: fnm, snm INTEGER :: idb, i @@ -378,5 +376,5 @@ CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:) INTEGER, ALLOCATABLE :: ix(:) - INTEGER :: n0, idb, ndb, i, j + INTEGER :: n0, idb, ndb LOGICAL :: ll !------------------------------------------------------------------------------------------------------------------------------ @@ -512,6 +510,6 @@ TYPE(trac_type), ALLOCATABLE :: ttr(:) CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:) - CHARACTER(LEN=maxlen) :: msg1, modname, tname, cname , pname - INTEGER :: it, nt, iq, nq, jq, itr, ntr, ipr, npr, i + CHARACTER(LEN=maxlen) :: msg1, modname + INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr LOGICAL :: ll modname = 'expandSection' @@ -686,5 +684,4 @@ INTEGER, ALLOCATABLE :: i0(:) CHARACTER(LEN=maxlen) :: nam, pha, tname - CHARACTER(LEN=maxlen), allocatable :: ph(:) CHARACTER(LEN=1) :: p INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n @@ -756,5 +753,4 @@ INTEGER, ALLOCATABLE :: iy(:), iz(:) INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k - INTEGER :: it ! tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler !------------------------------------------------------------------------------------------------------------------------------ @@ -869,5 +865,5 @@ TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:) TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:) - TYPE(trac_type), POINTER :: t1(:), t2(:) + TYPE(trac_type), POINTER :: t(:) INTEGER, ALLOCATABLE :: nt(:) CHARACTER(LEN=maxlen) :: tnam, tnam_new @@ -880,10 +876,10 @@ DO is=1, nsec !=== LOOP ON SECTIONS !---------------------------------------------------------------------------------------------------------------------------- - t1 => sections(is)%trac(:) + t => sections(is)%trac(:) !-------------------------------------------------------------------------------------------------------------------------- DO iq=1, nt(is) !=== LOOP ON TRACERS !-------------------------------------------------------------------------------------------------------------------------- - tnam = TRIM(t1(iq)%name) !--- Original name - IF(COUNT(t1%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished + tnam = TRIM(t(iq)%name) !--- Original name + IF(COUNT(t%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name) !--- Same with section extension nq = SUM(nt(1:is-1)) !--- Number of tracers in previous sections @@ -999,5 +995,5 @@ SUBROUTINE indexUpdate(tr) TYPE(trac_type), INTENT(INOUT) :: tr(:) - INTEGER :: iq, ig, ng, igen, ngen, ix(SIZE(tr)) + INTEGER :: iq, ig, igen, ngen, ix(SIZE(tr)) tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent ) !--- Parent index DO iq = 1, SIZE(tr); CALL addKey_1('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO @@ -1039,10 +1035,7 @@ CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %parent must be defined!) - INTEGER :: ik, is, it, idb, nk0, i, iis - INTEGER :: nk, ns, nt, ndb, nb0, i0 - CHARACTER(LEN=maxlen), POINTER :: k(:), v(:), k0(:), v0(:) + INTEGER :: is, iis, it, idb, ndb, nb0 CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:) - CHARACTER(LEN=maxlen) :: val, modname - TYPE(keys_type), POINTER :: ky(:) + CHARACTER(LEN=maxlen) :: modname TYPE(trac_type), POINTER :: tt(:), t TYPE(dataBase_type), ALLOCATABLE :: tdb(:) @@ -1489,5 +1482,5 @@ !------------------------------------------------------------------------------------------------------------------------------ TYPE(keys_type), POINTER :: keys(:) - LOGICAL :: lk, lt, li, ll + LOGICAL :: lk, lt, li INTEGER :: iq, nq @@ -1574,4 +1567,5 @@ IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN END DO + IF(PRESENT(nam)) nam = names(:) END FUNCTION getKeyByName_im !============================================================================================================================== @@ -1664,5 +1658,4 @@ !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen) :: sval - INTEGER :: ierr lerr = getKeyByName_s1(keyn, sval, tname, ky) IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN @@ -1678,5 +1671,5 @@ !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) - INTEGER :: ierr, iq, nq + INTEGER :: iq, nq IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN nq = SIZE(sval); ALLOCATE(val(nq)) @@ -1693,5 +1686,5 @@ !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) - INTEGER :: ierr, iq, nq + INTEGER :: iq, nq IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN nq = SIZE(sval); ALLOCATE(val(nq)) @@ -1707,5 +1700,5 @@ !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) - INTEGER :: ierr, iq, nq + INTEGER :: iq, nq IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN nq = SIZE(sval); ALLOCATE(val(nq)) @@ -1888,5 +1881,4 @@ INTEGER, OPTIONAL, INTENT(OUT) :: iPhase !------------------------------------------------------------------------------------------------------------------------------ - CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:) INTEGER :: ix, ip CHARACTER(LEN=maxlen) :: var Index: LMDZ6/trunk/libf/misc/strings_mod.F90 =================================================================== --- LMDZ6/trunk/libf/misc/strings_mod.F90 (revision 4362) +++ LMDZ6/trunk/libf/misc/strings_mod.F90 (revision 4363) @@ -49,5 +49,6 @@ SUBROUTINE init_printout(lunout_, prt_level_) INTEGER, INTENT(IN) :: lunout_, prt_level_ - lunout = lunout_ + lunout = lunout_ + prt_level = prt_level_ END SUBROUTINE init_printout !============================================================================================================================== @@ -457,8 +458,5 @@ LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Care about nbs with front sign or in scient. notation !------------------------------------------------------------------------------------------------------------------------------ - INTEGER :: idx0 !--- Used to display an identified non-numeric string - INTEGER, ALLOCATABLE :: ii(:) - LOGICAL :: ll, ls - CHARACTER(LEN=maxlen) :: d + INTEGER :: idx0 !--- Used to display an identified non-numeric string lerr = .FALSE. idx = strIdx1(rawList, del, ibeg, idel) !--- idx/=0: del(idel) is at position "idx" in "rawList" @@ -681,5 +679,4 @@ LOGICAL, OPTIONAL, INTENT(IN) :: lsurr !--- TRUE => key must be surrounded by special characters to be substituted !------------------------------------------------------------------------------------------------------------------------------ - CHARACTER(LEN=1024) :: s, t INTEGER :: i0, ix, nk, ns LOGICAL :: lsur, lb, le @@ -1181,7 +1178,6 @@ CHARACTER(LEN=maxlen) :: mes, sub, fm='(f12.9)', prf CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), vnm(:) - LOGICAL, ALLOCATABLE :: m(:) INTEGER, ALLOCATABLE :: ki(:), kj(:), kl(:) - INTEGER :: i, j, k, rk, ib, ie, itr, nm, nv, unt, nRmx, nCmx, nHd, rk1 + INTEGER :: i, j, k, rk, nv, unt, nRmx, nCmx, nHd REAL, ALLOCATABLE :: val(:,:) @@ -1199,5 +1195,5 @@ lerr= SIZE(a,1) /= PRODUCT(n); IF(fmsg('profile "n" does not match "a" and "ll"', sub, lerr, unt)) RETURN - SELECT CASE(rk1) !--- Indices list + SELECT CASE(rk) !--- Indices list CASE(0); IF(ll(1)) THEN; WRITE(unt,'(a,", ",a," = ",2f12.9)')TRIM(vnm(1)),TRIM(vnm(2)),a(1,1),a(1,2); RETURN; END IF CASE(1); ki = [ (i,i=1,n(1)) ]