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 1926 for branches/DEV_1879_mpp_sca/NEMO/OPA_SRC/opa.F90 – NEMO

Ignore:
Timestamp:
2010-06-10T13:06:13+02:00 (14 years ago)
Author:
acc
Message:

First implementation of mpp scalability modifications (branch:DEV_1879_mpp_sca

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/DEV_1879_mpp_sca/NEMO/OPA_SRC/opa.F90

    r1793 r1926  
    257257      ENDIF 
    258258!!gm c1d end 
     259 
     260      CALL opa_northcomms                   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
    259261 
    260262      IF( ln_ctl )   CALL prt_ctl_init      ! Print control 
     
    407409   END SUBROUTINE opa_closefile 
    408410 
     411   SUBROUTINE opa_northcomms 
     412      !!====================================================================== 
     413      !!                     ***  ROUTINE  opa_northcomms  *** 
     414      !! opa_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging 
     415      !!===================================================================== 
     416      !!---------------------------------------------------------------------- 
     417      !!  
     418      !! ** Purpose :   Initialization of the northern neighbours lists. 
     419      !!---------------------------------------------------------------------- 
     420 
     421      INTEGER ::   ji, jj, jk, ij    ! dummy loop indices 
     422      INTEGER ::   ijpj              ! ??? 
     423      INTEGER,  DIMENSION (jpi,4,4) ::   ifoldnbrs 
     424      REAL(wp), DIMENSION (jpi,jpj) ::   znnbrs     ! workspace 
     425      LOGICAL,  DIMENSION (jpnij)   ::   lrankset   ! workspace 
     426 
     427      IF(lwp) WRITE(numout,*) 
     428      IF(lwp) WRITE(numout,*) 'opa_northcomms : Initialization of the northern neighbours lists' 
     429      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     430 
     431      !!---------------------------------------------------------------------- 
     432      nsndto = 0 
     433      isendto = -1 
     434      ijpj   = 4 
     435      ! 
     436! Exchange and store ranks on northern rows 
     437 
     438      lrankset = .FALSE. 
     439      znnbrs = narea * tmask(:,:,1) 
     440      CALL lbc_lnk( znnbrs, 'T', 1. ) 
     441 
     442      IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 
     443        do jj = nlcj-ijpj+1, nlcj 
     444         ij = jj - nlcj + ijpj 
     445         ifoldnbrs(:,ij,1) = int(znnbrs(:,jj)) 
     446         do ji = 1,jpi 
     447          if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 
     448         &       lrankset(int(znnbrs(ji,jj))) = .true. 
     449         end do 
     450        end do 
     451 
     452        do jj = 1,jpnij 
     453         IF (lrankset(jj)) THEN 
     454          nsndto(1) = nsndto(1) + 1 
     455          IF(nsndto(1) .gt. jpmaxngh ) THEN 
     456           CALL ctl_stop( ' Too many neighbours in opa_northcomms ', & 
     457           &              ' jpmaxngh will need to be increased ') 
     458          ENDIF 
     459          isendto(nsndto(1),1) = jj-1   ! narea converted to MPI rank 
     460         ENDIF 
     461        end do 
     462      ENDIF 
     463       
     464      lrankset = .FALSE. 
     465      znnbrs = narea * umask(:,:,1) 
     466      CALL lbc_lnk( znnbrs, 'U', 1. ) 
     467 
     468      IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 
     469        do jj = nlcj-ijpj+1, nlcj 
     470         ij = jj - nlcj + ijpj 
     471         ifoldnbrs(:,ij,2) = int(znnbrs(:,jj)) 
     472         do ji = 1,jpi 
     473          if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 
     474         &       lrankset(int(znnbrs(ji,jj))) = .true. 
     475         end do 
     476        end do 
     477 
     478        do jj = 1,jpnij 
     479         IF (lrankset(jj)) THEN 
     480          nsndto(2) = nsndto(2) + 1 
     481          IF(nsndto(2) .gt. jpmaxngh ) THEN 
     482           CALL ctl_stop( ' Too many neighbours in opa_northcomms ', & 
     483           &              ' jpmaxngh will need to be increased ') 
     484          ENDIF 
     485          isendto(nsndto(2),2) = jj-1   ! narea converted to MPI rank 
     486         ENDIF 
     487        end do 
     488      ENDIF 
     489 
     490      lrankset = .FALSE. 
     491      znnbrs = narea * vmask(:,:,1) 
     492      CALL lbc_lnk( znnbrs, 'V', 1. ) 
     493 
     494      IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 
     495        do jj = nlcj-ijpj+1, nlcj 
     496         ij = jj - nlcj + ijpj 
     497         ifoldnbrs(:,ij,3) = int(znnbrs(:,jj)) 
     498         do ji = 1,jpi 
     499          if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 
     500         &       lrankset(int(znnbrs(ji,jj))) = .true. 
     501         end do 
     502        end do 
     503 
     504        do jj = 1,jpnij 
     505         IF (lrankset(jj)) THEN 
     506          nsndto(3) = nsndto(3) + 1 
     507          IF(nsndto(3) .gt. jpmaxngh ) THEN 
     508           CALL ctl_stop( ' Too many neighbours in opa_northcomms ', & 
     509           &              ' jpmaxngh will need to be increased ') 
     510          ENDIF 
     511          isendto(nsndto(3),3) = jj-1   ! narea converted to MPI rank 
     512         ENDIF 
     513        end do 
     514      ENDIF 
     515 
     516      lrankset = .FALSE. 
     517      znnbrs = narea * fmask(:,:,1) 
     518! 
     519! filter top rows to counter any strong slip conditions 
     520! 
     521      do jj = nlcj-ijpj+1, nlcj 
     522      do ji = 1,jpi 
     523       znnbrs(ji,jj) = narea * MIN(1.0,fmask(ji,jj,1)) 
     524      end do 
     525      enddo 
     526      CALL lbc_lnk( znnbrs, 'F', 1. ) 
     527 
     528      IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 
     529        do jj = nlcj-ijpj+1, nlcj 
     530         ij = jj - nlcj + ijpj 
     531         ifoldnbrs(:,ij,4) = int(znnbrs(:,jj)) 
     532         do ji = 1,jpi 
     533          if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 
     534         &       lrankset(int(znnbrs(ji,jj))) = .true. 
     535         end do 
     536        end do 
     537 
     538        do jj = 1,jpnij 
     539         IF (lrankset(jj)) THEN 
     540          nsndto(4) = nsndto(4) + 1 
     541          IF(nsndto(4) .gt. jpmaxngh ) THEN 
     542           CALL ctl_stop( ' Too many neighbours in opa_northcomms ', & 
     543           &              ' jpmaxngh will need to be increased ') 
     544          ENDIF 
     545          isendto(nsndto(4),4) = jj-1   ! narea converted to MPI rank 
     546         ENDIF 
     547        end do 
     548 
     549        lnorth_nogather = .TRUE. 
     550      ENDIF 
     551 
     552   END SUBROUTINE opa_northcomms 
    409553   !!====================================================================== 
    410554END MODULE opa 
Note: See TracChangeset for help on using the changeset viewer.