Line data Source code
1 : !=======================================================================
2 : !
3 : ! This module contains an I/O unit manager for tracking, assigning
4 : ! and reserving I/O unit numbers.
5 : !
6 : ! There are three reserved I/O units set as parameters in this
7 : ! module. The default units for standard input (stdin), standard
8 : ! output (stdout) and standard error (stderr). These are currently
9 : ! set as units 5,6,6, respectively as that is the most commonly
10 : ! used among vendors. However, the user may change these if those
11 : ! default units are conflicting with other models or if the
12 : ! vendor is using different values.
13 : !
14 : ! The maximum number of I/O units per node is currently set by
15 : ! the parameter ice\_IOMaxUnit.
16 : !
17 : ! author: Elizabeth C. Hunke, LANL
18 : ! 2006: ECH converted to free source form (F90)
19 : ! 2007: ECH added dynamic file units, modified from POP_IOUnitsMod.F90
20 :
21 : module ice_fileunits
22 :
23 : use ice_kinds_mod
24 : #ifdef CESMCOUPLED
25 : use shr_file_mod, only : shr_file_getunit, shr_file_freeunit
26 : #endif
27 :
28 : implicit none
29 : private
30 : public :: init_fileunits, get_fileunit, flush_fileunit, &
31 : release_fileunit, release_all_fileunits, & ! LCOV_EXCL_LINE
32 : goto_nml
33 :
34 : character (len=char_len), public :: &
35 : diag_type ! 'stdout' or 'file'
36 :
37 : character (len=char_len), public :: &
38 : bfbflag ! method for bit-for-bit computations
39 :
40 : integer (kind=int_kind), public :: &
41 : nu_grid , & ! grid file ! LCOV_EXCL_LINE
42 : nu_kmt , & ! land mask file ! LCOV_EXCL_LINE
43 : nu_nml , & ! namelist input file ! LCOV_EXCL_LINE
44 : nu_forcing , & ! forcing data file ! LCOV_EXCL_LINE
45 : nu_dump , & ! dump file for restarting ! LCOV_EXCL_LINE
46 : nu_restart , & ! restart input file ! LCOV_EXCL_LINE
47 : nu_dump_age , & ! dump file for restarting ice age tracer ! LCOV_EXCL_LINE
48 : nu_restart_age, & ! restart input file for ice age tracer ! LCOV_EXCL_LINE
49 : nu_dump_FY , & ! dump file for restarting first-year area tracer ! LCOV_EXCL_LINE
50 : nu_restart_FY , & ! restart input file for first-year area tracer ! LCOV_EXCL_LINE
51 : nu_dump_lvl , & ! dump file for restarting level ice tracers ! LCOV_EXCL_LINE
52 : nu_restart_lvl, & ! restart input file for level ice tracers ! LCOV_EXCL_LINE
53 : nu_dump_pond , & ! dump file for restarting melt pond tracer ! LCOV_EXCL_LINE
54 : nu_restart_pond,& ! restart input file for melt pond tracer ! LCOV_EXCL_LINE
55 : nu_dump_snow , & ! dump file for restarting snow redist/metamorph tracers ! LCOV_EXCL_LINE
56 : nu_restart_snow,& ! restart input file for snow redist/metamorph tracers ! LCOV_EXCL_LINE
57 : nu_dump_fsd , & ! dump file for restarting floe size distribution ! LCOV_EXCL_LINE
58 : nu_restart_fsd, & ! restart input file for floe size distribution ! LCOV_EXCL_LINE
59 : nu_dump_iso , & ! dump file for restarting isotope tracers ! LCOV_EXCL_LINE
60 : nu_restart_iso, & ! restart input file for isotope tracers ! LCOV_EXCL_LINE
61 : nu_dump_aero , & ! dump file for restarting aerosol tracer ! LCOV_EXCL_LINE
62 : nu_restart_aero,& ! restart input file for aerosol tracer ! LCOV_EXCL_LINE
63 : nu_dump_bgc , & ! dump file for restarting bgc ! LCOV_EXCL_LINE
64 : nu_restart_bgc, & ! restart input file for bgc ! LCOV_EXCL_LINE
65 : nu_dump_hbrine, & ! dump file for restarting hbrine ! LCOV_EXCL_LINE
66 : nu_restart_hbrine, & ! restart input file for hbrine ! LCOV_EXCL_LINE
67 : nu_dump_eap , & ! dump file for restarting eap dynamics ! LCOV_EXCL_LINE
68 : nu_restart_eap, & ! restart input file for eap dynamics ! LCOV_EXCL_LINE
69 : nu_rst_pointer, & ! pointer to latest restart file ! LCOV_EXCL_LINE
70 : nu_history , & ! binary history output file ! LCOV_EXCL_LINE
71 : nu_hdr ! header file for binary history output
72 :
73 : character (32), public :: &
74 : nml_filename = 'ice_in' ! namelist input file name
75 :
76 : integer (kind=int_kind), parameter, public :: &
77 : ice_stdin = 5, & ! reserved unit for standard input ! LCOV_EXCL_LINE
78 : ice_stdout = 6, & ! reserved unit for standard output ! LCOV_EXCL_LINE
79 : ice_stderr = 6 ! reserved unit for standard error
80 :
81 : integer (kind=int_kind), public :: &
82 : nu_diag = ice_stdout ! diagnostics output file, unit number may be overwritten
83 :
84 : logical (kind=log_kind), public :: &
85 : nu_diag_set = .false. ! flag to indicate whether nu_diag is already set
86 :
87 : integer (kind=int_kind), public :: &
88 : ice_IOUnitsMinUnit = 11, & ! do not use unit numbers below ! LCOV_EXCL_LINE
89 : ice_IOUnitsMaxUnit = 99 ! or above, set by setup_nml
90 :
91 : logical (kind=log_kind), dimension(:), allocatable :: &
92 : ice_IOUnitsInUse ! flag=.true. if unit currently open
93 :
94 : ! instance control
95 : integer (kind=int_kind), public :: inst_index
96 : character(len=16) , public :: inst_name
97 : character(len=16) , public :: inst_suffix
98 :
99 : !=======================================================================
100 :
101 : contains
102 :
103 : !=======================================================================
104 :
105 : ! This routine grabs needed unit numbers.
106 : ! nu_diag is set to 6 (stdout) but may be reset later by the namelist.
107 : ! nu_nml is obtained separately.
108 :
109 37 : subroutine init_fileunits
110 :
111 : character(len=*),parameter :: subname='(init_fileunits)'
112 :
113 37 : if (.not.allocated(ice_IOUnitsInUse)) allocate(ice_IOUnitsInUse(ice_IOUnitsMaxUnit))
114 3700 : ice_IOUnitsInUse = .false.
115 :
116 37 : ice_IOUnitsInUse(ice_stdin) = .true. ! reserve unit 5
117 37 : ice_IOUnitsInUse(ice_stdout) = .true. ! reserve unit 6
118 37 : ice_IOUnitsInUse(ice_stderr) = .true.
119 37 : if (nu_diag >= 1 .and. nu_diag <= ice_IOUnitsMaxUnit) &
120 37 : ice_IOUnitsInUse(nu_diag) = .true. ! reserve unit nu_diag
121 : #ifdef CESMCOUPLED
122 : ! CESM can have negative unit numbers.
123 : if (nu_diag < 0) nu_diag_set = .true.
124 : #endif
125 :
126 37 : call get_fileunit(nu_grid)
127 37 : call get_fileunit(nu_kmt)
128 37 : call get_fileunit(nu_forcing)
129 37 : call get_fileunit(nu_dump)
130 37 : call get_fileunit(nu_restart)
131 37 : call get_fileunit(nu_dump_age)
132 37 : call get_fileunit(nu_restart_age)
133 37 : call get_fileunit(nu_dump_FY)
134 37 : call get_fileunit(nu_restart_FY)
135 37 : call get_fileunit(nu_dump_lvl)
136 37 : call get_fileunit(nu_restart_lvl)
137 37 : call get_fileunit(nu_dump_pond)
138 37 : call get_fileunit(nu_restart_pond)
139 37 : call get_fileunit(nu_dump_snow)
140 37 : call get_fileunit(nu_restart_snow)
141 37 : call get_fileunit(nu_dump_fsd)
142 37 : call get_fileunit(nu_restart_fsd)
143 37 : call get_fileunit(nu_dump_iso)
144 37 : call get_fileunit(nu_restart_iso)
145 37 : call get_fileunit(nu_dump_aero)
146 37 : call get_fileunit(nu_restart_aero)
147 37 : call get_fileunit(nu_dump_bgc)
148 37 : call get_fileunit(nu_restart_bgc)
149 37 : call get_fileunit(nu_dump_hbrine)
150 37 : call get_fileunit(nu_restart_hbrine)
151 37 : call get_fileunit(nu_dump_eap)
152 37 : call get_fileunit(nu_restart_eap)
153 37 : call get_fileunit(nu_rst_pointer)
154 37 : call get_fileunit(nu_history)
155 37 : call get_fileunit(nu_hdr)
156 :
157 37 : end subroutine init_fileunits
158 :
159 : !=======================================================================
160 :
161 : ! This routine returns the next available I/O unit and marks it as
162 : ! in use to prevent any later use.
163 : ! Note that {\em all} processors must call this routine even if only
164 : ! the master task is doing the I/O. This is necessary insure that
165 : ! the units remain synchronized for other parallel I/O functions.
166 :
167 1166 : subroutine get_fileunit(iunit)
168 :
169 : integer (kind=int_kind), intent(out) :: &
170 : iunit ! next free I/O unit
171 :
172 : ! local variables
173 :
174 : #ifndef CESMCOUPLED
175 : integer (kind=int_kind) :: n ! dummy loop index
176 : logical (kind=log_kind) :: alreadyInUse
177 : #endif
178 :
179 : character(len=*),parameter :: subname='(get_fileunit)'
180 :
181 : #ifdef CESMCOUPLED
182 : iunit = shr_file_getUnit()
183 : #else
184 :
185 18451 : srch_units: do n=ice_IOUnitsMinUnit, ice_IOUnitsMaxUnit
186 18451 : if (.not. ice_IOUnitsInUse(n)) then ! I found one, I found one
187 :
188 : !*** make sure not in use by library or calling routines
189 1166 : INQUIRE (unit=n,OPENED=alreadyInUse)
190 :
191 1166 : if (.not. alreadyInUse) then
192 1166 : iunit = n ! return the free unit number
193 1166 : ice_IOUnitsInUse(iunit) = .true. ! mark iunit as being in use
194 1166 : exit srch_units
195 : else
196 : !*** if inquire shows this unit in use, mark it as
197 : !*** in use to prevent further queries
198 0 : ice_IOUnitsInUse(n) = .true.
199 : endif
200 : endif
201 : end do srch_units
202 :
203 1166 : if (iunit > ice_IOUnitsMaxUnit) stop 'ice_IOUnitsGet: No free units'
204 :
205 : #endif
206 :
207 1166 : end subroutine get_fileunit
208 :
209 : !=======================================================================
210 :
211 : ! This routine releases unit numbers at the end of a run.
212 :
213 37 : subroutine release_all_fileunits
214 :
215 : character(len=*),parameter :: subname='(release_all_fileunits)'
216 :
217 37 : call release_fileunit(nu_grid)
218 37 : call release_fileunit(nu_kmt)
219 37 : call release_fileunit(nu_forcing)
220 37 : call release_fileunit(nu_dump)
221 37 : call release_fileunit(nu_restart)
222 37 : call release_fileunit(nu_dump_age)
223 37 : call release_fileunit(nu_restart_age)
224 37 : call release_fileunit(nu_dump_FY)
225 37 : call release_fileunit(nu_restart_FY)
226 37 : call release_fileunit(nu_dump_lvl)
227 37 : call release_fileunit(nu_restart_lvl)
228 37 : call release_fileunit(nu_dump_pond)
229 37 : call release_fileunit(nu_restart_pond)
230 37 : call release_fileunit(nu_dump_snow)
231 37 : call release_fileunit(nu_restart_snow)
232 37 : call release_fileunit(nu_dump_fsd)
233 37 : call release_fileunit(nu_restart_fsd)
234 37 : call release_fileunit(nu_dump_iso)
235 37 : call release_fileunit(nu_restart_iso)
236 37 : call release_fileunit(nu_dump_aero)
237 37 : call release_fileunit(nu_restart_aero)
238 37 : call release_fileunit(nu_dump_bgc)
239 37 : call release_fileunit(nu_restart_bgc)
240 37 : call release_fileunit(nu_dump_hbrine)
241 37 : call release_fileunit(nu_restart_hbrine)
242 37 : call release_fileunit(nu_dump_eap)
243 37 : call release_fileunit(nu_restart_eap)
244 37 : call release_fileunit(nu_rst_pointer)
245 37 : call release_fileunit(nu_history)
246 37 : call release_fileunit(nu_hdr)
247 : #ifdef CESMCOUPLED
248 : ! CESM can have negative unit numbers
249 : if (nu_diag > 0 .and. nu_diag /= ice_stdout) call release_fileunit(nu_diag)
250 : #else
251 37 : if (nu_diag /= ice_stdout) call release_fileunit(nu_diag)
252 : #endif
253 :
254 37 : end subroutine release_all_fileunits
255 :
256 : !=======================================================================
257 :
258 : ! This routine releases an I/O unit (marks it as available).
259 : ! Note that {\em all} processors must call this routine even if only
260 : ! the master task is doing the I/O. This is necessary insure that
261 : ! the units remain synchronized for other parallel I/O functions.
262 :
263 1166 : subroutine release_fileunit(iunit)
264 :
265 : integer (kind=int_kind), intent(in) :: &
266 : iunit ! I/O unit to be released
267 :
268 : character(len=*),parameter :: subname='(release_fileunit)'
269 :
270 : #ifdef CESMCOUPLED
271 : call shr_file_freeUnit(iunit)
272 : #else
273 : ! check for proper unit number
274 1166 : if (iunit < 1 .or. iunit > ice_IOUnitsMaxUnit) then
275 0 : stop 'release_fileunit: bad unit'
276 : endif
277 :
278 : ! mark the unit as not in use
279 1166 : ice_IOUnitsInUse(iunit) = .false. ! that was easy...
280 : #endif
281 :
282 1166 : end subroutine release_fileunit
283 :
284 : !=======================================================================
285 :
286 :
287 : ! This routine enables a user to flush the output from an IO unit
288 : ! (typically stdout) to force output when the system is buffering
289 : ! such output. Because this system function is system dependent,
290 : ! we only support this wrapper and users are welcome to insert the
291 : ! code relevant to their local machine. In the case where the CESM
292 : ! libraries are available, the shared routine for sys flush can be
293 : ! used (and is provided here under a preprocessor option).
294 :
295 1011 : subroutine flush_fileunit(iunit)
296 :
297 : #ifdef CESMCOUPLED
298 : use shr_sys_mod, only : shr_sys_flush
299 : #endif
300 :
301 : integer (kind=int_kind), intent(in) :: &
302 : iunit ! I/O unit to be flushed
303 :
304 : character(len=*),parameter :: subname='(flush_fileunit)'
305 :
306 : !-----------------------------------------------------------------------
307 : !
308 : ! insert your system code here
309 : !
310 : !-----------------------------------------------------------------------
311 :
312 : #ifdef CESMCOUPLED
313 : call shr_sys_flush(iunit)
314 : #else
315 : #ifndef NO_F2003
316 1011 : flush(iunit)
317 : #else
318 : ! Place holder for old call.
319 : #endif
320 : #endif
321 :
322 1011 : end subroutine flush_fileunit
323 :
324 : !=======================================================================
325 :
326 : !=======================================================
327 :
328 105 : subroutine goto_nml(iunit, nml, status)
329 : ! Search to namelist group within ice_in file.
330 : ! for compilers that do not allow optional namelists
331 :
332 : ! passed variables
333 : integer(kind=int_kind), intent(in) :: &
334 : iunit ! namelist file unit
335 :
336 : character(len=*), intent(in) :: &
337 : nml ! namelist to search for
338 :
339 : integer(kind=int_kind), intent(out) :: &
340 : status ! status of subrouine
341 :
342 : ! local variables
343 : character(len=char_len) :: &
344 : file_str, & ! string in file ! LCOV_EXCL_LINE
345 : nml_str ! namelist string to test
346 :
347 : integer(kind=int_kind) :: &
348 : i, n ! dummy integers
349 :
350 :
351 : ! rewind file
352 105 : rewind(iunit)
353 :
354 : ! define test string with ampersand
355 105 : nml_str = '&' // trim(adjustl(nml))
356 :
357 : ! search for the record containing the namelist group we're looking for
358 32242 : do
359 32347 : read(iunit, '(a)', iostat=status) file_str
360 32347 : if (status /= 0) then
361 0 : exit ! e.g. end of file
362 : else
363 32347 : if (index(adjustl(file_str), nml_str) == 1) then
364 105 : exit ! i.e. found record we're looking for
365 : end if
366 : end if
367 : end do
368 :
369 : ! backspace to namelist name in file
370 105 : backspace(iunit)
371 :
372 105 : end subroutine goto_nml
373 :
374 : !=======================================================================
375 :
376 : end module ice_fileunits
377 :
378 : !=======================================================================
|
