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

Last change on this file since 9012 was 9012, checked in by acc, 3 years ago

Branch dev_CNRS_2017. Merge in no_ghost changes from dev_r8126_ROBUST08_no_ghost. These changes include lib_mpp refresh and rationalisation of mppini from dev_r8126_ROBUST10_MPPINI

File size: 7.5 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#if defined MULTI
47   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
48      INTEGER          , INTENT(in   ) ::   kfld        ! number of pt3d arrays
49#else
50   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn       )
51#endif
52      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
53      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
54      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
55      !
56      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
57      INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array
58      INTEGER  ::   ijt, iju, ipjm1
59      !!----------------------------------------------------------------------
60      !
61      ipk = K_SIZE(ptab)   ! 3rd dimension
62      ipl = L_SIZE(ptab)   ! 4th    -
63      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
64      !
65      !
66      SELECT CASE ( jpni )
67      CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction
68      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
69      END SELECT
70      ipjm1 = ipj-1
71
72      !
73      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
74         !
75         SELECT CASE ( npolj )
76         !
77         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
78            !
79            SELECT CASE ( NAT_IN(jf)  )
80            CASE ( 'T' , 'W' )                         ! T-, W-point
81               DO ji = 2, jpiglo
82                  ijt = jpiglo-ji+2
83                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
84               END DO
85               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2,:,:,jf)
86               DO ji = jpiglo/2+1, jpiglo
87                  ijt = jpiglo-ji+2
88                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
89               END DO
90            CASE ( 'U' )                               ! U-point
91               DO ji = 1, jpiglo-1
92                  iju = jpiglo-ji+1
93                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
94               END DO
95               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2,:,:,jf)
96               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2,:,:,jf)
97               DO ji = jpiglo/2, jpiglo-1
98                  iju = jpiglo-ji+1
99                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
100               END DO
101            CASE ( 'V' )                               ! V-point
102               DO ji = 2, jpiglo
103                  ijt = jpiglo-ji+2
104                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
105                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3,:,:,jf)
106               END DO
107               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3,:,:,jf)
108            CASE ( 'F' )                               ! F-point
109               DO ji = 1, jpiglo-1
110                  iju = jpiglo-ji+1
111                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
112                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3,:,:,jf)
113               END DO
114               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3,:,:,jf)
115               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3,:,:,jf)
116            END SELECT
117            !
118         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
119            !
120            SELECT CASE ( NAT_IN(jf)  )
121            CASE ( 'T' , 'W' )                         ! T-, W-point
122               DO ji = 1, jpiglo
123                  ijt = jpiglo-ji+1
124                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1,:,:,jf)
125               END DO
126            CASE ( 'U' )                               ! U-point
127               DO ji = 1, jpiglo-1
128                  iju = jpiglo-ji
129                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1,:,:,jf)
130               END DO
131               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(1,ipj-1,:,:,jf)
132            CASE ( 'V' )                               ! V-point
133               DO ji = 1, jpiglo
134                  ijt = jpiglo-ji+1
135                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
136               END DO
137               DO ji = jpiglo/2+1, jpiglo
138                  ijt = jpiglo-ji+1
139                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
140               END DO
141            CASE ( 'F' )                               ! F-point
142               DO ji = 1, jpiglo-1
143                  iju = jpiglo-ji
144                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
145               END DO
146               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(1,ipj-2,:,:,jf)
147               DO ji = jpiglo/2+1, jpiglo-1
148                  iju = jpiglo-ji
149                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
150               END DO
151            END SELECT
152            !
153         CASE DEFAULT                           ! *  closed : the code probably never go through
154            !
155            SELECT CASE ( NAT_IN(jf) )
156            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
157               ARRAY_IN(:, 1 ,:,:,jf) = 0._wp
158               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
159            CASE ( 'F' )                               ! F-point
160               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
161            END SELECT
162            !
163         END SELECT     !  npolj
164         !
165      END DO
166      !
167   END SUBROUTINE ROUTINE_NFD
168
169#undef ARRAY_TYPE
170#undef ARRAY_IN
171#undef NAT_IN
172#undef SGN_IN
173#undef K_SIZE
174#undef L_SIZE
175#undef F_SIZE
Note: See TracBrowser for help on using the repository browser.