New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9667 for NEMO/trunk/src/OCE/LBC/mppini.F90 – NEMO

Ignore:
Timestamp:
2018-05-28T17:47:05+02:00 (6 years ago)
Author:
smasson
Message:

trunk: cyclic north-south periodicity and nperio cleaning, see #2093

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/LBC/mppini.F90

    r9657 r9667  
    7878      nlei   = jpi 
    7979      nlej   = jpj 
    80       nperio = jperio 
    8180      nbondi = 2 
    8281      nbondj = 2 
    8382      nidom  = FLIO_DOM_NONE 
    8483      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) 
    8586      ! 
    8687      IF(lwp) THEN 
     
    8889         WRITE(numout,*) 'mpp_init : NO massively parallel processing' 
    8990         WRITE(numout,*) '~~~~~~~~ ' 
    90          WRITE(numout,*) '   nperio = ', nperio, '   nimpp  = ', nimpp 
    91          WRITE(numout,*) '   npolj  = ', npolj , '   njmpp  = ', njmpp 
     91         WRITE(numout,*) '   l_Iperio = ', l_Iperio, '    l_Jperio = ', l_Jperio  
     92         WRITE(numout,*) '     npolj  = ',   npolj , '      njmpp  = ', njmpp 
    9293      ENDIF 
    9394      ! 
     
    9596         CALL ctl_stop( 'mpp_init: equality  jpni = jpnj = jpnij = 1 is not satisfied',   & 
    9697            &           '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 ' ) 
    10098         ! 
    10199   END SUBROUTINE mpp_init 
     
    122120      !!      periodic 
    123121      !!      Type :         jperio global periodic condition 
    124       !!                     nperio local  periodic condition 
    125122      !! 
    126123      !! ** Action : - set domain parameters 
    127124      !!                    nimpp     : longitudinal index  
    128125      !!                    njmpp     : latitudinal  index 
    129       !!                    nperio    : lateral condition type  
    130126      !!                    narea     : number for local area 
    131127      !!                    nlci      : first dimension 
     
    276272      ! 3. Subdomain description in the Regular Case 
    277273      ! -------------------------------------------- 
    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       
    279279      icont = -1 
    280280      DO jarea = 1, jpni*jpnj 
     
    284284         ili = ilci(ii,ij) 
    285285         ilj = ilcj(ii,ij) 
    286          ibondj(ii,ij) = -1 
    287          IF( jarea >  jpni          )   ibondj(ii,ij) = 0 
    288          IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1 
    289          IF( jpnj  == 1             )   ibondj(ii,ij) = 2 
    290          ibondi(ii,ij) = 0 
    291          IF( MOD(jarea,jpni) ==  1  )   ibondi(ii,ij) = -1 
    292          IF( MOD(jarea,jpni) ==  0  )   ibondi(ii,ij) =  1 
    293          IF( jpni            ==  1  )   ibondi(ii,ij) =  2 
     286         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 
    294294 
    295295         ! Subdomain neighbors (get their zone number): default definition 
     
    305305         ! East-West periodicity: change ibondi, ioea, iowe 
    306306         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 
    319317         ENDIF 
    320318 
     
    393391         ii = 1 + MOD( jarea-1  , jpni ) 
    394392         ij = 1 +     (jarea-1) / jpni 
     393         ! land-only area with an active n neigbour 
    395394         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 communication  
    399             ! for northern neighbours of northern row processors (north-fold) 
    400             ! i.e. need to check that the northern neighbour only communicates 
    401             ! to the SOUTH (or not at all) if this area is land-only (#1057) 
    402             idir = 1 
    403             IF( ij == jpnj .AND. ijno == jpnj )   idir = -1     
    404             IF( ibondj(iino,ijno) == idir     )   ibondj(iino,ijno) =   2 
    405             IF( ibondj(iino,ijno) == 0        )   ibondj(iino,ijno) = -idir 
    406          ENDIF 
     395            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 
    407406         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 
    413413         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 
    419420         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 
    424425         ENDIF 
    425426      END DO 
     
    562563         WRITE(numout,*) '      nbondj = ', nbondj 
    563564         WRITE(numout,*) '      npolj  = ', npolj 
    564          WRITE(numout,*) '      nperio = ', nperio 
     565         WRITE(numout,*) '    l_Iperio = ', l_Iperio 
     566         WRITE(numout,*) '    l_Jperio = ', l_Jperio 
    565567         WRITE(numout,*) '      nlci   = ', nlci 
    566568         WRITE(numout,*) '      nlcj   = ', nlcj 
     
    571573         WRITE(numout,*) '      nn_hls = ', nn_hls  
    572574      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' ) 
    578575 
    579576      !                          ! Prepare mpp north fold 
Note: See TracChangeset for help on using the changeset viewer.