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 branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_ext_generic.h90 @ 9190

Last change on this file since 9190 was 9190, checked in by gm, 6 years ago

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