Changeset 4363
- Timestamp:
- Dec 1, 2022, 6:56:48 PM (2 years ago)
- Location:
- LMDZ6/trunk/libf/misc
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/misc/readTracFiles_mod.f90
r4358 r4363 185 185 LOGICAL, OPTIONAL, INTENT(IN) :: lRepr !--- Activate the HNNO3 exceptions for REPROBUS 186 186 CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:) 187 CHARACTER(LEN=maxlen) :: str, fname, mesg,tname, pname, cname187 CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname 188 188 INTEGER :: nsec, ierr, it, ntrac, ns, ip, ix, fType 189 LOGICAL, ALLOCATABLE :: ll(:), lGen3(:)190 189 LOGICAL :: lRep 191 190 TYPE(keys_type), POINTER :: k … … 194 193 modname = 'readTracersFiles' 195 194 IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0)) 196 lRep= 0; IF(PRESENT(lRepr)) lRep = lRepr195 lRep=.FALSE.; IF(PRESENT(lRepr)) lRep = lRepr 197 196 198 197 !--- Required sections + corresponding files names (new style single section case) for tests … … 338 337 INTEGER, ALLOCATABLE :: ndb(:) !--- Number of sections for each file 339 338 INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list 340 LOGICAL, ALLOCATABLE :: lTg(:) !--- Tagging tracers mask341 339 CHARACTER(LEN=maxlen) :: fnm, snm 342 340 INTEGER :: idb, i … … 378 376 CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:) 379 377 INTEGER, ALLOCATABLE :: ix(:) 380 INTEGER :: n0, idb, ndb , i, j378 INTEGER :: n0, idb, ndb 381 379 LOGICAL :: ll 382 380 !------------------------------------------------------------------------------------------------------------------------------ … … 512 510 TYPE(trac_type), ALLOCATABLE :: ttr(:) 513 511 CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:) 514 CHARACTER(LEN=maxlen) :: msg1, modname , tname, cname , pname515 INTEGER :: it, nt, iq, nq, jq, itr, ntr, ipr, npr, i512 CHARACTER(LEN=maxlen) :: msg1, modname 513 INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr 516 514 LOGICAL :: ll 517 515 modname = 'expandSection' … … 686 684 INTEGER, ALLOCATABLE :: i0(:) 687 685 CHARACTER(LEN=maxlen) :: nam, pha, tname 688 CHARACTER(LEN=maxlen), allocatable :: ph(:)689 686 CHARACTER(LEN=1) :: p 690 687 INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n … … 756 753 INTEGER, ALLOCATABLE :: iy(:), iz(:) 757 754 INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k 758 INTEGER :: it759 755 ! tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler 760 756 !------------------------------------------------------------------------------------------------------------------------------ … … 869 865 TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:) 870 866 TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:) 871 TYPE(trac_type), POINTER :: t 1(:), t2(:)867 TYPE(trac_type), POINTER :: t(:) 872 868 INTEGER, ALLOCATABLE :: nt(:) 873 869 CHARACTER(LEN=maxlen) :: tnam, tnam_new … … 880 876 DO is=1, nsec !=== LOOP ON SECTIONS 881 877 !---------------------------------------------------------------------------------------------------------------------------- 882 t 1=> sections(is)%trac(:)878 t => sections(is)%trac(:) 883 879 !-------------------------------------------------------------------------------------------------------------------------- 884 880 DO iq=1, nt(is) !=== LOOP ON TRACERS 885 881 !-------------------------------------------------------------------------------------------------------------------------- 886 tnam = TRIM(t 1(iq)%name)!--- Original name887 IF(COUNT(t 1%name == tnam) == 1) CYCLE!--- Current tracer is not duplicated: finished882 tnam = TRIM(t(iq)%name) !--- Original name 883 IF(COUNT(t%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished 888 884 tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name) !--- Same with section extension 889 885 nq = SUM(nt(1:is-1)) !--- Number of tracers in previous sections … … 999 995 SUBROUTINE indexUpdate(tr) 1000 996 TYPE(trac_type), INTENT(INOUT) :: tr(:) 1001 INTEGER :: iq, ig, ng,igen, ngen, ix(SIZE(tr))997 INTEGER :: iq, ig, igen, ngen, ix(SIZE(tr)) 1002 998 tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent ) !--- Parent index 1003 999 DO iq = 1, SIZE(tr); CALL addKey_1('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO … … 1039 1035 CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name 1040 1036 TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %parent must be defined!) 1041 INTEGER :: ik, is, it, idb, nk0, i, iis 1042 INTEGER :: nk, ns, nt, ndb, nb0, i0 1043 CHARACTER(LEN=maxlen), POINTER :: k(:), v(:), k0(:), v0(:) 1037 INTEGER :: is, iis, it, idb, ndb, nb0 1044 1038 CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:) 1045 CHARACTER(LEN=maxlen) :: val, modname 1046 TYPE(keys_type), POINTER :: ky(:) 1039 CHARACTER(LEN=maxlen) :: modname 1047 1040 TYPE(trac_type), POINTER :: tt(:), t 1048 1041 TYPE(dataBase_type), ALLOCATABLE :: tdb(:) … … 1489 1482 !------------------------------------------------------------------------------------------------------------------------------ 1490 1483 TYPE(keys_type), POINTER :: keys(:) 1491 LOGICAL :: lk, lt, li , ll1484 LOGICAL :: lk, lt, li 1492 1485 INTEGER :: iq, nq 1493 1486 … … 1574 1567 IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN 1575 1568 END DO 1569 IF(PRESENT(nam)) nam = names(:) 1576 1570 END FUNCTION getKeyByName_im 1577 1571 !============================================================================================================================== … … 1664 1658 !------------------------------------------------------------------------------------------------------------------------------ 1665 1659 CHARACTER(LEN=maxlen) :: sval 1666 INTEGER :: ierr1667 1660 lerr = getKeyByName_s1(keyn, sval, tname, ky) 1668 1661 IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN … … 1678 1671 !------------------------------------------------------------------------------------------------------------------------------ 1679 1672 CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) 1680 INTEGER :: i err, iq, nq1673 INTEGER :: iq, nq 1681 1674 IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN 1682 1675 nq = SIZE(sval); ALLOCATE(val(nq)) … … 1693 1686 !------------------------------------------------------------------------------------------------------------------------------ 1694 1687 CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) 1695 INTEGER :: i err, iq, nq1688 INTEGER :: iq, nq 1696 1689 IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN 1697 1690 nq = SIZE(sval); ALLOCATE(val(nq)) … … 1707 1700 !------------------------------------------------------------------------------------------------------------------------------ 1708 1701 CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) 1709 INTEGER :: i err, iq, nq1702 INTEGER :: iq, nq 1710 1703 IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN 1711 1704 nq = SIZE(sval); ALLOCATE(val(nq)) … … 1888 1881 INTEGER, OPTIONAL, INTENT(OUT) :: iPhase 1889 1882 !------------------------------------------------------------------------------------------------------------------------------ 1890 CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)1891 1883 INTEGER :: ix, ip 1892 1884 CHARACTER(LEN=maxlen) :: var -
LMDZ6/trunk/libf/misc/strings_mod.F90
r4358 r4363 49 49 SUBROUTINE init_printout(lunout_, prt_level_) 50 50 INTEGER, INTENT(IN) :: lunout_, prt_level_ 51 lunout = lunout_ 51 lunout = lunout_ 52 prt_level = prt_level_ 52 53 END SUBROUTINE init_printout 53 54 !============================================================================================================================== … … 457 458 LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Care about nbs with front sign or in scient. notation 458 459 !------------------------------------------------------------------------------------------------------------------------------ 459 INTEGER :: idx0 !--- Used to display an identified non-numeric string 460 INTEGER, ALLOCATABLE :: ii(:) 461 LOGICAL :: ll, ls 462 CHARACTER(LEN=maxlen) :: d 460 INTEGER :: idx0 !--- Used to display an identified non-numeric string 463 461 lerr = .FALSE. 464 462 idx = strIdx1(rawList, del, ibeg, idel) !--- idx/=0: del(idel) is at position "idx" in "rawList" … … 681 679 LOGICAL, OPTIONAL, INTENT(IN) :: lsurr !--- TRUE => key must be surrounded by special characters to be substituted 682 680 !------------------------------------------------------------------------------------------------------------------------------ 683 CHARACTER(LEN=1024) :: s, t684 681 INTEGER :: i0, ix, nk, ns 685 682 LOGICAL :: lsur, lb, le … … 1181 1178 CHARACTER(LEN=maxlen) :: mes, sub, fm='(f12.9)', prf 1182 1179 CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), vnm(:) 1183 LOGICAL, ALLOCATABLE :: m(:)1184 1180 INTEGER, ALLOCATABLE :: ki(:), kj(:), kl(:) 1185 INTEGER :: i, j, k, rk, ib, ie, itr, nm, nv, unt, nRmx, nCmx, nHd, rk11181 INTEGER :: i, j, k, rk, nv, unt, nRmx, nCmx, nHd 1186 1182 REAL, ALLOCATABLE :: val(:,:) 1187 1183 … … 1199 1195 lerr= SIZE(a,1) /= PRODUCT(n); IF(fmsg('profile "n" does not match "a" and "ll"', sub, lerr, unt)) RETURN 1200 1196 1201 SELECT CASE(rk 1) !--- Indices list1197 SELECT CASE(rk) !--- Indices list 1202 1198 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 1203 1199 CASE(1); ki = [ (i,i=1,n(1)) ]
Note: See TracChangeset
for help on using the changeset viewer.