source: lmdz_wrf/trunk/tools/module_generic.f90 @ 1637

Last change on this file since 1637 was 1619, checked in by lfita, 8 years ago

Adding:

  • `split: Subroutine which provides the values from a string [String] which has been split by a given character [charv] a given number of values [Nvalues] is expected
File size: 10.9 KB
Line 
1MODULE module_generic
2! Module with generic functions
3
4!!!!!!! Subroutines/Functions
5! ErrMsg: Subroutine to stop execution and provide an error message
6! ErrWarnMsg: Function to print error/warning message
7! index_list_coordsI: Function to provide the index of a given coordinate within a list of integer coordinates
8! Index1DArrayI: Function to provide the first index of a given value inside a 1D integer array
9! Index1DArrayR: Function to provide the first index of a given value inside a 1D real array
10! Index1DArrayR_K: Function to provide the first index of a given value inside a 1D real(r_k) array
11! Index2DArrayR: Function to provide the first index of a given value inside a 2D real array
12! mat2DPosition: Function to provide the i, j indices of a given value inside a 2D matrix
13! Nstrings: Function to repeat a number of times a given string
14! RangeI: Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector
15! RangeR: Function to provide a range of d1 values from 'iniv' to 'endv', of real values in a vector
16! RangeR_K: Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
17! split: Subroutine which provides the values from a string [String] which has been split by a given
18!   character [charv] a given number of values [Nvalues] is expected
19! vectorR_KS: Function to transform a vector of reals to a string of characters
20
21  USE module_definitions
22
23  CONTAINS
24
25  INTEGER FUNCTION index_list_coordsI(Ncoords, coords, icoord)
26  ! Function to provide the index of a given coordinate within a list of integer coordinates
27
28    IMPLICIT NONE
29
30    INTEGER, INTENT(in)                                  :: Ncoords
31    INTEGER, DIMENSION(Ncoords,2), INTENT(in)            :: coords
32    INTEGER, DIMENSION(2), INTENT(in)                    :: icoord
33
34! Local
35    INTEGER, DIMENSION(Ncoords)                          :: dist
36    INTEGER                                              :: i,mindist
37    INTEGER, DIMENSION(1)                                :: iloc
38
39!!!!!!! Variables
40! Ncoords: number of coordinates in the list
41! coords: list of coordinates
42! icoord: coordinate to find
43
44  fname = 'index_list_coordsI'
45
46  dist = (coords(:,1)-icoord(1))**2+(coords(:,2)-icoord(2))**2
47
48  IF (ANY(dist == 0)) THEN
49    iloc = MINLOC(dist)
50    index_list_coordsI = iloc(1)
51  ELSE
52    index_list_coordsI = -1
53  END IF
54
55  END FUNCTION index_list_coordsI
56
57  CHARACTER(len=1000) FUNCTION vectorR_KS(d1, vector)
58  ! Function to transform a vector of reals(r_k) to a string of characters
59
60    IMPLICIT NONE
61
62    INTEGER, INTENT(in)                                  :: d1
63    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: vector
64
65! Local
66    INTEGER                                              :: iv
67    CHARACTER(len=50)                                    :: RS
68
69!!!!!!! Variables
70! d1: length of the vector
71! vector: values to transform
72
73    fname = 'vectorR_KS'
74
75    vectorR_KS = ''
76    DO iv=1, d1
77      WRITE(RS, '(F50.25)')vector(iv)
78      IF (iv == 1) THEN
79        vectorR_KS = TRIM(RS)
80      ELSE
81        vectorR_KS = TRIM(vectorR_KS) // ', ' // TRIM(RS)
82      END IF
83    END DO   
84
85  END FUNCTION vectorR_KS
86
87CHARACTER(len=1000) FUNCTION Nstrings(Strval, Ntimes)
88! Function to repeat a number of times a given string
89
90  IMPLICIT NONE
91
92  CHARACTER(LEN=50), INTENT(in)                        :: Strval
93  INTEGER, INTENT(in)                                  :: Ntimes
94
95! Local
96  INTEGER                                              :: i
97
98!!!!!!! Variables
99! Strval: String to repeat
100! Ntimes: number of repetitions
101
102  fname = 'Nstrings'
103
104  Nstrings = ''
105  Do i=1, Ntimes
106    Nstrings = TRIM(Nstrings) // TRIM(Strval)
107  END DO
108
109END FUNCTION Nstrings
110
111  INTEGER FUNCTION Index1DArrayI(array1D, d1, val)
112! Function to provide the first index of a given value inside a 1D integer array
113
114    IMPLICIT NONE
115
116    INTEGER, INTENT(in)                                  :: d1
117    INTEGER, INTENT(in)                                  :: val
118    INTEGER, DIMENSION(d1), INTENT(in)                   :: array1D
119
120! Local
121    INTEGER                                              :: i
122
123    fname = 'Index1DArrayI'
124
125    Index1DArrayI = -1
126
127    DO i=1,d1
128      IF (array1d(i) == val) THEN
129        Index1DArrayI = i
130        EXIT
131      END IF
132    END DO
133
134  END FUNCTION Index1DArrayI
135
136  INTEGER FUNCTION Index1DArrayR(array1D, d1, val)
137! Function to provide the first index of a given value inside a 1D real array
138
139    IMPLICIT NONE
140
141    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
142    INTEGER, INTENT(in)                                  :: d1
143    REAL(r_k), INTENT(in)                                :: val
144    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: array1D
145
146! Local
147    INTEGER                                              :: i
148
149    fname = 'Index1DArrayR'
150
151    Index1DArrayR = -1
152
153    DO i=1,d1
154      IF (array1d(i) == val) THEN
155        Index1DArrayR = i
156        EXIT
157      END IF
158    END DO
159
160  END FUNCTION Index1DArrayR
161
162  INTEGER FUNCTION Index1DArrayR_K(array1D, d1, val)
163! Function to provide the first index of a given value inside a 1D real(r_k) array
164
165    IMPLICIT NONE
166
167    INTEGER, INTENT(in)                                  :: d1
168    REAL(r_k), INTENT(in)                                :: val
169    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: array1D
170
171! Local
172    INTEGER                                              :: i
173
174    fname = 'Index1DArrayR_K'
175
176    Index1DArrayR_K = -1
177
178    DO i=1,d1
179      IF (array1d(i) == val) THEN
180        Index1DArrayR_K = i
181        EXIT
182      END IF
183    END DO
184
185  END FUNCTION Index1DArrayR_K
186
187  FUNCTION Index2DArrayR(array2D, d1, d2, val)
188! Function to provide the first index of a given value inside a 2D real array
189
190    IMPLICIT NONE
191
192    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
193    INTEGER, INTENT(in)                                  :: d1, d2
194    REAL(r_k), INTENT(in)                                :: val
195    REAL(r_k), DIMENSION(d1,d2), INTENT(in)              :: array2D
196    INTEGER, DIMENSION(2)                                :: Index2DArrayR
197
198! Local
199    INTEGER                                              :: i, j
200
201    fname = 'Index2DArrayR'
202
203    Index2DArrayR = -1
204
205    DO i=1,d1
206      DO j=1,d2
207        IF (array2d(i,j) == val) THEN
208          Index2DArrayR(1) = i
209          Index2DArrayR(2) = j
210          EXIT
211        END IF
212      END DO
213    END DO
214
215  END FUNCTION Index2DArrayR
216
217  FUNCTION RangeI(d1, iniv, endv)
218! Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector
219
220    IMPLICIT NONE
221
222    INTEGER, INTENT(in)                                  :: d1, iniv, endv
223    INTEGER, DIMENSION(d1)                               :: RangeI
224
225! Local
226    INTEGER                                              :: i, intv
227
228    fname = 'RangeI'
229
230    intv = (endv - iniv) / (d1*1 - 1)
231
232    RangeI(1) = iniv
233    DO i=2,d1
234      RangeI(i) = RangeI(i-1) + intv
235    END DO
236
237  END FUNCTION RangeI
238
239  FUNCTION RangeR(d1, iniv, endv)
240! Function to provide a range of d1 from 'iniv' to 'endv', of real values in a vector
241
242    IMPLICIT NONE
243
244    INTEGER, INTENT(in)                                  :: d1
245    REAL, INTENT(in)                                     :: iniv, endv
246    REAL, DIMENSION(d1)                                  :: RangeR
247
248! Local
249    INTEGER                                              :: i
250    REAL                                                 :: intv
251
252    fname = 'RangeR'
253
254    intv = (endv - iniv) / (d1*1. - 1.)
255
256    RangeR(1) = iniv
257    DO i=2,d1
258      RangeR(i) = RangeR(i-1) + intv
259    END DO
260
261  END FUNCTION RangeR
262
263
264  FUNCTION RangeR_K(d1, iniv, endv)
265! Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
266
267    IMPLICIT NONE
268
269    INTEGER, INTENT(in)                                  :: d1
270    REAL(r_k), INTENT(in)                                :: iniv, endv
271    REAL(r_k), DIMENSION(d1)                             :: RangeR_K
272
273! Local
274    INTEGER                                              :: i
275    REAL(r_k)                                            :: intv
276
277    fname = 'RangeR_K'
278
279    intv = (endv - iniv) / (d1*oneRK-oneRK)
280
281    RangeR_K(1) = iniv
282    DO i=2,d1
283      RangeR_K(i) = RangeR_K(i-1) + intv
284    END DO
285
286  END FUNCTION RangeR_K
287
288  SUBROUTINE split(String,charv,Nvalues,values)
289! Subroutine which provides the values from a string [String] which has been split by a given
290!   character [charv] a given number of values [Nvalues] is expected
291
292    IMPLICIT NONE
293
294    CHARACTER(LEN=1000), INTENT(IN)                        :: String
295    CHARACTER(LEN=1), INTENT(IN)                           :: charv
296    INTEGER, INTENT(IN)                                    :: Nvalues
297    CHARACTER(LEN=200), INTENT(OUT), DIMENSION(Nvalues)    :: values
298
299! Local
300    INTEGER                                                :: i, ibeg, iend, Lstring
301    CHARACTER(LEN=3)                                       :: numS
302    CHARACTER(LEN=1000)                                    :: newString
303
304!!!!!!! Variables
305! String: String to split
306! charv: Character to use
307! Nvalues: number of values
308! values: vector with the given values (up to 200 characters)
309
310    fname = 'split'
311
312    newString = String
313    ibeg = 1
314    Lstring = LEN_TRIM(String)
315
316    DO i=1,Nvalues-1
317      iend = INDEX(newString(ibeg:Lstring), charv)
318
319      IF (iend == 0) THEN
320        WRITE (numS,"(I3)")Nvalues - 1
321        msg = "String '" // TRIM(String) // "' does not have " // TRIM(numS) // " '" // charv // "' !!"
322        CALL ErrMsg(msg, fname, -1)
323      END IF
324
325      values(i) = newString(ibeg:ibeg+iend-2)
326      ibeg = ibeg+iend
327    END DO
328    values(Nvalues) = newString(ibeg:Lstring)
329
330  END SUBROUTINE split
331
332SUBROUTINE ErrMsg(msg, funcn, errN)
333! Subroutine to stop execution and provide an error message
334
335  IMPLICIT NONE
336
337  CHARACTER(LEN=*), INTENT(in)                           :: msg, funcn
338  INTEGER, INTENT(in)                                    :: errN
339
340! Local
341  CHARACTER(LEN=50)                                      :: emsg
342
343!!!!!!! Variables
344! msg: message to print with the error
345! funcn: name of the funciton, section to localize the error
346! errN: number of the error provided for a given FORTRAN function
347
348  emsg = 'ERORR -- error -- ERROR -- error'
349
350  IF (errN /= 0) THEN
351    PRINT *,TRiM(emsg)
352    PRINT *,'  ' // TRIM(funcn) // ': ' // TRIM(msg) // ' !!'
353    PRINT *,'    error number:', errN
354    STOP
355  END IF
356
357  RETURN
358
359END SUBROUTINE ErrMsg
360
361  CHARACTER(LEN=50) FUNCTION ErrWarnMsg(msg)
362! Function to print error/warning message
363
364    IMPLICIT NONE
365
366    CHARACTER(LEN=3), INTENT(in)                         :: msg
367! Local
368
369    fname = 'ErrWarnMsg'
370
371    IF (msg == 'err') THEN
372      ErrWarnMsg = 'ERROR -- error -- ERROR -- error'
373    ELSE IF (msg == 'wrn') THEN
374      ErrWarnMsg = 'WARNING -- warning -- WARNING -- warning'
375    ELSE
376      PRINT *,'ERROR -- error -- ERROR -- error'
377      PRINT *,'  ' // TRIM(fname) // ": '" // TRIM(msg) // "' does not exist!!"
378      STOP
379    END IF
380  END FUNCTION ErrWarnMsg
381
382END MODULE module_generic
Note: See TracBrowser for help on using the repository browser.