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.

lbcnfd.F90 in NEMO/branches/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Context Navigation

source: NEMO/branches/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90 @ 10761

Last change on this file since 10761 was 10761, checked in by jcastill, 5 years ago
Remove svn keys
File size: 39.6 KB

Rev	Line
[1344]	1	MODULE lbcnfd
	2	!!======================================================================
	3	!! * MODULE lbcnfd *
	4	!! Ocean : north fold boundary conditions
	5	!!======================================================================
[2413]	6	!! History : 3.2 ! 2009-03 (R. Benshila) Original code
[4230]	7	!! 3.5 ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization
[1344]	8	!!----------------------------------------------------------------------
	9
[2413]	10	!!----------------------------------------------------------------------
	11	!! lbc_nfd : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
	12	!! lbc_nfd_3d : lateral boundary condition: North fold treatment for a 3D arrays (lbc_nfd)
	13	!! lbc_nfd_2d : lateral boundary condition: North fold treatment for a 2D arrays (lbc_nfd)
[4230]	14	!! mpp_lbc_nfd_3d : North fold treatment for a 3D arrays optimized for MPP
	15	!! mpp_lbc_nfd_2d : North fold treatment for a 2D arrays optimized for MPP
[2413]	16	!!----------------------------------------------------------------------
	17	USE dom_oce ! ocean space and time domain
	18	USE in_out_manager ! I/O manager
	19
[1344]	20	IMPLICIT NONE
	21	PRIVATE
	22
	23	INTERFACE lbc_nfd
[2413]	24	MODULE PROCEDURE lbc_nfd_3d, lbc_nfd_2d
[1344]	25	END INTERFACE
[6140]	26	!
[4230]	27	INTERFACE mpp_lbc_nfd
	28	MODULE PROCEDURE mpp_lbc_nfd_3d, mpp_lbc_nfd_2d
	29	END INTERFACE
[2287]	30
[6140]	31	PUBLIC lbc_nfd ! north fold conditions
	32	PUBLIC mpp_lbc_nfd ! north fold conditions (parallel case)
[4230]	33
[6140]	34	INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 3 !:
	35	INTEGER, PUBLIC :: nsndto, nfsloop, nfeloop !:
	36	INTEGER, PUBLIC, DIMENSION (jpmaxngh) :: isendto !: processes to which communicate
[4230]	37
[1344]	38	!!----------------------------------------------------------------------
[2287]	39	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	40	!! $Id$
[2413]	41	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[2287]	42	!!----------------------------------------------------------------------
[1344]	43	CONTAINS
	44
	45	SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
	46	!!----------------------------------------------------------------------
	47	!! * routine lbc_nfd_3d *
	48	!!
	49	!! ** Purpose : 3D lateral boundary condition : North fold treatment
[2413]	50	!! without processor exchanges.
[1344]	51	!!
	52	!! ** Method :
	53	!!
[2413]	54	!! ** Action : pt3d with updated values along the north fold
[1344]	55	!!----------------------------------------------------------------------
[2413]	56	CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points
	57	! ! = T , U , V , F , W points
	58	REAL(wp) , INTENT(in ) :: psgn ! control of the sign change
	59	! ! = -1. , the sign is changed if north fold boundary
	60	! ! = 1. , the sign is kept if north fold boundary
	61	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3d ! 3D array on which the boundary condition is applied
	62	!
[1344]	63	INTEGER :: ji, jk
	64	INTEGER :: ijt, iju, ijpj, ijpjm1
[2413]	65	!!----------------------------------------------------------------------
[1344]	66
	67	SELECT CASE ( jpni )
[2413]	68	CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction
	69	CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction
[1344]	70	END SELECT
	71	ijpjm1 = ijpj-1
	72
	73	DO jk = 1, jpk
[2413]	74	!
[1344]	75	SELECT CASE ( npolj )
[2413]	76	!
[1344]	77	CASE ( 3 , 4 ) ! * North fold T-point pivot
[2413]	78	!
[1344]	79	SELECT CASE ( cd_type )
	80	CASE ( 'T' , 'W' ) ! T-, W-point
	81	DO ji = 2, jpiglo
	82	ijt = jpiglo-ji+2
	83	pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
	84	END DO
[4152]	85	pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)
[1344]	86	DO ji = jpiglo/2+1, jpiglo
	87	ijt = jpiglo-ji+2
	88	pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
	89	END DO
	90	CASE ( 'U' ) ! U-point
	91	DO ji = 1, jpiglo-1
	92	iju = jpiglo-ji+1
	93	pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
	94	END DO
[4152]	95	pt3d( 1 ,ijpj,jk) = psgn * pt3d( 2 ,ijpj-2,jk)
	96	pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk)
[1344]	97	DO ji = jpiglo/2, jpiglo-1
	98	iju = jpiglo-ji+1
	99	pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
	100	END DO
	101	CASE ( 'V' ) ! V-point
	102	DO ji = 2, jpiglo
	103	ijt = jpiglo-ji+2
	104	pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
	105	pt3d(ji,ijpj ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
	106	END DO
[4152]	107	pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk)
[1344]	108	CASE ( 'F' ) ! F-point
	109	DO ji = 1, jpiglo-1
	110	iju = jpiglo-ji+1
	111	pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
	112	pt3d(ji,ijpj ,jk) = psgn * pt3d(iju,ijpj-3,jk)
	113	END DO
[4152]	114	pt3d( 1 ,ijpj,jk) = psgn * pt3d( 2 ,ijpj-3,jk)
	115	pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk)
[1344]	116	END SELECT
[2413]	117	!
[1344]	118	CASE ( 5 , 6 ) ! * North fold F-point pivot
[2413]	119	!
[1344]	120	SELECT CASE ( cd_type )
	121	CASE ( 'T' , 'W' ) ! T-, W-point
	122	DO ji = 1, jpiglo
	123	ijt = jpiglo-ji+1
	124	pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
	125	END DO
	126	CASE ( 'U' ) ! U-point
	127	DO ji = 1, jpiglo-1
	128	iju = jpiglo-ji
	129	pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
	130	END DO
[4152]	131	pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)
[1344]	132	CASE ( 'V' ) ! V-point
	133	DO ji = 1, jpiglo
	134	ijt = jpiglo-ji+1
	135	pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
	136	END DO
	137	DO ji = jpiglo/2+1, jpiglo
	138	ijt = jpiglo-ji+1
	139	pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
	140	END DO
	141	CASE ( 'F' ) ! F-point
	142	DO ji = 1, jpiglo-1
	143	iju = jpiglo-ji
	144	pt3d(ji,ijpj ,jk) = psgn * pt3d(iju,ijpj-2,jk)
	145	END DO
[4152]	146	pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)
[1344]	147	DO ji = jpiglo/2+1, jpiglo-1
	148	iju = jpiglo-ji
	149	pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
	150	END DO
	151	END SELECT
[2413]	152	!
[1344]	153	CASE DEFAULT ! * closed : the code probably never go through
[2413]	154	!
[1344]	155	SELECT CASE ( cd_type)
	156	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	157	pt3d(:, 1 ,jk) = 0.e0
	158	pt3d(:,ijpj,jk) = 0.e0
	159	CASE ( 'F' ) ! F-point
	160	pt3d(:,ijpj,jk) = 0.e0
	161	END SELECT
[2413]	162	!
[1344]	163	END SELECT ! npolj
[2413]	164	!
[1344]	165	END DO
[2413]	166	!
[1344]	167	END SUBROUTINE lbc_nfd_3d
	168
	169
	170	SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
	171	!!----------------------------------------------------------------------
	172	!! * routine lbc_nfd_2d *
	173	!!
	174	!! ** Purpose : 2D lateral boundary condition : North fold treatment
	175	!! without processor exchanges.
	176	!!
	177	!! ** Method :
	178	!!
[2413]	179	!! ** Action : pt2d with updated values along the north fold
[1344]	180	!!----------------------------------------------------------------------
[2413]	181	CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points
	182	! ! = T , U , V , F , W points
	183	REAL(wp) , INTENT(in ) :: psgn ! control of the sign change
	184	! ! = -1. , the sign is changed if north fold boundary
	185	! ! = 1. , the sign is kept if north fold boundary
	186	REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied
	187	INTEGER , OPTIONAL , INTENT(in ) :: pr2dj ! number of additional halos
	188	!
[1344]	189	INTEGER :: ji, jl, ipr2dj
	190	INTEGER :: ijt, iju, ijpj, ijpjm1
[2413]	191	!!----------------------------------------------------------------------
[1344]	192
	193	SELECT CASE ( jpni )
[2413]	194	CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction
	195	CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction
[1344]	196	END SELECT
[2413]	197	!
	198	IF( PRESENT(pr2dj) ) THEN ! use of additional halos
