source: branches/publications/ORCHIDEE_gmd_mict_peat_ch4/src_parallel/mod_orchidee_para.F90 @ 7346

Last change on this file since 7346 was 3564, checked in by albert.jornet, 8 years ago

Merge: from [3313:3545/trunk/ORCHIDEE]
Clean: output subroutine variables compile warning messages are solved.

Done in branches/ORCHIDEE-MICT/ORCHIDEE_MICT_TRUNK
File size: 6.1 KB
Line 
1! Initialization of parallel for MPI and OpenMP.
2
3!-
4!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_para.F90,v 1.1.2.4 2008/11/05 10:14:05 ssipsl Exp $
5!-
6
7MODULE mod_orchidee_para
8
9  USE mod_orchidee_para_var
10  USE mod_orchidee_mpi_data
11  USE mod_orchidee_omp_data
12  USE mod_orchidee_transfert_para
13   
14CONTAINS
15   
16  SUBROUTINE Init_orchidee_para(communicator)
17    IMPLICIT NONE
18    INTEGER,OPTIONAL,INTENT(in) :: communicator 
19
20    CALL Init_orchidee_omp
21
22
23    IF ( PRESENT(communicator) ) THEN
24       CALL Init_orchidee_mpi(communicator)
25    ELSE
26       CALL Init_orchidee_mpi
27    ENDIF
28
29
30    IF (is_mpi_root .AND. is_omp_root) THEN
31       is_root_prc=.TRUE.
32    ELSE
33       is_root_prc=.FALSE.
34    ENDIF
35  END SUBROUTINE Init_orchidee_para
36   
37 
38  SUBROUTINE Init_orchidee_data_para_driver(nbp,kindex_glo)
39
40    IMPLICIT NONE
41    INTEGER,INTENT(IN) :: nbp
42    INTEGER,INTENT(IN) :: kindex_glo(nbp)
43     
44    INTEGER :: first_point
45    INTEGER :: last_point
46    INTEGER :: nbp_loc
47    INTEGER :: nbp_loc_para(0:mpi_size-1)
48    INTEGER,ALLOCATABLE :: kindex_loc(:)
49    INTEGER :: offset
50    INTEGER :: i
51   
52     
53    last_point=0
54   
55    CALL read_load_balance(nbp,nbp_loc_para)   
56   
57    DO i=0,mpi_rank
58       nbp_loc=nbp_loc_para(i)
59       First_point=last_point+1
60       Last_point=last_point+nbp_loc
61    ENDDO
62   
63    ALLOCATE(kindex_loc(nbp_loc))
64    DO i=1,nbp_loc
65       kindex_loc(i)=kindex_glo(i+First_Point-1)
66    ENDDO
67   
68    IF (mpi_rank==0) THEN
69       offset=0
70    ELSE
71       offset=kindex_glo(First_point-1)-MOD(kindex_glo(First_point-1),iim_g)
72    ENDIF
73
74    kindex_loc(:)=kindex_loc(:)-offset
75
76    CALL Init_orchidee_data_para(nbp_loc,kindex_loc,offset,omp_size,omp_rank,MPI_COMM_ORCH)
77    CALL Set_stdout_file('out_orchidee')
78    CALL ipslnlf(new_number=numout)
79    !   
80  END SUBROUTINE Init_orchidee_data_para_driver
81   
82 
83  SUBROUTINE Init_orchidee_data_para(nbp,kindex,arg_offset,arg_omp_size,arg_omp_rank,COMM)
84
85    IMPLICIT NONE
86    INTEGER,INTENT(IN)     :: nbp
87    INTEGER,INTENT(IN)     :: kindex(nbp)
88    INTEGER,INTENT(IN)     :: arg_offset
89    INTEGER,INTENT(IN)     :: arg_omp_size
90    INTEGER,INTENT(IN)     :: arg_omp_rank
91    INTEGER,INTENT(IN)     :: COMM
92   
93    INTEGER,SAVE              :: arg_nbp_mpi
94    INTEGER,ALLOCATABLE,SAVE  :: kindex_mpi(:)
95   
96    offset=arg_offset 
97    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,offset)
98   
99    IF (is_omp_root) THEN
100       arg_nbp_mpi=SUM(nbp_omp_para_nb(:))
101       ALLOCATE(kindex_mpi(arg_nbp_mpi))
102    ENDIF
103
104    CALL barrier2_omp()
105    kindex_mpi(nbp_omp_begin:nbp_omp_end)=kindex(:)+offset
106    CALL barrier2_omp()
107     
108    IF (is_omp_root) THEN     
109       kindex_mpi(:)=kindex_mpi(:)-offset
110       CALL init_orchidee_mpi_data(arg_nbp_mpi,kindex_mpi,offset,COMM)
111       nbp_glo=SUM(nbp_mpi_para(:))
112    ENDIF
113    CALL barrier2_omp()
114
115    nbp_loc=nbp
116   
117    IF (is_mpi_root .AND. is_omp_root) THEN
118       is_root_prc=.TRUE.
119    ELSE
120       is_root_prc=.FALSE.
121    ENDIF
122   
123    CALL Test_orchidee_para
124
125  END SUBROUTINE Init_orchidee_data_para
126   
127  SUBROUTINE Set_stdout_file(filename)
128
129    IMPLICIT NONE
130
131    CHARACTER(len=*), INTENT(IN) :: filename
132    CHARACTER(len=255) :: fileout
133    CHARACTER(len=4)  :: num_mpi
134    CHARACTER(len=4)  :: num_omp
135    INTEGER,PARAMETER :: base_numout=100
136    INTEGER           :: ierr
137
138    IF (is_ok_mpi) THEN
139       WRITE(num_mpi,'(I4.4)') mpi_rank
140    ENDIF
141   
142    IF (is_ok_omp) THEN
143       WRITE(num_omp,'(I4.4)') omp_rank
144    ENDIF
145   
146     
147    IF (is_ok_mpi .AND. is_ok_omp) THEN
148       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
149       numout=base_numout+omp_rank
150    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
151       fileout=TRIM(filename)//'_'//num_mpi
152       numout=base_numout
153    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
154       fileout=TRIM(filename)//'_'//num_omp
155       numout=base_numout+omp_rank
156    ELSE
157       fileout=TRIM(filename)
158       numout=base_numout
159    ENDIF
160!$OMP CRITICAL 
161    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
162!$OMP END CRITICAL
163   
164    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
165    IF (ierr /= 0) THEN
166#ifdef CPP_PARA
167       CALL MPI_FINALIZE(ierr)
168#endif
169       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
170       STOP 1
171    ENDIF
172 
173!$OMP CRITICAL 
174    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
175!$OMP END CRITICAL
176
177    CALL Init_numout_omp(numout)
178
179  END SUBROUTINE Set_stdout_file
180     
181     
182  SUBROUTINE Test_orchidee_para
183
184    IMPLICIT NONE
185
186    INTEGER,PARAMETER :: dimsize=3
187    REAL :: Array(nbp_loc,dimsize)
188    REAL :: Array_glo(nbp_glo,dimsize)
189    REAL :: Array_glo_tmp(nbp_glo,dimsize)
190    REAL :: Array2D_loc(iim_g,jj_nb)
191    REAL :: Array2D_glo(iim_g,jjm_g)
192    REAL :: sum1,sum2,sum3
193   
194    INTEGER :: i,j
195   
196    DO j=1,dimsize
197       DO i=1,nbp_loc
198          Array(i,j)=10*j+omp_rank+i*1000
199       ENDDO
200    ENDDO
201     
202    CALL gather(Array,Array_glo)
203    CALL bcast(Array_glo)
204    CALL scatter(Array_glo,array)
205    CALL gather(array,array_glo_tmp)
206    CALL bcast(array_glo_tmp)   
207    WRITE(*,*) "1) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
208
209    sum1=SUM(array)
210    CALL reduce_sum(sum1,sum2)
211    CALL bcast(sum2)
212    sum3=SUM(array_glo)
213    WRITE(*,*) "2) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
214   
215    IF (is_omp_root) THEN
216       DO j=1,jjm_g
217          DO i=1,iim_g
218             Array2D_glo(i,j)=(j-1)*iim_g+i
219          ENDDO
220       ENDDO
221       
222       array2D_loc(:,:)=0
223       CALL scatter2D_mpi(array2D_glo,array2D_loc)
224       array2D_glo(:,:)=0
225       CALL gather2D_mpi(array2D_loc,array2D_glo)
226       CALL bcast_mpi(array2D_glo)
227       sum1=SUM(array2D_glo)
228       sum2=SUM(array2D_loc)
229       CALL reduce_sum_mpi(sum2,sum3)
230       CALL bcast_mpi(sum3)
231       
232       WRITE(*,*) "3) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
233    ENDIF
234    CALL barrier2_omp()
235
236  END SUBROUTINE  Test_orchidee_para
237 
238END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.