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.

lbclnk.F90 in branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Context Navigation

source: branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 3768

Last change on this file since 3768 was 3768, checked in by smasson, 11 years ago
dev_MERGE_2012: bugfix related to r3764
Property svn:keywords set to `Id`
File size: 21.3 KB

Rev	Line
[3]	1	MODULE lbclnk
	2	!!======================================================================
[232]	3	!! * MODULE lbclnk *
[3]	4	!! Ocean : lateral boundary conditions
	5	!!=====================================================================
[2335]	6	!! History : OPA ! 1997-06 (G. Madec) Original code
	7	!! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module
	8	!! 3.2 ! 2009-03 (R. Benshila) External north fold treatment
[3680]	9	!! 3.5 ! 2012 (S.Mocavero, I. Epicoco) Add 'lbc_bdy_lnk'
	10	!! and lbc_obc_lnk' routine to optimize
	11	!! the BDY/OBC communications
[3764]	12	!! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add a C1D case
[1344]	13	!!----------------------------------------------------------------------
[3764]	14	#if defined key_mpp_mpi
[3]	15	!!----------------------------------------------------------------------
[2335]	16	!! 'key_mpp_mpi' MPI massively parallel processing library
[3]	17	!!----------------------------------------------------------------------
[2335]	18	!! lbc_lnk : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
	19	!! lbc_lnk_e : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
[3680]	20	!! lbc_bdy_lnk : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
	21	!! lbc_obc_lnk : generic interface for mpp_lnk_obc_2d and mpp_lnk_obc_3d routines defined in lib_mpp
[15]	22	!!----------------------------------------------------------------------
[3]	23	USE lib_mpp ! distributed memory computing library
	24
	25	INTERFACE lbc_lnk
[473]	26	MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
[3]	27	END INTERFACE
	28
[3680]	29	INTERFACE lbc_bdy_lnk
	30	MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
	31	END INTERFACE
	32	INTERFACE lbc_obc_lnk
	33	MODULE PROCEDURE mpp_lnk_obc_2d, mpp_lnk_obc_3d
	34	END INTERFACE
	35
[311]	36	INTERFACE lbc_lnk_e
	37	MODULE PROCEDURE mpp_lnk_2d_e
	38	END INTERFACE
	39
[3]	40	PUBLIC lbc_lnk ! ocean lateral boundary conditions
[311]	41	PUBLIC lbc_lnk_e
[3680]	42	PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions
	43	PUBLIC lbc_obc_lnk ! ocean lateral BDY boundary conditions
[2335]	44
[3]	45	!!----------------------------------------------------------------------
[2335]	46	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	47	!! $Id$
	48	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	49	!!----------------------------------------------------------------------
[3]	50
	51	#else
	52	!!----------------------------------------------------------------------
	53	!! Default option shared memory computing
	54	!!----------------------------------------------------------------------
	55	!! lbc_lnk : generic interface for lbc_lnk_3d and lbc_lnk_2d
[2335]	56	!! lbc_lnk_3d : set the lateral boundary condition on a 3D variable on ocean mesh
	57	!! lbc_lnk_2d : set the lateral boundary condition on a 2D variable on ocean mesh
[3680]	58	!! lbc_bdy_lnk : set the lateral BDY boundary condition
	59	!! lbc_obc_lnk : set the lateral OBC boundary condition
[3]	60	!!----------------------------------------------------------------------
	61	USE oce ! ocean dynamics and tracers
	62	USE dom_oce ! ocean space and time domain
	63	USE in_out_manager ! I/O manager
[1344]	64	USE lbcnfd ! north fold
[3]	65
	66	IMPLICIT NONE
	67	PRIVATE
	68
	69	INTERFACE lbc_lnk
[473]	70	MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
[3]	71	END INTERFACE
	72
[311]	73	INTERFACE lbc_lnk_e
[3609]	74	MODULE PROCEDURE lbc_lnk_2d_e
[311]	75	END INTERFACE
	76
[3680]	77	INTERFACE lbc_bdy_lnk
	78	MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
	79	END INTERFACE
	80	INTERFACE lbc_obc_lnk
	81	MODULE PROCEDURE lbc_lnk_2d, lbc_lnk_3d
	82	END INTERFACE
	83
[2335]	84	PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions
	85	PUBLIC lbc_lnk_e
[3680]	86	PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions
	87	PUBLIC lbc_obc_lnk ! ocean lateral OBC boundary conditions
[2335]	88
[3]	89	!!----------------------------------------------------------------------
[2335]	90	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	91	!! $Id$
	92	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	93	!!----------------------------------------------------------------------
[3]	94	CONTAINS
	95
[3764]	96	# if defined key_c1d
	97	!!----------------------------------------------------------------------
	98	!! 'key_c1d' 1D configuration
	99	!!----------------------------------------------------------------------
	100
[473]	101	SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
[3]	102	!!---------------------------------------------------------------------
[473]	103	!! * ROUTINE lbc_lnk_3d_gather *
	104	!!
[3764]	105	!! ** Purpose : set lateral boundary conditions on two 3D arrays (C1D case)
	106	!!
	107	!! ** Method : call lbc_lnk_3d on pt3d1 and pt3d2
	108	!!----------------------------------------------------------------------
	109	CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! nature of pt3d grid-points
	110	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied
	111	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	112	!!----------------------------------------------------------------------
	113	!
	114	CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
	115	CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
	116	!
	117	END SUBROUTINE lbc_lnk_3d_gather
	118
	119
	120	SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
	121	!!---------------------------------------------------------------------
	122	!! * ROUTINE lbc_lnk_3d *
	123	!!
	124	!! ** Purpose : set lateral boundary conditions on a 3D array (C1D case)
	125	!!
	126	!! ** Method : 1D case, the central water column is set everywhere
	127	!!----------------------------------------------------------------------
	128	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	129	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied
	130	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	131	CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing)
	132	REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries)
	133	!
	134	INTEGER :: jk ! dummy loop index
	135	REAL(wp) :: ztab ! local scalar
	136	!!----------------------------------------------------------------------
	137	!
	138	DO jk = 1, jpk
	139	ztab = pt3d(2,2,jk)
	140	pt3d(:,:,jk) = ztab
	141	END DO
	142	!
	143	END SUBROUTINE lbc_lnk_3d
	144
	145
	146	SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
	147	!!---------------------------------------------------------------------
	148	!! * ROUTINE lbc_lnk_2d *
	149	!!
	150	!! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case)
	151	!!
	152	!! ** Method : 1D case, the central water column is set everywhere
	153	!!----------------------------------------------------------------------
	154	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	155	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied
	156	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	157	CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing)
	158	REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries)
	159	!
	160	REAL(wp) :: ztab ! local scalar
	161	!!----------------------------------------------------------------------
	162	!
	163	ztab = pt2d(2,2)
	164	pt2d(:,:) = ztab
	165	!
	166	END SUBROUTINE lbc_lnk_2d
	167
	168	#else
	169	!!----------------------------------------------------------------------
	170	!! Default option 3D shared memory computing
	171	!!----------------------------------------------------------------------
	172
	173	SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
	174	!!---------------------------------------------------------------------
	175	!! * ROUTINE lbc_lnk_3d_gather *
	176	!!
[2335]	177	!! ** Purpose : set lateral boundary conditions on two 3D arrays (non mpp case)
[473]	178	!!
[2335]	179	!! ** Method : psign = -1 : change the sign across the north fold
	180	!! = 1 : no change of the sign across the north fold
	181	!! = 0 : no change of the sign across the north fold and
	182	!! strict positivity preserved: use inner row/column
	183	!! for closed boundaries.
[473]	184	!!----------------------------------------------------------------------
[2335]	185	CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! nature of pt3d grid-points
	186	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied
	187	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	188	!!----------------------------------------------------------------------
	189	!
[1344]	190	CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
	191	CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
[2335]	192	!
[473]	193	END SUBROUTINE lbc_lnk_3d_gather
	194
	195
[888]	196	SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
[473]	197	!!---------------------------------------------------------------------
[3]	198	!! * ROUTINE lbc_lnk_3d *
	199	!!
[2335]	200	!! ** Purpose : set lateral boundary conditions on a 3D array (non mpp case)
[3]	201	!!
[2335]	202	!! ** Method : psign = -1 : change the sign across the north fold
	203	!! = 1 : no change of the sign across the north fold
	204	!! = 0 : no change of the sign across the north fold and
	205	!! strict positivity preserved: use inner row/column
	206	!! for closed boundaries.
	207	!!----------------------------------------------------------------------
	208	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	209	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied
	210	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	211	CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing)
	212	REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries)
[3]	213	!!
[2335]	214	REAL(wp) :: zland
[3]	215	!!----------------------------------------------------------------------
	216
[2335]	217	IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default)
[3764]	218	ELSE ; zland = 0._wp
[888]	219	ENDIF
	220
	221
	222	IF( PRESENT( cd_mpp ) ) THEN
[473]	223	! only fill the overlap area and extra allows
	224	! this is in mpp case. In this module, just do nothing
	225	ELSE
[2335]	226	!
[1344]	227	! ! East-West boundaries
	228	! ! ======================
[3]	229	SELECT CASE ( nperio )
[1344]	230	!
	231	CASE ( 1 , 4 , 6 ) !** cyclic east-west
	232	pt3d( 1 ,:,:) = pt3d(jpim1,:,:) ! all points
	233	pt3d(jpi,:,:) = pt3d( 2 ,:,:)
	234	!
	235	CASE DEFAULT !** East closed -- West closed
[3]	236	SELECT CASE ( cd_type )
	237	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
[1344]	238	pt3d( 1 ,:,:) = zland
	239	pt3d(jpi,:,:) = zland
[3]	240	CASE ( 'F' ) ! F-point
[1344]	241	pt3d(jpi,:,:) = zland
[3]	242	END SELECT
[1344]	243	!
[3]	244	END SELECT
[2335]	245	!
[3]	246	! ! North-South boundaries
	247	! ! ======================
	248	SELECT CASE ( nperio )
[1344]	249	!
	250	CASE ( 2 ) !** South symmetric -- North closed
[3]	251	SELECT CASE ( cd_type )
	252	CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points
[1344]	253	pt3d(:, 1 ,:) = pt3d(:,3,:)
	254	pt3d(:,jpj,:) = zland
[3]	255	CASE ( 'V' , 'F' ) ! V-, F-points
[1344]	256	pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
	257	pt3d(:,jpj,:) = zland
[3]	258	END SELECT
[1344]	259	!
	260	CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed
	261	SELECT CASE ( cd_type ) ! South : closed
	262	CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point
	263	pt3d(:, 1 ,:) = zland
[3]	264	END SELECT
[1344]	265	! ! North fold
	266	pt3d( 1 ,jpj,:) = zland
	267	pt3d(jpi,jpj,:) = zland
	268	CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
	269	!
	270	CASE DEFAULT !** North closed -- South closed
[3]	271	SELECT CASE ( cd_type )
[1344]	272	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	273	pt3d(:, 1 ,:) = zland
	274	pt3d(:,jpj,:) = zland
[3]	275	CASE ( 'F' ) ! F-point
[1344]	276	pt3d(:,jpj,:) = zland
[3]	277	END SELECT
[1344]	278	!
	279	END SELECT
[2335]	280	!
[1344]	281	ENDIF
[2335]	282	!
[3]	283	END SUBROUTINE lbc_lnk_3d
	284
[3680]	285	SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
	286	!!---------------------------------------------------------------------
	287	!! * ROUTINE lbc_bdy_lnk *
	288	!!
	289	!! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
	290	!! to maintain the same interface with regards to the mpp case
	291	!!
	292	!!----------------------------------------------------------------------
	293	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	294	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied
	295	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	296	INTEGER :: ib_bdy ! BDY boundary set
	297	!!
	298	CALL lbc_lnk_3d( pt3d, cd_type, psgn)
[3]	299
[3680]	300	END SUBROUTINE lbc_bdy_lnk_3d
	301
	302	SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
	303	!!---------------------------------------------------------------------
	304	!! * ROUTINE lbc_bdy_lnk *
	305	!!
	306	!! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
	307	!! to maintain the same interface with regards to the mpp case
	308	!!
	309	!!----------------------------------------------------------------------
	310	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	311	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 3D array on which the lbc is applied
	312	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	313	INTEGER :: ib_bdy ! BDY boundary set
	314	!!
	315	CALL lbc_lnk_2d( pt2d, cd_type, psgn)
	316
	317	END SUBROUTINE lbc_bdy_lnk_2d
	318
[888]	319	SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
[3]	320	!!---------------------------------------------------------------------
	321	!! * ROUTINE lbc_lnk_2d *
	322	!!
[2335]	323	!! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case)
[3]	324	!!
[2335]	325	!! ** Method : psign = -1 : change the sign across the north fold
	326	!! = 1 : no change of the sign across the north fold
	327	!! = 0 : no change of the sign across the north fold and
	328	!! strict positivity preserved: use inner row/column
	329	!! for closed boundaries.
	330	!!----------------------------------------------------------------------
	331	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
[2339]	332	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied
[2335]	333	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	334	CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing)
	335	REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries)
[3]	336	!!
[2335]	337	REAL(wp) :: zland
[3]	338	!!----------------------------------------------------------------------
	339
[2335]	340	IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default)
[3764]	341	ELSE ; zland = 0._wp
[888]	342	ENDIF
	343
[473]	344	IF (PRESENT(cd_mpp)) THEN
	345	! only fill the overlap area and extra allows
	346	! this is in mpp case. In this module, just do nothing
	347	ELSE
[2335]	348	!
[1344]	349	! ! East-West boundaries
	350	! ! ====================
	351	SELECT CASE ( nperio )
	352	!
	353	CASE ( 1 , 4 , 6 ) !** cyclic east-west
	354	pt2d( 1 ,:) = pt2d(jpim1,:) ! all points
	355	pt2d(jpi,:) = pt2d( 2 ,:)
	356	!
	357	CASE DEFAULT !** East closed -- West closed
	358	SELECT CASE ( cd_type )
	359	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	360	pt2d( 1 ,:) = zland
	361	pt2d(jpi,:) = zland
	362	CASE ( 'F' ) ! F-point
	363	pt2d(jpi,:) = zland
	364	END SELECT
	365	!
[3]	366	END SELECT
[2335]	367	!
[1344]	368	! ! North-South boundaries
	369	! ! ======================
	370	SELECT CASE ( nperio )
	371	!
	372	CASE ( 2 ) !** South symmetric -- North closed
	373	SELECT CASE ( cd_type )
	374	CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points
	375	pt2d(:, 1 ) = pt2d(:,3)
	376	pt2d(:,jpj) = zland
	377	CASE ( 'V' , 'F' ) ! V-, F-points
	378	pt2d(:, 1 ) = psgn * pt2d(:,2)
	379	pt2d(:,jpj) = zland
	380	END SELECT
	381	!
	382	CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed
	383	SELECT CASE ( cd_type ) ! South : closed
	384	CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point
	385	pt2d(:, 1 ) = zland
	386	END SELECT
	387	! ! North fold
	388	pt2d( 1 ,1 ) = zland
	389	pt2d( 1 ,jpj) = zland
	390	pt2d(jpi,jpj) = zland
	391	CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
	392	!
	393	CASE DEFAULT !** North closed -- South closed
	394	SELECT CASE ( cd_type )
	395	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	396	pt2d(:, 1 ) = zland
	397	pt2d(:,jpj) = zland
	398	CASE ( 'F' ) ! F-point
	399	pt2d(:,jpj) = zland
	400	END SELECT
	401	!
[3]	402	END SELECT
[2335]	403	!
[473]	404	ENDIF
[2335]	405	!
[3]	406	END SUBROUTINE lbc_lnk_2d
	407
[3609]	408	SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
	409	!!---------------------------------------------------------------------
	410	!! * ROUTINE lbc_lnk_2d *
	411	!!
	412	!! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case)
	413	!! special dummy routine to allow for use of halo indexing in mpp case
	414	!!
	415	!! ** Method : psign = -1 : change the sign across the north fold
	416	!! = 1 : no change of the sign across the north fold
	417	!! = 0 : no change of the sign across the north fold and
	418	!! strict positivity preserved: use inner row/column
	419	!! for closed boundaries.
	420	!!----------------------------------------------------------------------
	421	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	422	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied
	423	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	424	INTEGER , INTENT(in ) :: jpri ! size of extra halo (not needed in non-mpp)
	425	INTEGER , INTENT(in ) :: jprj ! size of extra halo (not needed in non-mpp)
	426	!!----------------------------------------------------------------------
	427
	428	CALL lbc_lnk_2d( pt2d, cd_type, psgn )
	429	!
	430	END SUBROUTINE lbc_lnk_2d_e
	431
[3768]	432	# endif
[3]	433	#endif
	434
	435	!!======================================================================
	436	END MODULE lbclnk

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

Download in other formats: