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/2014/dev_r4743_NOC2_ZTS/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Context Navigation

source: branches/2014/dev_r4743_NOC2_ZTS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 4891

Last change on this file since 4891 was 4891, checked in by acc, 10 years ago
Branch 2014/dev_r4743_NOC2_ZTS. Added fixes for ICB (icebergs) option to enable correct exchange of icb arrays across the north fold. These fixes also enable ICB to be used with land suppression. Optimisation of the exchanges for the ln_nnogather option has not yet been done. A Python utility (TOOLS/MISCELLANEOUS/icb_pp.py) is included to help collate iceberg trajectory output.
Property svn:keywords set to `Id`
File size: 20.9 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
[15]	21	!!----------------------------------------------------------------------
[3]	22	USE lib_mpp ! distributed memory computing library
	23
	24	INTERFACE lbc_lnk
[473]	25	MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
[3]	26	END INTERFACE
	27
[3680]	28	INTERFACE lbc_bdy_lnk
	29	MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
	30	END INTERFACE
	31
[311]	32	INTERFACE lbc_lnk_e
	33	MODULE PROCEDURE mpp_lnk_2d_e
	34	END INTERFACE
	35
[4891]	36	INTERFACE lbc_lnk_icb
	37	MODULE PROCEDURE mpp_lnk_2d_icb
	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
[4891]	43	PUBLIC lbc_lnk_icb
[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
[3]	59	!!----------------------------------------------------------------------
	60	USE oce ! ocean dynamics and tracers
	61	USE dom_oce ! ocean space and time domain
	62	USE in_out_manager ! I/O manager
[1344]	63	USE lbcnfd ! north fold
[3]	64
	65	IMPLICIT NONE
	66	PRIVATE
	67
	68	INTERFACE lbc_lnk
[473]	69	MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
[3]	70	END INTERFACE
	71
[311]	72	INTERFACE lbc_lnk_e
[3609]	73	MODULE PROCEDURE lbc_lnk_2d_e
[311]	74	END INTERFACE
	75
[3680]	76	INTERFACE lbc_bdy_lnk
	77	MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
	78	END INTERFACE
	79
[4891]	80	INTERFACE lbc_lnk_icb
	81	MODULE PROCEDURE lbc_lnk_2d_e
	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
[4891]	87	PUBLIC lbc_lnk_icb
[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	CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
	267	!
	268	CASE DEFAULT !** North closed -- South closed
[3]	269	SELECT CASE ( cd_type )
[1344]	270	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	271	pt3d(:, 1 ,:) = zland
	272	pt3d(:,jpj,:) = zland
[3]	273	CASE ( 'F' ) ! F-point
[1344]	274	pt3d(:,jpj,:) = zland
[3]	275	END SELECT
[1344]	276	!
	277	END SELECT
[2335]	278	!
[1344]	279	ENDIF
[2335]	280	!
[3]	281	END SUBROUTINE lbc_lnk_3d
	282
[888]	283	SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
[3]	284	!!---------------------------------------------------------------------
	285	!! * ROUTINE lbc_lnk_2d *
	286	!!
[2335]	287	!! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case)
[3]	288	!!
[2335]	289	!! ** Method : psign = -1 : change the sign across the north fold
	290	!! = 1 : no change of the sign across the north fold
	291	!! = 0 : no change of the sign across the north fold and
	292	!! strict positivity preserved: use inner row/column
	293	!! for closed boundaries.
	294	!!----------------------------------------------------------------------
	295	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
[2339]	296	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied
[2335]	297	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	298	CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing)
	299	REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries)
[3]	300	!!
[2335]	301	REAL(wp) :: zland
[3]	302	!!----------------------------------------------------------------------
	303
[2335]	304	IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default)
[3764]	305	ELSE ; zland = 0._wp
[888]	306	ENDIF
	307
[473]	308	IF (PRESENT(cd_mpp)) THEN
	309	! only fill the overlap area and extra allows
	310	! this is in mpp case. In this module, just do nothing
	311	ELSE
[2335]	312	!
[1344]	313	! ! East-West boundaries
	314	! ! ====================
	315	SELECT CASE ( nperio )
	316	!
	317	CASE ( 1 , 4 , 6 ) !** cyclic east-west
	318	pt2d( 1 ,:) = pt2d(jpim1,:) ! all points
	319	pt2d(jpi,:) = pt2d( 2 ,:)
	320	!
	321	CASE DEFAULT !** East closed -- West closed
	322	SELECT CASE ( cd_type )
	323	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	324	pt2d( 1 ,:) = zland
	325	pt2d(jpi,:) = zland
	326	CASE ( 'F' ) ! F-point
	327	pt2d(jpi,:) = zland
	328	END SELECT
	329	!
[3]	330	END SELECT
[2335]	331	!
[1344]	332	! ! North-South boundaries
	333	! ! ======================
	334	SELECT CASE ( nperio )
	335	!
	336	CASE ( 2 ) !** South symmetric -- North closed
	337	SELECT CASE ( cd_type )
	338	CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points
	339	pt2d(:, 1 ) = pt2d(:,3)
	340	pt2d(:,jpj) = zland
	341	CASE ( 'V' , 'F' ) ! V-, F-points
	342	pt2d(:, 1 ) = psgn * pt2d(:,2)
	343	pt2d(:,jpj) = zland
	344	END SELECT
	345	!
	346	CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed
	347	SELECT CASE ( cd_type ) ! South : closed
	348	CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point
	349	pt2d(:, 1 ) = zland
	350	END SELECT
	351	! ! North fold
	352	CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
	353	!
	354	CASE DEFAULT !** North closed -- South closed
	355	SELECT CASE ( cd_type )
	356	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	357	pt2d(:, 1 ) = zland
	358	pt2d(:,jpj) = zland
	359	CASE ( 'F' ) ! F-point
	360	pt2d(:,jpj) = zland
	361	END SELECT
	362	!
[3]	363	END SELECT
[2335]	364	!
[473]	365	ENDIF
[2335]	366	!
[3]	367	END SUBROUTINE lbc_lnk_2d
	368
[4153]	369	#endif
	370
	371
	372	SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
	373	!!---------------------------------------------------------------------
	374	!! * ROUTINE lbc_bdy_lnk *
	375	!!
	376	!! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
	377	!! to maintain the same interface with regards to the mpp
	378	!case
	379	!!
	380	!!----------------------------------------------------------------------
	381	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	382	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied
	383	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	384	INTEGER :: ib_bdy ! BDY boundary set
	385	!!
	386	CALL lbc_lnk_3d( pt3d, cd_type, psgn)
	387
	388	END SUBROUTINE lbc_bdy_lnk_3d
	389
	390	SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
	391	!!---------------------------------------------------------------------
	392	!! * ROUTINE lbc_bdy_lnk *
	393	!!
	394	!! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
	395	!! to maintain the same interface with regards to the mpp
	396	!case
	397	!!
	398	!!----------------------------------------------------------------------
	399	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	400	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 3D array on which the lbc is applied
	401	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	402	INTEGER :: ib_bdy ! BDY boundary set
	403	!!
	404	CALL lbc_lnk_2d( pt2d, cd_type, psgn)
	405
	406	END SUBROUTINE lbc_bdy_lnk_2d
	407
	408
[3609]	409	SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
	410	!!---------------------------------------------------------------------
	411	!! * ROUTINE lbc_lnk_2d *
	412	!!
	413	!! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case)
	414	!! special dummy routine to allow for use of halo indexing in mpp case
	415	!!
	416	!! ** Method : psign = -1 : change the sign across the north fold
	417	!! = 1 : no change of the sign across the north fold
	418	!! = 0 : no change of the sign across the north fold and
	419	!! strict positivity preserved: use inner row/column
	420	!! for closed boundaries.
	421	!!----------------------------------------------------------------------
	422	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	423	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied
	424	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	425	INTEGER , INTENT(in ) :: jpri ! size of extra halo (not needed in non-mpp)
	426	INTEGER , INTENT(in ) :: jprj ! size of extra halo (not needed in non-mpp)
	427	!!----------------------------------------------------------------------
	428
	429	CALL lbc_lnk_2d( pt2d, cd_type, psgn )
	430	!
	431	END SUBROUTINE lbc_lnk_2d_e
	432
[3]	433	#endif
	434
	435	!!======================================================================
	436	END MODULE lbclnk

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

Download in other formats: