1 | MODULE fldread |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE fldread *** |
---|
4 | !! Ocean forcing: read input field for surface boundary condition |
---|
5 | !!===================================================================== |
---|
6 | !! History : 9.0 ! 06-06 (G. Madec) Original code |
---|
7 | !!---------------------------------------------------------------------- |
---|
8 | |
---|
9 | !!---------------------------------------------------------------------- |
---|
10 | !! fld_read : read input fields used for the computation of the |
---|
11 | !! surface boundary condition |
---|
12 | !!---------------------------------------------------------------------- |
---|
13 | USE oce ! ocean dynamics and tracers |
---|
14 | USE dom_oce ! ocean space and time domain |
---|
15 | USE phycst ! ??? |
---|
16 | USE daymod ! calendar |
---|
17 | USE in_out_manager ! I/O manager |
---|
18 | USE iom ! I/O manager library |
---|
19 | |
---|
20 | IMPLICIT NONE |
---|
21 | PRIVATE |
---|
22 | |
---|
23 | TYPE, PUBLIC :: FLD_N !: Namelist field informations |
---|
24 | CHARACTER(len = 34) :: clname ! generic name of the NetCDF flux file |
---|
25 | REAL(wp) :: freqh ! frequency of each flux file |
---|
26 | CHARACTER(len = 34) :: clvar ! generic name of the variable in the NetCDF flux file |
---|
27 | LOGICAL :: ln_tint ! time interpolation or not (T/F) |
---|
28 | LOGICAL :: ln_clim ! climatology or not (T/F) |
---|
29 | CHARACTER(len = 7) :: cltype ! type of data file 'monthly' or yearly' |
---|
30 | END TYPE FLD_N |
---|
31 | |
---|
32 | TYPE, PUBLIC :: FLD !: Input field related variables |
---|
33 | CHARACTER(len = 256) :: clrootname ! generic name of the NetCDF file |
---|
34 | CHARACTER(len = 256) :: clname ! current name of the NetCDF file |
---|
35 | REAL(wp) :: freqh ! frequency of each flux file |
---|
36 | CHARACTER(len = 34) :: clvar ! generic name of the variable in the NetCDF flux file |
---|
37 | LOGICAL :: ln_tint ! time interpolation or not (T/F) |
---|
38 | LOGICAL :: ln_clim ! climatology or not (T/F) |
---|
39 | CHARACTER(len = 7) :: cltype ! type of data file 'monthly' or yearly' |
---|
40 | INTEGER :: num ! iom id of the jpfld files to be read |
---|
41 | REAL(wp) :: swap_sec ! swapping time in second since Jan. 1st 00h of nit000 year |
---|
42 | REAL(wp) , DIMENSION(2) :: rec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year |
---|
43 | REAL(wp) , DIMENSION(2) :: rec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year |
---|
44 | REAL(wp) , DIMENSION(jpi,jpj) :: fnow ! input fields interpolated to now time step |
---|
45 | REAL(wp) , DIMENSION(jpi,jpj,2) :: fdta ! 2 consecutive record of input fields |
---|
46 | END TYPE FLD |
---|
47 | |
---|
48 | PUBLIC fld_read, fld_fill ! called by sbc... modules |
---|
49 | |
---|
50 | !!---------------------------------------------------------------------- |
---|
51 | !! OPA 9.0 , LOCEAN-IPSL (2006) |
---|
52 | !! $Id$ |
---|
53 | !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) |
---|
54 | !!---------------------------------------------------------------------- |
---|
55 | |
---|
56 | CONTAINS |
---|
57 | |
---|
58 | SUBROUTINE fld_read( kt, kn_fsbc, sd ) |
---|
59 | !!--------------------------------------------------------------------- |
---|
60 | !! *** ROUTINE fld_read *** |
---|
61 | !! |
---|
62 | !! ** Purpose : provide at each time step the surface ocean fluxes |
---|
63 | !! (momentum, heat, freshwater and runoff) |
---|
64 | !! |
---|
65 | !! ** Method : READ each input fields in NetCDF files using IOM |
---|
66 | !! and intepolate it to the model time-step. |
---|
67 | !! Several assumptions are made on the input file: |
---|
68 | !! blahblahblah.... |
---|
69 | !!---------------------------------------------------------------------- |
---|
70 | INTEGER , INTENT(in ) :: kt ! ocean time step |
---|
71 | INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) |
---|
72 | TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables |
---|
73 | !! |
---|
74 | INTEGER :: jf ! dummy indices |
---|
75 | REAL(wp) :: zreclast ! last record to be read in the current year file |
---|
76 | REAL(wp) :: zsecend ! number of second since Jan. 1st 00h of nit000 year at nitend |
---|
77 | LOGICAL :: llnxtyr ! open next year file? |
---|
78 | LOGICAL :: llstop ! stop is the file is not existing |
---|
79 | REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation |
---|
80 | REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation |
---|
81 | !!--------------------------------------------------------------------- |
---|
82 | ! ! ===================== ! |
---|
83 | DO jf = 1, SIZE( sd ) ! LOOP OVER FIELD ! |
---|
84 | ! ! ===================== ! |
---|
85 | ! |
---|
86 | IF( kt == nit000 ) CALL fld_init( sd(jf) ) |
---|
87 | ! |
---|
88 | ! read/update the after data? |
---|
89 | IF( rsec_year + sec1jan000 > sd(jf)%swap_sec ) THEN |
---|
90 | |
---|
91 | IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap before record field |
---|
92 | !CDIR COLLAPSE |
---|
93 | sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) |
---|
94 | ENDIF |
---|
95 | |
---|
96 | ! update record informations |
---|
97 | CALL fld_rec( sd(jf) ) |
---|
98 | |
---|
99 | ! do we have to change the year/month of the forcing field?? |
---|
100 | IF( sd(jf)%ln_tint ) THEN |
---|
101 | ! if we do time interpolation we will need to open next year/month file before the end of the current year/month |
---|
102 | ! if it is the case, we are still before the end of the year/month when calling fld_rec so sd(jf)%rec_a(1) will |
---|
103 | ! be larger than the record number that should be read for current year/month (for ex. 13 for monthly mean file) |
---|
104 | |
---|
105 | ! last record to be read in the current file |
---|
106 | IF( sd(jf)%freqh == -1. ) THEN ; zreclast = 12. |
---|
107 | ELSE |
---|
108 | IF( sd(jf)%cltype == 'monthly' ) THEN ; zreclast = 24. / sd(jf)%freqh * REAL( nmonth_len(nmonth), wp ) |
---|
109 | ELSE ; zreclast = 24. / sd(jf)%freqh * REAL( nyear_len( 1 ), wp ) |
---|
110 | ENDIF |
---|
111 | ENDIF |
---|
112 | |
---|
113 | ! do we need next year data? |
---|
114 | IF( sd(jf)%rec_a(1) > zreclast ) THEN |
---|
115 | |
---|
116 | sd(jf)%rec_a(1) = 1. ! force to read the first record of the next year |
---|
117 | |
---|
118 | IF( .NOT. sd(jf)%ln_clim ) THEN ! close the current file and open a new one. |
---|
119 | |
---|
120 | llnxtyr = sd(jf)%cltype /= 'monthly' .OR. nmonth == 12 ! do we need to open next year file? |
---|
121 | ! if the run finishes at the end of the current year/month, we do accept that next year/month file does |
---|
122 | ! not exist. If the run continue farther than the current year/month, next year/month file must exist |
---|
123 | zsecend = rsec_year + sec1jan000 + REAL(nitend - kt, wp) * rdttra(1) ! second at the end of the run |
---|
124 | llstop = zsecend > sd(jf)%swap_sec ! read more than 1 record of next year |
---|
125 | |
---|
126 | CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr/)), nmonth + 1 - 12 * COUNT((/llnxtyr/)), llstop ) |
---|
127 | |
---|
128 | IF( sd(jf)%num == 0 .AND. .NOT. llstop ) THEN ! next year file is not existing |
---|
129 | CALL ctl_warn('next year/month file: '//TRIM(sd(jf)%clname)//' not existing -> back to current year/month') |
---|
130 | CALL fld_clopn( sd(jf), nyear, nmonth ) ! back to the current year/month |
---|
131 | sd(jf)%rec_a(1) = zreclast ! force to read the last record to be read in the current year file |
---|
132 | ENDIF |
---|
133 | |
---|
134 | ENDIF |
---|
135 | ENDIF |
---|
136 | |
---|
137 | ELSE |
---|
138 | ! if we are not doing time interpolation, we must change the year/month of the file just afer switching |
---|
139 | ! to the NEW year/month. If it is the case, we are at the beginning of the year/month when calling fld_rec |
---|
140 | ! so sd(jf)%rec_a(1) = 1 |
---|
141 | IF( sd(jf)%rec_a(1) == 1 ) CALL fld_clopn( sd(jf), nyear, nmonth ) ! back to the current year/month |
---|
142 | ENDIF |
---|
143 | |
---|
144 | ! read after data |
---|
145 | CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), NINT( sd(jf)%rec_a(1) ) ) |
---|
146 | |
---|
147 | ENDIF |
---|
148 | |
---|
149 | ! update field at each kn_fsbc time-step |
---|
150 | IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN |
---|
151 | ! |
---|
152 | IF( sd(jf)%ln_tint ) THEN |
---|
153 | IF(lwp .AND. kt - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & |
---|
154 | & ' kt = ', kt,' Y/M/D = ', nyear,'/', nmonth,'/', nday,' records b/a:', NINT(sd(jf)%rec_b(1)), & |
---|
155 | & '/', NINT(sd(jf)%rec_a(1)), ' (', sd(jf)%rec_b(2)/rday,'/', sd(jf)%rec_a(2)/rday, ' days)' |
---|
156 | ! |
---|
157 | ztinta = ( rsec_year + sec1jan000 - sd(jf)%rec_b(2) ) / ( sd(jf)%rec_a(2) - sd(jf)%rec_b(2) ) |
---|
158 | ztintb = 1. - ztinta |
---|
159 | !CDIR COLLAPSE |
---|
160 | sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) |
---|
161 | ELSE |
---|
162 | IF(lwp .AND. kt - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & |
---|
163 | & ' kt = ', kt, ' Y/M/D = ', nyear,'/', nmonth,'/', nday, ' record :', INT(sd(jf)%rec_a(1)), & |
---|
164 | & ' at ', sd(jf)%rec_a(2)/rday, 'day' |
---|
165 | !CDIR COLLAPSE |
---|
166 | sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2) ! piecewise constant field |
---|
167 | |
---|
168 | ENDIF |
---|
169 | ! |
---|
170 | ENDIF |
---|
171 | |
---|
172 | IF( kt == nitend ) CALL iom_close( sd(jf)%num ) ! Close the input files |
---|
173 | |
---|
174 | ! ! ===================== ! |
---|
175 | END DO ! END LOOP OVER FIELD ! |
---|
176 | ! ! ===================== ! |
---|
177 | END SUBROUTINE fld_read |
---|
178 | |
---|
179 | |
---|
180 | SUBROUTINE fld_init( sdjf ) |
---|
181 | !!--------------------------------------------------------------------- |
---|
182 | !! *** ROUTINE fld_init *** |
---|
183 | !! |
---|
184 | !! ** Purpose : - if time interpolation, read before data |
---|
185 | !! - open current year file |
---|
186 | !! |
---|
187 | !! ** Method : |
---|
188 | !!---------------------------------------------------------------------- |
---|
189 | TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables |
---|
190 | !! |
---|
191 | LOGICAL :: llprevyr ! are we reading previous year file? |
---|
192 | LOGICAL :: llprevmth ! are we reading previous month file? |
---|
193 | LOGICAL :: llprev ! llprevyr .OR. llprevmth |
---|
194 | INTEGER :: idvar ! variable id |
---|
195 | INTEGER :: inrec ! number of record existing for this variable |
---|
196 | !!--------------------------------------------------------------------- |
---|
197 | |
---|
198 | ! some default definitions... |
---|
199 | sdjf%num = 0 ! default definition for non-opened file |
---|
200 | IF( sdjf%ln_clim ) sdjf%clname = TRIM( sdjf%clrootname ) ! file name defaut definition, never change in this case |
---|
201 | llprevyr = .FALSE. |
---|
202 | llprevmth = .FALSE. |
---|
203 | |
---|
204 | ! define record informations |
---|
205 | CALL fld_rec( sdjf ) |
---|
206 | |
---|
207 | IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure |
---|
208 | |
---|
209 | IF( sdjf%rec_b(1) == 0.e0 ) THEN ! we redefine record sdjf%rec_b(1) with the last record of previous year file |
---|
210 | IF( sdjf%freqh == -1. ) THEN ! monthly mean |
---|
211 | sdjf%rec_b(1) = 12. ! force to read december mean |
---|
212 | ELSE |
---|
213 | IF( sdjf%cltype == 'monthly' ) THEN ! monthly file |
---|
214 | sdjf%rec_b(1) = 24. / sdjf%freqh * REAL( nmonth_len(nmonth-1), wp ) ! last record of previous month |
---|
215 | llprevmth = sdjf%ln_clim ! use previous month file? |
---|
216 | llprevyr = sdjf%ln_clim .AND. nmonth == 1 ! use previous year file? |
---|
217 | ELSE ! yearly file |
---|
218 | sdjf%rec_b(1) = 24. / sdjf%freqh * REAL( nyear_len(0), wp ) ! last record of year month |
---|
219 | llprevyr = sdjf%ln_clim ! use previous year file? |
---|
220 | ENDIF |
---|
221 | ENDIF |
---|
222 | ENDIF |
---|
223 | llprev = llprevyr .OR. llprevmth |
---|
224 | |
---|
225 | CALL fld_clopn( sdjf, nyear - COUNT((/llprevyr/)), nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr/)), llprev ) |
---|
226 | |
---|
227 | ! if previous year/month file is not existing, we switch to the current year/month |
---|
228 | IF( llprev .AND. sdjf%num == 0 ) THEN |
---|
229 | CALL ctl_warn( 'previous year/month file: '//TRIM(sdjf%clname)//' not existing -> back to current year/month' ) |
---|
230 | ! we force to read the first record of the current year/month instead of last record of previous year/month |
---|
231 | llprev = .false. |
---|
232 | sdjf%rec_b(1) = 1. |
---|
233 | CALL fld_clopn( sdjf, nyear, nmonth ) |
---|
234 | ENDIF |
---|
235 | |
---|
236 | IF( llprev ) THEN ! check if the last record sdjf%rec_n(1) exists in the file |
---|
237 | idvar = iom_varid( sdjf%num, sdjf%clvar ) ! id of the variable sdjf%clvar |
---|
238 | IF( idvar <= 0 ) RETURN |
---|
239 | inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar ) ! size of the last dim of idvar |
---|
240 | sdjf%rec_b(1) = MIN( sdjf%rec_b(1), REAL( inrec, wp ) ) ! make sure we select an existing record |
---|
241 | ENDIF |
---|
242 | |
---|
243 | ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read |
---|
244 | CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), NINT( sdjf%rec_b(1) ) ) |
---|
245 | |
---|
246 | IF(lwp) WRITE(numout,*)'fld_init : time-interpolation for ', TRIM( sdjf%clvar ), & |
---|
247 | & ' read previous record =', NINT(sdjf%rec_b(1)), ' at time = ', sdjf%rec_b(2)/rday, ' days' |
---|
248 | |
---|
249 | IF( llprev ) CALL iom_close( sdjf%num ) ! close previous year file (-> redefine sdjf%num to 0) |
---|
250 | |
---|
251 | ENDIF |
---|
252 | |
---|
253 | IF( sdjf%num == 0 ) CALL fld_clopn( sdjf, nyear, nmonth ) ! make sure current year/month file is opened |
---|
254 | |
---|
255 | sdjf%swap_sec = rsec_year + sec1jan000 - 1. ! force read/update the after data in the following part of fld_read |
---|
256 | |
---|
257 | END SUBROUTINE fld_init |
---|
258 | |
---|
259 | |
---|
260 | SUBROUTINE fld_rec( sdjf ) |
---|
261 | !!--------------------------------------------------------------------- |
---|
262 | !! *** ROUTINE fld_rec *** |
---|
263 | !! |
---|
264 | !! ** Purpose : compute rec_a, rec_b and swap_sec |
---|
265 | !! |
---|
266 | !! ** Method : |
---|
267 | !!---------------------------------------------------------------------- |
---|
268 | TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables |
---|
269 | !! |
---|
270 | INTEGER :: irec ! record number |
---|
271 | REAL(wp) :: zrec ! record number |
---|
272 | REAL(wp) :: ztmp ! temporary variable |
---|
273 | REAL(wp) :: zfreq_sec ! frequency mean (in seconds) |
---|
274 | !!---------------------------------------------------------------------- |
---|
275 | ! |
---|
276 | IF( sdjf%freqh == -1. ) THEN ! monthly mean |
---|
277 | ! |
---|
278 | IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record |
---|
279 | ! |
---|
280 | ! INT( ztmp ) |
---|
281 | ! /|\ |
---|
282 | ! 1 | *---- |
---|
283 | ! 0 |----( |
---|
284 | ! |----+----|--> time |
---|
285 | ! 0 /|\ 1 (nday/nmonth_len(nmonth)) |
---|
286 | ! | |
---|
287 | ! | |
---|
288 | ! forcing record : nmonth |
---|
289 | ! |
---|
290 | ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 |
---|
291 | ELSE |
---|
292 | ztmp = 0.e0 |
---|
293 | ENDIF |
---|
294 | irec = nmonth + INT( ztmp ) |
---|
295 | |
---|
296 | IF( sdjf%ln_tint ) THEN ; sdjf%swap_sec = rmonth_half(irec) ! swap at the middle of the month |
---|
297 | ELSE ; sdjf%swap_sec = rmonth_end( irec) ! swap at the end of the month |
---|
298 | ENDIF |
---|
299 | |
---|
300 | sdjf%rec_a(:) = (/ REAL( irec, wp ), rmonth_half(irec) /) ! define after record number and time |
---|
301 | irec = irec - 1 ! move back to previous record |
---|
302 | sdjf%rec_b(:) = (/ REAL( irec, wp ), rmonth_half(irec) /) ! define before record number and time |
---|
303 | ! |
---|
304 | ELSE ! higher frequency mean (in hours) |
---|
305 | ! |
---|
306 | zfreq_sec = sdjf%freqh * 3600. ! frequency mean (in seconds) |
---|
307 | ! number of second since the beginning of the file |
---|
308 | IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = rsec_month ! since Jan 1 of the current year |
---|
309 | ELSE ; ztmp = rsec_year ! since the first day of the current month |
---|
310 | ENDIF |
---|
311 | IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record |
---|
312 | ! |
---|
313 | ! INT( ztmp ) |
---|
314 | ! /|\ |
---|
315 | ! 2 | *-----( |
---|
316 | ! 1 | *-----( |
---|
317 | ! 0 |--( |
---|
318 | ! |--+--|--+--|--+--|--> time |
---|
319 | ! 0 /|\ 1 /|\ 2 /|\ 3 (rsec_year/zfreq_sec) or (rsec_month/zfreq_sec) |
---|
320 | ! | | | |
---|
321 | ! | | | |
---|
322 | ! forcing record : 1 2 3 |
---|
323 | ! |
---|
324 | ztmp= ztmp / zfreq_sec + 0.5 |
---|
325 | ELSE |
---|
326 | ! |
---|
327 | ! INT( ztmp ) |
---|
328 | ! /|\ |
---|
329 | ! 2 | *-----( |
---|
330 | ! 1 | *-----( |
---|
331 | ! 0 |-----( |
---|
332 | ! |--+--|--+--|--+--|--> time |
---|
333 | ! 0 /|\ 1 /|\ 2 /|\ 3 (rsec_year/zfreq_sec) or (rsec_month/zfreq_sec) |
---|
334 | ! | | | |
---|
335 | ! | | | |
---|
336 | ! forcing record : 1 2 3 |
---|
337 | ! |
---|
338 | ztmp= ztmp / zfreq_sec |
---|
339 | ENDIF |
---|
340 | zrec = 1. + REAL( INT( ztmp ), wp ) |
---|
341 | |
---|
342 | ! after record index and second since Jan. 1st 00h of nit000 year |
---|
343 | sdjf%rec_a(:) = (/ zrec, zfreq_sec * ( zrec - 0.5 ) + sec1jan000 /) |
---|
344 | IF( sdjf%cltype == 'monthly' ) & ! add the number of second between Jan 1 and the end of previous month |
---|
345 | sdjf%rec_a(2) = sdjf%rec_a(2) + rday * REAL(SUM(nmonth_len(1:nmonth -1)), wp) ! ok if nmonth=1 |
---|
346 | |
---|
347 | ! before record index and second since Jan. 1st 00h of nit000 year |
---|
348 | zrec = zrec - 1. ! move back to previous record |
---|
349 | sdjf%rec_b(:) = (/ zrec, zfreq_sec * ( zrec - 0.5 ) + sec1jan000 /) |
---|
350 | IF( sdjf%cltype == 'monthly' ) & ! add the number of second between Jan 1 and the end of previous month |
---|
351 | sdjf%rec_b(2) = sdjf%rec_b(2) + rday * REAL(SUM(nmonth_len(1:nmonth -1)), wp) ! ok if nmonth=1 |
---|
352 | |
---|
353 | ! swapping time in second since Jan. 1st 00h of nit000 year |
---|
354 | IF( sdjf%ln_tint ) THEN ; sdjf%swap_sec = sdjf%rec_a(2) ! swap at the middle of the record |
---|
355 | ELSE ; sdjf%swap_sec = sdjf%rec_a(2) + 0.5 * zfreq_sec ! swap at the end of the record |
---|
356 | ENDIF |
---|
357 | ! |
---|
358 | ENDIF |
---|
359 | ! |
---|
360 | END SUBROUTINE fld_rec |
---|
361 | |
---|
362 | |
---|
363 | SUBROUTINE fld_clopn( sdjf, kyear, kmonth, ldstop ) |
---|
364 | !!--------------------------------------------------------------------- |
---|
365 | !! *** ROUTINE fld_clopn *** |
---|
366 | !! |
---|
367 | !! ** Purpose : update the file name and open the file |
---|
368 | !! |
---|
369 | !! ** Method : |
---|
370 | !!---------------------------------------------------------------------- |
---|
371 | TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables |
---|
372 | INTEGER , INTENT(in ) :: kyear ! year value |
---|
373 | INTEGER , INTENT(in ) :: kmonth ! month value |
---|
374 | LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) |
---|
375 | |
---|
376 | IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open |
---|
377 | ! build the new filename if not climatological data |
---|
378 | IF( .NOT. sdjf%ln_clim ) THEN ; WRITE(sdjf%clname, '(a,"_y",i4)' ) TRIM( sdjf%clrootname ), kyear ! add year |
---|
379 | IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"m",i2)' ) TRIM( sdjf%clname ), kmonth ! add month |
---|
380 | ENDIF |
---|
381 | CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop ) |
---|
382 | ! |
---|
383 | END SUBROUTINE fld_clopn |
---|
384 | |
---|
385 | |
---|
386 | SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam ) |
---|
387 | !!--------------------------------------------------------------------- |
---|
388 | !! *** ROUTINE fld_fill *** |
---|
389 | !! |
---|
390 | !! ** Purpose : fill sdf with sdf_n and control print |
---|
391 | !! |
---|
392 | !! ** Method : |
---|
393 | !!---------------------------------------------------------------------- |
---|
394 | TYPE(FLD) , DIMENSION(:), INTENT(inout) :: sdf ! structure of input fields (file informations, fields read) |
---|
395 | TYPE(FLD_N), DIMENSION(:), INTENT(in ) :: sdf_n ! array of namelist information structures |
---|
396 | CHARACTER(len=*) , INTENT(in ) :: cdir ! Root directory for location of flx files |
---|
397 | CHARACTER(len=*) , INTENT(in ) :: cdcaller ! |
---|
398 | CHARACTER(len=*) , INTENT(in ) :: cdtitle ! |
---|
399 | CHARACTER(len=*) , INTENT(in ) :: cdnam ! |
---|
400 | ! |
---|
401 | INTEGER :: jf ! dummy indices |
---|
402 | !!--------------------------------------------------------------------- |
---|
403 | |
---|
404 | DO jf = 1, SIZE(sdf) |
---|
405 | sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname ) |
---|
406 | sdf(jf)%freqh = sdf_n(jf)%freqh |
---|
407 | sdf(jf)%clvar = sdf_n(jf)%clvar |
---|
408 | sdf(jf)%ln_tint = sdf_n(jf)%ln_tint |
---|
409 | sdf(jf)%ln_clim = sdf_n(jf)%ln_clim |
---|
410 | IF( sdf(jf)%freqh == -1. ) THEN ; sdf(jf)%cltype = 'yearly' |
---|
411 | ELSE ; sdf(jf)%cltype = sdf_n(jf)%cltype |
---|
412 | ENDIF |
---|
413 | END DO |
---|
414 | |
---|
415 | IF(lwp) THEN ! control print |
---|
416 | WRITE(numout,*) |
---|
417 | WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) |
---|
418 | WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) |
---|
419 | WRITE(numout,*) ' '//TRIM( cdnam )//' Namelist' |
---|
420 | WRITE(numout,*) ' list of files and frequency (>0: in hours ; <0 in months)' |
---|
421 | DO jf = 1, SIZE(sdf) |
---|
422 | WRITE(numout,*) ' root filename: ' , TRIM( sdf(jf)%clrootname ), & |
---|
423 | & ' variable name: ' , TRIM( sdf(jf)%clvar ) |
---|
424 | WRITE(numout,*) ' frequency: ' , sdf(jf)%freqh , & |
---|
425 | & ' time interp: ' , sdf(jf)%ln_tint , & |
---|
426 | & ' climatology: ' , sdf(jf)%ln_clim , & |
---|
427 | & ' data type: ' , sdf(jf)%cltype |
---|
428 | END DO |
---|
429 | ENDIF |
---|
430 | |
---|
431 | END SUBROUTINE fld_fill |
---|
432 | |
---|
433 | |
---|
434 | END MODULE fldread |
---|