1 | ! |
---|
2 | ! $Id: wrt_floats.F,v 1.5 2005/05/11 14:09:53 pmarches Exp $ |
---|
3 | ! |
---|
4 | #include "cppdefs.h" |
---|
5 | #ifdef FLOATS |
---|
6 | ! Writes requested model |
---|
7 | subroutine wrt_floats ! fields at requested levels |
---|
8 | ! into history netCDF file. |
---|
9 | # ifdef AGRIF |
---|
10 | USE Agrif_Util |
---|
11 | # endif |
---|
12 | implicit none |
---|
13 | # include "param.h" |
---|
14 | # include "scalars.h" |
---|
15 | # include "ncscrum.h" |
---|
16 | # include "ncscrum_floats.h" |
---|
17 | # include "grid.h" |
---|
18 | # include "ocean2d.h" |
---|
19 | # include "ocean3d.h" |
---|
20 | # include "mixing.h" |
---|
21 | # include "floats.h" |
---|
22 | # include "netcdf.inc" |
---|
23 | |
---|
24 | integer ierr, record, lvar, lenstr, iflt, id |
---|
25 | & , nfltrelmax, nfltunrelmax, indxrel(Mfloats) |
---|
26 | & , indxunrel(Mfloats),Toutint(Mfloats) |
---|
27 | & , start(2), count(2), ibuff(2), nf_fwrite |
---|
28 | logical newf |
---|
29 | character*65 vinfo |
---|
30 | real Tout(Mfloats) |
---|
31 | |
---|
32 | # if defined MPI & !defined PARALLEL_FILES |
---|
33 | include 'mpif.h' |
---|
34 | integer status(MPI_STATUS_SIZE), blank |
---|
35 | # endif |
---|
36 | # if defined MPI & !defined PARALLEL_FILES |
---|
37 | if (mynode.gt.0) then |
---|
38 | call MPI_Recv (blank, 1, MPI_INTEGER, mynode-1, |
---|
39 | & 1, MPI_COMM_WORLD, status, ierr) |
---|
40 | endif |
---|
41 | # endif |
---|
42 | ! |
---|
43 | ! Create/open history file; write grid arrays, if so needed. |
---|
44 | |
---|
45 | newf=.false. |
---|
46 | call def_floats (ncidflt, nrecflt, ierr, newf) |
---|
47 | if (ierr .ne. nf_noerr) goto 99 |
---|
48 | ! !!! WARNING: Once time |
---|
49 | ! Set record within the file. !!! stepping has been |
---|
50 | ! !!! started, it is assumed |
---|
51 | if (iic.eq.0) nrecflt=nrecflt+1 !!! that the global float |
---|
52 | if (nrpfflt.eq.0) then !!! history record index |
---|
53 | record=nrecflt !!! "nrecflt" is advanced |
---|
54 | else !!! by main. |
---|
55 | record=1+mod(nrecflt-1, nrpfflt) |
---|
56 | endif |
---|
57 | |
---|
58 | ! |
---|
59 | ! Write out evolving model variables: |
---|
60 | ! ----- --- -------- ----- ---------- |
---|
61 | ! |
---|
62 | ! Save indices of released and non released floats |
---|
63 | ! |
---|
64 | nfltrelmax=0 |
---|
65 | nfltunrelmax=0 |
---|
66 | do iflt=1,nfloats |
---|
67 | if (fltgrd(iflt).ne.-1) then |
---|
68 | nfltrelmax=nfltrelmax+1 |
---|
69 | indxrel(nfltrelmax)=iflt |
---|
70 | else |
---|
71 | nfltunrelmax=nfltunrelmax+1 |
---|
72 | indxunrel(nfltunrelmax)=iflt |
---|
73 | endif |
---|
74 | enddo |
---|
75 | |
---|
76 | |
---|
77 | ! Time step number and record numbers. |
---|
78 | ! |
---|
79 | ibuff(1)=iic |
---|
80 | ibuff(2)=nrecflt |
---|
81 | start(1)=1 |
---|
82 | start(2)=record |
---|
83 | count(1)=2 |
---|
84 | count(2)=1 |
---|
85 | |
---|
86 | ierr=nf_put_vara_int (ncidflt, fltTstep, start, count, ibuff) |
---|
87 | if (ierr .ne. nf_noerr) then |
---|
88 | write(stdout,1) 'time_step', record, ierr, nf_strerror(ierr) |
---|
89 | & MYID |
---|
90 | goto 99 !--> ERROR |
---|
91 | endif |
---|
92 | ! |
---|
93 | ! Time |
---|
94 | ! |
---|
95 | |
---|
96 | ierr=nf_put_var1_FTYPE (ncidflt, fltTime, record, time) |
---|
97 | if (ierr .ne. nf_noerr) then |
---|
98 | lvar=lenstr(vname(1,indxTime)) |
---|
99 | write(stdout,1) vname(1,indxTime)(1:lvar), record, ierr, |
---|
100 | & nf_strerror(ierr) MYID |
---|
101 | goto 99 !--> ERROR |
---|
102 | endif |
---|
103 | |
---|
104 | ! |
---|
105 | ! define position in nc file to write float data |
---|
106 | start(1)=1 |
---|
107 | count(1)=nfloats |
---|
108 | start(2)=record |
---|
109 | count(2)=1 |
---|
110 | |
---|
111 | if (wrtflt(indxfltGrd)) then |
---|
112 | ! |
---|
113 | ! Grid level |
---|
114 | do id=1,nfloats |
---|
115 | Toutint(id)=fltgrd(id) |
---|
116 | enddo |
---|
117 | |
---|
118 | ierr=nf_put_vara_int (ncidflt, fltGlevel, start,count, Toutint) |
---|
119 | if (ierr .ne. nf_noerr) then |
---|
120 | vinfo='grid level' |
---|
121 | lvar=lenstr(vinfo) |
---|
122 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
123 | & nf_strerror(ierr) MYID |
---|
124 | goto 99 !--> ERROR |
---|
125 | endif |
---|
126 | endif |
---|
127 | ! |
---|
128 | ! Fills in tmp variable with spval values for the nonreleased floats |
---|
129 | do id=1,nfltunrelmax |
---|
130 | iflt=indxunrel(id) |
---|
131 | Tout(iflt)=spval |
---|
132 | enddo |
---|
133 | |
---|
134 | # ifdef SOLVE3D |
---|
135 | |
---|
136 | if (wrtflt(indxfltTemp)) then |
---|
137 | ! temperature at floats position |
---|
138 | |
---|
139 | do id=1,nfltrelmax |
---|
140 | iflt=indxrel(id) |
---|
141 | Tout(iflt)=trackaux(iftem,iflt) |
---|
142 | enddo |
---|
143 | |
---|
144 | ierr=nf_put_vara_FTYPE(ncidflt,fltTemp,start,count, |
---|
145 | & Tout) |
---|
146 | if (ierr .ne. nf_noerr) then |
---|
147 | vinfo='Temp' |
---|
148 | lvar=lenstr(vinfo) |
---|
149 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
150 | & nf_strerror(ierr) MYID |
---|
151 | goto 99 !--> ERROR |
---|
152 | endif |
---|
153 | endif |
---|
154 | |
---|
155 | # ifdef SALINITY |
---|
156 | |
---|
157 | if (wrtflt(indxfltSalt)) then |
---|
158 | ! salinity at floats position |
---|
159 | |
---|
160 | do id=1,nfltrelmax |
---|
161 | iflt=indxrel(id) |
---|
162 | Tout(iflt)=trackaux(ifsal,iflt) |
---|
163 | enddo |
---|
164 | |
---|
165 | ierr=nf_put_vara_FTYPE(ncidflt,fltSal,start,count, |
---|
166 | & Tout) |
---|
167 | if (ierr .ne. nf_noerr) then |
---|
168 | vinfo='Salt' |
---|
169 | lvar=lenstr(vinfo) |
---|
170 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
171 | & nf_strerror(ierr) MYID |
---|
172 | goto 99 !--> ERROR |
---|
173 | endif |
---|
174 | endif |
---|
175 | |
---|
176 | # endif |
---|
177 | |
---|
178 | if (wrtflt(indxfltRho)) then |
---|
179 | ! density at floats position |
---|
180 | |
---|
181 | do id=1,nfltrelmax |
---|
182 | iflt=indxrel(id) |
---|
183 | Tout(iflt)=trackaux(ifden,iflt) |
---|
184 | enddo |
---|
185 | |
---|
186 | ierr=nf_put_vara_FTYPE(ncidflt,fltDen,start,count, |
---|
187 | & Tout) |
---|
188 | if (ierr .ne. nf_noerr) then |
---|
189 | vinfo='Den' |
---|
190 | lvar=lenstr(vinfo) |
---|
191 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
192 | & nf_strerror(ierr) MYID |
---|
193 | goto 99 !--> ERROR |
---|
194 | endif |
---|
195 | endif |
---|
196 | |
---|
197 | # endif /* SOLVE3D */ |
---|
198 | |
---|
199 | # ifdef IBM |
---|
200 | ! IBM data |
---|
201 | do id=1,nfltrelmax |
---|
202 | iflt=indxrel(id) |
---|
203 | Tout(iflt)=ibmdata(ibmage,iflt) |
---|
204 | enddo |
---|
205 | |
---|
206 | ierr=nf_put_vara_FTYPE(ncidflt,fltAge,start,count, |
---|
207 | & Tout) |
---|
208 | if (ierr .ne. nf_noerr) then |
---|
209 | vinfo='Age' |
---|
210 | lvar=lenstr(vinfo) |
---|
211 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
212 | & nf_strerror(ierr) MYID |
---|
213 | goto 99 !--> ERROR |
---|
214 | endif |
---|
215 | |
---|
216 | do id=1,nfltrelmax |
---|
217 | iflt=indxrel(id) |
---|
218 | Tout(iflt)=ibmdata(ibmzoe,iflt) |
---|
219 | enddo |
---|
220 | |
---|
221 | ierr=nf_put_vara_FTYPE(ncidflt,fltZoe,start,count, |
---|
222 | & Tout) |
---|
223 | if (ierr .ne. nf_noerr) then |
---|
224 | vinfo='Zoe' |
---|
225 | lvar=lenstr(vinfo) |
---|
226 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
227 | & nf_strerror(ierr) MYID |
---|
228 | goto 99 !--> ERROR |
---|
229 | endif |
---|
230 | # endif /* IBM */ |
---|
231 | |
---|
232 | if (wrtflt(indxfltVel)) then |
---|
233 | ! write mean velocity |
---|
234 | |
---|
235 | do id=1,nfltrelmax |
---|
236 | iflt=indxrel(id) |
---|
237 | Tout(iflt)=trackaux(ifvel,iflt) |
---|
238 | trackaux(ifvel,iflt)=0. !reinitializes variables for means |
---|
239 | enddo |
---|
240 | |
---|
241 | ierr=nf_put_vara_FTYPE(ncidflt,fltVel,start,count, |
---|
242 | & Tout) |
---|
243 | if (ierr .ne. nf_noerr) then |
---|
244 | vinfo='Vel' |
---|
245 | lvar=lenstr(vinfo) |
---|
246 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
247 | & nf_strerror(ierr) MYID |
---|
248 | goto 99 !--> ERROR |
---|
249 | endif |
---|
250 | endif |
---|
251 | |
---|
252 | !---------------------------------------------------------------- |
---|
253 | ! The following variables are to be stored with a non spval value |
---|
254 | ! at the first time step. Therefore, a modification to nfltrelmax |
---|
255 | ! and indxrel is done at this place. |
---|
256 | |
---|
257 | if (newf) then |
---|
258 | nfltrelmax=nfloats |
---|
259 | do iflt=1,nfloats |
---|
260 | indxrel(iflt)=iflt |
---|
261 | enddo |
---|
262 | endif |
---|
263 | |
---|
264 | # ifdef SPHERICAL |
---|
265 | ! WRITE floats (lon,lat) locations. |
---|
266 | |
---|
267 | do id=1,nfltrelmax |
---|
268 | iflt=indxrel(id) |
---|
269 | Tout(iflt)=trackaux(iflat,iflt) |
---|
270 | enddo |
---|
271 | |
---|
272 | ierr=nf_put_vara_FTYPE(ncidflt,fltLat,start,count, |
---|
273 | & Tout) |
---|
274 | if (ierr .ne. nf_noerr) then |
---|
275 | vinfo='Lat' |
---|
276 | lvar=lenstr(vinfo) |
---|
277 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
278 | & nf_strerror(ierr) MYID |
---|
279 | goto 99 !--> ERROR |
---|
280 | endif |
---|
281 | |
---|
282 | do id=1,nfltrelmax |
---|
283 | iflt=indxrel(id) |
---|
284 | Tout(iflt)=trackaux(iflon,iflt) |
---|
285 | enddo |
---|
286 | |
---|
287 | ierr=nf_put_vara_FTYPE(ncidflt,fltLon,start,count, |
---|
288 | & Tout) |
---|
289 | if (ierr .ne. nf_noerr) then |
---|
290 | vinfo='Lon' |
---|
291 | lvar=lenstr(vinfo) |
---|
292 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
293 | & nf_strerror(ierr) MYID |
---|
294 | goto 99 !--> ERROR |
---|
295 | endif |
---|
296 | |
---|
297 | # endif |
---|
298 | |
---|
299 | if (wrtflt(indxfltGrd)) then |
---|
300 | ! WRITE X position in the grid |
---|
301 | do id=1,nfltrelmax |
---|
302 | iflt=indxrel(id) |
---|
303 | Tout(iflt)=trackaux(ixgrd,iflt) |
---|
304 | enddo |
---|
305 | |
---|
306 | ierr=nf_put_vara_FTYPE(ncidflt,fltXgrd,start,count, |
---|
307 | & Tout) |
---|
308 | if (ierr .ne. nf_noerr) then |
---|
309 | vinfo='Xgrid' |
---|
310 | lvar=lenstr(vinfo) |
---|
311 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
312 | & nf_strerror(ierr) MYID |
---|
313 | goto 99 !--> ERROR |
---|
314 | endif |
---|
315 | |
---|
316 | ! WRITE Y position in the grid |
---|
317 | do id=1,nfltrelmax |
---|
318 | iflt=indxrel(id) |
---|
319 | Tout(iflt)=trackaux(iygrd,iflt) |
---|
320 | enddo |
---|
321 | |
---|
322 | ierr=nf_put_vara_FTYPE(ncidflt,fltYgrd,start,count, |
---|
323 | & Tout) |
---|
324 | if (ierr .ne. nf_noerr) then |
---|
325 | vinfo='Ygrid' |
---|
326 | lvar=lenstr(vinfo) |
---|
327 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
328 | & nf_strerror(ierr) MYID |
---|
329 | goto 99 !--> ERROR |
---|
330 | endif |
---|
331 | |
---|
332 | # ifdef SOLVE3D |
---|
333 | ! WRITE Z position in the grid |
---|
334 | do id=1,nfltrelmax |
---|
335 | iflt=indxrel(id) |
---|
336 | Tout(iflt)=trackaux(izgrd,iflt) |
---|
337 | enddo |
---|
338 | |
---|
339 | ierr=nf_put_vara_FTYPE(ncidflt,fltZgrd,start,count, |
---|
340 | & Tout) |
---|
341 | if (ierr .ne. nf_noerr) then |
---|
342 | vinfo='Zgrid' |
---|
343 | lvar=lenstr(vinfo) |
---|
344 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
345 | & nf_strerror(ierr) MYID |
---|
346 | goto 99 !--> ERROR |
---|
347 | endif |
---|
348 | # endif |
---|
349 | endif |
---|
350 | |
---|
351 | # ifdef SOLVE3D |
---|
352 | ! |
---|
353 | ! float depth |
---|
354 | |
---|
355 | do id=1,nfltrelmax |
---|
356 | iflt=indxrel(id) |
---|
357 | Tout(iflt)=trackaux(ifdpt,iflt) |
---|
358 | enddo |
---|
359 | |
---|
360 | ierr=nf_put_vara_FTYPE(ncidflt,fltDepth,start,count, |
---|
361 | & Tout) |
---|
362 | if (ierr .ne. nf_noerr) then |
---|
363 | vinfo='Depth' |
---|
364 | lvar=lenstr(vinfo) |
---|
365 | write(stdout,1) vinfo(1:lvar), record, ierr, |
---|
366 | & nf_strerror(ierr) MYID |
---|
367 | goto 99 !--> ERROR |
---|
368 | endif |
---|
369 | # endif |
---|
370 | |
---|
371 | 1 format(/1x, 'WRT_FLT ERROR while writing variable ''', A, |
---|
372 | & ''' into float file.' /11x, 'Time record:', I6, |
---|
373 | & 3x,'netCDF error code',i4 /11x,'Cause of error: ', |
---|
374 | & A, 3x, A, i4) |
---|
375 | goto 100 |
---|
376 | 99 may_day_flag=3 |
---|
377 | 100 continue |
---|
378 | |
---|
379 | |
---|
380 | ! |
---|
381 | ! Synchronize netCDF file to disk to allow other processes |
---|
382 | ! to access data immediately after it is written. |
---|
383 | ! |
---|
384 | # if defined MPI & !defined PARALLEL_FILES |
---|
385 | ierr=nf_close (ncidflt) |
---|
386 | if (nrpfflt.gt.0 .and. record.ge.nrpfflt) ncidflt=-1 |
---|
387 | # else |
---|
388 | if (nrpfflt.gt.0 .and. record.ge.nrpfflt) then |
---|
389 | ierr=nf_close (ncidflt) |
---|
390 | ! write(*,*) 'FLOAT FILE IS CLOSED (XA) ' |
---|
391 | ncidflt=-1 |
---|
392 | else |
---|
393 | ierr=nf_sync(ncidflt) |
---|
394 | endif |
---|
395 | # endif |
---|
396 | if (ierr .eq. nf_noerr) then |
---|
397 | write(stdout,'(6x,A,2(A,I4,1x),A,I3)') 'WRT_FLT -- wrote ', |
---|
398 | & 'float history fields into time record =', record, |
---|
399 | & '/' ,nrecflt MYID |
---|
400 | else |
---|
401 | write(stdout,'(/1x,2A/)') 'WRT_FLT ERROR: Cannot ', |
---|
402 | & 'synchronize/close float netCDF file.' |
---|
403 | may_day_flag=3 |
---|
404 | endif |
---|
405 | |
---|
406 | # if defined MPI & !defined PARALLEL_FILES |
---|
407 | if (mynode .lt. NNODES-1) then |
---|
408 | call MPI_Send (blank, 1, MPI_INTEGER, mynode+1, |
---|
409 | & 1, MPI_COMM_WORLD, ierr) |
---|
410 | endif |
---|
411 | # endif |
---|
412 | |
---|
413 | return |
---|
414 | end |
---|
415 | |
---|
416 | |
---|
417 | #else |
---|
418 | subroutine wrt_floats_empty |
---|
419 | return |
---|
420 | end |
---|
421 | #endif /* FLOATS */ |
---|
422 | |
---|