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

Last change on this file since 1616 was 1615, checked in by lfita, 8 years ago

Adding

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