Changeset 9667 for NEMO/trunk/src/OCE/LBC/mppini.F90
- Timestamp:
- 2018-05-28T17:47:05+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/LBC/mppini.F90
r9657 r9667 78 78 nlei = jpi 79 79 nlej = jpj 80 nperio = jperio81 80 nbondi = 2 82 81 nbondj = 2 83 82 nidom = FLIO_DOM_NONE 84 83 npolj = jperio 84 l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) 85 l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 85 86 ! 86 87 IF(lwp) THEN … … 88 89 WRITE(numout,*) 'mpp_init : NO massively parallel processing' 89 90 WRITE(numout,*) '~~~~~~~~ ' 90 WRITE(numout,*) ' nperio = ', nperio, ' nimpp = ', nimpp91 WRITE(numout,*) ' npolj = ', npolj , 'njmpp = ', njmpp91 WRITE(numout,*) ' l_Iperio = ', l_Iperio, ' l_Jperio = ', l_Jperio 92 WRITE(numout,*) ' npolj = ', npolj , ' njmpp = ', njmpp 92 93 ENDIF 93 94 ! … … 95 96 CALL ctl_stop( 'mpp_init: equality jpni = jpnj = jpnij = 1 is not satisfied', & 96 97 & 'the domain is lay out for distributed memory computing!' ) 97 !98 IF( jperio == 7 ) CALL ctl_stop( 'mpp_init: jperio = 7 needs distributed memory computing ', &99 & 'with 1 process. Add key_mpp_mpi in the list of active cpp keys ' )100 98 ! 101 99 END SUBROUTINE mpp_init … … 122 120 !! periodic 123 121 !! Type : jperio global periodic condition 124 !! nperio local periodic condition125 122 !! 126 123 !! ** Action : - set domain parameters 127 124 !! nimpp : longitudinal index 128 125 !! njmpp : latitudinal index 129 !! nperio : lateral condition type130 126 !! narea : number for local area 131 127 !! nlci : first dimension … … 276 272 ! 3. Subdomain description in the Regular Case 277 273 ! -------------------------------------------- 278 nperio = 0 274 ! specific cases where there is no communication -> must do the periodicity by itself 275 ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2 276 l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) 277 l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 278 279 279 icont = -1 280 280 DO jarea = 1, jpni*jpnj … … 284 284 ili = ilci(ii,ij) 285 285 ilj = ilcj(ii,ij) 286 ibond j(ii,ij) = -1287 IF( jarea > jpni ) ibondj(ii,ij) = 0288 IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1289 IF( jpn j == 1 ) ibondj(ii,ij) = 2290 ibond i(ii,ij) = 0291 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1292 IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1293 IF( jpn i == 1 ) ibondi(ii,ij) = 2286 ibondi(ii,ij) = 0 ! default: has e-w neighbours 287 IF( ii == 1 ) ibondi(ii,ij) = -1 ! first column, has only e neighbour 288 IF( ii == jpni ) ibondi(ii,ij) = 1 ! last column, has only w neighbour 289 IF( jpni == 1 ) ibondi(ii,ij) = 2 ! has no e-w neighbour 290 ibondj(ii,ij) = 0 ! default: has n-s neighbours 291 IF( ij == 1 ) ibondj(ii,ij) = -1 ! first row, has only n neighbour 292 IF( ij == jpnj ) ibondj(ii,ij) = 1 ! last row, has only s neighbour 293 IF( jpnj == 1 ) ibondj(ii,ij) = 2 ! has no n-s neighbour 294 294 295 295 ! Subdomain neighbors (get their zone number): default definition … … 305 305 ! East-West periodicity: change ibondi, ioea, iowe 306 306 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 307 IF( jpni == 1 )THEN 308 ibondi(ii,ij) = 2 309 nperio = 1 310 ELSE 311 ibondi(ii,ij) = 0 312 ENDIF 313 IF( MOD(jarea,jpni) == 0 ) THEN 314 ioea(ii,ij) = iarea0 - (jpni-1) 315 ENDIF 316 IF( MOD(jarea,jpni) == 1 ) THEN 317 iowe(ii,ij) = iarea0 + jpni - 1 318 ENDIF 307 IF( jpni /= 1 ) ibondi(ii,ij) = 0 ! redefine: all have e-w neighbours 308 IF( ii == 1 ) iowe(ii,ij) = iarea0 + (jpni-1) ! redefine: first column, address of w neighbour 309 IF( ii == jpni ) ioea(ii,ij) = iarea0 - (jpni-1) ! redefine: last column, address of e neighbour 310 ENDIF 311 312 ! Simple North-South periodicity: change ibondj, ioso, iono 313 IF( jperio == 2 .OR. jperio == 7 ) THEN 314 IF( jpnj /= 1 ) ibondj(ii,ij) = 0 ! redefine: all have n-s neighbours 315 IF( ij == 1 ) ioso(ii,ij) = iarea0 + jpni * (jpnj-1) ! redefine: first row, address of s neighbour 316 IF( ij == jpnj ) iono(ii,ij) = iarea0 - jpni * (jpnj-1) ! redefine: last row, address of n neighbour 319 317 ENDIF 320 318 … … 393 391 ii = 1 + MOD( jarea-1 , jpni ) 394 392 ij = 1 + (jarea-1) / jpni 393 ! land-only area with an active n neigbour 395 394 IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN 396 iino = 1 + MOD( iono(ii,ij) , jpni ) 397 ijno = 1 + iono(ii,ij) / jpni 398 ! Need to reverse the logical direction of communication399 ! for northern neighbours of northern row processors (north-fold)400 ! i.e. need to check that the northern neighbour only communicates401 ! to the SOUTH (or not at all) if this area is land-only (#1057)402 idir = 1403 IF( i j == jpnj .AND. ijno == jpnj ) idir = -1404 IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno) = 2405 IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir406 ENDIF395 iino = 1 + MOD( iono(ii,ij) , jpni ) ! ii index of this n neigbour 396 ijno = 1 + iono(ii,ij) / jpni ! ij index of this n neigbour 397 ! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057) 398 ! --> for northern neighbours of northern row processors (in case of north-fold) 399 ! need to reverse the LOGICAL direction of communication 400 idir = 1 ! we are indeed the s neigbour of this n neigbour 401 IF( ij == jpnj .AND. ijno == jpnj ) idir = -1 ! both are on the last row, we are in fact the n neigbour 402 IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno) = 2 ! this n neigbour had only a s/n neigbour -> no more 403 IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir ! this n neigbour had both, n-s neighbours -> keep 1 404 ENDIF 405 ! land-only area with an active s neigbour 407 406 IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN 408 iiso = 1 + MOD( ioso(ii,ij) , jpni ) 409 ijso = 1 + ioso(ii,ij) / jpni 410 IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 411 IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1 412 ENDIF 407 iiso = 1 + MOD( ioso(ii,ij) , jpni ) ! ii index of this s neigbour 408 ijso = 1 + ioso(ii,ij) / jpni ! ij index of this s neigbour 409 IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 ! this s neigbour had only a n neigbour -> no more neigbour 410 IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1 ! this s neigbour had both, n-s neighbours -> keep s neigbour 411 ENDIF 412 ! land-only area with an active e neigbour 413 413 IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN 414 iiea = 1 + MOD( ioea(ii,ij) , jpni ) 415 ijea = 1 + ioea(ii,ij) / jpni 416 IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 417 IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 418 ENDIF 414 iiea = 1 + MOD( ioea(ii,ij) , jpni ) ! ii index of this e neigbour 415 ijea = 1 + ioea(ii,ij) / jpni ! ij index of this e neigbour 416 IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 ! this e neigbour had only a w neigbour -> no more neigbour 417 IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 ! this e neigbour had both, e-w neighbours -> keep e neigbour 418 ENDIF 419 ! land-only area with an active w neigbour 419 420 IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN 420 iiwe = 1 + MOD( iowe(ii,ij) , jpni ) 421 ijwe = 1 + iowe(ii,ij) / jpni 422 IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 423 IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1 421 iiwe = 1 + MOD( iowe(ii,ij) , jpni ) ! ii index of this w neigbour 422 ijwe = 1 + iowe(ii,ij) / jpni ! ij index of this w neigbour 423 IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 ! this w neigbour had only a e neigbour -> no more neigbour 424 IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1 ! this w neigbour had both, e-w neighbours -> keep w neigbour 424 425 ENDIF 425 426 END DO … … 562 563 WRITE(numout,*) ' nbondj = ', nbondj 563 564 WRITE(numout,*) ' npolj = ', npolj 564 WRITE(numout,*) ' nperio = ', nperio 565 WRITE(numout,*) ' l_Iperio = ', l_Iperio 566 WRITE(numout,*) ' l_Jperio = ', l_Jperio 565 567 WRITE(numout,*) ' nlci = ', nlci 566 568 WRITE(numout,*) ' nlcj = ', nlcj … … 571 573 WRITE(numout,*) ' nn_hls = ', nn_hls 572 574 ENDIF 573 574 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( 'mpp_init: error on cyclicity' )575 576 IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) &577 & CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' )578 575 579 576 ! ! Prepare mpp north fold
Note: See TracChangeset
for help on using the changeset viewer.