source: lmdz_wrf/trunk/tools/module_generic.F90 @ 1392

Last change on this file since 1392 was 1355, checked in by lfita, 8 years ago

Fixing some issues of the `reprojection' modules
Generalizing the use of `module_generic'
Definition of errormsg' and warnmsg' in 'module_generic.F90'

File size: 3.0 KB
RevLine 
[715]1MODULE module_generic
2! Module with generic functions
[1313]3! Index1DArrayR: Function to provide the first index of a given value inside a 1D real array
4! Index2DArrayR: Function to provide the first index of a given value inside a 2D real array
5! ErrWarnMsg: Function to print error/warning message
[715]6
[1184]7  INTEGER, PARAMETER                                     :: r_k = KIND(1.d0)
8  ! Fill value at 64 bits
9  REAL(r_k)                                              :: fillval64 = 1.e20
[1355]10  CHARACTER(len=50), PARAMETER                           :: errormsg = 'ERROR -- error -- ERROR -- error'
11  CHARACTER(len=50), PARAMETER                           :: warnmsg = 'WARNING -- warning -- WARNING -- warning'
[1184]12
[715]13  CONTAINS
14
[764]15  INTEGER FUNCTION Index1DArrayR(array1D, d1, val)
16! Function to provide the first index of a given value inside a 1D real array
17
18    IMPLICIT NONE
19
20    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
21    INTEGER, INTENT(in)                                  :: d1
22    REAL(r_k), INTENT(in)                                :: val
23    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: array1D
24
25! Local
26    INTEGER                                              :: i
27    CHARACTER(LEN=50)                                    :: fname
28
29    fname = 'Index1DArrayR'
30
31    Index1DArrayR = -1
32
33    DO i=1,d1
34      IF (array1d(i) == val) THEN
35        Index1DArrayR = i
36        EXIT
37      END IF
38    END DO
39
40  END FUNCTION Index1DArrayR
41
[715]42  FUNCTION Index2DArrayR(array2D, d1, d2, val)
43! Function to provide the first index of a given value inside a 2D real array
44
45    IMPLICIT NONE
46
47    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
48    INTEGER, INTENT(in)                                  :: d1, d2
49    REAL(r_k), INTENT(in)                                :: val
50    REAL(r_k), DIMENSION(d1,d2), INTENT(in)              :: array2D
51    INTEGER, DIMENSION(2)                                :: Index2DArrayR
52
53! Local
54    INTEGER                                              :: i, j
55    CHARACTER(LEN=50)                                    :: fname
56
57    fname = 'Index2DArrayR'
58
59    Index2DArrayR = -1
60
61    DO i=1,d1
62      DO j=1,d2
63        IF (array2d(i,j) == val) THEN
64          Index2DArrayR(1) = i
65          Index2DArrayR(2) = j
66          EXIT
67        END IF
68      END DO
69    END DO
70
71  END FUNCTION Index2DArrayR
72
73  CHARACTER(LEN=50) FUNCTION ErrWarnMsg(msg)
74! Function to print error/warning message
75
76    IMPLICIT NONE
77
78    CHARACTER(LEN=3), INTENT(in)                         :: msg
79! Local
80    CHARACTER(LEN=50)                                    :: fname
81
82    fname = 'ErrWarnMsg'
83
84    IF (msg == 'err') THEN
85      ErrWarnMsg = 'ERROR -- error -- ERROR -- error'
86    ELSE IF (msg == 'wrn') THEN
87      ErrWarnMsg = 'WARNING -- warning -- WARNING -- warning'
88    ELSE
89      PRINT *,'ERROR -- error -- ERROR -- error'
90      PRINT *,'  ' // TRIM(fname) // ": '" // TRIM(msg) // "' does not exist!!"
91      STOP
92    END IF
93  END FUNCTION ErrWarnMsg
94
95END MODULE module_generic
Note: See TracBrowser for help on using the repository browser.