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

source: NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_ext_generic.h90 @ 14338

Last change on this file since 14338 was 14338, checked in by smasson, 3 years ago

dev_r14312_MPI_Interface: simplification of lbclnk and lbcnfd and their generic interfaces, #2598
  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
File size: 6.2 KB
Line 
1#if defined DIM_2d
2#   define XD                    2d
3#   define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
4#   define K_SIZE(ptab)          1
5#   define L_SIZE(ptab)          1
6#else
7=== NOT CODED ===
8#endif
9#define    F_SIZE(ptab)          1
10
11   SUBROUTINE lbc_nfd_ext_/**/XD/**/_/**/PRECISION( ptab, cd_nat, psgn, kextj )
12      !!----------------------------------------------------------------------
13      REAL(PRECISION), DIMENSION(:,1-kextj:),INTENT(inout) ::   ptab
14      CHARACTER(len=1), INTENT(in   ) ::   cd_nat      ! nature of array grid-points
15      REAL(PRECISION),  INTENT(in   ) ::   psgn        ! sign used across the north fold boundary
16      INTEGER,          INTENT(in   ) ::   kextj       ! extra halo width at north fold
17!!      INTEGER                       , INTENT(in   ) ::   kextj       ! extra halo width at north fold, declared before its use in ptab
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      SELECT CASE ( jpni )
29      CASE ( 1 )     ;   ipj = jpj        ! 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         IF( c_NFtype == 'T' ) THEN            ! *  North fold  T-point pivot
39            !
40            SELECT CASE ( cd_nat  )
41            CASE ( 'T' , 'W' )                         ! T-, W-point
42               DO jh = 0, kextj
43                  DO ji = 2, jpiglo
44                     ijt = jpiglo-ji+2
45                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
46                  END DO
47                  ARRAY_IN(1,ipj+jh,:,:,jf) = psgn * ARRAY_IN(3,ipj-2-jh,:,:,jf)
48               END DO
49               DO ji = jpiglo/2+1, jpiglo
50                  ijt = jpiglo-ji+2
51                  ARRAY_IN(ji,ipjm1,:,:,jf) = psgn * ARRAY_IN(ijt,ipjm1,:,:,jf)
52               END DO
53            CASE ( 'U' )                               ! U-point
54               DO jh = 0, kextj
55                  DO ji = 2, jpiglo-1
56                     iju = jpiglo-ji+1
57                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
58                  END DO
59                 ARRAY_IN(   1  ,ipj+jh,:,:,jf) = psgn * ARRAY_IN(    2   ,ipj-2-jh,:,:,jf)
60                 ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = psgn * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf) 
61               END DO
62               DO ji = jpiglo/2, jpiglo-1
63                  iju = jpiglo-ji+1
64                  ARRAY_IN(ji,ipjm1,:,:,jf) = psgn * ARRAY_IN(iju,ipjm1,:,:,jf)
65               END DO
66            CASE ( 'V' )                               ! V-point
67               DO jh = 0, kextj
68                  DO ji = 2, jpiglo
69                     ijt = jpiglo-ji+2
70                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
71                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-3-jh,:,:,jf)
72                  END DO
73                  ARRAY_IN(1,ipj+jh,:,:,jf) = psgn * ARRAY_IN(3,ipj-3-jh,:,:,jf) 
74               END DO
75            CASE ( 'F' )                               ! F-point
76               DO jh = 0, kextj
77                  DO ji = 1, jpiglo-1
78                     iju = jpiglo-ji+1
79                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = psgn * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
80                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = psgn * ARRAY_IN(iju,ipj-3-jh,:,:,jf)
81                  END DO
82               END DO
83               DO jh = 0, kextj
84                  ARRAY_IN(   1  ,ipj+jh,:,:,jf) = psgn * ARRAY_IN(    2   ,ipj-3-jh,:,:,jf)
85                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = psgn * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf)
86               END DO
87            END SELECT
88            !
89         ENDIF   ! c_NFtype == 'T'
90         !
91         IF( c_NFtype == 'F' ) THEN            ! *  North fold  F-point pivot
92            !
93            SELECT CASE ( cd_nat  )
94            CASE ( 'T' , 'W' )                         ! T-, W-point
95               DO jh = 0, kextj
96                  DO ji = 1, jpiglo
97                     ijt = jpiglo-ji+1
98                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-1-jh,:,:,jf)
99                  END DO
100               END DO
101            CASE ( 'U' )                               ! U-point
102               DO jh = 0, kextj
103                  DO ji = 1, jpiglo-1
104                     iju = jpiglo-ji
105                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(iju,ipj-1-jh,:,:,jf)
106                  END DO
107                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = psgn * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf)
108               END DO
109            CASE ( 'V' )                               ! V-point
110               DO jh = 0, kextj
111                  DO ji = 1, jpiglo
112                     ijt = jpiglo-ji+1
113                     ARRAY_IN(ji,ipj+jh,:,:,jf) = psgn * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
114                  END DO
115               END DO
116               DO ji = jpiglo/2+1, jpiglo
117                  ijt = jpiglo-ji+1
118                  ARRAY_IN(ji,ipjm1,:,:,jf) = psgn * ARRAY_IN(ijt,ipjm1,:,:,jf)
119               END DO
120            CASE ( 'F' )                               ! F-point
121               DO jh = 0, kextj
122                  DO ji = 1, jpiglo-1
123                     iju = jpiglo-ji
124                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = psgn * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
125                  END DO
126                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = psgn * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf)
127               END DO
128               DO ji = jpiglo/2+1, jpiglo-1
129                  iju = jpiglo-ji
130                  ARRAY_IN(ji,ipjm1,:,:,jf) = psgn * ARRAY_IN(iju,ipjm1,:,:,jf)
131               END DO
132            END SELECT
133            !
134         ENDIF   ! c_NFtype == 'F'
135         !
136      END DO
137      !
138   END SUBROUTINE lbc_nfd_ext_/**/XD/**/_/**/PRECISION
139
140#undef XD
141#undef ARRAY_IN
142#undef K_SIZE
143#undef L_SIZE
144#undef F_SIZE
Note: See TracBrowser for help on using the repository browser.