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