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_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_ext_generic.h90 @ 8860

Last change on this file since 8860 was 8860, checked in by acc, 7 years ago

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