New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
errioipsl.f90 in branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/EXTERNAL/IOIPSL/src – NEMO

source: branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90 @ 5448

Last change on this file since 5448 was 5448, checked in by davestorkey, 9 years ago

Clear SVN keywords from UKMO/dev_r5021_nn_etau_revision branch.

File size: 6.5 KB
Line 
1MODULE errioipsl
2!-
3!$Id$
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     WRITE(n_l,'("Fatal error from IOIPSL. STOP in ipslerr with code")')
83     STOP 1
84   ENDIF
85!---------------------
86END SUBROUTINE ipslerr
87!===
88SUBROUTINE ipslerr_act (new_mode,old_mode)
89!!--------------------------------------------------------------------
90!! The "ipslerr_act" routine allows to know and modify
91!! the current "action mode" for the error messages,
92!! and reinitialize the error level values.
93!!
94!! SUBROUTINE ipslerr_act (new_mode,old_mode)
95!!
96!! Optional INPUT argument
97!!
98!! (I) new_mode : new error action mode
99!!                .TRUE.  -> STOP     in case of fatal error
100!!                .FALSE. -> CONTINUE in case of fatal error
101!!
102!! Optional OUTPUT argument
103!!
104!! (I) old_mode : current error action mode
105!!--------------------------------------------------------------------
106  IMPLICIT NONE
107!-
108  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode
109  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode
110!---------------------------------------------------------------------
111  IF (PRESENT(old_mode)) THEN
112    old_mode = lact_mode
113  ENDIF
114  IF (PRESENT(new_mode)) THEN
115    lact_mode = new_mode
116  ENDIF
117  ilv_cur = 0
118  ilv_max = 0
119!-------------------------
120END SUBROUTINE ipslerr_act
121!===
122SUBROUTINE ipslerr_inq (current_level,maximum_level)
123!!--------------------------------------------------------------------
124!! The "ipslerr_inq" routine allows to know
125!! the current level of the error messages
126!! and the maximum level encountered since the
127!! last call to "ipslerr_act".
128!!
129!! SUBROUTINE ipslerr_inq (current_level,maximum_level)
130!!
131!! Optional OUTPUT argument
132!!
133!! (I) current_level : current error level
134!! (I) maximum_level : maximum error level
135!!--------------------------------------------------------------------
136  IMPLICIT NONE
137!-
138  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level
139!---------------------------------------------------------------------
140  IF (PRESENT(current_level)) THEN
141    current_level = ilv_cur
142  ENDIF
143  IF (PRESENT(maximum_level)) THEN
144    maximum_level = ilv_max
145  ENDIF
146!-------------------------
147END SUBROUTINE ipslerr_inq
148!===
149SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
150!---------------------------------------------------------------------
151!- INPUT
152!- plev   : Category of message to be reported to the user
153!-          1 = Note to the user
154!-          2 = Warning to the user
155!-          3 = Fatal error
156!- pcname : Name of subroutine which has called histerr
157!- pstr1   
158!- pstr2  : String containing the explanations to the user
159!- pstr3
160!---------------------------------------------------------------------
161   IMPLICIT NONE
162!-
163   INTEGER :: plev
164   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
165!-
166   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
167  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
168  &     "WARNING FROM ROUTINE          ", &
169  &     "FATAL ERROR FROM ROUTINE      " /)
170!---------------------------------------------------------------------
171   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
172     WRITE(*,'("     ")')
173     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
174     WRITE(*,'(" --> ",A)') pstr1
175     WRITE(*,'(" --> ",A)') pstr2
176     WRITE(*,'(" --> ",A)') pstr3
177   ENDIF
178   IF (plev == 3) THEN
179     STOP 'Fatal error from IOIPSL. See stdout for more details'
180   ENDIF
181!---------------------
182END SUBROUTINE histerr
183!===
184SUBROUTINE ipsldbg (new_status,old_status)
185!!--------------------------------------------------------------------
186!! The "ipsldbg" routine
187!! allows to activate or deactivate the debug,
188!! and to know the current status of the debug.
189!!
190!! SUBROUTINE ipsldbg (new_status,old_status)
191!!
192!! Optional INPUT argument
193!!
194!! (L) new_status : new status of the debug
195!!
196!! Optional OUTPUT argument
197!!
198!! (L) old_status : current status of the debug
199!!--------------------------------------------------------------------
200  IMPLICIT NONE
201!-
202  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
203  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
204!---------------------------------------------------------------------
205  IF (PRESENT(old_status)) THEN
206    old_status = ioipsl_debug
207  ENDIF
208  IF (PRESENT(new_status)) THEN
209    ioipsl_debug = new_status
210  ENDIF
211!---------------------
212END SUBROUTINE ipsldbg
213!===
214!-------------------
215END MODULE errioipsl
Note: See TracBrowser for help on using the repository browser.