Context Navigation

diahsb.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

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

Download in other formats: