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

Last change on this file since 7346 was 1962, checked in by matthew.mcgrath, 10 years ago

DEV: Trunk changes up to and including r1925
File size: 6.9 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!++++++++TEST+++++++++
157!           INTEGER,PARAMETER :: base_numout=6
158            INTEGER,PARAMETER :: base_numout=100
159!++++++++++++++++++++
160           
161    INTEGER           :: ierr
162
163    IF (is_ok_mpi) THEN
164       WRITE(num_mpi,'(I4.4)') mpi_rank
165    ENDIF
166   
167    IF (is_ok_omp) THEN
168       WRITE(num_omp,'(I4.4)') omp_rank
169    ENDIF
170   
171     
172    IF (is_ok_mpi .AND. is_ok_omp) THEN
173       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
174       numout=base_numout+omp_rank
175    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
176       fileout=TRIM(filename)//'_'//num_mpi
177       numout=base_numout
178    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
179       fileout=TRIM(filename)//'_'//num_omp
180       numout=base_numout+omp_rank
181    ELSE
182       fileout=TRIM(filename)
183       numout=base_numout
184    ENDIF
185!$OMP CRITICAL 
186    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
187!$OMP END CRITICAL
188   
189    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
190    IF (ierr /= 0) THEN
191#ifdef CPP_PARA
192       CALL MPI_FINALIZE(ierr)
193#endif
194       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
195       STOP 1
196    ENDIF
197 
198!$OMP CRITICAL 
199    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
200!$OMP END CRITICAL
201
202    CALL Init_numout_omp(numout)
203
204  END SUBROUTINE Set_stdout_file
205     
206     
207  SUBROUTINE Test_orchidee_para
208
209    IMPLICIT NONE
210
211    INTEGER,PARAMETER :: dimsize=3
212    REAL(r_std) :: Array(nbp_loc,dimsize)
213    REAL(r_std) :: Array_glo(nbp_glo,dimsize)
214    REAL(r_std) :: Array_glo_tmp(nbp_glo,dimsize)
215    REAL(r_std) :: Array2D_loc(iim_g,jj_nb)
216    REAL(r_std) :: Array2D_glo(iim_g,jjm_g)
217    REAL(r_std) :: sum1,sum2,sum3
218   
219    INTEGER :: i,j
220   
221    DO j=1,dimsize
222       DO i=1,nbp_loc
223          Array(i,j)=10*j+omp_rank+i*1000
224       ENDDO
225    ENDDO
226     
227    CALL gather(Array,Array_glo)
228    CALL bcast(Array_glo)
229    CALL scatter(Array_glo,array)
230    CALL gather(array,array_glo_tmp)
231    CALL bcast(array_glo_tmp)   
232    WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Should be 0 :",SUM(array_glo-array_glo_tmp)
233
234    sum1=SUM(array)
235    CALL reduce_sum(sum1,sum2)
236    CALL bcast(sum2)
237    sum3=SUM(array_glo)
238    WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Should be 0 :",sum3-sum2
239   
240    IF (is_omp_root) THEN
241       DO j=1,jjm_g
242          DO i=1,iim_g
243             Array2D_glo(i,j)=(j-1)*iim_g+i
244          ENDDO
245       ENDDO
246       
247       array2D_loc(:,:)=0
248       CALL scatter2D_mpi(array2D_glo,array2D_loc)
249       array2D_glo(:,:)=0
250       CALL gather2D_mpi(array2D_loc,array2D_glo)
251       CALL bcast_mpi(array2D_glo)
252       sum1=SUM(array2D_glo)
253       sum2=SUM(array2D_loc)
254       CALL reduce_sum_mpi(sum2,sum3)
255       CALL bcast_mpi(sum3)
256       
257       WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Should be 0 :",sum3-sum1
258    ENDIF
259    CALL barrier2_omp()
260
261  END SUBROUTINE  Test_orchidee_para
262 
263END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.