- Timestamp:
- 2021-02-01T08:34:52+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_generic.h90
r14349 r14363 1 1 2 SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, k fld )2 SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, khls, kfld ) 3 3 TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c. 4 4 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points 5 5 REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary 6 INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls 6 7 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 7 8 ! 8 9 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices 9 INTEGER :: 10 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 10 11 INTEGER :: ii1, ii2, ij1, ij2 11 12 !!---------------------------------------------------------------------- 12 13 ! 14 ipi = SIZE(ptab(1)%pt4d,1) 13 15 ipj = SIZE(ptab(1)%pt4d,2) 14 16 ipk = SIZE(ptab(1)%pt4d,3) 15 17 ipl = SIZE(ptab(1)%pt4d,4) 16 18 ipf = kfld 19 ! 20 IF( ipi /= Ni0glo+2*khls ) THEN 21 WRITE(ctmp1,*) 'lbc_nfd input array does not match khls', ipi, khls, Ni0glo 22 CALL ctl_stop( 'STOP', ctmp1 ) 23 ENDIF 17 24 ! 18 25 DO jf = 1, ipf ! Loop on the number of arrays to be treated … … 24 31 DO jl = 1, ipl; DO jk = 1, ipk 25 32 ! 26 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full27 DO jj = 1, nn_hls28 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 129 ij2 = ipj - 2* nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 130 ! 31 DO ji = 1, nn_hls ! first nn_hls points32 ii1 = ji ! ends at: nn_hls33 ii2 = 2* nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 234 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 35 END DO 36 DO ji = 1, 1 ! point nn_hls+137 ii1 = nn_hls + ji33 ! last khls lines (from ipj to ipj-khls+1) : full 34 DO jj = 1, khls 35 ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1 36 ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1 37 ! 38 DO ji = 1, khls ! first khls points 39 ii1 = ji ! ends at: khls 40 ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2 41 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 42 END DO 43 DO ji = 1, 1 ! point khls+1 44 ii1 = khls + ji 38 45 ii2 = ii1 39 46 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 40 47 END DO 41 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)42 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls43 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 244 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 45 END DO 46 DO ji = 1, 1 ! point jpiglo - nn_hls + 147 ii1 = jpiglo - nn_hls + ji48 ii2 = nn_hls + ji49 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 50 END DO 51 DO ji = 1, nn_hls-1 ! last nn_hls-1 points52 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo53 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 254 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 55 END DO 56 END DO 57 ! 58 ! line number ipj- nn_hls : right half59 DO jj = 1, 1 60 ij1 = ipj - nn_hls61 ij2 = ij1 ! same line 62 ! 63 DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)64 ii1 = jpiglo/2 + ji + 1 ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls65 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 266 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 67 END DO 68 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)69 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls70 ii1 = ji ! ends at: nn_hls71 ii2 = 2* nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 272 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 73 END DO 74 ! ! last nn_hls-1 points: have been / will done by e-w periodicity48 DO ji = 1, Ni0glo - 1 ! points from khls+2 to ipi - khls (note: Ni0glo = ipi - 2*khls) 49 ii1 = 2 + khls + ji - 1 ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls 50 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2 51 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 52 END DO 53 DO ji = 1, 1 ! point ipi - khls + 1 54 ii1 = ipi - khls + ji 55 ii2 = khls + ji 56 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 57 END DO 58 DO ji = 1, khls-1 ! last khls-1 points 59 ii1 = ipi - khls + 1 + ji ! ends at: ipi - khls + 1 + khls - 1 = ipi 60 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2 61 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 62 END DO 63 END DO 64 ! 65 ! line number ipj-khls : right half 66 DO jj = 1, 1 67 ij1 = ipj - khls 68 ij2 = ij1 ! same line 69 ! 70 DO ji = 1, Ni0glo/2-1 ! points from ipi/2+2 to ipi - khls (note: Ni0glo = ipi - 2*khls) 71 ii1 = ipi/2 + ji + 1 ! ends at: ipi/2 + (ipi/2 - khls - 1) + 1 = ipi - khls 72 ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls - 1) + 1 = khls + 2 73 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 74 END DO 75 DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done) 76 ! ! as we just changed points ipi-2khls+1 to ipi-khls 77 ii1 = ji ! ends at: khls 78 ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2 79 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 80 END DO 81 ! ! last khls-1 points: have been / will done by e-w periodicity 75 82 END DO 76 83 ! … … 79 86 DO jl = 1, ipl; DO jk = 1, ipk 80 87 ! 81 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full82 DO jj = 1, nn_hls83 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 184 ij2 = ipj - 2* nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 185 ! 86 DO ji = 1, nn_hls ! first nn_hls points87 ii1 = ji ! ends at: nn_hls88 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 189 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 90 END DO 91 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)92 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls93 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 194 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 95 END DO 96 DO ji = 1, nn_hls ! last nn_hls points97 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo98 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 199 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 100 END DO 101 END DO 102 ! 103 ! line number ipj- nn_hls : right half104 DO jj = 1, 1 105 ij1 = ipj - nn_hls106 ij2 = ij1 ! same line 107 ! 108 DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)109 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls110 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1111 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 112 END DO 113 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)114 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls115 ii1 = ji ! ends at: nn_hls116 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1117 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 118 END DO 119 ! ! last nn_hls-1 points: have been / will done by e-w periodicity88 ! last khls lines (from ipj to ipj-khls+1) : full 89 DO jj = 1, khls 90 ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1 91 ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1 92 ! 93 DO ji = 1, khls ! first khls points 94 ii1 = ji ! ends at: khls 95 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 96 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 97 END DO 98 DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls) 99 ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls 100 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1 101 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 102 END DO 103 DO ji = 1, khls ! last khls points 104 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 105 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1 106 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 107 END DO 108 END DO 109 ! 110 ! line number ipj-khls : right half 111 DO jj = 1, 1 112 ij1 = ipj - khls 113 ij2 = ij1 ! same line 114 ! 115 DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - khls (note: Ni0glo = ipi - 2*khls) 116 ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls 117 ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1 118 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 119 END DO 120 DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done) 121 ! ! as we just changed points ipi-2khls+1 to ipi-khls 122 ii1 = ji ! ends at: khls 123 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 124 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 125 END DO 126 ! ! last khls-1 points: have been / will done by e-w periodicity 120 127 END DO 121 128 ! … … 124 131 DO jl = 1, ipl; DO jk = 1, ipk 125 132 ! 126 ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full127 DO jj = 1, nn_hls+1128 ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls129 ij2 = ipj - 2* nn_hls + jj - 2 ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1130 ! 131 DO ji = 1, nn_hls ! first nn_hls points132 ii1 = ji ! ends at: nn_hls133 ii2 = 2* nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2134 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 135 END DO 136 DO ji = 1, 1 ! point nn_hls+1137 ii1 = nn_hls + ji133 ! last khls+1 lines (from ipj to ipj-khls) : full 134 DO jj = 1, khls+1 135 ij1 = ipj - jj + 1 ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls 136 ij2 = ipj - 2*khls + jj - 2 ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1 137 ! 138 DO ji = 1, khls ! first khls points 139 ii1 = ji ! ends at: khls 140 ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2 141 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 142 END DO 143 DO ji = 1, 1 ! point khls+1 144 ii1 = khls + ji 138 145 ii2 = ii1 139 146 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 140 147 END DO 141 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)142 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls143 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2144 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 145 END DO 146 DO ji = 1, 1 ! point jpiglo - nn_hls + 1147 ii1 = jpiglo - nn_hls + ji148 ii2 = nn_hls + ji149 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 150 END DO 151 DO ji = 1, nn_hls-1 ! last nn_hls-1 points152 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo153 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2148 DO ji = 1, Ni0glo - 1 ! points from khls+2 to ipi - khls (note: Ni0glo = ipi - 2*khls) 149 ii1 = 2 + khls + ji - 1 ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls 150 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2 151 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 152 END DO 153 DO ji = 1, 1 ! point ipi - khls + 1 154 ii1 = ipi - khls + ji 155 ii2 = khls + ji 156 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 157 END DO 158 DO ji = 1, khls-1 ! last khls-1 points 159 ii1 = ipi - khls + 1 + ji ! ends at: ipi - khls + 1 + khls - 1 = ipi 160 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2 154 161 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 155 162 END DO … … 160 167 DO jl = 1, ipl; DO jk = 1, ipk 161 168 ! 162 ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full163 DO jj = 1, nn_hls+1164 ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls165 ij2 = ipj - 2* nn_hls + jj - 2 ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1166 ! 167 DO ji = 1, nn_hls ! first nn_hls points168 ii1 = ji ! ends at: nn_hls169 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1170 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 171 END DO 172 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)173 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls174 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1175 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 176 END DO 177 DO ji = 1, nn_hls ! last nn_hls points178 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo179 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1169 ! last khls+1 lines (from ipj to ipj-khls) : full 170 DO jj = 1, khls+1 171 ij1 = ipj - jj + 1 ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls 172 ij2 = ipj - 2*khls + jj - 2 ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1 173 ! 174 DO ji = 1, khls ! first khls points 175 ii1 = ji ! ends at: khls 176 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 177 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 178 END DO 179 DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls) 180 ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls 181 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1 182 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 183 END DO 184 DO ji = 1, khls ! last khls points 185 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 186 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1 180 187 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 181 188 END DO … … 193 200 DO jl = 1, ipl; DO jk = 1, ipk 194 201 ! 195 ! first: line number ipj- nn_hls : 3 points196 DO jj = 1, 1 197 ij1 = ipj - nn_hls198 ij2 = ij1 ! same line 199 ! 200 DO ji = 1, 1 ! points from jpiglo/2+1201 ii1 = jpiglo/2 + ji202 ii2 = jpiglo/2 - ji + 1203 ptab(jf)%pt4d(ii1,ij1,jk,jl) = 204 END DO 205 DO ji = 1, 1 ! points jpiglo - nn_hls206 ii1 = jpiglo - nn_hls + ji - 1207 ii2 = nn_hls + ji208 ptab(jf)%pt4d(ii1,ij1,jk,jl) = 209 END DO 210 DO ji = 1, 1 ! point nn_hls: redo it just in case (if e-w periodocity already done)211 ! ! as we just changed point jpiglo - nn_hls212 ii1 = nn_hls + ji - 1213 ii2 = nn_hls + ji214 ptab(jf)%pt4d(ii1,ij1,jk,jl) = 215 END DO 216 END DO 217 ! 218 ! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full219 DO jj = 1, nn_hls220 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls221 ij2 = ipj - 2* nn_hls + jj ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls222 ! 223 DO ji = 1, nn_hls ! first nn_hls points224 ii1 = ji ! ends at: nn_hls225 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1226 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 227 END DO 228 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)229 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls230 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1231 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 232 END DO 233 DO ji = 1, nn_hls ! last nn_hls points234 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo235 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1202 ! first: line number ipj-khls : 3 points 203 DO jj = 1, 1 204 ij1 = ipj - khls 205 ij2 = ij1 ! same line 206 ! 207 DO ji = 1, 1 ! points from ipi/2+1 208 ii1 = ipi/2 + ji 209 ii2 = ipi/2 - ji + 1 210 ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign... 211 END DO 212 DO ji = 1, 1 ! points ipi - khls 213 ii1 = ipi - khls + ji - 1 214 ii2 = khls + ji 215 ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign... 216 END DO 217 DO ji = 1, 1 ! point khls: redo it just in case (if e-w periodocity already done) 218 ! ! as we just changed point ipi - khls 219 ii1 = khls + ji - 1 220 ii2 = khls + ji 221 ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign... 222 END DO 223 END DO 224 ! 225 ! Second: last khls lines (from ipj to ipj-khls+1) : full 226 DO jj = 1, khls 227 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - khls 228 ij2 = ipj - 2*khls + jj ! ends at: ipj - 2*khls + khls = ipj - khls 229 ! 230 DO ji = 1, khls ! first khls points 231 ii1 = ji ! ends at: khls 232 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 233 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 234 END DO 235 DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls) 236 ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls 237 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1 238 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 239 END DO 240 DO ji = 1, khls ! last khls points 241 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 242 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1 236 243 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 237 244 END DO … … 242 249 DO jl = 1, ipl; DO jk = 1, ipk 243 250 ! 244 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full245 DO jj = 1, nn_hls246 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls247 ij2 = ipj - 2* nn_hls + jj ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls248 ! 249 DO ji = 1, nn_hls-1 ! first nn_hls-1 points250 ii1 = ji ! ends at: nn_hls-1251 ii2 = 2* nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1252 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 253 END DO 254 DO ji = 1, 1 ! point nn_hls255 ii1 = nn_hls + ji - 1256 ii2 = jpiglo- ii1257 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 258 END DO 259 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls)260 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1261 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1262 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 263 END DO 264 DO ji = 1, 1 ! point jpiglo - nn_hls265 ii1 = jpiglo - nn_hls + ji - 1251 ! last khls lines (from ipj to ipj-khls+1) : full 252 DO jj = 1, khls 253 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - khls 254 ij2 = ipj - 2*khls + jj ! ends at: ipj - 2*khls + khls = ipj - khls 255 ! 256 DO ji = 1, khls-1 ! first khls-1 points 257 ii1 = ji ! ends at: khls-1 258 ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1 259 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 260 END DO 261 DO ji = 1, 1 ! point khls 262 ii1 = khls + ji - 1 263 ii2 = ipi - ii1 264 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 265 END DO 266 DO ji = 1, Ni0glo - 1 ! points from khls+1 to ipi - khls - 1 (note: Ni0glo = ipi - 2*khls) 267 ii1 = khls + ji ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1 268 ii2 = ipi - khls - ji ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1 269 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 270 END DO 271 DO ji = 1, 1 ! point ipi - khls 272 ii1 = ipi - khls + ji - 1 266 273 ii2 = ii1 267 274 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 268 275 END DO 269 DO ji = 1, nn_hls ! last nn_hls points270 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo271 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls276 DO ji = 1, khls ! last khls points 277 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 278 ii2 = ipi - khls - ji ! ends at: ipi - khls - khls = ipi - 2*khls 272 279 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 273 280 END DO … … 278 285 DO jl = 1, ipl; DO jk = 1, ipk 279 286 ! 280 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full281 DO jj = 1, nn_hls282 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1283 ij2 = ipj - 2* nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1284 ! 285 DO ji = 1, nn_hls ! first nn_hls points286 ii1 = ji ! ends at: nn_hls287 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1288 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 289 END DO 290 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)291 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls292 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1293 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 294 END DO 295 DO ji = 1, nn_hls ! last nn_hls points296 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo297 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1287 ! last khls lines (from ipj to ipj-khls+1) : full 288 DO jj = 1, khls 289 ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1 290 ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1 291 ! 292 DO ji = 1, khls ! first khls points 293 ii1 = ji ! ends at: khls 294 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 295 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 296 END DO 297 DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls) 298 ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls 299 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1 300 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 301 END DO 302 DO ji = 1, khls ! last khls points 303 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 304 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1 298 305 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 299 306 END DO 300 307 END DO 301 308 ! 302 ! line number ipj- nn_hls : right half303 DO jj = 1, 1 304 ij1 = ipj - nn_hls305 ij2 = ij1 ! same line 306 ! 307 DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)308 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls309 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1310 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 311 END DO 312 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)313 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls314 ii1 = ji ! ends at: nn_hls315 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1316 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 317 END DO 318 ! ! last nn_hls points: have been / will done by e-w periodicity309 ! line number ipj-khls : right half 310 DO jj = 1, 1 311 ij1 = ipj - khls 312 ij2 = ij1 ! same line 313 ! 314 DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - khls (note: Ni0glo = ipi - 2*khls) 315 ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls 316 ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1 317 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 318 END DO 319 DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done) 320 ! ! as we just changed points ipi-2khls+1 to ipi-khls 321 ii1 = ji ! ends at: khls 322 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 323 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 324 END DO 325 ! ! last khls points: have been / will done by e-w periodicity 319 326 END DO 320 327 ! … … 323 330 DO jl = 1, ipl; DO jk = 1, ipk 324 331 ! 325 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full326 DO jj = 1, nn_hls327 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1328 ij2 = ipj - 2* nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1329 ! 330 DO ji = 1, nn_hls-1 ! first nn_hls-1 points331 ii1 = ji ! ends at: nn_hls-1332 ii2 = 2* nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1333 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 334 END DO 335 DO ji = 1, 1 ! point nn_hls336 ii1 = nn_hls + ji - 1337 ii2 = jpiglo- ii1338 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 339 END DO 340 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls)341 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1342 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1343 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 344 END DO 345 DO ji = 1, 1 ! point jpiglo - nn_hls346 ii1 = jpiglo - nn_hls + ji - 1332 ! last khls lines (from ipj to ipj-khls+1) : full 333 DO jj = 1, khls 334 ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1 335 ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1 336 ! 337 DO ji = 1, khls-1 ! first khls-1 points 338 ii1 = ji ! ends at: khls-1 339 ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1 340 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 341 END DO 342 DO ji = 1, 1 ! point khls 343 ii1 = khls + ji - 1 344 ii2 = ipi - ii1 345 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 346 END DO 347 DO ji = 1, Ni0glo - 1 ! points from khls+1 to ipi - khls - 1 (note: Ni0glo = ipi - 2*khls) 348 ii1 = khls + ji ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1 349 ii2 = ipi - khls - ji ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1 350 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 351 END DO 352 DO ji = 1, 1 ! point ipi - khls 353 ii1 = ipi - khls + ji - 1 347 354 ii2 = ii1 348 355 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 349 356 END DO 350 DO ji = 1, nn_hls ! last nn_hls points351 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo352 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls357 DO ji = 1, khls ! last khls points 358 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 359 ii2 = ipi - khls - ji ! ends at: ipi - khls - khls = ipi - 2*khls 353 360 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 354 361 END DO 355 362 END DO 356 363 ! 357 ! line number ipj- nn_hls : right half358 DO jj = 1, 1 359 ij1 = ipj - nn_hls360 ij2 = ij1 ! same line 361 ! 362 DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+1 to jpiglo - nn_hls-1 (note: Ni0glo = jpiglo - 2*nn_hls)363 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls364 ii2 = jpiglo/2 - ji ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1365 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 366 END DO 367 DO ji = 1, nn_hls-1 ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done)368 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1369 ii1 = ji ! ends at: nn_hls370 ii2 = 2* nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1371 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 372 END DO 373 ! ! last nn_hls points: have been / will done by e-w periodicity364 ! line number ipj-khls : right half 365 DO jj = 1, 1 366 ij1 = ipj - khls 367 ij2 = ij1 ! same line 368 ! 369 DO ji = 1, Ni0glo/2-1 ! points from ipi/2+1 to ipi - khls-1 (note: Ni0glo = ipi - 2*khls) 370 ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls 371 ii2 = ipi/2 - ji ! ends at: ipi/2 - (ipi/2 - khls - 1 ) = khls + 1 372 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 373 END DO 374 DO ji = 1, khls-1 ! first khls-1 points: redo them just in case (if e-w periodocity already done) 375 ! ! as we just changed points ipi-2khls+1 to ipi-nn_hl-1 376 ii1 = ji ! ends at: khls 377 ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1 378 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 379 END DO 380 ! ! last khls points: have been / will done by e-w periodicity 374 381 END DO 375 382 !
Note: See TracChangeset
for help on using the changeset viewer.
