- Timestamp:
- 2020-04-23T15:14:45+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC
- Files:
-
- 8 edited
-
halo_mng.F90 (modified) (3 diffs)
-
lbc_nfd_ext_generic.h90 (modified) (1 diff)
-
lbc_nfd_generic.h90 (modified) (1 diff)
-
lbc_nfd_nogather_generic.h90 (modified) (19 diffs)
-
lbclnk.F90 (modified) (4 diffs)
-
mpp_lnk_generic.h90 (modified) (4 diffs)
-
mpp_nfd_generic.h90 (modified) (9 diffs)
-
mppini.F90 (modified) (47 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/halo_mng.F90
r12719 r12807 26 26 INTEGER :: jpi_1, jpj_1 27 27 INTEGER :: jpimax_1, jpjmax_1 28 INTEGER :: nlci_1, nlcj_1 29 INTEGER :: nldi_1, nldj_1 30 INTEGER :: nlei_1, nlej_1 28 INTEGER :: Nis0_1, Njs0_1 29 INTEGER :: Nie0_1, Nje0_1 31 30 CONTAINS 32 31 … … 36 35 jpj_1 = jpj 37 36 38 nlci_1 = nlci39 nlcj_1 = nlcj37 Nis0_1 = Nis0 38 Njs0_1 = Njs0 40 39 41 nldi_1 = nldi 42 nldj_1 = nldj 43 44 nlei_1 = nlei 45 nlej_1 = nlej 40 Nie0_1 = Nie0 41 Nje0_1 = Nje0 46 42 47 43 jpimax_1 = jpimax … … 59 55 jpj = jpj_1 + 2*khls -2 60 56 61 nlci = nlci_1 + 2*khls -262 nlcj = nlcj_1 + 2*khls -257 jpi = jpi_1 + 2*khls -2 58 jpj = jpj_1 + 2*khls -2 63 59 64 60 jpimax = jpimax_1 + 2*khls -2 65 61 jpjmax = jpjmax_1 + 2*khls -2 66 62 67 nldi = nldi_1 + khls - 168 nldj = nldj_1 + khls - 163 Nis0 = Nis0_1 + khls - 1 64 Njs0 = Njs0_1 + khls - 1 69 65 70 nlei = nlei_1 + khls - 171 nlej = nlej_1 + khls - 166 Nie0 = Nie0_1 + khls - 1 67 Nje0 = Nje0_1 + khls - 1 72 68 73 69 END SUBROUTINE halo_mng_set -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_ext_generic.h90
r10525 r12807 28 28 ! 29 29 SELECT CASE ( jpni ) 30 CASE ( 1 ) ; ipj = nlcj! 1 proc only along the i-direction30 CASE ( 1 ) ; ipj = jpj ! 1 proc only along the i-direction 31 31 CASE DEFAULT ; ipj = 4 ! several proc along the i-direction 32 32 END SELECT -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_generic.h90
r10425 r12807 65 65 ! 66 66 SELECT CASE ( jpni ) 67 CASE ( 1 ) ; ipj = nlcj! 1 proc only along the i-direction67 CASE ( 1 ) ; ipj = jpj ! 1 proc only along the i-direction 68 68 CASE DEFAULT ; ipj = 4 ! several proc along the i-direction 69 69 END SELECT -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_nogather_generic.h90
r12719 r12807 97 97 DO jl = 1, ipl; DO jk = 1, ipk 98 98 DO jj = 1, nn_hls 99 ijj = nlcj -jj +1100 DO ji = startloop, nlci99 ijj = jpj -jj +1 100 DO ji = startloop, jpi 101 101 ijt = jpiglo - (ji + nimpp-nn_hls+1 ) - nfiimpp(isendto(1),jpnj) + 4 102 102 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) … … 107 107 DO jl = 1, ipl; DO jk = 1, ipk 108 108 DO jj = 1, nn_hls 109 ijj = nlcj -jj +1109 ijj = jpj -jj +1 110 110 DO ii = 0, nn_hls-1 111 ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1, nlcj-2*nn_hls+jj-1,jk,jl,jf)111 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) 112 112 END DO 113 113 END DO … … 118 118 IF( nimpp >= jpiglo/2+1 ) THEN 119 119 startloop = 1 120 ELSEIF( nimpp+ nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN120 ELSEIF( nimpp+jpi-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 121 121 startloop = jpiglo/2+1 - nimpp + nn_hls 122 122 ELSE 123 startloop = nlci + 1124 ENDIF 125 IF( startloop <= nlci ) THEN123 startloop = jpi + 1 124 ENDIF 125 IF( startloop <= jpi ) THEN 126 126 DO jl = 1, ipl; DO jk = 1, ipk 127 DO ji = startloop, nlci127 DO ji = startloop, jpi 128 128 ijt = jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 129 129 jia = ji + nimpp -nn_hls 130 130 ijta = jpiglo - jia + 2 131 131 IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 132 ARRAY_IN(ji, nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,nlcj-nn_hls,jk,jl,jf)132 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf) 133 133 ELSE 134 ARRAY_IN(ji, nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf)134 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 135 135 ENDIF 136 136 END DO … … 139 139 ENDIF 140 140 CASE ( 'U' ) ! U-point 141 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN142 endloop = nlci141 IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 142 endloop = jpi 143 143 ELSE 144 endloop = nlci - nn_hls145 ENDIF 146 DO jl = 1, ipl; DO jk = 1, ipk 147 DO jj = 1, nn_hls 148 ijj = nlcj -jj +1144 endloop = jpi - nn_hls 145 ENDIF 146 DO jl = 1, ipl; DO jk = 1, ipk 147 DO jj = 1, nn_hls 148 ijj = jpj -jj +1 149 149 DO ji = 1, endloop 150 150 iju = jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 3 … … 155 155 IF (nimpp .eq. 1) THEN 156 156 DO jj = 1, nn_hls 157 ijj = nlcj -jj +1157 ijj = jpj -jj +1 158 158 DO ii = 0, nn_hls-1 159 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii, nlcj-2*nn_hls+jj-1,:,:,jf)159 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 160 160 END DO 161 161 END DO 162 162 ENDIF 163 IF((nimpp + nlci - 2*nn_hls+1) .eq. jpiglo) THEN163 IF((nimpp + jpi - 2*nn_hls+1) .eq. jpiglo) THEN 164 164 DO jj = 1, nn_hls 165 ijj = nlcj -jj +1165 ijj = jpj -jj +1 166 166 DO ii = 1, nn_hls 167 ARRAY_IN( nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf)167 ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 168 168 END DO 169 169 END DO … … 171 171 ! 172 172 IF ( .NOT. l_fast_exchanges ) THEN 173 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN174 endloop = nlci175 ELSE 176 endloop = nlci - nn_hls173 IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 174 endloop = jpi 175 ELSE 176 endloop = jpi - nn_hls 177 177 ENDIF 178 178 IF( nimpp >= jpiglo/2 ) THEN 179 179 startloop = 1 180 ELSEIF( ( nimpp + nlci - 2*nn_hls+1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN180 ELSEIF( ( nimpp + jpi - 2*nn_hls+1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 181 181 startloop = jpiglo/2 - (nimpp -nn_hls+1) +1 182 182 ELSE … … 190 190 ijua = jpiglo - jia + 1 191 191 IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 192 ARRAY_IN(ji, nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+nn_hls,nlcj-nn_hls,jk,jl,jf)192 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf) 193 193 ELSE 194 ARRAY_IN(ji, nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf)194 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 195 195 ENDIF 196 196 END DO … … 208 208 DO jl = 1, ipl; DO jk = 1, ipk 209 209 DO jj = 2, nn_hls+1 210 ijj = nlcj -jj +1211 DO ji = startloop, nlci210 ijj = jpj -jj +1 211 DO ji = startloop, jpi 212 212 ijt=jpiglo - (ji +nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 213 213 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) … … 217 217 ENDIF 218 218 DO jl = 1, ipl; DO jk = 1, ipk 219 DO ji = startloop, nlci219 DO ji = startloop, jpi 220 220 ijt=jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 221 ARRAY_IN(ji, nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf)221 ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 222 222 END DO 223 223 END DO; END DO 224 224 IF (nimpp .eq. 1) THEN 225 225 DO jj = 1, nn_hls 226 ijj = nlcj-jj+1226 ijj = jpj-jj+1 227 227 DO ii = 0, nn_hls-1 228 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1, nlcj-2*nn_hls+jj-1,:,:,jf)228 ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf) 229 229 END DO 230 230 END DO 231 231 ENDIF 232 232 CASE ( 'F' ) ! F-point 233 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN234 endloop = nlci233 IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 234 endloop = jpi 235 235 ELSE 236 endloop = nlci - nn_hls236 endloop = jpi - nn_hls 237 237 ENDIF 238 238 IF ( .NOT. l_fast_exchanges ) THEN 239 239 DO jl = 1, ipl; DO jk = 1, ipk 240 240 DO jj = 2, nn_hls+1 241 ijj = nlcj -jj +1241 ijj = jpj -jj +1 242 242 DO ji = 1, endloop 243 243 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 … … 250 250 DO ji = 1, endloop 251 251 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 252 ARRAY_IN(ji, nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf)252 ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 253 253 END DO 254 254 END DO; END DO 255 255 IF (nimpp .eq. 1) THEN 256 256 DO ii = 1, nn_hls 257 ARRAY_IN(ii+1, nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls-1,:,:,jf)257 ARRAY_IN(ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf) 258 258 END DO 259 259 IF ( .NOT. l_fast_exchanges ) THEN 260 260 DO jj = 1, nn_hls 261 ijj = nlcj -jj261 ijj = jpj -jj 262 262 DO ii = 1, nn_hls 263 ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii, nlcj-2*nn_hls+jj-1,:,:,jf)263 ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 264 264 END DO 265 265 END DO 266 266 ENDIF 267 267 ENDIF 268 IF((nimpp + nlci - 2*nn_hls+1 ) .eq. jpiglo) THEN268 IF((nimpp + jpi - 2*nn_hls+1 ) .eq. jpiglo) THEN 269 269 DO ii = 1, nn_hls 270 ARRAY_IN( nlci-ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls-1,:,:,jf)270 ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf) 271 271 END DO 272 272 IF ( .NOT. l_fast_exchanges ) THEN 273 273 DO jj = 1, nn_hls 274 ijj = nlcj -jj274 ijj = jpj -jj 275 275 DO ii = 1, nn_hls 276 ARRAY_IN( nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf)276 ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 277 277 END DO 278 278 END DO … … 288 288 DO jl = 1, ipl; DO jk = 1, ipk 289 289 DO jj = 1, nn_hls 290 ijj = nlcj-jj+1291 DO ji = 1, nlci290 ijj = jpj-jj+1 291 DO ji = 1, jpi 292 292 ijt = jpiglo - ( ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 293 293 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) … … 297 297 ! 298 298 CASE ( 'U' ) ! U-point 299 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN300 endloop = nlci299 IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 300 endloop = jpi 301 301 ELSE 302 endloop = nlci - nn_hls303 ENDIF 304 DO jl = 1, ipl; DO jk = 1, ipk 305 DO jj = 1, nn_hls 306 ijj = nlcj-jj+1302 endloop = jpi - nn_hls 303 ENDIF 304 DO jl = 1, ipl; DO jk = 1, ipk 305 DO jj = 1, nn_hls 306 ijj = jpj-jj+1 307 307 DO ji = 1, endloop 308 308 iju = jpiglo- (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 … … 311 311 END DO 312 312 END DO; END DO 313 IF(nimpp + nlci - 2*nn_hls+1 .eq. jpiglo) THEN313 IF(nimpp + jpi - 2*nn_hls+1 .eq. jpiglo) THEN 314 314 DO jl = 1, ipl; DO jk = 1, ipk 315 315 DO jj = 1, nn_hls 316 ijj = nlcj-jj+1316 ijj = jpj-jj+1 317 317 DO ii = 1, nn_hls 318 iij = nlci-ii+1319 ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN( nlci-2*nn_hls+ii-1,nlcj-2*nn_hls+jj,jk,jl,jf)318 iij = jpi-ii+1 319 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) 320 320 END DO 321 321 END DO … … 326 326 DO jl = 1, ipl; DO jk = 1, ipk 327 327 DO jj = 1, nn_hls 328 ijj = nlcj -jj +1329 DO ji = 1, nlci328 ijj = jpj -jj +1 329 DO ji = 1, jpi 330 330 ijt = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 331 331 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) … … 337 337 IF( nimpp >= jpiglo/2+1 ) THEN 338 338 startloop = 1 339 ELSEIF( nimpp+ nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN339 ELSEIF( nimpp+jpi-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 340 340 startloop = jpiglo/2+1 - nimpp + nn_hls 341 341 ELSE 342 startloop = nlci + 1343 ENDIF 344 IF( startloop <= nlci ) THEN345 DO jl = 1, ipl; DO jk = 1, ipk 346 DO ji = startloop, nlci342 startloop = jpi + 1 343 ENDIF 344 IF( startloop <= jpi ) THEN 345 DO jl = 1, ipl; DO jk = 1, ipk 346 DO ji = startloop, jpi 347 347 ijt = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 348 ARRAY_IN(ji, nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf)348 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 349 349 END DO 350 350 END DO; END DO … … 353 353 ! 354 354 CASE ( 'F' ) ! F-point 355 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN356 endloop = nlci355 IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 356 endloop = jpi 357 357 ELSE 358 endloop = nlci - nn_hls359 ENDIF 360 DO jl = 1, ipl; DO jk = 1, ipk 361 DO jj = 1, nn_hls 362 ijj = nlcj -jj +1358 endloop = jpi - nn_hls 359 ENDIF 360 DO jl = 1, ipl; DO jk = 1, ipk 361 DO jj = 1, nn_hls 362 ijj = jpj -jj +1 363 363 DO ji = 1, endloop 364 364 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 … … 367 367 END DO 368 368 END DO; END DO 369 IF((nimpp + nlci - 2*nn_hls+1) .eq. jpiglo) THEN369 IF((nimpp + jpi - 2*nn_hls+1) .eq. jpiglo) THEN 370 370 DO jl = 1, ipl; DO jk = 1, ipk 371 371 DO jj = 1, nn_hls 372 ijj = nlcj -jj +1372 ijj = jpj -jj +1 373 373 DO ii = 1, nn_hls 374 iij = nlci -ii+1375 ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN( nlci-2*nn_hls+ii-1,nlcj-2*nn_hls+jj-1,jk,jl,jf)374 iij = jpi -ii+1 375 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) 376 376 END DO 377 377 END DO … … 380 380 ! 381 381 IF ( .NOT. l_fast_exchanges ) THEN 382 IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN383 endloop = nlci384 ELSE 385 endloop = nlci - nn_hls382 IF( nimpp + jpi - 2*nn_hls+1 /= jpiglo ) THEN 383 endloop = jpi 384 ELSE 385 endloop = jpi - nn_hls 386 386 ENDIF 387 387 IF( nimpp >= jpiglo/2+1 ) THEN 388 388 startloop = 1 389 ELSEIF( nimpp+ nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN389 ELSEIF( nimpp+jpi-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 390 390 startloop = jpiglo/2+1 - nimpp + nn_hls 391 391 ELSE … … 396 396 DO ji = startloop, endloop 397 397 iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 398 ARRAY_IN(ji, nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf)398 ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 399 399 END DO 400 400 END DO; END DO -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbclnk.F90
r12377 r12807 248 248 ! 249 249 INTEGER :: ji, jj, jr 250 INTEGER :: ierr, itaille, i ldi, ilei, iilb250 INTEGER :: ierr, itaille, iis0, iie0, iilb 251 251 INTEGER :: ipj, ij, iproc 252 252 ! … … 282 282 DO jr = 1, ndim_rank_north ! recover the global north array 283 283 iproc = nrank_north(jr) + 1 284 i ldi = nldit(iproc)285 i lei = nleit(iproc)284 iis0 = nis0all(iproc) 285 iie0 = nie0all(iproc) 286 286 iilb = nimppt(iproc) 287 287 DO jj = 1-kextj, ipj+kextj 288 DO ji = i ldi, ilei288 DO ji = iis0, iie0 289 289 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 290 290 END DO … … 396 396 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 397 397 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 398 iihom = jpi -nreci-kexti398 iihom = jpi - (2 * nn_hls) - kexti 399 399 DO jl = 1, ipreci 400 400 r2dew(:,jl,1) = pt2d(nn_hls+jl,:) … … 453 453 ! 454 454 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 455 ijhom = jpj -nrecj-kextj455 ijhom = jpj - ( 2 * nn_hls ) -kextj 456 456 DO jl = 1, iprecj 457 457 r2dsn(:,jl,1) = pt2d(:,ijhom +jl) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90
r12719 r12807 189 189 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 190 190 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf) ! 1 -> nn_hls 191 END DO ; END DO ; END DO ; END DO ; END DO191 END DO ; END DO ; END DO ; END DO ; END DO 192 192 CASE ( jpfillperio ) ! use east-weast periodicity 193 193 ishift2 = jpi - 2 * nn_hls 194 194 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 195 195 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 196 END DO ; END DO ; END DO ; END DO ; END DO196 END DO ; END DO ; END DO ; END DO ; END DO 197 197 CASE ( jpfillcopy ) ! filling with inner domain values 198 DO jf = 1, ipf ! number of arrays to be treated 199 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 200 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 201 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf) 202 END DO ; END DO ; END DO ; END DO 203 ENDIF 204 END DO 198 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 199 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf) 200 END DO ; END DO ; END DO ; END DO ; END DO 205 201 CASE ( jpfillcst ) ! filling with constant value 206 DO jf = 1, ipf ! number of arrays to be treated 207 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 208 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 209 ARRAY_IN(ji,jj,jk,jl,jf) = zland 210 END DO; END DO ; END DO ; END DO 211 ENDIF 212 END DO 202 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 203 ARRAY_IN(ji,jj,jk,jl,jf) = zland 204 END DO ; END DO ; END DO ; END DO ; END DO 213 205 END SELECT 214 206 ! … … 234 226 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 235 227 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 236 END DO ; END DO ; END DO ; END DO ; END DO228 END DO ; END DO ; END DO ; END DO ; END DO 237 229 END SELECT 238 230 ! … … 303 295 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 304 296 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf) ! 1 -> nn_hls 305 END DO ; END DO ; END DO ; END DO ; END DO297 END DO ; END DO ; END DO ; END DO ; END DO 306 298 CASE ( jpfillperio ) ! use north-south periodicity 307 299 ishift2 = jpj - 2 * nn_hls 308 300 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 309 301 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 310 END DO ; END DO ; END DO ; END DO ; END DO302 END DO ; END DO ; END DO ; END DO ; END DO 311 303 CASE ( jpfillcopy ) ! filling with inner domain values 312 DO jf = 1, ipf ! number of arrays to be treated 313 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 314 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 315 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 316 END DO ; END DO ; END DO ; END DO 317 ENDIF 318 END DO 304 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 305 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 306 END DO ; END DO ; END DO ; END DO ; END DO 319 307 CASE ( jpfillcst ) ! filling with constant value 320 DO jf = 1, ipf ! number of arrays to be treated 321 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 322 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 323 ARRAY_IN(ji,jj,jk,jl,jf) = zland 324 END DO; END DO ; END DO ; END DO 325 ENDIF 326 END DO 308 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 309 ARRAY_IN(ji,jj,jk,jl,jf) = zland 310 END DO ; END DO ; END DO ; END DO ; END DO 327 311 END SELECT 328 312 ! … … 340 324 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 341 325 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 342 END DO ; END DO ; END DO ; END DO ; END DO326 END DO ; END DO ; END DO ; END DO ; END DO 343 327 CASE ( jpfillcopy ) ! filling with inner domain values 344 328 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 345 329 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 346 END DO ; END DO ; END DO ; END DO ; END DO330 END DO ; END DO ; END DO ; END DO ; END DO 347 331 CASE ( jpfillcst ) ! filling with constant value 348 332 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 349 333 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 350 END DO ; END DO ; END DO ; END DO ; END DO334 END DO ; END DO ; END DO ; END DO ; END DO 351 335 END SELECT 352 336 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90
r12719 r12807 56 56 INTEGER :: ipi, ipk, ipl, ipf ! dimension of the input array 57 57 INTEGER :: imigr, iihom, ijhom ! local integers 58 INTEGER :: ierr, ibuffsize, i lci, ildi, ilei, iilb58 INTEGER :: ierr, ibuffsize, ijpi, iis0, iie0, iilb 59 59 INTEGER :: ij, iproc 60 60 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather … … 111 111 CASE ( 'T' , 'W' ,'U' ) ! T-, U-, W-point 112 112 DO ji = 1, nn_hls+1 113 jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1113 jj_s(jf,ji) = jpj - 2*nn_hls +ji -1 114 114 ENDDO 115 115 CASE ( 'V' , 'F' ) ! V-, F-point 116 116 DO ji = 1, nn_hls+1 117 jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2117 jj_s(jf,ji) = jpj - 2*nn_hls +ji - 2 118 118 ENDDO 119 119 END SELECT … … 124 124 CASE ( 'T' , 'W' ,'U' ) ! T-, U-, W-point 125 125 DO ji = 1, nn_hls 126 jj_s(jf,ji) = nlcj - 2*nn_hls + ji126 jj_s(jf,ji) = jpj - 2*nn_hls + ji 127 127 ENDDO 128 128 ipj_s(jf) = nn_hls ! need only one line anyway 129 129 CASE ( 'V' , 'F' ) ! V-, F-point 130 130 DO ji = 1, nn_hls+1 131 jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1131 jj_s(jf,ji) = jpj - 2*nn_hls +ji -1 132 132 ENDDO 133 133 END SELECT … … 175 175 iproc = nfipproc(isendto(jr),jpnj) 176 176 IF(iproc /= -1) THEN 177 iilb = nimppt(iproc+1)178 i lci = nlcit(iproc+1)179 i ldi = nldit(iproc+1) + nn_hls-1180 i lei = nleit(iproc+1) + nn_hls-1181 IF( iilb == 1 ) i ldi= nn_hls ! e-w boundary already done -> force to take 1st column182 IF( iilb + i lci - 1 == jpiglo ) ilei = nlei+1 ! e-w boundary already done -> force to take last column177 iilb = nimppt(iproc+1) 178 ijpi = jpiall(iproc+1) 179 iis0 = nis0all(iproc+1) + nn_hls-1 180 iie0 = nie0all(iproc+1) + nn_hls-1 181 IF( iilb == 1 ) iis0 = nn_hls ! e-w boundary already done -> force to take 1st column 182 IF( iilb + ijpi - 1 == jpiglo ) iie0 = Nie0+1 ! e-w boundary already done -> force to take last column 183 183 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 184 184 ENDIF … … 190 190 DO jl = 1, ipl 191 191 DO jk = 1, ipk 192 DO ji = i ldi, ilei192 DO ji = iis0, iie0 193 193 ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1) 194 194 END DO … … 200 200 DO jl = 1, ipl 201 201 DO jk = 1, ipk 202 DO ji = i ldi, ilei202 DO ji = iis0, iie0 203 203 ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf) 204 204 END DO … … 233 233 DO jl = 1, ipl 234 234 DO jk = 1, ipk 235 DO jj = nlcj - ijpj +1, nlcj236 ij = jj - nlcj + ijpj235 DO jj = jpj - ijpj +1, jpj 236 ij = jj - jpj + ijpj 237 237 znorthloc(1:jpi,ij,jk,jl,jf) = ARRAY_IN(1:jpi,jj,jk,jl,jf) 238 238 END DO … … 262 262 DO jr = 1, ndim_rank_north ! recover the global north array 263 263 iproc = nrank_north(jr) + 1 264 iilb = nimppt(iproc)265 i lci = nlcit(iproc)266 i ldi = nldit(iproc)267 i lei = nleit(iproc)268 IF( iilb == 1 ) i ldi= 1 ! e-w boundary already done -> force to take 1st column269 IF( iilb + i lci - 1 == jpiglo ) ilei = ilci ! e-w boundary already done -> force to take last column264 iilb = nimppt(iproc) 265 ijpi = jpiall(iproc) 266 iis0 = nis0all(iproc) 267 iie0 = nie0all(iproc) 268 IF( iilb == 1 ) iis0 = 1 ! e-w boundary already done -> force to take 1st column 269 IF( iilb + ijpi - 1 == jpiglo ) iie0 = ijpi ! e-w boundary already done -> force to take last column 270 270 DO jf = 1, ipf 271 271 DO jl = 1, ipl 272 272 DO jk = 1, ipk 273 273 DO jj = 1, ijpj 274 DO ji = i ldi, ilei274 DO ji = iis0, iie0 275 275 ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr) 276 276 END DO … … 287 287 DO jl = 1, ipl 288 288 DO jk = 1, ipk 289 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to ARRAY_IN290 ij = jj - nlcj + ijpj291 DO ji= 1, nlci289 DO jj = jpj-ijpj+1, jpj ! Scatter back to ARRAY_IN 290 ij = jj - jpj + ijpj 291 DO ji= 1, jpi 292 292 ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf) 293 293 END DO -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90
r12760 r12807 59 59 !!---------------------------------------------------------------------- 60 60 ! 61 jpiglo = Ni0glo 62 jpjglo = Nj0glo 61 63 jpimax = jpiglo 62 64 jpjmax = jpjglo … … 76 78 nimpp = 1 ! 77 79 njmpp = 1 78 nlci = jpi79 nlcj = jpj80 nldi = 181 nldj = 182 nlei = jpi83 nlej = jpj84 80 nbondi = 2 85 81 nbondj = 2 … … 131 127 !! njmpp : latitudinal index 132 128 !! narea : number for local area 133 !! nlci : first dimension134 !! nlcj : second dimension135 129 !! nbondi : mark for "east-west local boundary" 136 130 !! nbondj : mark for "north-south local boundary" … … 158 152 INTEGER, ALLOCATABLE, DIMENSION(:) :: iin, ii_nono, ii_noea ! 1D workspace 159 153 INTEGER, ALLOCATABLE, DIMENSION(:) :: ijn, ii_noso, ii_nowe ! - - 160 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, i lci, ibondi, ipproc ! 2D workspace161 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, i lcj, ibondj, ipolj ! - -162 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: i lei, ildi, iono, ioea ! - -163 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: i lej, ildj, ioso, iowe ! - -154 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi, ibondi, ipproc ! 2D workspace 155 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj, ibondj, ipolj ! - - 156 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iie0, iis0, iono, ioea ! - - 157 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ije0, ijs0, ioso, iowe ! - - 164 158 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: llisoce ! - - 165 159 NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file, & … … 194 188 ! 195 189 IF(lwm) WRITE( numond, nammpp ) 196 190 ! 191 !!!------------------------------------ 192 !!! nn_hls shloud be read in nammpp 193 !!!------------------------------------ 194 jpiglo = Ni0glo + 2 * nn_hls 195 jpjglo = Nj0glo + 2 * nn_hls 196 ! 197 197 ! do we need to take into account bdy_msk? 198 198 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) … … 204 204 IF( ln_bdy .AND. ln_mask_file ) CALL iom_open( cn_mask_file, numbdy ) 205 205 ! 206 IF( ln_listonly ) CALL mpp_init_bestpartition( MAX(mppsize,jpni*jpnj), ldlist = .TRUE. ) ! must be done by all core206 IF( ln_listonly ) CALL bestpartition( MAX(mppsize,jpni*jpnj), ldlist = .TRUE. ) ! must be done by all core 207 207 ! 208 208 ! 1. Dimension arrays for subdomains 209 209 ! ----------------------------------- 210 210 ! 211 ! If dimensions of processor grid weren't specified in the namelist file211 ! If dimensions of processors grid weren't specified in the namelist file 212 212 ! then we calculate them here now that we have our communicator size 213 213 IF(lwp) THEN … … 217 217 ENDIF 218 218 IF( jpni < 1 .OR. jpnj < 1 ) THEN 219 CALL mpp_init_bestpartition( mppsize, jpni, jpnj ) ! best mpi decomposition for mppsize mpi processes219 CALL bestpartition( mppsize, jpni, jpnj ) ! best mpi decomposition for mppsize mpi processes 220 220 llauto = .TRUE. 221 221 llbest = .TRUE. 222 222 ELSE 223 223 llauto = .FALSE. 224 CALL mpp_init_bestpartition( mppsize, inbi, inbj, icnt2 ) ! best mpi decomposition for mppsize mpi processes224 CALL bestpartition( mppsize, inbi, inbj, icnt2 ) ! best mpi decomposition for mppsize mpi processes 225 225 ! largest subdomain size for mpi decoposition jpni*jpnj given in the namelist 226 CALL mpp_basic_decomposition(jpni, jpnj, jpimax, jpjmax )227 ! largest subdomain size for mpi decoposition inbi*inbj given by mpp_init_bestpartition228 CALL mpp_basic_decomposition(inbi, inbj, iimax, ijmax )226 CALL basic_decomposition( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax ) 227 ! largest subdomain size for mpi decoposition inbi*inbj given by bestpartition 228 CALL basic_decomposition( jpiglo, jpjglo, nn_hls, inbi, inbj, iimax, ijmax ) 229 229 icnt1 = jpni*jpnj - mppsize ! number of land subdomains that should be removed to use mppsize mpi processes 230 230 IF(lwp) THEN … … 257 257 ! look for land mpi subdomains... 258 258 ALLOCATE( llisoce(jpni,jpnj) ) 259 CALL mpp_init_isoce( jpni, jpnj, llisoce )259 CALL is_ocean( jpni, jpnj, llisoce ) 260 260 inijmin = COUNT( llisoce ) ! number of oce subdomains 261 261 … … 266 266 WRITE(ctmp4,*) ' ==>>> There is the list of best domain decompositions you should use: ' 267 267 CALL ctl_stop( ctmp1, ctmp2, ctmp3, ' ', ctmp4, ' ' ) 268 CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. ) ! must be done by all core268 CALL bestpartition( mppsize, ldlist = .TRUE. ) ! must be done by all core 269 269 ENDIF 270 270 … … 290 290 WRITE(numout,*) 291 291 ENDIF 292 CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. ) ! must be done by all core292 CALL bestpartition( mppsize, ldlist = .TRUE. ) ! must be done by all core 293 293 ENDIF 294 294 … … 318 318 IF( numbdy /= -1 ) CALL iom_close( numbdy ) 319 319 320 ALLOCATE( nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfi lcit(jpni,jpnj) , &321 & nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) , &322 & njmppt(jpnij) , ibonjt(jpnij) , n ldit(jpnij) , nldjt(jpnij) , &323 & n leit(jpnij) , nlejt(jpnij) , &320 ALLOCATE( nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfijpit(jpni,jpnj) , & 321 & nimppt(jpnij) , ibonit(jpnij) , jpiall(jpnij) , jpjall(jpnij) , & 322 & njmppt(jpnij) , ibonjt(jpnij) , nis0all(jpnij) , njs0all(jpnij) , & 323 & nie0all(jpnij) , nje0all(jpnij) , & 324 324 & iin(jpnij), ii_nono(jpnij), ii_noea(jpnij), & 325 325 & ijn(jpnij), ii_noso(jpnij), ii_nowe(jpnij), & 326 & iimppt(jpni,jpnj), i lci(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj), &327 & ijmppt(jpni,jpnj), i lcj(jpni,jpnj), ibondj(jpni,jpnj),ipolj(jpni,jpnj), &328 & ilei(jpni,jpnj), ildi(jpni,jpnj), iono(jpni,jpnj),ioea(jpni,jpnj), &329 & ilej(jpni,jpnj), ildj(jpni,jpnj), ioso(jpni,jpnj),iowe(jpni,jpnj), &326 & iimppt(jpni,jpnj), ijpi(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj), & 327 & ijmppt(jpni,jpnj), ijpj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj), & 328 & iie0(jpni,jpnj), iis0(jpni,jpnj), iono(jpni,jpnj), ioea(jpni,jpnj), & 329 & ije0(jpni,jpnj), ijs0(jpni,jpnj), ioso(jpni,jpnj), iowe(jpni,jpnj), & 330 330 & STAT=ierr ) 331 331 CALL mpp_sum( 'mppini', ierr ) … … 345 345 ! ----------------------------------- 346 346 ! 347 nreci = 2 * nn_hls 348 nrecj = 2 * nn_hls 349 CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ilci, ilcj ) 347 CALL basic_decomposition( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj ) 350 348 nfiimpp(:,:) = iimppt(:,:) 351 nfi lcit(:,:) = ilci(:,:)349 nfijpit(:,:) = ijpi(:,:) 352 350 ! 353 351 IF(lwp) THEN … … 359 357 WRITE(numout,*) ' jpnj = ', jpnj 360 358 WRITE(numout,*) 361 WRITE(numout,*) ' sum i lci(i,1) = ', sum(ilci(:,1)), ' jpiglo = ', jpiglo362 WRITE(numout,*) ' sum i lcj(1,j) = ', sum(ilcj(1,:)), ' jpjglo = ', jpjglo359 WRITE(numout,*) ' sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo 360 WRITE(numout,*) ' sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo 363 361 ENDIF 364 362 … … 375 373 ii = 1 + MOD(iarea0,jpni) 376 374 ij = 1 + iarea0/jpni 377 ili = i lci(ii,ij)378 ilj = i lcj(ii,ij)375 ili = ijpi(ii,ij) 376 ilj = ijpj(ii,ij) 379 377 ibondi(ii,ij) = 0 ! default: has e-w neighbours 380 378 IF( ii == 1 ) ibondi(ii,ij) = -1 ! first column, has only e neighbour … … 391 389 ioea(ii,ij) = iarea0 + 1 392 390 iono(ii,ij) = iarea0 + jpni 393 i ldi(ii,ij) = 1 + nn_hls394 i lei(ii,ij) = ili - nn_hls395 i ldj(ii,ij) = 1 + nn_hls396 i lej(ii,ij) = ilj - nn_hls391 iis0(ii,ij) = 1 + nn_hls 392 iie0(ii,ij) = ili - nn_hls 393 ijs0(ii,ij) = 1 + nn_hls 394 ije0(ii,ij) = ilj - nn_hls 397 395 398 396 ! East-West periodicity: change ibondi, ioea, iowe … … 500 498 ENDIF 501 499 END DO 502 503 ! Update il[de][ij] according to modified ibond[ij]504 ! ----------------------505 DO jproc = 1, jpnij506 ii = iin(jproc)507 ij = ijn(jproc)508 IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1509 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij)510 IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1511 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij)512 END DO513 500 514 501 ! 5. Subdomain print … … 523 510 DO jj = jpnj, 1, -1 524 511 WRITE(numout,9403) (' ',ji=il1,il2-1) 525 WRITE(numout,9402) jj, (i lci(ji,jj),ilcj(ji,jj),ji=il1,il2)512 WRITE(numout,9402) jj, (ijpi(ji,jj),ijpj(ji,jj),ji=il1,il2) 526 513 WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2) 527 514 WRITE(numout,9403) (' ',ji=il1,il2-1) … … 580 567 noea = ii_noea(narea) 581 568 nono = ii_nono(narea) 582 nlci = ilci(ii,ij)583 nldi = ildi(ii,ij)584 nlei = ilei(ii,ij)585 nlcj = ilcj(ii,ij)586 nldj = ildj(ii,ij)587 nlej = ilej(ii,ij)569 jpi = ijpi(ii,ij) 570 !!$ Nis0 = iis0(ii,ij) 571 !!$ Nie0 = iie0(ii,ij) 572 jpj = ijpj(ii,ij) 573 !!$ Njs0 = ijs0(ii,ij) 574 !!$ Nje0 = ije0(ii,ij) 588 575 nbondi = ibondi(ii,ij) 589 576 nbondj = ibondj(ii,ij) 590 577 nimpp = iimppt(ii,ij) 591 578 njmpp = ijmppt(ii,ij) 592 jpi = nlci593 jpj = nlcj594 579 jpk = jpkglo ! third dim 595 580 #if defined key_agrif … … 609 594 ii = iin(jproc) 610 595 ij = ijn(jproc) 611 nlcit(jproc) = ilci(ii,ij)612 n ldit(jproc) = ildi(ii,ij)613 n leit(jproc) = ilei(ii,ij)614 nlcjt(jproc) = ilcj(ii,ij)615 n ldjt(jproc) = ildj(ii,ij)616 n lejt(jproc) = ilej(ii,ij)596 jpiall (jproc) = ijpi(ii,ij) 597 nis0all(jproc) = iis0(ii,ij) 598 nie0all(jproc) = iie0(ii,ij) 599 jpjall (jproc) = ijpj(ii,ij) 600 njs0all(jproc) = ijs0(ii,ij) 601 nje0all(jproc) = ije0(ii,ij) 617 602 ibonit(jproc) = ibondi(ii,ij) 618 603 ibonjt(jproc) = ibondj(ii,ij) … … 628 613 WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,& 629 614 & ' ( local: ',narea,jpi,jpj,' )' 630 WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlejnimp njmp nono noso nowe noea nbondi nbondj '615 WRITE(inum,'(a)') 'nproc jpi jpj Nis0 Njs0 Nie0 Nje0 nimp njmp nono noso nowe noea nbondi nbondj ' 631 616 632 617 DO jproc = 1, jpnij 633 WRITE(inum,'(13i5,2i7)') jproc-1, nlcit (jproc), nlcjt(jproc), &634 & n ldit (jproc), nldjt(jproc), &635 & n leit (jproc), nlejt(jproc), &618 WRITE(inum,'(13i5,2i7)') jproc-1, jpiall(jproc), jpjall(jproc), & 619 & nis0all(jproc), njs0all(jproc), & 620 & nie0all(jproc), nje0all(jproc), & 636 621 & nimppt (jproc), njmppt (jproc), & 637 622 & ii_nono(jproc), ii_noso(jproc), & … … 667 652 WRITE(numout,*) ' l_Iperio = ', l_Iperio 668 653 WRITE(numout,*) ' l_Jperio = ', l_Jperio 669 WRITE(numout,*) ' nlci = ', nlci670 WRITE(numout,*) ' nlcj = ', nlcj671 654 WRITE(numout,*) ' nimpp = ', nimpp 672 655 WRITE(numout,*) ' njmpp = ', njmpp 673 WRITE(numout,*) ' nreci = ', nreci674 WRITE(numout,*) ' nrecj = ', nrecj675 656 WRITE(numout,*) ' nn_hls = ', nn_hls 676 657 ENDIF … … 712 693 DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe, & 713 694 & iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj, & 714 & i lci, ilcj, ilei, ilej, ildi, ildj, &695 & ijpi, ijpj, iie0, ije0, iis0, ijs0, & 715 696 & iono, ioea, ioso, iowe, llisoce) 716 697 ! … … 718 699 719 700 720 SUBROUTINE mpp_basic_decomposition(knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj)721 !!---------------------------------------------------------------------- 722 !! *** ROUTINE mpp_basic_decomposition ***701 SUBROUTINE basic_decomposition( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 702 !!---------------------------------------------------------------------- 703 !! *** ROUTINE basic_decomposition *** 723 704 !! 724 705 !! ** Purpose : Lay out the global domain over processors. … … 732 713 !! klcj : second dimension 733 714 !!---------------------------------------------------------------------- 715 INTEGER, INTENT(in ) :: kiglo, kjglo 716 INTEGER, INTENT(in ) :: khls 734 717 INTEGER, INTENT(in ) :: knbi, knbj 735 718 INTEGER, INTENT( out) :: kimax, kjmax … … 738 721 ! 739 722 INTEGER :: ji, jj 723 INTEGER :: i2hls 740 724 INTEGER :: iresti, irestj, irm, ijpjmin 741 INTEGER :: ireci, irecj742 !!----------------------------------------------------------------------725 !!---------------------------------------------------------------------- 726 i2hls = 2*khls 743 727 ! 744 728 #if defined key_nemocice_decomp 745 kimax = ( nx_global+2- 2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls ! first dim.746 kjmax = ( ny_global+2- 2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls ! second dim.729 kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 730 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 747 731 #else 748 kimax = ( jpiglo - 2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls ! first dim.749 kjmax = ( jpjglo - 2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls ! second dim.732 kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 733 kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 750 734 #endif 751 735 IF( .NOT. PRESENT(kimppt) ) RETURN … … 754 738 ! ----------------------------------- 755 739 ! Computation of local domain sizes klci() klcj() 756 ! These dimensions depend on global sizes knbi,knbj and jpiglo,jpjglo740 ! These dimensions depend on global sizes knbi,knbj and kiglo,kjglo 757 741 ! The subdomains are squares lesser than or equal to the global 758 742 ! dimensions divided by the number of processors minus the overlap array. 759 743 ! 760 ireci = 2 * nn_hls 761 irecj = 2 * nn_hls 762 iresti = 1 + MOD( jpiglo - ireci -1 , knbi ) 763 irestj = 1 + MOD( jpjglo - irecj -1 , knbj ) 744 iresti = 1 + MOD( kiglo - i2hls - 1 , knbi ) 745 irestj = 1 + MOD( kjglo - i2hls - 1 , knbj ) 764 746 ! 765 747 ! Need to use kimax and kjmax here since jpi and jpj not yet defined 766 748 #if defined key_nemocice_decomp 767 749 ! Change padding to be consistent with CICE 768 klci(1:knbi-1 ,:) = kimax769 klci( knbi ,:) = jpiglo - (knbi - 1) * (kimax - nreci)770 klcj(: ,1:knbj-1) = kjmax771 klcj(: , knbj) = jpjglo - (knbj - 1) * (kjmax - nrecj)750 klci(1:knbi-1,: ) = kimax 751 klci( knbi ,: ) = kiglo - (knbi - 1) * (kimax - i2hls) 752 klcj(: ,1:knbj-1) = kjmax 753 klcj(: , knbj ) = kjglo - (knbj - 1) * (kjmax - i2hls) 772 754 #else 773 755 klci(1:iresti ,:) = kimax 774 756 klci(iresti+1:knbi ,:) = kimax-1 775 IF( MINVAL(klci) < 3) THEN776 WRITE(ctmp1,*) ' mpp_basic_decomposition: minimum value of jpi must be >= 3'757 IF( MINVAL(klci) < 2*i2hls ) THEN 758 WRITE(ctmp1,*) ' basic_decomposition: minimum value of jpi must be >= ', 2*i2hls 777 759 WRITE(ctmp2,*) ' We have ', MINVAL(klci) 778 760 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) … … 780 762 IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN 781 763 ! minimize the size of the last row to compensate for the north pole folding coast 782 IF( jperio == 3 .OR. jperio == 4 ) ijpjmin = 5 ! V and F folding involves line jpj-3 that must not be south boundary 783 IF( jperio == 5 .OR. jperio == 6 ) ijpjmin = 4 ! V and F folding involves line jpj-2 that must not be south boundary 784 irm = knbj - irestj ! total number of lines to be removed 785 klcj(:, knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row 786 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove 787 irestj = knbj - 1 - irm 788 klcj(:, 1:irestj) = kjmax 764 IF( jperio == 3 .OR. jperio == 4 ) ijpjmin = 2+3*khls ! V and F folding must be outside of southern halos 765 IF( jperio == 5 .OR. jperio == 6 ) ijpjmin = 1+3*khls ! V and F folding must be outside of southern halos 766 irm = knbj - irestj ! total number of lines to be removed 767 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row 768 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove 769 irestj = knbj - 1 - irm 789 770 klcj(:, irestj+1:knbj-1) = kjmax-1 790 771 ELSE 791 ijpjmin = 3 792 klcj(:, 1:irestj) = kjmax 793 klcj(:, irestj+1:knbj) = kjmax-1 794 ENDIF 795 IF( MINVAL(klcj) < ijpjmin ) THEN 796 WRITE(ctmp1,*) ' mpp_basic_decomposition: minimum value of jpj must be >= ', ijpjmin 772 klcj(:, irestj+1:knbj ) = kjmax-1 773 ENDIF 774 klcj(:,1:irestj) = kjmax 775 IF( MINVAL(klcj) < 2*i2hls ) THEN 776 WRITE(ctmp1,*) ' basic_decomposition: minimum value of jpj must be >= ', 2*i2hls 797 777 WRITE(ctmp2,*) ' We have ', MINVAL(klcj) 798 778 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) … … 808 788 DO jj = 1, knbj 809 789 DO ji = 2, knbi 810 kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - ireci790 kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - 2 * nn_hls 811 791 END DO 812 792 END DO … … 816 796 DO jj = 2, knbj 817 797 DO ji = 1, knbi 818 kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - irecj798 kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - 2 * nn_hls 819 799 END DO 820 800 END DO 821 801 ENDIF 822 802 823 END SUBROUTINE mpp_basic_decomposition824 825 826 SUBROUTINE mpp_init_bestpartition( knbij, knbi, knbj, knbcnt, ldlist )827 !!---------------------------------------------------------------------- 828 !! *** ROUTINE mpp_init_bestpartition ***803 END SUBROUTINE basic_decomposition 804 805 806 SUBROUTINE bestpartition( knbij, knbi, knbj, knbcnt, ldlist ) 807 !!---------------------------------------------------------------------- 808 !! *** ROUTINE bestpartition *** 829 809 !! 830 810 !! ** Purpose : … … 877 857 iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls ! first dim. 878 858 #else 879 iszitst = ( jpiglo - 2*nn_hls+ (ji-1) ) / ji + 2*nn_hls859 iszitst = ( Ni0glo + (ji-1) ) / ji + 2*nn_hls 880 860 #endif 881 861 IF( iszitst < isziref ) THEN … … 888 868 iszjtst = ( ny_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls ! first dim. 889 869 #else 890 iszjtst = ( jpjglo - 2*nn_hls+ (ji-1) ) / ji + 2*nn_hls870 iszjtst = ( Nj0glo + (ji-1) ) / ji + 2*nn_hls 891 871 #endif 892 872 IF( iszjtst < iszjref ) THEN … … 976 956 ji = isz0 ! initialization with the largest value 977 957 ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 978 CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum)958 CALL is_ocean( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 979 959 inbijold = COUNT(llisoce) 980 960 DEALLOCATE( llisoce ) 981 961 DO ji =isz0-1,1,-1 982 962 ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 983 CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum)963 CALL is_ocean( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 984 964 inbij = COUNT(llisoce) 985 965 DEALLOCATE( llisoce ) … … 1007 987 ii = ii -1 1008 988 ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) ) 1009 CALL mpp_init_isoce( inbi0(ii), inbj0(ii), llisoce ) ! must be done by all core989 CALL is_ocean( inbi0(ii), inbj0(ii), llisoce ) ! must be done by all core 1010 990 inbij = COUNT(llisoce) 1011 991 DEALLOCATE( llisoce ) … … 1016 996 DEALLOCATE( inbi0, inbj0 ) 1017 997 ! 1018 END SUBROUTINE mpp_init_bestpartition998 END SUBROUTINE bestpartition 1019 999 1020 1000 … … 1025 1005 !! ** Purpose : the the proportion of land points in the surface land-sea mask 1026 1006 !! 1027 !! ** Method : read iproc strips (of length jpiglo) of the land-sea mask1007 !! ** Method : read iproc strips (of length Ni0glo) of the land-sea mask 1028 1008 !!---------------------------------------------------------------------- 1029 1009 REAL(wp), INTENT( out) :: propland ! proportion of land points in the global domain (between 0 and 1) … … 1042 1022 1043 1023 ! number of processes reading the bathymetry file 1044 iproc = MINVAL( (/mppsize, jpjglo/2, 100/) ) ! read a least 2 lines, no more that 100 processes reading at the same time1024 iproc = MINVAL( (/mppsize, Nj0glo/2, 100/) ) ! read a least 2 lines, no more that 100 processes reading at the same time 1045 1025 1046 1026 ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1 … … 1052 1032 IF( MOD( narea-1, idiv ) == 0 .AND. iarea < iproc ) THEN ! beware idiv can be = to 1 1053 1033 ! 1054 ijsz = jpjglo / iproc ! width of the stripe to read1055 IF( iarea < MOD( jpjglo,iproc) ) ijsz = ijsz + 11056 ijstr = iarea*( jpjglo/iproc) + MIN(iarea, MOD(jpjglo,iproc)) + 1 ! starting j position of the reading1057 ! 1058 ALLOCATE( lloce( jpiglo, ijsz) ) ! allocate the strip1059 CALL mpp_init_readbot_strip( ijstr, ijsz, lloce )1034 ijsz = Nj0glo / iproc ! width of the stripe to read 1035 IF( iarea < MOD(Nj0glo,iproc) ) ijsz = ijsz + 1 1036 ijstr = iarea*(Nj0glo/iproc) + MIN(iarea, MOD(Nj0glo,iproc)) + 1 ! starting j position of the reading 1037 ! 1038 ALLOCATE( lloce(Ni0glo, ijsz) ) ! allocate the strip 1039 CALL readbot_strip( ijstr, ijsz, lloce ) 1060 1040 inboce = COUNT(lloce) ! number of ocean point in the stripe 1061 1041 DEALLOCATE(lloce) … … 1066 1046 CALL mpp_sum( 'mppini', inboce ) ! total number of ocean points over the global domain 1067 1047 ! 1068 propland = REAL( jpiglo*jpjglo - inboce, wp ) / REAL( jpiglo*jpjglo, wp )1048 propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp ) 1069 1049 ! 1070 1050 END SUBROUTINE mpp_init_landprop 1071 1051 1072 1052 1073 SUBROUTINE mpp_init_isoce( knbi, knbj, ldisoce )1053 SUBROUTINE is_ocean( knbi, knbj, ldisoce ) 1074 1054 !!---------------------------------------------------------------------- 1075 1055 !! *** ROUTINE mpp_init_nboce *** … … 1078 1058 !! subdomains contain at least 1 ocean point 1079 1059 !! 1080 !! ** Method : read knbj strips (of length jpiglo) of the land-sea mask1060 !! ** Method : read knbj strips (of length Ni0glo) of the land-sea mask 1081 1061 !!---------------------------------------------------------------------- 1082 1062 INTEGER, INTENT(in ) :: knbi, knbj ! domain decomposition … … 1088 1068 INTEGER :: ji, jn 1089 1069 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1090 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, i lci1091 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, i lcj1070 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi 1071 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj 1092 1072 !!---------------------------------------------------------------------- 1093 1073 ! do nothing if there is no land-sea mask … … 1109 1089 IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN ! beware idiv can be = to 1 1110 1090 ! 1111 ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), i lci(knbi,knbj), ilcj(knbi,knbj) )1112 CALL mpp_basic_decomposition( knbi, knbj, iimax, ijmax, iimppt, ijmppt, ilci, ilcj )1091 ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ijpi(knbi,knbj), ijpj(knbi,knbj) ) 1092 CALL basic_decomposition( Ni0glo, Nj0glo, 0, knbi, knbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 1113 1093 ! 1114 ALLOCATE( lloce( jpiglo, ilcj(1,iarea+1)) )! allocate the strip1115 CALL mpp_init_readbot_strip( ijmppt(1,iarea+1), ilcj(1,iarea+1), lloce ) ! read the strip1094 ALLOCATE( lloce(Ni0glo, ijpj(1,iarea+1)) ) ! allocate the strip 1095 CALL readbot_strip( ijmppt(1,iarea+1), ijpj(1,iarea+1), lloce ) ! read the strip 1116 1096 DO ji = 1, knbi 1117 inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+i lci(ji,1)-1,:) ) ! number of ocean point in subdomain1097 inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)-1,:) ) ! number of ocean point in subdomain 1118 1098 END DO 1119 1099 ! 1120 1100 DEALLOCATE(lloce) 1121 DEALLOCATE(iimppt, ijmppt, i lci, ilcj)1101 DEALLOCATE(iimppt, ijmppt, ijpi, ijpj) 1122 1102 ! 1123 1103 ENDIF … … 1129 1109 ldisoce(:,:) = inboce(:,:) /= 0 1130 1110 ! 1131 END SUBROUTINE mpp_init_isoce1111 END SUBROUTINE is_ocean 1132 1112 1133 1113 1134 SUBROUTINE mpp_init_readbot_strip( kjstr, kjcnt, ldoce )1135 !!---------------------------------------------------------------------- 1136 !! *** ROUTINE mpp_init_readbot_strip ***1114 SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 1115 !!---------------------------------------------------------------------- 1116 !! *** ROUTINE readbot_strip *** 1137 1117 !! 1138 1118 !! ** Purpose : Read relevant bathymetric information in order to … … 1140 1120 !! of land domains, in an mpp computation. 1141 1121 !! 1142 !! ** Method : read stipe of size ( jpiglo,...)1122 !! ** Method : read stipe of size (Ni0glo,...) 1143 1123 !!---------------------------------------------------------------------- 1144 1124 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading 1145 1125 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read 1146 LOGICAL, DIMENSION( jpiglo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean1126 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1147 1127 ! 1148 1128 INTEGER :: inumsave ! local logical unit 1149 REAL(wp), DIMENSION( jpiglo,kjcnt) :: zbot, zbdy1129 REAL(wp), DIMENSION(Ni0glo,kjcnt) :: zbot, zbdy 1150 1130 !!---------------------------------------------------------------------- 1151 1131 ! 1152 1132 inumsave = numout ; numout = numnul ! redirect all print to /dev/null 1153 1133 ! 1154 IF( numbot /= -1 ) THEN 1155 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/ jpiglo, kjcnt/) )1134 IF( numbot /= -1 ) THEN 1135 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1156 1136 ELSE 1157 zbot(:,:) = 1. 1158 ENDIF 1159 1160 IF( numbdy /= -1 ) THEN! Adjust with bdy_msk if it exists1161 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) )1137 zbot(:,:) = 1._wp ! put a non-null value 1138 ENDIF 1139 ! 1140 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1141 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1162 1142 zbot(:,:) = zbot(:,:) * zbdy(:,:) 1163 1143 ENDIF 1164 1144 ! 1165 ldoce(:,:) = zbot(:,:) > 0. 1145 ldoce(:,:) = zbot(:,:) > 0._wp 1166 1146 numout = inumsave 1167 1147 ! 1168 END SUBROUTINE mpp_init_readbot_strip1148 END SUBROUTINE readbot_strip 1169 1149 1170 1150 … … 1190 1170 iglo(1) = jpiglo 1191 1171 iglo(2) = jpjglo 1192 iloc(1) = nlci1193 iloc(2) = nlcj1172 iloc(1) = jpi 1173 iloc(2) = jpj 1194 1174 iabsf(1) = nimppt(narea) 1195 1175 iabsf(2) = njmppt(narea) 1196 1176 iabsl(:) = iabsf(:) + iloc(:) - 1 1197 ihals(1) = nldi- 11198 ihals(2) = nldj- 11199 ihale(1) = nlci - nlei1200 ihale(2) = nlcj - nlej1177 ihals(1) = Nis0 - 1 1178 ihals(2) = Njs0 - 1 1179 ihale(1) = jpi - Nie0 1180 ihale(2) = jpj - Nje0 1201 1181 idid(1) = 1 1202 1182 idid(2) = 2 … … 1239 1219 ! 1240 1220 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 1241 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 11221 sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 1242 1222 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 1243 1223 dxM = jpiglo - nimppt(narea) + 2 … … 1249 1229 ! 1250 1230 sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process 1251 dxT = nfiimpp(jn, jpnj) + nfi lcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process1231 dxT = nfiimpp(jn, jpnj) + nfijpit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process 1252 1232 ! 1253 1233 IF ( sxT < sxM .AND. sxM < dxT ) THEN … … 1281 1261 IF( nn_hls == 1 ) THEN !* halo size of 1 1282 1262 ! 1283 nIs_0 = 2 ; nIs_1 = 1 ; nIs_1nxt2 = nIs_0 ; nIs_2 = nIs_11284 nJs_0 = 2 ; nJs_1 = 1 ; nJs_1nxt2 = nJs_0 ; nJs_2 = nJs_11263 Nis0 = 2 ; Nis1 = 1 ; Nis1nxt2 = Nis0 ; Nis2 = Nis1 1264 Njs0 = 2 ; Njs1 = 1 ; Njs1nxt2 = Njs0 ; Njs2 = Njs1 1285 1265 ! 1286 nIe_0 = jpi-1 ; nIe_1 = jpi ; nIe_1nxt2 = nIe_0 ; nIe_2 = nIe_11287 nJe_0 = jpj-1 ; nJe_1 = jpj ; nJe_1nxt2 = nJe_0 ; nJe_2 = nJe_11266 Nie0 = jpi-1 ; Nie1 = jpi ; Nie1nxt2 = Nie0 ; Nie2 = Nie1 1267 Nje0 = jpj-1 ; Nje1 = jpj ; Nje1nxt2 = Nje0 ; Nje2 = Nje1 1288 1268 ! 1289 1269 ELSEIF( nn_hls == 2 ) THEN !* halo size of 2 1290 1270 ! 1291 nIs_0 = 3 ; nIs_1 = 2 ; nIs_1nxt2 = nIs_1 ; nIs_2 = 11292 nJs_0 = 3 ; nJs_1 = 2 ; nJs_1nxt2 = nJs_1 ; nJs_2 = 11271 Nis0 = 3 ; Nis1 = 2 ; Nis1nxt2 = Nis1 ; Nis2 = 1 1272 Njs0 = 3 ; Njs1 = 2 ; Njs1nxt2 = Njs1 ; Njs2 = 1 1293 1273 ! 1294 nIe_0 = jpi-2 ; nIe_1 = jpi-1 ; nIe_1nxt2 = nIe_1 ; nIe_2 = jpi1295 nJe_0 = jpj-2 ; nJe_1 = jpj-1 ; nJe_1nxt2 = nJe_1 ; nJe_2 = jpj1274 Nie0 = jpi-2 ; Nie1 = jpi-1 ; Nie1nxt2 = Nie1 ; Nie2 = jpi 1275 Nje0 = jpj-2 ; Nje1 = jpj-1 ; Nje1nxt2 = Nje1 ; Nje2 = jpj 1296 1276 ! 1297 1277 ELSE !* unexpected halo size 1298 1278 CALL ctl_stop( 'STOP', 'ini_mpp: wrong value of halo size : nn_hls= 1 or 2 only !') 1299 1279 ENDIF 1280 ! 1281 Ni_0 = Nie0 - Nis0 + 1 1282 Nj_0 = Nje0 - Njs0 + 1 1283 Ni_1 = Nie1 - Nis1 + 1 1284 Nj_1 = Nje1 - Njs1 + 1 1285 Ni_2 = Nie2 - Nis2 + 1 1286 Nj_2 = Nje2 - Njs2 + 1 1300 1287 ! 1301 1288 END SUBROUTINE init_doloop
Note: See TracChangeset
for help on using the changeset viewer.
