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.

diaar5.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 @ 6793

Last change on this file since 6793 was 6793, checked in by davestorkey, 8 years ago

Merge in changes r6482:6692 from the nemo_v3_6_STABLE branch. Only part that changes results for GO6 configurations is a bug fix for the TVD advection scheme put in at r6692.
Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6692 cf. r6688 of /branches/2015/nemo_v3_6_STABLE/NEMOGCM@6791

Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6688 cf. r6482 of /branches/2015/nemo_v3_6_STABLE/NEMOGCM@6791

File size: 11.7 KB

Rev	Line
[1756]	1	MODULE diaar5
	2	!!======================================================================
	3	!! * MODULE diaar5 *
	4	!! AR5 diagnostics
	5	!!======================================================================
[2528]	6	!! History : 3.2 ! 2009-11 (S. Masson) Original code
	7	!! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
[1756]	8	!!----------------------------------------------------------------------
[2715]	9	#if defined key_diaar5 \|\| defined key_esopa
[1756]	10	!!----------------------------------------------------------------------
	11	!! 'key_diaar5' : activate ar5 diagnotics
	12	!!----------------------------------------------------------------------
[2528]	13	!! dia_ar5 : AR5 diagnostics
	14	!! dia_ar5_init : initialisation of AR5 diagnostics
[1756]	15	!!----------------------------------------------------------------------
	16	USE oce ! ocean dynamics and active tracers
	17	USE dom_oce ! ocean space and time domain
[2528]	18	USE eosbn2 ! equation of state (eos_bn2 routine)
[1756]	19	USE lib_mpp ! distribued memory computing library
	20	USE iom ! I/O manager library
[3294]	21	USE timing ! preformance summary
	22	USE wrk_nemo ! working arrays
[5253]	23	USE fldread ! type FLD_N
	24	USE phycst ! physical constant
	25	USE in_out_manager ! I/O manager
[1756]	26
	27	IMPLICIT NONE
	28	PRIVATE
	29
[2528]	30	PUBLIC dia_ar5 ! routine called in step.F90 module
	31	PUBLIC dia_ar5_init ! routine called in opa.F90 module
[2715]	32	PUBLIC dia_ar5_alloc ! routine called in nemogcm.F90 module
[1756]	33
	34	LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE. ! coupled flag
	35
[2528]	36	REAL(wp) :: vol0 ! ocean volume (interior domain)
	37	REAL(wp) :: area_tot ! total ocean surface (interior domain)
[2715]	38	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: area ! cell surface (interior domain)
	39	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: thick0 ! ocean thickness (interior domain)
	40	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity
[1756]	41
	42	!! * Substitutions
	43	# include "domzgr_substitute.h90"
	44	!!----------------------------------------------------------------------
[2528]	45	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	46	!! $Id$
	47	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1756]	48	!!----------------------------------------------------------------------
	49	CONTAINS
	50
[2715]	51	FUNCTION dia_ar5_alloc()
	52	!!----------------------------------------------------------------------
	53	!! * ROUTINE dia_ar5_alloc *
	54	!!----------------------------------------------------------------------
	55	INTEGER :: dia_ar5_alloc
	56	!!----------------------------------------------------------------------
	57	!
	58	ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )
	59	!
	60	IF( lk_mpp ) CALL mpp_sum ( dia_ar5_alloc )
	61	IF( dia_ar5_alloc /= 0 ) CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays')
	62	!
	63	END FUNCTION dia_ar5_alloc
	64
	65
[1756]	66	SUBROUTINE dia_ar5( kt )
	67	!!----------------------------------------------------------------------
	68	!! * ROUTINE dia_ar5 *
	69	!!
[2528]	70	!! ** Purpose : compute and output some AR5 diagnostics
[1756]	71	!!----------------------------------------------------------------------
[2715]	72	!
[1756]	73	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[2715]	74	!
[1756]	75	INTEGER :: ji, jj, jk ! dummy loop arguments
	76	REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass
[3294]	77	!
	78	REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace
	79	REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace
	80	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace
[1756]	81	!!--------------------------------------------------------------------
[3294]	82	IF( nn_timing == 1 ) CALL timing_start('dia_ar5')
	83
	84	CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres )
	85	CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop )
	86	CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn )
[1756]	87
	88	zarea_ssh(:,:) = area(:,:) * sshn(:,:)
	89
	90	! ! total volume of liquid seawater
	91	zvolssh = SUM( zarea_ssh(:,:) )
	92	IF( lk_mpp ) CALL mpp_sum( zvolssh )
	93	zvol = vol0 + zvolssh
	94
	95	CALL iom_put( 'voltot', zvol )
	96	CALL iom_put( 'sshtot', zvolssh / area_tot )
	97
[3294]	98	!
	99	ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh
[2528]	100	ztsn(:,:,:,jp_sal) = sn0(:,:,:)
[4313]	101	CALL eos( ztsn, zrhd, fsdept_n(:,:,:) ) ! now in situ density using initial salinity
[1756]	102	!
[2528]	103	zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
[1756]	104	DO jk = 1, jpkm1
	105	zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
	106	END DO
[4990]	107	IF( .NOT.lk_vvl ) THEN
[5120]	108	IF ( ln_isfcav ) THEN
	109	DO ji=1,jpi
	110	DO jj=1,jpj
	111	zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
	112	END DO
[4990]	113	END DO
[5120]	114	ELSE
	115	zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
	116	END IF
[4990]	117	END IF
[1756]	118	!
	119	zarho = SUM( area(:,:) * zbotpres(:,:) )
	120	IF( lk_mpp ) CALL mpp_sum( zarho )
	121	zssh_steric = - zarho / area_tot
	122	CALL iom_put( 'sshthster', zssh_steric )
	123
	124	! ! steric sea surface height
