Changeset 9667 for NEMO/trunk/src
- Timestamp:
- 2018-05-28T17:47:05+02:00 (6 years ago)
- Location:
- NEMO/trunk/src/OCE
- Files:
-
- 10 edited
-
CRS/crs.F90 (modified) (2 diffs)
-
CRS/crsdom.F90 (modified) (2 diffs)
-
DOM/dom_oce.F90 (modified) (1 diff)
-
ICB/icblbc.F90 (modified) (2 diffs)
-
IOM/prtctl.F90 (modified) (1 diff)
-
LBC/lbc_lnk_generic.h90 (modified) (4 diffs)
-
LBC/lib_mpp.F90 (modified) (1 diff)
-
LBC/mpp_bdy_generic.h90 (modified) (2 diffs)
-
LBC/mpp_lnk_generic.h90 (modified) (4 diffs)
-
LBC/mppini.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/CRS/crs.F90
r9598 r9667 276 276 jpim1 = jpim1_full 277 277 jpjm1 = jpjm1_full 278 nperio = nperio_full278 jperio = nperio_full 279 279 280 280 npolj = npolj_full … … 315 315 jpim1 = jpi_crsm1 316 316 jpjm1 = jpj_crsm1 317 nperio = nperio_crs317 jperio = nperio_crs 318 318 319 319 npolj = npolj_crs -
NEMO/trunk/src/OCE/CRS/crsdom.F90
r9598 r9667 2037 2037 jpim1_full = jpim1 2038 2038 jpjm1_full = jpjm1 2039 nperio_full = nperio2039 nperio_full = jperio 2040 2040 2041 2041 npolj_full = npolj … … 2121 2121 CASE ( 0 ) 2122 2122 2123 SELECT CASE ( nperio )2123 SELECT CASE ( jperio ) 2124 2124 2125 2125 -
NEMO/trunk/src/OCE/DOM/dom_oce.F90
r9598 r9667 66 66 !! space domain parameters 67 67 !!---------------------------------------------------------------------- 68 INTEGER, PUBLIC :: jperio !: Global domain lateral boundary type (between 0 and 6)68 INTEGER, PUBLIC :: jperio !: Global domain lateral boundary type (between 0 and 7) 69 69 ! ! = 0 closed ; = 1 cyclic East-West 70 ! ! = 2 equatorial symmetric; = 3 North fold T-point pivot70 ! ! = 2 cyclic North-South ; = 3 North fold T-point pivot 71 71 ! ! = 4 cyclic East-West AND North fold T-point pivot 72 72 ! ! = 5 North fold F-point pivot 73 73 ! ! = 6 cyclic East-West AND North fold F-point pivot 74 INTEGER, PUBLIC :: nperio !: Local domain lateral boundary type (deduced from jperio and MPP decomposition) 74 ! ! = 7 bi-cyclic East-West AND North-South 75 LOGICAL, PUBLIC :: l_Iperio, l_Jperio ! should we explicitely take care I/J periodicity 75 76 76 77 ! ! domain MPP decomposition parameters -
NEMO/trunk/src/OCE/ICB/icblbc.F90
r9598 r9667 85 85 !! ============================= 86 86 87 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN87 IF( l_Iperio ) THEN 88 88 89 89 this => first_berg … … 103 103 !! north/south boundaries 104 104 !! ====================== 105 ! south symmetric 106 IF( nperio == 2 ) CALL ctl_stop(' south symmetric condition not implemented for icebergs') 105 IF( l_Jperio) CALL ctl_stop(' north-south periodicity not implemented for icebergs') 107 106 ! north fold 108 IF( np erio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6) CALL icb_lbc_nfld()107 IF( npolj /= 0 ) CALL icb_lbc_nfld() 109 108 ! 110 109 END SUBROUTINE icb_lbc -
NEMO/trunk/src/OCE/IOM/prtctl.F90
r9598 r9667 387 387 !! periodic 388 388 !! Type : jperio global periodic condition 389 !! nperio local periodic condition390 389 !! 391 390 !! ** Action : - set domain parameters 392 391 !! nimpp : longitudinal index 393 392 !! njmpp : latitudinal index 394 !! nperio : lateral condition type395 393 !! narea : number for local area 396 394 !! nlcil : first dimension -
NEMO/trunk/src/OCE/LBC/lbc_lnk_generic.h90
r9019 r9667 60 60 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 61 61 REAL(wp) :: zland 62 LOGICAL :: ll_ Iperio, ll_Jperio, ll_nfd62 LOGICAL :: ll_nfd 63 63 !!---------------------------------------------------------------------- 64 64 ! … … 67 67 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 68 68 ! 69 ll_Iperio = nperio==1 .OR. nperio==4 .OR. nperio==6 70 ll_Jperio = jperio==7 71 ll_nfd = nperio==3 .OR. nperio==4 .OR. nperio==5 .OR. nperio==6 69 ll_nfd = jperio==3 .OR. jperio==4 .OR. jperio==5 .OR. jperio==6 72 70 ! 73 71 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value … … 89 87 ! 90 88 ! ! East-West boundaries 91 IF( l l_Iperio ) THEN !* cyclic89 IF( l_Iperio ) THEN !* cyclic 92 90 ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf) 93 91 ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN( 2 ,:,:,:,jf) … … 97 95 ENDIF 98 96 ! ! North-South boundaries 99 IF( l l_Jperio ) THEN !* cyclic97 IF( l_Jperio ) THEN !* cyclic 100 98 ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf) 101 99 ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:, 2 ,:,:,jf) -
NEMO/trunk/src/OCE/LBC/lib_mpp.F90
r9598 r9667 1466 1466 ! ! East-West boundaries 1467 1467 ! !* Cyclic east-west 1468 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6)) THEN1469 pt2d(1-kexti: 1 ,:) = pt2d(jpim1-kexti:jpim1 ,:) ! east1470 pt2d( jpi :jpi+kexti,:) = pt2d( 2:2+kexti,:) ! west1468 IF( l_Iperio ) THEN 1469 pt2d(1-kexti: 1 ,:) = pt2d(jpim1-kexti: jpim1 ,:) ! east 1470 pt2d( jpi :jpi+kexti,:) = pt2d( 2 :2+kexti,:) ! west 1471 1471 ! 1472 1472 ELSE !* closed 1473 IF( .NOT. cd_type == 'F' ) pt2d( 1-kexti :nn_hls ,:) = 0._wp ! south except at F-point 1474 pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._wp ! north 1473 IF( .NOT. cd_type == 'F' ) pt2d( 1-kexti :nn_hls ,:) = 0._wp ! east except at F-point 1474 pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._wp ! west 1475 ENDIF 1476 ! ! North-South boundaries 1477 IF( l_Jperio ) THEN !* cyclic (only with no mpp j-split) 1478 pt2d(:,1-kextj: 1 ) = pt2d(:,jpjm1-kextj: jpjm1) ! north 1479 pt2d(:, jpj :jpj+kextj) = pt2d(:, 2 :2+kextj) ! south 1480 ELSE !* closed 1481 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-kextj :nn_hls ) = 0._wp ! north except at F-point 1482 pt2d(:,jpj-nn_hls+1:jpj+kextj) = 0._wp ! south 1475 1483 ENDIF 1476 1484 ! -
NEMO/trunk/src/OCE/LBC/mpp_bdy_generic.h90
r9019 r9667 76 76 IF( nbondi == 2) THEN ! neither subdomain to the east nor to the west 77 77 ! !* Cyclic 78 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN78 IF( l_Iperio ) THEN 79 79 ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf) 80 80 ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN( 2 ,:,:,:,jf) … … 91 91 ! ! North-South boundaries 92 92 ! 93 IF (nbondj == 2 .OR. nbondj == -1) THEN !* closed 94 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:,1:nn_hls,:,:,jf) = zland ! south except F-point 95 ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 96 ARRAY_IN(:,nlcj-nn_hls+1:jpj,:,:,jf) = zland ! north 93 IF( nbondj == 2) THEN ! neither subdomain to the north nor to the south 94 ! !* Cyclic 95 IF( l_Jperio ) THEN 96 ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:,jpjm1,:,:,jf) 97 ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:, 2 ,:,:,jf) 98 ELSE !* Closed 99 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:, 1 :nn_hls,:,:,jf) = zland ! east except F-point 100 ARRAY_IN(:,nlcj-nn_hls+1:jpj ,:,:,jf) = zland ! west 101 ENDIF 102 ELSEIF(nbondi == -1) THEN ! subdomain to the east only 103 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:,1:nn_hls,:,:,jf) = zland ! south except F-point 104 ! 105 ELSEIF(nbondi == 1) THEN ! subdomain to the west only 106 ARRAY_IN(:,nlcj-nn_hls+1:jpj,:,:,jf) = zland ! north 97 107 ENDIF 108 ! 98 109 END DO 99 110 -
NEMO/trunk/src/OCE/LBC/mpp_lnk_generic.h90
r9019 r9667 62 62 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 63 63 REAL(wp) :: zland 64 LOGICAL :: ll_Iperio, ll_Jperio65 64 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 66 65 REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! north-south & south-north halos … … 75 74 & zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) ) 76 75 ! 77 ll_Iperio = nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6)78 ll_Jperio = nbondj == 2 .AND. jperio == 779 !80 76 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 81 77 ELSE ; zland = 0._wp ! zero by default … … 111 107 DO jf = 1, ipf ! number of arrays to be treated 112 108 ! 113 ! ! East-West boundaries114 IF( l l_Iperio ) THEN!* cyclic109 ! ! East-West boundaries 110 IF( l_Iperio ) THEN !* cyclic 115 111 ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf) 116 112 ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN( 2 ,:,:,:,jf) … … 120 116 ENDIF 121 117 ! ! North-South boundaries 122 IF( l l_Jperio ) THEN!* cyclic (only with no mpp j-split)118 IF( l_Jperio ) THEN !* cyclic (only with no mpp j-split) 123 119 ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf) 124 120 ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:, 2 ,:,:,jf) -
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.
