mod_phys_lmdz_para.F90

Go to the documentation of this file.

!
!$Header$
!
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(iim,jjp1,nb_proc,distrib)
  IMPLICIT NONE
    INTEGER,INTENT(in) :: iim
    INTEGER,INTENT(in) :: jjp1
    INTEGER,INTENT(in) :: nb_proc
    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)

    CALL init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
!$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
    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
  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