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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

diawri.F90 in branches/2011/dev_r2739_LOCEAN8_ZTC/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

Context Navigation

source: branches/2011/dev_r2739_LOCEAN8_ZTC/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 @ 2970

Last change on this file since 2970 was 2970, checked in by mlelod, 13 years ago
thickness weighted outputs and additional outputs, see ticket/863?
Property svn:keywords set to `Id`
File size: 42.7 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	!!----------------------------------------------------------------------
20
21	!!----------------------------------------------------------------------
22	!! dia_wri : create the standart output files
23	!! dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
24	!!----------------------------------------------------------------------
25	USE oce ! ocean dynamics and tracers
26	USE dom_oce ! ocean space and time domain
27	USE zdf_oce ! ocean vertical physics
28	USE ldftra_oce ! ocean active tracers: lateral physics
29	USE ldfdyn_oce ! ocean dynamics: lateral physics
30	USE sol_oce ! solver variables
31	USE sbc_oce ! Surface boundary condition: ocean fields
32	USE sbc_ice ! Surface boundary condition: ice fields
33	USE sbcssr ! restoring term toward SST/SSS climatology
34	USE phycst ! physical constants
35	USE dynadv ! dynamics: vector invariant versus flux form
36	USE zdfmxl ! mixed layer
37	USE dianam ! build name of file (routine)
38	USE zdfddm ! vertical physics: double diffusion
39	USE diahth ! thermocline diagnostics
40	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
41	USE in_out_manager ! I/O manager
42	USE diadimg ! dimg direct access file format output
43	USE diaar5, ONLY : lk_diaar5
44	USE iom
45	USE ioipsl
46	#if defined key_lim2
47	USE limwri_2
48	#endif
49	USE dtatem
50	USE dtasal
51	USE lib_mpp ! MPP library
52
53	IMPLICIT NONE
54	PRIVATE
55
56	PUBLIC dia_wri ! routines called by step.F90
57	PUBLIC dia_wri_state
58	PUBLIC dia_wri_alloc ! Called by nemogcm module
59
60	INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file
61	INTEGER :: nid_U, nz_U, nh_U, ndim_U, ndim_hU ! grid_U file
62	INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file
63	INTEGER :: nid_W, nz_W, nh_W ! grid_W file
64	INTEGER :: ndex(1) ! ???
65	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
66	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
67
68	!! * Substitutions
69	# include "zdfddm_substitute.h90"
70	# include "domzgr_substitute.h90"
71	# include "vectopt_loop_substitute.h90"
72	!!----------------------------------------------------------------------
73	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
74	!! $Id $
75	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
76	!!----------------------------------------------------------------------
77	CONTAINS
78
79	INTEGER FUNCTION dia_wri_alloc()
80	!!----------------------------------------------------------------------
81	INTEGER, DIMENSION(2) :: ierr
82	!!----------------------------------------------------------------------
83	!
84	ierr = 0
85	!
86	ALLOCATE( ndex_hT(jpijpj) , ndex_T(jpijpj*jpk) , &
87	& ndex_hU(jpijpj) , ndex_U(jpijpj*jpk) , &
88	& ndex_hV(jpijpj) , ndex_V(jpijpj*jpk) , STAT=ierr(1) )
89	!
90	dia_wri_alloc = MAXVAL(ierr)
91	IF( lk_mpp ) CALL mpp_sum( dia_wri_alloc )
92	!
93	END FUNCTION dia_wri_alloc
94
95	#if defined key_dimgout
96	!!----------------------------------------------------------------------
97	!! 'key_dimgout' DIMG output file
98	!!----------------------------------------------------------------------
99	# include "diawri_dimg.h90"
100
101	#else
102	!!----------------------------------------------------------------------
103	!! Default option NetCDF output file
104	!!----------------------------------------------------------------------
105	# if defined key_iomput
106	!!----------------------------------------------------------------------
107	!! 'key_iomput' use IOM library
108	!!----------------------------------------------------------------------
109
110	SUBROUTINE dia_wri( kt )
111	!!---------------------------------------------------------------------
112	!! * ROUTINE dia_wri *
113	!!
114	!! ** Purpose : Standard output of opa: dynamics and tracer fields
115	!! NETCDF format is used by default
116	!!
117	!! ** Method : use iom_put
118	!!----------------------------------------------------------------------
119	USE oce, ONLY : z3d => ta ! use ta as 3D workspace
120	USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
121	USE wrk_nemo, ONLY: z2d => wrk_2d_1
122	!!
123	INTEGER, INTENT( in ) :: kt ! ocean time-step index
124	!!
125	INTEGER :: ji, jj, jk ! dummy loop indices
126	REAL(wp) :: zztmp, zztmpx, zztmpy !
127	!!----------------------------------------------------------------------
128	!
129	IF( wrk_in_use(2, 1) )THEN
130	CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.')
131	RETURN
132	END IF
133	!
134	! Output the initial state and forcings
135	IF( ninist == 1 ) THEN
136	CALL dia_wri_state( 'output.init', kt )
137	ninist = 0
138	ENDIF
139
140	IF( lk_vvl ) THEN
141	z3d(:,:,:) = tn(:,:,:) * fse3t_n(:,:,:)
142	CALL iom_put( "toce" , z3d ) ! heat content
143	CALL iom_put( "sst" , z3d(:,:,1) ) ! sea surface heat content
144	CALL iom_put( "sst2" , z3d(:,:,1) * tn(:,:,1) ) ! sea surface content of squared temperature
145	z3d(:,:,:) = sn(:,:,:) * fse3t_n(:,:,:)
146	CALL iom_put( "soce" , z3d ) ! salinity content
147	CALL iom_put( "sss" , z3d(:,:,1) ) ! sea surface salinity content
148	CALL iom_put( "sss2" , z3d(:,:,1) * sn(:,:,1) ) ! sea surface content of squared salinity
149	ELSE
150	CALL iom_put( "toce" , tn ) ! temperature
151	CALL iom_put( "sst" , tn(:,:,1) ) ! sea surface temperature
152	CALL iom_put( "sst2" , tn(:,:,1) * tn(:,:,1) ) ! square of sea surface temperature
153	CALL iom_put( "soce" , sn ) ! salinity
154	CALL iom_put( "sss" , sn(:,:,1) ) ! sea surface salinity
155	CALL iom_put( "sss2" , sn(:,:,1) * sn(:,:,1) ) ! square of sea surface salinity
156	END IF
157	IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN
158	CALL iom_put( "uoce" , un(:,:,:) * fse3u_n(:,:,:) ) ! i-transport
159	CALL iom_put( "voce" , vn(:,:,:) * fse3v_n(:,:,:) ) ! j-transport
160	ELSE
161	CALL iom_put( "uoce" , un ) ! i-current
162	CALL iom_put( "voce" , vn ) ! j-current
163	END IF
164	CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.
165	CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef.
166	IF( lk_zdfddm ) THEN
167	CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef.
168	ENDIF
169
170	DO jj = 2, jpjm1 ! sst gradient
171	DO ji = fs_2, fs_jpim1 ! vector opt.
172	zztmp = tn(ji,jj,1)
173	zztmpx = ( tn(ji+1,jj ,1) - zztmp ) / e1u(ji,jj) + ( zztmp - tn(ji-1,jj ,1) ) / e1u(ji-1,jj )
174	zztmpy = ( tn(ji ,jj+1,1) - zztmp ) / e2v(ji,jj) + ( zztmp - tn(ji ,jj-1,1) ) / e2v(ji ,jj-1)
175	z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) &
176	& * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
177	END DO
178	END DO
179	CALL lbc_lnk( z2d, 'T', 1. )
180	CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient
181	!CDIR NOVERRCHK
182	z2d(:,:) = SQRT( z2d(:,:) )
183	CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient
184
185	IF( lk_diaar5 ) THEN
186	z3d(:,:,jpk) = 0.e0
187	DO jk = 1, jpkm1
188	z3d(:,:,jk) = rau0 * un(:,:,jk) * e1u(:,:) * fse3u_n(:,:,jk)
189	END DO
190	CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction
191	zztmp = 0.5 * rcp
192	z2d(:,:) = 0.e0
193	DO jk = 1, jpkm1
194	DO jj = 2, jpjm1
195	DO ji = fs_2, fs_jpim1 ! vector opt.
196	z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) )
197	END DO
198	END DO
199	END DO
200	CALL lbc_lnk( z2d, 'U', -1. )
201	CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction
202	DO jk = 1, jpkm1
203	z3d(:,:,jk) = rau0 * vn(:,:,jk) * e2v(:,:) * fse3v_n(:,:,jk)
204	END DO
205	CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction
206	z2d(:,:) = 0.e0
207	DO jk = 1, jpkm1
208	DO jj = 2, jpjm1
209	DO ji = fs_2, fs_jpim1 ! vector opt.
210	z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) )
211	END DO
212	END DO
213	END DO
214	CALL lbc_lnk( z2d, 'V', -1. )
215	CALL iom_put( "v_heattr", z2d ) ! heat transport in j-direction
216	ENDIF
217	!
218	IF( wrk_not_released(2, 1) ) THEN
219	CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.')
220	RETURN
221	END IF
222	!
223	END SUBROUTINE dia_wri
224
225	#else
226	!!----------------------------------------------------------------------
227	!! Default option use IOIPSL library
228	!!----------------------------------------------------------------------
229
230	SUBROUTINE dia_wri( kt )
231	!!---------------------------------------------------------------------
232	!! * ROUTINE dia_wri *
233	!!
234	!! ** Purpose : Standard output of opa: dynamics and tracer fields
235	!! NETCDF format is used by default
236	!!
237	!! ** Method : At the beginning of the first time step (nit000),
238	!! define all the NETCDF files and fields
239	!! At each time step call histdef to compute the mean if ncessary
240	!! Each nwrite time step, output the instantaneous or mean fields
241	!!----------------------------------------------------------------------
242	USE oce, ONLY : z3d => ta ! use ta as 3D workspace
243	USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
244	USE wrk_nemo, ONLY: zw2d => wrk_2d_1
245	!!
246	INTEGER, INTENT( in ) :: kt ! ocean time-step index
247	!!
248	LOGICAL :: ll_print = .FALSE. ! =T print and flush numout
249	CHARACTER (len=40) :: clhstnam, clop, clmx ! local names
250	INTEGER :: inum = 11 ! temporary logical unit
251	INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers
252	REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars
253	!!----------------------------------------------------------------------
254	!
255	IF( wrk_in_use(2, 1))THEN
256	CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.')
257	RETURN
258	END IF
259	!
260	! Output the initial state and forcings
261	IF( ninist == 1 ) THEN
262	CALL dia_wri_state( 'output.init', kt )
263	ninist = 0
264	ENDIF
265	!
266	! 0. Initialisation
267	! -----------------
268
269	! local variable for debugging
270	ll_print = .FALSE.
271	ll_print = ll_print .AND. lwp
272
273	! Define frequency of output and means
274	zdt = rdt
275	IF( nacc == 1 ) zdt = rdtmin
276	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
277	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
278	ENDIF
279	#if defined key_diainstant
280	zsto = nwrite * zdt
281	clop = "inst("//TRIM(clop)//")"
282	#else
283	zsto=zdt
284	clop = "ave("//TRIM(clop)//")"
285	#endif
286	zout = nwrite * zdt
287	zmax = ( nitend - nit000 + 1 ) * zdt
288
289	! Define indices of the horizontal output zoom and vertical limit storage
290	iimi = 1 ; iima = jpi
291	ijmi = 1 ; ijma = jpj
292	ipk = jpk
293
294	! define time axis
295	it = kt
296	itmod = kt - nit000 + 1
297
298
299	! 1. Define NETCDF files and fields at beginning of first time step
300	! -----------------------------------------------------------------
301
302	IF( kt == nit000 ) THEN
303
304	! Define the NETCDF files (one per grid)
305
306	! Compute julian date from starting date of the run
307	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
308	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
309	IF(lwp)WRITE(numout,*)
310	IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear, &
311	& ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
312	IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, &
313	' limit storage in depth = ', ipk
314
315	! WRITE root name in date.file for use by postpro
316	IF(lwp) THEN
317	CALL dia_nam( clhstnam, nwrite,' ' )
318	CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
319	WRITE(inum,*) clhstnam
320	CLOSE(inum)
321	ENDIF
322
323	! Define the T grid FILE ( nid_T )
324
325	CALL dia_nam( clhstnam, nwrite, 'grid_T' )
326	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
327	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit
328	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
329	& nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
330	CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept
331	& "m", ipk, gdept_0, nz_T, "down" )
332	! ! Index of ocean points
333	CALL wheneq( jpijpjipk, tmask, 1, 1., ndex_T , ndim_T ) ! volume
334	CALL wheneq( jpi*jpj , tmask, 1, 1., ndex_hT, ndim_hT ) ! surface
335
336	! Define the U grid FILE ( nid_U )
337
338	CALL dia_nam( clhstnam, nwrite, 'grid_U' )
339	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
340	CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu
341	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
342	& nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
343	CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept
344	& "m", ipk, gdept_0, nz_U, "down" )
345	! ! Index of ocean points
346	CALL wheneq( jpijpjipk, umask, 1, 1., ndex_U , ndim_U ) ! volume
347	CALL wheneq( jpi*jpj , umask, 1, 1., ndex_hU, ndim_hU ) ! surface
348
349	! Define the V grid FILE ( nid_V )
350
351	CALL dia_nam( clhstnam, nwrite, 'grid_V' ) ! filename
352	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
353	CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv
354	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
355	& nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
356	CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept
357	& "m", ipk, gdept_0, nz_V, "down" )
358	! ! Index of ocean points
359	CALL wheneq( jpijpjipk, vmask, 1, 1., ndex_V , ndim_V ) ! volume
360	CALL wheneq( jpi*jpj , vmask, 1, 1., ndex_hV, ndim_hV ) ! surface
361
362	! Define the W grid FILE ( nid_W )
363
364	CALL dia_nam( clhstnam, nwrite, 'grid_W' ) ! filename
365	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
366	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit
367	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
368	& nit000-1, zjulian, zdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
369	CALL histvert( nid_W, "depthw", "Vertical W levels", & ! Vertical grid: gdepw
370	& "m", ipk, gdepw_0, nz_W, "down" )
371
372
373	! Declare all the output fields as NETCDF variables
374
375	! !!! nid_T : 3D
376	CALL histdef( nid_T, "votemper", "Temperature" , "C" , & ! tn
377	& jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
378	CALL histdef( nid_T, "vosaline", "Salinity" , "PSU" , & ! sn
379	& jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
380	#if defined key_vvl
381	CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" , & ! e3t_n
382	& jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
383	CALL histdef( nid_T, "vovvldep", "T point depth" , "m" , & ! e3t_n
384	& jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
385	CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" , & ! e3t_n
386	& jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
387	#endif
388	! !!! nid_T : 2D
389	CALL histdef( nid_T, "sosstsst", "Sea Surface temperature" , "C" , & ! sst
390	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
391	CALL histdef( nid_T, "sosaline", "Sea Surface Salinity" , "PSU" , & ! sss
392	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
393	CALL histdef( nid_T, "sossheig", "Sea Surface Height" , "m" , & ! ssh
394	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
395	!!$#if defined key_lim3 \|\| defined key_lim2
396	!!$ ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to
397	!!$ ! internal damping to Levitus that can be diagnosed from others
398	!!$ ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup
399	!!$ CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater" , "kg/m2/s", & ! fsalt
400	!!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
401	!!$ CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater" , "kg/m2/s", & ! fmass
402	!!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
403	!!$#endif
404	CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux" , "Kg/m2/s", & ! (emp-rnf)
405	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
406	!!$ CALL histdef( nid_T, "sorunoff", "Runoffs" , "Kg/m2/s", & ! runoffs
407	!!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
408	CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux" , "kg/m2/s", & ! (emps-rnf)
409	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
410	CALL histdef( nid_T, "sosalflx", "Surface Salt Flux" , "Kg/m2/s", & ! (emps-rnf) * sn
411	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
412	CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux" , "W/m2" , & ! qns + qsr
413	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
414	CALL histdef( nid_T, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! qsr
415	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
416	CALL histdef( nid_T, "somixhgt", "Turbocline Depth" , "m" , & ! hmld
417	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
418	CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01" , "m" , & ! hmlp
419	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
420	CALL histdef( nid_T, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i
421	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
422	CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm
423	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
424	#if ! defined key_coupled
425	CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp
426	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
427	CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp
428	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
429	CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping" , "Kg/m2/s", & ! erp * sn
430	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
431	#endif
432
433
434
435	#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )
436	CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp
437	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
438	CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp
439	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
440	CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping" , "Kg/m2/s", & ! erp * sn
441	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
442	#endif
443	clmx ="l_max(only(x))" ! max index on a period
444	CALL histdef( nid_T, "sobowlin", "Bowl Index" , "W-point", & ! bowl INDEX
445	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clmx, zsto, zout )
446	#if defined key_diahth
447	CALL histdef( nid_T, "sothedep", "Thermocline Depth" , "m" , & ! hth
448	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
449	CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm" , "m" , & ! hd20
450	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
451	CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm" , "m" , & ! hd28
452	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
453	CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "W" , & ! htc3
454	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
455	#endif
456
457	#if defined key_coupled
458	# if defined key_lim3
459	Must be adapted to LIM3
460	# else
461	CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice
462	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
463	CALL histdef( nid_T,"soicealb" , "Ice Albedo" , "[0,1]" , & ! alb_ice
464	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
465	# endif
466	#endif
467
468	CALL histend( nid_T, snc4chunks=snc4set )
469
470	! !!! nid_U : 3D
471	CALL histdef( nid_U, "vozocrtx", "Zonal Current" , "m/s" , & ! un
472	& jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
473	#if defined key_diaeiv
474	CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv
475	& jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
476	#endif
477	! !!! nid_U : 2D
478	CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau
479	& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
480
481	CALL histend( nid_U, snc4chunks=snc4set )
482
483	! !!! nid_V : 3D
484	CALL histdef( nid_V, "vomecrty", "Meridional Current" , "m/s" , & ! vn
485	& jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
486	#if defined key_diaeiv
487	CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv
488	& jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
489	#endif
490	! !!! nid_V : 2D
491	CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau
492	& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
493
494	CALL histend( nid_V, snc4chunks=snc4set )
495
496	! !!! nid_W : 3D
497	CALL histdef( nid_W, "vovecrtz", "Vertical Velocity" , "m/s" , & ! wn
498	& jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
499	#if defined key_diaeiv
500	CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv
501	& jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
502	#endif
503	CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt
504	& jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
505	CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity" , "m2/s" , & ! avmu
506	& jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
507
508	IF( lk_zdfddm ) THEN
509	CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity" , "m2/s" , & ! avs
510	& jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
511	ENDIF
512	! !!! nid_W : 2D
513	#if defined key_traldf_c2d
514	CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity" , "m2/s" , & ! ahtw
515	& jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
516	# if defined key_traldf_eiv
517	CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s", & ! aeiw
518	& jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
519	# endif
520	#endif
521
522	CALL histend( nid_W, snc4chunks=snc4set )
523
524	IF(lwp) WRITE(numout,*)
525	IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
526	IF(ll_print) CALL FLUSH(numout )
527
528	ENDIF
529
530	! 2. Start writing data
531	! ---------------------
532
533	! ndex(1) est utilise ssi l'avant dernier argument est diffferent de
534	! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
535	! donne le nombre d'elements, et ndex la liste des indices a sortir
536
537	IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN
538	WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
539	WRITE(numout,*) '~~~~~~ '
540	ENDIF
541
542	! Write fields on T grid
543	IF( lk_vvl ) THEN
544	CALL histwrite( nid_T, "votemper", it, tn(:,:,:) * fse3t_n(:,:,:) , ndim_T , ndex_T ) ! heat content
545	CALL histwrite( nid_T, "vosaline", it, sn(:,:,:) * fse3t_n(:,:,:) , ndim_T , ndex_T ) ! salt content
546	CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1) * fse3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content
547	CALL histwrite( nid_T, "sosaline", it, sn(:,:,1) * fse3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content
548	ELSE
549	CALL histwrite( nid_T, "votemper", it, tn , ndim_T , ndex_T ) ! temperature
550	CALL histwrite( nid_T, "vosaline", it, sn , ndim_T , ndex_T ) ! salinity
551	CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1) , ndim_hT, ndex_hT ) ! sea surface temperature
552	CALL histwrite( nid_T, "sosaline", it, sn(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity
553
554	ENDIF
555	IF( lk_vvl ) THEN
556	z3d(:,:,:) = ( ( fse3t_n(:,:,:) - fse3t_0(:,:,:) ) / fse3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
557	CALL histwrite( nid_T, "vovvle3t", it, fse3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness
558	CALL histwrite( nid_T, "vovvldep", it, fsdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth
559	CALL histwrite( nid_T, "vovvldef", it, z3d , ndim_T , ndex_T ) ! level thickness deformation
560	ENDIF
561	CALL histwrite( nid_T, "sossheig", it, sshn , ndim_hT, ndex_hT ) ! sea surface height
562	!!$#if defined key_lim3 \|\| defined key_lim2
563	!!$ CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:) , ndim_hT, ndex_hT ) ! ice=>ocean water flux
564	!!$ CALL histwrite( nid_T, "sowaflep", it, fmass(:,:) , ndim_hT, ndex_hT ) ! atmos=>ocean water flux
565	!!$#endif
566	CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf ) , ndim_hT, ndex_hT ) ! upward water flux
567	!!$ CALL histwrite( nid_T, "sorunoff", it, runoff , ndim_hT, ndex_hT ) ! runoff
568	CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf ) , ndim_hT, ndex_hT ) ! c/d water flux
569	zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * sn(:,:,1) * tmask(:,:,1)
570	CALL histwrite( nid_T, "sosalflx", it, zw2d , ndim_hT, ndex_hT ) ! c/d salt flux
571	CALL histwrite( nid_T, "sohefldo", it, qns + qsr , ndim_hT, ndex_hT ) ! total heat flux
572	CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux
573	CALL histwrite( nid_T, "somixhgt", it, hmld , ndim_hT, ndex_hT ) ! turbocline depth
574	CALL histwrite( nid_T, "somxl010", it, hmlp , ndim_hT, ndex_hT ) ! mixed layer depth
575	CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction
576	CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed
577	#if ! defined key_coupled
578	CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping
579	CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping
580	IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)
581	CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping
582	#endif
583	#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )
584	CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping
585	CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping
586	IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)
587	CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping
588	#endif
589	zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
590	CALL histwrite( nid_T, "sobowlin", it, zw2d , ndim_hT, ndex_hT ) ! ???
591
592	#if defined key_diahth
593	CALL histwrite( nid_T, "sothedep", it, hth , ndim_hT, ndex_hT ) ! depth of the thermocline
594	CALL histwrite( nid_T, "so20chgt", it, hd20 , ndim_hT, ndex_hT ) ! depth of the 20 isotherm
595	CALL histwrite( nid_T, "so28chgt", it, hd28 , ndim_hT, ndex_hT ) ! depth of the 28 isotherm
596	CALL histwrite( nid_T, "sohtc300", it, htc3 , ndim_hT, ndex_hT ) ! first 300m heaat content
597	#endif
598
599	#if defined key_coupled
600	# if defined key_lim3
601	Must be adapted for LIM3
602	CALL histwrite( nid_T, "soicetem", it, tn_ice , ndim_hT, ndex_hT ) ! surf. ice temperature
603	CALL histwrite( nid_T, "soicealb", it, alb_ice , ndim_hT, ndex_hT ) ! ice albedo
604	# else
605	CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature
606	CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo
607	# endif
608	#endif
609	! Write fields on U grid
610	IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN
611	CALL histwrite( nid_U, "vozocrtx", it, un(:,:,:) * fse3u_n(:,:,:), ndim_U , ndex_U ) ! i-transport
612	ELSE
613	CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current
614	ENDIF
615	#if defined key_diaeiv
616	CALL histwrite( nid_U, "vozoeivu", it, u_eiv , ndim_U , ndex_U ) ! i-eiv current
617	#endif
618	CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress
619
620	! Write fields on V grid
621	IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN
622	CALL histwrite( nid_V, "vomecrty", it, vn(:,:,:) * fse3v_n(:,:,:), ndim_V , ndex_V ) ! j-transport
623	ELSE
624	CALL histwrite( nid_V, "vomecrty", it, vn , ndim_V , ndex_V ) ! j-current
625	END IF
626	#if defined key_diaeiv
627	CALL histwrite( nid_V, "vomeeivv", it, v_eiv , ndim_V , ndex_V ) ! j-eiv current
628	#endif
629	CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress
630
631	! Write fields on W grid
632	CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current
633	# if defined key_diaeiv
634	CALL histwrite( nid_W, "voveeivw", it, w_eiv , ndim_T, ndex_T ) ! vert. eiv current
635	# endif
636	CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef.
637	CALL histwrite( nid_W, "votkeavm", it, avmu , ndim_T, ndex_T ) ! T vert. eddy visc. coef.
638	IF( lk_zdfddm ) THEN
639	CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T ) ! S vert. eddy diff. coef.
640	ENDIF
641	#if defined key_traldf_c2d
642	CALL histwrite( nid_W, "soleahtw", it, ahtw , ndim_hT, ndex_hT ) ! lateral eddy diff. coef.
643	# if defined key_traldf_eiv
644	CALL histwrite( nid_W, "soleaeiw", it, aeiw , ndim_hT, ndex_hT ) ! EIV coefficient at w-point
645	# endif
646	#endif
647
648	! 3. Close all files
649	! ---------------------------------------
650	IF( kt == nitend ) THEN
651	CALL histclo( nid_T )
652	CALL histclo( nid_U )
653	CALL histclo( nid_V )
654	CALL histclo( nid_W )
655	ENDIF
656	!
657	IF( wrk_not_released(2, 1))THEN
658	CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.')
659	RETURN
660	END IF
661	!
662	END SUBROUTINE dia_wri
663	# endif
664
665	#endif
666
667	SUBROUTINE dia_wri_state( cdfile_name, kt )
668	!!---------------------------------------------------------------------
669	!! * ROUTINE dia_wri_state *
670	!!
671	!! ** Purpose : create a NetCDF file named cdfile_name which contains
672	!! the instantaneous ocean state and forcing fields.
673	!! Used to find errors in the initial state or save the last
674	!! ocean state in case of abnormal end of a simulation
675	!!
676	!! ** Method : NetCDF files using ioipsl
677	!! File 'output.init.nc' is created if ninist = 1 (namelist)
678	!! File 'output.abort.nc' is created in case of abnormal job end
679	!!----------------------------------------------------------------------
680	CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created
681	INTEGER , INTENT( in ) :: kt ! ocean time-step index
682	!!
683	CHARACTER (len=32) :: clname
684	CHARACTER (len=40) :: clop
685	INTEGER :: id_i , nz_i, nh_i
686	INTEGER, DIMENSION(1) :: idex ! local workspace
687	REAL(wp) :: zsto, zout, zmax, zjulian, zdt
688	!!----------------------------------------------------------------------
689
690	! 0. Initialisation
691	! -----------------
692
693	! Define name, frequency of output and means
694	clname = cdfile_name
695	IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
696	zdt = rdt
697	zsto = rdt
698	clop = "inst(x)" ! no use of the mask value (require less cpu time)
699	zout = rdt
700	zmax = ( nitend - nit000 + 1 ) * zdt
701
702	IF(lwp) WRITE(numout,*)
703	IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
704	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created '
705	IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc'
706
707
708	! 1. Define NETCDF files and fields at beginning of first time step
709	! -----------------------------------------------------------------
710
711	! Compute julian date from starting date of the run
712	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis
713	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
714	CALL histbeg( clname, jpi, glamt, jpj, gphit, &
715	1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
716	CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept
717	"m", jpk, gdept_0, nz_i, "down")
718
719	! Declare all the output fields as NetCDF variables
720
721	CALL histdef( id_i, "vosaline", "Salinity" , "PSU" , & ! salinity
722	& jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
723	CALL histdef( id_i, "votemper", "Temperature" , "C" , & ! temperature
724	& jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
725	CALL histdef( id_i, "sossheig", "Sea Surface Height" , "m" , & ! ssh
726	& jpi, jpj, nh_i, 1 , 1, 1 , nz_i, 32, clop, zsto, zout )
727	CALL histdef( id_i, "vozocrtx", "Zonal Current" , "m/s" , & ! zonal current
728	& jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
729	CALL histdef( id_i, "vomecrty", "Meridional Current" , "m/s" , & ! meridonal current
730	& jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
731	CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current
732	& jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
733	CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater
734	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
735	CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux
736	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
737	CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux
738	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
739	CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i
740	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
741	CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress
742	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
743	CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress
744	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
745	IF( lk_vvl ) THEN
746	CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth
747	& jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
748	END IF
749
750	#if defined key_lim2
751	CALL lim_wri_state_2( kt, id_i, nh_i )
752	#else
753	CALL histend( id_i, snc4chunks=snc4set )
754	#endif
755
756	! 2. Start writing data
757	! ---------------------
758	! idex(1) est utilise ssi l'avant dernier argument est diffferent de
759	! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
760	! donne le nombre d'elements, et idex la liste des indices a sortir
761	idex(1) = 1 ! init to avoid compil warning
762
763	! Write all fields on T grid
764	CALL histwrite( id_i, "votemper", kt, tn , jpijpjjpk, idex ) ! now temperature
765	CALL histwrite( id_i, "vosaline", kt, sn , jpijpjjpk, idex ) ! now salinity
766	CALL histwrite( id_i, "sossheig", kt, sshn , jpi*jpj , idex ) ! sea surface height
767	CALL histwrite( id_i, "vozocrtx", kt, un , jpijpjjpk, idex ) ! now i-velocity
768	CALL histwrite( id_i, "vomecrty", kt, vn , jpijpjjpk, idex ) ! now j-velocity
769	CALL histwrite( id_i, "vovecrtz", kt, wn , jpijpjjpk, idex ) ! now k-velocity
770	CALL histwrite( id_i, "sowaflup", kt, (emp-rnf), jpi*jpj , idex ) ! freshwater budget
771	CALL histwrite( id_i, "sohefldo", kt, qsr + qns, jpi*jpj , idex ) ! total heat flux
772	CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux
773	CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction
774	CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress
775	CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress
776	IF( lk_vvl ) THEN
777	CALL histwrite( id_i, "vovvldep", kt, fsdept_n(:,:,:), jpijpjjpk, idex ) ! t-point depth
778	END IF
779
780	! 3. Close the file
781	! -----------------
782	CALL histclo( id_i )
783	#if ! defined key_iomput && ! defined key_dimgout
784	IF( ninist /= 1 ) THEN
785	CALL histclo( nid_T )
786	CALL histclo( nid_U )
787	CALL histclo( nid_V )
788	CALL histclo( nid_W )
789	ENDIF
790	#endif
791
792	END SUBROUTINE dia_wri_state
793	!!======================================================================
794	END MODULE diawri

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

Download in other formats: