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

source: NEMO/trunk/src/OCE/LBC/lbc_nfd_ext_generic.h90 @ 14433

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

trunk: merge dev_r14312_MPI_Interface into the trunk, #2598

  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
File size: 4.7 KB
Line 
1
2   SUBROUTINE lbc_nfd_ext_/**/PRECISION( ptab, cd_nat, psgn, kextj )
3      !!----------------------------------------------------------------------
4      REAL(PRECISION), DIMENSION(:,1-kextj:),INTENT(inout) ::   ptab
5      CHARACTER(len=1), INTENT(in   ) ::   cd_nat      ! nature of array grid-points
6      REAL(PRECISION),  INTENT(in   ) ::   psgn        ! sign used across the north fold boundary
7      INTEGER,          INTENT(in   ) ::   kextj       ! extra halo width at north fold
8      !
9      INTEGER  ::    ji,  jj,  jh   ! dummy loop indices
10      INTEGER  ::   ipj
11      INTEGER  ::   ijt, iju, ipjm1
12      !!----------------------------------------------------------------------
13      !
14      SELECT CASE ( jpni )
15      CASE ( 1 )     ;   ipj = jpj        ! 1 proc only  along the i-direction
16      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
17      END SELECT
18      !
19      ipjm1 = ipj-1
20      !
21      IF( c_NFtype == 'T' ) THEN            ! *  North fold  T-point pivot
22         !
23         SELECT CASE ( cd_nat  )
24         CASE ( 'T' , 'W' )                         ! T-, W-point
25            DO jh = 0, kextj
26               DO ji = 2, jpiglo
27                  ijt = jpiglo-ji+2
28                  ptab(ji,ipj+jh) = psgn * ptab(ijt,ipj-2-jh)
29               END DO
30               ptab(1,ipj+jh) = psgn * ptab(3,ipj-2-jh)
31            END DO
32            DO ji = jpiglo/2+1, jpiglo
33               ijt = jpiglo-ji+2
34               ptab(ji,ipjm1) = psgn * ptab(ijt,ipjm1)
35            END DO
36         CASE ( 'U' )                               ! U-point
37            DO jh = 0, kextj
38               DO ji = 2, jpiglo-1
39                  iju = jpiglo-ji+1
40                  ptab(ji,ipj+jh) = psgn * ptab(iju,ipj-2-jh)
41               END DO
42               ptab(   1  ,ipj+jh) = psgn * ptab(    2   ,ipj-2-jh)
43               ptab(jpiglo,ipj+jh) = psgn * ptab(jpiglo-1,ipj-2-jh) 
44            END DO
45            DO ji = jpiglo/2, jpiglo-1
46               iju = jpiglo-ji+1
47               ptab(ji,ipjm1) = psgn * ptab(iju,ipjm1)
48            END DO
49         CASE ( 'V' )                               ! V-point
50            DO jh = 0, kextj
51               DO ji = 2, jpiglo
52                  ijt = jpiglo-ji+2
53                  ptab(ji,ipj-1+jh) = psgn * ptab(ijt,ipj-2-jh)
54                  ptab(ji,ipj+jh  ) = psgn * ptab(ijt,ipj-3-jh)
55               END DO
56               ptab(1,ipj+jh) = psgn * ptab(3,ipj-3-jh) 
57            END DO
58         CASE ( 'F' )                               ! F-point
59            DO jh = 0, kextj
60               DO ji = 1, jpiglo-1
61                  iju = jpiglo-ji+1
62                  ptab(ji,ipj-1+jh) = psgn * ptab(iju,ipj-2-jh)
63                  ptab(ji,ipj+jh  ) = psgn * ptab(iju,ipj-3-jh)
64               END DO
65            END DO
66            DO jh = 0, kextj
67               ptab(   1  ,ipj+jh) = psgn * ptab(    2   ,ipj-3-jh)
68               ptab(jpiglo,ipj+jh) = psgn * ptab(jpiglo-1,ipj-3-jh)
69            END DO
70         END SELECT
71         !
72      ENDIF   ! c_NFtype == 'T'
73      !
74      IF( c_NFtype == 'F' ) THEN            ! *  North fold  F-point pivot
75         !
76         SELECT CASE ( cd_nat  )
77         CASE ( 'T' , 'W' )                         ! T-, W-point
78            DO jh = 0, kextj
79               DO ji = 1, jpiglo
80                  ijt = jpiglo-ji+1
81                  ptab(ji,ipj+jh) = psgn * ptab(ijt,ipj-1-jh)
82               END DO
83            END DO
84         CASE ( 'U' )                               ! U-point
85            DO jh = 0, kextj
86               DO ji = 1, jpiglo-1
87                  iju = jpiglo-ji
88                  ptab(ji,ipj+jh) = psgn * ptab(iju,ipj-1-jh)
89               END DO
90               ptab(jpiglo,ipj+jh) = psgn * ptab(jpiglo-2,ipj-1-jh)
91            END DO
92         CASE ( 'V' )                               ! V-point
93            DO jh = 0, kextj
94               DO ji = 1, jpiglo
95                  ijt = jpiglo-ji+1
96                  ptab(ji,ipj+jh) = psgn * ptab(ijt,ipj-2-jh)
97               END DO
98            END DO
99            DO ji = jpiglo/2+1, jpiglo
100               ijt = jpiglo-ji+1
101               ptab(ji,ipjm1) = psgn * ptab(ijt,ipjm1)
102            END DO
103         CASE ( 'F' )                               ! F-point
104            DO jh = 0, kextj
105               DO ji = 1, jpiglo-1
106                  iju = jpiglo-ji
107                  ptab(ji,ipj+jh  ) = psgn * ptab(iju,ipj-2-jh)
108               END DO
109               ptab(jpiglo,ipj+jh) = psgn * ptab(jpiglo-2,ipj-2-jh)
110            END DO
111            DO ji = jpiglo/2+1, jpiglo-1
112               iju = jpiglo-ji
113               ptab(ji,ipjm1) = psgn * ptab(iju,ipjm1)
114            END DO
115         END SELECT
116         !
117      ENDIF   ! c_NFtype == 'F'
118      !
119   END SUBROUTINE lbc_nfd_ext_/**/PRECISION
120
Note: See TracBrowser for help on using the repository browser.