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