source: CONFIG/UNIFORM/v6/IPSLCM5A2.1R8/SOURCES/REDHAT8/ORCHIDEE/mod_orchidee_para.F90 @ 6506

Last change on this file since 6506 was 6506, checked in by snguyen, 12 months ago

redhat 8 compatibility updates
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    numout=6
174   
175!$OMP CRITICAL 
176    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
177!$OMP END CRITICAL
178
179    CALL Init_numout_omp(numout)
180
181  END SUBROUTINE Set_stdout_file
182     
183     
184  SUBROUTINE Test_orchidee_para
185
186    IMPLICIT NONE
187
188    INTEGER,PARAMETER :: dimsize=3
189    REAL :: Array(nbp_loc,dimsize)
190    REAL :: Array_glo(nbp_glo,dimsize)
191    REAL :: Array_glo_tmp(nbp_glo,dimsize)
192    REAL :: Array2D_loc(iim_g,jj_nb)
193    REAL :: Array2D_glo(iim_g,jjm_g)
194    REAL :: sum1,sum2,sum3
195   
196    INTEGER :: i,j
197   
198    DO j=1,dimsize
199       DO i=1,nbp_loc
200          Array(i,j)=10*j+omp_rank+i*1000
201       ENDDO
202    ENDDO
203     
204    CALL gather(Array,Array_glo)
205    CALL bcast(Array_glo)
206    CALL scatter(Array_glo,array)
207    CALL gather(array,array_glo_tmp)
208    CALL bcast(array_glo_tmp)   
209    WRITE(*,*) "1) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
210
211    sum1=SUM(array)
212    CALL reduce_sum(sum1,sum2)
213    CALL bcast(sum2)
214    sum3=SUM(array_glo)
215    WRITE(*,*) "2) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
216   
217    IF (is_omp_root) THEN
218       DO j=1,jjm_g
219          DO i=1,iim_g
220             Array2D_glo(i,j)=(j-1)*iim_g+i
221          ENDDO
222       ENDDO
223       
224       array2D_loc(:,:)=0
225       CALL scatter2D_mpi(array2D_glo,array2D_loc)
226       array2D_glo(:,:)=0
227       CALL gather2D_mpi(array2D_loc,array2D_glo)
228       CALL bcast_mpi(array2D_glo)
229       sum1=SUM(array2D_glo)
230       sum2=SUM(array2D_loc)
231       CALL reduce_sum_mpi(sum2,sum3)
232       CALL bcast_mpi(sum3)
233       
234       WRITE(*,*) "3) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
235    ENDIF
236    CALL barrier2_omp()
237
238  END SUBROUTINE  Test_orchidee_para
239 
240END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.