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

Ignore:
Timestamp:
2010-06-29T17:41:10+02:00 (14 years ago)
Author:
acc
Message:

ticket #684 step 6: Add in changes between the head of the DEV_r1879_mpp_rep branch and the trunk@1879.

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r1970 r1976  
    7575#endif 
    7676 
     77# if defined key_mpp_rep1 
     78   PUBLIC mpp_allgatherv 
     79# endif 
     80 
    7781   !! * Interfaces 
    7882   !! define generic interface for these routine as they are called sometimes 
    … …  
    8690   END INTERFACE 
    8791   INTERFACE mpp_sum 
     92# if defined key_mpp_rep2 
     93      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 
     94                       mppsum_realdd, mppsum_a_realdd 
     95# else 
    8896      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real 
     97# endif 
    8998   END INTERFACE 
    9099   INTERFACE mpp_lbc_north 
    … …  
    97106      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 
    98107   END INTERFACE 
    99  
     108    
     109# if defined key_mpp_rep1 
     110   INTERFACE mpp_allgatherv 
     111      MODULE PROCEDURE mpp_allgatherv_real, mpp_allgatherv_int 
     112   END INTERFACE 
     113# endif 
    100114 
    101115   !! ========================= !! 
    … …  
    112126   INTEGER ::   mppsize        ! number of process 
    113127   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ] 
    114 !$AGRIF_DO_NOT_TREAT 
    115    INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator 
    116 !$AGRIF_END_DO_NOT_TREAT 
     128   INTEGER ::   mpi_comm_opa   ! opa local communicator 
     129 
     130   INTEGER, PUBLIC :: MPI_SUMDD 
    117131 
    118132   ! variables used in case of sea-ice 
    … …  
    193207      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer 
    194208 
    195       CALL mpi_initialized ( mpi_was_called, code ) 
    196       IF( code /= MPI_SUCCESS ) THEN 
    197          WRITE(*, cform_err) 
    198          WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
    199          CALL mpi_abort( mpi_comm_world, code, ierr ) 
    200       ENDIF 
    201  
    202       IF( mpi_was_called ) THEN 
    203          ! 
     209#if defined key_agrif 
     210      IF( Agrif_Root() ) THEN 
     211#endif 
     212         !!bug RB : should be clean to use Agrif in coupled mode 
     213#if ! defined key_agrif 
     214         CALL mpi_initialized ( mpi_was_called, code ) 
     215         IF( code /= MPI_SUCCESS ) THEN 
     216            WRITE(*, cform_err) 
     217            WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
     218            CALL mpi_abort( mpi_comm_world, code, ierr ) 
     219         ENDIF 
     220 
     221         IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
     222            mpi_comm_opa = localComm 
     223            SELECT CASE ( cn_mpi_send ) 
     224            CASE ( 'S' )                ! Standard mpi send (blocking) 
     225               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     226            CASE ( 'B' )                ! Buffer mpi send (blocking) 
     227               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     228               CALL mpi_init_opa( ierr )  
     229            CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     230               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     231               l_isend = .TRUE. 
     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         ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
     238            WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
     239            WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
     240            nstop = nstop + 1 
     241         ELSE 
     242#endif 
     243            SELECT CASE ( cn_mpi_send ) 
     244            CASE ( 'S' )                ! Standard mpi send (blocking) 
     245               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     246               CALL mpi_init( ierr ) 
     247            CASE ( 'B' )                ! Buffer mpi send (blocking) 
     248               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     249               CALL mpi_init_opa( ierr ) 
     250            CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     251               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     252               l_isend = .TRUE. 
     253               CALL mpi_init( ierr ) 
     254            CASE DEFAULT 
     255               WRITE(ldtxt(7),cform_err) 
     256               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
     257               nstop = nstop + 1 
     258            END SELECT 
     259 
     260#if ! defined key_agrif 
     261            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
     262            IF( code /= MPI_SUCCESS ) THEN 
     263               WRITE(*, cform_err) 
     264               WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
     265               CALL mpi_abort( mpi_comm_world, code, ierr ) 
     266            ENDIF 
     267            ! 
     268         ENDIF 
     269#endif 
     270#if defined key_agrif 
     271      ELSE 
    204272         SELECT CASE ( cn_mpi_send ) 
    205273         CASE ( 'S' )                ! Standard mpi send (blocking) 
    … …  
    207275         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    208276            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    209             CALL mpi_init_opa( ierr )  
    210277         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    211278            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    … …  
    216283            nstop = nstop + 1 
    217284         END SELECT 
    218       ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
    219          WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
    220          WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
    221          nstop = nstop + 1 
    222       ELSE 
    223          SELECT CASE ( cn_mpi_send ) 
    224          CASE ( 'S' )                ! Standard mpi send (blocking) 
    225             WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    226             CALL mpi_init( ierr ) 
    227          CASE ( 'B' )                ! Buffer mpi send (blocking) 
    228             WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    229             CALL mpi_init_opa( ierr ) 
    230          CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    231             WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    232             l_isend = .TRUE. 
    233             CALL mpi_init( ierr ) 
    234          CASE DEFAULT 
    235             WRITE(ldtxt(7),cform_err) 
    236             WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    237             nstop = nstop + 1 
    238          END SELECT 
    239          ! 
    240285      ENDIF 
    241286 
    242       IF( PRESENT(localComm) ) THEN  
    243          IF( Agrif_Root() ) THEN 
    244             mpi_comm_opa = localComm 
    245          ENDIF 
    246       ELSE 
    247          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    248          IF( code /= MPI_SUCCESS ) THEN 
    249             WRITE(*, cform_err) 
    250             WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
    251             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    252          ENDIF 
    253       ENDIF  
    254  
     287      mpi_comm_opa = mpi_comm_world 
     288#endif 
    255289      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    256290      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
    257291      mynode = mpprank 
     292      ! 
     293#if defined key_mpp_rep2 
     294      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
     295#endif 
    258296      ! 
    259297   END FUNCTION mynode 
    … …  
    13941432   END SUBROUTINE mppsum_real 
    13951433 
    1396  
     1434# if defined key_mpp_rep2 
     1435   SUBROUTINE mppsum_realdd( ytab, kcom ) 
     1436      !!---------------------------------------------------------------------- 
     1437      !!                  ***  routine mppsum_realdd *** 
     1438      !! 
     1439      !! ** Purpose :   global sum in Massively Parallel Processing 
     1440      !!                SCALAR argument case for double-double precision 
     1441      !! 
     1442      !!----------------------------------------------------------------------- 
     1443      COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar 
     1444      INTEGER , INTENT( in  ), OPTIONAL :: kcom 
     1445 
     1446      !! * Local variables   (MPI version) 
     1447      INTEGER  ::    ierror 
     1448      INTEGER  ::   localcomm 
     1449      COMPLEX(wp) :: zwork 
     1450 
     1451      localcomm = mpi_comm_opa 
     1452      IF( PRESENT(kcom) ) localcomm = kcom 
     1453 
     1454      ! reduce local sums into global sum 
     1455      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, & 
     1456                       MPI_SUMDD,localcomm,ierror) 
     1457      ytab = zwork 
     1458 
     1459   END SUBROUTINE mppsum_realdd 
     1460   
     1461   
     1462   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom ) 
     1463      !!---------------------------------------------------------------------- 
     1464      !!                  ***  routine mppsum_a_realdd  *** 
     1465      !! 
     1466      !! ** Purpose :   global sum in Massively Parallel Processing 
     1467      !!                COMPLEX ARRAY case for double-double precision 
     1468      !! 
     1469      !!----------------------------------------------------------------------- 
     1470      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab 
     1471      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array 
     1472      INTEGER , INTENT( in  ), OPTIONAL :: kcom 
     1473 
     1474      !! * Local variables   (MPI version) 
     1475      INTEGER                      :: ierror    ! temporary integer 
     1476      INTEGER                      ::   localcomm 
     1477      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace 
     1478 
     1479      localcomm = mpi_comm_opa 
     1480      IF( PRESENT(kcom) ) localcomm = kcom 
     1481 
     1482      CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, & 
     1483                       MPI_SUMDD,localcomm,ierror) 
     1484      ytab(:) = zwork(:) 
     1485 
     1486   END SUBROUTINE mppsum_a_realdd 
     1487# endif    
     1488    
    13971489   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) 
    13981490      !!------------------------------------------------------------------------ 
    … …  
    20492141      ijpj   = 4 
    20502142      ijpjm1 = 3 
    2051       ztab(:,:,:) = 0.e0 
    20522143      ! 
    20532144      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d 
    … …  
    21152206      ijpj   = 4 
    21162207      ijpjm1 = 3 
    2117       ztab(:,:) = 0.e0 
    21182208      ! 
    21192209      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d 
    … …  
    21812271      ! 
    21822272      ijpj=4 
    2183       ztab(:,:) = 0.e0 
    21842273 
    21852274      ij=0 
    … …  
    22652354   END SUBROUTINE mpi_init_opa 
    22662355 
     2356#if defined key_mpp_rep1 
     2357   SUBROUTINE mpp_allgatherv_real( pvalsin, knoin, pvalsout, ksizeout, & 
     2358      &                            knoout, kstartout ) 
     2359      !!---------------------------------------------------------------------- 
     2360      !!               ***  ROUTINE mpp_allgatherv_real *** 
     2361      !!           
     2362      !! ** Purpose : Gather a real array on all processors 
     2363      !! 
     2364      !! ** Method  : MPI all gatherv 
     2365      !! 
     2366      !! ** Action  : This does only work for MPI.  
     2367      !!              It does not work for SHMEM. 
     2368      !! 
     2369      !! References : http://www.mpi-forum.org 
     2370      !! 
     2371      !! History : 
     2372      !!        !  08-08  (K. Mogensen)  Original code 
     2373      !!---------------------------------------------------------------------- 
     2374 
     2375      !! * Arguments 
     2376      INTEGER, INTENT(IN) :: & 
     2377         & knoin,     & 
     2378         & ksizeout 
     2379      REAL(wp), DIMENSION(knoin), INTENT(IN) :: & 
     2380         & pvalsin 
     2381      REAL(wp), DIMENSION(ksizeout), INTENT(OUT) :: & 
     2382         & pvalsout 
     2383      INTEGER, DIMENSION(jpnij), INTENT(OUT) :: & 
     2384         & kstartout, & 
     2385         & knoout 
     2386       
     2387      !! * Local declarations 
     2388      INTEGER :: & 
     2389         & ierr 
     2390      INTEGER :: & 
     2391         & ji 
     2392      !----------------------------------------------------------------------- 
     2393      ! Call the MPI library to get number of data per processor 
     2394      !----------------------------------------------------------------------- 
     2395      CALL mpi_allgather( knoin,  1, mpi_integer, & 
     2396         &                knoout, 1, mpi_integer, & 
     2397         &                mpi_comm_opa, ierr ) 
     2398      !----------------------------------------------------------------------- 
     2399      ! Compute starts of each processors contribution 
     2400      !----------------------------------------------------------------------- 
     2401      kstartout(1) = 0 
     2402      DO ji = 2, jpnij 
     2403         kstartout(ji) = kstartout(ji-1) + knoout(ji-1)  
     2404      ENDDO 
     2405      !----------------------------------------------------------------------- 
     2406      ! Call the MPI library to do the gathering of the data 
     2407      !----------------------------------------------------------------------- 
     2408      CALL mpi_allgatherv( pvalsin,  knoin,  MPI_DOUBLE_PRECISION,            & 
     2409         &                 pvalsout, knoout, kstartout, MPI_DOUBLE_PRECISION, & 
     2410         &                 mpi_comm_opa, ierr ) 
     2411      
     2412   END SUBROUTINE mpp_allgatherv_real 
     2413 
     2414   SUBROUTINE mpp_allgatherv_int( kvalsin, knoin, kvalsout, ksizeout, & 
     2415      &                               knoout, kstartout ) 
     2416      !!---------------------------------------------------------------------- 
     2417      !!               ***  ROUTINE mpp_allgatherv *** 
     2418      !!           
     2419      !! ** Purpose : Gather an integer array on all processors 
     2420      !! 
     2421      !! ** Method  : MPI all gatherv 
     2422      !! 
     2423      !! ** Action  : This does only work for MPI.  
     2424      !!              It does not work for SHMEM. 
     2425      !! 
     2426      !! References : http://www.mpi-forum.org 
     2427      !! 
     2428      !! History : 
     2429      !!        !  06-07  (K. Mogensen)  Original code 
     2430      !!---------------------------------------------------------------------- 
     2431 
     2432      !! * Arguments 
     2433      INTEGER, INTENT(IN) :: & 
     2434         & knoin,     & 
     2435         & ksizeout 
     2436      INTEGER, DIMENSION(knoin), INTENT(IN) :: & 
     2437         & kvalsin 
     2438      INTEGER, DIMENSION(ksizeout), INTENT(OUT) :: & 
     2439         & kvalsout 
     2440      INTEGER, DIMENSION(jpnij), INTENT(OUT) :: & 
     2441         & kstartout, & 
     2442         & knoout 
     2443       
     2444      !! * Local declarations 
     2445      INTEGER :: & 
     2446         & ierr 
     2447      INTEGER :: & 
     2448         & ji 
     2449      !----------------------------------------------------------------------- 
     2450      ! Call the MPI library to get number of data per processor 
     2451      !----------------------------------------------------------------------- 
     2452      CALL mpi_allgather( knoin,  1, mpi_integer, & 
     2453         &                knoout, 1, mpi_integer, & 
     2454         &                mpi_comm_opa, ierr ) 
     2455      !----------------------------------------------------------------------- 
     2456      ! Compute starts of each processors contribution 
     2457      !----------------------------------------------------------------------- 
     2458      kstartout(1) = 0 
     2459      DO ji = 2, jpnij 
     2460         kstartout(ji) = kstartout(ji-1) + knoout(ji-1) 
     2461      ENDDO 
     2462      !----------------------------------------------------------------------- 
     2463      ! Call the MPI library to do the gathering of the data 
     2464      !----------------------------------------------------------------------- 
     2465      CALL mpi_allgatherv( kvalsin,  knoin,  mpi_integer,            & 
     2466         &                 kvalsout, knoout, kstartout, mpi_integer, & 
     2467         &                 mpi_comm_opa, ierr ) 
     2468       
     2469   END SUBROUTINE mpp_allgatherv_int 
     2470#endif 
     2471 
     2472#if defined key_mpp_rep2 
     2473   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype) 
     2474      !!--------------------------------------------------------------------- 
     2475      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD 
     2476      !! 
     2477      !!   Modification of original codes written by David H. Bailey 
     2478      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i) 
     2479      !!--------------------------------------------------------------------- 
     2480      INTEGER, INTENT(in)                         :: ilen, itype 
     2481      COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda 
     2482      COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb 
     2483      ! 
     2484      REAL(wp) :: zerr, zt1, zt2    ! local work variables 
     2485      INTEGER :: ji, ztmp           ! local scalar 
     2486 
     2487      ztmp = itype   ! avoid compilation warning 
     2488 
     2489      DO ji=1,ilen 
     2490      ! Compute ydda + yddb using Knuth's trick. 
     2491         zt1  = real(ydda(ji)) + real(yddb(ji)) 
     2492         zerr = zt1 - real(ydda(ji)) 
     2493         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) & 
     2494                + aimag(ydda(ji)) + aimag(yddb(ji)) 
     2495 
     2496         ! The result is zt1 + zt2, after normalization. 
     2497         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp ) 
     2498      END DO 
     2499 
     2500   END SUBROUTINE DDPDD_MPI 
     2501#endif 
     2502 
    22672503#else 
    22682504   !!---------------------------------------------------------------------- 
    22692505   !!   Default case:            Dummy module        share memory computing 
    22702506   !!---------------------------------------------------------------------- 
     2507# if defined key_mpp_rep1 
     2508   USE par_kind 
     2509   USE par_oce 
     2510 
     2511   PUBLIC mpp_allgatherv 
     2512# endif 
     2513 
    22712514   INTERFACE mpp_sum 
    2272       MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i 
     2515      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i,  & 
     2516             &         mpp_sum_c, mpp_sum_ac  
    22732517   END INTERFACE 
    22742518   INTERFACE mpp_max 
    … …  
    22882532   END INTERFACE 
    22892533 
     2534# if defined key_mpp_rep1 
     2535   INTERFACE mpp_allgatherv 
     2536      MODULE PROCEDURE mpp_allgatherv_real, mpp_allgatherv_int 
     2537   END INTERFACE 
     2538# endif 
     2539 
    22902540 
    22912541   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag 
    … …  
    23252575   END SUBROUTINE mpp_sum_ai 
    23262576 
     2577   SUBROUTINE mpp_sum_ac( yarr, kdim, kcom )      ! Dummy routine 
     2578      COMPLEX, DIMENSION(:) :: yarr 
     2579      INTEGER               :: kdim 
     2580      INTEGER, OPTIONAL     :: kcom  
     2581      WRITE(*,*) 'mpp_sum_ac: You should not have seen this print! error?', kdim, yarr(1), kcom 
     2582   END SUBROUTINE mpp_sum_ac 
     2583 
    23272584   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine 
    23282585      REAL                  :: psca 
    … …  
    23302587      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom 
    23312588   END SUBROUTINE mpp_sum_s 
    2332  
     2589  
    23332590   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine 
    23342591      integer               :: kint 
    2335       INTEGER, OPTIONAL     :: kcom  
     2592      INTEGER, OPTIONAL     :: kcom 
    23362593      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom 
    23372594   END SUBROUTINE mpp_sum_i 
     2595 
     2596   SUBROUTINE mpp_sum_c( ysca, kcom )            ! Dummy routine 
     2597      COMPLEX               :: ysca 
     2598      INTEGER, OPTIONAL     :: kcom  
     2599      WRITE(*,*) 'mpp_sum_c: You should not have seen this print! error?', ysca, kcom 
     2600   END SUBROUTINE mpp_sum_c 
    23382601 
    23392602   SUBROUTINE mppmax_a_real( parr, kdim, kcom ) 
    … …  
    24592722   END SUBROUTINE mpp_comm_free 
    24602723 
     2724# if defined key_mpp_rep1  
     2725   SUBROUTINE mpp_allgatherv_real( pvalsin, knoin, pvalsout, ksizeout, & 
     2726      &                            knoout, kstartout ) 
     2727      INTEGER, INTENT(IN) :: & 
     2728         & knoin,     & 
     2729         & ksizeout 
     2730      REAL(wp), DIMENSION(knoin), INTENT(IN) :: & 
     2731         & pvalsin 
     2732      REAL(wp), DIMENSION(ksizeout), INTENT(OUT) :: & 
     2733         & pvalsout 
     2734      INTEGER, DIMENSION(jpnij), INTENT(OUT) :: & 
     2735         & kstartout, & 
     2736         & knoout 
     2737      pvalsout(1:knoin) = pvalsin(1:knoin) 
     2738      kstartout(1) = 0 
     2739      knoout(1) = knoin           
     2740   END SUBROUTINE mpp_allgatherv_real 
     2741 
     2742   SUBROUTINE mpp_allgatherv_int( kvalsin, knoin, kvalsout, ksizeout, & 
     2743      &                               knoout, kstartout ) 
     2744      INTEGER, INTENT(IN) :: & 
     2745         & knoin,     & 
     2746         & ksizeout 
     2747      INTEGER, DIMENSION(knoin), INTENT(IN) :: & 
     2748         & kvalsin 
     2749      INTEGER, DIMENSION(ksizeout), INTENT(OUT) :: & 
     2750         & kvalsout 
     2751      INTEGER, DIMENSION(jpnij), INTENT(OUT) :: & 
     2752         & kstartout, & 
     2753         & knoout 
     2754       
     2755      kvalsout(1:knoin) = kvalsin(1:knoin) 
     2756      kstartout(1) = 0 
     2757      knoout(1) = knoin             
     2758   END SUBROUTINE mpp_allgatherv_int 
     2759# endif 
     2760 
    24612761#endif 
    24622762   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.