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.

closea.F90 in branches/DEV_R1821_Rivers/NEMO/OPA_SRC/DOM – NEMO

Context Navigation

source: branches/DEV_R1821_Rivers/NEMO/OPA_SRC/DOM/closea.F90 @ 1998

Last change on this file since 1998 was 1998, checked in by acc, 14 years ago
ticket #465_Rivers tidied code and added namelist changes in preparation for mid-year merge
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 17.1 KB

Rev	Line
[3]	1	MODULE closea
	2	!!======================================================================
	3	!! * MODULE closea *
[888]	4	!! Closed Seas : specific treatments associated with closed seas
[3]	5	!!======================================================================
[888]	6	!! History : 8.2 ! 00-05 (O. Marti) Original code
	7	!! 8.5 ! 02-06 (E. Durand, G. Madec) F90
	8	!! 9.0 ! 06-07 (G. Madec) add clo_rnf, clo_ups, clo_bat
	9	!!----------------------------------------------------------------------
[3]	10
	11	!!----------------------------------------------------------------------
	12	!! dom_clo : modification of the ocean domain for closed seas cases
[888]	13	!! sbc_clo : Special handling of closed seas
	14	!! clo_rnf : set close sea outflows as river mouths (see sbcrnf)
	15	!! clo_ups : set mixed centered/upstream scheme in closed sea (see traadv_cen2)
	16	!! clo_bat : set to zero a field over closed sea (see domzrg)
[3]	17	!!----------------------------------------------------------------------
	18	USE oce ! dynamics and tracers
	19	USE dom_oce ! ocean space and time domain
	20	USE in_out_manager ! I/O manager
[888]	21	USE sbc_oce ! ocean surface boundary conditions
[3]	22	USE lib_mpp ! distributed memory computing library
	23	USE lbclnk ! ???
	24
	25	IMPLICIT NONE
	26	PRIVATE
	27
[888]	28	PUBLIC dom_clo ! routine called by domain module
	29	PUBLIC sbc_clo ! routine called by step module
	30	PUBLIC clo_rnf ! routine called by sbcrnf module
	31	PUBLIC clo_ups ! routine called in traadv_cen2(_jki) module
	32	PUBLIC clo_bat ! routine called in domzgr module
[3]	33
[888]	34	INTEGER, PUBLIC, PARAMETER :: jpncs = 4 !: number of closed sea
	35	INTEGER, PUBLIC, DIMENSION(jpncs) :: ncstt !: Type of closed sea
	36	INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsi1, ncsj1 !: south-west closed sea limits (i,j)
	37	INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsi2, ncsj2 !: north-east closed sea limits (i,j)
	38	INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsnr !: number of point where run-off pours
	39	INTEGER, PUBLIC, DIMENSION(jpncs,4) :: ncsir, ncsjr !: Location of runoff
[3]	40
[888]	41	REAL(wp), DIMENSION (jpncs+1) :: surf ! closed sea surface
[3]	42
	43	!! * Substitutions
	44	# include "vectopt_loop_substitute.h90"
	45	!!----------------------------------------------------------------------
[888]	46	!! OPA 9.0 , LOCEAN-IPSL (2006)
	47	!! $Id$
	48	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
[3]	49	!!----------------------------------------------------------------------
	50
	51	CONTAINS
	52
	53	SUBROUTINE dom_clo
	54	!!---------------------------------------------------------------------
	55	!! * ROUTINE dom_clo *
	56	!!
	57	!! ** Purpose : Closed sea domain initialization
	58	!!
	59	!! ** Method : if a closed sea is located only in a model grid point
[888]	60	!! just the thermodynamic processes are applied.
[3]	61	!!
[888]	62	!! ** Action : ncsi1(), ncsj1() : south-west closed sea limits (i,j)
	63	!! ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
	64	!! ncsir(), ncsjr() : Location of runoff
	65	!! ncsnr : number of point where run-off pours
	66	!! ncstt : Type of closed sea
	67	!! =0 spread over the world ocean
	68	!! =2 put at location runoff
[3]	69	!!----------------------------------------------------------------------
	70	INTEGER :: jc ! dummy loop indices
	71	!!----------------------------------------------------------------------
	72
	73	IF(lwp) WRITE(numout,*)
[64]	74	IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
	75	IF(lwp) WRITE(numout,*)'~~~~~~~'
[3]	76
	77	! initial values
	78	ncsnr(:) = 1 ; ncsi1(:) = 1 ; ncsi2(:) = 1 ; ncsir(:,:) = 1
	79	ncstt(:) = 0 ; ncsj1(:) = 1 ; ncsj2(:) = 1 ; ncsjr(:,:) = 1
	80
	81	! set the closed seas (in data domain indices)
	82	! -------------------
	83
	84	IF( cp_cfg == "orca" ) THEN
[888]	85	!
[3]	86	SELECT CASE ( jp_cfg )
	87	! ! =======================
	88	CASE ( 2 ) ! ORCA_R2 configuration
	89	! ! =======================
	90	! ! Caspian Sea
	91	ncsnr(1) = 1 ; ncstt(1) = 0 ! spread over the globe
	92	ncsi1(1) = 11 ; ncsj1(1) = 103
	93	ncsi2(1) = 17 ; ncsj2(1) = 112
	94	ncsir(1,1) = 1 ; ncsjr(1,1) = 1
	95	! ! Great North American Lakes
	96	ncsnr(2) = 1 ; ncstt(2) = 2 ! put at St Laurent mouth
	97	ncsi1(2) = 97 ; ncsj1(2) = 107
	98	ncsi2(2) = 103 ; ncsj2(2) = 111
	99	ncsir(2,1) = 110 ; ncsjr(2,1) = 111
	100	! ! Black Sea 1 : west part of the Black Sea
	101	ncsnr(3) = 1 ; ncstt(3) = 2 ! (ie west of the cyclic b.c.)
	102	ncsi1(3) = 174 ; ncsj1(3) = 107 ! put in Med Sea
	103	ncsi2(3) = 181 ; ncsj2(3) = 112
	104	ncsir(3,1) = 171 ; ncsjr(3,1) = 106
	105	! ! Black Sea 2 : est part of the Black Sea
	106	ncsnr(4) = 1 ; ncstt(4) = 2 ! (ie est of the cyclic b.c.)
	107	ncsi1(4) = 2 ; ncsj1(4) = 107 ! put in Med Sea
	108	ncsi2(4) = 6 ; ncsj2(4) = 112
	109	ncsir(4,1) = 171 ; ncsjr(4,1) = 106
	110	! ! =======================
	111	CASE ( 4 ) ! ORCA_R4 configuration
	112	! ! =======================
	113	! ! Caspian Sea
	114	ncsnr(1) = 1 ; ncstt(1) = 0
	115	ncsi1(1) = 4 ; ncsj1(1) = 53
	116	ncsi2(1) = 4 ; ncsj2(1) = 56
	117	ncsir(1,1) = 1 ; ncsjr(1,1) = 1
	118	! ! Great North American Lakes
	119	ncsnr(2) = 1 ; ncstt(2) = 2
	120	ncsi1(2) = 49 ; ncsj1(2) = 55
	121	ncsi2(2) = 51 ; ncsj2(2) = 56
	122	ncsir(2,1) = 57 ; ncsjr(2,1) = 55
	123	! ! Black Sea
	124	ncsnr(3) = 4 ; ncstt(3) = 2
	125	ncsi1(3) = 88 ; ncsj1(3) = 55
	126	ncsi2(3) = 91 ; ncsj2(3) = 56
	127	ncsir(3,1) = 86 ; ncsjr(3,1) = 53
	128	ncsir(3,2) = 87 ; ncsjr(3,2) = 53
	129	ncsir(3,3) = 86 ; ncsjr(3,3) = 52
	130	ncsir(3,4) = 87 ; ncsjr(3,4) = 52
	131	! ! Baltic Sea
	132	ncsnr(4) = 1 ; ncstt(4) = 2
	133	ncsi1(4) = 75 ; ncsj1(4) = 59
	134	ncsi2(4) = 76 ; ncsj2(4) = 61
	135	ncsir(4,1) = 84 ; ncsjr(4,1) = 59
[304]	136	! ! =======================
	137	CASE ( 025 ) ! ORCA_R025 configuration
	138	! ! =======================
	139	ncsnr(1) = 1 ; ncstt(1) = 0 ! Caspian + Aral sea
	140	ncsi1(1) = 1330 ; ncsj1(1) = 645
	141	ncsi2(1) = 1400 ; ncsj2(1) = 795
	142	ncsir(1,1) = 1 ; ncsjr(1,1) = 1
	143	!
	144	ncsnr(2) = 1 ; ncstt(2) = 0 ! Azov Sea
	145	ncsi1(2) = 1284 ; ncsj1(2) = 722
	146	ncsi2(2) = 1304 ; ncsj2(2) = 747
	147	ncsir(2,1) = 1 ; ncsjr(2,1) = 1
[888]	148	!
[3]	149	END SELECT
[888]	150	!
[3]	151	ENDIF
	152
	153	! convert the position in local domain indices
	154	! --------------------------------------------
	155	DO jc = 1, jpncs
	156	ncsi1(jc) = mi0( ncsi1(jc) )
	157	ncsj1(jc) = mj0( ncsj1(jc) )
	158
[64]	159	ncsi2(jc) = mi1( ncsi2(jc) )
	160	ncsj2(jc) = mj1( ncsj2(jc) )
[3]	161	END DO
[888]	162	!
[3]	163	END SUBROUTINE dom_clo
	164
	165
[888]	166	SUBROUTINE sbc_clo( kt )
[3]	167	!!---------------------------------------------------------------------
[888]	168	!! * ROUTINE sbc_clo *
[3]	169	!!
	170	!! ** Purpose : Special handling of closed seas
	171	!!
	172	!! ** Method : Water flux is forced to zero over closed sea
	173	!! Excess is shared between remaining ocean, or
	174	!! put as run-off in open ocean.
	175	!!
[888]	176	!! ** Action : emp, emps updated surface freshwater fluxes at kt
[3]	177	!!----------------------------------------------------------------------
[888]	178	INTEGER, INTENT(in) :: kt ! ocean model time step
	179	!
	180	INTEGER :: ji, jj, jc, jn ! dummy loop indices
	181	REAL(wp) :: zze2
[1938]	182	REAL(wp), DIMENSION (jpncs) :: zfwf
	183
[3]	184	!!----------------------------------------------------------------------
[888]	185	!
	186	! !------------------!
	187	IF( kt == nit000 ) THEN ! Initialisation !
	188	! !------------------!
[3]	189	IF(lwp) WRITE(numout,*)
[888]	190	IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
[64]	191	IF(lwp) WRITE(numout,*)'~~~~~~~'
[3]	192
	193	! Total surface of ocean
	194	surf(jpncs+1) = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
	195
	196	DO jc = 1, jpncs
	197	surf(jc) =0.e0
	198	DO jj = ncsj1(jc), ncsj2(jc)
	199	DO ji = ncsi1(jc), ncsi2(jc)
[888]	200	surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) ! surface of closed seas
[3]	201	END DO
	202	END DO
	203	END DO
[32]	204	IF( lk_mpp ) CALL mpp_sum ( surf, jpncs+1 ) ! mpp: sum over all the global domain
[3]	205
	206	IF(lwp) WRITE(numout,*)' Closed sea surfaces'
	207	DO jc = 1, jpncs
[888]	208	IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
[3]	209	END DO
	210
	211	! jpncs+1 : surface of sea, closed seas excluded
	212	DO jc = 1, jpncs
	213	surf(jpncs+1) = surf(jpncs+1) - surf(jc)
	214	END DO
[888]	215	!
[3]	216	ENDIF
[888]	217	! !--------------------!
	218	! ! update emp, emps !
[1938]	219	zfwf = 0.e0 !--------------------!
[3]	220	DO jc = 1, jpncs
	221	DO jj = ncsj1(jc), ncsj2(jc)
	222	DO ji = ncsi1(jc), ncsi2(jc)
[1938]	223	zfwf(jc) = zfwf(jc) + e1t(ji,jj) * e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj)
[3]	224	END DO
	225	END DO
	226	END DO
[1938]	227	IF( lk_mpp ) CALL mpp_sum ( zfwf(:) , jpncs ) ! mpp: sum over all the global domain
[3]	228
	229	IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! Black Sea case for ORCA_R2 configuration
[1938]	230	zze2 = ( zfwf(3) + zfwf(4) ) / 2.
	231	zfwf(3) = zze2
	232	zfwf(4) = zze2
[3]	233	ENDIF
	234
	235	DO jc = 1, jpncs
[888]	236	!
[3]	237	IF( ncstt(jc) == 0 ) THEN
	238	! water/evap excess is shared by all open ocean
[1938]	239	emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
	240	emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
[3]	241	ELSEIF( ncstt(jc) == 1 ) THEN
	242	! Excess water in open sea, at outflow location, excess evap shared
[1938]	243	IF ( zfwf(jc) <= 0.e0 ) THEN
[3]	244	DO jn = 1, ncsnr(jc)
	245	ji = mi0(ncsir(jc,jn))
	246	jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
	247	IF ( ji > 1 .AND. ji < jpi &
	248	.AND. jj > 1 .AND. jj < jpj ) THEN
[1938]	249	emp (ji,jj) = emp (ji,jj) + zfwf(jc) / &
[3]	250	(FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
[1938]	251	emps(ji,jj) = emps(ji,jj) + zfwf(jc) / &
[3]	252	(FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
	253	END IF
	254	END DO
	255	ELSE
[1938]	256	emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
	257	emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
[3]	258	ENDIF
	259	ELSEIF( ncstt(jc) == 2 ) THEN
	260	! Excess e-p+r (either sign) goes to open ocean, at outflow location
	261	IF( ji > 1 .AND. ji < jpi &
	262	.AND. jj > 1 .AND. jj < jpj ) THEN
	263	DO jn = 1, ncsnr(jc)
	264	ji = mi0(ncsir(jc,jn))
	265	jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
[1938]	266	emp (ji,jj) = emp (ji,jj) + zfwf(jc) &
[3]	267	/ (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj) )
[1938]	268	emps(ji,jj) = emps(ji,jj) + zfwf(jc) &
[3]	269	/ (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj) )
	270	END DO
	271	ENDIF
	272	ENDIF
[888]	273	!
[3]	274	DO jj = ncsj1(jc), ncsj2(jc)
	275	DO ji = ncsi1(jc), ncsi2(jc)
[1938]	276	emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc)
	277	emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc)
[3]	278	END DO
	279	END DO
[888]	280	!
[3]	281	END DO
[888]	282	!
[1998]	283	CALL lbc_lnk( emp , 'T', 1. )
	284	CALL lbc_lnk( emps, 'T', 1. )
[888]	285	!
	286	END SUBROUTINE sbc_clo
	287
	288
	289	SUBROUTINE clo_rnf( p_rnfmsk )
	290	!!---------------------------------------------------------------------
	291	!! * ROUTINE sbc_rnf *
	292	!!
	293	!! ** Purpose : allow the treatment of closed sea outflow grid-points
	294	!! to be the same as river mouth grid-points
	295	!!
	296	!! ** Method : set to 1 the runoff mask (mskrnf, see sbcrnf module)
	297	!! at the closed sea outflow grid-point.
	298	!!
	299	!! ** Action : update (p_)mskrnf (set 1 at closed sea outflow)
	300	!!----------------------------------------------------------------------
	301	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_rnfmsk ! river runoff mask (rnfmsk array)
	302	!
	303	INTEGER :: jc, jn ! dummy loop indices
	304	INTEGER :: ii, ij ! temporary integer
	305	!!----------------------------------------------------------------------
	306	!
	307	DO jc = 1, jpncs
	308	IF( ncstt(jc) >= 1 ) THEN ! runoff mask set to 1 at closed sea outflows
	309	DO jn = 1, 4
	310	ii = mi0( ncsir(jc,jn) )
	311	ij = mj0( ncsjr(jc,jn) )
	312	p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 )
	313	END DO
	314	ENDIF
	315	END DO
	316	!
	317	END SUBROUTINE clo_rnf
[3]	318
[888]	319
	320	SUBROUTINE clo_ups( p_upsmsk )
	321	!!---------------------------------------------------------------------
	322	!! * ROUTINE sbc_rnf *
	323	!!
	324	!! ** Purpose : allow the treatment of closed sea outflow grid-points
	325	!! to be the same as river mouth grid-points
	326	!!
	327	!! ** Method : set to 0.5 the upstream mask (upsmsk, see traadv_cen2
	328	!! module) over the closed seas.
	329	!!
	330	!! ** Action : update (p_)upsmsk (set 0.5 over closed seas)
	331	!!----------------------------------------------------------------------
	332	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_upsmsk ! upstream mask (upsmsk array)
	333	!
	334	INTEGER :: jc, ji, jj ! dummy loop indices
	335	!!----------------------------------------------------------------------
	336	!
	337	DO jc = 1, jpncs
	338	DO jj = ncsj1(jc), ncsj2(jc)
	339	DO ji = ncsi1(jc), ncsi2(jc)
	340	p_upsmsk(ji,jj) = 0.5 ! mixed upstream/centered scheme over closed seas
	341	END DO
	342	END DO
	343	END DO
	344	!
	345	END SUBROUTINE clo_ups
	346
	347
	348	SUBROUTINE clo_bat( pbat, kbat )
	349	!!---------------------------------------------------------------------
	350	!! * ROUTINE clo_bat *
	351	!!
	352	!! ** Purpose : suppress closed sea from the domain
	353	!!
	354	!! ** Method : set to 0 the meter and level bathymetry (given in
	355	!! arguments) over the closed seas.
	356	!!
	357	!! ** Action : set pbat=0 and kbat=0 over closed seas
	358	!!----------------------------------------------------------------------
	359	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pbat ! bathymetry in meters (bathy array)
	360	INTEGER , DIMENSION(jpi,jpj), INTENT(inout) :: kbat ! bathymetry in levels (mbathy array)
	361	!
	362	INTEGER :: jc, ji, jj ! dummy loop indices
	363	!!----------------------------------------------------------------------
	364	!
	365	DO jc = 1, jpncs
	366	DO jj = ncsj1(jc), ncsj2(jc)
	367	DO ji = ncsi1(jc), ncsi2(jc)
	368	pbat(ji,jj) = 0.e0
	369	kbat(ji,jj) = 0
	370	END DO
	371	END DO
	372	END DO
	373	!
	374	END SUBROUTINE clo_bat
[3]	375
	376	!!======================================================================
	377	END MODULE closea

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

Download in other formats: