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

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago
set proper svn properties to all files...
Property svn:keywords set to `Id`
File size: 38.0 KB

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

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

Download in other formats: