source: branches/publications/ORCHIDEE-LEAK-r5919/src_parallel/mod_orchidee_para.F90 @ 5925

Last change on this file since 5925 was 1925, checked in by josefine.ghattas, 10 years ago
  • xios : adapted for use with OpenMP (only master thread do call to xios), added coherence check between cpp key XIOS and run time flag
  • mod_orchidee_para : moved declaration part into mod_orchidee_para_var
  • simplifications in the use of modules in src_parallel : only use mod_orchidee_para_var if this is sufficient
  • small corrections for OpenMP
File size: 6.7 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_grid_glo(arg_nbp_lon,arg_nbp_lat,arg_nbp_glo)
128    IMPLICIT NONE
129
130    INTEGER(i_std), INTENT(IN) :: arg_nbp_lon
131    INTEGER(i_std), INTENT(IN) :: arg_nbp_lat
132    INTEGER(i_std), INTENT(IN),OPTIONAL :: arg_nbp_glo
133    iim_g=arg_nbp_lon
134    jjm_g=arg_nbp_lat
135    IF (PRESENT(arg_nbp_glo)) nbp_glo=arg_nbp_glo
136  END SUBROUTINE set_grid_glo
137 
138  SUBROUTINE Allocate_grid_glo
139    IMPLICIT NONE
140 
141    ALLOCATE(resolution_g(nbp_glo,2),area_g(nbp_glo),lalo_g(nbp_glo,2), &
142         &   neighbours_g(nbp_glo,8),contfrac_g(nbp_glo),index_g(nbp_glo))
143    ALLOCATE(lon_g(iim_g, jjm_g), lat_g(iim_g, jjm_g), zlev_g(iim_g, jjm_g))
144 
145  END SUBROUTINE Allocate_grid_glo
146 
147   
148  SUBROUTINE Set_stdout_file(filename)
149
150    IMPLICIT NONE
151
152    CHARACTER(len=*), INTENT(IN) :: filename
153    CHARACTER(len=255) :: fileout
154    CHARACTER(len=4)  :: num_mpi
155    CHARACTER(len=4)  :: num_omp
156    INTEGER,PARAMETER :: base_numout=100
157    INTEGER           :: ierr
158
159    IF (is_ok_mpi) THEN
160       WRITE(num_mpi,'(I4.4)') mpi_rank
161    ENDIF
162   
163    IF (is_ok_omp) THEN
164       WRITE(num_omp,'(I4.4)') omp_rank
165    ENDIF
166   
167     
168    IF (is_ok_mpi .AND. is_ok_omp) THEN
169       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
170       numout=base_numout+omp_rank
171    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
172       fileout=TRIM(filename)//'_'//num_mpi
173       numout=base_numout
174    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
175       fileout=TRIM(filename)//'_'//num_omp
176       numout=base_numout+omp_rank
177    ELSE
178       fileout=TRIM(filename)
179       numout=base_numout
180    ENDIF
181!$OMP CRITICAL 
182    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
183!$OMP END CRITICAL
184   
185    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
186    IF (ierr /= 0) THEN
187#ifdef CPP_PARA
188       CALL MPI_FINALIZE(ierr)
189#endif
190       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
191       STOP 1
192    ENDIF
193 
194!$OMP CRITICAL 
195    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
196!$OMP END CRITICAL
197
198    CALL Init_numout_omp(numout)
199
200  END SUBROUTINE Set_stdout_file
201     
202     
203  SUBROUTINE Test_orchidee_para
204
205    IMPLICIT NONE
206
207    INTEGER,PARAMETER :: dimsize=3
208    REAL :: Array(nbp_loc,dimsize)
209    REAL :: Array_glo(nbp_glo,dimsize)
210    REAL :: Array_glo_tmp(nbp_glo,dimsize)
211    REAL :: Array2D_loc(iim_g,jj_nb)
212    REAL :: Array2D_glo(iim_g,jjm_g)
213    REAL :: sum1,sum2,sum3
214   
215    INTEGER :: i,j
216   
217    DO j=1,dimsize
218       DO i=1,nbp_loc
219          Array(i,j)=10*j+omp_rank+i*1000
220       ENDDO
221    ENDDO
222     
223    CALL gather(Array,Array_glo)
224    CALL bcast(Array_glo)
225    CALL scatter(Array_glo,array)
226    CALL gather(array,array_glo_tmp)
227    CALL bcast(array_glo_tmp)   
228    WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
229
230    sum1=SUM(array)
231    CALL reduce_sum(sum1,sum2)
232    CALL bcast(sum2)
233    sum3=SUM(array_glo)
234    WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
235   
236    IF (is_omp_root) THEN
237       DO j=1,jjm_g
238          DO i=1,iim_g
239             Array2D_glo(i,j)=(j-1)*iim_g+i
240          ENDDO
241       ENDDO
242       
243       array2D_loc(:,:)=0
244       CALL scatter2D_mpi(array2D_glo,array2D_loc)
245       array2D_glo(:,:)=0
246       CALL gather2D_mpi(array2D_loc,array2D_glo)
247       CALL bcast_mpi(array2D_glo)
248       sum1=SUM(array2D_glo)
249       sum2=SUM(array2D_loc)
250       CALL reduce_sum_mpi(sum2,sum3)
251       CALL bcast_mpi(sum3)
252       
253       WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
254    ENDIF
255    CALL barrier2_omp()
256
257  END SUBROUTINE  Test_orchidee_para
258 
259END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.