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/2015/dev_r5056_CMCC4_simplification/NEMOGCM/NEMO/SAS_SRC – NEMO

Context Navigation

source: branches/2015/dev_r5056_CMCC4_simplification/NEMOGCM/NEMO/SAS_SRC/diawri.F90 @ 5282

Last change on this file since 5282 was 5282, checked in by diovino, 9 years ago
Dev. branch CMCC4_simplification ticket #1456
File size: 21.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 traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
31	USE sol_oce ! solver variables
32	USE sbc_oce ! Surface boundary condition: ocean fields
33	USE sbc_ice ! Surface boundary condition: ice fields
34	USE sbcssr ! restoring term toward SST/SSS climatology
35	USE phycst ! physical constants
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 diaar5, ONLY : lk_diaar5
43	USE iom
44	USE ioipsl
45	#if defined key_lim2
46	USE limwri_2
47	#endif
48	USE lib_mpp ! MPP library
49	USE timing ! preformance summary
50	USE wrk_nemo ! working array
51
52	IMPLICIT NONE
53	PRIVATE
54
55	PUBLIC dia_wri ! routines called by step.F90
56	PUBLIC dia_wri_state
57	PUBLIC dia_wri_alloc ! Called by nemogcm module
58
59	INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file
60	INTEGER :: nid_U, nz_U, nh_U, ndim_U, ndim_hU ! grid_U file
61	INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file
62	INTEGER :: ndex(1) ! ???
63	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
64
65	!! * Substitutions
66	# include "zdfddm_substitute.h90"
67	# include "domzgr_substitute.h90"
68	# include "vectopt_loop_substitute.h90"
69	!!----------------------------------------------------------------------
70	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
71	!! $Id $
72	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
73	!!----------------------------------------------------------------------
74	CONTAINS
75
76	INTEGER FUNCTION dia_wri_alloc()
77	!!----------------------------------------------------------------------
78	INTEGER :: ierr
79	!!----------------------------------------------------------------------
80	!
81	ALLOCATE( ndex_hT(jpijpj), ndex_hU(jpijpj), ndex_hV(jpi*jpj), STAT=dia_wri_alloc )
82	IF( lk_mpp ) CALL mpp_sum( dia_wri_alloc )
83	!
84	END FUNCTION dia_wri_alloc
85
86	!!----------------------------------------------------------------------
87	!! Default option NetCDF output file
88	!!----------------------------------------------------------------------
89	#if defined key_iomput
90	!!----------------------------------------------------------------------
91	!! 'key_iomput' use IOM library
92	!!----------------------------------------------------------------------
93
94	SUBROUTINE dia_wri( kt )
95	!!---------------------------------------------------------------------
96	!! * ROUTINE dia_wri *
97	!!
98	!! ** Purpose : Standard output of opa: dynamics and tracer fields
99	!! NETCDF format is used by default
100	!! Standalone surface scheme
101	!!
102	!! ** Method : use iom_put
103	!!----------------------------------------------------------------------
104	!!
105	INTEGER, INTENT( in ) :: kt ! ocean time-step index
106	!!----------------------------------------------------------------------
107	!
108	!! no relevant 2D arrays to write in iomput case
109	!
110	END SUBROUTINE dia_wri
111
112	#else
113	!!----------------------------------------------------------------------
114	!! Default option use IOIPSL library
115	!!----------------------------------------------------------------------
116
117	SUBROUTINE dia_wri( kt )
118	!!---------------------------------------------------------------------
119	!! * ROUTINE dia_wri *
120	!!
121	!! ** Purpose : Standard output of opa: dynamics and tracer fields
122	!! NETCDF format is used by default
123	!!
124	!! ** Method : At the beginning of the first time step (nit000),
125	!! define all the NETCDF files and fields
126	!! At each time step call histdef to compute the mean if ncessary
127	!! Each nwrite time step, output the instantaneous or mean fields
128	!!----------------------------------------------------------------------
129	!!
130	INTEGER, INTENT( in ) :: kt ! ocean time-step index
131	!!
132	LOGICAL :: ll_print = .FALSE. ! =T print and flush numout
133	CHARACTER (len=40) :: clhstnam, clop, clmx ! local names
134	INTEGER :: inum = 11 ! temporary logical unit
135	INTEGER :: ji, jj, jk ! dummy loop indices
136	INTEGER :: ierr ! error code return from allocation
137	INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers
138	REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars
139	!!----------------------------------------------------------------------
140	!
141	IF( nn_timing == 1 ) CALL timing_start('dia_wri')
142	!
143	! Output the initial state and forcings
144	IF( ninist == 1 ) THEN
145	CALL dia_wri_state( 'output.init', kt )
146	ninist = 0
147	ENDIF
148	!
149	! 0. Initialisation
150	! -----------------
151
152	! local variable for debugging
153	ll_print = .FALSE.
154	ll_print = ll_print .AND. lwp
155
156	! Define frequency of output and means
157	zdt = rdt
158	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
159	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
160	ENDIF
161	#if defined key_diainstant
162	zsto = nwrite * zdt
163	clop = "inst("//TRIM(clop)//")"
164	#else
165	zsto=zdt
166	clop = "ave("//TRIM(clop)//")"
167	#endif
168	zout = nwrite * zdt
169	zmax = ( nitend - nit000 + 1 ) * zdt
170
171	! Define indices of the horizontal output zoom and vertical limit storage
172	iimi = 1 ; iima = jpi
173	ijmi = 1 ; ijma = jpj
174	ipk = jpk
175
176	! define time axis
177	it = kt
178	itmod = kt - nit000 + 1
179
180
181	! 1. Define NETCDF files and fields at beginning of first time step
182	! -----------------------------------------------------------------
183
184	IF( kt == nit000 ) THEN
185
186	! Define the NETCDF files (one per grid)
187
188	! Compute julian date from starting date of the run
189	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
190	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
191	IF(lwp)WRITE(numout,*)
192	IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear, &
193	& ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
194	IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, &
195	' limit storage in depth = ', ipk
196
197	! WRITE root name in date.file for use by postpro
198	IF(lwp) THEN
199	CALL dia_nam( clhstnam, nwrite,' ' )
200	CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
201	WRITE(inum,*) clhstnam
202	CLOSE(inum)
203	ENDIF
204
205	! Define the T grid FILE ( nid_T )
206
207	CALL dia_nam( clhstnam, nwrite, 'grid_T' )
208	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
209	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit
210	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
211	& nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
212	CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept
213	& "m", ipk, gdept_1d, nz_T, "down" )
214	! ! Index of ocean points
215	CALL wheneq( jpi*jpj , tmask, 1, 1., ndex_hT, ndim_hT ) ! surface
216
217	! Define the U grid FILE ( nid_U )
218
219	CALL dia_nam( clhstnam, nwrite, 'grid_U' )
220	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
221	CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu
222	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
223	& nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
224	CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept
225	& "m", ipk, gdept_1d, nz_U, "down" )
226	! ! Index of ocean points
227	CALL wheneq( jpi*jpj , umask, 1, 1., ndex_hU, ndim_hU ) ! surface
228
229	! Define the V grid FILE ( nid_V )
230
231	CALL dia_nam( clhstnam, nwrite, 'grid_V' ) ! filename
232	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
233	CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv
234	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
235	& nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
236	CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept
237	& "m", ipk, gdept_1d, nz_V, "down" )
238	! ! Index of ocean points
239	CALL wheneq( jpi*jpj , vmask, 1, 1., ndex_hV, ndim_hV ) ! surface
240
241	! No W grid FILE
242
243	! Declare all the output fields as NETCDF variables
244
245	! !!! nid_T : 3D
246	CALL histdef( nid_T, "sst_m", "Sea Surface temperature" , "C" , & ! sst
247	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
248	CALL histdef( nid_T, "sss_m", "Sea Surface Salinity" , "PSU" , & ! sss
249	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
250	CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux" , "Kg/m2/s", & ! (emp-rnf)
251	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
252	CALL histdef( nid_T, "sosfldow", "downward salt flux" , "PSU/m2/s", & ! (sfx)
253	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
254	CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux" , "W/m2" , & ! qns + qsr
255	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
256	CALL histdef( nid_T, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! qsr
257	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
258	CALL histdef( nid_T, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i
259	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
260	CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm
261	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
262
263	CALL histend( nid_T, snc4chunks=snc4set )
264
265	! !!! nid_U : 3D
266	CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s" , & ! ssu
267	& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
268	CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau
269	& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
270
271	CALL histend( nid_U, snc4chunks=snc4set )
272
273	! !!! nid_V : 3D
274	CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s", & ! ssv_m
275	& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
276	CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau
277	& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
278
279	CALL histend( nid_V, snc4chunks=snc4set )
280
281	IF(lwp) WRITE(numout,*)
282	IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
283	IF(ll_print) CALL FLUSH(numout )
284
285	ENDIF
286
287	! 2. Start writing data
288	! ---------------------
289
290	! ndex(1) est utilise ssi l'avant dernier argument est diffferent de
291	! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
292	! donne le nombre d'elements, et ndex la liste des indices a sortir
293
294	IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN
295	WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
296	WRITE(numout,*) '~~~~~~ '
297	ENDIF
298
299	! Write fields on T grid
300	CALL histwrite( nid_T, "sst_m", it, sst_m, ndim_hT, ndex_hT ) ! sea surface temperature
301	CALL histwrite( nid_T, "sss_m", it, sss_m, ndim_hT, ndex_hT ) ! sea surface salinity
302	CALL histwrite( nid_T, "sowaflup", it, (emp - rnf ) , ndim_hT, ndex_hT ) ! upward water flux
303	CALL histwrite( nid_T, "sosfldow", it, sfx , ndim_hT, ndex_hT ) ! downward salt flux
304	! (includes virtual salt flux beneath ice
305	! in linear free surface case)
306
307	CALL histwrite( nid_T, "sohefldo", it, qns + qsr , ndim_hT, ndex_hT ) ! total heat flux
308	CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux
309	CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction
310	CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed
311
312	! Write fields on U grid
313	CALL histwrite( nid_U, "ssu_m" , it, ssu_m , ndim_hU, ndex_hU ) ! i-current speed
314	CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress
315
316	! Write fields on V grid
317	CALL histwrite( nid_V, "ssv_m" , it, ssv_m , ndim_hV, ndex_hV ) ! j-current speed
318	CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress
319
320	! 3. Close all files
321	! ---------------------------------------
322	IF( kt == nitend ) THEN
323	CALL histclo( nid_T )
324	CALL histclo( nid_U )
325	CALL histclo( nid_V )
326	ENDIF
327	!
328	IF( nn_timing == 1 ) CALL timing_stop('dia_wri')
329	!
330	END SUBROUTINE dia_wri
331	#endif
332
333
334
335	SUBROUTINE dia_wri_state( cdfile_name, kt )
336	!!---------------------------------------------------------------------
337	!! * ROUTINE dia_wri_state *
338	!!
339	!! ** Purpose : create a NetCDF file named cdfile_name which contains
340	!! the instantaneous ocean state and forcing fields.
341	!! Used to find errors in the initial state or save the last
342	!! ocean state in case of abnormal end of a simulation
343	!!
344	!! ** Method : NetCDF files using ioipsl
345	!! File 'output.init.nc' is created if ninist = 1 (namelist)
346	!! File 'output.abort.nc' is created in case of abnormal job end
347	!!----------------------------------------------------------------------
348	CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created
349	INTEGER , INTENT( in ) :: kt ! ocean time-step index
350	!!
351	CHARACTER (len=32) :: clname
352	CHARACTER (len=40) :: clop
353	INTEGER :: id_i , nz_i, nh_i
354	INTEGER, DIMENSION(1) :: idex ! local workspace
355	REAL(wp) :: zsto, zout, zmax, zjulian, zdt
356	!!----------------------------------------------------------------------
357	!
358	IF( nn_timing == 1 ) CALL timing_start('dia_wri_state')
359
360	! 0. Initialisation
361	! -----------------
362
363	! Define name, frequency of output and means
364	clname = cdfile_name
365	IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
366	zdt = rdt
367	zsto = rdt
368	clop = "inst(x)" ! no use of the mask value (require less cpu time)
369	zout = rdt
370	zmax = ( nitend - nit000 + 1 ) * zdt
371
372	IF(lwp) WRITE(numout,*)
373	IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
374	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created '
375	IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc'
376
377
378	! 1. Define NETCDF files and fields at beginning of first time step
379	! -----------------------------------------------------------------
380
381	! Compute julian date from starting date of the run
382	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis
383	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
384	CALL histbeg( clname, jpi, glamt, jpj, gphit, &
385	1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
386	CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept
387	"m", jpk, gdept_1d, nz_i, "down")
388
389	! Declare all the output fields as NetCDF variables
390
391	CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater
392	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
393	CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux
394	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
395	CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux
396	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
397	CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i
398	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
399	CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress
400	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
401	CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress
402	& jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
403
404	#if defined key_lim2
405	CALL lim_wri_state_2( kt, id_i, nh_i )
406	#else
407	CALL histend( id_i, snc4chunks=snc4set )
408	#endif
409
410	! 2. Start writing data
411	! ---------------------
412	! idex(1) est utilise ssi l'avant dernier argument est diffferent de
413	! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
414	! donne le nombre d'elements, et idex la liste des indices a sortir
415	idex(1) = 1 ! init to avoid compil warning
416
417	! Write all fields on T grid
418	CALL histwrite( id_i, "sowaflup", kt, emp , jpi*jpj , idex ) ! freshwater budget
419	CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux
420	CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux
421	CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction
422	CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress
423	CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress
424
425	! 3. Close the file
426	! -----------------
427	CALL histclo( id_i )
428	#if ! defined key_iomput
429	IF( ninist /= 1 ) THEN
430	CALL histclo( nid_T )
431	CALL histclo( nid_U )
432	CALL histclo( nid_V )
433	ENDIF
434	#endif
435
436	IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state')
437	!
438
439	END SUBROUTINE dia_wri_state
440	!!======================================================================
441	END MODULE diawri

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

Download in other formats: