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
32 :
33 : character (len=char_len), public :: &
34 : diag_type ! 'stdout' or 'file'
35 :
36 : character (len=char_len), public :: &
37 : bfbflag ! method for bit-for-bit computations
38 :
39 : integer (kind=int_kind), public :: &
40 : nu_grid , & ! grid file ! LCOV_EXCL_LINE
41 : nu_kmt , & ! land mask file ! LCOV_EXCL_LINE
42 : nu_nml , & ! namelist input file ! LCOV_EXCL_LINE
43 : nu_forcing , & ! forcing data file ! LCOV_EXCL_LINE
44 : nu_dump , & ! dump file for restarting ! LCOV_EXCL_LINE
45 : nu_restart , & ! restart input file ! LCOV_EXCL_LINE
46 : nu_dump_age , & ! dump file for restarting ice age tracer ! LCOV_EXCL_LINE
47 : nu_restart_age, & ! restart input file for ice age tracer ! LCOV_EXCL_LINE
48 : nu_dump_FY , & ! dump file for restarting first-year area tracer ! LCOV_EXCL_LINE
49 : nu_restart_FY , & ! restart input file for first-year area tracer ! LCOV_EXCL_LINE
50 : nu_dump_lvl , & ! dump file for restarting level ice tracers ! LCOV_EXCL_LINE
51 : nu_restart_lvl, & ! restart input file for level ice tracers ! LCOV_EXCL_LINE
52 : nu_dump_pond , & ! dump file for restarting melt pond tracer ! LCOV_EXCL_LINE
53 : nu_restart_pond,& ! restart input file for melt pond tracer ! LCOV_EXCL_LINE
54 : nu_dump_fsd , & ! dump file for restarting floe size distribution ! LCOV_EXCL_LINE
55 : nu_restart_fsd, & ! restart input file for floe size distribution ! LCOV_EXCL_LINE
56 : nu_dump_iso , & ! dump file for restarting isotope tracers ! LCOV_EXCL_LINE
57 : nu_restart_iso, & ! restart input file for isotope tracers ! LCOV_EXCL_LINE
58 : nu_dump_aero , & ! dump file for restarting aerosol tracer ! LCOV_EXCL_LINE
59 : nu_restart_aero,& ! restart input file for aerosol tracer ! LCOV_EXCL_LINE
60 : nu_dump_bgc , & ! dump file for restarting bgc ! LCOV_EXCL_LINE
61 : nu_restart_bgc, & ! restart input file for bgc ! LCOV_EXCL_LINE
62 : nu_dump_hbrine, & ! dump file for restarting hbrine ! LCOV_EXCL_LINE
63 : nu_restart_hbrine, & ! restart input file for hbrine ! LCOV_EXCL_LINE
64 : nu_dump_eap , & ! dump file for restarting eap dynamics ! LCOV_EXCL_LINE
65 : nu_restart_eap, & ! restart input file for eap dynamics ! LCOV_EXCL_LINE
66 : nu_rst_pointer, & ! pointer to latest restart file ! LCOV_EXCL_LINE
67 : nu_history , & ! binary history output file ! LCOV_EXCL_LINE
68 : nu_hdr ! header file for binary history output
69 :
70 : character (32), public :: &
71 : nml_filename = 'ice_in' ! namelist input file name
72 :
73 : integer (kind=int_kind), parameter, public :: &
74 : ice_stdin = 5, & ! reserved unit for standard input ! LCOV_EXCL_LINE
75 : ice_stdout = 6, & ! reserved unit for standard output ! LCOV_EXCL_LINE
76 : ice_stderr = 6 ! reserved unit for standard error
77 :
78 : integer (kind=int_kind), public :: &
79 : nu_diag = ice_stdout ! diagnostics output file, unit number may be overwritten
80 :
81 : logical (kind=log_kind), public :: &
82 : nu_diag_set = .false. ! flag to indicate whether nu_diag is already set
83 :
84 : integer (kind=int_kind), public :: &
85 : ice_IOUnitsMinUnit = 11, & ! do not use unit numbers below ! LCOV_EXCL_LINE
86 : ice_IOUnitsMaxUnit = 99 ! or above, set by setup_nml
87 :
88 : logical (kind=log_kind), dimension(:), allocatable :: &
89 : ice_IOUnitsInUse ! flag=.true. if unit currently open
90 :
91 : ! instance control
92 : integer (kind=int_kind), public :: inst_index
93 : character(len=16) , public :: inst_name
94 : character(len=16) , public :: inst_suffix
95 :
96 : !=======================================================================
97 :
98 : contains
99 :
100 : !=======================================================================
101 :
102 : ! This routine grabs needed unit numbers.
103 : ! nu_diag is set to 6 (stdout) but may be reset later by the namelist.
104 : ! nu_nml is obtained separately.
105 :
106 4138 : subroutine init_fileunits
107 :
108 : character(len=*),parameter :: subname='(init_fileunits)'
109 :
110 4138 : if (.not.allocated(ice_IOUnitsInUse)) allocate(ice_IOUnitsInUse(ice_IOUnitsMaxUnit))
111 413800 : ice_IOUnitsInUse = .false.
112 :
113 4138 : ice_IOUnitsInUse(ice_stdin) = .true. ! reserve unit 5
114 4138 : ice_IOUnitsInUse(ice_stdout) = .true. ! reserve unit 6
115 4138 : ice_IOUnitsInUse(ice_stderr) = .true.
116 4138 : if (nu_diag >= 1 .and. nu_diag <= ice_IOUnitsMaxUnit) &
117 4138 : ice_IOUnitsInUse(nu_diag) = .true. ! reserve unit nu_diag
118 :
119 4138 : call get_fileunit(nu_grid)
120 4138 : call get_fileunit(nu_kmt)
121 4138 : call get_fileunit(nu_forcing)
122 4138 : call get_fileunit(nu_dump)
123 4138 : call get_fileunit(nu_restart)
124 4138 : call get_fileunit(nu_dump_age)
125 4138 : call get_fileunit(nu_restart_age)
126 4138 : call get_fileunit(nu_dump_FY)
127 4138 : call get_fileunit(nu_restart_FY)
128 4138 : call get_fileunit(nu_dump_lvl)
129 4138 : call get_fileunit(nu_restart_lvl)
130 4138 : call get_fileunit(nu_dump_pond)
131 4138 : call get_fileunit(nu_restart_pond)
132 4138 : call get_fileunit(nu_dump_fsd)
133 4138 : call get_fileunit(nu_restart_fsd)
134 4138 : call get_fileunit(nu_dump_iso)
135 4138 : call get_fileunit(nu_restart_iso)
136 4138 : call get_fileunit(nu_dump_aero)
137 4138 : call get_fileunit(nu_restart_aero)
138 4138 : call get_fileunit(nu_dump_bgc)
139 4138 : call get_fileunit(nu_restart_bgc)
140 4138 : call get_fileunit(nu_dump_hbrine)
141 4138 : call get_fileunit(nu_restart_hbrine)
142 4138 : call get_fileunit(nu_dump_eap)
143 4138 : call get_fileunit(nu_restart_eap)
144 4138 : call get_fileunit(nu_rst_pointer)
145 4138 : call get_fileunit(nu_history)
146 4138 : call get_fileunit(nu_hdr)
147 :
148 4138 : end subroutine init_fileunits
149 :
150 : !=======================================================================
151 :
152 : ! This routine returns the next available I/O unit and marks it as
153 : ! in use to prevent any later use.
154 : ! Note that {\em all} processors must call this routine even if only
155 : ! the master task is doing the I/O. This is necessary insure that
156 : ! the units remain synchronized for other parallel I/O functions.
157 :
158 149166 : subroutine get_fileunit(iunit)
159 :
160 : integer (kind=int_kind), intent(out) :: &
161 : iunit ! next free I/O unit
162 :
163 : ! local variables
164 :
165 : #ifndef CESMCOUPLED
166 : integer (kind=int_kind) :: n ! dummy loop index
167 : logical (kind=log_kind) :: alreadyInUse
168 : #endif
169 :
170 : character(len=*),parameter :: subname='(get_fileunit)'
171 :
172 : #ifdef CESMCOUPLED
173 : iunit = shr_file_getUnit()
174 : #else
175 :
176 2354146 : srch_units: do n=ice_IOUnitsMinUnit, ice_IOUnitsMaxUnit
177 2354146 : if (.not. ice_IOUnitsInUse(n)) then ! I found one, I found one
178 :
179 : !*** make sure not in use by library or calling routines
180 149166 : INQUIRE (unit=n,OPENED=alreadyInUse)
181 :
182 149166 : if (.not. alreadyInUse) then
183 149166 : iunit = n ! return the free unit number
184 149166 : ice_IOUnitsInUse(iunit) = .true. ! mark iunit as being in use
185 149166 : exit srch_units
186 : else
187 : !*** if inquire shows this unit in use, mark it as
188 : !*** in use to prevent further queries
189 0 : ice_IOUnitsInUse(n) = .true.
190 : endif
191 : endif
192 : end do srch_units
193 :
194 149166 : if (iunit > ice_IOUnitsMaxUnit) stop 'ice_IOUnitsGet: No free units'
195 :
196 : #endif
197 :
198 149166 : end subroutine get_fileunit
199 :
200 : !=======================================================================
201 :
202 : ! This routine releases unit numbers at the end of a run.
203 :
204 4125 : subroutine release_all_fileunits
205 :
206 : character(len=*),parameter :: subname='(release_all_fileunits)'
207 :
208 4125 : call release_fileunit(nu_grid)
209 4125 : call release_fileunit(nu_kmt)
210 4125 : call release_fileunit(nu_forcing)
211 4125 : call release_fileunit(nu_dump)
212 4125 : call release_fileunit(nu_restart)
213 4125 : call release_fileunit(nu_dump_age)
214 4125 : call release_fileunit(nu_restart_age)
215 4125 : call release_fileunit(nu_dump_FY)
216 4125 : call release_fileunit(nu_restart_FY)
217 4125 : call release_fileunit(nu_dump_lvl)
218 4125 : call release_fileunit(nu_restart_lvl)
219 4125 : call release_fileunit(nu_dump_pond)
220 4125 : call release_fileunit(nu_restart_pond)
221 4125 : call release_fileunit(nu_dump_fsd)
222 4125 : call release_fileunit(nu_restart_fsd)
223 4125 : call release_fileunit(nu_dump_iso)
224 4125 : call release_fileunit(nu_restart_iso)
225 4125 : call release_fileunit(nu_dump_aero)
226 4125 : call release_fileunit(nu_restart_aero)
227 4125 : call release_fileunit(nu_dump_bgc)
228 4125 : call release_fileunit(nu_restart_bgc)
229 4125 : call release_fileunit(nu_dump_hbrine)
230 4125 : call release_fileunit(nu_restart_hbrine)
231 4125 : call release_fileunit(nu_dump_eap)
232 4125 : call release_fileunit(nu_restart_eap)
233 4125 : call release_fileunit(nu_rst_pointer)
234 4125 : call release_fileunit(nu_history)
235 4125 : call release_fileunit(nu_hdr)
236 4125 : if (nu_diag /= ice_stdout) call release_fileunit(nu_diag)
237 :
238 4125 : end subroutine release_all_fileunits
239 :
240 : !=======================================================================
241 :
242 : ! This routine releases an I/O unit (marks it as available).
243 : ! Note that {\em all} processors must call this routine even if only
244 : ! the master task is doing the I/O. This is necessary insure that
245 : ! the units remain synchronized for other parallel I/O functions.
246 :
247 148802 : subroutine release_fileunit(iunit)
248 :
249 : integer (kind=int_kind), intent(in) :: &
250 : iunit ! I/O unit to be released
251 :
252 : character(len=*),parameter :: subname='(release_fileunit)'
253 :
254 : #ifdef CESMCOUPLED
255 : call shr_file_freeUnit(iunit)
256 : #else
257 : ! check for proper unit number
258 148802 : if (iunit < 1 .or. iunit > ice_IOUnitsMaxUnit) then
259 0 : stop 'release_fileunit: bad unit'
260 : endif
261 :
262 : ! mark the unit as not in use
263 148802 : ice_IOUnitsInUse(iunit) = .false. ! that was easy...
264 : #endif
265 :
266 148802 : end subroutine release_fileunit
267 :
268 : !=======================================================================
269 :
270 :
271 : ! This routine enables a user to flush the output from an IO unit
272 : ! (typically stdout) to force output when the system is buffering
273 : ! such output. Because this system function is system dependent,
274 : ! we only support this wrapper and users are welcome to insert the
275 : ! code relevant to their local machine. In the case where the CESM
276 : ! libraries are available, the shared routine for sys flush can be
277 : ! used (and is provided here under a preprocessor option).
278 :
279 5783 : subroutine flush_fileunit(iunit)
280 :
281 : #ifdef CESMCOUPLED
282 : use shr_sys_mod, only : shr_sys_flush
283 : #endif
284 :
285 : integer (kind=int_kind), intent(in) :: &
286 : iunit ! I/O unit to be flushed
287 :
288 : character(len=*),parameter :: subname='(flush_fileunit)'
289 :
290 : !-----------------------------------------------------------------------
291 : !
292 : ! insert your system code here
293 : !
294 : !-----------------------------------------------------------------------
295 :
296 : #ifdef CESMCOUPLED
297 : call shr_sys_flush(iunit)
298 : #else
299 : #ifndef NO_F2003
300 5783 : flush(iunit)
301 : #else
302 : ! Place holder for old call.
303 : #endif
304 : #endif
305 :
306 5783 : end subroutine flush_fileunit
307 :
308 : !=======================================================================
309 :
310 : end module ice_fileunits
311 :
312 : !=======================================================================
|
