10 #define NEW_LGI_METHOD2a 83 integer(ip_i4_p),
save ::
debug = 0
109 character(*) ,
intent(in) :: str
110 character(1) ,
intent(in) :: char
111 integer(ip_i4_p),
intent(out),
optional :: rc
116 integer(ip_i4_p) :: count
117 integer(ip_i4_p) :: n
120 character(*),
parameter :: subName =
"(oasis_string_countChar) " 129 do n = 1, len_trim(str)
130 if (str(n:n) == char) count = count + 1
134 if (
present(rc)) rc = 0
156 character(len=*),
intent(in) :: str
157 character(len=len(str)) :: oasis_string_toUpper
160 integer(ip_i4_p) :: i
161 integer(ip_i4_p) :: aseq
162 integer(ip_i4_p) :: LowerToUpper
163 character(len=1) :: ctmp
166 character(*),
parameter :: subName =
"(oasis_string_toUpper) " 174 lowertoupper = iachar(
"A") - iachar(
"a")
179 if ( aseq >= iachar(
"a") .and. aseq <= iachar(
"z") ) &
180 ctmp = achar(aseq + lowertoupper)
181 oasis_string_toupper(i:i) = ctmp
203 character(len=*),
intent(in) :: str
204 character(len=len(str)) :: oasis_string_toLower
207 integer(ip_i4_p) :: i
208 integer(ip_i4_p) :: aseq
209 integer(ip_i4_p) :: UpperToLower
210 character(len=1) :: ctmp
213 character(*),
parameter :: subName =
"(oasis_string_toLower) " 221 uppertolower = iachar(
"a") - iachar(
"A")
226 if ( aseq >= iachar(
"A") .and. aseq <= iachar(
"Z") ) &
227 ctmp = achar(aseq + uppertolower)
228 oasis_string_tolower(i:i) = ctmp
250 character(len=*),
intent(in) :: str
251 character(len=len(str)) :: oasis_string_getParentDir
254 integer(ip_i4_p) :: i
255 integer(ip_i4_p) :: nlen
258 character(*),
parameter :: subName =
"(oasis_string_getParentDir) " 267 if ( str(nlen:nlen) ==
"/" ) nlen = nlen - 1
268 i = index( str(1:nlen),
"/", back=.true. )
270 oasis_string_getparentdir = str
272 oasis_string_getparentdir = str(1:i-1)
299 character(*) ,
intent(in) :: string
300 character(*) ,
intent(in) :: substr
301 integer(ip_i4_p),
intent(out),
optional :: rc
308 character(*),
parameter :: subName =
"(oasis_string_lastIndex) " 319 if (
present(rc)) rc = 0
344 character(*) ,
intent(in) :: string
345 character(*) ,
intent(in) :: substr
346 integer(ip_i4_p),
intent(out),
optional :: rc
351 integer(ip_i4_p) :: i
354 character(*),
parameter :: subName =
"(oasis_string_endIndex) " 365 i = index(trim(string),trim(substr))
378 if (
present(rc)) rc = 0
403 character(*) ,
intent(inout) :: str
404 integer(ip_i4_p),
intent(out) ,
optional :: rc
409 integer(ip_i4_p) :: rCode
412 character(*),
parameter :: subName =
"(oasis_string_leftAlign) " 432 if (
present(rc)) rc = 0
457 character(*) ,
intent(inout) :: str
458 integer(ip_i4_p),
intent(out) ,
optional :: rc
463 integer(ip_i4_p) :: rCode
464 integer(ip_i4_p) :: n,icnt
467 character(*),
parameter :: subName =
"(oasis_string_alphaNum) " 477 if ((str(n:n) >=
'a' .and. str(n:n) <=
'z') .or. &
478 (str(n:n) >=
'A' .and. str(n:n) <=
'Z') .or. &
479 (str(n:n) >=
'0' .and. str(n:n) <=
'9'))
then 481 str(icnt:icnt) = str(n:n)
488 if (
present(rc)) rc = 0
513 character(*) ,
intent(in) :: string
514 character(*) ,
intent(in) :: startTag
515 character(*) ,
intent(in) :: endTag
516 character(*) ,
intent(out) :: substr
517 integer(ip_i4_p),
intent(out),
optional :: rc
522 integer(ip_i4_p) :: iStart
523 integer(ip_i4_p) :: iEnd
524 integer(ip_i4_p) :: rCode
527 character(*),
parameter :: subName =
"(oasis_string_betweenTags) " 537 iend = index(string,trim(adjustl(endtag )))
544 WRITE(
nulprt,*) subname,
estr,
"can't find start tag in string" 545 WRITE(
nulprt,*) subname,
estr,
"start tag = ",trim(starttag)
546 WRITE(
nulprt,*) subname,
estr,
"string = ",trim(string)
549 else if (iend < 1)
then 551 WRITE(
nulprt,*) subname,
estr,
"can't find end tag in string" 552 WRITE(
nulprt,*) subname,
estr,
"end tag = ",trim( endtag)
553 WRITE(
nulprt,*) subname,
estr,
"string = ",trim(string)
556 else if ( iend <= istart)
then 558 WRITE(
nulprt,*) subname,
estr,
"start tag not before end tag" 559 WRITE(
nulprt,*) subname,
estr,
"start tag = ",trim(starttag)
560 WRITE(
nulprt,*) subname,
estr,
"end tag = ",trim( endtag)
561 WRITE(
nulprt,*) subname,
estr,
"string = ",trim(string)
564 else if ( istart+1 == iend )
then 567 WRITE(
nulprt,*) subname,
wstr,
"zero-length substring found in ",trim(string)
570 substr = string(istart+1:iend-1)
571 IF (len_trim(substr) == 0)
THEN 573 WRITE(
nulprt,*) subname,
wstr,
"white-space substring found in ",trim(string)
578 if (
present(rc)) rc = rcode
610 character(*) ,
intent(in) :: string
611 character(*) ,
intent(out) :: unit
612 integer(ip_i4_p),
intent(out) :: bdate
613 real(ip_r8_p) ,
intent(out) :: bsec
614 integer(ip_i4_p),
intent(out),
optional :: rc
619 integer(ip_i4_p) :: i,i1,i2
620 character(ic_long) :: tbase
621 character(ic_long) :: lstr
622 integer(ip_i4_p) :: yr,mo,da,hr,min
626 character(*),
parameter :: subName =
"(oasis_string_parseCFtunit) " 641 if (i > 0) unit =
'days' 643 if (i > 0) unit =
'hours' 645 if (i > 0) unit =
'minutes' 647 if (i > 0) unit =
'seconds' 649 if (trim(unit) ==
'none')
then 651 WRITE(
nulprt,*) subname,
estr,
'time unit unknown' 659 WRITE(
nulprt,*) subname,
estr,
'since does not appear in unit attribute for time ' 663 tbase = trim(string(i+6:))
668 WRITE(
nulprt,*) trim(subname)//
' '//
'unit '//trim(unit)
669 WRITE(
nulprt,*) trim(subname)//
' '//
'tbase '//trim(tbase)
673 yr=0; mo=0; da=0; hr=0; min=0; sec=0
676 i2 = index(tbase,
'-') - 1
678 read(lstr,*,err=200,end=200) yr
682 i2 = index(tbase,
'-') - 1
684 read(lstr,*,err=200,end=200) mo
688 i2 = index(tbase,
' ') - 1
690 read(lstr,*,err=200,end=200) da
694 i2 = index(tbase,
':') - 1
696 read(lstr,*,err=200,end=100) hr
700 i2 = index(tbase,
':') - 1
702 read(lstr,*,err=200,end=100) min
706 i2 = index(tbase,
' ') - 1
708 read(lstr,*,err=200,end=100) sec
714 WRITE(
nulprt,*) trim(subname),
'ymdhms:',yr,mo,da,hr,min,sec
718 bdate = abs(yr)*10000 + mo*100 + da
719 if (yr < 0) bdate = -bdate
720 bsec =
real(hr*3600 + min*60,ip_r8_p) + sec
722 if (
present(rc)) rc = 0
729 write(
nulprt,*) subname,
estr,
'200 on char num read ' 755 character(*) ,
intent(inout) :: string
756 integer(ip_i4_p),
optional,
intent(out) :: rc
761 integer(ip_i4_p) :: n
762 integer(ip_i4_p) :: rCode
765 character(*),
parameter :: subName =
"(oasis_string_clean) " 775 if (
present(rc)) rc = rcode
800 character(*) ,
intent(in) :: list
801 integer(ip_i4_p),
optional,
intent(out) :: rc
806 integer (ip_i4_p) :: nChar
807 integer (ip_i4_p) :: rCode
810 character(*),
parameter :: subName =
"(oasis_string_listIsValid) " 821 nchar = len_trim(list)
824 else if ( list(1:1) ==
listdel )
then 826 else if (list(nchar:nchar) ==
listdel )
then 828 else if (index(trim(list),
" " ) > 0)
then 830 else if (index(trim(list),
listdel2) > 0)
then 837 write(
nulprt,*) subname,
wstr,
"invalid list = ",trim(list)
841 if (
present(rc)) rc = rcode
866 character(*) ,
intent(in) :: list
867 integer(ip_i4_p) ,
intent(in) :: k
868 character(*) ,
intent(out) :: name
869 integer(ip_i4_p),
optional,
intent(out) :: rc
874 integer(ip_i4_p) :: i,j,n
875 integer(ip_i4_p) :: kFlds
876 integer(ip_i4_p) :: i0,i1
877 integer(ip_i4_p) :: rCode
880 character(*),
parameter :: subName =
"(oasis_string_listGetName) " 893 write(
nulprt,*) subname,
estr,
"invalid list = ",trim(list)
900 if (k<1 .or. kflds<k)
then 902 WRITE(
nulprt,*) subname,
estr,
"invalid index = ",k
903 WRITE(
nulprt,*) subname,
estr,
" list = ",trim(list)
919 if ( k < kflds )
then 925 name = list(i0:i1)//
" " 927 if (
present(rc)) rc = rcode
952 character(*) ,
intent(in) :: list1
953 character(*) ,
intent(in) :: list2
954 character(*) ,
intent(out) :: listout
955 integer(ip_i4_p),
optional,
intent(out) :: rc
960 integer(ip_i4_p) :: nf,n1,n2
961 character(ic_med) :: name
962 integer(ip_i4_p) :: rCode
965 character(*),
parameter :: subName =
"(oasis_string_listIntersect) " 985 if (
present(rc)) rc = rcode
1010 character(*) ,
intent(in) :: list1
1011 character(*) ,
intent(in) :: list2
1012 character(*) ,
intent(out) :: listout
1013 integer(ip_i4_p),
optional,
intent(out) :: rc
1018 integer(ip_i4_p) :: nf,n1,n2
1019 character(ic_med) :: name
1020 integer(ip_i4_p) :: rCode
1023 character(*),
parameter :: subName =
"(oasis_string_listUnion) " 1053 if (
present(rc)) rc = rcode
1078 character(*) ,
intent(in) :: list1
1079 character(*) ,
intent(in) :: list2
1080 character(*) ,
intent(out) :: listout
1081 integer(ip_i4_p),
optional,
intent(out) :: rc
1086 character(ic_xxl):: l1,l2
1087 integer(ip_i4_p) :: rCode
1090 character(*),
parameter :: subName =
"(oasis_string_listMerge) " 1102 if ( (len(l1) < len_trim(list1)) .or. (len(l2) < len_trim(list2)))
then 1113 if (len_trim(l1)+len_trim(l2)+1 > len(listout)) &
1115 if (len_trim(l1) == 0)
then 1118 listout = trim(l1)//
":"//trim(l2)
1121 if (
present(rc)) rc = rcode
1146 character(*) ,
intent(inout) :: list
1147 character(*) ,
intent(in) :: listadd
1148 integer(ip_i4_p),
optional,
intent(out) :: rc
1153 character(ic_xxl) :: l1
1154 integer(ip_i4_p) :: rCode
1157 character(*),
parameter :: subName =
"(oasis_string_listAppend) " 1169 if (len(l1) < len_trim(listadd))
then 1176 if (len_trim(list)+len_trim(l1)+1 > len(list)) &
1178 if (len_trim(list) == 0)
then 1181 list = trim(list)//
":"//trim(l1)
1184 if (
present(rc)) rc = rcode
1211 character(*) ,
intent(in) :: listadd
1212 character(*) ,
intent(inout) :: list
1213 integer(ip_i4_p),
optional,
intent(out) :: rc
1218 character(ic_xxl) :: l1
1219 integer(ip_i4_p) :: rCode
1222 character(*),
parameter :: subName =
"(oasis_string_listPrepend) " 1234 if (len(l1) < len_trim(listadd))
then 1242 if (len_trim(list)+len_trim(l1)+1 > len(list)) &
1244 if (len_trim(l1) == 0)
then 1247 list = trim(l1)//
":"//trim(list)
1250 if (
present(rc)) rc = rcode
1275 character(*),
intent(in) :: string
1276 character(*),
intent(in) :: fldStr
1281 integer(ip_i4_p) :: k
1282 integer(ip_i4_p) :: rc
1285 character(*),
parameter :: subName =
"(oasis_string_listGetIndexF) " 1298 #if (defined NEW_LGI_METHOD2a || defined NEW_LGI_METHOD2b) 1318 character(*) ,
intent(in) :: string
1319 character(*) ,
intent(in) :: fldStr
1320 integer(ip_i4_p),
intent(out) :: kFld
1321 logical ,
intent(in) ,
optional :: print
1322 integer(ip_i4_p),
intent(out),
optional :: rc
1327 integer(ip_i4_p) :: n,n1,n2
1328 integer(ip_i4_p) :: lens
1333 character(*),
parameter :: subName =
"(oasis_string_listGetIndex) " 1342 if (
present(rc)) rc = 0
1348 if (
present(print)) lprint = print
1351 if (len_trim(fldstr) < 1)
then 1354 WRITE(
nulprt,*) subname,
estr,
"input field name has 0 length" 1363 lens = len_trim(string)
1368 n = index(string,
listdel,back=.false.)
1374 if (trim(fldstr) == string(1:lens))
then 1383 if (trim(fldstr) == string(1:n-1))
then 1390 if (.not.found)
then 1392 n = index(string,
listdel,back=.true.)
1393 if (trim(fldstr) == string(n+1:lens))
then 1401 if (.not.found)
then 1403 n = index(string,
':'//trim(fldstr)//
':',back=.false.)
1407 #if defined NEW_LGI_METHOD2a 1410 #if defined NEW_LGI_METHOD2b 1411 if (n <= lens/2)
then 1418 n2 = index(string(n1+1:lens),
listdel,back=.false.)
1431 n2 = index(string(1:n1-1),
listdel,back=.true.)
1448 if (.not. found)
then 1451 WRITE(
nulprt,*) subname,
"FYI: field ",trim(fldstr),
" not found in list ",trim(string)
1454 if (
present(rc)) rc = 1
1480 character(*),
intent(in) :: str
1485 integer(ip_i4_p) :: count
1488 character(*),
parameter :: subName =
"(oasis_string_listGetNum) " 1498 if (len_trim(str) > 0)
then 1526 character(len=1),
intent(in) :: cflag
1531 character(*),
parameter :: subName =
"(oasis_string_listSetDel) " 1539 WRITE(
nulprt,*) subname,
' changing listDel from '//trim(
listdel)//
' to '//trim(cflag)
1568 character(*),
intent(out) :: del
1573 character(*),
parameter :: subName =
"(oasis_string_listGetDel) " 1604 logical,
intent(in) :: flag
1609 character(*),
parameter :: subName =
"(oasis_string_setAbort) " 1618 WRITE(
nulprt,*) subname,
' setting abort to true' 1622 WRITE(
nulprt,*) subname,
' setting abort to false' 1652 integer(ip_i4_p),
intent(in) :: iFlag
1659 character(*),
parameter :: subName =
"(oasis_string_setDebug) " 1685 character(*),
optional,
intent(in) :: string
1690 character(ic_xxl) :: lstring
1691 character(*),
parameter :: subName =
"(oasis_string_abort)" 1701 if (
present(string)) lstring = string
1704 WRITE(
nulprt,*) subname,
estr,
'abort for ',trim(lstring)
1707 write(
nulprt,*) subname,
wstr,
'no abort for '//trim(lstring)
logical function, public oasis_string_listisvalid(list, rc)
Determine whether string is a valid list.
subroutine, public oasis_string_listprepend(listadd, list, rc)
Prepend one list to another.
subroutine, public oasis_string_clean(string, rc)
Clean a string, set it to blank.
integer function, public oasis_string_listgetindexf(string, fldStr)
Get the index of a field in a list.
subroutine, public oasis_string_setabort(flag)
Set local oasis_string abort flag, true = abort, false = print and continue.
subroutine, public oasis_string_setdebug(iFlag)
Set local oasis_string debug level, 0 = production.
Provides a common location for several OASIS variables.
subroutine, public oasis_string_listunion(list1, list2, listout, rc)
Get union of two fields lists, write into third list.
integer function, public oasis_string_endindex(string, substr, rc)
Get the ending index of the first occurance of a substring within string.
integer(kind=ip_intwp_p) nulprt
integer(ip_i4_p), save debug
subroutine, public oasis_string_listgetindex(string, fldStr, kFld, print, rc)
Get the index of a field in a string.
subroutine, public oasis_string_listmerge(list1, list2, listout, rc)
Merge two lists into a third list.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
subroutine oasis_string_abort(string)
Supports aborts in the string module.
subroutine, public oasis_string_listgetname(list, k, name, rc)
Get name of k-th field in list.
subroutine, public oasis_string_listgetdel(del)
Get field delimeter character in lists.
integer(kind=ip_i4_p) compid
subroutine, public oasis_string_betweentags(string, startTag, endTag, substr, rc)
Get the substring found between the start and end strings.
character(len=len(str)) function, public oasis_string_tolower(str)
Convert the input string to lower-case.
integer(kind=ip_i4_p) mpi_rank_local
subroutine, public oasis_string_leftalign(str, rc)
Remove leading white space.
subroutine, public oasis_string_parsecftunit(string, unit, bdate, bsec, rc)
Parse CF time unit into a delta string name and a base time in yyyymmdd.
Character string manipulation methods.
subroutine, public oasis_string_listappend(list, listadd, rc)
Append one list to another.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
integer function, public oasis_string_countchar(str, char, rc)
Count number of occurances of a single character in a string.
integer function, public oasis_string_lastindex(string, substr, rc)
Get the index of the last occurance of a substring within a string.
subroutine, public oasis_string_listintersect(list1, list2, listout, rc)
Get intersection of two fields lists, write into third list.
Defines parameters for OASIS.
character(len= *), parameter, public estr
integer function, public oasis_string_listgetnum(str)
return number of fields in string list
character(len=len(str)) function, public oasis_string_getparentdir(str)
Get the parent directory pathname.
character(len=2), save listdel2
subroutine, public oasis_string_alphanum(str, rc)
Remove all non alpha numeric characters from string.
subroutine, public oasis_flush(nu)
Flushes output to file.
Performance timer methods.
subroutine, public oasis_string_listsetdel(cflag)
Set field delimeter character in lists.
character(len=1), save listdel
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
character(len=len(str)) function, public oasis_string_toupper(str)
Convert the input string to upper-case.
character(len= *), parameter, public wstr