Context Navigation

diawri.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

File size: 22.0 KB

Line
1	MODULE diawri
2	!!======================================================================
3	!! * MODULE diawri *
4	!! Ocean diagnostics : write ocean output files
5	!!=====================================================================
6	!! History : OPA ! 1991-03 (M.-A. Foujols) Original code
7	!! 4.0 ! 1991-11 (G. Madec)
8	!! ! 1992-06 (M. Imbard) correction restart file
9	!! ! 1992-07 (M. Imbard) split into diawri and rstwri
10	!! ! 1993-03 (M. Imbard) suppress writibm
11	!! ! 1998-01 (C. Levy) NETCDF format using ioipsl INTERFACE
12	!! ! 1999-02 (E. Guilyardi) name of netCDF files + variables
13	!! 8.2 ! 2000-06 (M. Imbard) Original code (diabort.F)
14	!! NEMO 1.0 ! 2002-06 (A.Bozec, E. Durand) Original code (diainit.F)
15	!! - ! 2002-09 (G. Madec) F90: Free form and module
16	!! - ! 2002-12 (G. Madec) merge of diabort and diainit, F90
17	!! ! 2005-11 (V. Garnier) Surface pressure gradient organization
18	!! 3.2 ! 2008-11 (B. Lemaire) creation from old diawri
19	!! 3.7 ! 2014-01 (G. Madec) remove eddy induced velocity from no-IOM output
20	!! ! change name of output variables in dia_wri_state
21	!!----------------------------------------------------------------------
22
23	!!----------------------------------------------------------------------
24	!! dia_wri : create the standart output files
25	!! dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
26	!!----------------------------------------------------------------------
27	USE oce ! ocean dynamics and tracers
28	USE dom_oce ! ocean space and time domain
29	USE phycst ! physical constants
30	USE dianam ! build name of file (routine)
31	USE diahth ! thermocline diagnostics
32	USE dynadv , ONLY: ln_dynadv_vec
33	USE icb_oce ! Icebergs
34	USE icbdia ! Iceberg budgets
35	USE ldftra ! lateral physics: eddy diffusivity coef.
36	USE ldfdyn ! lateral physics: eddy viscosity coef.
37	USE sbc_oce ! Surface boundary condition: ocean fields
38	USE sbc_ice ! Surface boundary condition: ice fields
39	USE sbcssr ! restoring term toward SST/SSS climatology
40	USE sbcwave ! wave parameters
41	USE wet_dry ! wetting and drying
42	USE zdf_oce ! ocean vertical physics
43	USE zdfdrg ! ocean vertical physics: top/bottom friction
44	USE zdfmxl ! mixed layer
45	!
46	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
47	USE in_out_manager ! I/O manager
48	USE diatmb ! Top,middle,bottom output
49	USE dia25h ! 25h Mean output
50	USE iom !
51	USE ioipsl !
52
53	#if defined key_si3
54	USE ice
55	USE icewri
56	#endif
57	USE lib_mpp ! MPP library
58	USE timing ! preformance summary
59	USE diu_bulk ! diurnal warm layer
60	USE diu_coolskin ! Cool skin
61
62	IMPLICIT NONE
63	PRIVATE
64
65	PUBLIC dia_wri ! routines called by step.F90
66	PUBLIC dia_wri_state
67	PUBLIC dia_wri_alloc ! Called by nemogcm module
68
69	INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file
70	INTEGER :: nb_T , ndim_bT ! grid_T file
71	INTEGER :: nid_U, nz_U, nh_U, ndim_U, ndim_hU ! grid_U file
72	INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file
73	INTEGER :: nid_W, nz_W, nh_W ! grid_W file
74	INTEGER :: ndex(1) ! ???
75	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
76	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
77	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
78
79	!!----------------------------------------------------------------------
80	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
81	!! $Id: diawri.F90 9598 2018-05-15 22:47:16Z nicolasmartin $
82	!! Software governed by the CeCILL licence (./LICENSE)
83	!!----------------------------------------------------------------------
84	CONTAINS
85
86	#if defined key_iomput
87	!!----------------------------------------------------------------------
88	!! 'key_iomput' use IOM library
89	!!----------------------------------------------------------------------
90	INTEGER FUNCTION dia_wri_alloc()
91	!
92	dia_wri_alloc = 0
93	!
94	END FUNCTION dia_wri_alloc
95
96
97	SUBROUTINE dia_wri( kt, Kmm )
98	!!---------------------------------------------------------------------
99	!! * ROUTINE dia_wri *
100	!!
101	!! ** Purpose : Standard output of opa: dynamics and tracer fields
102	!! NETCDF format is used by default
103	!!
104	!! ** Method : use iom_put
105	!!----------------------------------------------------------------------
106	INTEGER, INTENT( in ) :: kt ! ocean time-step index
107	INTEGER, INTENT( in ) :: Kmm ! ocean time level index
108	!!
109	INTEGER :: ji, jj, jk ! dummy loop indices
110	INTEGER :: ikbot ! local integer
111	REAL(wp):: zztmp , zztmpx ! local scalar
112	REAL(wp):: zztmp2, zztmpy ! - -
113	REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace
114	REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace
115	!!----------------------------------------------------------------------
116	!
117	IF( ln_timing ) CALL timing_start('dia_wri')
118	!
119	! Output the initial state and forcings
120	IF( ninist == 1 ) THEN
121	CALL dia_wri_state( Kmm, 'output.init' )
122	ninist = 0
123	ENDIF
124
125	! Output of initial vertical scale factor
126	CALL iom_put("e3t_0", e3t_0(:,:,:) )
127	CALL iom_put("e3u_0", e3u_0(:,:,:) )
128	CALL iom_put("e3v_0", e3v_0(:,:,:) )
129	!
130	CALL iom_put( "e3t" , e3t(:,:,:,Kmm) )
131	CALL iom_put( "e3u" , e3u(:,:,:,Kmm) )
132	CALL iom_put( "e3v" , e3v(:,:,:,Kmm) )
133	CALL iom_put( "e3w" , e3w(:,:,:,Kmm) )
134	IF( iom_use("e3tdef") ) &
135	CALL iom_put( "e3tdef" , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
136
137	IF( ll_wd ) THEN
138	CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) ! sea surface height (brought back to the reference used for wetting and drying)
139	ELSE
140	CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height
141	ENDIF
142
143	IF( iom_use("wetdep") ) & ! wet depth
144	CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) )
145
146	CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) ) ! 3D temperature
147	CALL iom_put( "sst", ts(:,:,1,jp_tem,Kmm) ) ! surface temperature
148	IF ( iom_use("sbt") ) THEN
149	DO jj = 1, jpj
150	DO ji = 1, jpi
151	ikbot = mbkt(ji,jj)
152	z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
153	END DO
154	END DO
155	CALL iom_put( "sbt", z2d ) ! bottom temperature
156	ENDIF
157
158	CALL iom_put( "soce", ts(:,:,:,jp_sal,Kmm) ) ! 3D salinity
159	CALL iom_put( "sss", ts(:,:,1,jp_sal,Kmm) ) ! surface salinity
160	IF ( iom_use("sbs") ) THEN
161	DO jj = 1, jpj
162	DO ji = 1, jpi
163	ikbot = mbkt(ji,jj)
164	z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
165	END DO
166	END DO
167	CALL iom_put( "sbs", z2d ) ! bottom salinity
168	ENDIF
169
170	IF ( iom_use("taubot") ) THEN ! bottom stress
171	zztmp = rau0 * 0.25
172	z2d(:,:) = 0._wp
173	DO jj = 2, jpjm1
174	DO ji = fs_2, fs_jpim1 ! vector opt.
175	zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 &
176	& + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 &
177	& + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vv(ji,jj ,mbkv(ji,jj ),Kmm) )**2 &
178	& + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm) )**2
179	z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1)
180	!
181	END DO
182	END DO
183	CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
184	CALL iom_put( "taubot", z2d )
185	ENDIF
186
187	CALL iom_put( "uoce", uu(:,:,:,Kmm) ) ! 3D i-current
188	CALL iom_put( "ssu", uu(:,:,1,Kmm) ) ! surface i-current
189	IF ( iom_use("sbu") ) THEN
190	DO jj = 1, jpj
191	DO ji = 1, jpi
192	ikbot = mbku(ji,jj)
193	z2d(ji,jj) = uu(ji,jj,ikbot,Kmm)
194	END DO
195	END DO
196	CALL iom_put( "sbu", z2d ) ! bottom i-current
197	ENDIF
198
199	CALL iom_put( "voce", vv(:,:,:,Kmm) ) ! 3D j-current
200	CALL iom_put( "ssv", vv(:,:,1,Kmm) ) ! surface j-current
201	IF ( iom_use("sbv") ) THEN
202	DO jj = 1, jpj
203	DO ji = 1, jpi
204	ikbot = mbkv(ji,jj)
205	z2d(ji,jj) = vv(ji,jj,ikbot,Kmm)
206	END DO
207	END DO
208	CALL iom_put( "sbv", z2d ) ! bottom j-current
209	ENDIF
210
211	IF( ln_zad_Aimp ) ww = ww + wi ! Recombine explicit and implicit parts of vertical velocity for diagnostic output
212	!
213	CALL iom_put( "woce", ww ) ! vertical velocity
214	IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value
215	! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
216	z2d(:,:) = rau0 * e1e2t(:,:)
217	DO jk = 1, jpk
218	z3d(:,:,jk) = ww(:,:,jk) * z2d(:,:)
219	END DO
220	CALL iom_put( "w_masstr" , z3d )
221	IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
222	ENDIF
223	!
224	IF( ln_zad_Aimp ) ww = ww - wi ! Remove implicit part of vertical velocity that was added for diagnostic output
225
226	CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.
227	CALL iom_put( "avs" , avs ) ! S vert. eddy diff. coef.
228	CALL iom_put( "avm" , avm ) ! T vert. eddy visc. coef.
229
230	IF( iom_use('logavt') ) CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt(:,:,:) ) ) )
231	IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) )
232
233	IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
234	DO jj = 2, jpjm1 ! sst gradient
235	DO ji = fs_2, fs_jpim1 ! vector opt.
236	zztmp = ts(ji,jj,1,jp_tem,Kmm)
237	zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj)
238	zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1)
239	z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) &
240	& * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
241	END DO
242	END DO
243	CALL lbc_lnk( 'diawri', z2d, 'T', 1. )
244	CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient
245	z2d(:,:) = SQRT( z2d(:,:) )
246	CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient
247	ENDIF
248
249	! heat and salt contents
250	IF( iom_use("heatc") ) THEN
251	z2d(:,:) = 0._wp
252	DO jk = 1, jpkm1
253	DO jj = 1, jpj
254	DO ji = 1, jpi
255	z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk)
256	END DO
257	END DO
258	END DO
259	CALL iom_put( "heatc", rau0_rcp * z2d ) ! vertically integrated heat content (J/m2)
260	ENDIF
261
262	IF( iom_use("saltc") ) THEN
263	z2d(:,:) = 0._wp
264	DO jk = 1, jpkm1
265	DO jj = 1, jpj
266	DO ji = 1, jpi
267	z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
268	END DO
269	END DO
270	END DO
271	CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2)
272	ENDIF
273	!
274	IF ( iom_use("eken") ) THEN
275	z3d(:,:,jpk) = 0._wp
276	DO jk = 1, jpkm1
277	DO jj = 2, jpjm1
278	DO ji = fs_2, fs_jpim1 ! vector opt.
279	zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
280	z3d(ji,jj,jk) = zztmp * ( uu(ji-1,jj,jk,Kmm)*2 e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) &
281	& + uu(ji ,jj,jk,Kmm)*2 e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) &
282	& + vv(ji,jj-1,jk,Kmm)*2 e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) &
283	& + vv(ji,jj ,jk,Kmm)*2 e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) )
284	END DO
285	END DO
286	END DO
287	CALL lbc_lnk( 'diawri', z3d, 'T', 1. )
288	CALL iom_put( "eken", z3d ) ! kinetic energy
289	ENDIF
290	!
291	CALL iom_put( "hdiv", hdiv ) ! Horizontal divergence
292	!
293	IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
294	z3d(:,:,jpk) = 0.e0
295	z2d(:,:) = 0.e0
296	DO jk = 1, jpkm1
297	z3d(:,:,jk) = rau0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk)
298	z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
299	END DO
300	CALL iom_put( "u_masstr" , z3d ) ! mass transport in i-direction
301	CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum
302	ENDIF
303
304	IF( iom_use("u_heattr") ) THEN
305	z2d(:,:) = 0._wp
306	DO jk = 1, jpkm1
307	DO jj = 2, jpjm1
308	DO ji = fs_2, fs_jpim1 ! vector opt.
309	z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
310	END DO
311	END DO
312	END DO
313	CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
314	CALL iom_put( "u_heattr", 0.5rcp z2d ) ! heat transport in i-direction
315	ENDIF
316
317	IF( iom_use("u_salttr") ) THEN
318	z2d(:,:) = 0.e0
319	DO jk = 1, jpkm1
320	DO jj = 2, jpjm1
321	DO ji = fs_2, fs_jpim1 ! vector opt.
322	z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
323	END DO
324	END DO
325	END DO
326	CALL lbc_lnk( 'diawri', z2d, 'U', -1. )
327	CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction
328	ENDIF
329
330
331	IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN
332	z3d(:,:,jpk) = 0.e0
333	DO jk = 1, jpkm1
334	z3d(:,:,jk) = rau0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk)
335	END DO
336	CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction
337	ENDIF
338
339	IF( iom_use("v_heattr") ) THEN
340	z2d(:,:) = 0.e0
341	DO jk = 1, jpkm1
342	DO jj = 2, jpjm1
343	DO ji = fs_2, fs_jpim1 ! vector opt.
344	z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
345	END DO
346	END DO
347	END DO
348	CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
349	CALL iom_put( "v_heattr", 0.5rcp z2d ) ! heat transport in j-direction
350	ENDIF
351
352	IF( iom_use("v_salttr") ) THEN
353	z2d(:,:) = 0._wp
354	DO jk = 1, jpkm1
355	DO jj = 2, jpjm1
356	DO ji = fs_2, fs_jpim1 ! vector opt.
357	z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
358	END DO
359	END DO
360	END DO
361	CALL lbc_lnk( 'diawri', z2d, 'V', -1. )
362	CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction
363	ENDIF
364
365	IF( iom_use("tosmint") ) THEN
366	z2d(:,:) = 0._wp
367	DO jk = 1, jpkm1
368	DO jj = 2, jpjm1
369	DO ji = fs_2, fs_jpim1 ! vector opt.
370	z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)
371	END DO
372	END DO
373	END DO
374	CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
375	CALL iom_put( "tosmint", rau0 * z2d ) ! Vertical integral of temperature
376	ENDIF
377	IF( iom_use("somint") ) THEN
378	z2d(:,:)=0._wp
379	DO jk = 1, jpkm1
380	DO jj = 2, jpjm1
381	DO ji = fs_2, fs_jpim1 ! vector opt.
382	z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
383	END DO
384	END DO
385	END DO
386	CALL lbc_lnk( 'diawri', z2d, 'T', -1. )
387	CALL iom_put( "somint", rau0 * z2d ) ! Vertical integral of salinity
388	ENDIF
389
390	CALL iom_put( "bn2", rn2 ) ! Brunt-Vaisala buoyancy frequency (N^2)
391	!
392
393	IF (ln_diatmb) CALL dia_tmb( Kmm ) ! tmb values
394
395	IF (ln_dia25h) CALL dia_25h( kt, Kmm ) ! 25h averaging
396
397	IF( ln_timing ) CALL timing_stop('dia_wri')
398	!
399	END SUBROUTINE dia_wri
400
401	#else
402	!!----------------------------------------------------------------------
403	!! Default option use IOIPSL library
404	!!----------------------------------------------------------------------
405
406	INTEGER FUNCTION dia_wri_alloc()
407	!
408	dia_wri_alloc = 0
409	!
410	END FUNCTION dia_wri_alloc
411
412
413	SUBROUTINE dia_wri( kt, Kmm )
414
415	INTEGER, INTENT( in ) :: kt ! ocean time-step index
416	INTEGER, INTENT( in ) :: Kmm ! ocean time level index
417	IF( ninist == 1 ) THEN !== Output the initial state and forcings ==!
418	CALL dia_wri_state( Kmm, 'output.init' )
419	ninist = 0
420	ENDIF
421	!
422	! 0. Initialisation
423	! -----------------
424
425	END SUBROUTINE dia_wri
426
427	#endif
428
429	SUBROUTINE dia_wri_state( Kmm, cdfile_name )
430	!!---------------------------------------------------------------------
431	!! * ROUTINE dia_wri_state *
432	!!
433	!! ** Purpose : create a NetCDF file named cdfile_name which contains
434	!! the instantaneous ocean state and forcing fields.
435	!! Used to find errors in the initial state or save the last
436	!! ocean state in case of abnormal end of a simulation
437	!!
438	!! ** Method : NetCDF files using ioipsl
439	!! File 'output.init.nc' is created if ninist = 1 (namelist)
440	!! File 'output.abort.nc' is created in case of abnormal job end
441	!!----------------------------------------------------------------------
442	INTEGER , INTENT( in ) :: Kmm ! time level index
443	CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created
444	!!
445	INTEGER :: inum
446	!!----------------------------------------------------------------------
447	!
448	IF(lwp) WRITE(numout,*)
449	IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
450	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created '
451	IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc'
452
453	#if defined key_si3
454	CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
455	#else
456	CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
457	#endif
458
459	CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) ) ! now temperature
460	CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) ) ! now salinity
461	CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm) ) ! sea surface height
462	CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm) ) ! now i-velocity
463	CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm) ) ! now j-velocity
464	IF( ln_zad_Aimp ) THEN
465	CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi ) ! now k-velocity
466	ELSE
467	CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity
468	ENDIF
469	IF( ALLOCATED(ahtu) ) THEN
470	CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point
471	CALL iom_rstput( 0, 0, inum, 'ahtv', ahtv ) ! aht at v-point
472	ENDIF
473	IF( ALLOCATED(ahmt) ) THEN
474	CALL iom_rstput( 0, 0, inum, 'ahmt', ahmt ) ! ahmt at u-point
475	CALL iom_rstput( 0, 0, inum, 'ahmf', ahmf ) ! ahmf at v-point
476	ENDIF
477	CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget
478	CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux
479	CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr ) ! solar heat flux
480	CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i ) ! ice fraction
481	CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress
482	CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress
483	IF( .NOT.ln_linssh ) THEN
484	CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm) ) ! T-cell depth
485	CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm) ) ! T-cell thickness
486	END IF
487	IF( ln_wave .AND. ln_sdw ) THEN
488	CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd ) ! now StokesDrift i-velocity
489	CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd ) ! now StokesDrift j-velocity
490	CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd ) ! now StokesDrift k-velocity
491	ENDIF
492
493	#if defined key_si3
494	IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid
495	CALL ice_wri_state( inum )
496	ENDIF
497	#endif
498	!
499	CALL iom_close( inum )
500	!
501	END SUBROUTINE dia_wri_state
502
503	!!======================================================================
504	END MODULE diawri

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/trunk/tests/BENCH/MY_SRC/diawri.F90 @ 12377

Download in other formats: