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 13942 for NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC – NEMO

Ignore:
Timestamp:
2020-12-01T17:14:18+01:00 (4 years ago)
Author:
jchanut
Message:

Merged with trunk @13787

Location:
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@13292        sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r13286 r13942  
    3535#endif 
    3636 
    37    SUBROUTINE ROUTINE_MULTI( cdname                                                                             & 
    38       &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   & 
    39       &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
    40       &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
     37   SUBROUTINE ROUTINE_MULTI( cdname                                                                               & 
     38      &                    , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4   & 
     39      &                    , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8   & 
     40      &                    , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12  & 
     41      &                    , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16  & 
    4142      &                    , kfillmode, pfillval, lsend, lrecv ) 
    4243      !!--------------------------------------------------------------------- 
    43       CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine 
    44       ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) :: pt1     ! arrays on which the lbc is applied 
    45       ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2  , pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9  , pt10  , pt11 
    46       CHARACTER(len=1)                     , INTENT(in   ) :: cdna1   ! nature of pt2D. array grid-points 
    47       CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11 
    48       REAL(wp)                             , INTENT(in   ) :: psgn1   ! sign used across the north fold 
    49       REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11 
    50       INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant) 
    51       REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries) 
    52       LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out 
     44      CHARACTER(len=*)     ,                   INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     45      ARRAY_TYPE(:,:,:,:)            , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied 
     46      ARRAY_TYPE(:,:,:,:)  , OPTIONAL, TARGET, INTENT(inout) ::   pt2   , pt3   , pt4   , pt5   , pt6   , pt7   , pt8   , pt9  , & 
     47         &                                                        pt10  , pt11  , pt12  , pt13  , pt14  , pt15  , pt16 
     48      CHARACTER(len=1)                       , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points 
     49      CHARACTER(len=1)     , OPTIONAL        , INTENT(in   ) ::   cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, & 
     50         &                                                        cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16 
     51      REAL(wp)                               , INTENT(in   ) ::   psgn1   ! sign used across the north fold 
     52      REAL(wp)             , OPTIONAL        , INTENT(in   ) ::   psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , psgn9, & 
     53         &                                                        psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16 
     54      INTEGER              , OPTIONAL        , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant) 
     55      REAL(wp)             , OPTIONAL        , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
     56      LOGICAL, DIMENSION(4), OPTIONAL        , INTENT(in   ) ::   lsend, lrecv   ! indicate how communications are to be carried out 
    5357      !! 
    5458      INTEGER                          ::   kfld        ! number of elements that will be attributed 
    55       PTR_TYPE         , DIMENSION(11) ::   ptab_ptr    ! pointer array 
    56       CHARACTER(len=1) , DIMENSION(11) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
    57       REAL(wp)         , DIMENSION(11) ::   psgn_ptr    ! sign used across the north fold boundary 
     59      PTR_TYPE         , DIMENSION(16) ::   ptab_ptr    ! pointer array 
     60      CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
     61      REAL(wp)         , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary 
    5862      !!--------------------------------------------------------------------- 
    5963      ! 
    … …  
    7478      IF( PRESENT(psgn10) )   CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    7579      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     80      IF( PRESENT(psgn12) )   CALL ROUTINE_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     81      IF( PRESENT(psgn13) )   CALL ROUTINE_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     82      IF( PRESENT(psgn14) )   CALL ROUTINE_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     83      IF( PRESENT(psgn15) )   CALL ROUTINE_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     84      IF( PRESENT(psgn16) )   CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    7685      ! 
    77       CALL lbc_lnk_ptr    ( cdname,              ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 
     86      CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 
    7887      ! 
    7988   END SUBROUTINE ROUTINE_MULTI 

  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC/lib_mpp.F90

    r13286 r13942  
    7373   PUBLIC   tic_tac 
    7474#if ! defined key_mpp_mpi 
     75   PUBLIC MPI_wait 
    7576   PUBLIC MPI_Wtime 
    7677#endif 
    … …  
    115116#else    
    116117   INTEGER, PUBLIC, PARAMETER ::   MPI_STATUS_SIZE = 1 
     118   INTEGER, PUBLIC, PARAMETER ::   MPI_REAL = 4 
    117119   INTEGER, PUBLIC, PARAMETER ::   MPI_DOUBLE_PRECISION = 8 
    118120   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.    !: mpp flag 
    … …  
    509511            ALLOCATE(todelay(idvar)%y1d(isz)) 
    510512            todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp)   ! create %y1d, complex variable needed by mpi_sumdd 
     513            ndelayid(idvar) = MPI_REQUEST_NULL                             ! initialised request to a valid value 
    511514         END IF 
    512515      ENDIF 
    … …  
    516519         ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz))   ! allocate also %z1d as used for the restart 
    517520         CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr )   ! get %y1d 
    518          todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp)      ! define %z1d from %y1d 
    519       ENDIF 
    520  
    521       IF( ndelayid(idvar) > 0 )   CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received 
     521         ndelayid(idvar) = MPI_REQUEST_NULL 
     522      ENDIF 
     523 
     524      CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received 
    522525 
    523526      ! send back pout from todelay(idvar)%z1d defined at previous call 
    … …  
    528531      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 
    529532      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) 
    530       ndelayid(idvar) = 1 
     533      ndelayid(idvar) = MPI_REQUEST_NULL 
    531534      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    532535# else 
    … …  
    589592            DEALLOCATE(todelay(idvar)%z1d) 
    590593            ndelayid(idvar) = -1                                      ! do as if we had no restart 
     594         ELSE 
     595            ndelayid(idvar) = MPI_REQUEST_NULL 
    591596         END IF 
    592597      ENDIF 
    … …  
    596601         ALLOCATE(todelay(idvar)%z1d(isz)) 
    597602         CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr )   ! get %z1d 
    598       ENDIF 
    599  
    600       IF( ndelayid(idvar) > 0 )   CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received 
     603         ndelayid(idvar) = MPI_REQUEST_NULL 
     604      ENDIF 
     605 
     606      CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received 
    601607 
    602608      ! send back pout from todelay(idvar)%z1d defined at previous call 
    … …  
    604610 
    605611      ! send p_in into todelay(idvar)%z1d with a non-blocking communication 
     612      ! (PM) Should we get rid of MPI2 option ? MPI3 was release in 2013. Who is still using MPI2 ? 
    606613# if defined key_mpi2 
    607614      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 
    608       CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar), ierr ) 
     615      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ierr ) 
    609616      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    610617# else 
    … …  
    629636      !!---------------------------------------------------------------------- 
    630637#if defined key_mpp_mpi 
    631       IF( ndelayid(kid) /= -2 ) THEN   
    632 #if ! defined key_mpi2 
    633          IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 
    634          CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr )                        ! make sure todelay(kid) is received 
    635          IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    636 #endif 
    637          IF( ASSOCIATED(todelay(kid)%y1d) )   todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp)  ! define %z1d from %y1d 
    638          ndelayid(kid) = -2   ! add flag to know that mpi_wait was already called on kid 
    639       ENDIF 
     638      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 
     639      ! test on ndelayid(kid) useless as mpi_wait return immediatly if the request handle is MPI_REQUEST_NULL 
     640      CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! after this ndelayid(kid) = MPI_REQUEST_NULL 
     641      IF( ln_timing ) CALL tic_tac( .FALSE., ld_global = .TRUE.) 
     642      IF( ASSOCIATED(todelay(kid)%y1d) )   todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp)  ! define %z1d from %y1d 
    640643#endif 
    641644   END SUBROUTINE mpp_delay_rcv 

  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC/mpp_lbc_north_icb_generic.h90

    r13286 r13942  
    6767      ! 
    6868      IF( ln_timing ) CALL tic_tac(.TRUE.) 
     69#if defined key_mpp_mpi 
    6970      CALL MPI_ALLGATHER( znorthloc_e(1,1-kextj)    , itaille, MPI_TYPE,    & 
    7071         &                znorthgloio_e(1,1-kextj,1), itaille, MPI_TYPE,    & 
    7172         &                ncomm_north, ierr ) 
     73#endif 
    7274      ! 
    7375      IF( ln_timing ) CALL tic_tac(.FALSE.) 

  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC/mpp_loc_generic.h90

    r13286 r13942  
    22#   if defined SINGLE_PRECISION 
    33#      define ARRAY_TYPE(i,j,k)    REAL(sp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    4 #      define MASK_TYPE(i,j,k)     REAL(sp)        , INTENT(in   ) ::   MASK_IN(i,j,k) 
     4#if defined key_mpp_mpi 
     5#      define MPI_TYPE MPI_2REAL 
     6#endif 
    57#      define PRECISION sp 
    68#   else 
    79#      define ARRAY_TYPE(i,j,k)    REAL(dp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k) 
    8 #      define MASK_TYPE(i,j,k)     REAL(dp)        , INTENT(in   ) ::   MASK_IN(i,j,k) 
     10#if defined key_mpp_mpi 
     11#      define MPI_TYPE MPI_2DOUBLE_PRECISION 
     12#endif 
    913#      define PRECISION dp 
    1014#   endif 
    … …  
    1216#   if defined DIM_2d 
    1317#      define ARRAY_IN(i,j,k)   ptab(i,j) 
    14 #      define MASK_IN(i,j,k)    pmask(i,j) 
     18#      define MASK_IN(i,j,k)    ldmsk(i,j) 
    1519#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(2) 
    1620#      define K_SIZE(ptab)      1 
    … …  
    1822#   if defined DIM_3d 
    1923#      define ARRAY_IN(i,j,k)   ptab(i,j,k) 
    20 #      define MASK_IN(i,j,k)    pmask(i,j,k) 
     24#      define MASK_IN(i,j,k)    ldmsk(i,j,k) 
    2125#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(3) 
    2226#      define K_SIZE(ptab)      SIZE(ptab,3) 
    2327#   endif 
    2428#   if defined OPERATION_MAXLOC 
    25 #      define MPI_OPERATION mpi_maxloc 
     29#      define MPI_OPERATION MPI_MAXLOC 
    2630#      define LOC_OPERATION MAXLOC 
    2731#      define ERRVAL -HUGE 
    2832#   endif 
    2933#   if defined OPERATION_MINLOC 
    30 #      define MPI_OPERATION mpi_minloc 
     34#      define MPI_OPERATION MPI_MINLOC 
    3135#      define LOC_OPERATION MINLOC 
    3236#      define ERRVAL HUGE 
    3337#   endif 
    3438 
    35    SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex ) 
     39   SUBROUTINE ROUTINE_LOC( cdname, ptab, ldmsk, pmin, kindex, ldhalo ) 
    3640      !!---------------------------------------------------------------------- 
    37       CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     41      CHARACTER(len=*), INTENT(in    ) ::   cdname  ! name of the calling subroutine 
    3842      ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied 
    39       MASK_TYPE(:,:,:)                             ! local mask 
    40       REAL(PRECISION)        , INTENT(  out) ::   pmin    ! Global minimum of ptab 
     43      LOGICAL          , INTENT(in   ) ::   MASK_IN(:,:,:)                     ! local mask 
     44      REAL(PRECISION)  , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    4145      INDEX_TYPE(:)                                ! index of minimum in global frame 
     46      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldhalo  ! If .false. (default) excludes halos in kindex  
    4247      ! 
    4348      INTEGER  ::   ierror, ii, idim 
    4449      INTEGER  ::   index0 
     50      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs 
    4551      REAL(PRECISION) ::   zmin     ! local minimum 
    46       INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs 
    47       REAL(dp), DIMENSION(2,1) ::   zain, zaout 
     52      REAL(PRECISION), DIMENSION(2,1) ::   zain, zaout 
     53      LOGICAL  ::   llhalo 
    4854      !!----------------------------------------------------------------------- 
    4955      ! 
    5056      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 
    5157      ! 
     58      IF( PRESENT(ldhalo) ) THEN   ;   llhalo = ldhalo 
     59      ELSE                         ;   llhalo = .FALSE. 
     60      ENDIF 
     61      ! 
    5262      idim = SIZE(kindex) 
    5363      ! 
    54       IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN 
    55          ! special case for land processors 
    56          zmin = ERRVAL(zmin) 
    57          index0 = 0 
    58       ELSE 
     64      IF ( ANY( MASK_IN(:,:,:) ) ) THEN   ! there is at least 1 valid point... 
     65         ! 
    5966         ALLOCATE ( ilocs(idim) ) 
    6067         ! 
    61          ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp ) 
     68         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) ) 
    6269         zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3)) 
    6370         ! 
    … …  
    7986         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 
    8087#endif 
     88      ELSE 
     89         ! special case for land processors 
     90         zmin = ERRVAL(zmin) 
     91         index0 = 0 
    8192      END IF 
     93      ! 
    8294      zain(1,:) = zmin 
    83       zain(2,:) = REAL(index0, wp) 
     95      zain(2,:) = REAL(index0, PRECISION) 
    8496      ! 
     97#if defined key_mpp_mpi 
    8598      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 
    86 #if defined key_mpp_mpi 
    87       CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror) 
     99      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_TYPE, MPI_OPERATION ,MPI_COMM_OCE, ierror) 
     100      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    88101#else 
    89102      zaout(:,:) = zain(:,:) 
    90103#endif 
    91       IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    92104      ! 
    93105      pmin      = zaout(1,1) 
    … …  
    104116      kindex(:) = kindex(:) + 1   ! start indices at 1 
    105117 
     118      IF( .NOT. llhalo ) THEN 
     119         kindex(1)  = kindex(1) - nn_hls 
     120#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     121         kindex(2)  = kindex(2) - nn_hls 
     122#endif 
     123      ENDIF 
     124       
    106125   END SUBROUTINE ROUTINE_LOC 
    107126 
    … …  
    109128#undef PRECISION 
    110129#undef ARRAY_TYPE 
    111 #undef MASK_TYPE 
    112130#undef ARRAY_IN 
    113131#undef MASK_IN 
    114132#undef K_SIZE 
     133#if defined key_mpp_mpi 
     134#   undef MPI_TYPE 
     135#endif 
    115136#undef MPI_OPERATION 
    116137#undef LOC_OPERATION 

  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC/mpp_nfd_generic.h90

    r13290 r13942  
    317317         ! start waiting time measurement 
    318318         IF( ln_timing ) CALL tic_tac(.TRUE.) 
     319#if defined key_mpp_mpi 
    319320         CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthglo, ibuffsize, MPI_TYPE, ncomm_north, ierr ) 
     321#endif 
    320322         ! stop waiting time measurement 
    321323         IF( ln_timing ) CALL tic_tac(.FALSE.) 

  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/LBC/mppini.F90

    r13305 r13942  
    6262      !!---------------------------------------------------------------------- 
    6363      ! 
    64       jpiglo = Ni0glo 
    65       jpjglo = Nj0glo 
     64      nn_hls = 1 
     65      jpiglo = Ni0glo + 2 * nn_hls 
     66      jpjglo = Nj0glo + 2 * nn_hls 
    6667      jpimax = jpiglo 
    6768      jpjmax = jpjglo 
    … …  
    7273      jpjm1  = jpj-1                         !   "           " 
    7374      jpkm1  = MAX( 1, jpk-1 )               !   "           " 
    74       ! 
    75       CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls)  
    76       ! 
    7775      jpij   = jpi*jpj 
    7876      jpni   = 1 
    7977      jpnj   = 1 
    8078      jpnij  = jpni*jpnj 
    81       nn_hls = 1 
    8279      nimpp  = 1 
    8380      njmpp  = 1 
    … …  
    9188      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 
    9289      ! 
     90      CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls)  
     91      ! 
    9392      IF(lwp) THEN 
    9493         WRITE(numout,*) 
    … …  
    9998      ENDIF 
    10099      ! 
    101       IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 )                                     & 
    102          CALL ctl_stop( 'mpp_init: equality  jpni = jpnj = jpnij = 1 is not satisfied',   & 
    103             &           'the domain is lay out for distributed memory computing!' ) 
    104          ! 
    105100#if defined key_agrif 
    106101    IF (.NOT.agrif_root()) THEN 
    … …  
    676671    END SUBROUTINE mpp_init 
    677672 
     673#endif 
    678674 
    679675    SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
    … …  
    790786      !! ** Method  : 
    791787      !!---------------------------------------------------------------------- 
    792       INTEGER,           INTENT(in   ) ::   knbij         ! total number if subdomains              (knbi*knbj) 
     788      INTEGER,           INTENT(in   ) ::   knbij         ! total number of subdomains (knbi*knbj) 
    793789      INTEGER, OPTIONAL, INTENT(  out) ::   knbi, knbj    ! number if subdomains along i and j (knbi and knbj) 
    794790      INTEGER, OPTIONAL, INTENT(  out) ::   knbcnt        ! number of land subdomains 
    … …  
    798794      INTEGER :: iszitst, iszjtst 
    799795      INTEGER :: isziref, iszjref 
     796      INTEGER :: iszimin, iszjmin 
    800797      INTEGER :: inbij, iszij 
    801798      INTEGER :: inbimax, inbjmax, inbijmax, inbijold 
    … …  
    826823      inbimax = 0 
    827824      inbjmax = 0 
    828       isziref = Ni0glo*Nj0glo+1 
    829       iszjref = Ni0glo*Nj0glo+1 
     825      isziref = jpiglo*jpjglo+1   ! define a value that is larger than the largest possible 
     826      iszjref = jpiglo*jpjglo+1 
     827      ! 
     828      iszimin = 4*nn_hls          ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain 
     829      iszjmin = 4*nn_hls 
     830      IF( jperio == 3 .OR. jperio == 4 )   iszjmin = MAX(iszjmin, 2+3*nn_hls)   ! V and F folding must be outside of southern halos 
     831      IF( jperio == 5 .OR. jperio == 6 )   iszjmin = MAX(iszjmin, 1+3*nn_hls)   ! V and F folding must be outside of southern halos 
    830832      ! 
    831833      ! get the list of knbi that gives a smaller jpimax than knbi-1 
    … …  
    835837         iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim. 
    836838#else 
    837          iszitst = ( Ni0glo + (ji-1) ) / ji 
     839         iszitst = ( Ni0glo + (ji-1) ) / ji + 2*nn_hls   ! max subdomain i-size 
    838840#endif 
    839          IF( iszitst < isziref ) THEN 
     841         IF( iszitst < isziref .AND. iszitst >= iszimin ) THEN 
    840842            isziref = iszitst 
    841843            inbimax = inbimax + 1 
    … …  
    846848         iszjtst = ( ny_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim. 
    847849#else 
    848          iszjtst = ( Nj0glo + (ji-1) ) / ji 
     850         iszjtst = ( Nj0glo + (ji-1) ) / ji + 2*nn_hls   ! max subdomain j-size 
    849851#endif 
    850          IF( iszjtst < iszjref ) THEN 
     852         IF( iszjtst < iszjref .AND. iszjtst >= iszjmin ) THEN 
    851853            iszjref = iszjtst 
    852854            inbjmax = inbjmax + 1 
    … …  
    901903      isz0 = 0                                                  ! number of best partitions      
    902904      inbij = 1                                                 ! start with the min value of inbij1 => 1 
    903       iszij = Ni0glo*Nj0glo+1                                   ! default: larger than global domain 
     905      iszij = jpiglo*jpjglo+1                                   ! default: larger than global domain 
    904906      DO WHILE( inbij <= inbijmax )                             ! if we did not reach the max of inbij1 
    905907         ii = MINLOC(iszij1, mask = inbij1 == inbij, dim = 1)   ! warning: send back the first occurence if multiple results 
    906908         IF ( iszij1(ii) < iszij ) THEN 
     909            ii = MINLOC( iszi1+iszj1, mask = iszij1 == iszij1(ii) .AND. inbij1 == inbij, dim = 1)  ! select the smaller perimeter if multiple min 
    907910            isz0 = isz0 + 1 
    908911            indexok(isz0) = ii 
    … …  
    13221325   END SUBROUTINE init_nfdcom 
    13231326 
    1324 #endif 
    13251327 
    13261328   SUBROUTINE init_doloop 
Note: See TracChangeset for help on using the changeset viewer.