Changeset 13286 for NEMO/trunk/src/OCE/LBC/lbc_nfd_nogather_generic.h90
- Timestamp:
- 2020-07-09T17:48:29+02:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/lbc_nfd_nogather_generic.h90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 2 2 ^/utils/build/makenemo@HEAD makenemo 3 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools /@HEADtools4 ^/utils/tools@HEAD tools 5 5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM … … 8 8 9 9 # SETTE 10 ^/utils/CI/ sette@12931sette10 ^/utils/CI/r12931_sette_ticket2366@HEAD sette
-
- Property svn:externals
-
NEMO/trunk/src/OCE/LBC/lbc_nfd_nogather_generic.h90
r13226 r13286 60 60 # define L_SIZE(ptab) SIZE(ptab,4) 61 61 # endif 62 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k,l)63 62 # define J_SIZE(ptab2) SIZE(ptab2,2) 63 # define ARRAY2_IN(i,j,k,l,f) ptab2(i,j,k,l) 64 64 # if defined SINGLE_PRECISION 65 65 # define ARRAY_TYPE(i,j,k,l,f) REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) … … 82 82 !! 83 83 !!---------------------------------------------------------------------- 84 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied85 ARRAY2_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied84 ARRAY_TYPE(:,:,:,:,:) 85 ARRAY2_TYPE(:,:,:,:,:) 86 86 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 87 87 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 88 88 INTEGER, OPTIONAL, INTENT(in ) :: kfld ! number of pt3d arrays 89 89 ! 90 INTEGER :: ji, jj, jk, 91 INTEGER :: ipi, ipj, ipk, ipl, ipf 92 INTEGER :: ijt, iju, ij pj, ijpjp1, ijta, ijua, jia, startloop, endloop90 INTEGER :: ji, jj, jk, jn, ii, jl, jh, jf ! dummy loop indices 91 INTEGER :: ipi, ipj, ipk, ipl, ipf, iij, ijj ! dimension of the input array 92 INTEGER :: ijt, iju, ijta, ijua, jia, startloop, endloop 93 93 LOGICAL :: l_fast_exchanges 94 94 !!---------------------------------------------------------------------- … … 100 100 ! Security check for further developments 101 101 IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' ) 102 !103 ijpj = 1 ! index of first modified line104 ijpjp1 = 2 ! index + 1105 106 102 ! 2nd dimension determines exchange speed 107 103 IF (ipj == 1 ) THEN … … 120 116 ! 121 117 CASE ( 'T' , 'W' ) ! T-, W-point 122 IF ( nimpp /= 1 ) THEN ; startloop = 1 123 ELSE ; startloop = 2 124 ENDIF 125 ! 126 DO jl = 1, ipl; DO jk = 1, ipk 127 DO ji = startloop, nlci 128 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 129 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 118 IF ( nimpp /= 1 ) THEN ; startloop = 1 119 ELSE ; startloop = 1 + nn_hls 120 ENDIF 121 ! 122 DO jl = 1, ipl; DO jk = 1, ipk 123 DO jj = 1, nn_hls 124 ijj = jpj -jj +1 125 DO ji = startloop, jpi 126 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 127 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 128 END DO 130 129 END DO 131 130 END DO; END DO 132 131 IF( nimpp == 1 ) THEN 133 132 DO jl = 1, ipl; DO jk = 1, ipk 134 ARRAY_IN(1,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-2,jk,jl,jf) 135 END DO; END DO 136 ENDIF 137 ! 138 IF ( .NOT. l_fast_exchanges ) THEN 139 IF( nimpp >= jpiglo/2+1 ) THEN 133 DO jj = 1, nn_hls 134 ijj = jpj -jj +1 135 DO ii = 0, nn_hls-1 136 ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl,jf) 137 END DO 138 END DO 139 END DO; END DO 140 ENDIF 141 ! 142 IF ( .NOT. l_fast_exchanges ) THEN 143 IF( nimpp >= Ni0glo/2+2 ) THEN 140 144 startloop = 1 141 ELSEIF( nimpp+ nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1) THEN142 startloop = jpiglo/2+1 - nimpp + 1143 ELSE 144 startloop = nlci + 1145 ENDIF 146 IF( startloop <= nlci ) THEN145 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 146 startloop = Ni0glo/2+2 - nimpp + nn_hls 147 ELSE 148 startloop = jpi + 1 149 ENDIF 150 IF( startloop <= jpi ) THEN 147 151 DO jl = 1, ipl; DO jk = 1, ipk 148 DO ji = startloop, nlci149 ijt = jpiglo - ji - nimpp - nfi impp(isendto(1),jpnj) + 4152 DO ji = startloop, jpi 153 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 150 154 jia = ji + nimpp - 1 151 155 ijta = jpiglo - jia + 2 152 156 IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 153 ARRAY_IN(ji, nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-1,jk,jl,jf)157 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf) 154 158 ELSE 155 ARRAY_IN(ji, nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)159 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 156 160 ENDIF 157 161 END DO … … 159 163 ENDIF 160 164 ENDIF 161 162 165 CASE ( 'U' ) ! U-point 163 IF( nimpp + nlci - 1 /= jpiglo ) THEN164 endloop = nlci166 IF( nimpp + jpi - 1 /= jpiglo ) THEN 167 endloop = jpi 165 168 ELSE 166 endloop = nlci - 1 167 ENDIF 168 DO jl = 1, ipl; DO jk = 1, ipk 169 DO ji = 1, endloop 170 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 171 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 169 endloop = jpi - nn_hls 170 ENDIF 171 DO jl = 1, ipl; DO jk = 1, ipk 172 DO jj = 1, nn_hls 173 ijj = jpj -jj +1 174 DO ji = 1, endloop 175 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 176 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 177 END DO 172 178 END DO 173 179 END DO; END DO 174 180 IF (nimpp .eq. 1) THEN 175 ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 176 ENDIF 177 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 178 ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 179 ENDIF 180 ! 181 IF ( .NOT. l_fast_exchanges ) THEN 182 IF( nimpp + nlci - 1 /= jpiglo ) THEN 183 endloop = nlci 184 ELSE 185 endloop = nlci - 1 186 ENDIF 187 IF( nimpp >= jpiglo/2 ) THEN 188 startloop = 1 189 ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 190 startloop = jpiglo/2 - nimpp + 1 181 DO jj = 1, nn_hls 182 ijj = jpj -jj +1 183 DO ii = 0, nn_hls-1 184 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 185 END DO 186 END DO 187 ENDIF 188 IF((nimpp + jpi - 1) .eq. jpiglo) THEN 189 DO jj = 1, nn_hls 190 ijj = jpj -jj +1 191 DO ii = 1, nn_hls 192 ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 193 END DO 194 END DO 195 ENDIF 196 ! 197 IF ( .NOT. l_fast_exchanges ) THEN 198 IF( nimpp + jpi - 1 /= jpiglo ) THEN 199 endloop = jpi 200 ELSE 201 endloop = jpi - nn_hls 202 ENDIF 203 IF( nimpp >= Ni0glo/2+1 ) THEN 204 startloop = nn_hls 205 ELSEIF( ( nimpp + jpi - 1 >= Ni0glo/2+1 ) .AND. ( nimpp < Ni0glo/2+1 ) ) THEN 206 startloop = Ni0glo/2+1 - nimpp + nn_hls 191 207 ELSE 192 208 startloop = endloop + 1 … … 195 211 DO jl = 1, ipl; DO jk = 1, ipk 196 212 DO ji = startloop, endloop 197 iju = jpiglo - ji - nimpp - nfi impp(isendto(1),jpnj) + 3198 jia = ji + nimpp - 1 199 ijua = jpiglo - jia + 1 213 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 214 jia = ji + nimpp - 1 215 ijua = jpiglo - jia + 1 200 216 IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 201 ARRAY_IN(ji, nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-1,jk,jl,jf)217 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,jpj-nn_hls,jk,jl,jf) 202 218 ELSE 203 ARRAY_IN(ji, nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)219 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 204 220 ENDIF 205 221 END DO … … 210 226 CASE ( 'V' ) ! V-point 211 227 IF( nimpp /= 1 ) THEN 212 startloop = 1 228 startloop = 1 213 229 ELSE 214 startloop = 2 215 ENDIF 216 IF ( .NOT. l_fast_exchanges ) THEN 217 DO jl = 1, ipl; DO jk = 1, ipk 218 DO ji = startloop, nlci 219 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 220 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 221 END DO 222 END DO; END DO 223 ENDIF 224 DO jl = 1, ipl; DO jk = 1, ipk 225 DO ji = startloop, nlci 226 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 227 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 230 startloop = 1 + nn_hls 231 ENDIF 232 IF ( .NOT. l_fast_exchanges ) THEN 233 DO jl = 1, ipl; DO jk = 1, ipk 234 DO jj = 2, nn_hls+1 235 ijj = jpj -jj +1 236 DO ji = startloop, jpi 237 ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 238 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 239 END DO 240 END DO 241 END DO; END DO 242 ENDIF 243 DO jl = 1, ipl; DO jk = 1, ipk 244 DO ji = startloop, jpi 245 ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 246 ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 228 247 END DO 229 248 END DO; END DO 230 249 IF (nimpp .eq. 1) THEN 231 ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-3,:,:,jf) 250 DO jj = 1, nn_hls 251 ijj = jpj-jj+1 252 DO ii = 0, nn_hls-1 253 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf) 254 END DO 255 END DO 232 256 ENDIF 233 257 CASE ( 'F' ) ! F-point 234 IF( nimpp + nlci - 1 /= jpiglo ) THEN235 endloop = nlci258 IF( nimpp + jpi - 1 /= jpiglo ) THEN 259 endloop = jpi 236 260 ELSE 237 endloop = nlci - 1 238 ENDIF 239 IF ( .NOT. l_fast_exchanges ) THEN 240 DO jl = 1, ipl; DO jk = 1, ipk 241 DO ji = 1, endloop 242 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 243 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 244 END DO 261 endloop = jpi - nn_hls 262 ENDIF 263 IF ( .NOT. l_fast_exchanges ) THEN 264 DO jl = 1, ipl; DO jk = 1, ipk 265 DO jj = 2, nn_hls+1 266 ijj = jpj -jj +1 267 DO ji = 1, endloop 268 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 269 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 270 END DO 271 END DO 245 272 END DO; END DO 246 273 ENDIF 247 274 DO jl = 1, ipl; DO jk = 1, ipk 248 275 DO ji = 1, endloop 249 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 250 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 251 END DO 252 END DO; END DO 253 IF (nimpp .eq. 1) THEN 254 ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-3,:,:,jf) 255 IF ( .NOT. l_fast_exchanges ) & 256 ARRAY_IN(1,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 257 ENDIF 258 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 259 ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-3,:,:,jf) 260 IF ( .NOT. l_fast_exchanges ) & 261 ARRAY_IN(nlci,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 262 ENDIF 263 ! 264 END SELECT 276 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 277 ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 278 END DO 279 END DO; END DO 280 IF (nimpp .eq. 1) THEN 281 DO ii = 1, nn_hls 282 ARRAY_IN(ii,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf) 283 END DO 284 IF ( .NOT. l_fast_exchanges ) THEN 285 DO jj = 1, nn_hls 286 ijj = jpj -jj 287 DO ii = 0, nn_hls-1 288 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 289 END DO 290 END DO 291 ENDIF 292 ENDIF 293 IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN 294 DO ii = 1, nn_hls 295 ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf) 296 END DO 297 IF ( .NOT. l_fast_exchanges ) THEN 298 DO jj = 1, nn_hls 299 ijj = jpj -jj 300 DO ii = 1, nn_hls 301 ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 302 END DO 303 END DO 304 ENDIF 305 ENDIF 306 ! 307 END SELECT 265 308 ! 266 309 CASE ( 5, 6 ) ! * North fold F-point pivot … … 269 312 CASE ( 'T' , 'W' ) ! T-, W-point 270 313 DO jl = 1, ipl; DO jk = 1, ipk 271 DO ji = 1, nlci 272 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 273 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 274 END DO 314 DO jj = 1, nn_hls 315 ijj = jpj-jj+1 316 DO ji = 1, jpi 317 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 318 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 319 END DO 320 END DO 275 321 END DO; END DO 276 322 ! 277 323 CASE ( 'U' ) ! U-point 278 IF( nimpp + nlci - 1 /= jpiglo ) THEN279 endloop = nlci324 IF( nimpp + jpi - 1 /= jpiglo ) THEN 325 endloop = jpi 280 326 ELSE 281 endloop = nlci - 1 282 ENDIF 283 DO jl = 1, ipl; DO jk = 1, ipk 284 DO ji = 1, endloop 285 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 286 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 287 END DO 288 END DO; END DO 289 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 290 DO jl = 1, ipl; DO jk = 1, ipk 291 ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf) 327 endloop = jpi - nn_hls 328 ENDIF 329 DO jl = 1, ipl; DO jk = 1, ipk 330 DO jj = 1, nn_hls 331 ijj = jpj-jj+1 332 DO ji = 1, endloop 333 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 334 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 335 END DO 336 END DO 337 END DO; END DO 338 IF(nimpp + jpi - 1 .eq. jpiglo) THEN 339 DO jl = 1, ipl; DO jk = 1, ipk 340 DO jj = 1, nn_hls 341 ijj = jpj-jj+1 342 DO ii = 1, nn_hls 343 iij = jpi-ii+1 344 ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl,jf) 345 END DO 346 END DO 292 347 END DO; END DO 293 348 ENDIF … … 295 350 CASE ( 'V' ) ! V-point 296 351 DO jl = 1, ipl; DO jk = 1, ipk 297 DO ji = 1, nlci 298 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 299 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 352 DO jj = 1, nn_hls 353 ijj = jpj -jj +1 354 DO ji = 1, jpi 355 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 356 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 357 END DO 300 358 END DO 301 359 END DO; END DO 302 360 303 361 IF ( .NOT. l_fast_exchanges ) THEN 304 IF( nimpp >= jpiglo/2+1) THEN362 IF( nimpp >= Ni0glo/2+2 ) THEN 305 363 startloop = 1 306 ELSEIF( nimpp+ nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1) THEN307 startloop = jpiglo/2+1 - nimpp + 1308 ELSE 309 startloop = nlci + 1310 ENDIF 311 IF( startloop <= nlci ) THEN312 DO jl = 1, ipl; DO jk = 1, ipk 313 DO ji = startloop, nlci314 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3315 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)316 END DO364 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 365 startloop = Ni0glo/2+2 - nimpp + nn_hls 366 ELSE 367 startloop = jpi + 1 368 ENDIF 369 IF( startloop <= jpi ) THEN 370 DO jl = 1, ipl; DO jk = 1, ipk 371 DO ji = startloop, jpi 372 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 373 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 374 END DO 317 375 END DO; END DO 318 376 ENDIF … … 320 378 ! 321 379 CASE ( 'F' ) ! F-point 322 IF( nimpp + nlci - 1 /= jpiglo ) THEN323 endloop = nlci380 IF( nimpp + jpi - 1 /= jpiglo ) THEN 381 endloop = jpi 324 382 ELSE 325 endloop = nlci - 1 326 ENDIF 327 DO jl = 1, ipl; DO jk = 1, ipk 328 DO ji = 1, endloop 329 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 330 ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 331 END DO 332 END DO; END DO 333 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 334 DO jl = 1, ipl; DO jk = 1, ipk 335 ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-2,jk,jl,jf) 336 END DO; END DO 337 ENDIF 338 ! 339 IF ( .NOT. l_fast_exchanges ) THEN 340 IF( nimpp + nlci - 1 /= jpiglo ) THEN 341 endloop = nlci 342 ELSE 343 endloop = nlci - 1 344 ENDIF 345 IF( nimpp >= jpiglo/2+1 ) THEN 346 startloop = 1 347 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 348 startloop = jpiglo/2+1 - nimpp + 1 383 endloop = jpi - nn_hls 384 ENDIF 385 DO jl = 1, ipl; DO jk = 1, ipk 386 DO jj = 1, nn_hls 387 ijj = jpj -jj +1 388 DO ji = 1, endloop 389 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 390 ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 391 END DO 392 END DO 393 END DO; END DO 394 IF((nimpp + jpi - 1) .eq. jpiglo) THEN 395 DO jl = 1, ipl; DO jk = 1, ipk 396 DO jj = 1, nn_hls 397 ijj = jpj -jj +1 398 DO ii = 1, nn_hls 399 iij = jpi -ii+1 400 ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl,jf) 401 END DO 402 END DO 403 END DO; END DO 404 ENDIF 405 ! 406 IF ( .NOT. l_fast_exchanges ) THEN 407 IF( nimpp + jpi - 1 /= jpiglo ) THEN 408 endloop = jpi 409 ELSE 410 endloop = jpi - nn_hls 411 ENDIF 412 IF( nimpp >= Ni0glo/2+2 ) THEN 413 startloop = 1 414 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 415 startloop = Ni0glo/2+2 - nimpp + nn_hls 349 416 ELSE 350 417 startloop = endloop + 1 … … 353 420 DO jl = 1, ipl; DO jk = 1, ipk 354 421 DO ji = startloop, endloop 355 iju = jpiglo - ji - nimpp - nfi impp(isendto(1),jpnj) + 2356 ARRAY_IN(ji, nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)422 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 423 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 357 424 END DO 358 425 END DO; END DO
Note: See TracChangeset
for help on using the changeset viewer.
