Line data Source code
1 : !=======================================================================
2 :
3 : ! Diagnostic information output during run
4 : !
5 : ! authors: T. Craig
6 :
7 : module icedrv_history
8 :
9 : use icedrv_kinds
10 : use icedrv_constants, only: nu_diag, nu_diag_out
11 : use icedrv_domain_size, only: nx, ncat, nfsd
12 : use icedrv_diagnostics, only: nx_names
13 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
14 : use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_sizes
15 : use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_indices
16 : use icedrv_system, only: icedrv_system_abort
17 :
18 : implicit none
19 : private
20 : public :: history_write, &
21 : history_close
22 :
23 : ! history output file info
24 :
25 : character (len=char_len), public :: &
26 : history_format ! format of history files, only supported type is 'nc'
27 :
28 : character (len=char_len_long) :: hist_file ! hist file name
29 :
30 : integer (kind=int_kind) :: ncid ! cdf file id
31 : integer (kind=int_kind) :: nxid, ncatid, ntrcrid, nfsdid, timid ! cdf dim ids
32 : integer (kind=int_kind) :: timcnt ! time counter
33 :
34 : !=======================================================================
35 :
36 : contains
37 :
38 : !=======================================================================
39 :
40 : ! Writes history information
41 :
42 48264 : subroutine history_write()
43 :
44 : use icedrv_calendar, only: days_per_year, use_leap_years, year_init
45 : use icedrv_calendar, only: time, time0, secday, istep1, idate, sec
46 : use icedrv_state, only: aice, vice, vsno, uvel, vvel, divu, shear, strength
47 : use icedrv_state, only: trcr, trcrn
48 : use icedrv_state, only: aicen, vicen, vsnon
49 : use icedrv_flux, only: evap, fsnow, frain, frazil
50 : use icedrv_flux, only: fswabs, flw, flwout, fsens, fsurf, flat
51 : use icedrv_flux, only: Tair, Qa, fsw, fcondtop
52 : use icedrv_flux, only: meltt, meltb, meltl, snoice
53 : use icedrv_flux, only: dsnow, congel, sst, sss, Tf, fhocn
54 : use icedrv_arrays_column, only: d_afsd_newi, d_afsd_latg, d_afsd_latm, d_afsd_wave, d_afsd_weld
55 : #ifdef USE_NETCDF
56 : use netcdf
57 : #endif
58 :
59 : ! local variables
60 :
61 : logical (kind=log_kind), save :: &
62 : first_call = .true. ! first call flag
63 :
64 : integer (kind=int_kind) :: &
65 : n, & ! counters
66 : ntrcr, & ! tracer count from icepack
67 : dimid1(1), dimid2(2), dimid3(3), dimid4(4), & ! cdf dimids
68 : start1(1), start2(2), start3(3), start4(4), & ! cdf start/count arrays
69 : count1(1), count2(2), count3(3), count4(4), & ! cdf start/count arrays
70 : varid, & ! cdf varid
71 : status, & ! cdf status flag
72 : iflag ! history file attributes
73 :
74 : character (len=8) :: &
75 : cdate ! date string
76 :
77 : real (kind=dbl_kind) :: &
78 : value ! temporary
79 : real (kind=dbl_kind),allocatable :: &
80 48264 : value1(:), value2(:,:), value3(:,:,:), value4(:,:,:,:) ! temporary
81 :
82 : integer (kind=dbl_kind), parameter :: num_2d = 32
83 : character(len=16), parameter :: fld_2d(num_2d) = &
84 : (/ 'aice ', 'vice ', 'vsno ', &
85 : 'uvel ', 'vvel ', 'divu ', &
86 : 'shear ', 'strength ', &
87 : 'evap ', 'fsnow ', 'frazil ', &
88 : 'fswabs ', 'flw ', 'flwout ', &
89 : 'fsens ', 'fsurf ', 'flat ', &
90 : 'frain ', 'Tair ', 'Qa ', &
91 : 'fsw ', 'fcondtop ', 'meltt ', &
92 : 'meltb ', 'meltl ', 'snoice ', &
93 : 'dsnow ', 'congel ', 'sst ', &
94 : 'sss ', 'Tf ', 'fhocn ' /)
95 :
96 : integer (kind=dbl_kind), parameter :: num_3d_ncat = 3
97 : character(len=16), parameter :: fld_3d_ncat(num_3d_ncat) = &
98 : (/ 'aicen ', 'vicen ', 'vsnon ' /)
99 :
100 : logical (kind=log_kind) :: &
101 : tr_fsd ! flag for tracing fsd
102 :
103 : integer (kind=dbl_kind), parameter :: num_3d_nfsd = 5
104 : character(len=16), parameter :: fld_3d_nfsd(num_3d_nfsd) = &
105 : (/ 'd_afsd_newi ', 'd_afsd_latg ', 'd_afsd_latm ', &
106 : 'd_afsd_wave ', 'd_afsd_weld ' /)
107 :
108 : integer (kind=dbl_kind), parameter :: num_3d_ntrcr = 1
109 : character(len=16), parameter :: fld_3d_ntrcr(num_3d_ntrcr) = &
110 : (/ 'trcr ' /)
111 :
112 : integer (kind=dbl_kind), parameter :: num_4d_ncat_ntrcr = 1
113 : character(len=16), parameter :: fld_4d_ncat_ntrcr(num_4d_ncat_ntrcr) = &
114 : (/ 'trcrn ' /)
115 :
116 : character (len=char_len_long) :: tmpstr
117 :
118 : character(len=*), parameter :: subname='(history_write)'
119 :
120 : #ifdef USE_NETCDF
121 48264 : call icepack_query_tracer_sizes(ntrcr_out=ntrcr)
122 48264 : call icepack_query_tracer_flags(tr_fsd_out=tr_fsd)
123 48264 : if (first_call) then
124 6 : timcnt = 0
125 6 : write(hist_file,'(a,i8.8,a)') './history/icepack.h.',idate,'.nc'
126 6 : iflag = nf90_clobber
127 6 : status = nf90_create(trim(hist_file),iflag,ncid)
128 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: nf90_create '//trim(hist_file))
129 :
130 : ! nx columns dimension
131 6 : status = nf90_def_dim(ncid,'ni',nx,nxid)
132 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim ni')
133 6 : status = nf90_def_var(ncid,'ni',NF90_INT,nxid,varid)
134 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var ni')
135 30 : do n = 1,nx
136 24 : write(tmpstr,'(a,i3.3)') 'column_name_',n
137 24 : status = nf90_put_att(ncid,varid,trim(tmpstr),trim(nx_names(n)))
138 30 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att columns names')
139 : enddo
140 :
141 : ! ncat category dimension
142 6 : status = nf90_def_dim(ncid,'ncat',ncat,ncatid)
143 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim ncat')
144 6 : status = nf90_def_var(ncid,'ncat',NF90_INT,ncatid,varid)
145 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var ncat')
146 :
147 : ! ntrcr dimension
148 6 : status = nf90_def_dim(ncid,'ntrcr',ntrcr,ntrcrid)
149 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim ntrcr')
150 6 : status = nf90_def_var(ncid,'ntrcr',NF90_INT,ntrcrid,varid)
151 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var ntrcr')
152 :
153 6 : if (tr_fsd) then
154 : ! nfsd category dimension
155 0 : status = nf90_def_dim(ncid,'nfsd',nfsd,nfsdid)
156 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim nfsd')
157 0 : status = nf90_def_var(ncid,'nfsd',NF90_INT,nfsdid,varid)
158 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var nfsd')
159 : endif
160 :
161 : ! time dimension
162 6 : status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,timid)
163 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim time')
164 6 : status = nf90_def_var(ncid,'time',NF90_DOUBLE,timid,varid)
165 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var time')
166 6 : status = nf90_put_att(ncid,varid,'long_name','model time')
167 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att time long_name')
168 6 : write(tmpstr,'(a,i0,a)') 'days since ', &
169 12 : year_init,'-01-01 00:00:00'
170 6 : status = nf90_put_att(ncid,varid,'units',trim(tmpstr))
171 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att time units')
172 6 : if (days_per_year == 360) then
173 0 : status = nf90_put_att(ncid,varid,'calendar','360_day')
174 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att calendar 360_day')
175 6 : elseif (days_per_year == 365 .and. .not.use_leap_years ) then
176 6 : status = nf90_put_att(ncid,varid,'calendar','NoLeap')
177 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att calendar noleap')
178 0 : elseif (use_leap_years) then
179 0 : status = nf90_put_att(ncid,varid,'calendar','Gregorian')
180 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att calendar gregorian')
181 : else
182 0 : call icedrv_system_abort(string=subname//' ERROR: invalid calendar settings')
183 : endif
184 6 : status = nf90_def_var(ncid,'timestep',NF90_INT,timid,varid)
185 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var timestep')
186 6 : status = nf90_def_var(ncid,'date',NF90_DOUBLE,timid,varid)
187 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var date')
188 :
189 : ! 2d fields
190 :
191 6 : dimid2(1) = nxid
192 6 : dimid2(2) = timid
193 :
194 198 : do n = 1,num_2d
195 192 : status = nf90_def_var(ncid,trim(fld_2d(n)),NF90_DOUBLE,dimid2,varid)
196 198 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_2d(n)))
197 : enddo
198 :
199 : ! 3d ncat fields
200 :
201 6 : dimid3(1) = nxid
202 6 : dimid3(2) = ncatid
203 6 : dimid3(3) = timid
204 :
205 24 : do n = 1,num_3d_ncat
206 18 : status = nf90_def_var(ncid,trim(fld_3d_ncat(n)),NF90_DOUBLE,dimid3,varid)
207 24 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_3d_ncat(n)))
208 : enddo
209 :
210 6 : if (tr_fsd) then
211 : ! 3d nfsd fields
212 :
213 0 : dimid3(1) = nxid
214 0 : dimid3(2) = nfsdid
215 0 : dimid3(3) = timid
216 :
217 0 : do n = 1,num_3d_nfsd
218 0 : status = nf90_def_var(ncid,trim(fld_3d_nfsd(n)),NF90_DOUBLE,dimid3,varid)
219 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_3d_nfsd(n)))
220 : enddo
221 : endif
222 :
223 : ! 3d ntrcr fields
224 :
225 6 : dimid3(1) = nxid
226 6 : dimid3(2) = ntrcrid
227 6 : dimid3(3) = timid
228 :
229 12 : do n = 1,num_3d_ntrcr
230 6 : status = nf90_def_var(ncid,trim(fld_3d_ntrcr(n)),NF90_DOUBLE,dimid3,varid)
231 12 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_3d_ntrcr(n)))
232 : enddo
233 :
234 : ! 4d ncat ntrcr fields
235 :
236 6 : dimid4(1) = nxid
237 6 : dimid4(2) = ntrcrid
238 6 : dimid4(3) = ncatid
239 6 : dimid4(4) = timid
240 :
241 12 : do n = 1,num_4d_ncat_ntrcr
242 6 : status = nf90_def_var(ncid,trim(fld_4d_ncat_ntrcr(n)),NF90_DOUBLE,dimid4,varid)
243 12 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_4d_ncat_ntrcr(n)))
244 : enddo
245 :
246 : ! enddef
247 :
248 6 : status = nf90_enddef(ncid)
249 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in nf90_enddef')
250 :
251 : ! static dimension variables
252 :
253 6 : status = nf90_inq_varid(ncid,'ni',varid)
254 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'ni')
255 6 : status = nf90_put_var(ncid,varid,(/(n,n=1,nx)/))
256 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'ni')
257 :
258 6 : status = nf90_inq_varid(ncid,'ncat',varid)
259 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'ncat')
260 6 : status = nf90_put_var(ncid,varid,(/(n,n=1,ncat)/))
261 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'ncat')
262 :
263 6 : status = nf90_inq_varid(ncid,'ntrcr',varid)
264 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'ntrcr')
265 258 : status = nf90_put_var(ncid,varid,(/(n,n=1,ntrcr)/))
266 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'ntrcr')
267 :
268 6 : if (tr_fsd) then
269 0 : status = nf90_inq_varid(ncid,'nfsd',varid)
270 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'nfsd')
271 0 : status = nf90_put_var(ncid,varid,(/(n,n=1,nfsd)/))
272 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'nfsd')
273 : endif
274 :
275 : endif
276 :
277 48264 : first_call = .false.
278 :
279 : ! Time
280 :
281 48264 : timcnt = timcnt + 1
282 :
283 48264 : status = nf90_inq_varid(ncid,'time',varid)
284 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'time')
285 48264 : value = time/secday
286 96528 : status = nf90_put_var(ncid,varid,value,start=(/timcnt/))
287 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'time')
288 :
289 48264 : status = nf90_inq_varid(ncid,'timestep',varid)
290 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'timestep')
291 96528 : status = nf90_put_var(ncid,varid,istep1,start=(/timcnt/))
292 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'timestep')
293 :
294 48264 : status = nf90_inq_varid(ncid,'date',varid)
295 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'date')
296 48264 : value = real(idate,kind=dbl_kind) + real(sec,kind=dbl_kind)/(secday)
297 96528 : status = nf90_put_var(ncid,varid,value,start=(/timcnt/))
298 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'date')
299 :
300 : ! 2d fields
301 :
302 48264 : start2(1) = 1
303 48264 : count2(1) = nx
304 48264 : start2(2) = timcnt
305 48264 : count2(2) = 1
306 :
307 1592712 : do n = 1,num_2d
308 1544448 : allocate(value2(count2(1),1))
309 :
310 9266688 : value2 = -9999._dbl_kind
311 1737504 : if (trim(fld_2d(n)) == 'aice') value2(1:count2(1),1) = aice(1:count2(1))
312 1737504 : if (trim(fld_2d(n)) == 'vice') value2(1:count2(1),1) = vice(1:count2(1))
313 1737504 : if (trim(fld_2d(n)) == 'vsno') value2(1:count2(1),1) = vsno(1:count2(1))
314 1737504 : if (trim(fld_2d(n)) == 'uvel') value2(1:count2(1),1) = uvel(1:count2(1))
315 1737504 : if (trim(fld_2d(n)) == 'vvel') value2(1:count2(1),1) = vvel(1:count2(1))
316 1737504 : if (trim(fld_2d(n)) == 'divu') value2(1:count2(1),1) = divu(1:count2(1))
317 1737504 : if (trim(fld_2d(n)) == 'shear') value2(1:count2(1),1) = shear(1:count2(1))
318 1737504 : if (trim(fld_2d(n)) == 'strength') value2(1:count2(1),1) = strength(1:count2(1))
319 1737504 : if (trim(fld_2d(n)) == 'evap') value2(1:count2(1),1) = evap(1:count2(1))
320 1737504 : if (trim(fld_2d(n)) == 'fsnow') value2(1:count2(1),1) = fsnow(1:count2(1))
321 1737504 : if (trim(fld_2d(n)) == 'frazil') value2(1:count2(1),1) = frazil(1:count2(1))
322 1737504 : if (trim(fld_2d(n)) == 'fswabs') value2(1:count2(1),1) = fswabs(1:count2(1))
323 1737504 : if (trim(fld_2d(n)) == 'flw') value2(1:count2(1),1) = flw(1:count2(1))
324 1737504 : if (trim(fld_2d(n)) == 'flwout') value2(1:count2(1),1) = flwout(1:count2(1))
325 1737504 : if (trim(fld_2d(n)) == 'fsens') value2(1:count2(1),1) = fsens(1:count2(1))
326 1737504 : if (trim(fld_2d(n)) == 'fsurf') value2(1:count2(1),1) = fsurf(1:count2(1))
327 1737504 : if (trim(fld_2d(n)) == 'flat') value2(1:count2(1),1) = flat(1:count2(1))
328 1737504 : if (trim(fld_2d(n)) == 'frain') value2(1:count2(1),1) = frain(1:count2(1))
329 1737504 : if (trim(fld_2d(n)) == 'Tair') value2(1:count2(1),1) = Tair(1:count2(1))
330 1737504 : if (trim(fld_2d(n)) == 'Qa') value2(1:count2(1),1) = Qa(1:count2(1))
331 1737504 : if (trim(fld_2d(n)) == 'fsw') value2(1:count2(1),1) = fsw(1:count2(1))
332 1737504 : if (trim(fld_2d(n)) == 'fcondtop') value2(1:count2(1),1) = fcondtop(1:count2(1))
333 1737504 : if (trim(fld_2d(n)) == 'meltt') value2(1:count2(1),1) = meltt(1:count2(1))
334 1737504 : if (trim(fld_2d(n)) == 'meltb') value2(1:count2(1),1) = meltb(1:count2(1))
335 1737504 : if (trim(fld_2d(n)) == 'meltl') value2(1:count2(1),1) = meltl(1:count2(1))
336 1737504 : if (trim(fld_2d(n)) == 'snoice') value2(1:count2(1),1) = snoice(1:count2(1))
337 1737504 : if (trim(fld_2d(n)) == 'dsnow') value2(1:count2(1),1) = dsnow(1:count2(1))
338 1737504 : if (trim(fld_2d(n)) == 'congel') value2(1:count2(1),1) = congel(1:count2(1))
339 1737504 : if (trim(fld_2d(n)) == 'sst') value2(1:count2(1),1) = sst(1:count2(1))
340 1737504 : if (trim(fld_2d(n)) == 'sss') value2(1:count2(1),1) = sss(1:count2(1))
341 1737504 : if (trim(fld_2d(n)) == 'Tf') value2(1:count2(1),1) = Tf(1:count2(1))
342 1737504 : if (trim(fld_2d(n)) == 'fhocn') value2(1:count2(1),1) = fhocn(1:count2(1))
343 :
344 1544448 : status = nf90_inq_varid(ncid,trim(fld_2d(n)),varid)
345 1544448 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_2d(n)))
346 1544448 : status = nf90_put_var(ncid,varid,value2,start=start2,count=count2)
347 1544448 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_2d(n)))
348 :
349 1592712 : deallocate(value2)
350 : enddo
351 :
352 : ! 3d ncat fields
353 :
354 48264 : start3(1) = 1
355 48264 : count3(1) = nx
356 48264 : start3(2) = 1
357 48264 : count3(2) = ncat
358 48264 : start3(3) = timcnt
359 48264 : count3(3) = 1
360 :
361 193056 : do n = 1,num_3d_ncat
362 144792 : allocate(value3(count3(1),count3(2),1))
363 :
364 3909384 : value3 = -9999._dbl_kind
365 1351392 : if (trim(fld_3d_ncat(n)) == 'aicen') value3(1:count3(1),1:count3(2),1) = aicen(1:count3(1),1:count3(2))
366 1351392 : if (trim(fld_3d_ncat(n)) == 'vicen') value3(1:count3(1),1:count3(2),1) = vicen(1:count3(1),1:count3(2))
367 1351392 : if (trim(fld_3d_ncat(n)) == 'vsnon') value3(1:count3(1),1:count3(2),1) = vsnon(1:count3(1),1:count3(2))
368 :
369 144792 : status = nf90_inq_varid(ncid,trim(fld_3d_ncat(n)),varid)
370 144792 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_3d_ncat(n)))
371 144792 : status = nf90_put_var(ncid,varid,value3,start=start3,count=count3)
372 144792 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_3d_ncat(n)))
373 :
374 193056 : deallocate(value3)
375 : enddo
376 :
377 48264 : if (tr_fsd) then
378 : ! 3d nfsd fields
379 :
380 0 : start3(1) = 1
381 0 : count3(1) = nx
382 0 : start3(2) = 1
383 0 : count3(2) = nfsd
384 0 : start3(3) = timcnt
385 0 : count3(3) = 1
386 :
387 0 : do n = 1,num_3d_nfsd
388 0 : allocate(value3(count3(1),count3(2),1))
389 :
390 0 : value3 = -9999._dbl_kind
391 0 : if (trim(fld_3d_nfsd(n)) == 'd_afsd_newi') value3(1:count3(1),1:count3(2),1) = d_afsd_newi(1:count3(1),1:count3(2))
392 0 : if (trim(fld_3d_nfsd(n)) == 'd_afsd_latg') value3(1:count3(1),1:count3(2),1) = d_afsd_latg(1:count3(1),1:count3(2))
393 0 : if (trim(fld_3d_nfsd(n)) == 'd_afsd_latm') value3(1:count3(1),1:count3(2),1) = d_afsd_latm(1:count3(1),1:count3(2))
394 0 : if (trim(fld_3d_nfsd(n)) == 'd_afsd_wave') value3(1:count3(1),1:count3(2),1) = d_afsd_wave(1:count3(1),1:count3(2))
395 0 : if (trim(fld_3d_nfsd(n)) == 'd_afsd_weld') value3(1:count3(1),1:count3(2),1) = d_afsd_weld(1:count3(1),1:count3(2))
396 :
397 0 : status = nf90_inq_varid(ncid,trim(fld_3d_nfsd(n)),varid)
398 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_3d_nfsd(n)))
399 0 : status = nf90_put_var(ncid,varid,value3,start=start3,count=count3)
400 0 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_3d_nfsd(n)))
401 :
402 0 : deallocate(value3)
403 : enddo
404 : endif
405 :
406 : ! 3d ntrcr fields
407 :
408 48264 : start3(1) = 1
409 48264 : count3(1) = nx
410 48264 : start3(2) = 1
411 48264 : count3(2) = ntrcr
412 48264 : start3(3) = timcnt
413 48264 : count3(3) = 1
414 :
415 96528 : do n = 1,num_3d_ntrcr
416 48264 : allocate(value3(count3(1),count3(2),1))
417 :
418 5164248 : value3 = -9999._dbl_kind
419 5115984 : if (trim(fld_3d_ntrcr(n)) == 'trcr') value3(1:count3(1),1:count3(2),1) = trcr(1:count3(1),1:count3(2))
420 :
421 48264 : status = nf90_inq_varid(ncid,trim(fld_3d_ntrcr(n)),varid)
422 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_3d_ntrcr(n)))
423 48264 : status = nf90_put_var(ncid,varid,value3,start=start3,count=count3)
424 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_3d_ntrcr(n)))
425 :
426 96528 : deallocate(value3)
427 : enddo
428 :
429 : ! 4d ncat ntrcr fields
430 :
431 48264 : start4(1) = 1
432 48264 : count4(1) = nx
433 48264 : start4(2) = 1
434 48264 : count4(2) = ntrcr
435 48264 : start4(3) = 1
436 48264 : count4(3) = ncat
437 48264 : start4(4) = timcnt
438 48264 : count4(4) = 1
439 :
440 96528 : do n = 1,num_4d_ncat_ntrcr
441 48264 : allocate(value4(count4(1),count4(2),count4(3),1))
442 :
443 25676448 : value4 = -9999._dbl_kind
444 25628184 : if (trim(fld_4d_ncat_ntrcr(n)) == 'trcrn') value4(1:count4(1),1:count4(2),1:count4(3),1) = trcrn(1:count4(1),1:count4(2),1:count4(3))
445 :
446 48264 : status = nf90_inq_varid(ncid,trim(fld_4d_ncat_ntrcr(n)),varid)
447 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_4d_ncat_ntrcr(n)))
448 48264 : status = nf90_put_var(ncid,varid,value4,start=start4,count=count4)
449 48264 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_4d_ncat_ntrcr(n)))
450 :
451 96528 : deallocate(value4)
452 : enddo
453 :
454 : #else
455 0 : call icedrv_system_abort(string=subname//' ERROR: history requires USE_NETCDF',file=__FILE__,line=__LINE__)
456 : #endif
457 :
458 48264 : end subroutine history_write
459 :
460 : !=======================================================================
461 :
462 : ! Close history file
463 :
464 6 : subroutine history_close()
465 :
466 : #ifdef USE_NETCDF
467 : use netcdf
468 : #endif
469 :
470 : ! local variables
471 :
472 : integer (kind=int_kind) :: &
473 : status ! cdf status flag
474 :
475 : character(len=*), parameter :: subname='(history_close)'
476 :
477 : #ifdef USE_NETCDF
478 6 : status = nf90_close(ncid)
479 6 : if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: nf90_close')
480 : #else
481 0 : call icedrv_system_abort(string=subname//' ERROR: history requires USE_NETCDF',file=__FILE__,line=__LINE__)
482 : #endif
483 :
484 6 : end subroutine history_close
485 :
486 : !=======================================================================
487 :
488 : end module icedrv_history
489 :
490 : !=======================================================================
|