[1344]	199	ipr2dj = pr2dj
[2413]	200	IF( jpni > 1 ) ijpj = ijpj + ipr2dj
[1344]	201	ELSE
	202	ipr2dj = 0
	203	ENDIF
[2413]	204	!
[1344]	205	ijpjm1 = ijpj-1
	206
	207
	208	SELECT CASE ( npolj )
[2413]	209	!
[1344]	210	CASE ( 3, 4 ) ! * North fold T-point pivot
[2413]	211	!
[1344]	212	SELECT CASE ( cd_type )
[2413]	213	!
	214	CASE ( 'T' , 'W' ) ! T- , W-points
[1344]	215	DO jl = 0, ipr2dj
	216	DO ji = 2, jpiglo
	217	ijt=jpiglo-ji+2
	218	pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
	219	END DO
	220	END DO
[4152]	221	pt2d(1,ijpj) = psgn * pt2d(3,ijpj-2)
[1344]	222	DO ji = jpiglo/2+1, jpiglo
	223	ijt=jpiglo-ji+2
	224	pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
	225	END DO
	226	CASE ( 'U' ) ! U-point
[2413]	227	DO jl = 0, ipr2dj
[1344]	228	DO ji = 1, jpiglo-1
	229	iju = jpiglo-ji+1
	230	pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
	231	END DO
	232	END DO
[4152]	233	pt2d( 1 ,ijpj ) = psgn * pt2d( 2 ,ijpj-2)
	234	pt2d(jpiglo,ijpj ) = psgn * pt2d(jpiglo-1,ijpj-2)
	235	pt2d(1 ,ijpj-1) = psgn * pt2d(jpiglo ,ijpj-1)
[1344]	236	DO ji = jpiglo/2, jpiglo-1
	237	iju = jpiglo-ji+1
	238	pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
	239	END DO
	240	CASE ( 'V' ) ! V-point
[2413]	241	DO jl = -1, ipr2dj
[1344]	242	DO ji = 2, jpiglo
	243	ijt = jpiglo-ji+2
	244	pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
	245	END DO
	246	END DO
[4152]	247	pt2d( 1 ,ijpj) = psgn * pt2d( 3 ,ijpj-3)
[2413]	248	CASE ( 'F' ) ! F-point
	249	DO jl = -1, ipr2dj
[1344]	250	DO ji = 1, jpiglo-1
	251	iju = jpiglo-ji+1
	252	pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
	253	END DO
	254	END DO
[4152]	255	pt2d( 1 ,ijpj) = psgn * pt2d( 2 ,ijpj-3)
	256	pt2d(jpiglo,ijpj) = psgn * pt2d(jpiglo-1,ijpj-3)
	257	pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)
	258	pt2d( 1 ,ijpj-1) = psgn * pt2d( 2 ,ijpj-2)
[2413]	259	CASE ( 'I' ) ! ice U-V point (I-point)
	260	DO jl = 0, ipr2dj
[1344]	261	pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
	262	DO ji = 3, jpiglo
	263	iju = jpiglo - ji + 3
	264	pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
	265	END DO
	266	END DO
[3294]	267	CASE ( 'J' ) ! first ice U-V point
	268	DO jl =0, ipr2dj
	269	pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
	270	DO ji = 3, jpiglo
	271	iju = jpiglo - ji + 3
	272	pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
	273	END DO
	274	END DO
	275	CASE ( 'K' ) ! second ice U-V point
	276	DO jl =0, ipr2dj
	277	pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
	278	DO ji = 3, jpiglo
	279	iju = jpiglo - ji + 3
	280	pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
	281	END DO
	282	END DO
[1344]	283	END SELECT
[2413]	284	!
[1344]	285	CASE ( 5, 6 ) ! * North fold F-point pivot
[2413]	286	!
[1344]	287	SELECT CASE ( cd_type )
[2413]	288	CASE ( 'T' , 'W' ) ! T-, W-point
[1344]	289	DO jl = 0, ipr2dj
	290	DO ji = 1, jpiglo
	291	ijt = jpiglo-ji+1
	292	pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
	293	END DO
	294	END DO
	295	CASE ( 'U' ) ! U-point
	296	DO jl = 0, ipr2dj
	297	DO ji = 1, jpiglo-1
	298	iju = jpiglo-ji
	299	pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
	300	END DO
	301	END DO
[4152]	302	pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
[1344]	303	CASE ( 'V' ) ! V-point
	304	DO jl = 0, ipr2dj
	305	DO ji = 1, jpiglo
	306	ijt = jpiglo-ji+1
	307	pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
	308	END DO
	309	END DO
	310	DO ji = jpiglo/2+1, jpiglo
	311	ijt = jpiglo-ji+1
	312	pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
	313	END DO
[2413]	314	CASE ( 'F' ) ! F-point
[1344]	315	DO jl = 0, ipr2dj
	316	DO ji = 1, jpiglo-1
	317	iju = jpiglo-ji
	318	pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
	319	END DO
	320	END DO
[4152]	321	pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
[1344]	322	DO ji = jpiglo/2+1, jpiglo-1
	323	iju = jpiglo-ji
	324	pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
	325	END DO
[2413]	326	CASE ( 'I' ) ! ice U-V point (I-point)
[1344]	327	pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
	328	DO jl = 0, ipr2dj
	329	DO ji = 2 , jpiglo-1
	330	ijt = jpiglo - ji + 2
	331	pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
	332	END DO
	333	END DO
[3294]	334	CASE ( 'J' ) ! first ice U-V point
	335	pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
	336	DO jl = 0, ipr2dj
	337	DO ji = 2 , jpiglo-1
	338	ijt = jpiglo - ji + 2
	339	pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl)
	340	END DO
	341	END DO
	342	CASE ( 'K' ) ! second ice U-V point
	343	pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
	344	DO jl = 0, ipr2dj
	345	DO ji = 2 , jpiglo-1
	346	ijt = jpiglo - ji + 2
	347	pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl)
	348	END DO
	349	END DO
[1344]	350	END SELECT
[2413]	351	!
[1344]	352	CASE DEFAULT ! * closed : the code probably never go through
[2413]	353	!
[1344]	354	SELECT CASE ( cd_type)
	355	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	356	pt2d(:, 1:1-ipr2dj ) = 0.e0
	357	pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
	358	CASE ( 'F' ) ! F-point
	359	pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
	360	CASE ( 'I' ) ! ice U-V point
	361	pt2d(:, 1:1-ipr2dj ) = 0.e0
	362	pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
[3294]	363	CASE ( 'J' ) ! first ice U-V point
	364	pt2d(:, 1:1-ipr2dj ) = 0.e0
	365	pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
	366	CASE ( 'K' ) ! second ice U-V point
	367	pt2d(:, 1:1-ipr2dj ) = 0.e0
	368	pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
[1344]	369	END SELECT
[2413]	370	!
[1344]	371	END SELECT
[2413]	372	!
[1344]	373	END SUBROUTINE lbc_nfd_2d
	374
[4230]	375
	376	SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn )
	377	!!----------------------------------------------------------------------
	378	!! * routine mpp_lbc_nfd_3d *
	379	!!
	380	!! ** Purpose : 3D lateral boundary condition : North fold treatment
	381	!! without processor exchanges.
	382	!!
	383	!! ** Method :
	384	!!
	385	!! ** Action : pt3d with updated values along the north fold
	386	!!----------------------------------------------------------------------
	387	CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points
	388	! ! = T , U , V , F , W points
	389	REAL(wp) , INTENT(in ) :: psgn ! control of the sign change
	390	! ! = -1. , the sign is changed if north fold boundary
[6140]	391	! ! = 1. , the sign is kept if north fold boundary
	392	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3dl ! 3D array on which the boundary condition is applied
	393	REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pt3dr ! 3D array on which the boundary condition is applied
[4230]	394	!
	395	INTEGER :: ji, jk
	396	INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
	397	!!----------------------------------------------------------------------
[6140]	398	!
[4230]	399	SELECT CASE ( jpni )
	400	CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction
	401	CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction
	402	END SELECT
	403	ijpjm1 = ijpj-1
	404
	405	!
	406	SELECT CASE ( npolj )
	407	!
	408	CASE ( 3 , 4 ) ! * North fold T-point pivot
	409	!
	410	SELECT CASE ( cd_type )
	411	CASE ( 'T' , 'W' ) ! T-, W-point
[4671]	412	IF (nimpp .ne. 1) THEN
[4230]	413	startloop = 1
	414	ELSE
	415	startloop = 2
	416	ENDIF
	417
	418	DO jk = 1, jpk
	419	DO ji = startloop, nlci
[4671]	420	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[4230]	421	pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
	422	END DO
[4686]	423	IF(nimpp .eq. 1) THEN
	424	pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk)
	425	ENDIF
