Oasis3-MCT
 All Classes Files Functions Variables Macros Pages
mod_oasis_sys.F90
Go to the documentation of this file.
1 
2 !> System type methods
3 
5 
8 
9  IMPLICIT NONE
10 
11  character(len=*),parameter,public :: astr = ' ABORT: ' ! abort string
12  character(len=*),parameter,public :: estr = ' ERROR: ' ! error string
13  character(len=*),parameter,public :: wstr = ' WARNING: ' ! warning string
14 
15  private
16 
17  public oasis_abort
18  public oasis_flush
19  public oasis_unitsetmin
20  public oasis_unitget
21  public oasis_unitfree
22  public oasis_debug_enter
23  public oasis_debug_exit
24  public oasis_debug_note
25 
26  integer(ip_intwp_p),parameter :: muni = 20
27  integer(ip_intwp_p),save :: unitno(muni) = -1
28  integer(ip_intwp_p),save :: maxion
29  integer(ip_intwp_p),parameter :: tree_delta = 2
30  integer(ip_intwp_p),save :: tree_indent = 0
31 
32 !--------------------------------------------------------------------
33 CONTAINS
34 !--------------------------------------------------------------------
35 
36 !--------------------------------------------------------------------
37 
38 !> OASIS abort method, publically available to users
39 
40  SUBROUTINE oasis_abort(id_compid, cd_routine, cd_message)
41 
42  IMPLICIT NONE
43 !--------------------------------------------------------------------
44  INTEGER(kind=ip_intwp_p),INTENT(in),optional :: id_compid !< component id
45  CHARACTER(len=*), INTENT(in),optional :: cd_routine !< string defining calling routine
46  CHARACTER(len=*), INTENT(in),optional :: cd_message !< error message string
47 !--------------------------------------------------------------------
48  INTEGER :: ierror
49  character(len=*),parameter :: subname = '(oasis_abort)'
50 !--------------------------------------------------------------------
51 
52  if (present(id_compid)) &
53  WRITE (nulprt,*) subname,astr,'compid = ',id_compid
54  if (present(cd_routine)) &
55  WRITE (nulprt,*) subname,astr,'called by = ',trim(cd_routine)
56  if (present(cd_message)) &
57  WRITE (nulprt,*) subname,astr,'message = ',trim(cd_message)
58 
59  WRITE (nulprt,*) subname,astr,'on model = ',trim(compnm)
60  WRITE (nulprt,*) subname,astr,'on global rank = ',mpi_rank_global
61  WRITE (nulprt,*) subname,astr,'on local rank = ',mpi_rank_local
62  WRITE (nulprt,*) subname,astr,'CALLING ABORT FROM OASIS LAYER NOW'
63  CALL oasis_flush(nulprt)
64 
65 #if defined use_comm_MPI1 || defined use_comm_MPI2
66  CALL mpi_abort(mpi_comm_global, 0, ierror)
67 #endif
68 
69  stop
70 
71  END SUBROUTINE oasis_abort
72 
73 !==========================================================================
74 
75 !> Flushes output to file
76 
77  SUBROUTINE oasis_flush(nu)
78 
79  IMPLICIT NONE
80 
81 !--------------------------------------------------------------------
82  INTEGER(kind=ip_intwp_p),INTENT(in) :: nu !< unit number of file
83 !--------------------------------------------------------------------
84  character(len=*),parameter :: subname = '(oasis_flush)'
85 !--------------------------------------------------------------------
86 
87  CALL FLUSH(nu)
88 
89  END SUBROUTINE oasis_flush
90 
91 !==========================================================================
92 
93 !> Get a free unit number
94 
95  SUBROUTINE oasis_unitget(uio)
96 
97  IMPLICIT NONE
98 
99 !--------------------------------------------------------------------
100  INTEGER(kind=ip_intwp_p),INTENT(out) :: uio !< unit number
101 !--------------------------------------------------------------------
102  INTEGER(kind=ip_intwp_p) :: n1
103  logical :: found
104  character(len=*),parameter :: subname = '(oasis_unitget)'
105 !--------------------------------------------------------------------
106 
107  n1 = 0
108  found = .false.
109  do while (n1 < muni .and. .not.found)
110  n1 = n1 + 1
111  if (unitno(n1) < 0) then
112  found = .true.
113  uio = n1 + maxion
114  unitno(n1) = uio
115  if (oasis_debug >= 2) write(nulprt,*) subname,n1,uio
116  endif
117  enddo
118 
119  if (.not.found) then
120  write(nulprt,*) subname,estr,'no unit number available '
121  call oasis_abort()
122  endif
123 
124  END SUBROUTINE oasis_unitget
125 
126 !==========================================================================
127 
128 !> Set the minimum unit number allowed
129 
130  SUBROUTINE oasis_unitsetmin(uio)
131 
132  IMPLICIT NONE
133 
134 !--------------------------------------------------------------------
135  INTEGER(kind=ip_intwp_p),INTENT(in) :: uio !< unit number
136 !--------------------------------------------------------------------
137  character(len=*),parameter :: subname = '(oasis_unitsetmin)'
138 !--------------------------------------------------------------------
139 
140  maxion = uio
141  if (oasis_debug >= 20) write(nulprt,*) subname,maxion
142 
143  END SUBROUTINE oasis_unitsetmin
144 
145 !==========================================================================
146 
147 !> Release a unit number for reuse
148 
149  SUBROUTINE oasis_unitfree(uio)
150 
151  IMPLICIT NONE
152 
153 !--------------------------------------------------------------------
154  INTEGER(kind=ip_intwp_p),INTENT(in) :: uio !< unit number
155 !--------------------------------------------------------------------
156  INTEGER(kind=ip_intwp_p) :: n1
157  character(len=*),parameter :: subname = '(oasis_unitfree)'
158 !--------------------------------------------------------------------
159 
160  do n1 = 1,muni
161  if (unitno(n1) == uio) then
162  unitno(n1) = -1
163  if (oasis_debug >= 20) write(nulprt,*) subname,n1,uio
164  endif
165  enddo
166 
167  END SUBROUTINE oasis_unitfree
168 
169 !=========================================================================
170 !==========================================================================
171 
172 !> Used when a subroutine is entered, write info to log file at some debug level
173 
174 SUBROUTINE oasis_debug_enter(string)
175 
176  IMPLICIT NONE
177 
178 !--------------------------------------------------------------------
179  CHARACTER(len=*), INTENT(in) :: string !< name of the subroutine
180 
181  character(len=*),parameter :: subname = '(oasis_debug_enter)'
182  CHARACTER(len=1), pointer :: ch_blank(:)
183  CHARACTER(len=500) :: tree_enter
184 
185  if (oasis_debug >= 10) then
186  ALLOCATE (ch_blank(tree_indent))
187  ch_blank='-'
188  tree_enter='-- ENTER '//trim(string)
189  WRITE(nulprt,*) ch_blank,trim(tree_enter)
190  tree_indent = tree_indent + tree_delta
191  DEALLOCATE (ch_blank)
192  CALL oasis_flush(nulprt)
193  endif
194 
195  END SUBROUTINE oasis_debug_enter
196 
197 !==========================================================================
198 
199 !> Used when a subroutine is exited, write info to log file at some debug level
200 
201 SUBROUTINE oasis_debug_exit(string)
202 
203  IMPLICIT NONE
204 
205 !--------------------------------------------------------------------
206  CHARACTER(len=*), INTENT(in) :: string !< name of subroutine
207 
208  character(len=*),parameter :: subname = '(oasis_debug_exit)'
209  CHARACTER(len=1), pointer :: ch_blank(:)
210  CHARACTER(len=500) :: tree_exit
211 
212  IF (oasis_debug >= 10) THEN
213  tree_indent = max(0,tree_indent - tree_delta)
214  ALLOCATE (ch_blank(tree_indent))
215  ch_blank='-'
216  tree_exit='-- EXIT '//trim(string)
217  WRITE(nulprt,*) ch_blank,trim(tree_exit)
218  DEALLOCATE (ch_blank)
219  CALL oasis_flush(nulprt)
220  ENDIF
221 
222  END SUBROUTINE oasis_debug_exit
223 
224 !==========================================================================
225 
226 !> Used to write information from a subroutine, write info to log file at some debug level
227 
228 SUBROUTINE oasis_debug_note(string)
229 
230  IMPLICIT NONE
231 
232 !--------------------------------------------------------------------
233  CHARACTER(len=*), INTENT(in) :: string !< string to write
234 
235  character(len=*),parameter :: subname = '(oasis_debug_note)'
236  CHARACTER(len=1), pointer :: ch_blank(:)
237  CHARACTER(len=500) :: tree_note
238 
239  if (oasis_debug >= 12) then
240  ALLOCATE (ch_blank(tree_indent))
241  ch_blank='-'
242  tree_note='-- NOTE '//trim(string)
243  WRITE(nulprt,*) ch_blank,trim(tree_note)
244  DEALLOCATE(ch_blank)
245  call oasis_flush(nulprt)
246  endif
247 
248  END SUBROUTINE oasis_debug_note
249 
250 !==========================================================================
251 
252 END MODULE mod_oasis_sys
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
System type methods.
subroutine, public oasis_unitsetmin(uio)
Set the minimum unit number allowed.
Provides a common location for several OASIS variables.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
Defines kinds for OASIS.
subroutine, public oasis_debug_note(string)
Used to write information from a subroutine, write info to log file at some debug level...
subroutine, public oasis_flush(nu)
Flushes output to file.
subroutine, public oasis_unitget(uio)
Get a free unit number.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine, public oasis_unitfree(uio)
Release a unit number for reuse.