Context Navigation

diahsb.F90 @ 8793

Last change on this file since 8793 was 8793, checked in by andmirek, 6 years ago
#1953 and #1962 change lxios_read to lrxios to be consistent with write branch
Property svn:keywords set to `Id`
File size: 21.3 KB

Line
1	MODULE diahsb
2	!!======================================================================
3	!! * MODULE diahsb *
4	!! Ocean diagnostics: Heat, salt and volume budgets
5	!!======================================================================
6	!! History : 3.3 ! 2010-09 (M. Leclair) Original code
7	!! ! 2012-10 (C. Rousset) add iom_put
8	!!----------------------------------------------------------------------
9
10	!!----------------------------------------------------------------------
11	!! dia_hsb : Diagnose the conservation of ocean heat and salt contents, and volume
12	!! dia_hsb_rst : Read or write DIA file in restart file
13	!! dia_hsb_init : Initialization of the conservation diagnostic
14	!!----------------------------------------------------------------------
15	USE oce ! ocean dynamics and tracers
16	USE dom_oce ! ocean space and time domain
17	USE phycst ! physical constants
18	USE sbc_oce ! surface thermohaline fluxes
19	USE sbcrnf ! river runoff
20	USE sbcisf ! ice shelves
21	USE domvvl ! vertical scale factors
22	USE traqsr ! penetrative solar radiation
23	USE trabbc ! bottom boundary condition
24	USE trabbc ! bottom boundary condition
25	USE restart ! ocean restart
26	USE bdy_oce , ONLY: ln_bdy
27	!
28	USE iom ! I/O manager
29	USE in_out_manager ! I/O manager
30	USE lib_fortran ! glob_sum
31	USE lib_mpp ! distributed memory computing library
32	USE timing ! preformance summary
33	USE wrk_nemo ! work arrays
34	USE iom_def, ONLY : lwxios
35	USE iom_def, ONLY : lrxios
36
37	IMPLICIT NONE
38	PRIVATE
39
40	PUBLIC dia_hsb ! routine called by step.F90
41	PUBLIC dia_hsb_init ! routine called by nemogcm.F90
42
43	LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets
44
45	REAL(wp) :: surf_tot ! ocean surface
46	REAL(wp) :: frc_t, frc_s, frc_v ! global forcing trends
47	REAL(wp) :: frc_wn_t, frc_wn_s ! global forcing trends
48	!
49	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf
50	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini !
51	REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini !
52	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini !
53
54	!! * Substitutions
55	# include "vectopt_loop_substitute.h90"
56	!!----------------------------------------------------------------------
57	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
58	!! $Id$
59	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
60	!!----------------------------------------------------------------------
61	CONTAINS
62
63	SUBROUTINE dia_hsb( kt )
64	!!---------------------------------------------------------------------------
65	!! * ROUTINE dia_hsb *
66	!!
67	!! ** Purpose: Compute the ocean global heat content, salt content and volume conservation
68	!!
69	!! ** Method : - Compute the deviation of heat content, salt content and volume
70	!! at the current time step from their values at nit000
71	!! - Compute the contribution of forcing and remove it from these deviations
72	!!
73	!!---------------------------------------------------------------------------
74	INTEGER, INTENT(in) :: kt ! ocean time-step index
75	!
76	INTEGER :: ji, jj, jk ! dummy loop indice
77	REAL(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations
78	REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - -
79	REAL(wp) :: zdiff_v1 , zdiff_v2 ! volume variation
80	REAL(wp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit
81	REAL(wp) :: zvol_tot ! volume
82	REAL(wp) :: z_frc_trd_t , z_frc_trd_s ! - -
83	REAL(wp) :: z_frc_trd_v ! - -
84	REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - -
85	REAL(wp) :: z_ssh_hc , z_ssh_sc ! - -
86	REAL(wp), DIMENSION(:,:), POINTER :: z2d0, z2d1
87	!!---------------------------------------------------------------------------
88	IF( nn_timing == 1 ) CALL timing_start('dia_hsb')
89	!
90	CALL wrk_alloc( jpi,jpj, z2d0, z2d1 )
91	!
92	tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ;
93	tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ;
94	! ------------------------- !
95	! 1 - Trends due to forcing !
96	! ------------------------- !
97	z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
98	z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes
99	z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes
100	! Add runoff heat & salt input
101	IF( ln_rnf ) z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) )
102	IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) )
103	! Add ice shelf heat & salt input
104	IF( ln_isf ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) )
105	! Add penetrative solar radiation
106	IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * surf(:,:) )
107	! Add geothermal heat flux
108	IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) )
109	!
110	IF( ln_linssh ) THEN
111	IF( ln_isfcav ) THEN
112	DO ji=1,jpi
113	DO jj=1,jpj
114	z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
115	z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
116	END DO
117	END DO
118	ELSE
119	z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem)
120	z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal)
121	END IF
122	z_wn_trd_t = - glob_sum( z2d0 )
123	z_wn_trd_s = - glob_sum( z2d1 )
124	ENDIF
125
126	frc_v = frc_v + z_frc_trd_v * rdt
127	frc_t = frc_t + z_frc_trd_t * rdt
128	frc_s = frc_s + z_frc_trd_s * rdt
129	! ! Advection flux through fixed surface (z=0)
130	IF( ln_linssh ) THEN
131	frc_wn_t = frc_wn_t + z_wn_trd_t * rdt
132	frc_wn_s = frc_wn_s + z_wn_trd_s * rdt
133	ENDIF
134
135	! ------------------------ !
136	! 2 - Content variations !
137	! ------------------------ !
138	! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl)
139	zdiff_v2 = 0._wp
140	zdiff_hc = 0._wp
141	zdiff_sc = 0._wp
142
143	! volume variation (calculated with ssh)
144	zdiff_v1 = glob_sum_full( surf(:,:) * sshn(:,:) - surf_ini(:,:) * ssh_ini(:,:) )
145
146	! heat & salt content variation (associated with ssh)
147	IF( ln_linssh ) THEN
148	IF( ln_isfcav ) THEN
149	DO ji = 1, jpi
150	DO jj = 1, jpj
151	z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) )
152	z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) )
153	END DO
154	END DO
155	ELSE
156	z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) )
157	z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )
158	END IF
159	z_ssh_hc = glob_sum_full( z2d0 )
160	z_ssh_sc = glob_sum_full( z2d1 )
161	ENDIF
162
163	DO jk = 1, jpkm1
164	! volume variation (calculated with scale factors)
165	zdiff_v2 = zdiff_v2 + glob_sum_full( surf(:,:) * tmask(:,:,jk) &
166	& * e3t_n(:,:,jk) - surf_ini(:,:) * e3t_ini(:,:,jk) )
167	! heat content variation
168	zdiff_hc = zdiff_hc + glob_sum_full( surf(:,:) * tmask(:,:,jk) &
169	& * e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - surf_ini(:,:) * hc_loc_ini(:,:,jk) )
170	! salt content variation
171	zdiff_sc = zdiff_sc + glob_sum_full( surf (:,:) * tmask(:,:,jk) &
172	* e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - surf_ini(:,:) * sc_loc_ini(:,:,jk) )
173	ENDDO
174
175	! ------------------------ !
176	! 3 - Drifts !
177	! ------------------------ !
178	zdiff_v1 = zdiff_v1 - frc_v
179	IF( .NOT.ln_linssh ) zdiff_v2 = zdiff_v2 - frc_v
180	zdiff_hc = zdiff_hc - frc_t
181	zdiff_sc = zdiff_sc - frc_s
182	IF( ln_linssh ) THEN
183	zdiff_hc1 = zdiff_hc + z_ssh_hc
184	zdiff_sc1 = zdiff_sc + z_ssh_sc
185	zerr_hc1 = z_ssh_hc - frc_wn_t
186	zerr_sc1 = z_ssh_sc - frc_wn_s
187	ENDIF
188
189	! ----------------------- !
190	! 4 - Diagnostics writing !
191	! ----------------------- !
192	zvol_tot = 0._wp ! total ocean volume (calculated with scale factors)
193	DO jk = 1, jpkm1
194	zvol_tot = zvol_tot + glob_sum_full( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) )
195	END DO
196
197	!!gm to be added ?
198	! IF( ln_linssh ) THEN ! fixed volume, add the ssh contribution
199	! zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) )
200	! ENDIF
201	!!gm end
202
203	CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3)
204	CALL iom_put( 'bgfrctem' , frc_t * rau0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J)
205	CALL iom_put( 'bgfrchfx' , frc_t * rau0 * rcp / & ! hc - surface forcing (W/m2)
206	& ( surf_tot * kt * rdt ) )
207	CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3)
208
209	IF( .NOT. ln_linssh ) THEN
210	CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C)
211	CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (pss)
212	CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J)
213	CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp / & ! Heat flux drift (W/m2)
214	& ( surf_tot * kt * rdt ) )
215	CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3)
216	CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3)
217	CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3)
218	ELSE
219	CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C)
220	CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (pss)
221	CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J)
222	CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp / & ! Heat flux drift (W/m2)
223	& ( surf_tot * kt * rdt ) )
224	CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3)
225	CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3)
226	CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C)
227	CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu)
228	ENDIF
229	!
230	IF( lrst_oce ) CALL dia_hsb_rst( kt, 'WRITE' )
231	!
232	CALL wrk_dealloc( jpi,jpj, z2d0, z2d1 )
233	!
234	IF( nn_timing == 1 ) CALL timing_stop('dia_hsb')
235	!
236	END SUBROUTINE dia_hsb
237
238
239	SUBROUTINE dia_hsb_rst( kt, cdrw )
240	!!---------------------------------------------------------------------
241	!! * ROUTINE dia_hsb_rst *
242	!!
243	!! ** Purpose : Read or write DIA file in restart file
244	!!
245	!! ** Method : use of IOM library
246	!!----------------------------------------------------------------------
247	INTEGER , INTENT(in) :: kt ! ocean time-step
248	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
249	!
250	INTEGER :: ji, jj, jk ! dummy loop indices
251	!!----------------------------------------------------------------------
252	!
253	IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise
254	IF( ln_rstart ) THEN !* Read the restart file
255	!
256	IF(lwp) WRITE(numout,*) '~~~~~~~'
257	IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp
258	IF(lwp) WRITE(numout,*) '~~~~~~~'
259	CALL iom_get( numror, 'frc_v', frc_v, ldxios = lrxios )
260	CALL iom_get( numror, 'frc_t', frc_t, ldxios = lrxios )
261	CALL iom_get( numror, 'frc_s', frc_s, ldxios = lrxios )
262	IF( ln_linssh ) THEN
263	CALL iom_get( numror, 'frc_wn_t', frc_wn_t, ldxios = lrxios )
264	CALL iom_get( numror, 'frc_wn_s', frc_wn_s, ldxios = lrxios )
265	ENDIF
266	CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini, ldxios = lrxios ) ! ice sheet coupling
267	CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:), ldxios = lrxios )
268	CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:), ldxios = lrxios )
269	CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:), ldxios = lrxios )
270	CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:), ldxios = lrxios )
271	IF( ln_linssh ) THEN
272	CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:), ldxios = lrxios )
273	CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:), ldxios = lrxios )
274	ENDIF
275	ELSE
276	IF(lwp) WRITE(numout,*) '~~~~~~~'
277	IF(lwp) WRITE(numout,*) ' dia_hsb at initial state '
278	IF(lwp) WRITE(numout,*) '~~~~~~~'
279	surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface
280	ssh_ini(:,:) = sshn(:,:) ! initial ssh
281	DO jk = 1, jpk
282	! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
283	e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors
284	hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content
285	sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content
286	END DO
287	frc_v = 0._wp ! volume trend due to forcing
288	frc_t = 0._wp ! heat content - - - -
289	frc_s = 0._wp ! salt content - - - -
290	IF( ln_linssh ) THEN
291	IF ( ln_isfcav ) THEN
292	DO ji=1,jpi
293	DO jj=1,jpj
294	ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh
295	ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh
296	ENDDO
297	ENDDO
298	ELSE
299	ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh
300	ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh
301	END IF
302	frc_wn_t = 0._wp ! initial heat content misfit due to free surface
303	frc_wn_s = 0._wp ! initial salt content misfit due to free surface
304	ENDIF
305	ENDIF
306
307	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file
308	! ! -------------------
309	IF(lwp) WRITE(numout,*) '~~~~~~~'
310	IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp
311	IF(lwp) WRITE(numout,*) '~~~~~~~'
312	IF( lwxios ) CALL iom_swap( cwxios_context )
313	CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v, ldxios = lwxios)
314	CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t, ldxios = lwxios)
315	CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s, ldxios = lwxios)
316	IF( ln_linssh ) THEN
317	CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t, ldxios = lwxios)
318	CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s, ldxios = lwxios )
319	ENDIF
320	CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini, ldxios = lwxios ) ! ice sheet coupling
321	CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:), ldxios = lwxios )
322	CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:), ldxios = lwxios )
323	CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:), ldxios = lwxios )
324	CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:), ldxios = lwxios )
325	IF( ln_linssh ) THEN
326	CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:), ldxios = lwxios )
327	CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:), ldxios = lwxios )
328	ENDIF
329	!
330	IF( lwxios ) CALL iom_swap( cxios_context )
331	ENDIF
332	!
333	END SUBROUTINE dia_hsb_rst
334
335
336	SUBROUTINE dia_hsb_init
337	!!---------------------------------------------------------------------------
338	!! * ROUTINE dia_hsb *
339	!!
340	!! ** Purpose: Initialization for the heat salt volume budgets
341	!!
342	!! ** Method : Compute initial heat content, salt content and volume
343	!!
344	!! ** Action : - Compute initial heat content, salt content and volume
345	!! - Initialize forcing trends
346	!! - Compute coefficients for conversion
347	!!---------------------------------------------------------------------------
348	INTEGER :: ierror ! local integer
349	INTEGER :: ios
350	!!
351	NAMELIST/namhsb/ ln_diahsb
352	!!----------------------------------------------------------------------
353	!
354	REWIND( numnam_ref ) ! Namelist namhsb in reference namelist
355	READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901)
356	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp )
357
358	REWIND( numnam_cfg ) ! Namelist namhsb in configuration namelist
359	READ ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 )
360	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp )
361	IF(lwm) WRITE ( numond, namhsb )
362
363	IF(lwp) THEN
364	WRITE(numout,*)
365	WRITE(numout,*) 'dia_hsb_init'
366	WRITE(numout,*) '~~~~~~~~ '
367	WRITE(numout,*) ' check the heat and salt budgets (T) or not (F) ln_diahsb = ', ln_diahsb
368	ENDIF
369	!
370	IF( .NOT. ln_diahsb ) RETURN
371
372	IF(lwxios) THEN
373	! define variables in restart file when writing with XIOS
374	CALL iom_set_rstw_var_active('frc_v')
375	CALL iom_set_rstw_var_active('frc_t')
376	CALL iom_set_rstw_var_active('frc_s')
377	IF( ln_linssh ) THEN
378	CALL iom_set_rstw_var_active('frc_wn_t')
379	CALL iom_set_rstw_var_active('frc_wn_s')
380	ENDIF
381	CALL iom_set_rstw_var_active('surf_ini')
382	CALL iom_set_rstw_var_active('ssh_ini')
383	CALL iom_set_rstw_var_active('e3t_ini')
384	CALL iom_set_rstw_var_active('hc_loc_ini')
385	CALL iom_set_rstw_var_active('sc_loc_ini')
386	IF( ln_linssh ) THEN
387	CALL iom_set_rstw_var_active('ssh_hc_loc_ini')
388	CALL iom_set_rstw_var_active('ssh_sc_loc_ini')
389	ENDIF
390	ENDIF
391	! ------------------- !
392	! 1 - Allocate memory !
393	! ------------------- !
394	ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), &
395	& e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror )
396	IF( ierror > 0 ) THEN
397	CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' ) ; RETURN
398	ENDIF
399
400	IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )
401	IF( ierror > 0 ) THEN
402	CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' ) ; RETURN
403	ENDIF
404
405	! ----------------------------------------------- !
406	! 2 - Time independant variables and file opening !
407	! ----------------------------------------------- !
408	surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area
409	surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area
410
411	IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' )
412	!
413	! ---------------------------------- !
414	! 4 - initial conservation variables !
415	! ---------------------------------- !
416	CALL dia_hsb_rst( nit000, 'READ' ) !* read or initialize all required files
417	!
418	END SUBROUTINE dia_hsb_init
419
420	!!======================================================================
421	END MODULE diahsb

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

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

Context Navigation

source: branches/2017/dev_r8600_xios_read_write/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90 @ 8793

Download in other formats: