source: codes/icosagcm/trunk/src/mpipara.F90 @ 151

MODULE mpipara

  INTEGER,SAVE :: mpi_rank
  INTEGER,SAVE :: mpi_size
  
  INTEGER,SAVE :: comm_icosa
  INTEGER,SAVE :: ierr
  LOGICAL,SAVE :: using_mpi
  LOGICAL,SAVE :: is_mpi_root
  
  INTERFACE allocate_mpi_buffer
    MODULE PROCEDURE allocate_mpi_buffer_r2, allocate_mpi_buffer_r3,allocate_mpi_buffer_r4
  END INTERFACE allocate_mpi_buffer

CONTAINS

  SUBROUTINE init_mpipara
  USE mpi_mod
  IMPLICIT NONE

    using_mpi=.FALSE.
#ifdef CPP_USING_MPI
    using_mpi=.TRUE. 
#endif 
    
    IF (using_mpi) THEN
      CALL MPI_INIT(ierr)
      comm_icosa=MPI_COMM_WORLD
      CALL MPI_COMM_SIZE(comm_icosa,mpi_size,ierr)
      CALL MPI_COMM_RANK(comm_icosa,mpi_rank,ierr)
      PRINT *, 'MPI Process ', mpi_rank, '/', mpi_size
    ELSE
      comm_icosa=-1
      mpi_size=1
      mpi_rank=0
    ENDIF
    
    IF (mpi_rank==0) THEN 
      is_mpi_root=.TRUE.
    ELSE
      is_mpi_root=.FALSE.
    ENDIF
    
  END SUBROUTINE  init_mpipara

  SUBROUTINE finalize_mpipara
  USE mpi_mod
  IMPLICIT NONE
    
    IF (using_mpi) CALL MPI_FINALIZE(ierr)
    
   END SUBROUTINE  finalize_mpipara
   

  SUBROUTINE allocate_mpi_buffer_r2(buffer,length)
  USE ISO_C_BINDING
  USE mpi_mod
  USE prec
  IMPLICIT NONE
    REAL(rstd), POINTER :: buffer(:)
    INTEGER,INTENT(IN)  :: length

    TYPE(C_PTR)         :: base_ptr
    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
    INTEGER :: real_size,ierr
    
    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
    size=length*real_size
    
    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
    CALL C_F_POINTER(base_ptr, buffer, (/ length /))

   END SUBROUTINE allocate_mpi_buffer_r2

  SUBROUTINE allocate_mpi_buffer_r3(buffer,length,dim3)
  USE ISO_C_BINDING
  USE mpi_mod
  USE prec
    IMPLICIT NONE
    REAL(rstd), POINTER :: buffer(:,:)
    INTEGER,INTENT(IN)  :: length
    INTEGER,INTENT(IN)  :: dim3

    TYPE(C_PTR)         :: base_ptr
    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
    INTEGER :: real_size,ierr
    
    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
    size=length*real_size*dim3
    
    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
    CALL C_F_POINTER(base_ptr, buffer, (/ length,dim3 /))
    
   END SUBROUTINE allocate_mpi_buffer_r3

  SUBROUTINE allocate_mpi_buffer_r4(buffer,length,dim3,dim4)
  USE ISO_C_BINDING
  USE mpi_mod
  USE prec
  IMPLICIT NONE
    REAL(rstd), POINTER :: buffer(:,:,:)
    INTEGER,INTENT(IN)  :: length
    INTEGER,INTENT(IN)  :: dim3
    INTEGER,INTENT(IN)  :: dim4

    TYPE(C_PTR)         :: base_ptr
    INTEGER(KIND=MPI_ADDRESS_KIND) :: size
    INTEGER :: real_size,ierr
    
    CALL MPI_TYPE_EXTENT(MPI_REAL8, real_size, ierr)
    size=length*real_size*dim3*dim4
    
    CALL MPI_ALLOC_MEM(size,MPI_INFO_NULL,base_ptr,ierr)
    CALL C_F_POINTER(base_ptr, buffer, (/ length, dim3, dim4 /))
    
   END SUBROUTINE allocate_mpi_buffer_r4
   
END MODULE mpipara