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/branches/UKMO/dev_r10448_bdyvol/src/OCE/LBC – NEMO

source: NEMO/branches/UKMO/dev_r10448_bdyvol/src/OCE/LBC/lbc_nfd_ext_generic.h90 @ 10455

Last change on this file since 10455 was 10425, checked in by smasson, 5 years ago

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
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(:,1-kextj:,:,:,:)                      ! 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 = 2, 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               END DO
86               DO jh = 0, kextj
87                  ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3-jh,:,:,jf)
88                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf)
89               END DO
90            END SELECT
91            !
92         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
93            !
94            SELECT CASE ( NAT_IN(jf)  )
95            CASE ( 'T' , 'W' )                         ! T-, W-point
96               DO jh = 0, kextj
97                  DO ji = 1, jpiglo
98                     ijt = jpiglo-ji+1
99                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1-jh,:,:,jf)
100                  END DO
101               END DO
102            CASE ( 'U' )                               ! U-point
103               DO jh = 0, kextj
104                  DO ji = 1, jpiglo-1
105                     iju = jpiglo-ji
106                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1-jh,:,:,jf)
107                  END DO
108                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf)
109               END DO
110            CASE ( 'V' )                               ! V-point
111               DO jh = 0, kextj
112                  DO ji = 1, jpiglo
113                     ijt = jpiglo-ji+1
114                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
115                  END DO
116               END DO
117               DO ji = jpiglo/2+1, jpiglo
118                  ijt = jpiglo-ji+1
119                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
120               END DO
121            CASE ( 'F' )                               ! F-point
122               DO jh = 0, kextj
123                  DO ji = 1, jpiglo-1
124                     iju = jpiglo-ji
125                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
126                  END DO
127                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf)
128               END DO
129               DO ji = jpiglo/2+1, jpiglo-1
130                  iju = jpiglo-ji
131                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
132               END DO
133            END SELECT
134            !
135         CASE DEFAULT                           ! *  closed : the code probably never go through
136            !
137            SELECT CASE ( NAT_IN(jf) )
138            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
139               ARRAY_IN(:,  1:1-kextj  ,:,:,jf) = 0._wp
140               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
141            CASE ( 'F' )                               ! F-point
142               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
143            END SELECT
144            !
145         END SELECT     !  npolj
146         !
147      END DO
148      !
149   END SUBROUTINE ROUTINE_NFD
150
151#undef ARRAY_TYPE
152#undef ARRAY_IN
153#undef NAT_IN
154#undef SGN_IN
155#undef K_SIZE
156#undef L_SIZE
157#undef F_SIZE
Note: See TracBrowser for help on using the repository browser.