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_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

Context Navigation

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 @ 4455

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

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

Download in other formats: