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/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Context Navigation

source: branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 4015

Last change on this file since 4015 was 4015, checked in by cetlod, 11 years ago
2013/dev_r3940_CNRS4_IOCRS: 1st step, add new routines for outputs coarsening
Property svn:keywords set to `Id`
File size: 21.2 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	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
[3680]	283	SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
	284	!!---------------------------------------------------------------------
	285	!! * ROUTINE lbc_bdy_lnk *
	286	!!
	287	!! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
	288	!! to maintain the same interface with regards to the mpp case
	289	!!
	290	!!----------------------------------------------------------------------
	291	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	292	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied
	293	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	294	INTEGER :: ib_bdy ! BDY boundary set
	295	!!
	296	CALL lbc_lnk_3d( pt3d, cd_type, psgn)
[3]	297
[3680]	298	END SUBROUTINE lbc_bdy_lnk_3d
	299
	300	SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
	301	!!---------------------------------------------------------------------
	302	!! * ROUTINE lbc_bdy_lnk *
	303	!!
	304	!! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
	305	!! to maintain the same interface with regards to the mpp case
	306	!!
	307	!!----------------------------------------------------------------------
	308	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	309	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 3D array on which the lbc is applied
	310	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	311	INTEGER :: ib_bdy ! BDY boundary set
	312	!!
	313	CALL lbc_lnk_2d( pt2d, cd_type, psgn)
	314
	315	END SUBROUTINE lbc_bdy_lnk_2d
	316
[888]	317	SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
[3]	318	!!---------------------------------------------------------------------
	319	!! * ROUTINE lbc_lnk_2d *
	320	!!
[2335]	321	!! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case)
[3]	322	!!
[2335]	323	!! ** Method : psign = -1 : change the sign across the north fold
	324	!! = 1 : no change of the sign across the north fold
	325	!! = 0 : no change of the sign across the north fold and
	326	!! strict positivity preserved: use inner row/column
	327	!! for closed boundaries.
	328	!!----------------------------------------------------------------------
	329	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
[2339]	330	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied
[2335]	331	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	332	CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing)
	333	REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries)
[3]	334	!!
[2335]	335	REAL(wp) :: zland
[3]	336	!!----------------------------------------------------------------------
	337
[2335]	338	IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default)
[3764]	339	ELSE ; zland = 0._wp
[888]	340	ENDIF
	341
[473]	342	IF (PRESENT(cd_mpp)) THEN
	343	! only fill the overlap area and extra allows
	344	! this is in mpp case. In this module, just do nothing
	345	ELSE
[2335]	346	!
[1344]	347	! ! East-West boundaries
	348	! ! ====================
	349	SELECT CASE ( nperio )
	350	!
	351	CASE ( 1 , 4 , 6 ) !** cyclic east-west
	352	pt2d( 1 ,:) = pt2d(jpim1,:) ! all points
	353	pt2d(jpi,:) = pt2d( 2 ,:)
	354	!
	355	CASE DEFAULT !** East closed -- West closed
	356	SELECT CASE ( cd_type )
	357	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	358	pt2d( 1 ,:) = zland
	359	pt2d(jpi,:) = zland
	360	CASE ( 'F' ) ! F-point
	361	pt2d(jpi,:) = zland
	362	END SELECT
	363	!
[3]	364	END SELECT
[2335]	365	!
[1344]	366	! ! North-South boundaries
	367	! ! ======================
	368	SELECT CASE ( nperio )
	369	!
	370	CASE ( 2 ) !** South symmetric -- North closed
	371	SELECT CASE ( cd_type )
	372	CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points
	373	pt2d(:, 1 ) = pt2d(:,3)
	374	pt2d(:,jpj) = zland
	375	CASE ( 'V' , 'F' ) ! V-, F-points
	376	pt2d(:, 1 ) = psgn * pt2d(:,2)
	377	pt2d(:,jpj) = zland
	378	END SELECT
	379	!
	380	CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed
	381	SELECT CASE ( cd_type ) ! South : closed
	382	CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point
	383	pt2d(:, 1 ) = zland
	384	END SELECT
	385	! ! North fold
	386	CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
	387	!
	388	CASE DEFAULT !** North closed -- South closed
	389	SELECT CASE ( cd_type )
	390	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	391	pt2d(:, 1 ) = zland
	392	pt2d(:,jpj) = zland
	393	CASE ( 'F' ) ! F-point
	394	pt2d(:,jpj) = zland
	395	END SELECT
	396	!
[3]	397	END SELECT
[2335]	398	!
[473]	399	ENDIF
[2335]	400	!
[3]	401	END SUBROUTINE lbc_lnk_2d
	402
[3609]	403	SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
	404	!!---------------------------------------------------------------------
	405	!! * ROUTINE lbc_lnk_2d *
	406	!!
	407	!! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case)
	408	!! special dummy routine to allow for use of halo indexing in mpp case
	409	!!
	410	!! ** Method : psign = -1 : change the sign across the north fold
	411	!! = 1 : no change of the sign across the north fold
	412	!! = 0 : no change of the sign across the north fold and
	413	!! strict positivity preserved: use inner row/column
	414	!! for closed boundaries.
	415	!!----------------------------------------------------------------------
	416	CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points
	417	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied
	418	REAL(wp) , INTENT(in ) :: psgn ! control of the sign
	419	INTEGER , INTENT(in ) :: jpri ! size of extra halo (not needed in non-mpp)
	420	INTEGER , INTENT(in ) :: jprj ! size of extra halo (not needed in non-mpp)
	421	!!----------------------------------------------------------------------
	422
	423	CALL lbc_lnk_2d( pt2d, cd_type, psgn )
	424	!
	425	END SUBROUTINE lbc_lnk_2d_e
	426
[3768]	427	# endif
[3]	428	#endif
	429
	430	!!======================================================================
	431	END MODULE lbclnk

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

Download in other formats: