95
96
98
99
100
101 integer, intent(in) :: ng, tile
102
103
104
105 integer :: LBi, UBi, LBj, UBj
106 integer :: gtype, itide, itrc, status, varid
107
108 real(dp) :: scale
109 real(r8) :: Work(NTC(ng))
110
111 character (len=*), parameter :: MyFile = &
112 & __FILE__//", wrt_tides_nf90"
113
114 sourcefile=myfile
115
116
117
118
119
120 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
121
122
123
124 IF (master) WRITE (stdout,20) ng
125
126
127
129 & hcount(ng), (/0/), (/0/), &
130 & ncid = har(ng)%ncid)
131 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
132
133
134
136 & trim(vname(1,idtime)), time(ng), &
137 & (/0/), (/0/), &
138 & ncid = har(ng)%ncid, &
139 & varid = har(ng)%Vid(idtime))
140 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
141
142
143
144 DO itide=1,ntc(ng)
145 work(itide)=tides(ng)%Tperiod(itide)/3600.0_r8
146 END DO
147
149 & trim(vname(1,idtper)), &
150 & work, &
151 & (/1/), (/ntc(ng)/), &
152 & ncid = har(ng)%ncid, &
153 & varid = har(ng)%Vid(idtper))
154 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
155
156
157
159 & trim(vname(1,idcosw)), &
160 & tides(ng) % CosW_sum, &
161 & (/1/), (/ntc(ng)/), &
162 & ncid = har(ng)%ncid, &
163 & varid = har(ng)%Vid(idcosw))
164 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
165
166
167
169 & trim(vname(1,idsinw)), &
170 & tides(ng) % SinW_sum, &
171 & (/1/), (/ntc(ng)/), &
172 & ncid = har(ng)%ncid, &
173 & varid = har(ng)%Vid(idsinw))
174 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
175
176
177
179 & trim(vname(1,idcos2)), &
180 & tides(ng) % CosWCosW, &
181 & (/1,1/), (/ntc(ng),ntc(ng)/), &
182 & ncid = har(ng)%ncid, &
183 & varid = har(ng)%Vid(idcos2))
184 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
185
186
187
189 & trim(vname(1,idsin2)), &
190 & tides(ng) % SinWSinW, &
191 & (/1,1/), (/ntc(ng),ntc(ng)/), &
192 & ncid = har(ng)%ncid, &
193 & varid = har(ng)%Vid(idsin2))
194 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
195
196
197
199 & trim(vname(1,idswcw)), &
200 & tides(ng) % SinWCosW, &
201 & (/1,1/), (/ntc(ng),ntc(ng)/), &
202 & ncid = har(ng)%ncid, &
203 & varid = har(ng)%Vid(idswcw))
204 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
205
206
207
208 IF (aout(idfsud,ng)) THEN
209 scale=1.0_dp
210 gtype=r3dvar
211 status=nf_fwrite3d(ng, inlm, har(ng)%ncid, idfsuh, &
212 & har(ng)%Vid(idfsuh), 0, gtype, &
213 & lbi, ubi, lbj, ubj, 0, 2*ntc(ng), scale, &
214# ifdef MASKING
215 & grid(ng) % rmask, &
216# endif
217 & tides(ng) % zeta_tide, &
218 & setfillval = .false.)
219 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
220 IF (master) THEN
221 WRITE (stdout,20) trim(vname(1,idfsuh)), trim(har(ng)%name)
222 END IF
223 exit_flag=3
224 ioerror=status
225 RETURN
226 END IF
227 END IF
228
229
230
231 IF (aout(idu2dd,ng)) THEN
232 scale=1.0_dp
233 gtype=u3dvar
234 status=nf_fwrite3d(ng, inlm, har(ng)%ncid, idu2dh, &
235 & har(ng)%Vid(idu2dh), 0, gtype, &
236 & lbi, ubi, lbj, ubj, 0, 2*ntc(ng), scale, &
237# ifdef MASKING
238 & grid(ng) % umask, &
239# endif
240 & tides(ng) % ubar_tide, &
241 & setfillval = .false.)
242 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
243 IF (master) THEN
244 WRITE (stdout,20) trim(vname(1,idu2dh)), trim(har(ng)%name)
245 END IF
246 exit_flag=3
247 ioerror=status
248 RETURN
249 END IF
250 END IF
251
252
253
254 IF (aout(idv2dd,ng)) THEN
255 scale=1.0_dp
256 gtype=v3dvar
257 status=nf_fwrite3d(ng, inlm, har(ng)%ncid, idv2dh, &
258 & har(ng)%Vid(idv2dh), 0, gtype, &
259 & lbi, ubi, lbj, ubj, 0, 2*ntc(ng), scale, &
260# ifdef MASKING
261 & grid(ng) % vmask, &
262# endif
263 & tides(ng) % vbar_tide, &
264 & setfillval = .false.)
265 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
266 IF (master) THEN
267 WRITE (stdout,20) trim(vname(1,idv2dh)), trim(har(ng)%name)
268 END IF
269 exit_flag=3
270 ioerror=status
271 RETURN
272 END IF
273 END IF
274
275# ifdef SOLVE3D
276
277
278
279 IF (aout(idu3dd,ng)) THEN
280 scale=1.0_dp
281 gtype=u3dvar
282 status=nf_fwrite4d(ng, inlm, har(ng)%ncid, idu3dh, &
283 & har(ng)%Vid(idu3dh), 0, gtype, &
284 & lbi, ubi, lbj, ubj, 1, n(ng), 0, 2*ntc(ng), &
285 & scale, &
286# ifdef MASKING
287 & grid(ng) % umask, &
288# endif
289 & tides(ng) % u_tide, &
290 & setfillval = .false.)
291 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
292 IF (master) THEN
293 WRITE (stdout,20) trim(vname(1,idu3dh)), trim(har(ng)%name)
294 END IF
295 exit_flag=3
296 ioerror=status
297 RETURN
298 END IF
299 END IF
300
301
302
303 IF (aout(idv3dd,ng)) THEN
304 scale=1.0_dp
305 gtype=v3dvar
306 status=nf_fwrite4d(ng, inlm, har(ng)%ncid, idv3dh, &
307 & har(ng)%Vid(idv3dh), 0, gtype, &
308 & lbi, ubi, lbj, ubj, 1, n(ng), 0, 2*ntc(ng), &
309 & scale, &
310# ifdef MASKING
311 & grid(ng) % vmask, &
312# endif
313 & tides(ng) % v_tide, &
314 & setfillval = .false.)
315 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
316 IF (master) THEN
317 WRITE (stdout,20) trim(vname(1,idv3dh)), trim(har(ng)%name)
318 END IF
319 exit_flag=3
320 ioerror=status
321 RETURN
322 END IF
323 END IF
324
325
326
327 DO itrc=1,nat
328 IF (aout(idtrcd(itrc),ng)) THEN
329 scale=1.0_dp
330 gtype=r3dvar
331 status=nf_fwrite4d(ng, inlm, har(ng)%ncid, idtrch(itrc), &
332 & har(ng)%Vid(idtrch(itrc)), 0, gtype, &
333 & lbi, ubi, lbj, ubj, 1, n(ng), 0, 2*ntc(ng),&
334 & scale, &
335# ifdef MASKING
336 & grid(ng) % vmask, &
337# endif
338 & tides(ng) % t_tide(:,:,:,:,itrc), &
339 & setfillval = .false.)
340 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
341 IF (master) THEN
342 WRITE (stdout,20) trim(vname(1,idtrch(itrc))), &
343 & trim(har(ng)%name)
344 END IF
345 exit_flag=3
346 ioerror=status
347 RETURN
348 END IF
349 END IF
350 END DO
351# endif
352
353
354
355
356
357
358 CALL netcdf_sync (ng, inlm, har(ng)%name, har(ng)%ncid)
359 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
360
361 10 FORMAT (2x,'WRT_TIDES_NF90 - writing time-accumulated tide ', &
362 & 'harmonics, Grid ',i2.2)
363 20 FORMAT (/,' WRT_TIDES_NF90 - error while writing variable: ',a, &
364 & /,13x,'into detide harmonics NetCDF file: ',/,13x,a)
365
366 RETURN
subroutine, public netcdf_sync(ng, model, ncname, ncid)