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 2304 for branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2010-10-22T17:56:39+02:00 (14 years ago)
Author:
rblod
Message:

Choose one option for mpp reproducibility, see ticket #743

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lib_mpp.F90

    r2287 r2304  
    7373   PUBLIC   mppsize, mpprank 
    7474 
    75 # if defined key_mpp_rep1 
    76    PUBLIC mpp_allgatherv 
    77 # endif 
    78  
    7975   !! * Interfaces 
    8076   !! define generic interface for these routine as they are called sometimes 
    … …  
    8884   END INTERFACE 
    8985   INTERFACE mpp_sum 
    90 # if defined key_mpp_rep2 
     86# if defined key_mpp_rep 
    9187      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 
    9288                       mppsum_realdd, mppsum_a_realdd 
    … …  
    105101   END INTERFACE 
    106102    
    107 # if defined key_mpp_rep1 
    108    INTERFACE mpp_allgatherv 
    109       MODULE PROCEDURE mpp_allgatherv_real, mpp_allgatherv_int 
    110    END INTERFACE 
    111 # endif 
    112  
    113103   !! ========================= !! 
    114104   !!  MPI  variable definition !! 
    … …  
    289279      mynode = mpprank 
    290280      ! 
    291 #if defined key_mpp_rep2 
     281#if defined key_mpp_rep 
    292282      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
    293283#endif 
    … …  
    14301420   END SUBROUTINE mppsum_real 
    14311421 
    1432 # if defined key_mpp_rep2 
     1422# if defined key_mpp_rep 
    14331423   SUBROUTINE mppsum_realdd( ytab, kcom ) 
    14341424      !!---------------------------------------------------------------------- 
    … …  
    23522342   END SUBROUTINE mpi_init_opa 
    23532343 
    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 
     2344#if defined key_mpp_rep 
    24712345   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype) 
    24722346      !!--------------------------------------------------------------------- 
    … …  
    25032377   !!   Default case:            Dummy module        share memory computing 
    25042378   !!---------------------------------------------------------------------- 
    2505 # if defined key_mpp_rep1 
    2506    USE par_kind 
    2507    USE par_oce 
    2508  
    2509    PUBLIC mpp_allgatherv 
    2510 # endif 
    25112379 
    25122380   INTERFACE mpp_sum 
    … …  
    25302398   END INTERFACE 
    25312399 
    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  
    2538  
    25392400   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag 
    25402401   INTEGER :: ncomm_ice 
    … …  
    27192580      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom 
    27202581   END SUBROUTINE mpp_comm_free 
    2721  
    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  
    27592582#endif 
    27602583   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.