Changeset 10560


Ignore:
Timestamp:
2019-01-23T15:37:31+01:00 (18 months ago)
Author:
smasson
Message:

trunk: bugfix in mppini for automatic domain decomposition with low number of cores

File:
1 edited

Legend:

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

    r10542 r10560  
    10061006      INTEGER, DIMENSION(knbi*knbj) ::   inboce_1d 
    10071007      INTEGER :: idiv, iimax, ijmax, iarea 
    1008       INTEGER :: ji 
     1008      INTEGER :: ji, jn 
    10091009      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce                  ! lloce(i,j) = .true. if the point (i,j) is ocean  
    10101010      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci 
     
    10181018 
    10191019      ! we want to read knbj strips of the land-sea mask. -> pick up knbj processes every idiv processes starting at 1 
    1020       IF( knbj == 1 ) THEN   ;   idiv = mppsize 
    1021       ELSE                   ;   idiv = ( mppsize - 1 ) / ( knbj - 1 ) 
     1020      IF           ( knbj == 1 ) THEN   ;   idiv = mppsize 
     1021      ELSE IF ( mppsize < knbj ) THEN   ;   idiv = 1 
     1022      ELSE                              ;   idiv = ( mppsize - 1 ) / ( knbj - 1 ) 
    10221023      ENDIF 
    10231024      inboce(:,:) = 0          ! default no ocean point found 
    1024       iarea = (narea-1)/idiv   ! involed process number (starting counting at 0) 
    1025       IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN   ! beware idiv can be = to 1 
     1025 
     1026      DO jn = 0, (knbj-1)/mppsize   ! if mppsize < knbj : more strips than mpi processes (because of potential land domains) 
    10261027         ! 
    1027          ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ilci(knbi,knbj), ilcj(knbi,knbj) ) 
    1028          CALL mpp_basic_decomposition( knbi, knbj, iimax, ijmax, iimppt, ijmppt, ilci, ilcj ) 
    1029          ! 
    1030          ALLOCATE( lloce(jpiglo, ilcj(1,iarea+1)) )                                         ! allocate the strip 
    1031          CALL mpp_init_readbot_strip( ijmppt(1,iarea+1), ilcj(1,iarea+1), lloce )           ! read the strip 
    1032          DO  ji = 1, knbi 
    1033             inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ilci(ji,1)-1,:) )   ! number of ocean point in a subdomain 
    1034          END DO 
    1035          ! 
    1036          DEALLOCATE(lloce) 
    1037          DEALLOCATE(iimppt, ijmppt, ilci, ilcj) 
    1038          ! 
    1039       ENDIF 
    1040        
     1028         iarea = (narea-1)/idiv + jn * mppsize   ! involed process number (starting counting at 0) 
     1029         IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN   ! beware idiv can be = to 1 
     1030            ! 
     1031            ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ilci(knbi,knbj), ilcj(knbi,knbj) ) 
     1032            CALL mpp_basic_decomposition( knbi, knbj, iimax, ijmax, iimppt, ijmppt, ilci, ilcj ) 
     1033            ! 
     1034            ALLOCATE( lloce(jpiglo, ilcj(1,iarea+1)) )                                         ! allocate the strip 
     1035            CALL mpp_init_readbot_strip( ijmppt(1,iarea+1), ilcj(1,iarea+1), lloce )           ! read the strip 
     1036            DO  ji = 1, knbi 
     1037               inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ilci(ji,1)-1,:) )   ! number of ocean point in subdomain 
     1038            END DO 
     1039            ! 
     1040            DEALLOCATE(lloce) 
     1041            DEALLOCATE(iimppt, ijmppt, ilci, ilcj) 
     1042            ! 
     1043         ENDIF 
     1044      END DO 
     1045    
    10411046      inboce_1d = RESHAPE(inboce, (/ knbi*knbj /)) 
    10421047      CALL mpp_sum( 'mppini', inboce_1d ) 
Note: See TracChangeset for help on using the changeset viewer.