[4230]	426	END DO
	427
	428	IF(nimpp .ge. (jpiglo/2+1)) THEN
	429	startloop = 1
	430	ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
	431	startloop = jpiglo/2+1 - nimpp + 1
	432	ELSE
	433	startloop = nlci + 1
	434	ENDIF
	435	IF(startloop .le. nlci) THEN
	436	DO jk = 1, jpk
	437	DO ji = startloop, nlci
[4671]	438	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[4230]	439	jia = ji + nimpp - 1
	440	ijta = jpiglo - jia + 2
	441	IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
	442	pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk)
	443	ELSE
	444	pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
	445	ENDIF
	446	END DO
	447	END DO
	448	ENDIF
	449
	450
	451	CASE ( 'U' ) ! U-point
[4671]	452	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	453	endloop = nlci
	454	ELSE
	455	endloop = nlci - 1
	456	ENDIF
	457	DO jk = 1, jpk
	458	DO ji = 1, endloop
[4671]	459	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	460	pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk)
	461	END DO
[4686]	462	IF(nimpp .eq. 1) THEN
	463	pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-2,jk)
	464	ENDIF
	465	IF((nimpp + nlci - 1) .eq. jpiglo) THEN
	466	pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk)
	467	ENDIF
[4230]	468	END DO
	469
[4671]	470	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	471	endloop = nlci
	472	ELSE
	473	endloop = nlci - 1
	474	ENDIF
	475	IF(nimpp .ge. (jpiglo/2)) THEN
	476	startloop = 1
	477	ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
	478	startloop = jpiglo/2 - nimpp + 1
	479	ELSE
	480	startloop = endloop + 1
	481	ENDIF
	482	IF (startloop .le. endloop) THEN
	483	DO jk = 1, jpk
	484	DO ji = startloop, endloop
[4671]	485	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	486	jia = ji + nimpp - 1
	487	ijua = jpiglo - jia + 1
	488	IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
	489	pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk)
	490	ELSE
	491	pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
	492	ENDIF
	493	END DO
	494	END DO
	495	ENDIF
	496
	497	CASE ( 'V' ) ! V-point
[4671]	498	IF (nimpp .ne. 1) THEN
[4230]	499	startloop = 1
	500	ELSE
	501	startloop = 2
	502	ENDIF
	503	DO jk = 1, jpk
	504	DO ji = startloop, nlci
[4671]	505	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[4230]	506	pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
	507	pt3dl(ji,ijpj ,jk) = psgn * pt3dr(ijt,ijpj-3,jk)
	508	END DO
[4686]	509	IF(nimpp .eq. 1) THEN
	510	pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk)
	511	ENDIF
[4230]	512	END DO
	513	CASE ( 'F' ) ! F-point
[4671]	514	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	515	endloop = nlci
	516	ELSE
	517	endloop = nlci - 1
	518	ENDIF
	519	DO jk = 1, jpk
	520	DO ji = 1, endloop
[4671]	521	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	522	pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk)
	523	pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-3,jk)
	524	END DO
[4686]	525	IF(nimpp .eq. 1) THEN
	526	pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-3,jk)
	527	ENDIF
	528	IF((nimpp + nlci - 1) .eq. jpiglo) THEN
	529	pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk)
	530	ENDIF
[4230]	531	END DO
	532	END SELECT
	533	!
	534
	535	CASE ( 5 , 6 ) ! * North fold F-point pivot
	536	!
	537	SELECT CASE ( cd_type )
	538	CASE ( 'T' , 'W' ) ! T-, W-point
	539	DO jk = 1, jpk
	540	DO ji = 1, nlci
[4671]	541	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	542	pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk)
	543	END DO
	544	END DO
	545
	546	CASE ( 'U' ) ! U-point
[4671]	547	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	548	endloop = nlci
	549	ELSE
	550	endloop = nlci - 1
	551	ENDIF
	552	DO jk = 1, jpk
	553	DO ji = 1, endloop
[4671]	554	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
[4230]	555	pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk)
	556	END DO
[4686]	557	IF((nimpp + nlci - 1) .eq. jpiglo) THEN
	558	pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk)
	559	ENDIF
[4230]	560	END DO
	561
	562	CASE ( 'V' ) ! V-point
	563	DO jk = 1, jpk
	564	DO ji = 1, nlci
[4671]	565	ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	566	pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
	567	END DO
	568	END DO
	569
	570	IF(nimpp .ge. (jpiglo/2+1)) THEN
	571	startloop = 1
	572	ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
	573	startloop = jpiglo/2+1 - nimpp + 1
	574	ELSE
	575	startloop = nlci + 1
	576	ENDIF
	577	IF(startloop .le. nlci) THEN
	578	DO jk = 1, jpk
	579	DO ji = startloop, nlci
[4671]	580	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	581	pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
	582	END DO
	583	END DO
	584	ENDIF
	585
	586	CASE ( 'F' ) ! F-point
[4671]	587	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	588	endloop = nlci
	589	ELSE
	590	endloop = nlci - 1
	591	ENDIF
	592	DO jk = 1, jpk
	593	DO ji = 1, endloop
[4671]	594	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
[4230]	595	pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk)
	596	END DO
[4686]	597	IF((nimpp + nlci - 1) .eq. jpiglo) THEN
	598	pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk)
	599	ENDIF
[4230]	600	END DO
	601
[4671]	602	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	603	endloop = nlci
	604	ELSE
	605	endloop = nlci - 1
	606	ENDIF
	607	IF(nimpp .ge. (jpiglo/2+1)) THEN
	608	startloop = 1
	609	ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
	610	startloop = jpiglo/2+1 - nimpp + 1
	611	ELSE
	612	startloop = endloop + 1
	613	ENDIF
	614	IF (startloop .le. endloop) THEN
	615	DO jk = 1, jpk
	616	DO ji = startloop, endloop
[4671]	617	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
[4230]	618	pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
	619	END DO
	620	END DO
	621	ENDIF
	622
	623	END SELECT
	624
	625	CASE DEFAULT ! * closed : the code probably never go through
	626	!
	627	SELECT CASE ( cd_type)
	628	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	629	pt3dl(:, 1 ,jk) = 0.e0
	630	pt3dl(:,ijpj,jk) = 0.e0
	631	CASE ( 'F' ) ! F-point
	632	pt3dl(:,ijpj,jk) = 0.e0
	633	END SELECT
	634	!
	635	END SELECT ! npolj
	636	!
	637	!
	638	END SUBROUTINE mpp_lbc_nfd_3d
	639
	640
	641	SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn )
	642	!!----------------------------------------------------------------------
	643	!! * routine mpp_lbc_nfd_2d *
	644	!!
	645	!! ** Purpose : 2D lateral boundary condition : North fold treatment
	646	!! without processor exchanges.
	647	!!
	648	!! ** Method :
	649	!!
	650	!! ** Action : pt2d with updated values along the north fold
	651	!!----------------------------------------------------------------------
	652	CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points
	653	! ! = T , U , V , F , W points
	654	REAL(wp) , INTENT(in ) :: psgn ! control of the sign change
	655	! ! = -1. , the sign is changed if north fold boundary
	656	! ! = 1. , the sign is kept if north fold boundary
[6140]	657	REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2dl ! 2D array on which the boundary condition is applied
	658	REAL(wp), DIMENSION(:,:), INTENT(in ) :: pt2dr ! 2D array on which the boundary condition is applied
[4230]	659	!
	660	INTEGER :: ji
	661	INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
	662	!!----------------------------------------------------------------------
	663
	664	SELECT CASE ( jpni )
	665	CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction
	666	CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction
	667	END SELECT
	668	!
	669	ijpjm1 = ijpj-1
	670
	671
	672	SELECT CASE ( npolj )
	673	!
	674	CASE ( 3, 4 ) ! * North fold T-point pivot
	675	!
	676	SELECT CASE ( cd_type )
	677	!
	678	CASE ( 'T' , 'W' ) ! T- , W-points
[4671]	679	IF (nimpp .ne. 1) THEN
[4230]	680	startloop = 1
	681	ELSE
	682	startloop = 2
	683	ENDIF
	684	DO ji = startloop, nlci
[4671]	685	ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[4230]	686	pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
	687	END DO
[4686]	688	IF (nimpp .eq. 1) THEN
	689	pt2dl(1,ijpj) = psgn * pt2dl(3,ijpj-2)
	690	ENDIF
[4230]	691
	692	IF(nimpp .ge. (jpiglo/2+1)) THEN
	693	startloop = 1
	694	ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
	695	startloop = jpiglo/2+1 - nimpp + 1
	696	ELSE
	697	startloop = nlci + 1
	698	ENDIF
	699	DO ji = startloop, nlci
