source: LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_para.f90 @ 5440

Last change on this file since 5440 was 5268, checked in by abarral, 2 months ago

.f90 <-> .F90 depending on cpp key use
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 3.0 KB
Line 
1!
2! $Id: mod_phys_lmdz_para.f90 5268 2024-10-23 17:02:39Z evignon $
3!
4MODULE mod_phys_lmdz_para
5  USE mod_phys_lmdz_transfert_para
6  USE mod_phys_lmdz_mpi_data
7  USE mod_phys_lmdz_omp_data
8   
9  INTEGER,SAVE :: klon_loc
10  LOGICAL,SAVE :: is_sequential
11  LOGICAL,SAVE :: is_parallel
12  LOGICAL,SAVE :: is_master
13
14 
15!$OMP THREADPRIVATE(klon_loc,is_master)
16 
17CONTAINS
18
19  SUBROUTINE Init_phys_lmdz_para(nbp,nbp_lon,nbp_lat,nbp_lev,grid_type, nvertex,communicator)
20  IMPLICIT NONE
21    INTEGER,INTENT(in) :: nbp
22    INTEGER,INTENT(in) :: nbp_lon
23    INTEGER,INTENT(in) :: nbp_lat
24    INTEGER,INTENT(in) :: nbp_lev
25    INTEGER,INTENT(in) :: communicator
26    INTEGER,INTENT(IN) :: grid_type
27    INTEGER,INTENT(IN) :: nvertex
28
29    CALL Init_phys_lmdz_mpi_data(nbp,nbp_lon,nbp_lat,nbp_lev, grid_type, nvertex,communicator)
30!$OMP PARALLEL
31    CALL Init_phys_lmdz_omp_data(klon_mpi)
32    klon_loc=klon_omp
33    IF (is_mpi_root .AND. is_omp_root) THEN
34       is_master=.TRUE.
35     ELSE
36       is_master=.FALSE.
37     ENDIF
38!ym     CALL Test_transfert
39!$OMP END PARALLEL   
40     IF (is_using_mpi .OR. is_using_omp) THEN
41       is_sequential=.FALSE.
42       is_parallel=.TRUE.
43     ELSE
44       is_sequential=.TRUE.
45       is_parallel=.FALSE.
46     ENDIF
47
48
49     
50  END SUBROUTINE Init_phys_lmdz_para
51
52  SUBROUTINE Test_transfert
53  USE mod_grid_phy_lmdz
54  USE print_control_mod, ONLY: lunout
55  IMPLICIT NONE
56!    INCLUDE "iniprint.h"
57 
58    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
59    REAL :: tmp1d_glo(klon_glo,nbp_lev)
60    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
61    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
62    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
63    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
64    REAL :: CheckSum
65   
66    INTEGER :: i,l
67 
68    Test_Field1d_glo = 0.
69    Test_Field2d_glo = 0.
70    Test_Field1d_loc = 0.
71    Test_Field2d_loc = 0.
72 
73    IF (is_mpi_root) THEN
74!$OMP MASTER
75      DO l=1,nbp_lev
76        DO i=1,klon_glo
77!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
78           Test_Field1d_glo(i,l)=1
79        ENDDO
80      ENDDO
81!$OMP END MASTER 
82    ENDIF
83 
84    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
85    CALL Gather(Test_Field1d_loc,tmp1d_glo)
86 
87    IF (is_mpi_root) THEN
88!$OMP MASTER 
89      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
90      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
91!$OMP END MASTER
92    ENDIF
93   
94    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
95    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
96    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
97    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)
98
99    IF (is_mpi_root) THEN
100!$OMP MASTER 
101      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
102      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
103!$OMP END MASTER
104    ENDIF
105
106    CALL bcast(Test_Field1d_glo)
107    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)
108
109    IF (is_mpi_root) THEN
110!$OMP MASTER 
111      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
112      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
113!$OMP END MASTER
114    ENDIF
115   
116     
117   END SUBROUTINE Test_transfert
118 
119END MODULE mod_phys_lmdz_para
120   
Note: See TracBrowser for help on using the repository browser.