Context Navigation

diawri.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

Property svn:keywords set to Id

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

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

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

Context Navigation

source: trunk/NEMOGCM/NEMO/SAS_SRC/diawri.F90 @ 6140

Download in other formats: