source: IOIPSL/trunk/src/errioipsl.f90 @ 11

Last change on this file since 11 was 11, checked in by bellier, 15 years ago

JB: on the road to svn

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