[4671]	700	ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[4230]	701	jia = ji + nimpp - 1
	702	ijta = jpiglo - jia + 2
	703	IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
	704	pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1)
	705	ELSE
	706	pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
	707	ENDIF
	708	END DO
	709
	710	CASE ( 'U' ) ! U-point
[4671]	711	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	712	endloop = nlci
	713	ELSE
	714	endloop = nlci - 1
	715	ENDIF
	716	DO ji = 1, endloop
[4671]	717	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	718	pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
	719	END DO
	720
[4686]	721	IF (nimpp .eq. 1) THEN
	722	pt2dl( 1 ,ijpj ) = psgn * pt2dl( 2 ,ijpj-2)
	723	pt2dl(1 ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1)
	724	ENDIF
	725	IF((nimpp + nlci - 1) .eq. jpiglo) THEN
	726	pt2dl(nlci,ijpj ) = psgn * pt2dl(nlci-1,ijpj-2)
	727	ENDIF
	728
[4671]	729	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	730	endloop = nlci
	731	ELSE
	732	endloop = nlci - 1
	733	ENDIF
	734	IF(nimpp .ge. (jpiglo/2)) THEN
	735	startloop = 1
	736	ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
	737	startloop = jpiglo/2 - nimpp + 1
	738	ELSE
	739	startloop = endloop + 1
	740	ENDIF
	741	DO ji = startloop, endloop
[4671]	742	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	743	jia = ji + nimpp - 1
	744	ijua = jpiglo - jia + 1
	745	IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
	746	pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1)
	747	ELSE
	748	pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
	749	ENDIF
	750	END DO
	751
	752	CASE ( 'V' ) ! V-point
[4671]	753	IF (nimpp .ne. 1) THEN
[4230]	754	startloop = 1
	755	ELSE
	756	startloop = 2
	757	ENDIF
	758	DO ji = startloop, nlci
[4671]	759	ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[4230]	760	pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1)
	761	pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2)
	762	END DO
[4686]	763	IF (nimpp .eq. 1) THEN
	764	pt2dl( 1 ,ijpj) = psgn * pt2dl( 3 ,ijpj-3)
	765	ENDIF
[4230]	766
	767	CASE ( 'F' ) ! F-point
[4671]	768	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	769	endloop = nlci
	770	ELSE
	771	endloop = nlci - 1
	772	ENDIF
	773	DO ji = 1, endloop
[4671]	774	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	775	pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1)
	776	pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2)
	777	END DO
[4686]	778	IF (nimpp .eq. 1) THEN
	779	pt2dl( 1 ,ijpj) = psgn * pt2dl( 2 ,ijpj-3)
	780	pt2dl( 1 ,ijpj-1) = psgn * pt2dl( 2 ,ijpj-2)
	781	ENDIF
	782	IF((nimpp + nlci - 1) .eq. jpiglo) THEN
	783	pt2dl(nlci,ijpj) = psgn * pt2dl(nlci-1,ijpj-3)
	784	pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2)
	785	ENDIF
[4230]	786
	787	CASE ( 'I' ) ! ice U-V point (I-point)
[4671]	788	IF (nimpp .ne. 1) THEN
[4230]	789	startloop = 1
	790	ELSE
	791	startloop = 3
	792	pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
	793	ENDIF
	794	DO ji = startloop, nlci
[4671]	795	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
[4230]	796	pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
	797	END DO
	798
	799	CASE ( 'J' ) ! first ice U-V point
[4671]	800	IF (nimpp .ne. 1) THEN
[4230]	801	startloop = 1
	802	ELSE
	803	startloop = 3
[7646]	804	pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
[4230]	805	ENDIF
	806	DO ji = startloop, nlci
[4671]	807	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
[4230]	808	pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
	809	END DO
	810
	811	CASE ( 'K' ) ! second ice U-V point
[4671]	812	IF (nimpp .ne. 1) THEN
[4230]	813	startloop = 1
	814	ELSE
	815	startloop = 3
[7646]	816	pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
[4230]	817	ENDIF
	818	DO ji = startloop, nlci
[4671]	819	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
[4230]	820	pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
	821	END DO
	822
	823	END SELECT
	824	!
	825	CASE ( 5, 6 ) ! * North fold F-point pivot
	826	!
	827	SELECT CASE ( cd_type )
	828	CASE ( 'T' , 'W' ) ! T-, W-point
	829	DO ji = 1, nlci
[4671]	830	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	831	pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)
	832	END DO
	833
	834	CASE ( 'U' ) ! U-point
