source: LMDZ6/branches/IPSLCM6.0.15/libf/misc/ioipsl_errioipsl.F90 @ 3427

Last change on this file since 3427 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 6.6 KB
Line 
1!
2! $Id$
3!
4! Module/Routines extracted from IOIPSL v2_1_8
5!
6MODULE 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!---------------------------------------------------------------------
13IMPLICIT NONE
14!-
15PRIVATE
16!-
17PUBLIC :: 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!===
23CONTAINS
24!===
25SUBROUTINE 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!---------------------
52END SUBROUTINE ipslnlf
53!===
54SUBROUTINE 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!---------------------
90END SUBROUTINE ipslerr
91!===
92SUBROUTINE 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!-------------------------
124END SUBROUTINE ipslerr_act
125!===
126SUBROUTINE 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!-------------------------
151END SUBROUTINE ipslerr_inq
152!===
153SUBROUTINE 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!---------------------
186END SUBROUTINE histerr
187!===
188SUBROUTINE 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!---------------------
216END SUBROUTINE ipsldbg
217!===
218!-------------------
219END MODULE ioipsl_errioipsl
Note: See TracBrowser for help on using the repository browser.