New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
string_function.f90 in vendors/XMLIO_SERVER/current/src/XMLIO – NEMO

source: vendors/XMLIO_SERVER/current/src/XMLIO/string_function.f90 @ 1897

Last change on this file since 1897 was 1897, checked in by flavoni, 14 years ago

importing XMLIO_SERVER vendor
File size: 2.4 KB
Line 
1MODULE string_function
2 
3
4
5
6CONTAINS
7
8  FUNCTION stdstr(string)
9  USE mod_xmlio_parameters
10  IMPLICIT NONE
11    CHARACTER(LEN=*),INTENT(IN) :: string
12    CHARACTER(LEN=str_len) :: stdstr
13   
14    stdstr=string
15  END FUNCTION stdstr
16   
17 
18  FUNCTION Hash(Str)
19  IMPLICIT NONE 
20    CHARACTER(LEN=*),INTENT(IN) :: Str
21    CHARACTER(LEN=LEN(str)) :: new_str
22    INTEGER :: Hash
23    INTEGER :: c
24    INTEGER :: i
25   
26    new_str=ADJUSTL(ADJUSTR(Str))
27   
28    Hash=0
29    DO i=1,LEN_TRIM(new_Str)
30      c = IACHAR(new_Str(i:i))
31      Hash=c+ISHFT(Hash,6)+ISHFT(Hash,16)-Hash
32    ENDDO
33   
34  END FUNCTION Hash
35 
36  FUNCTION String_to_integer(str,succed)
37  USE error_msg
38  IMPLICIT NONE
39    CHARACTER(LEN=*),INTENT(IN) :: Str
40    LOGICAL,OPTIONAL            :: succed
41   
42    INTEGER :: String_to_integer
43    INTEGER :: ierr
44   
45    READ(Str,FMT=*,iostat=ierr) String_to_integer
46   
47    IF (PRESENT(succed)) succed=.TRUE.
48     
49    IF (ierr/=0) THEN
50      IF (PRESENT(succed)) THEN
51        succed=.FALSE.
52      ELSE
53        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to integer'
54        CALL Error("string_function:string_to_integer")
55      ENDIF
56    ENDIF
57  END FUNCTION String_to_integer
58 
59  FUNCTION String_to_real(str,succed)
60  USE error_msg
61  IMPLICIT NONE
62    CHARACTER(LEN=*),INTENT(IN) :: Str
63    LOGICAL,OPTIONAL            :: succed
64   
65    REAL    :: String_to_real
66    INTEGER :: ierr
67   
68    READ(Str,FMT=*,iostat=ierr) String_to_real
69   
70    IF (PRESENT(succed)) succed=.TRUE.
71     
72    IF (ierr/=0) THEN
73      IF (PRESENT(succed)) THEN
74        succed=.FALSE.
75      ELSE
76        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to real'
77        CALL Error("string_function:string_to_real")
78      ENDIF
79    ENDIF
80   
81  END FUNCTION String_to_real
82 
83  FUNCTION String_to_logical(str,succed)
84  USE error_msg
85  IMPLICIT NONE
86    CHARACTER(LEN=*),INTENT(IN) :: Str
87    LOGICAL,OPTIONAL            :: succed
88   
89    LOGICAL :: String_to_logical
90    INTEGER :: ierr
91   
92    READ(Str,FMT=*,iostat=ierr) String_to_logical
93   
94    IF (PRESENT(succed)) succed=.TRUE.
95     
96    IF (ierr/=0) THEN
97      IF (PRESENT(succed)) THEN
98        succed=.FALSE.
99      ELSE
100        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to logical'
101        CALL Error("string_function:string_to_logical")
102      ENDIF
103    ENDIF
104   
105  END FUNCTION String_to_logical
106   
107END MODULE string_function
Note: See TracBrowser for help on using the repository browser.