source: LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_para.f90

!
! $Id: mod_phys_lmdz_para.f90 5268 2024-10-23 17:02:39Z abarral $
!
MODULE mod_phys_lmdz_para
  USE mod_phys_lmdz_transfert_para
  USE mod_phys_lmdz_mpi_data
  USE mod_phys_lmdz_omp_data
    
  INTEGER,SAVE :: klon_loc
  LOGICAL,SAVE :: is_sequential
  LOGICAL,SAVE :: is_parallel
  LOGICAL,SAVE :: is_master

  
!$OMP THREADPRIVATE(klon_loc,is_master)
  
CONTAINS

  SUBROUTINE Init_phys_lmdz_para(nbp,nbp_lon,nbp_lat,nbp_lev,grid_type, nvertex,communicator)
  IMPLICIT NONE
    INTEGER,INTENT(in) :: nbp
    INTEGER,INTENT(in) :: nbp_lon
    INTEGER,INTENT(in) :: nbp_lat
    INTEGER,INTENT(in) :: nbp_lev
    INTEGER,INTENT(in) :: communicator
    INTEGER,INTENT(IN) :: grid_type 
    INTEGER,INTENT(IN) :: nvertex 

    CALL Init_phys_lmdz_mpi_data(nbp,nbp_lon,nbp_lat,nbp_lev, grid_type, nvertex,communicator)
!$OMP PARALLEL
    CALL Init_phys_lmdz_omp_data(klon_mpi)
    klon_loc=klon_omp
    IF (is_mpi_root .AND. is_omp_root) THEN 
       is_master=.TRUE.
     ELSE
       is_master=.FALSE.
     ENDIF
!ym     CALL Test_transfert
!$OMP END PARALLEL    
     IF (is_using_mpi .OR. is_using_omp) THEN
       is_sequential=.FALSE.
       is_parallel=.TRUE.
     ELSE
       is_sequential=.TRUE.
       is_parallel=.FALSE.
     ENDIF


      
  END SUBROUTINE Init_phys_lmdz_para

  SUBROUTINE Test_transfert
  USE mod_grid_phy_lmdz
  USE print_control_mod, ONLY: lunout
  IMPLICIT NONE
!    INCLUDE "iniprint.h"
 
    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
    REAL :: tmp1d_glo(klon_glo,nbp_lev)
    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
    REAL :: CheckSum
    
    INTEGER :: i,l
  
    Test_Field1d_glo = 0.
    Test_Field2d_glo = 0.
    Test_Field1d_loc = 0.
    Test_Field2d_loc = 0.
  
    IF (is_mpi_root) THEN
!$OMP MASTER
      DO l=1,nbp_lev
        DO i=1,klon_glo
!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
           Test_Field1d_glo(i,l)=1
        ENDDO
      ENDDO
!$OMP END MASTER  
    ENDIF
  
    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
    CALL Gather(Test_Field1d_loc,tmp1d_glo)
  
    IF (is_mpi_root) THEN
!$OMP MASTER  
      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
!$OMP END MASTER
    ENDIF
    
    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)

    IF (is_mpi_root) THEN
!$OMP MASTER  
      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
!$OMP END MASTER
    ENDIF

    CALL bcast(Test_Field1d_glo)
    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)

    IF (is_mpi_root) THEN
!$OMP MASTER  
      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
!$OMP END MASTER
    ENDIF
    
     
   END SUBROUTINE Test_transfert
  
END MODULE mod_phys_lmdz_para