[4671]	835	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	836	endloop = nlci
	837	ELSE
	838	endloop = nlci - 1
	839	ENDIF
	840	DO ji = 1, endloop
[4671]	841	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
[4230]	842	pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
	843	END DO
[4686]	844	IF((nimpp + nlci - 1) .eq. jpiglo) THEN
	845	pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1)
	846	ENDIF
[4230]	847
	848	CASE ( 'V' ) ! V-point
	849	DO ji = 1, nlci
[4671]	850	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	851	pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
	852	END DO
	853	IF(nimpp .ge. (jpiglo/2+1)) THEN
	854	startloop = 1
	855	ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
	856	startloop = jpiglo/2+1 - nimpp + 1
	857	ELSE
	858	startloop = nlci + 1
	859	ENDIF
	860	DO ji = startloop, nlci
[4671]	861	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
[4230]	862	pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
	863	END DO
	864
	865	CASE ( 'F' ) ! F-point
[4671]	866	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	867	endloop = nlci
	868	ELSE
	869	endloop = nlci - 1
	870	ENDIF
	871	DO ji = 1, endloop
[4671]	872	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
[4230]	873	pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
	874	END DO
[4686]	875	IF((nimpp + nlci - 1) .eq. jpiglo) THEN
	876	pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2)
	877	ENDIF
[4230]	878
[4671]	879	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	880	endloop = nlci
	881	ELSE
	882	endloop = nlci - 1
	883	ENDIF
	884	IF(nimpp .ge. (jpiglo/2+1)) THEN
	885	startloop = 1
	886	ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
	887	startloop = jpiglo/2+1 - nimpp + 1
	888	ELSE
	889	startloop = endloop + 1
	890	ENDIF
	891
	892	DO ji = startloop, endloop
[4671]	893	iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
[4230]	894	pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
	895	END DO
	896
	897	CASE ( 'I' ) ! ice U-V point (I-point)
[4671]	898	IF (nimpp .ne. 1) THEN
[4230]	899	startloop = 1
	900	ELSE
	901	startloop = 2
	902	ENDIF
[4671]	903	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	904	endloop = nlci
	905	ELSE
	906	endloop = nlci - 1
	907	ENDIF
	908	DO ji = startloop , endloop
[4671]	909	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[7646]	910	pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
[4230]	911	END DO
	912
	913	CASE ( 'J' ) ! first ice U-V point
[4671]	914	IF (nimpp .ne. 1) THEN
[4230]	915	startloop = 1
	916	ELSE
	917	startloop = 2
	918	ENDIF
[4671]	919	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	920	endloop = nlci
	921	ELSE
	922	endloop = nlci - 1
	923	ENDIF
	924	DO ji = startloop , endloop
[4671]	925	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[7646]	926	pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1)
[4230]	927	END DO
	928
	929	CASE ( 'K' ) ! second ice U-V point
[4671]	930	IF (nimpp .ne. 1) THEN
[4230]	931	startloop = 1
	932	ELSE
	933	startloop = 2
	934	ENDIF
[4671]	935	IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
[4230]	936	endloop = nlci
	937	ELSE
	938	endloop = nlci - 1
	939	ENDIF
	940	DO ji = startloop, endloop
[4671]	941	ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
[4230]	942	pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1)
	943	END DO
	944
	945	END SELECT
	946	!
	947	CASE DEFAULT ! * closed : the code probably never go through
	948	!
	949	SELECT CASE ( cd_type)
	950	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
	951	pt2dl(:, 1 ) = 0.e0
	952	pt2dl(:,ijpj) = 0.e0
	953	CASE ( 'F' ) ! F-point
	954	pt2dl(:,ijpj) = 0.e0
	955	CASE ( 'I' ) ! ice U-V point
	956	pt2dl(:, 1 ) = 0.e0
	957	pt2dl(:,ijpj) = 0.e0
	958	CASE ( 'J' ) ! first ice U-V point
	959	pt2dl(:, 1 ) = 0.e0
	960	pt2dl(:,ijpj) = 0.e0
	961	CASE ( 'K' ) ! second ice U-V point
	962	pt2dl(:, 1 ) = 0.e0
	963	pt2dl(:,ijpj) = 0.e0
	964	END SELECT
	965	!
	966	END SELECT
	967	!
	968	END SUBROUTINE mpp_lbc_nfd_2d
	969
[6140]	970	!!======================================================================
[1344]	971	END MODULE lbcnfd

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

Download in other formats: