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_generic.h90 in branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_generic.h90 @ 8882

Last change on this file since 8882 was 8882, checked in by flavoni, 6 years ago

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