- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/lbc_nfd_generic.h90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/LBC/lbc_nfd_generic.h90
r13226 r13899 10 10 # endif 11 11 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 12 # define J_SIZE(ptab) SIZE(ptab(1)%pt2d,2) 12 13 # define K_SIZE(ptab) 1 13 14 # define L_SIZE(ptab) 1 … … 20 21 # endif 21 22 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 23 # define J_SIZE(ptab) SIZE(ptab(1)%pt3d,2) 22 24 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) 23 25 # define L_SIZE(ptab) 1 … … 30 32 # endif 31 33 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 34 # define J_SIZE(ptab) SIZE(ptab(1)%pt4d,2) 32 35 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 33 36 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) … … 40 43 # if defined DIM_2d 41 44 # define ARRAY_IN(i,j,k,l,f) ptab(i,j) 45 # define J_SIZE(ptab) SIZE(ptab,2) 42 46 # define K_SIZE(ptab) 1 43 47 # define L_SIZE(ptab) 1 … … 45 49 # if defined DIM_3d 46 50 # define ARRAY_IN(i,j,k,l,f) ptab(i,j,k) 51 # define J_SIZE(ptab) SIZE(ptab,2) 47 52 # define K_SIZE(ptab) SIZE(ptab,3) 48 53 # define L_SIZE(ptab) 1 … … 50 55 # if defined DIM_4d 51 56 # define ARRAY_IN(i,j,k,l,f) ptab(i,j,k,l) 57 # define J_SIZE(ptab) SIZE(ptab,2) 52 58 # define K_SIZE(ptab) SIZE(ptab,3) 53 59 # define L_SIZE(ptab) SIZE(ptab,4) … … 76 82 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 77 83 ! 78 INTEGER :: ji, jj, jk, jl, jh,jf ! dummy loop indices79 INTEGER :: ipi, ipj, ipk, ipl,ipf ! dimension of the input array80 INTEGER :: i jt, iju, ipjm184 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices 85 INTEGER :: ipj, ipk, ipl, ipf ! dimension of the input array 86 INTEGER :: ii1, ii2, ij1, ij2 81 87 !!---------------------------------------------------------------------- 82 88 ! 83 ipk = K_SIZE(ptab) ! 3rd dimension 89 ipj = J_SIZE(ptab) ! 2nd dimension 90 ipk = K_SIZE(ptab) ! 3rd - 84 91 ipl = L_SIZE(ptab) ! 4th - 85 92 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 86 !87 !88 SELECT CASE ( jpni )89 CASE ( 1 ) ; ipj = nlcj ! 1 proc only along the i-direction90 CASE DEFAULT ; ipj = 4 ! several proc along the i-direction91 END SELECT92 ipjm1 = ipj-193 94 93 ! 95 94 DO jf = 1, ipf ! Loop on the number of arrays to be treated … … 101 100 SELECT CASE ( NAT_IN(jf) ) 102 101 CASE ( 'T' , 'W' ) ! T-, W-point 103 DO ji = 2, jpiglo 104 ijt = jpiglo-ji+2 105 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2,:,:,jf) 106 END DO 107 ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-2,:,:,jf) 108 DO ji = jpiglo/2+1, jpiglo 109 ijt = jpiglo-ji+2 110 ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf) 111 END DO 102 DO jl = 1, ipl; DO jk = 1, ipk 103 ! 104 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 105 DO jj = 1, nn_hls 106 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1 107 ij2 = ipj - 2*nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 108 ! 109 DO ji = 1, nn_hls ! first nn_hls points 110 ii1 = ji ! ends at: nn_hls 111 ii2 = 2*nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 112 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 113 END DO 114 DO ji = 1, 1 ! point nn_hls+1 115 ii1 = nn_hls + ji 116 ii2 = ii1 117 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 118 END DO 119 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 120 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 121 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2 122 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 123 END DO 124 DO ji = 1, 1 ! point jpiglo - nn_hls + 1 125 ii1 = jpiglo - nn_hls + ji 126 ii2 = nn_hls + ji 127 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 128 END DO 129 DO ji = 1, nn_hls-1 ! last nn_hls-1 points 130 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 131 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2 132 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 133 END DO 134 END DO 135 ! 136 ! line number ipj-nn_hls : right half 137 DO jj = 1, 1 138 ij1 = ipj - nn_hls 139 ij2 = ij1 ! same line 140 ! 141 DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 142 ii1 = jpiglo/2 + ji + 1 ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls 143 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 2 144 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 145 END DO 146 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) 147 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 148 ii1 = ji ! ends at: nn_hls 149 ii2 = 2*nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 150 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 151 END DO 152 ! ! last nn_hls-1 points: have been / will done by e-w periodicity 153 END DO 154 ! 155 END DO; END DO 112 156 CASE ( 'U' ) ! U-point 113 DO ji = 1, jpiglo-1 114 iju = jpiglo-ji+1 115 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2,:,:,jf) 116 END DO 117 ARRAY_IN( 1 ,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ipj-2,:,:,jf) 118 ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-2,:,:,jf) 119 DO ji = jpiglo/2, jpiglo-1 120 iju = jpiglo-ji+1 121 ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf) 122 END DO 157 DO jl = 1, ipl; DO jk = 1, ipk 158 ! 159 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 160 DO jj = 1, nn_hls 161 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1 162 ij2 = ipj - 2*nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 163 ! 164 DO ji = 1, nn_hls ! first nn_hls points 165 ii1 = ji ! ends at: nn_hls 166 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 167 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 168 END DO 169 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 170 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 171 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 172 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 173 END DO 174 DO ji = 1, nn_hls ! last nn_hls points 175 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 176 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 177 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 178 END DO 179 END DO 180 ! 181 ! line number ipj-nn_hls : right half 182 DO jj = 1, 1 183 ij1 = ipj - nn_hls 184 ij2 = ij1 ! same line 185 ! 186 DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 187 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 188 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1 189 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 190 END DO 191 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) 192 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 193 ii1 = ji ! ends at: nn_hls 194 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 195 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 196 END DO 197 ! ! last nn_hls-1 points: have been / will done by e-w periodicity 198 END DO 199 ! 200 END DO; END DO 123 201 CASE ( 'V' ) ! V-point 124 DO ji = 2, jpiglo 125 ijt = jpiglo-ji+2 126 ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2,:,:,jf) 127 ARRAY_IN(ji,ipj ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-3,:,:,jf) 128 END DO 129 ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ipj-3,:,:,jf) 202 DO jl = 1, ipl; DO jk = 1, ipk 203 ! 204 ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full 205 DO jj = 1, nn_hls+1 206 ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls 207 ij2 = ipj - 2*nn_hls + jj - 2 ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1 208 ! 209 DO ji = 1, nn_hls ! first nn_hls points 210 ii1 = ji ! ends at: nn_hls 211 ii2 = 2*nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 212 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 213 END DO 214 DO ji = 1, 1 ! point nn_hls+1 215 ii1 = nn_hls + ji 216 ii2 = ii1 217 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 218 END DO 219 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 220 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 221 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2 222 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 223 END DO 224 DO ji = 1, 1 ! point jpiglo - nn_hls + 1 225 ii1 = jpiglo - nn_hls + ji 226 ii2 = nn_hls + ji 227 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 228 END DO 229 DO ji = 1, nn_hls-1 ! last nn_hls-1 points 230 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 231 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2 232 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 233 END DO 234 END DO 235 ! 236 END DO; END DO 130 237 CASE ( 'F' ) ! F-point 131 DO ji = 1, jpiglo-1 132 iju = jpiglo-ji+1 133 ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2,:,:,jf) 134 ARRAY_IN(ji,ipj ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-3,:,:,jf) 135 END DO 136 ARRAY_IN( 1 ,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN( 2 ,ipj-3,:,:,jf) 137 ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-1,ipj-3,:,:,jf) 138 END SELECT 238 DO jl = 1, ipl; DO jk = 1, ipk 239 ! 240 ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full 241 DO jj = 1, nn_hls+1 242 ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls 243 ij2 = ipj - 2*nn_hls + jj - 2 ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1 244 ! 245 DO ji = 1, nn_hls ! first nn_hls points 246 ii1 = ji ! ends at: nn_hls 247 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 248 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 249 END DO 250 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 251 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 252 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 253 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 254 END DO 255 DO ji = 1, nn_hls ! last nn_hls points 256 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 257 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 258 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 259 END DO 260 END DO 261 ! 262 END DO; END DO 263 END SELECT ! NAT_IN(jf) 139 264 ! 140 265 CASE ( 5 , 6 ) ! * North fold F-point pivot … … 142 267 SELECT CASE ( NAT_IN(jf) ) 143 268 CASE ( 'T' , 'W' ) ! T-, W-point 144 DO ji = 1, jpiglo 145 ijt = jpiglo-ji+1 146 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-1,:,:,jf) 147 END DO 269 DO jl = 1, ipl; DO jk = 1, ipk 270 ! 271 ! first: line number ipj-nn_hls : 3 points 272 DO jj = 1, 1 273 ij1 = ipj - nn_hls 274 ij2 = ij1 ! same line 275 ! 276 DO ji = 1, 1 ! points from jpiglo/2+1 277 ii1 = jpiglo/2 + ji 278 ii2 = jpiglo/2 - ji + 1 279 ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign... 280 END DO 281 DO ji = 1, 1 ! points jpiglo - nn_hls 282 ii1 = jpiglo - nn_hls + ji - 1 283 ii2 = nn_hls + ji 284 ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign... 285 END DO 286 DO ji = 1, 1 ! point nn_hls: redo it just in case (if e-w periodocity already done) 287 ! ! as we just changed point jpiglo - nn_hls 288 ii1 = nn_hls + ji - 1 289 ii2 = nn_hls + ji 290 ARRAY_IN(ii1,ij1,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) ! Warning: pb with sign... 291 END DO 292 END DO 293 ! 294 ! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full 295 DO jj = 1, nn_hls 296 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls 297 ij2 = ipj - 2*nn_hls + jj ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls 298 ! 299 DO ji = 1, nn_hls ! first nn_hls points 300 ii1 = ji ! ends at: nn_hls 301 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 302 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 303 END DO 304 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 305 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 306 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 307 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 308 END DO 309 DO ji = 1, nn_hls ! last nn_hls points 310 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 311 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 312 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 313 END DO 314 END DO 315 ! 316 END DO; END DO 148 317 CASE ( 'U' ) ! U-point 149 DO ji = 1, jpiglo-1 150 iju = jpiglo-ji 151 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-1,:,:,jf) 152 END DO 153 ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-1,:,:,jf) 318 DO jl = 1, ipl; DO jk = 1, ipk 319 ! 320 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 321 DO jj = 1, nn_hls 322 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls 323 ij2 = ipj - 2*nn_hls + jj ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls 324 ! 325 DO ji = 1, nn_hls-1 ! first nn_hls-1 points 326 ii1 = ji ! ends at: nn_hls-1 327 ii2 = 2*nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 328 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 329 END DO 330 DO ji = 1, 1 ! point nn_hls 331 ii1 = nn_hls + ji - 1 332 ii2 = jpiglo - ii1 333 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 334 END DO 335 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls) 336 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 337 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1 338 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 339 END DO 340 DO ji = 1, 1 ! point jpiglo - nn_hls 341 ii1 = jpiglo - nn_hls + ji - 1 342 ii2 = ii1 343 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 344 END DO 345 DO ji = 1, nn_hls ! last nn_hls points 346 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 347 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls 348 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 349 END DO 350 END DO 351 ! 352 END DO; END DO 154 353 CASE ( 'V' ) ! V-point 155 DO ji = 1, jpiglo 156 ijt = jpiglo-ji+1 157 ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipj-2,:,:,jf) 158 END DO 159 DO ji = jpiglo/2+1, jpiglo 160 ijt = jpiglo-ji+1 161 ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijt,ipjm1,:,:,jf) 162 END DO 354 DO jl = 1, ipl; DO jk = 1, ipk 355 ! 356 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 357 DO jj = 1, nn_hls 358 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1 359 ij2 = ipj - 2*nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 360 ! 361 DO ji = 1, nn_hls ! first nn_hls points 362 ii1 = ji ! ends at: nn_hls 363 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 364 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 365 END DO 366 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 367 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 368 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 369 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 370 END DO 371 DO ji = 1, nn_hls ! last nn_hls points 372 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 373 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 374 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 375 END DO 376 END DO 377 ! 378 ! line number ipj-nn_hls : right half 379 DO jj = 1, 1 380 ij1 = ipj - nn_hls 381 ij2 = ij1 ! same line 382 ! 383 DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls) 384 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 385 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1 386 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 387 END DO 388 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done) 389 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 390 ii1 = ji ! ends at: nn_hls 391 ii2 = 2*nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 392 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 393 END DO 394 ! ! last nn_hls points: have been / will done by e-w periodicity 395 END DO 396 ! 397 END DO; END DO 163 398 CASE ( 'F' ) ! F-point 164 DO ji = 1, jpiglo-1 165 iju = jpiglo-ji 166 ARRAY_IN(ji,ipj ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipj-2,:,:,jf) 167 END DO 168 ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-2,:,:,jf) 169 DO ji = jpiglo/2+1, jpiglo-1 170 iju = jpiglo-ji 171 ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(iju,ipjm1,:,:,jf) 172 END DO 173 END SELECT 399 DO jl = 1, ipl; DO jk = 1, ipk 400 ! 401 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 402 DO jj = 1, nn_hls 403 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1 404 ij2 = ipj - 2*nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 405 ! 406 DO ji = 1, nn_hls-1 ! first nn_hls-1 points 407 ii1 = ji ! ends at: nn_hls-1 408 ii2 = 2*nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 409 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 410 END DO 411 DO ji = 1, 1 ! point nn_hls 412 ii1 = nn_hls + ji - 1 413 ii2 = jpiglo - ii1 414 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 415 END DO 416 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls) 417 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 418 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1 419 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 420 END DO 421 DO ji = 1, 1 ! point jpiglo - nn_hls 422 ii1 = jpiglo - nn_hls + ji - 1 423 ii2 = ii1 424 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 425 END DO 426 DO ji = 1, nn_hls ! last nn_hls points 427 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 428 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls 429 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 430 END DO 431 END DO 432 ! 433 ! line number ipj-nn_hls : right half 434 DO jj = 1, 1 435 ij1 = ipj - nn_hls 436 ij2 = ij1 ! same line 437 ! 438 DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+1 to jpiglo - nn_hls-1 (note: Ni0glo = jpiglo - 2*nn_hls) 439 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 440 ii2 = jpiglo/2 - ji ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1 441 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 442 END DO 443 DO ji = 1, nn_hls-1 ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done) 444 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1 445 ii1 = ji ! ends at: nn_hls 446 ii2 = 2*nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 447 ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 448 END DO 449 ! ! last nn_hls points: have been / will done by e-w periodicity 450 END DO 451 ! 452 END DO; END DO 453 END SELECT ! NAT_IN(jf) 174 454 ! 175 CASE DEFAULT ! * closed : the code probably never go through 176 ! 177 SELECT CASE ( NAT_IN(jf) ) 178 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 179 ARRAY_IN(:, 1 ,:,:,jf) = 0._wp 180 ARRAY_IN(:,ipj,:,:,jf) = 0._wp 181 CASE ( 'F' ) ! F-point 182 ARRAY_IN(:,ipj,:,:,jf) = 0._wp 183 END SELECT 184 ! 185 END SELECT ! npolj 455 END SELECT ! npolj 186 456 ! 187 END DO 457 END DO ! ipf 188 458 ! 189 459 END SUBROUTINE ROUTINE_NFD … … 194 464 #undef NAT_IN 195 465 #undef SGN_IN 466 #undef J_SIZE 196 467 #undef K_SIZE 197 468 #undef L_SIZE
Note: See TracChangeset
for help on using the changeset viewer.
