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 NEMO/trunk/src/OCE/LBC – NEMO

source: NEMO/trunk/src/OCE/LBC/lbc_nfd_generic.h90 @ 13226

Last change on this file since 13226 was 13226, checked in by orioltp, 4 years ago

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