source: lmdz_wrf/trunk/tools/module_basic.f90 @ 2404

Last change on this file since 2404 was 1655, checked in by lfita, 7 years ago

Adding new structure with module_basic.f90 and infrastructure to deal with netCDF from FORTRAN
File size: 8.3 KB
Line 
1MODULE module_basic
2! Module with basic functions
3
4!!!!!!! Subroutines/Functions
5! attachString: Subroutine to attach a subStribg to an existing String
6! ErrMsg: Subroutine to stop execution and provide an error message
7! ErrWarnMsg: Function to print error/warning message
8! ItoS: Function to transform an integer to String
9! Nstrings: Function to repeat a number of times a given string
10! removeChar: Subroutine to remove a given character from a string
11! removeNONnum: Subroutine to remove non numeric characters from a string
12! split: Subroutine which provides the values from a string [String] which has been split by a given
13!   character [charv] a given number of values [Nvalues] is expected
14! StoI: Function to transform a String to an integer
15! StoL: Function to transform a String to a boolean
16! StoR: Function to transform a String to a real
17! vectorR_KS: Function to transform a vector of reals to a string of characters
18
19  USE module_definitions
20
21  CONTAINS
22
23  SUBROUTINE removeNONnum(String, newString)
24! Subroutine to remove non numeric characters from a string
25
26    IMPLICIT NONE
27
28    CHARACTER(LEN=*), INTENT(IN)                         :: String
29    CHARACTER(LEN=*), INTENT(OUT)                        :: newString
30
31! Local
32    INTEGER                                              :: ic, inc, Lstring
33
34!!!!!!! Variables
35! String: string to remove non-numeric characters
36! newString: resultant string
37
38    Lstring = LEN_TRIM(String)
39    newString = ''
40    inc = 1
41    DO ic=1, Lstring
42      IF (ICHAR(String(ic:ic)) >= ICHAR('0') .AND. ICHAR(String(ic:ic)) <= ICHAR('9')) THEN
43        newString(inc:inc) = String(ic:ic)
44        inc = inc + 1
45      END IF
46    END DO
47
48  END SUBROUTINE removeNONnum
49
50  SUBROUTINE attachString(String, subString)
51! Subroutine to attach a subStribg to an existing String
52
53    IMPLICIT NONE
54
55    CHARACTER(LEN=1000), INTENT(INOUT)                   :: String
56    CHARACTER(LEN=*), INTENT(IN)                         :: subString
57
58! Local
59    INTEGER                                              :: LString, LsubString
60    CHARACTER(LEN=50)                                    :: fname
61
62!!!!!!! Variables
63! Sting: String to increase
64! subString: String to attach
65
66    fname = 'attachString'
67
68    LString = LEN_TRIM(String)
69    LsubString = LEN_TRIM(subString)
70
71    String(1:LString + LsubString) = String(1:LString) // TRIM(subString)
72
73  END SUBROUTINE attachString
74
75  SUBROUTINE removeChar(String, charv)
76! Subroutine to remove a given character from a string
77
78    IMPLICIT NONE
79
80    CHARACTER(LEN=*), INTENT(INOUT)                      :: String
81    CHARACTER(LEN=1), INTENT(IN)                         :: charv
82
83! Local
84    INTEGER                                              :: ic, inc, Lstring
85    CHARACTER(LEN=1000)                                  :: newString
86
87!!!!!!! Variables
88! String: string to remove a character
89! charv: character to remove
90
91    Lstring = LEN_TRIM(String)
92    newString = ''
93    inc = 1
94    DO ic=1, Lstring
95      IF (String(ic:ic) /= charv) THEN
96        newString(inc:inc) = String(ic:ic)
97        inc = inc + 1
98      END IF
99    END DO
100
101    String = ''
102    String(1:inc) = newString(1:inc)
103
104  END SUBROUTINE removeChar
105
106  CHARACTER(len=1000) FUNCTION vectorR_KS(d1, vector)
107  ! Function to transform a vector of reals(r_k) to a string of characters
108
109    IMPLICIT NONE
110
111    INTEGER, INTENT(in)                                  :: d1
112    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: vector
113
114! Local
115    INTEGER                                              :: iv
116    CHARACTER(len=50)                                    :: RS
117
118!!!!!!! Variables
119! d1: length of the vector
120! vector: values to transform
121
122    fname = 'vectorR_KS'
123
124    vectorR_KS = ''
125    DO iv=1, d1
126      WRITE(RS, '(F50.25)')vector(iv)
127      IF (iv == 1) THEN
128        vectorR_KS = TRIM(RS)
129      ELSE
130        vectorR_KS = TRIM(vectorR_KS) // ', ' // TRIM(RS)
131      END IF
132    END DO   
133
134  END FUNCTION vectorR_KS
135
136  CHARACTER(LEN=50) FUNCTION ItoS(Ival)
137! ItoS: Function to transform an integer to String
138
139    IMPLICIT NONE
140
141    INTEGER, INTENT(IN)                                  :: Ival
142
143! Local
144    CHARACTER(LEN=50)                                    :: itoS0
145
146    WRITE(ItoS0,'(I50)')Ival
147    CALL  removeNONnum(ItoS0, ItoS)
148
149  END FUNCTION ItoS
150
151CHARACTER(len=1000) FUNCTION Nstrings(Strval, Ntimes)
152! Function to repeat a number of times a given string
153
154  IMPLICIT NONE
155
156  CHARACTER(LEN=50), INTENT(in)                        :: Strval
157  INTEGER, INTENT(in)                                  :: Ntimes
158
159! Local
160  INTEGER                                              :: i
161
162!!!!!!! Variables
163! Strval: String to repeat
164! Ntimes: number of repetitions
165
166  fname = 'Nstrings'
167
168  Nstrings = ''
169  Do i=1, Ntimes
170    Nstrings = TRIM(Nstrings) // TRIM(Strval)
171  END DO
172
173END FUNCTION Nstrings
174
175  SUBROUTINE split(String,charv,Nvalues,values)
176! Subroutine which provides the values from a string [String] which has been split by a given
177!   character [charv] a given number of values [Nvalues] is expected
178
179    IMPLICIT NONE
180
181    CHARACTER(LEN=1000), INTENT(IN)                        :: String
182    CHARACTER(LEN=1), INTENT(IN)                           :: charv
183    INTEGER, INTENT(IN)                                    :: Nvalues
184    CHARACTER(LEN=200), INTENT(OUT), DIMENSION(Nvalues)    :: values
185
186! Local
187    INTEGER                                                :: i, ibeg, iend, Lstring
188    CHARACTER(LEN=3)                                       :: numS
189    CHARACTER(LEN=1000)                                    :: newString
190
191!!!!!!! Variables
192! String: String to split
193! charv: Character to use
194! Nvalues: number of values
195! values: vector with the given values (up to 200 characters)
196
197    fname = 'split'
198
199    newString = String
200    ibeg = 1
201    Lstring = LEN_TRIM(String)
202
203    DO i=1,Nvalues-1
204      iend = INDEX(newString(ibeg:Lstring), charv)
205
206      IF (iend == 0) THEN
207        WRITE (numS,"(I3)")Nvalues - 1
208        msg = "String '" // TRIM(String) // "' does not have " // TRIM(numS) // " '" // charv // "' !!"
209        CALL ErrMsg(msg, fname, -1)
210      END IF
211
212      values(i) = newString(ibeg:ibeg+iend-2)
213      ibeg = ibeg+iend
214    END DO
215    values(Nvalues) = newString(ibeg:Lstring)
216
217  END SUBROUTINE split
218
219SUBROUTINE ErrMsg(msg, funcn, errN)
220! Subroutine to stop execution and provide an error message
221
222  IMPLICIT NONE
223
224  CHARACTER(LEN=*), INTENT(in)                           :: msg, funcn
225  INTEGER, INTENT(in)                                    :: errN
226
227! Local
228  CHARACTER(LEN=50)                                      :: emsg
229
230!!!!!!! Variables
231! msg: message to print with the error
232! funcn: name of the funciton, section to localize the error
233! errN: number of the error provided for a given FORTRAN function
234
235  emsg = 'ERORR -- error -- ERROR -- error'
236
237  IF (errN /= 0) THEN
238    PRINT *,TRiM(emsg)
239    PRINT *,'  ' // TRIM(funcn) // ': ' // TRIM(msg) // ' !!'
240    PRINT *,'    error number:', errN
241    STOP
242  END IF
243
244  RETURN
245
246END SUBROUTINE ErrMsg
247
248  CHARACTER(LEN=50) FUNCTION ErrWarnMsg(msg)
249! Function to print error/warning message
250
251    IMPLICIT NONE
252
253    CHARACTER(LEN=3), INTENT(in)                         :: msg
254! Local
255
256    fname = 'ErrWarnMsg'
257
258    IF (msg == 'err') THEN
259      ErrWarnMsg = 'ERROR -- error -- ERROR -- error'
260    ELSE IF (msg == 'wrn') THEN
261      ErrWarnMsg = 'WARNING -- warning -- WARNING -- warning'
262    ELSE
263      PRINT *,'ERROR -- error -- ERROR -- error'
264      PRINT *,'  ' // TRIM(fname) // ": '" // TRIM(msg) // "' does not exist!!"
265      STOP
266    END IF
267  END FUNCTION ErrWarnMsg
268
269  INTEGER FUNCTION StoI(String)
270! Function to transform a String to an integer
271
272    IMPLICIT NONE
273
274    CHARACTER(LEN=200), INTENT(IN)                       :: String
275
276    READ(String,'(I200)')StoI
277
278  END FUNCTION StoI
279
280  REAL FUNCTION StoR(String)
281! Function to transform a String to a real
282
283    IMPLICIT NONE
284
285    CHARACTER(LEN=200), INTENT(IN)                       :: String
286
287    READ(String,'(F200.0)')StoR
288
289  END FUNCTION StoR
290
291  LOGICAL FUNCTION StoL(String)
292! Function to transform a String to a boolean
293
294    IMPLICIT NONE
295
296    CHARACTER(LEN=200), INTENT(IN)                       :: String
297
298    IF (TRIM(String) == '.T.' .OR. TRIM(String) == '.true.' .OR. TRIM(String) == '.TRUE.'             &
299      .OR. TRIM(String) == 'yes' .OR. TRIM(String) == 'YES' .OR. TRIM(String) == 'y' ) THEN
300      StoL = .TRUE.
301    ELSE
302      StoL = .FALSE.
303    END IF
304
305  END FUNCTION StoL
306
307END MODULE module_basic
Note: See TracBrowser for help on using the repository browser.