Context Navigation

diahsb.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 20.2 KB

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

Download in other formats: