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 4232 – NEMO

Changeset 4232


Ignore:
Timestamp:
2013-11-18T13:11:55+01:00 (11 years ago)
Author:
cetlod
Message:

dev_LOCEAN_CMCC_INGV_2013 : minor bug corrections, see ticket #1182

Location:
branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4230 r4232  
    26672667            END DO 
    26682668         ENDIF 
    2669          CALL mpp_lbc_nfd( ztabl, ztabr_3d, cd_type, psgn )   ! North fold boundary condition 
     2669         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition 
    26702670         ! 
    26712671         DO jk = 1, jpk 
  • branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r4166 r4232  
    5454#endif 
    5555   USE sbcssm 
     56   USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
    5657 
    5758   IMPLICIT NONE 
     
    558559      !!====================================================================== 
    559560      !!                     ***  ROUTINE  nemo_northcomms  *** 
    560       !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging 
     561      !! nemo_northcomms    :  Setup for north fold exchanges with explicit  
     562      !!                       point-to-point messaging 
    561563      !!===================================================================== 
    562564      !!---------------------------------------------------------------------- 
    563       !!  
     565      !! 
    564566      !! ** Purpose :   Initialization of the northern neighbours lists. 
    565567      !!---------------------------------------------------------------------- 
    566       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)  
    567       !!---------------------------------------------------------------------- 
    568  
    569       INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices 
    570       INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange 
    571       INTEGER ::   northcomms_alloc        ! allocate return status 
    572       REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace 
    573       LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace 
    574  
    575       IF(lwp) WRITE(numout,*) 
    576       IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 
    577       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    578  
    579       !!---------------------------------------------------------------------- 
    580       ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 
    581       ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 
    582       IF( northcomms_alloc /= 0 ) THEN 
    583          WRITE(numout,cform_war) 
    584          WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 
    585          CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 
    586       ENDIF 
     568      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
     569      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
     570      !!---------------------------------------------------------------------- 
     571 
     572      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
     573      INTEGER  ::   njmppmax 
     574 
     575      njmppmax = MAXVAL( njmppt ) 
     576     
     577      !initializes the north-fold communication variables 
     578      isendto(:) = 0 
    587579      nsndto = 0 
    588       isendto = -1 
    589       ijpj   = 4 
    590       ! 
    591       ! This routine has been called because ln_nnogather has been set true ( nammpp ) 
    592       ! However, these first few exchanges have to use the mpi_allgather method to 
    593       ! establish the neighbour lists to use in subsequent peer to peer exchanges. 
    594       ! Consequently, set l_north_nogather to be false here and set it true only after 
    595       ! the lists have been established. 
    596       ! 
    597       l_north_nogather = .FALSE. 
    598       ! 
    599       ! Exchange and store ranks on northern rows 
    600  
    601       DO jtyp = 1,4 
    602  
    603          lrankset = .FALSE. 
    604          znnbrs = narea 
    605          SELECT CASE (jtyp) 
    606             CASE(1) 
    607                CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points 
    608             CASE(2) 
    609                CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point 
    610             CASE(3) 
    611                CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point 
    612             CASE(4) 
    613                CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point 
    614          END SELECT 
    615  
    616          IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 
    617             DO jj = nlcj-ijpj+1, nlcj 
    618                ij = jj - nlcj + ijpj 
    619                DO ji = 1,jpi 
    620                   IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 
    621                &     lrankset(INT(znnbrs(ji,jj))) = .true. 
    622                END DO 
    623             END DO 
    624  
    625             DO jj = 1,jpnij 
    626                IF ( lrankset(jj) ) THEN 
    627                   nsndto(jtyp) = nsndto(jtyp) + 1 
    628                   IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 
    629                      CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
    630                   &                 ' jpmaxngh will need to be increased ') 
    631                   ENDIF 
    632                   isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
    633                ENDIF 
    634             END DO 
    635          ENDIF 
    636  
    637       END DO 
    638  
    639       ! 
    640       ! Type 5: I-point 
    641       ! 
    642       ! ICE point exchanges may involve some averaging. The neighbours list is 
    643       ! built up using two exchanges to ensure that the whole stencil is covered. 
    644       ! lrankset should not be reset between these 'J' and 'K' point exchanges 
    645  
    646       jtyp = 5 
    647       lrankset = .FALSE. 
    648       znnbrs = narea  
    649       CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 
    650  
    651       IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 
    652          DO jj = nlcj-ijpj+1, nlcj 
    653             ij = jj - nlcj + ijpj 
    654             DO ji = 1,jpi 
    655                IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 
    656             &     lrankset(INT(znnbrs(ji,jj))) = .true. 
    657          END DO 
    658         END DO 
    659       ENDIF 
    660  
    661       znnbrs = narea  
    662       CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 
    663  
    664       IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 
    665          DO jj = nlcj-ijpj+1, nlcj 
    666             ij = jj - nlcj + ijpj 
    667             DO ji = 1,jpi 
    668                IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) & 
    669             &       lrankset( INT(znnbrs(ji,jj))) = .true. 
    670             END DO 
    671          END DO 
    672  
    673          DO jj = 1,jpnij 
    674             IF ( lrankset(jj) ) THEN 
    675                nsndto(jtyp) = nsndto(jtyp) + 1 
    676                IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 
    677                   CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 
    678                &                 ' jpmaxngh will need to be increased ') 
    679                ENDIF 
    680                isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank 
    681             ENDIF 
    682          END DO 
    683          ! 
    684          ! For northern row areas, set l_north_nogather so that all subsequent exchanges  
    685          ! can use peer to peer communications at the north fold 
    686          ! 
    687          l_north_nogather = .TRUE. 
    688          ! 
    689       ENDIF 
    690       DEALLOCATE( znnbrs ) 
    691       DEALLOCATE( lrankset ) 
    692  
     580 
     581      !if I am a process in the north 
     582      IF ( njmpp == njmppmax ) THEN 
     583          !sxM is the first point (in the global domain) needed to compute the 
     584          !north-fold for the current process 
     585          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
     586          !dxM is the last point (in the global domain) needed to compute the 
     587          !north-fold for the current process 
     588          dxM = jpiglo - nimppt(narea) + 2 
     589 
     590          !loop over the other north-fold processes to find the processes 
     591          !managing the points belonging to the sxT-dxT range 
     592          DO jn = jpnij - jpni +1, jpnij 
     593             IF ( njmppt(jn) == njmppmax ) THEN 
     594                !sxT is the first point (in the global domain) of the jn 
     595                !process 
     596                sxT = nimppt(jn) 
     597                !dxT is the last point (in the global domain) of the jn 
     598                !process 
     599                dxT = nimppt(jn) + nlcit(jn) - 1 
     600                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
     601                   nsndto = nsndto + 1 
     602                   isendto(nsndto) = jn 
     603                ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     604                   nsndto = nsndto + 1 
     605                   isendto(nsndto) = jn 
     606                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
     607                   nsndto = nsndto + 1 
     608                   isendto(nsndto) = jn 
     609                END IF 
     610             END IF 
     611          END DO 
     612      ENDIF 
     613      l_north_nogather = .TRUE. 
    693614   END SUBROUTINE nemo_northcomms 
     615 
    694616#else 
    695617   SUBROUTINE nemo_northcomms      ! Dummy routine 
Note: See TracChangeset for help on using the changeset viewer.