[4313]	125	CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) ) ! now in situ and potential density
[2528]	126	zrhop(:,:,jpk) = 0._wp
[1756]	127	CALL iom_put( 'rhop', zrhop )
	128	!
[2528]	129	zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
[1756]	130	DO jk = 1, jpkm1
	131	zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
	132	END DO
[4990]	133	IF( .NOT.lk_vvl ) THEN
[5120]	134	IF ( ln_isfcav ) THEN
	135	DO ji=1,jpi
	136	DO jj=1,jpj
	137	zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
	138	END DO
[4990]	139	END DO
[5120]	140	ELSE
	141	zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
	142	END IF
[4990]	143	END IF
[1756]	144	!
	145	zarho = SUM( area(:,:) * zbotpres(:,:) )
	146	IF( lk_mpp ) CALL mpp_sum( zarho )
	147	zssh_steric = - zarho / area_tot
	148	CALL iom_put( 'sshsteric', zssh_steric )
	149
	150	! ! ocean bottom pressure
[2528]	151	zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa
[1756]	152	zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) )
	153	CALL iom_put( 'botpres', zbotpres )
	154
	155	! ! Mean density anomalie, temperature and salinity
[2528]	156	ztemp = 0._wp
	157	zsal = 0._wp
[1756]	158	DO jk = 1, jpkm1
	159	DO jj = 1, jpj
	160	DO ji = 1, jpi
	161	zztmp = area(ji,jj) * fse3t(ji,jj,jk)
[3294]	162	ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem)
	163	zsal = zsal + zztmp * tsn(ji,jj,jk,jp_sal)
[1756]	164	END DO
	165	END DO
	166	END DO
[2528]	167	IF( .NOT.lk_vvl ) THEN
[5120]	168	IF ( ln_isfcav ) THEN
	169	DO ji=1,jpi
	170	DO jj=1,jpj
	171	ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem)
	172	zsal = zsal + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal)
	173	END DO
[4990]	174	END DO
[5120]	175	ELSE
[5121]	176	ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )
	177	zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )
[5120]	178	END IF
[1756]	179	ENDIF
	180	IF( lk_mpp ) THEN
	181	CALL mpp_sum( ztemp )
	182	CALL mpp_sum( zsal )
	183	END IF
	184	!
	185	zmass = rau0 * ( zarho + zvol ) ! total mass of liquid seawater
	186	ztemp = ztemp / zvol ! potential temperature in liquid seawater
	187	zsal = zsal / zvol ! Salinity of liquid seawater
	188	!
	189	CALL iom_put( 'masstot', zmass )
	190	CALL iom_put( 'temptot', ztemp )
	191	CALL iom_put( 'saltot' , zsal )
	192	!
[3294]	193	CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres )
	194	CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop )
	195	CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn )
[2715]	196	!
[3294]	197	IF( nn_timing == 1 ) CALL timing_stop('dia_ar5')
	198	!
[1756]	199	END SUBROUTINE dia_ar5
	200
	201
	202	SUBROUTINE dia_ar5_init
	203	!!----------------------------------------------------------------------
	204	!! * ROUTINE dia_ar5_init *
	205	!!
[2528]	206	!! ** Purpose : initialization for AR5 diagnostic computation
[1756]	207	!!----------------------------------------------------------------------
	208	INTEGER :: inum
	209	INTEGER :: ik
	210	INTEGER :: ji, jj, jk ! dummy loop indices
	211	REAL(wp) :: zztmp
[2715]	212	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity
[5253]	213	!
[1756]	214	!!----------------------------------------------------------------------
	215	!
[3294]	216	IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init')
	217	!
[6793]	218	CALL wrk_alloc( jpi, jpj, jpk, 2, zsaldta )
[2715]	219	! ! allocate dia_ar5 arrays
	220	IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' )
	221
[1756]	222	area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
	223
	224	area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot )
	225
[2528]	226	vol0 = 0._wp
	227	thick0(:,:) = 0._wp
[1756]	228	DO jk = 1, jpkm1
[4292]	229	vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) )
	230	thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk)
[1756]	231	END DO
[1948]	232	IF( lk_mpp ) CALL mpp_sum( vol0 )
[5253]	233
[6793]	234	CALL iom_open ( 'sali_ref_clim_monthly', inum )
	235	CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 )
	236	CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 )
[1756]	237	CALL iom_close( inum )
[6793]	238
[2528]	239	sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )
	240	sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)
[1756]	241	IF( ln_zps ) THEN ! z-coord. partial steps
	242	DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step)
	243	DO ji = 1, jpi
[2528]	244	ik = mbkt(ji,jj)
	245	IF( ik > 1 ) THEN
[4292]	246	zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
[2528]	247	sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
[1756]	248	ENDIF
	249	END DO
	250	END DO
	251	ENDIF
	252	!
[6793]	253	CALL wrk_dealloc( jpi, jpj, jpk, 2, zsaldta )
[2715]	254	!
[3294]	255	IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init')
	256	!
[1756]	257	END SUBROUTINE dia_ar5_init
	258
	259	#else
	260	!!----------------------------------------------------------------------
	261	!! Default option : NO diaar5
	262	!!----------------------------------------------------------------------
	263	LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE. ! coupled flag
	264	CONTAINS
[2528]	265	SUBROUTINE dia_ar5_init ! Dummy routine
	266	END SUBROUTINE dia_ar5_init
[1756]	267	SUBROUTINE dia_ar5( kt ) ! Empty routine
[2528]	268	INTEGER :: kt
[1756]	269	WRITE(,) 'dia_ar5: You should not have seen this print! error?', kt
	270	END SUBROUTINE dia_ar5
	271	#endif
	272
	273	!!======================================================================
	274	END MODULE diaar5

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

Download in other formats: