mod_surf_para.F90

Go to the documentation of this file.

MODULE mod_surf_para
  IMPLICIT NONE
  
  INTERFACE gather_surf
    MODULE PROCEDURE gather_surf_i,gather_surf_r
  END INTERFACE gather_surf
  
  INTERFACE gather_surf_omp
    MODULE PROCEDURE gather_surf_omp_i,gather_surf_omp_r
  END INTERFACE gather_surf_omp

  INTERFACE gather_surf_mpi
    MODULE PROCEDURE gather_surf_mpi_i,gather_surf_mpi_r
  END INTERFACE gather_surf_mpi

  INTERFACE scatter_surf
    MODULE PROCEDURE scatter_surf_i,scatter_surf_r
  END INTERFACE scatter_surf
  
  INTERFACE scatter_surf_omp
    MODULE PROCEDURE scatter_surf_omp_i,scatter_surf_omp_r
  END INTERFACE scatter_surf_omp

  INTERFACE scatter_surf_mpi
    MODULE PROCEDURE scatter_surf_mpi_i,scatter_surf_mpi_r
  END INTERFACE scatter_surf_mpi
  
  
  INTEGER,SAVE             :: knon_omp
  INTEGER,SAVE             :: knon_omp_begin
  INTEGER,SAVE             :: knon_omp_end
!$OMP THREADPRIVATE(knon_omp,knon_omp_begin,knon_omp_end)
  INTEGER,ALLOCATABLE,SAVE :: knon_omp_para(:)
  INTEGER,ALLOCATABLE,SAVE :: knon_omp_begin_para(:)
  INTEGER,ALLOCATABLE,SAVE :: knon_omp_end_para(:)
  
  INTEGER,SAVE             :: knon_mpi
  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_para(:)
  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_begin_para(:)
  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_end_para(:)
  
  INTEGER,SAVE             :: knon_glo
  INTEGER,SAVE,ALLOCATABLE :: knon_glo_para(:)  
  INTEGER,ALLOCATABLE,SAVE :: knon_glo_begin_para(:)
  INTEGER,ALLOCATABLE,SAVE :: knon_glo_end_para(:)
  
  
CONTAINS

  SUBROUTINE init_surf_para(knon)
  USE mod_phys_lmdz_para
#ifdef CPP_MPI
  include 'mpif.h'
#endif
    INTEGER :: knon
    INTEGER :: i,ierr
    
    knon_omp=knon
    IF (is_omp_root) THEN
      ALLOCATE(knon_omp_para(0:omp_size-1))
      ALLOCATE(knon_omp_begin_para(0:omp_size-1))
      ALLOCATE(knon_omp_end_para(0:omp_size-1))
    ENDIF
!$OMP BARRIER
    knon_omp_para(omp_rank)=knon
!$OMP BARRIER
    IF (is_omp_root) THEN 
      knon_omp_begin_para(0)=1
      knon_omp_end_para(0)=knon_omp_para(0)
      DO i=1,omp_size-1
        knon_omp_begin_para(i)=knon_omp_end_para(i-1)+1
        knon_omp_end_para(i)=knon_omp_begin_para(i)+knon_omp_para(i)-1
      ENDDO
    ENDIF 
!$OMP BARRIER
    knon_omp_begin=knon_omp_begin_para(omp_rank)
    knon_omp_end=knon_omp_end_para(omp_rank)
!$OMP BARRIER    
    IF (is_omp_root) THEN
      knon_mpi=sum(knon_omp_para)
      ALLOCATE(knon_mpi_para(0:mpi_size-1))
      ALLOCATE(knon_mpi_begin_para(0:mpi_size-1))
      ALLOCATE(knon_mpi_end_para(0:mpi_size-1))
      
      ALLOCATE(knon_glo_para(0:mpi_size*omp_size-1))
      ALLOCATE(knon_glo_begin_para(0:mpi_size*omp_size-1))
      ALLOCATE(knon_glo_end_para(0:mpi_size*omp_size-1))
      
      IF (is_using_mpi) THEN
#ifdef CPP_MPI
        CALL mpi_allgather(knon_mpi,1,mpi_integer,knon_mpi_para,1,mpi_integer,comm_lmdz_phy,ierr)
        CALL mpi_allgather(knon_omp_para,omp_size,mpi_integer,knon_glo_para,omp_size,mpi_integer,comm_lmdz_phy,ierr)
#endif
      ELSE
        knon_mpi_para(:)=knon_mpi
        knon_glo_para(:)=knon_omp_para(:)
      ENDIF     
      
      knon_glo=sum(knon_mpi_para(:))
      
      knon_mpi_begin_para(0)=1
      knon_mpi_end_para(0)=knon_mpi_para(0)
      DO i=1,mpi_size-1
        knon_mpi_begin_para(i)=knon_mpi_end_para(i-1)+1
        knon_mpi_end_para(i)=knon_mpi_begin_para(i)+knon_mpi_para(i)-1
      ENDDO
      
      knon_glo_begin_para(0)=1
      knon_glo_end_para(0)=knon_glo_para(0)
      DO i=1,mpi_size*omp_size-1
        knon_glo_begin_para(i)=knon_glo_end_para(i-1)+1
        knon_glo_end_para(i)= knon_glo_begin_para(i)+knon_glo_para(i)-1
      ENDDO
   ENDIF
!$OMP BARRIER

  END SUBROUTINE init_surf_para

 
  SUBROUTINE finalize_surf_para
  USE mod_phys_lmdz_para

!$OMP BARRIER   
   IF (is_omp_root) THEN
      DEALLOCATE(knon_omp_para)
      DEALLOCATE(knon_omp_begin_para)
      DEALLOCATE(knon_omp_end_para)
      DEALLOCATE(knon_mpi_para)
      DEALLOCATE(knon_mpi_begin_para)
      DEALLOCATE(knon_mpi_end_para)
      DEALLOCATE(knon_glo_para)  
      DEALLOCATE(knon_glo_begin_para)
      DEALLOCATE(knon_glo_end_para)
    ENDIF
    
  END SUBROUTINE finalize_surf_para
  
  
  SUBROUTINE gather_surf_i(FieldIn, FieldOut)
  USE mod_phys_lmdz_para
    INTEGER :: FieldIn(:)
    INTEGER :: FieldOut(:)
    INTEGER :: FieldTmp(knon_mpi)
    
    CALL gather_surf_omp_i(fieldin,fieldtmp)
    IF (is_omp_root) CALL gather_surf_mpi_i(fieldtmp,fieldout)
    
  END SUBROUTINE gather_surf_i


  SUBROUTINE gather_surf_omp_i(FieldIn,FieldOut)
  USE mod_phys_lmdz_para
    INTEGER :: FieldIn(:)
    INTEGER :: FieldOut(:)
  
    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
    
    IF (is_omp_root) ALLOCATE(field_tmp(knon_mpi))
!$OMP BARRIER
    field_tmp(knon_omp_begin:knon_omp_end)=fieldin(:)
!$OMP BARRIER        
    IF (is_omp_root) fieldout(:)=field_tmp(:)
!$OMP BARRIER
    IF (is_omp_root) DEALLOCATE(field_tmp)
    
  END SUBROUTINE  gather_surf_omp_i
  
     
  SUBROUTINE gather_surf_mpi_i(FieldIn,FieldOut)
  USE mod_phys_lmdz_para
#ifdef CPP_MPI
  include 'mpif.h'
#endif
    INTEGER :: FieldIn(:)
    INTEGER :: FieldOut(:)
    INTEGER :: ierr
    
    IF (is_using_mpi) THEN
#ifdef CPP_MPI
      CALL mpi_gatherv(fieldin,knon_mpi,mpi_integer,                                &
                       fieldout,knon_mpi_para,knon_mpi_begin_para(:)-1,mpi_integer, &
                       mpi_master,comm_lmdz_phy,ierr)
#endif
    ELSE
      fieldout(:)=fieldin(:)
    ENDIF
  
  END SUBROUTINE gather_surf_mpi_i
  




  SUBROUTINE gather_surf_r(FieldIn, FieldOut)
  USE mod_phys_lmdz_para
    REAL :: FieldIn(:)
    REAL :: FieldOut(:)
    REAL :: FieldTmp(knon_mpi)
    
    CALL gather_surf_omp_r(fieldin,fieldtmp)
    IF (is_omp_root) CALL gather_surf_mpi_r(fieldtmp,fieldout)
    
  END SUBROUTINE gather_surf_r


  SUBROUTINE gather_surf_omp_r(FieldIn,FieldOut)
  USE mod_phys_lmdz_para
    REAL :: FieldIn(:)
    REAL :: FieldOut(:)
  
    REAL,SAVE,ALLOCATABLE :: Field_tmp(:)
    
    IF (is_omp_root) ALLOCATE(field_tmp(knon_mpi))
!$OMP BARRIER
    field_tmp(knon_omp_begin:knon_omp_end)=fieldin(:)
!$OMP BARRIER        
    IF (is_omp_root) fieldout(:)=field_tmp(:)
!$OMP BARRIER
    IF (is_omp_root) DEALLOCATE(field_tmp)
    
  END SUBROUTINE  gather_surf_omp_r
  
     
  SUBROUTINE gather_surf_mpi_r(FieldIn,FieldOut)
  USE mod_phys_lmdz_para
#ifdef CPP_MPI
  include 'mpif.h'
#endif
    REAL :: FieldIn(:)
    REAL :: FieldOut(:)
    REAL :: ierr
    
    IF (is_using_mpi) THEN
#ifdef CPP_MPI
      CALL mpi_gatherv(fieldin,knon_mpi,mpi_real_lmdz,                                 &
                       fieldout,knon_mpi_para,knon_mpi_begin_para(:)-1,mpi_real_lmdz,  &
                       mpi_master,comm_lmdz_phy,ierr)            
#endif
    ELSE
      fieldout(:)=fieldin(:)
    ENDIF
  
  END SUBROUTINE gather_surf_mpi_r




  SUBROUTINE scatter_surf_i(FieldIn, FieldOut)
  USE mod_phys_lmdz_para
    INTEGER :: FieldIn(:)
    INTEGER :: FieldOut(:)
    INTEGER :: FieldTmp(knon_mpi)
    
    IF (is_omp_root) CALL scatter_surf_mpi_i(fieldin,fieldtmp)
    CALL scatter_surf_omp_i(fieldtmp,fieldout)
    
  END SUBROUTINE scatter_surf_i


  SUBROUTINE scatter_surf_omp_i(FieldIn,FieldOut)
  USE mod_phys_lmdz_para
    INTEGER :: FieldIn(:)
    INTEGER :: FieldOut(:)
  
    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
    
    IF (is_omp_root) ALLOCATE(field_tmp(knon_mpi))
    IF (is_omp_root) field_tmp(:)=fieldin(:)
!$OMP BARRIER        
    fieldout(:)=field_tmp(knon_omp_begin:knon_omp_end)
!$OMP BARRIER
    IF (is_omp_root) DEALLOCATE(field_tmp)
    
  END SUBROUTINE  scatter_surf_omp_i
  
     
  SUBROUTINE scatter_surf_mpi_i(FieldIn,FieldOut)
  USE mod_phys_lmdz_para
#ifdef CPP_MPI
  include 'mpif.h'
#endif
    INTEGER :: FieldIn(:)
    INTEGER :: FieldOut(:)
    INTEGER :: ierr
    
    IF (is_using_mpi) THEN
#ifdef CPP_MPI
      CALL mpi_scatterv(fieldin,knon_mpi_para,knon_mpi_begin_para(:)-1,mpi_integer,   &
                        fieldout,knon_mpi,mpi_integer,                                &
                        mpi_master,comm_lmdz_phy,ierr)
#endif
    ELSE
      fieldout(:)=fieldin(:)
    ENDIF
  
  END SUBROUTINE scatter_surf_mpi_i



  SUBROUTINE scatter_surf_r(FieldIn, FieldOut)
  USE mod_phys_lmdz_para
    REAL :: FieldIn(:)
    REAL :: FieldOut(:)
    REAL :: FieldTmp(knon_mpi)
    
    IF (is_omp_root) CALL scatter_surf_mpi_r(fieldin,fieldtmp)
    CALL scatter_surf_omp_r(fieldtmp,fieldout)
    
  END SUBROUTINE scatter_surf_r


  SUBROUTINE scatter_surf_omp_r(FieldIn,FieldOut)
  USE mod_phys_lmdz_para
    REAL :: FieldIn(:)
    REAL :: FieldOut(:)
  
    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
    
    IF (is_omp_root) ALLOCATE(field_tmp(knon_mpi))
    IF (is_omp_root) field_tmp(:)=fieldin(:)
!$OMP BARRIER        
    fieldout(:)=field_tmp(knon_omp_begin:knon_omp_end)
!$OMP BARRIER
    IF (is_omp_root) DEALLOCATE(field_tmp)
    
  END SUBROUTINE  scatter_surf_omp_r
  
     
  SUBROUTINE scatter_surf_mpi_r(FieldIn,FieldOut)
  USE mod_phys_lmdz_para
#ifdef CPP_MPI
  include 'mpif.h'
#endif
    REAL :: FieldIn(:)
    REAL :: FieldOut(:)
    INTEGER :: ierr
    
    IF (is_using_mpi) THEN
#ifdef CPP_MPI
      CALL mpi_scatterv(fieldin,knon_mpi_para,knon_mpi_begin_para(:)-1,mpi_integer,   &
                        fieldout,knon_mpi,mpi_integer,                                &
                        mpi_master,comm_lmdz_phy,ierr)
#endif
    ELSE
      fieldout(:)=fieldin(:)
    ENDIF
  
  END SUBROUTINE scatter_surf_mpi_r

END MODULE mod_surf_para