10 #define NEW_LGI_METHOD2a
80 character(len=1) ,
save :: listdel =
":"
81 character(len=2) ,
save :: listdel2 =
"::"
82 logical ,
save :: doabort = .true.
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 )))
543 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
550 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
557 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
566 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
572 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
650 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
651 WRITE(nulprt,*) subname,estr,
'time unit unknown'
658 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
659 WRITE(nulprt,*) subname,estr,
'since does not appear in unit attribute for time '
663 tbase = trim(string(i+6:))
666 if (debug > 0 .and. nulprt > 0)
then
667 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
713 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
728 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
836 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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) "
892 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
893 write(nulprt,*) subname,estr,
"invalid list = ",trim(list)
900 if (k<1 .or. kflds<k)
then
901 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
902 WRITE(nulprt,*) subname,estr,
"invalid index = ",k
903 WRITE(nulprt,*) subname,estr,
" list = ",trim(list)
914 i = index(list(i0:i1),listdel)
919 if ( k < kflds )
then
920 i = index(list(i0:i1),listdel)
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_xl) :: 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_xl) :: 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_xl) :: 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
1353 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
1450 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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) "
1538 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
1539 WRITE(nulprt,*) subname,
' changing listDel from '//trim(listdel)//
' to '//trim(cflag)
1542 listdel = trim(cflag)
1543 listdel2 = listdel//listdel
1568 character(*),
intent(out) :: del
1573 character(*),
parameter :: subName =
"(oasis_string_listGetDel) "
1604 logical,
intent(in) :: flag
1609 character(*),
parameter :: subName =
"(oasis_string_setAbort) "
1617 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
1618 WRITE(nulprt,*) subname,
' setting abort to true'
1621 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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_xl) :: 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)
subroutine oasis_string_abort(string)
Supports aborts in the string module.
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
subroutine, public oasis_string_listgetdel(del)
Get field delimeter character in lists.
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_clean(string, rc)
Clean a string, set it to blank.
Provides a common location for several OASIS variables.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
subroutine, public oasis_string_setabort(flag)
Set local oasis_string abort flag, true = abort, false = print and continue.
subroutine, public oasis_flush(nu)
Flushes output to file.
subroutine, public oasis_string_listappend(list, listadd, rc)
Append one list to another.
character(len=len(str)) function, public oasis_string_toupper(str)
Convert the input string to upper-case.
Character string manipulation methods.
character(len=len(str)) function, public oasis_string_getparentdir(str)
Get the parent directory pathname.
subroutine, public oasis_string_listmerge(list1, list2, listout, rc)
Merge two lists into a third list.
integer function, public oasis_string_endindex(string, substr, rc)
Get the ending index of the first occurance of a substring within string.
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.
integer function, public oasis_string_countchar(str, char, rc)
Count number of occurances of a single character in a string.
Performance timer methods.
subroutine, public oasis_string_listintersect(list1, list2, listout, rc)
Get intersection of two fields lists, write into third list.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine, public oasis_string_listgetname(list, k, name, rc)
Get name of k-th field in list.
subroutine, public oasis_string_setdebug(iFlag)
Set local oasis_string debug level, 0 = production.
subroutine, public oasis_string_listunion(list1, list2, listout, rc)
Get union of two fields lists, write into third list.
logical function, public oasis_string_listisvalid(list, rc)
Determine whether string is a valid list.
subroutine, public oasis_string_leftalign(str, rc)
Remove leading white space.
subroutine, public oasis_string_listgetindex(string, fldStr, kFld, print, rc)
Get the index of a field in a string.
subroutine, public oasis_string_betweentags(string, startTag, endTag, substr, rc)
Get the substring found between the start and end strings.
integer function, public oasis_string_listgetnum(str)
return number of fields in string list
Defines parameters for OASIS.
integer function, public oasis_string_listgetindexf(string, fldStr)
Get the index of a field in a list.
subroutine, public oasis_string_alphanum(str, rc)
Remove all non alpha numeric characters from string.
character(len=len(str)) function, public oasis_string_tolower(str)
Convert the input string to lower-case.
subroutine, public oasis_string_listprepend(listadd, list, rc)
Prepend one list to another.
subroutine, public oasis_string_listsetdel(cflag)
Set field delimeter character in lists.