1 |
|
|
! |
2 |
|
|
! $Id$ |
3 |
|
|
! |
4 |
|
|
! Module/Routines extracted from IOIPSL v2_1_8 |
5 |
|
|
! |
6 |
|
|
MODULE ioipsl_errioipsl |
7 |
|
|
!- |
8 |
|
|
!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $ |
9 |
|
|
!- |
10 |
|
|
! This software is governed by the CeCILL license |
11 |
|
|
! See IOIPSL/IOIPSL_License_CeCILL.txt |
12 |
|
|
!--------------------------------------------------------------------- |
13 |
|
|
IMPLICIT NONE |
14 |
|
|
!- |
15 |
|
|
PRIVATE |
16 |
|
|
!- |
17 |
|
|
PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg |
18 |
|
|
!- |
19 |
|
|
INTEGER :: n_l=6, ilv_cur=0, ilv_max=0 |
20 |
|
|
LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE. |
21 |
|
|
!- |
22 |
|
|
!=== |
23 |
|
|
CONTAINS |
24 |
|
|
!=== |
25 |
|
|
SUBROUTINE ipslnlf (new_number,old_number) |
26 |
|
|
!!-------------------------------------------------------------------- |
27 |
|
|
!! The "ipslnlf" routine allows to know and modify |
28 |
|
|
!! the current logical number for the messages. |
29 |
|
|
!! |
30 |
|
|
!! SUBROUTINE ipslnlf (new_number,old_number) |
31 |
|
|
!! |
32 |
|
|
!! Optional INPUT argument |
33 |
|
|
!! |
34 |
|
|
!! (I) new_number : new logical number of the file |
35 |
|
|
!! |
36 |
|
|
!! Optional OUTPUT argument |
37 |
|
|
!! |
38 |
|
|
!! (I) old_number : current logical number of the file |
39 |
|
|
!!-------------------------------------------------------------------- |
40 |
|
|
IMPLICIT NONE |
41 |
|
|
!- |
42 |
|
|
INTEGER,OPTIONAL,INTENT(IN) :: new_number |
43 |
|
|
INTEGER,OPTIONAL,INTENT(OUT) :: old_number |
44 |
|
|
!--------------------------------------------------------------------- |
45 |
|
|
IF (PRESENT(old_number)) THEN |
46 |
|
|
old_number = n_l |
47 |
|
|
ENDIF |
48 |
|
|
IF (PRESENT(new_number)) THEN |
49 |
|
|
n_l = new_number |
50 |
|
|
ENDIF |
51 |
|
|
!--------------------- |
52 |
|
|
END SUBROUTINE ipslnlf |
53 |
|
|
!=== |
54 |
|
|
SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3) |
55 |
|
|
!--------------------------------------------------------------------- |
56 |
|
|
!! The "ipslerr" routine |
57 |
|
|
!! allows to handle the messages to the user. |
58 |
|
|
!! |
59 |
|
|
!! INPUT |
60 |
|
|
!! |
61 |
|
|
!! plev : Category of message to be reported to the user |
62 |
|
|
!! 1 = Note to the user |
63 |
|
|
!! 2 = Warning to the user |
64 |
|
|
!! 3 = Fatal error |
65 |
|
|
!! pcname : Name of subroutine which has called ipslerr |
66 |
|
|
!! pstr1 |
67 |
|
|
!! pstr2 : Strings containing the explanations to the user |
68 |
|
|
!! pstr3 |
69 |
|
|
!--------------------------------------------------------------------- |
70 |
|
|
IMPLICIT NONE |
71 |
|
|
!- |
72 |
|
|
INTEGER :: plev |
73 |
|
|
CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3 |
74 |
|
|
!- |
75 |
|
|
CHARACTER(LEN=30),DIMENSION(3) :: pemsg = & |
76 |
|
|
& (/ "NOTE TO THE USER FROM ROUTINE ", & |
77 |
|
|
& "WARNING FROM ROUTINE ", & |
78 |
|
|
& "FATAL ERROR FROM ROUTINE " /) |
79 |
|
|
!--------------------------------------------------------------------- |
80 |
|
|
IF ( (plev >= 1).AND.(plev <= 3) ) THEN |
81 |
|
|
ilv_cur = plev |
82 |
|
|
ilv_max = MAX(ilv_max,plev) |
83 |
|
|
WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname) |
84 |
|
|
WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3) |
85 |
|
|
ENDIF |
86 |
|
|
IF ( (plev == 3).AND.lact_mode) THEN |
87 |
|
|
STOP 'Fatal error from IOIPSL. See stdout for more details' |
88 |
|
|
ENDIF |
89 |
|
|
!--------------------- |
90 |
|
|
END SUBROUTINE ipslerr |
91 |
|
|
!=== |
92 |
|
|
SUBROUTINE ipslerr_act (new_mode,old_mode) |
93 |
|
|
!!-------------------------------------------------------------------- |
94 |
|
|
!! The "ipslerr_act" routine allows to know and modify |
95 |
|
|
!! the current "action mode" for the error messages, |
96 |
|
|
!! and reinitialize the error level values. |
97 |
|
|
!! |
98 |
|
|
!! SUBROUTINE ipslerr_act (new_mode,old_mode) |
99 |
|
|
!! |
100 |
|
|
!! Optional INPUT argument |
101 |
|
|
!! |
102 |
|
|
!! (I) new_mode : new error action mode |
103 |
|
|
!! .TRUE. -> STOP in case of fatal error |
104 |
|
|
!! .FALSE. -> CONTINUE in case of fatal error |
105 |
|
|
!! |
106 |
|
|
!! Optional OUTPUT argument |
107 |
|
|
!! |
108 |
|
|
!! (I) old_mode : current error action mode |
109 |
|
|
!!-------------------------------------------------------------------- |
110 |
|
|
IMPLICIT NONE |
111 |
|
|
!- |
112 |
|
|
LOGICAL,OPTIONAL,INTENT(IN) :: new_mode |
113 |
|
|
LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode |
114 |
|
|
!--------------------------------------------------------------------- |
115 |
|
|
IF (PRESENT(old_mode)) THEN |
116 |
|
|
old_mode = lact_mode |
117 |
|
|
ENDIF |
118 |
|
|
IF (PRESENT(new_mode)) THEN |
119 |
|
|
lact_mode = new_mode |
120 |
|
|
ENDIF |
121 |
|
|
ilv_cur = 0 |
122 |
|
|
ilv_max = 0 |
123 |
|
|
!------------------------- |
124 |
|
|
END SUBROUTINE ipslerr_act |
125 |
|
|
!=== |
126 |
|
|
SUBROUTINE ipslerr_inq (current_level,maximum_level) |
127 |
|
|
!!-------------------------------------------------------------------- |
128 |
|
|
!! The "ipslerr_inq" routine allows to know |
129 |
|
|
!! the current level of the error messages |
130 |
|
|
!! and the maximum level encountered since the |
131 |
|
|
!! last call to "ipslerr_act". |
132 |
|
|
!! |
133 |
|
|
!! SUBROUTINE ipslerr_inq (current_level,maximum_level) |
134 |
|
|
!! |
135 |
|
|
!! Optional OUTPUT argument |
136 |
|
|
!! |
137 |
|
|
!! (I) current_level : current error level |
138 |
|
|
!! (I) maximum_level : maximum error level |
139 |
|
|
!!-------------------------------------------------------------------- |
140 |
|
|
IMPLICIT NONE |
141 |
|
|
!- |
142 |
|
|
INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level |
143 |
|
|
!--------------------------------------------------------------------- |
144 |
|
|
IF (PRESENT(current_level)) THEN |
145 |
|
|
current_level = ilv_cur |
146 |
|
|
ENDIF |
147 |
|
|
IF (PRESENT(maximum_level)) THEN |
148 |
|
|
maximum_level = ilv_max |
149 |
|
|
ENDIF |
150 |
|
|
!------------------------- |
151 |
|
|
END SUBROUTINE ipslerr_inq |
152 |
|
|
!=== |
153 |
|
|
SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3) |
154 |
|
|
!--------------------------------------------------------------------- |
155 |
|
|
!- INPUT |
156 |
|
|
!- plev : Category of message to be reported to the user |
157 |
|
|
!- 1 = Note to the user |
158 |
|
|
!- 2 = Warning to the user |
159 |
|
|
!- 3 = Fatal error |
160 |
|
|
!- pcname : Name of subroutine which has called histerr |
161 |
|
|
!- pstr1 |
162 |
|
|
!- pstr2 : String containing the explanations to the user |
163 |
|
|
!- pstr3 |
164 |
|
|
!--------------------------------------------------------------------- |
165 |
|
|
IMPLICIT NONE |
166 |
|
|
!- |
167 |
|
|
INTEGER :: plev |
168 |
|
|
CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3 |
169 |
|
|
!- |
170 |
|
|
CHARACTER(LEN=30),DIMENSION(3) :: pemsg = & |
171 |
|
|
& (/ "NOTE TO THE USER FROM ROUTINE ", & |
172 |
|
|
& "WARNING FROM ROUTINE ", & |
173 |
|
|
& "FATAL ERROR FROM ROUTINE " /) |
174 |
|
|
!--------------------------------------------------------------------- |
175 |
|
|
IF ( (plev >= 1).AND.(plev <= 3) ) THEN |
176 |
|
|
WRITE(*,'(" ")') |
177 |
|
|
WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname) |
178 |
|
|
WRITE(*,'(" --> ",A)') pstr1 |
179 |
|
|
WRITE(*,'(" --> ",A)') pstr2 |
180 |
|
|
WRITE(*,'(" --> ",A)') pstr3 |
181 |
|
|
ENDIF |
182 |
|
|
IF (plev == 3) THEN |
183 |
|
|
STOP 'Fatal error from IOIPSL. See stdout for more details' |
184 |
|
|
ENDIF |
185 |
|
|
!--------------------- |
186 |
|
|
END SUBROUTINE histerr |
187 |
|
|
!=== |
188 |
|
|
SUBROUTINE ipsldbg (new_status,old_status) |
189 |
|
|
!!-------------------------------------------------------------------- |
190 |
|
|
!! The "ipsldbg" routine |
191 |
|
|
!! allows to activate or deactivate the debug, |
192 |
|
|
!! and to know the current status of the debug. |
193 |
|
|
!! |
194 |
|
|
!! SUBROUTINE ipsldbg (new_status,old_status) |
195 |
|
|
!! |
196 |
|
|
!! Optional INPUT argument |
197 |
|
|
!! |
198 |
|
|
!! (L) new_status : new status of the debug |
199 |
|
|
!! |
200 |
|
|
!! Optional OUTPUT argument |
201 |
|
|
!! |
202 |
|
|
!! (L) old_status : current status of the debug |
203 |
|
|
!!-------------------------------------------------------------------- |
204 |
|
|
IMPLICIT NONE |
205 |
|
|
!- |
206 |
|
|
LOGICAL,OPTIONAL,INTENT(IN) :: new_status |
207 |
|
|
LOGICAL,OPTIONAL,INTENT(OUT) :: old_status |
208 |
|
|
!--------------------------------------------------------------------- |
209 |
|
|
IF (PRESENT(old_status)) THEN |
210 |
|
|
old_status = ioipsl_debug |
211 |
|
|
ENDIF |
212 |
|
|
IF (PRESENT(new_status)) THEN |
213 |
|
|
ioipsl_debug = new_status |
214 |
|
|
ENDIF |
215 |
|
|
!--------------------- |
216 |
|
|
END SUBROUTINE ipsldbg |
217 |
|
|
!=== |
218 |
|
|
!------------------- |
219 |
|
|
END MODULE ioipsl_errioipsl |