Changeset 4403
- Timestamp:
- Jan 30, 2023, 9:27:31 PM (16 months ago)
- Location:
- LMDZ6/trunk/libf
- Files:
-
- 6 edited
-
dyn3d_common/infotrac.F90 (modified) (1 diff)
-
misc/readTracFiles_mod.f90 (modified) (6 diffs)
-
misc/strings_mod.F90 (modified) (1 diff)
-
phylmd/infotrac_phy.F90 (modified) (1 diff)
-
phylmdiso/isotopes_routines_mod.F90 (modified) (2 diffs)
-
phylmdiso/isotrac_mod.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d_common/infotrac.F90
r4389 r4403 379 379 380 380 !=== DISPLAY THE RESULTS 381 IF(prt_level > 1) THEN 382 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 383 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 384 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 385 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 386 CALL msg('niso = '//TRIM(int2str(niso)), modname) 387 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 381 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 382 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 383 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 384 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 385 CALL msg('niso = '//TRIM(int2str(niso)), modname) 386 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 388 387 #ifdef INCA 389 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 390 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 391 #endif 392 END IF 388 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 389 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 390 #endif 393 391 t => tracers 394 392 CALL msg('Information stored in infotrac :', modname) -
LMDZ6/trunk/libf/misc/readTracFiles_mod.f90
r4400 r4403 1167 1167 !=== Geographic tagging tracers descending on tracer "iname": mask, names, number 1168 1168 ll = t(:)%type=='tag' .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2 1169 i%zone = PACK(strTail(t(:)%name,'_' ), MASK = ll)!--- Tagging zones names for isotopes category "iname"1169 i%zone = PACK(strTail(t(:)%name,'_',.TRUE.), MASK = ll) !--- Tagging zones names for isotopes category "iname" 1170 1170 CALL strReduce(i%zone) 1171 1171 i%nzone = SIZE(i%zone) !--- Tagging zones number for isotopes category "iname" … … 1190 1190 IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE !--- Only deal with tracers descending on "iname" 1191 1191 t1%iso_iGroup = ic !--- Isotopes family idx in list "isotopes(:)%parent" 1192 t1%iso_iName = strIdx(i%trac, delPhase(strHead(t1%name,'_'))) !--- Current isotope idx in effective isotopes list1193 t1%iso_iZone = strIdx(i%zone, strTail(t1%name, '_')) !--- Current isotope zone idx in effective zones list1192 t1%iso_iName = strIdx(i%trac, strHead(delPhase(t1%name),'_',.TRUE.)) !--- Current isotope idx in effective isotopes list 1193 t1%iso_iZone = strIdx(i%zone, strTail(t1%name, '_',.TRUE.)) !--- Current isotope zone idx in effective zones list 1194 1194 t1%iso_iPhase = INDEX(i%phase,TRIM(t1%phase)) !--- Current isotope phase idx in effective phases list 1195 1195 IF(t1%iGeneration /= 2) t1%iso_iZone = 0 !--- Skip possible generation 1 tagging tracers … … 1441 1441 !------------------------------------------------------------------------------------------------------------------------------ 1442 1442 CHARACTER(LEN=maxlen) :: tnam 1443 tnam = strHead(delPhase(tname),'_',. FALSE.) !--- Remove tag and phase1443 tnam = strHead(delPhase(tname),'_',.TRUE.) !--- Remove phase and tag 1444 1444 IF(PRESENT(ky)) THEN !=== KEY FROM "ky" 1445 1445 val = fgetKeyNam_s1(tname, keyn, ky, lerr=lerr) !--- "ky" and "tname" … … 1824 1824 !------------------------------------------------------------------------------------------------------------------------------ 1825 1825 INTEGER :: ip 1826 phase = TRIM(strHead(strTail(tname, phases_sep , .TRUE.), '_', .TRUE.))1826 phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.)) !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha> 1827 1827 IF( PRESENT(phases)) ip = INDEX( phases, phase) 1828 1828 IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase) … … 1854 1854 ELSE 1855 1855 ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list 1856 IF(ix /= 0) tmp(2) = newH2OIso(ix)!--- Move to new isotope name1857 IF(ip /= 0) tmp(2) = addPhase(tmp(2), ip)!--- Add phase to isotope name1858 newName = TRIM(strStack(tmp(2:nt), '_'))!=== WATER ISOTOPE OR TAGGING TRACER1856 IF(ix /= 0) newName = newH2OIso(ix) !--- Move to new isotope name 1857 IF(ip /= 0) newName = addPhase(newName, ip) !--- Add phase to isotope name 1858 IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3)) !=== WATER ISOTOPE OR TAGGING TRACER 1859 1859 END IF 1860 1860 END FUNCTION old2newH2O_1 … … 1881 1881 CHARACTER(LEN=maxlen) :: var 1882 1882 oldName = newName 1883 IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase1884 1883 ip = getiPhase(newName) !--- Phase index 1885 IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index 1886 ix = strIdx(newH2OIso, strHead(newName, '_')) !--- Index in the known H2O isotopes list 1887 IF(ix /= 0) THEN 1888 oldName = 'H2O'//'_'//TRIM(oldH2OIso(ix)) !=== WATER ISOTOPE WITHOUT PHASE 1889 IF(newH2OIso(ix)/=newName) oldName=TRIM(oldName)//'_'//strTail(newName,'_')!=== WATER ISOTOPIC TAGGING TRACER WITHOUT PHASE 1890 END IF 1891 IF(ix /= 0 .OR. ip == 0) RETURN 1892 oldName = 'H2O'//old_phases(ip:ip) 1893 IF(newName == addPhase('H2O', ip)) RETURN !=== WATER WITH PHASE 1894 var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Head variable name (no phase) 1884 IF(PRESENT(iPhase)) iPhase = MAX(ip, 1) !--- Return phase index ; default: 1 (gazeous) 1885 var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Variable without phase and tag 1895 1886 ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list 1896 IF(ix == 0) RETURN !=== H2O[vli]_<var> (<var> /= H2O isotope) 1897 oldName = TRIM(oldName)//'_'//TRIM(oldH2OIso(ix)) !=== WATER ISOTOPE WITH PHASE 1898 var = addPhase(var, ip) !--- Head variable with phase 1899 IF(newName /= var) oldName = TRIM(oldName)//strTail(newName, TRIM(var)) !=== WATER ISOTOPIC TAGGING TRACER 1887 IF(ix == 0 .AND. var /= 'H2O') RETURN !--- Neither H2O nor an H2O isotope => finished 1888 oldName = 'H2O' 1889 IF(ip /= 0) oldName = TRIM(oldName)//old_phases(ip:ip) !--- Add phase if needed 1890 IF(ix /= 0) oldName = TRIM(oldName)//'_'//oldH2OIso(ix) !--- H2O isotope name 1891 IF(newName /= addPhase(var, ip)) & 1892 oldName = TRIM(oldName)//strTail(newName, '_', .TRUE.) !--- Add the tag suffix 1893 IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_') !--- Isotope with no phase: remove 'H2O_' prefix 1900 1894 END FUNCTION new2oldH2O_1 1901 1895 !============================================================================================================================== -
LMDZ6/trunk/libf/misc/strings_mod.F90
r4363 r4403 194 194 195 195 !============================================================================================================================== 196 !=== Extract the substring in front of the last (first if lFirst==TRUE) occurrence of separator "sep" in "str"================196 !=== Extract the substring in front of the first (last if lBackward==TRUE) occurrence of "sep" in "str" ================ 197 197 !=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect: ================ 198 198 !=== * strHead(..,.FALSE.) = 'a' ${str%%$sep*} ================ 199 199 !=== * strHead(..,.TRUE.) = 'a_b' ${str%$sep*} ================ 200 200 !============================================================================================================================== 201 CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep,lFirst) RESULT(out)201 CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out) 202 202 CHARACTER(LEN=*), INTENT(IN) :: str 203 203 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 204 LOGICAL, OPTIONAL, INTENT(IN) :: lFirst 205 !------------------------------------------------------------------------------------------------------------------------------ 206 LOGICAL :: lf 207 lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst 204 LOGICAL, OPTIONAL, INTENT(IN) :: lBackward 205 !------------------------------------------------------------------------------------------------------------------------------ 208 206 IF(PRESENT(sep)) THEN 209 out = str(1:INDEX(str,sep,.NOT.lf)-1) 207 IF( PRESENT(lBackWard)) out = str(1:INDEX(str,sep,lBackWard)-1) 208 IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,sep)-1) 210 209 ELSE 211 out = str(1:INDEX(str,'/',.NOT.lf)-1) 210 IF( PRESENT(lBackWard)) out = str(1:INDEX(str,'/',lBackWard)-1) 211 IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,'/')-1) 212 212 END IF 213 213 IF(out == '') out = str 214 214 END FUNCTION strHead_1 215 215 !============================================================================================================================== 216 FUNCTION strHead_m(str, sep,lFirst) RESULT(out)216 FUNCTION strHead_m(str, sep, lBackward) RESULT(out) 217 217 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:) 218 218 CHARACTER(LEN=*), INTENT(IN) :: str(:) 219 219 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 220 LOGICAL, OPTIONAL, INTENT(IN) :: lFirst 221 !------------------------------------------------------------------------------------------------------------------------------ 222 LOGICAL :: lf 220 LOGICAL, OPTIONAL, INTENT(IN) :: lBackward 221 !------------------------------------------------------------------------------------------------------------------------------ 223 222 INTEGER :: k 224 lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst225 223 IF(PRESENT(sep)) THEN 226 out = [(strHead_1(str(k), sep, lf), k=1, SIZE(str))] 224 IF( PRESENT(lBackWard)) out = [(strHead_1(str(k), sep, lBackWard), k=1, SIZE(str))] 225 IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), sep), k=1, SIZE(str))] 227 226 ELSE 228 out = [(strHead_1(str(k), lFirst=lf), k=1, SIZE(str))] 227 IF( PRESENT(lBackWard)) out = [(strHead_1(str(k), '/', lBackWard), k=1, SIZE(str))] 228 IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), '/'), k=1, SIZE(str))] 229 229 END IF 230 230 END FUNCTION strHead_m 231 231 !============================================================================================================================== 232 !=== Extract the substring following the last (first if lFirst==TRUE) occurrence of separator "sep" in "str"================232 !=== Extract the substring following the first (last if lBackward==TRUE) occurrence of "sep" in "str" ================ 233 233 !=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect: ================ 234 !=== * strTail( ..,.FALSE.) = 'c' ${str#*$sep}================235 !=== * strTail( ..,.TRUE.) = 'b_c' ${str##*$sep}================236 !============================================================================================================================== 237 CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep,lFirst) RESULT(out)234 !=== * strTail(str, '_', .FALSE.) = 'b_c' ${str#*$sep} ================ 235 !=== * strTail(str, '_', .TRUE.) = 'c' ${str##*$sep} ================ 236 !============================================================================================================================== 237 CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out) 238 238 CHARACTER(LEN=*), INTENT(IN) :: str 239 239 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 240 LOGICAL, OPTIONAL, INTENT(IN) :: lFirst 241 !------------------------------------------------------------------------------------------------------------------------------ 242 LOGICAL :: lf 243 lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst 240 LOGICAL, OPTIONAL, INTENT(IN) :: lBackWard 241 !------------------------------------------------------------------------------------------------------------------------------ 244 242 IF(PRESENT(sep)) THEN 245 out = str(INDEX(str,sep,.NOT.lf)+LEN(sep):LEN_TRIM(str)) 243 IF( PRESENT(lBackWard)) out = str(INDEX(str,sep,lBackWard)+LEN(sep):LEN_TRIM(str)) 244 IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,sep) +LEN(sep):LEN_TRIM(str)) 246 245 ELSE 247 out = str(INDEX(str,'/',.NOT.lf)+1:LEN_TRIM(str)) 246 IF( PRESENT(lBackWard)) out = str(INDEX(str,'/',lBackWard)+1:LEN_TRIM(str)) 247 IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,'/') +1:LEN_TRIM(str)) 248 248 END IF 249 249 IF(out == '') out = str 250 250 END FUNCTION strTail_1 251 251 !============================================================================================================================== 252 FUNCTION strTail_m(str, sep,lFirst) RESULT(out)252 FUNCTION strTail_m(str, sep, lBackWard) RESULT(out) 253 253 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:) 254 254 CHARACTER(LEN=*), INTENT(IN) :: str(:) 255 255 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 256 LOGICAL, OPTIONAL, INTENT(IN) :: lFirst 257 !------------------------------------------------------------------------------------------------------------------------------ 258 LOGICAL :: lf 256 LOGICAL, OPTIONAL, INTENT(IN) :: lBackWard 257 !------------------------------------------------------------------------------------------------------------------------------ 259 258 INTEGER :: k 260 lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst261 259 IF(PRESENT(sep)) THEN 262 out = [(strTail_1(str(k), sep, lf), k=1, SIZE(str))] 260 IF( PRESENT(lBackWard)) out = [(strTail_1(str(k), sep, lBackWard), k=1, SIZE(str))] 261 IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), sep), k=1, SIZE(str))] 263 262 ELSE 264 out = [(strTail_1(str(k), lFirst=lf), k=1, SIZE(str))] 263 IF( PRESENT(lBackWard)) out = [(strTail_1(str(k), '/', lBackWard), k=1, SIZE(str))] 264 IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), '/'), k=1, SIZE(str))] 265 265 END IF 266 266 END FUNCTION strTail_m -
LMDZ6/trunk/libf/phylmd/infotrac_phy.F90
r4389 r4403 386 386 387 387 !=== DISPLAY THE RESULTS 388 ! IF(prt_level > 1) THEN 389 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 390 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 391 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 392 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 393 CALL msg('niso = '//TRIM(int2str(niso)), modname) 394 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 388 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 389 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 390 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 391 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 392 CALL msg('niso = '//TRIM(int2str(niso)), modname) 393 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 395 394 #ifdef INCA 396 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 397 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 398 #endif 399 ! END IF 395 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 396 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 397 #endif 400 398 t => tracers 401 399 CALL msg('Information stored in infotrac_phy :', modname) -
LMDZ6/trunk/libf/phylmdiso/isotopes_routines_mod.F90
r4402 r4403 16516 16516 #endif 16517 16517 xtrain_fall, xtsnow_fall, ql_ancien, xtl_ancien, qs_ancien, xts_ancien, fxtevap, xtsol 16518 USE indice_sol_mod, ONLY: nbsrf 16518 USE indice_sol_mod, ONLY: nbsrf 16519 16519 USE isotopes_mod, ONLY: isoName,iso_HDO,iso_eau 16520 16520 USE phyetat0_get_mod, ONLY: phyetat0_get, phyetat0_srf 16521 16521 USE readTracFiles_mod, ONLY: new2oldH2O 16522 USE strings_mod, ONLY: strIdx, str Head, strTail, maxlen, msg, int2str16522 USE strings_mod, ONLY: strIdx, strTail, maxlen, msg, int2str 16523 16523 #ifdef ISOVERIF 16524 16524 USE isotopes_verif_mod … … 16558 16558 16559 16559 outiso = isoName(ixt) 16560 oldIso = strTail(new2oldH2O(outiso), '_' , lFirst=.TRUE.)16560 oldIso = strTail(new2oldH2O(outiso), '_') !--- Remove "H2O_" from "H2O_<iso>[_<tag>]" 16561 16561 ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après fichier: 16562 16562 #ifdef ISOTRAC -
LMDZ6/trunk/libf/phylmdiso/isotrac_mod.F90
r4325 r4403 149 149 USE isotopes_mod, ONLY: iso_eau, ntracisoOR, initialisation_iso 150 150 USE dimphy, ONLY: klon, klev 151 USE strings_mod, ONLY: int2str, strStack, strTail, strHead, fmsg151 USE strings_mod, ONLY: int2str, strStack, strTail, strHead, strIdx, fmsg 152 152 153 153 IMPLICIT NONE … … 658 658 END DO 659 659 660 index_zone = [( INDEX(isoZone, strTail( isoName(ixt) ,'_')), ixt=1, ntiso)]661 index_iso = [( INDEX(isoName, strHead(delPhase(isoName(ixt)),'_')), ixt=1, ntiso)]660 index_zone = [(strIdx(isoZone, strTail(isoName(ixt) ,'_',.TRUE.)), ixt=1, ntiso)] 661 index_iso = [(strIdx(isoName, strHead(isoName(ixt) ,'_',.TRUE.)), ixt=1, ntiso)] 662 662 itZonIso_loc = itZonIso(:,:) 663 663 #ifdef ISOVERIF
Note: See TracChangeset
for help on using the changeset viewer.
