source: NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/LBC/lbc_nfd_ext_generic.h90 @ 12603

Last change on this file since 12603 was 12603, checked in by orioltp, 8 months ago

Adding several interfaces to work with both single and double precision

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