source: LMDZ4/trunk/libf/phy_IPCC_AR4/mod_phys_lmdz_para.F90 @ 963

Last change on this file since 963 was 868, checked in by Laurent Fairhead, 17 years ago

Preparation du remplacement de la physique utilisee pour l'exercice IPCC_AR4
par la version de la physique avec thermique. On garde le repertoire phylmd
pour un petit moment pour que les utilisateurs ne soient pas trop perdus ...
phy_IPCC_AR4 = phylmd
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.6 KB
Line 
1!
2!$Header$
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 
13!$OMP THREADPRIVATE(klon_loc)
14 
15CONTAINS
16
17  SUBROUTINE Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
18  IMPLICIT NONE
19    INTEGER,INTENT(in) :: iim
20    INTEGER,INTENT(in) :: jjp1
21    INTEGER,INTENT(in) :: nb_proc
22    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
23
24    CALL Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
25!$OMP PARALLEL
26    CALL Init_phys_lmdz_omp_data(klon_mpi)
27    klon_loc=klon_omp
28    CALL Test_transfert
29!$OMP END PARALLEL   
30     IF (is_ok_mpi .OR. is_ok_omp) THEN
31       is_sequential=.FALSE.
32       is_parallel=.TRUE.
33     ELSE
34       is_sequential=.TRUE.
35       is_parallel=.FALSE.
36     ENDIF
37     
38  END SUBROUTINE Init_phys_lmdz_para
39
40  SUBROUTINE Test_transfert
41  USE mod_grid_phy_lmdz
42  IMPLICIT NONE
43 
44    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
45    REAL :: tmp1d_glo(klon_glo,nbp_lev)
46    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
47    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
48    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
49    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
50    REAL :: CheckSum
51   
52    INTEGER :: i,l
53 
54    Test_Field1d_glo = 0.
55    Test_Field2d_glo = 0.
56    Test_Field1d_loc = 0.
57    Test_Field2d_loc = 0.
58 
59    IF (is_mpi_root) THEN
60!$OMP MASTER
61      DO l=1,nbp_lev
62        DO i=1,klon_glo
63!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
64           Test_Field1d_glo(i,l)=1
65        ENDDO
66      ENDDO
67!$OMP END MASTER 
68    ENDIF
69 
70    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
71    CALL Gather(Test_Field1d_loc,tmp1d_glo)
72 
73    IF (is_mpi_root) THEN
74!$OMP MASTER 
75      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
76      PRINT *, "------> Checksum =",Checksum," MUST BE 0"
77!$OMP END MASTER
78    ENDIF
79   
80    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
81    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
82    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
83    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)
84
85    IF (is_mpi_root) THEN
86!$OMP MASTER 
87      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
88      PRINT *, "------> Checksum =",Checksum," MUST BE 0"
89!$OMP END MASTER
90    ENDIF
91
92    CALL bcast(Test_Field1d_glo)
93    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)
94
95    IF (is_mpi_root) THEN
96!$OMP MASTER 
97      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
98      PRINT *, "------> Checksum =",Checksum," MUST BE 0"
99!$OMP END MASTER
100    ENDIF
101   
102     
103   END SUBROUTINE Test_transfert
104 
105END MODULE mod_phys_lmdz_para
106   
Note: See TracBrowser for help on using the repository browser.