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.

lbc_nfd_ext_generic.h90 in NEMO/trunk/src/OCE/LBC – NEMO

Context Navigation

source: NEMO/trunk/src/OCE/LBC/lbc_nfd_ext_generic.h90 @ 13226

Last change on this file since 13226 was 13226, checked in by orioltp, 4 years ago
Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk
Property svn:keywords set to `Id` Property svn:mime-type set to `text/x-fortran`
File size: 7.2 KB

Line
1	! !== IN: ptab is an array ==!
2	#define NAT_IN(k) cd_nat
3	#define SGN_IN(k) psgn
4	#define F_SIZE(ptab) 1
5	#if defined DIM_2d
6	# define ARRAY_IN(i,j,k,l,f) ptab(i,j)
7	# define K_SIZE(ptab) 1
8	# define L_SIZE(ptab) 1
9	#endif
10	#if defined SINGLE_PRECISION
11	# define ARRAY_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
12	# define PRECISION sp
13	#else
14	# define ARRAY_TYPE(i,j,k,l,f) REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
15	# define PRECISION dp
16	#endif
17
18	SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj )
19	!!----------------------------------------------------------------------
20	INTEGER , INTENT(in ) :: kextj ! extra halo width at north fold, declared before its use in ARRAY_TYPE
21	ARRAY_TYPE(:,1-kextj:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied
22	CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points
23	REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary
24	!
25	INTEGER :: ji, jj, jk, jl, jh, jf ! dummy loop indices
26	INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
27	INTEGER :: ijt, iju, ipjm1
28	!!----------------------------------------------------------------------
29	!
30	ipk = K_SIZE(ptab) ! 3rd dimension
31	ipl = L_SIZE(ptab) ! 4th -
32	ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers)
33	!
34	!
35	SELECT CASE ( jpni )
36	CASE ( 1 ) ; ipj = nlcj ! 1 proc only along the i-direction
37	CASE DEFAULT ; ipj = 4 ! several proc along the i-direction
38	END SELECT
39	!
40	ipjm1 = ipj-1
41
42	!
43	DO jf = 1, ipf ! Loop on the number of arrays to be treated
44	!
45	SELECT CASE ( npolj )
46	!
47	CASE ( 3 , 4 ) ! * North fold T-point pivot
48	!
49	SELECT CASE ( NAT_IN(jf) )
50	CASE ( 'T' , 'W' ) ! T-, W-point
51	DO jh = 0, kextj
52	DO ji = 2, jpiglo
53	ijt = jpiglo-ji+2
54	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
55	END DO
56	ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-2-jh,:,:,jf)
57	END DO
58	DO ji = jpiglo/2+1, jpiglo
59	ijt = jpiglo-ji+2
60	ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf)
61	END DO
62	CASE ( 'U' ) ! U-point
63	DO jh = 0, kextj
64	DO ji = 2, jpiglo-1
65	iju = jpiglo-ji+1
66	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
67	END DO
68	ARRAY_IN( 1 ,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ipj-2-jh,:,:,jf)
69	ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf)
70	END DO
71	DO ji = jpiglo/2, jpiglo-1
72	iju = jpiglo-ji+1
73	ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf)
74	END DO
75	CASE ( 'V' ) ! V-point
76	DO jh = 0, kextj
77	DO ji = 2, jpiglo
78	ijt = jpiglo-ji+2
79	ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
80	ARRAY_IN(ji,ipj+jh ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-3-jh,:,:,jf)
81	END DO
82	ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-3-jh,:,:,jf)
83	END DO
84	CASE ( 'F' ) ! F-point
85	DO jh = 0, kextj
86	DO ji = 1, jpiglo-1
87	iju = jpiglo-ji+1
88	ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
89	ARRAY_IN(ji,ipj+jh ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-3-jh,:,:,jf)
90	END DO
91	END DO
92	DO jh = 0, kextj
93	ARRAY_IN( 1 ,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ipj-3-jh,:,:,jf)
94	ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf)
95	END DO
96	END SELECT
97	!
98	CASE ( 5 , 6 ) ! * North fold F-point pivot
99	!
100	SELECT CASE ( NAT_IN(jf) )
101	CASE ( 'T' , 'W' ) ! T-, W-point
102	DO jh = 0, kextj
103	DO ji = 1, jpiglo
104	ijt = jpiglo-ji+1
105	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-1-jh,:,:,jf)
106	END DO
107	END DO
108	CASE ( 'U' ) ! U-point
109	DO jh = 0, kextj
110	DO ji = 1, jpiglo-1
111	iju = jpiglo-ji
112	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-1-jh,:,:,jf)
113	END DO
114	ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf)
115	END DO
116	CASE ( 'V' ) ! V-point
117	DO jh = 0, kextj
118	DO ji = 1, jpiglo
119	ijt = jpiglo-ji+1
120	ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
121	END DO
122	END DO
123	DO ji = jpiglo/2+1, jpiglo
124	ijt = jpiglo-ji+1
125	ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf)
126	END DO
127	CASE ( 'F' ) ! F-point
128	DO jh = 0, kextj
129	DO ji = 1, jpiglo-1
130	iju = jpiglo-ji
131	ARRAY_IN(ji,ipj+jh ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
132	END DO
133	ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf)
134	END DO
135	DO ji = jpiglo/2+1, jpiglo-1
136	iju = jpiglo-ji
137	ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf)
138	END DO
139	END SELECT
140	!
141	CASE DEFAULT ! * closed : the code probably never go through
142	!
143	SELECT CASE ( NAT_IN(jf) )
144	CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points
145	ARRAY_IN(:, 1:1-kextj ,:,:,jf) = 0._wp
146	ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
147	CASE ( 'F' ) ! F-point
148	ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
149	END SELECT
150	!
151	END SELECT ! npolj
152	!
153	END DO
154	!
155	END SUBROUTINE ROUTINE_NFD
156
157	#undef PRECISION
158	#undef ARRAY_TYPE
159	#undef ARRAY_IN
160	#undef NAT_IN
161	#undef SGN_IN
162	#undef K_SIZE
163	#undef L_SIZE
164	#undef F_SIZE

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

Download in other formats: