source: vendors/IOIPSL/current/src/errioipsl.f90 @ 1895

Last change on this file since 1895 was 1895, checked in by flavoni, 11 years ago

importing IOIPSL on vendors

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