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 2219 for branches/DEV_r2191_3partymerge2010/NEMO/OPA_SRC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2010-10-12T15:06:30+02:00 (14 years ago)
Author:
rblod
Message:

Merge branch DEV_1879_mpp_rep into DEV_r2191_3partymerge2010

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/DEV_r2191_3partymerge2010/NEMO/OPA_SRC/lib_mpp.F90

    r2208 r2219  
    7373   PUBLIC   mppsize, mpprank 
    7474 
     75# if defined key_mpp_rep1 
     76   PUBLIC mpp_allgatherv 
     77# endif 
     78 
    7579   !! * Interfaces 
    7680   !! define generic interface for these routine as they are called sometimes 
    … …  
    8488   END INTERFACE 
    8589   INTERFACE mpp_sum 
     90# if defined key_mpp_rep2 
     91      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 
     92                       mppsum_realdd, mppsum_a_realdd 
     93# else 
    8694      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real 
     95# endif 
    8796   END INTERFACE 
    8897   INTERFACE mpp_lbc_north 
    … …  
    95104      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 
    96105   END INTERFACE 
    97  
     106    
     107# if defined key_mpp_rep1 
     108   INTERFACE mpp_allgatherv 
     109      MODULE PROCEDURE mpp_allgatherv_real, mpp_allgatherv_int 
     110   END INTERFACE 
     111# endif 
    98112 
    99113   !! ========================= !! 
    … …  
    110124   INTEGER ::   mppsize        ! number of process 
    111125   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ] 
    112 !$AGRIF_DO_NOT_TREAT 
    113    INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator 
    114 !$AGRIF_END_DO_NOT_TREAT 
     126   INTEGER ::   mpi_comm_opa   ! opa local communicator 
     127 
     128   INTEGER, PUBLIC :: MPI_SUMDD 
    115129 
    116130   ! variables used in case of sea-ice 
    … …  
    191205      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer 
    192206 
    193       CALL mpi_initialized ( mpi_was_called, code ) 
    194       IF( code /= MPI_SUCCESS ) THEN 
    195          WRITE(*, cform_err) 
    196          WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
    197          CALL mpi_abort( mpi_comm_world, code, ierr ) 
    198       ENDIF 
    199  
    200       IF( mpi_was_called ) THEN 
    201          ! 
     207#if defined key_agrif 
     208      IF( Agrif_Root() ) THEN 
     209#endif 
     210         !!bug RB : should be clean to use Agrif in coupled mode 
     211#if ! defined key_agrif 
     212         CALL mpi_initialized ( mpi_was_called, code ) 
     213         IF( code /= MPI_SUCCESS ) THEN 
     214            WRITE(*, cform_err) 
     215            WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
     216            CALL mpi_abort( mpi_comm_world, code, ierr ) 
     217         ENDIF 
     218 
     219         IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
     220            mpi_comm_opa = localComm 
     221            SELECT CASE ( cn_mpi_send ) 
     222            CASE ( 'S' )                ! Standard mpi send (blocking) 
     223               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     224            CASE ( 'B' )                ! Buffer mpi send (blocking) 
     225               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     226               CALL mpi_init_opa( ierr )  
     227            CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     228               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     229               l_isend = .TRUE. 
     230            CASE DEFAULT 
     231               WRITE(ldtxt(7),cform_err) 
     232               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
     233               nstop = nstop + 1 
     234            END SELECT 
     235         ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
     236            WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
     237            WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
     238            nstop = nstop + 1 
     239         ELSE 
     240#endif 
     241            SELECT CASE ( cn_mpi_send ) 
     242            CASE ( 'S' )                ! Standard mpi send (blocking) 
     243               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     244               CALL mpi_init( ierr ) 
     245            CASE ( 'B' )                ! Buffer mpi send (blocking) 
     246               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     247               CALL mpi_init_opa( ierr ) 
     248            CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     249               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     250               l_isend = .TRUE. 
     251               CALL mpi_init( ierr ) 
     252            CASE DEFAULT 
     253               WRITE(ldtxt(7),cform_err) 
     254               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
     255               nstop = nstop + 1 
     256            END SELECT 
     257 
     258#if ! defined key_agrif 
     259            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
     260            IF( code /= MPI_SUCCESS ) THEN 
     261               WRITE(*, cform_err) 
     262               WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
     263               CALL mpi_abort( mpi_comm_world, code, ierr ) 
     264            ENDIF 
     265            ! 
     266         ENDIF 
     267#endif 
     268#if defined key_agrif 
     269      ELSE 
    202270         SELECT CASE ( cn_mpi_send ) 
    203271         CASE ( 'S' )                ! Standard mpi send (blocking) 
    … …  
    205273         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    206274            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    207             CALL mpi_init_opa( ierr )  
    208275         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    209276            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    … …  
    214281            nstop = nstop + 1 
    215282         END SELECT 
    216       ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
    217          WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
    218          WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
    219          nstop = nstop + 1 
    220       ELSE 
    221          SELECT CASE ( cn_mpi_send ) 
    222          CASE ( 'S' )                ! Standard mpi send (blocking) 
    223             WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    224             CALL mpi_init( ierr ) 
    225          CASE ( 'B' )                ! Buffer mpi send (blocking) 
    226             WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    227             CALL mpi_init_opa( ierr ) 
    228          CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    229             WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    230             l_isend = .TRUE. 
    231             CALL mpi_init( ierr ) 
    232          CASE DEFAULT 
    233             WRITE(ldtxt(7),cform_err) 
    234             WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    235             nstop = nstop + 1 
    236          END SELECT 
    237          ! 
    238283      ENDIF 
    239284 
    240       IF( PRESENT(localComm) ) THEN  
    241          IF( Agrif_Root() ) THEN 
    242             mpi_comm_opa = localComm 
    243          ENDIF 
    244       ELSE 
    245          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    246          IF( code /= MPI_SUCCESS ) THEN 
    247             WRITE(*, cform_err) 
    248             WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
    249             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    250          ENDIF 
    251       ENDIF  
    252  
     285      mpi_comm_opa = mpi_comm_world 
     286#endif 
    253287      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    254288      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
    255289      mynode = mpprank 
     290      ! 
     291#if defined key_mpp_rep2 
     292      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
     293#endif 
    256294      ! 
    257295   END FUNCTION mynode 
    … …  
    13921430   END SUBROUTINE mppsum_real 
    13931431 
    1394  
     1432# if defined key_mpp_rep2 
     1433   SUBROUTINE mppsum_realdd( ytab, kcom ) 
     1434      !!---------------------------------------------------------------------- 
     1435      !!                  ***  routine mppsum_realdd *** 
     1436      !! 
     1437      !! ** Purpose :   global sum in Massively Parallel Processing 
     1438      !!                SCALAR argument case for double-double precision 
     1439      !! 
     1440      !!----------------------------------------------------------------------- 
     1441      COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar 
     1442      INTEGER , INTENT( in  ), OPTIONAL :: kcom 
     1443 
     1444      !! * Local variables   (MPI version) 
     1445      INTEGER  ::    ierror 
     1446      INTEGER  ::   localcomm 
     1447      COMPLEX(wp) :: zwork 
     1448 
     1449      localcomm = mpi_comm_opa 
     1450      IF( PRESENT(kcom) ) localcomm = kcom 
     1451 
     1452      ! reduce local sums into global sum 
     1453      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, & 
     1454                       MPI_SUMDD,localcomm,ierror) 
     1455      ytab = zwork 
     1456 
     1457   END SUBROUTINE mppsum_realdd 
     1458   
     1459   
     1460   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom ) 
     1461      !!---------------------------------------------------------------------- 
     1462      !!                  ***  routine mppsum_a_realdd  *** 
     1463      !! 
     1464      !! ** Purpose :   global sum in Massively Parallel Processing 
     1465      !!                COMPLEX ARRAY case for double-double precision 
     1466      !! 
     1467      !!----------------------------------------------------------------------- 
     1468      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab 
     1469      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array 
     1470      INTEGER , INTENT( in  ), OPTIONAL :: kcom 
     1471 
     1472      !! * Local variables   (MPI version) 
     1473      INTEGER                      :: ierror    ! temporary integer 
     1474      INTEGER                      ::   localcomm 
     1475      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace 
     1476 
     1477      localcomm = mpi_comm_opa 
     1478      IF( PRESENT(kcom) ) localcomm = kcom 
     1479 
     1480      CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, & 
     1481                       MPI_SUMDD,localcomm,ierror) 
     1482      ytab(:) = zwork(:) 
     1483 
     1484   END SUBROUTINE mppsum_a_realdd 
     1485# endif    
     1486    
    13951487   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) 
    13961488      !!------------------------------------------------------------------------ 
    … …  
    20472139      ijpj   = 4 
    20482140      ijpjm1 = 3 
    2049       ztab(:,:,:) = 0.e0 
    20502141      ! 
    20512142      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d 
    … …  
    21132204      ijpj   = 4 
    21142205      ijpjm1 = 3 
    2115       ztab(:,:) = 0.e0 
    21162206      ! 
    21172207      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d 
    … …  
    21792269      ! 
    21802270      ijpj=4 
    2181       ztab(:,:) = 0.e0 
    21822271 
    21832272      ij=0 
    … …  
    22632352   END SUBROUTINE mpi_init_opa 
    22642353 
     2354#if defined key_mpp_rep1 
     2355   SUBROUTINE mpp_allgatherv_real( pvalsin, knoin, pvalsout, ksizeout, & 
     2356      &                            knoout, kstartout ) 
     2357      !!---------------------------------------------------------------------- 
     2358      !!               ***  ROUTINE mpp_allgatherv_real *** 
     2359      !!           
     2360      !! ** Purpose : Gather a real array on all processors 
     2361      !! 
     2362      !! ** Method  : MPI all gatherv 
     2363      !! 
     2364      !! ** Action  : This does only work for MPI.  
     2365      !!              It does not work for SHMEM. 
     2366      !! 
     2367      !! References : http://www.mpi-forum.org 
     2368      !! 
     2369      !! History : 
     2370      !!        !  08-08  (K. Mogensen)  Original code 
     2371      !!---------------------------------------------------------------------- 
     2372 
     2373      !! * Arguments 
     2374      INTEGER, INTENT(IN) :: & 
     2375         & knoin,     & 
     2376         & ksizeout 
     2377      REAL(wp), DIMENSION(knoin), INTENT(IN) :: & 
     2378         & pvalsin 
     2379      REAL(wp), DIMENSION(ksizeout), INTENT(OUT) :: & 
     2380         & pvalsout 
     2381      INTEGER, DIMENSION(jpnij), INTENT(OUT) :: & 
     2382         & kstartout, & 
     2383         & knoout 
     2384       
     2385      !! * Local declarations 
     2386      INTEGER :: & 
     2387         & ierr 
     2388      INTEGER :: & 
     2389         & ji 
     2390      !----------------------------------------------------------------------- 
     2391      ! Call the MPI library to get number of data per processor 
     2392      !----------------------------------------------------------------------- 
     2393      CALL mpi_allgather( knoin,  1, mpi_integer, & 
     2394         &                knoout, 1, mpi_integer, & 
     2395         &                mpi_comm_opa, ierr ) 
     2396      !----------------------------------------------------------------------- 
     2397      ! Compute starts of each processors contribution 
     2398      !----------------------------------------------------------------------- 
     2399      kstartout(1) = 0 
     2400      DO ji = 2, jpnij 
     2401         kstartout(ji) = kstartout(ji-1) + knoout(ji-1)  
     2402      ENDDO 
     2403      !----------------------------------------------------------------------- 
     2404      ! Call the MPI library to do the gathering of the data 
     2405      !----------------------------------------------------------------------- 
     2406      CALL mpi_allgatherv( pvalsin,  knoin,  MPI_DOUBLE_PRECISION,            & 
     2407         &                 pvalsout, knoout, kstartout, MPI_DOUBLE_PRECISION, & 
     2408         &                 mpi_comm_opa, ierr ) 
     2409      
     2410   END SUBROUTINE mpp_allgatherv_real 
     2411 
     2412   SUBROUTINE mpp_allgatherv_int( kvalsin, knoin, kvalsout, ksizeout, & 
     2413      &                               knoout, kstartout ) 
     2414      !!---------------------------------------------------------------------- 
     2415      !!               ***  ROUTINE mpp_allgatherv *** 
     2416      !!           
     2417      !! ** Purpose : Gather an integer array on all processors 
     2418      !! 
     2419      !! ** Method  : MPI all gatherv 
     2420      !! 
     2421      !! ** Action  : This does only work for MPI.  
     2422      !!              It does not work for SHMEM. 
     2423      !! 
     2424      !! References : http://www.mpi-forum.org 
     2425      !! 
     2426      !! History : 
     2427      !!        !  06-07  (K. Mogensen)  Original code 
     2428      !!---------------------------------------------------------------------- 
     2429 
     2430      !! * Arguments 
     2431      INTEGER, INTENT(IN) :: & 
     2432         & knoin,     & 
     2433         & ksizeout 
     2434      INTEGER, DIMENSION(knoin), INTENT(IN) :: & 
     2435         & kvalsin 
     2436      INTEGER, DIMENSION(ksizeout), INTENT(OUT) :: & 
     2437         & kvalsout 
     2438      INTEGER, DIMENSION(jpnij), INTENT(OUT) :: & 
     2439         & kstartout, & 
     2440         & knoout 
     2441       
     2442      !! * Local declarations 
     2443      INTEGER :: & 
     2444         & ierr 
     2445      INTEGER :: & 
     2446         & ji 
     2447      !----------------------------------------------------------------------- 
     2448      ! Call the MPI library to get number of data per processor 
     2449      !----------------------------------------------------------------------- 
     2450      CALL mpi_allgather( knoin,  1, mpi_integer, & 
     2451         &                knoout, 1, mpi_integer, & 
     2452         &                mpi_comm_opa, ierr ) 
     2453      !----------------------------------------------------------------------- 
     2454      ! Compute starts of each processors contribution 
     2455      !----------------------------------------------------------------------- 
     2456      kstartout(1) = 0 
     2457      DO ji = 2, jpnij 
     2458         kstartout(ji) = kstartout(ji-1) + knoout(ji-1) 
     2459      ENDDO 
     2460      !----------------------------------------------------------------------- 
     2461      ! Call the MPI library to do the gathering of the data 
     2462      !----------------------------------------------------------------------- 
     2463      CALL mpi_allgatherv( kvalsin,  knoin,  mpi_integer,            & 
     2464         &                 kvalsout, knoout, kstartout, mpi_integer, & 
     2465         &                 mpi_comm_opa, ierr ) 
     2466       
     2467   END SUBROUTINE mpp_allgatherv_int 
     2468#endif 
     2469 
     2470#if defined key_mpp_rep2 
     2471   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype) 
     2472      !!--------------------------------------------------------------------- 
     2473      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD 
     2474      !! 
     2475      !!   Modification of original codes written by David H. Bailey 
     2476      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i) 
     2477      !!--------------------------------------------------------------------- 
     2478      INTEGER, INTENT(in)                         :: ilen, itype 
     2479      COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda 
     2480      COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb 
     2481      ! 
     2482      REAL(wp) :: zerr, zt1, zt2    ! local work variables 
     2483      INTEGER :: ji, ztmp           ! local scalar 
     2484 
     2485      ztmp = itype   ! avoid compilation warning 
     2486 
     2487      DO ji=1,ilen 
     2488      ! Compute ydda + yddb using Knuth's trick. 
     2489         zt1  = real(ydda(ji)) + real(yddb(ji)) 
     2490         zerr = zt1 - real(ydda(ji)) 
     2491         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) & 
     2492                + aimag(ydda(ji)) + aimag(yddb(ji)) 
     2493 
     2494         ! The result is zt1 + zt2, after normalization. 
     2495         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp ) 
     2496      END DO 
     2497 
     2498   END SUBROUTINE DDPDD_MPI 
     2499#endif 
     2500 
    22652501#else 
    22662502   !!---------------------------------------------------------------------- 
    22672503   !!   Default case:            Dummy module        share memory computing 
    22682504   !!---------------------------------------------------------------------- 
     2505# if defined key_mpp_rep1 
     2506   USE par_kind 
     2507   USE par_oce 
     2508 
     2509   PUBLIC mpp_allgatherv 
     2510# endif 
     2511 
    22692512   INTERFACE mpp_sum 
    2270       MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i 
     2513      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i,  & 
     2514             &         mpp_sum_c, mpp_sum_ac  
    22712515   END INTERFACE 
    22722516   INTERFACE mpp_max 
    … …  
    22862530   END INTERFACE 
    22872531 
     2532# if defined key_mpp_rep1 
     2533   INTERFACE mpp_allgatherv 
     2534      MODULE PROCEDURE mpp_allgatherv_real, mpp_allgatherv_int 
     2535   END INTERFACE 
     2536# endif 
     2537 
    22882538 
    22892539   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag 
    … …  
    23232573   END SUBROUTINE mpp_sum_ai 
    23242574 
     2575   SUBROUTINE mpp_sum_ac( yarr, kdim, kcom )      ! Dummy routine 
     2576      COMPLEX, DIMENSION(:) :: yarr 
     2577      INTEGER               :: kdim 
     2578      INTEGER, OPTIONAL     :: kcom  
     2579      WRITE(*,*) 'mpp_sum_ac: You should not have seen this print! error?', kdim, yarr(1), kcom 
     2580   END SUBROUTINE mpp_sum_ac 
     2581 
    23252582   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine 
    23262583      REAL                  :: psca 
    … …  
    23282585      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom 
    23292586   END SUBROUTINE mpp_sum_s 
    2330  
     2587  
    23312588   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine 
    23322589      integer               :: kint 
    2333       INTEGER, OPTIONAL     :: kcom  
     2590      INTEGER, OPTIONAL     :: kcom 
    23342591      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom 
    23352592   END SUBROUTINE mpp_sum_i 
     2593 
     2594   SUBROUTINE mpp_sum_c( ysca, kcom )            ! Dummy routine 
     2595      COMPLEX               :: ysca 
     2596      INTEGER, OPTIONAL     :: kcom  
     2597      WRITE(*,*) 'mpp_sum_c: You should not have seen this print! error?', ysca, kcom 
     2598   END SUBROUTINE mpp_sum_c 
    23362599 
    23372600   SUBROUTINE mppmax_a_real( parr, kdim, kcom ) 
    … …  
    24572720   END SUBROUTINE mpp_comm_free 
    24582721 
     2722# if defined key_mpp_rep1  
     2723   SUBROUTINE mpp_allgatherv_real( pvalsin, knoin, pvalsout, ksizeout, & 
     2724      &                            knoout, kstartout ) 
     2725      INTEGER, INTENT(IN) :: & 
     2726         & knoin,     & 
     2727         & ksizeout 
     2728      REAL(wp), DIMENSION(knoin), INTENT(IN) :: & 
     2729         & pvalsin 
     2730      REAL(wp), DIMENSION(ksizeout), INTENT(OUT) :: & 
     2731         & pvalsout 
     2732      INTEGER, DIMENSION(jpnij), INTENT(OUT) :: & 
     2733         & kstartout, & 
     2734         & knoout 
     2735      pvalsout(1:knoin) = pvalsin(1:knoin) 
     2736      kstartout(1) = 0 
     2737      knoout(1) = knoin           
     2738   END SUBROUTINE mpp_allgatherv_real 
     2739 
     2740   SUBROUTINE mpp_allgatherv_int( kvalsin, knoin, kvalsout, ksizeout, & 
     2741      &                               knoout, kstartout ) 
     2742      INTEGER, INTENT(IN) :: & 
     2743         & knoin,     & 
     2744         & ksizeout 
     2745      INTEGER, DIMENSION(knoin), INTENT(IN) :: & 
     2746         & kvalsin 
     2747      INTEGER, DIMENSION(ksizeout), INTENT(OUT) :: & 
     2748         & kvalsout 
     2749      INTEGER, DIMENSION(jpnij), INTENT(OUT) :: & 
     2750         & kstartout, & 
     2751         & knoout 
     2752       
     2753      kvalsout(1:knoin) = kvalsin(1:knoin) 
     2754      kstartout(1) = 0 
     2755      knoout(1) = knoin             
     2756   END SUBROUTINE mpp_allgatherv_int 
     2757# endif 
     2758 
    24592759#endif 
    24602760   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.