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

Last change on this file since 4 was 4, checked in by rblod, 16 years ago

First import of IOIPSL sources

File size: 4.5 KB
Line 
1!$Header: /home/ioipsl/CVSROOT/IOIPSL/src/errioipsl.f90,v 2.2 2005/02/22 10:14:14 adm Exp $
2!-
3MODULE errioipsl
4!---------------------------------------------------------------------
5IMPLICIT NONE
6!-
7PRIVATE
8!-
9PUBLIC :: ipslnlf, ipslerr, histerr, ipsldbg
10!-
11  INTEGER :: n_l=6
12  LOGICAL :: ioipsl_debug=.FALSE.
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     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
74     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
75   ENDIF
76   IF (plev == 3) THEN
77     STOP 'Fatal error from IOIPSL. See stdout for more details'
78   ENDIF
79!---------------------
80END SUBROUTINE ipslerr
81!===
82SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
83!---------------------------------------------------------------------
84!- INPUT
85!- plev   : Category of message to be reported to the user
86!-          1 = Note to the user
87!-          2 = Warning to the user
88!-          3 = Fatal error
89!- pcname : Name of subroutine which has called histerr
90!- pstr1   
91!- pstr2  : String containing the explanations to the user
92!- pstr3
93!---------------------------------------------------------------------
94   IMPLICIT NONE
95!-
96   INTEGER :: plev
97   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
98!-
99   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
100  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
101  &     "WARNING FROM ROUTINE          ", &
102  &     "FATAL ERROR FROM ROUTINE      " /)
103!---------------------------------------------------------------------
104   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
105     WRITE(*,'("     ")')
106     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
107     WRITE(*,'(" --> ",A)') pstr1
108     WRITE(*,'(" --> ",A)') pstr2
109     WRITE(*,'(" --> ",A)') pstr3
110   ENDIF
111   IF (plev == 3) THEN
112     STOP 'Fatal error from IOIPSL. See stdout for more details'
113   ENDIF
114!---------------------
115END SUBROUTINE histerr
116!===
117SUBROUTINE ipsldbg (new_status,old_status)
118!!--------------------------------------------------------------------
119!! The "ipsldbg" routine
120!! allows to activate or deactivate the debug,
121!! and to know the current status of the debug.
122!!
123!! SUBROUTINE ipsldbg (new_status,old_status)
124!!
125!! Optional INPUT argument
126!!
127!! (L) new_status : new status of the debug
128!!
129!! Optional OUTPUT argument
130!!
131!! (L) old_status : current status of the debug
132!!--------------------------------------------------------------------
133  IMPLICIT NONE
134!-
135  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
136  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
137!---------------------------------------------------------------------
138  IF (PRESENT(old_status)) THEN
139    old_status = ioipsl_debug
140  ENDIF
141  IF (PRESENT(new_status)) THEN
142    ioipsl_debug = new_status
143  ENDIF
144!---------------------
145END SUBROUTINE ipsldbg
146!===
147!-------------------
148END MODULE errioipsl
Note: See TracBrowser for help on using the repository browser.