| 1 | ! Definition and allocation of parallel datas. |
|---|
| 2 | ! Initialization of parallel or sequentiel IOs. |
|---|
| 3 | ! Definition of Load Balancing functions. |
|---|
| 4 | |
|---|
| 5 | !- |
|---|
| 6 | !< $HeadURL$ |
|---|
| 7 | !< $Date$ |
|---|
| 8 | !< $Author$ |
|---|
| 9 | !< $Revision$ |
|---|
| 10 | !- |
|---|
| 11 | |
|---|
| 12 | MODULE data_para |
|---|
| 13 | |
|---|
| 14 | !- |
|---|
| 15 | USE defprec |
|---|
| 16 | USE ioipsl |
|---|
| 17 | !- |
|---|
| 18 | #include "src_parallel.h" |
|---|
| 19 | !- |
|---|
| 20 | !- |
|---|
| 21 | ! Unit for output messages |
|---|
| 22 | INTEGER(i_std), SAVE :: numout = 6 |
|---|
| 23 | |
|---|
| 24 | INTEGER, SAVE :: mpi_size !! Number of parallel processes |
|---|
| 25 | INTEGER, SAVE :: mpi_rank !! my rank num |
|---|
| 26 | INTEGER, SAVE :: root_prc !! rank of root proc |
|---|
| 27 | LOGICAL, SAVE :: is_root_prc !! Only root proc is true |
|---|
| 28 | INTEGER, SAVE :: nbp_loc !! number of local continental points |
|---|
| 29 | INTEGER, SAVE :: nbp_glo !! number of global continental points |
|---|
| 30 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_para_nb |
|---|
| 31 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_para_begin |
|---|
| 32 | INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_para_end |
|---|
| 33 | |
|---|
| 34 | INTEGER,SAVE :: iim_g, jjm_g !! Dimension of global fields |
|---|
| 35 | ! i x j 2D points (not land points) index |
|---|
| 36 | INTEGER,SAVE,allocatable,dimension(:) :: ij_para_nb ! Number of 2D points for each mpi_rank block |
|---|
| 37 | INTEGER,SAVE,allocatable,dimension(:) :: ij_para_begin ! First 2D point for each mpi_rank block |
|---|
| 38 | INTEGER,SAVE,allocatable,dimension(:) :: ij_para_end ! Last 2D point for each mpi_rank block |
|---|
| 39 | ! i 2D index |
|---|
| 40 | INTEGER,SAVE,allocatable,dimension(:) :: ii_para_begin ! First i index of 2D point for each mpi_rank block |
|---|
| 41 | INTEGER,SAVE,allocatable,dimension(:) :: ii_para_end ! Last i index of 2D point for each mpi_rank block |
|---|
| 42 | ! j 2D index |
|---|
| 43 | INTEGER,SAVE,allocatable,dimension(:) :: jj_para_nb ! Number of complete j lines for each mpi_rank block |
|---|
| 44 | INTEGER,SAVE,allocatable,dimension(:) :: jj_para_begin ! First j index of 2D point for each mpi_rank block |
|---|
| 45 | INTEGER,SAVE,allocatable,dimension(:) :: jj_para_end ! Last j index of 2D point for each mpi_rank block |
|---|
| 46 | |
|---|
| 47 | INTEGER,SAVE :: ii_begin |
|---|
| 48 | INTEGER,SAVE :: ii_end |
|---|
| 49 | INTEGER,SAVE :: jj_begin |
|---|
| 50 | INTEGER,SAVE :: jj_end |
|---|
| 51 | INTEGER,SAVE :: jj_nb |
|---|
| 52 | INTEGER,SAVE :: ij_begin |
|---|
| 53 | INTEGER,SAVE :: ij_end |
|---|
| 54 | INTEGER,SAVE :: ij_nb |
|---|
| 55 | |
|---|
| 56 | |
|---|
| 57 | !! Global array used by stomate and sechiba |
|---|
| 58 | !- |
|---|
| 59 | !! index of land points on the 2D map |
|---|
| 60 | INTEGER(i_std),ALLOCATABLE,DIMENSION(:),SAVE :: index_g |
|---|
| 61 | !- |
|---|
| 62 | !! indices of the 4 neighbours of each grid point (1=N, 2=E, 3=S, 4=W) |
|---|
| 63 | INTEGER(i_std),ALLOCATABLE,DIMENSION(:,:),SAVE :: neighbours_g |
|---|
| 64 | !- |
|---|
| 65 | !! resolution at each grid point in m (1=E-W, 2=N-S) |
|---|
| 66 | REAL(r_std),ALLOCATABLE,DIMENSION(:,:),SAVE :: resolution_g |
|---|
| 67 | REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE :: area_g |
|---|
| 68 | !- |
|---|
| 69 | !! Geographical coordinates |
|---|
| 70 | REAL(r_std),ALLOCATABLE,DIMENSION(:,:),SAVE :: lalo_g |
|---|
| 71 | ! Global grid, for all process |
|---|
| 72 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE :: lon_g, lat_g, zlev_g |
|---|
| 73 | !- |
|---|
| 74 | !! Fraction of continents |
|---|
| 75 | REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE :: contfrac_g |
|---|
| 76 | |
|---|
| 77 | INTEGER, SAVE :: MPI_COMM_ORCH |
|---|
| 78 | INTEGER, SAVE :: MPI_REAL_ORCH |
|---|
| 79 | INTEGER, SAVE :: MPI_INT_ORCH |
|---|
| 80 | LOGICAL, SAVE :: cpl_lmdz |
|---|
| 81 | |
|---|
| 82 | INTEGER, SAVE :: orch_domain_id |
|---|
| 83 | |
|---|
| 84 | CONTAINS |
|---|
| 85 | |
|---|
| 86 | SUBROUTINE init_para(cpl_lmdz_x, communicator) |
|---|
| 87 | |
|---|
| 88 | IMPLICIT NONE |
|---|
| 89 | |
|---|
| 90 | #ifdef CPP_PARA |
|---|
| 91 | INCLUDE 'mpif.h' |
|---|
| 92 | #endif |
|---|
| 93 | LOGICAL :: cpl_lmdz_x |
|---|
| 94 | INTEGER,OPTIONAL :: communicator |
|---|
| 95 | INTEGER :: ierr |
|---|
| 96 | CHARACTER(LEN=20) :: filename |
|---|
| 97 | INTEGER :: i, div |
|---|
| 98 | CHARACTER(LEN=4) :: num |
|---|
| 99 | LOGICAL, PARAMETER :: check = .FALSE. |
|---|
| 100 | |
|---|
| 101 | cpl_lmdz=cpl_lmdz_x |
|---|
| 102 | |
|---|
| 103 | #ifdef CPP_PARA |
|---|
| 104 | ! Orchidee communicator : |
|---|
| 105 | IF (.NOT. cpl_lmdz) THEN |
|---|
| 106 | CALL MPI_INIT(ierr) |
|---|
| 107 | IF (ierr /= 0) THEN |
|---|
| 108 | WRITE(*,*) 'INIT_PARA : MPI_INIT failed with ',ierr |
|---|
| 109 | STOP "INIT_PARA" |
|---|
| 110 | ENDIF |
|---|
| 111 | MPI_COMM_ORCH=MPI_COMM_WORLD |
|---|
| 112 | ELSE |
|---|
| 113 | MPI_COMM_ORCH=communicator |
|---|
| 114 | ENDIF |
|---|
| 115 | |
|---|
| 116 | |
|---|
| 117 | ! Int and real precision |
|---|
| 118 | IF (MPI_VERSION == 1) THEN |
|---|
| 119 | ! Version MPI 1.x |
|---|
| 120 | IF (i_std==i_4) THEN |
|---|
| 121 | MPI_INT_ORCH=MPI_INTEGER |
|---|
| 122 | ELSEIF (i_std==i_8) THEN |
|---|
| 123 | MPI_INT_ORCH=MPI_INTEGER |
|---|
| 124 | ELSE |
|---|
| 125 | MPI_INT_ORCH=MPI_INTEGER |
|---|
| 126 | ENDIF |
|---|
| 127 | |
|---|
| 128 | IF (r_std==r_4) THEN |
|---|
| 129 | MPI_REAL_ORCH=MPI_REAL |
|---|
| 130 | ELSEIF (r_std==r_8) THEN |
|---|
| 131 | MPI_REAL_ORCH=MPI_DOUBLE_PRECISION |
|---|
| 132 | ELSE |
|---|
| 133 | MPI_REAL_ORCH=MPI_REAL |
|---|
| 134 | ENDIF |
|---|
| 135 | ELSE |
|---|
| 136 | ! Others MPI |
|---|
| 137 | IF (i_std==i_4) THEN |
|---|
| 138 | MPI_INT_ORCH=MPI_INTEGER4 |
|---|
| 139 | ELSEIF (i_std==i_8) THEN |
|---|
| 140 | MPI_INT_ORCH=MPI_INTEGER8 |
|---|
| 141 | ELSE |
|---|
| 142 | MPI_INT_ORCH=MPI_INTEGER |
|---|
| 143 | ENDIF |
|---|
| 144 | |
|---|
| 145 | IF (r_std==r_4) THEN |
|---|
| 146 | MPI_REAL_ORCH=MPI_REAL4 |
|---|
| 147 | ELSEIF (r_std==r_8) THEN |
|---|
| 148 | MPI_REAL_ORCH=MPI_REAL8 |
|---|
| 149 | ELSE |
|---|
| 150 | MPI_REAL_ORCH=MPI_REAL |
|---|
| 151 | ENDIF |
|---|
| 152 | ENDIF |
|---|
| 153 | |
|---|
| 154 | CALL MPI_COMM_SIZE(MPI_COMM_ORCH,mpi_size,ierr) |
|---|
| 155 | IF (ierr /= 0) THEN |
|---|
| 156 | WRITE(*,*) 'INIT_PARA : MPI_COMM_SIZE failed with ',ierr |
|---|
| 157 | STOP "INIT_PARA" |
|---|
| 158 | ENDIF |
|---|
| 159 | CALL MPI_COMM_RANK(MPI_COMM_ORCH,mpi_rank,ierr) |
|---|
| 160 | IF (ierr /= 0) THEN |
|---|
| 161 | WRITE(*,*) 'INIT_PARA : MPI_COMM_RANK failed with ',ierr |
|---|
| 162 | STOP "INIT_PARA" |
|---|
| 163 | ENDIF |
|---|
| 164 | |
|---|
| 165 | #else |
|---|
| 166 | mpi_rank=0 |
|---|
| 167 | mpi_size=1 |
|---|
| 168 | #endif |
|---|
| 169 | root_prc=0 |
|---|
| 170 | |
|---|
| 171 | IF (mpi_rank==0) THEN |
|---|
| 172 | is_root_prc=.TRUE. |
|---|
| 173 | ELSE |
|---|
| 174 | is_root_prc=.FALSE. |
|---|
| 175 | ENDIF |
|---|
| 176 | |
|---|
| 177 | ! Open mpi_rank outputs or select stdout |
|---|
| 178 | IF (mpi_size > 1) THEN |
|---|
| 179 | write(num,'(I4.4)') mpi_rank |
|---|
| 180 | |
|---|
| 181 | numout = 100 |
|---|
| 182 | |
|---|
| 183 | filename = 'out_orchidee_'//num |
|---|
| 184 | |
|---|
| 185 | OPEN(UNIT=numout,FILE=TRIM(filename),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(*,*) "Erreur can't open file ", filename |
|---|
| 191 | STOP "INIT_PARA" |
|---|
| 192 | ENDIF |
|---|
| 193 | ELSE |
|---|
| 194 | numout = 6 |
|---|
| 195 | ENDIF |
|---|
| 196 | |
|---|
| 197 | IF (check) THEN |
|---|
| 198 | #ifdef CPP_PARA |
|---|
| 199 | WRITE(numout,*) 'version MPI ', MPI_VERSION, MPI_SUBVERSION |
|---|
| 200 | WRITE(numout,*) 'INTEGERS ',MPI_INTEGER4,MPI_INTEGER8,MPI_INTEGER,MPI_INT_ORCH |
|---|
| 201 | WRITE(numout,*) 'REALS ',MPI_REAL4,MPI_REAL8,MPI_REAL,MPI_REAL_ORCH |
|---|
| 202 | #endif |
|---|
| 203 | WRITE(numout,*) 'RANK ',mpi_rank,' SIZE ',mpi_size |
|---|
| 204 | WRITE(numout,*) "Am I root process ?",is_root_prc |
|---|
| 205 | WRITE(numout,*) "Init_para : For process number ",mpi_rank, "output file = ",filename |
|---|
| 206 | ENDIF |
|---|
| 207 | |
|---|
| 208 | END SUBROUTINE init_para |
|---|
| 209 | |
|---|
| 210 | SUBROUTINE init_data_para(iim,jjm,nbpoints,index_x) |
|---|
| 211 | |
|---|
| 212 | IMPLICIT NONE |
|---|
| 213 | #ifdef CPP_PARA |
|---|
| 214 | INCLUDE 'mpif.h' |
|---|
| 215 | #endif |
|---|
| 216 | |
|---|
| 217 | INTEGER,INTENT(IN) :: iim |
|---|
| 218 | INTEGER,INTENT(IN) :: jjm |
|---|
| 219 | INTEGER,INTENT(IN) :: nbpoints |
|---|
| 220 | INTEGER,DIMENSION(:),INTENT(IN) :: index_x |
|---|
| 221 | |
|---|
| 222 | INTEGER,ALLOCATABLE,DIMENSION(:) :: index_l |
|---|
| 223 | INTEGER,ALLOCATABLE,DIMENSION(:) :: displs |
|---|
| 224 | #ifdef CPP_PARA |
|---|
| 225 | INTEGER :: ierr |
|---|
| 226 | #endif |
|---|
| 227 | INTEGER :: i |
|---|
| 228 | LOGICAL, PARAMETER :: check=.FALSE. |
|---|
| 229 | |
|---|
| 230 | |
|---|
| 231 | IF (check) WRITE(numout,*) 'INIT_DATA_PARA',iim,jjm,nbpoints,index_x |
|---|
| 232 | ALLOCATE(nbp_para_nb(0:mpi_size-1)) |
|---|
| 233 | ALLOCATE(nbp_para_begin(0:mpi_size-1)) |
|---|
| 234 | ALLOCATE(nbp_para_end(0:mpi_size-1)) |
|---|
| 235 | ALLOCATE(jj_para_nb(0:mpi_size-1)) |
|---|
| 236 | ALLOCATE(jj_para_begin(0:mpi_size-1)) |
|---|
| 237 | ALLOCATE(jj_para_end(0:mpi_size-1)) |
|---|
| 238 | ALLOCATE(ii_para_begin(0:mpi_size-1)) |
|---|
| 239 | ALLOCATE(ii_para_end(0:mpi_size-1)) |
|---|
| 240 | ALLOCATE(ij_para_nb(0:mpi_size-1)) |
|---|
| 241 | ALLOCATE(ij_para_begin(0:mpi_size-1)) |
|---|
| 242 | ALLOCATE(ij_para_end(0:mpi_size-1)) |
|---|
| 243 | |
|---|
| 244 | IF (cpl_lmdz) THEN |
|---|
| 245 | #ifdef CPP_PARA |
|---|
| 246 | CALL MPI_GATHER(nbpoints,1,MPI_INT_ORCH,nbp_para_nb,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 247 | #else |
|---|
| 248 | nbp_para_nb(0)=nbpoints |
|---|
| 249 | #endif |
|---|
| 250 | |
|---|
| 251 | IF (is_root_prc) THEN |
|---|
| 252 | nbp_glo=sum(nbp_para_nb) |
|---|
| 253 | ALLOCATE(displs(0:mpi_size-1)) |
|---|
| 254 | ALLOCATE(index_l(nbp_glo)) |
|---|
| 255 | displs(0)=0 |
|---|
| 256 | DO i=1,mpi_size-1 |
|---|
| 257 | displs(i)=displs(i-1)+nbp_para_nb(i-1) |
|---|
| 258 | ENDDO |
|---|
| 259 | ENDIF |
|---|
| 260 | #ifdef CPP_PARA |
|---|
| 261 | CALL MPI_BCAST(nbp_glo,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 262 | CALL MPI_GATHERV(index_x,nbpoints,MPI_INT_ORCH,index_l,nbp_para_nb,displs,& |
|---|
| 263 | MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 264 | #else |
|---|
| 265 | ! if not parallized, nb_glo=nbpoints=nbp_para_nb |
|---|
| 266 | IF (is_root_prc) index_l(:)=index_x(1:nbp_glo) |
|---|
| 267 | #endif |
|---|
| 268 | ELSE |
|---|
| 269 | IF (is_root_prc) THEN |
|---|
| 270 | nbp_glo=nbpoints |
|---|
| 271 | ALLOCATE(index_l(nbp_glo)) |
|---|
| 272 | index_l(:)=index_x(1:nbp_glo) |
|---|
| 273 | CALL Read_Load_Balance(nbpoints,nbp_para_nb) |
|---|
| 274 | ENDIF |
|---|
| 275 | ENDIF |
|---|
| 276 | |
|---|
| 277 | IF (is_root_prc) THEN |
|---|
| 278 | |
|---|
| 279 | IF (check) WRITE(numout,*) '==== DISTRIB ====',nbpoints,nbp_para_nb |
|---|
| 280 | |
|---|
| 281 | nbp_para_begin(0)=1 |
|---|
| 282 | nbp_para_end(0)=nbp_para_nb(0) |
|---|
| 283 | |
|---|
| 284 | DO i=1,mpi_size-1 |
|---|
| 285 | nbp_para_begin(i)=nbp_para_end(i-1)+1 |
|---|
| 286 | nbp_para_end(i)=nbp_para_begin(i)+nbp_para_nb(i)-1 |
|---|
| 287 | ENDDO |
|---|
| 288 | |
|---|
| 289 | nbp_loc=nbp_para_nb(mpi_rank) |
|---|
| 290 | |
|---|
| 291 | iim_g=iim |
|---|
| 292 | jjm_g=jjm |
|---|
| 293 | |
|---|
| 294 | |
|---|
| 295 | ij_para_begin(0)=1 |
|---|
| 296 | ij_para_end(0)=index_l(nbp_para_end(0)) |
|---|
| 297 | ij_para_nb(0)=ij_para_end(0)-ij_para_begin(0)+1 |
|---|
| 298 | |
|---|
| 299 | DO i=1,mpi_size-1 |
|---|
| 300 | ij_para_begin(i)=ij_para_end(i-1)+1 |
|---|
| 301 | ij_para_end(i)=index_l(nbp_para_end(i)) |
|---|
| 302 | ij_para_nb(i)=ij_para_end(i)-ij_para_begin(i)+1 |
|---|
| 303 | ENDDO |
|---|
| 304 | |
|---|
| 305 | ij_para_end(mpi_size-1)=iim*jjm |
|---|
| 306 | ij_para_nb(mpi_size-1)=ij_para_end(mpi_size-1)-ij_para_begin(mpi_size-1)+1 |
|---|
| 307 | |
|---|
| 308 | |
|---|
| 309 | DO i=0,mpi_size-1 |
|---|
| 310 | jj_para_begin(i)=(ij_para_begin(i)-1)/iim + 1 |
|---|
| 311 | jj_para_end(i)=(ij_para_end(i)-1)/iim + 1 |
|---|
| 312 | jj_para_nb(i)=jj_para_end(i)-jj_para_begin(i)+1 |
|---|
| 313 | |
|---|
| 314 | ii_para_begin(i)=MOD(ij_para_begin(i)-1,iim)+1 |
|---|
| 315 | ii_para_end(i)=MOD(ij_para_end(i)-1,iim)+1 |
|---|
| 316 | ENDDO |
|---|
| 317 | |
|---|
| 318 | IF (check) THEN |
|---|
| 319 | WRITE(numout,*) '==== DECOUP ====' |
|---|
| 320 | WRITE(numout,*) 'nbp_para_begin=',nbp_para_begin |
|---|
| 321 | WRITE(numout,*) 'nbp_para_end =',nbp_para_end |
|---|
| 322 | WRITE(numout,*) 'nbp_loc=',nbp_loc |
|---|
| 323 | |
|---|
| 324 | WRITE(numout,*) 'ij_para_begin=',ij_para_begin |
|---|
| 325 | WRITE(numout,*) 'ij_para_end=',ij_para_end |
|---|
| 326 | WRITE(numout,*) 'ij_para_nb=',ij_para_nb |
|---|
| 327 | WRITE(numout,*) 'jj_para_begin=',jj_para_begin |
|---|
| 328 | WRITE(numout,*) 'jj_para_end=',jj_para_end |
|---|
| 329 | WRITE(numout,*) 'jj_para_nb=',jj_para_nb |
|---|
| 330 | WRITE(numout,*) 'ii_para_begin=',ii_para_begin |
|---|
| 331 | WRITE(numout,*) 'ii_para_end=',ii_para_end |
|---|
| 332 | ENDIF |
|---|
| 333 | |
|---|
| 334 | ! |
|---|
| 335 | !- Root need the global variables |
|---|
| 336 | !- |
|---|
| 337 | ALLOCATE(resolution_g(nbp_glo,2),area_g(nbp_glo),lalo_g(nbp_glo,2)) |
|---|
| 338 | ALLOCATE(neighbours_g(nbp_glo,8),contfrac_g(nbp_glo),index_g(nbp_glo)) |
|---|
| 339 | ALLOCATE(lon_g(iim_g, jjm_g), lat_g(iim_g, jjm_g), zlev_g(iim_g, jjm_g)) |
|---|
| 340 | |
|---|
| 341 | index_g(:)=index_l(1:nbp_glo) |
|---|
| 342 | ENDIF |
|---|
| 343 | |
|---|
| 344 | #ifdef CPP_PARA |
|---|
| 345 | IF (is_root_prc) WRITE(numout,*) 'nbp_para_nb =',nbp_para_nb |
|---|
| 346 | CALL MPI_BCAST(nbp_para_nb,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 347 | CALL MPI_BCAST(nbp_para_begin,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 348 | CALL MPI_BCAST(nbp_para_end,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 349 | CALL MPI_BCAST(jj_para_nb,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 350 | CALL MPI_BCAST(jj_para_begin,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 351 | CALL MPI_BCAST(jj_para_end,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 352 | CALL MPI_BCAST(ii_para_begin,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 353 | CALL MPI_BCAST(ii_para_end,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 354 | CALL MPI_BCAST(ij_para_nb,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 355 | CALL MPI_BCAST(ij_para_begin,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 356 | CALL MPI_BCAST(ij_para_end,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 357 | CALL MPI_BCAST(iim_g,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 358 | CALL MPI_BCAST(jjm_g,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 359 | CALL MPI_BCAST(nbp_glo,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 360 | #endif |
|---|
| 361 | |
|---|
| 362 | nbp_loc=nbp_para_nb(mpi_rank) |
|---|
| 363 | |
|---|
| 364 | ij_nb=ij_para_nb(mpi_rank) |
|---|
| 365 | ij_begin=ij_para_begin(mpi_rank) |
|---|
| 366 | ij_end=ij_para_end(mpi_rank) |
|---|
| 367 | |
|---|
| 368 | jj_nb=jj_para_nb(mpi_rank) |
|---|
| 369 | jj_begin=jj_para_begin(mpi_rank) |
|---|
| 370 | jj_end=jj_para_end(mpi_rank) |
|---|
| 371 | |
|---|
| 372 | ii_begin=ii_para_begin(mpi_rank) |
|---|
| 373 | ii_end=ii_para_end(mpi_rank) |
|---|
| 374 | |
|---|
| 375 | IF (check) & |
|---|
| 376 | WRITE(numout,*) 'Init_io_para' |
|---|
| 377 | CALL Init_io_para |
|---|
| 378 | |
|---|
| 379 | IF (is_root_prc ) THEN |
|---|
| 380 | DEALLOCATE(index_l) |
|---|
| 381 | IF ( cpl_lmdz) THEN |
|---|
| 382 | DEALLOCATE(displs) |
|---|
| 383 | ENDIF |
|---|
| 384 | ENDIF |
|---|
| 385 | |
|---|
| 386 | IF (check) & |
|---|
| 387 | WRITE(numout,*) 'DATA PARA',nbp_loc,nbp_glo,jj_begin,jj_end,ii_begin,ii_end |
|---|
| 388 | END SUBROUTINE init_data_para |
|---|
| 389 | |
|---|
| 390 | |
|---|
| 391 | SUBROUTINE Init_io_para |
|---|
| 392 | USE ioipsl |
|---|
| 393 | IMPLICIT NONE |
|---|
| 394 | |
|---|
| 395 | INTEGER,DIMENSION(2) :: ddid |
|---|
| 396 | INTEGER,DIMENSION(2) :: dsg |
|---|
| 397 | INTEGER,DIMENSION(2) :: dsl |
|---|
| 398 | INTEGER,DIMENSION(2) :: dpf |
|---|
| 399 | INTEGER,DIMENSION(2) :: dpl |
|---|
| 400 | INTEGER,DIMENSION(2) :: dhs |
|---|
| 401 | INTEGER,DIMENSION(2) :: dhe |
|---|
| 402 | |
|---|
| 403 | ddid=(/ 1,2 /) |
|---|
| 404 | dsg=(/ iim_g, jjm_g /) |
|---|
| 405 | dsl=(/ iim_g, jj_nb /) |
|---|
| 406 | dpf=(/ 1,jj_begin /) |
|---|
| 407 | dpl=(/ iim_g, jj_end /) |
|---|
| 408 | dhs=(/ ii_begin-1,0 /) |
|---|
| 409 | if (mpi_rank==mpi_size-1) then |
|---|
| 410 | dhe=(/0,0/) |
|---|
| 411 | else |
|---|
| 412 | dhe=(/ iim_g-ii_end,0 /) |
|---|
| 413 | endif |
|---|
| 414 | |
|---|
| 415 | call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & |
|---|
| 416 | 'APPLE',orch_domain_id) |
|---|
| 417 | END SUBROUTINE Init_io_para |
|---|
| 418 | |
|---|
| 419 | SUBROUTINE Read_Load_balance(NbPoints,Nbpoints_loc) |
|---|
| 420 | |
|---|
| 421 | IMPLICIT NONE |
|---|
| 422 | INTEGER,INTENT(IN) :: NbPoints |
|---|
| 423 | INTEGER,INTENT(OUT) :: Nbpoints_loc(0:mpi_size-1) |
|---|
| 424 | #ifdef CPP_PARA |
|---|
| 425 | INTEGER :: unit_number=10 |
|---|
| 426 | CHARACTER(len=255) :: filename='Load_balance_orchidee.dat' |
|---|
| 427 | INTEGER :: j |
|---|
| 428 | #endif |
|---|
| 429 | INTEGER :: i,s,ierr |
|---|
| 430 | |
|---|
| 431 | Nbpoints_loc(:) = 0 |
|---|
| 432 | |
|---|
| 433 | #ifdef CPP_PARA |
|---|
| 434 | OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr) |
|---|
| 435 | #else |
|---|
| 436 | ierr=1 |
|---|
| 437 | #endif |
|---|
| 438 | s=0 |
|---|
| 439 | |
|---|
| 440 | #ifdef CPP_PARA |
|---|
| 441 | IF (ierr==0) THEN |
|---|
| 442 | i=0 |
|---|
| 443 | !- Reading for any balancing file (even with a bad structure) |
|---|
| 444 | DO WHILE (i < mpi_size .AND. ierr == 0) |
|---|
| 445 | READ (unit_number,*,IOSTAT=ierr) j,Nbpoints_loc(i) |
|---|
| 446 | s=s+Nbpoints_loc(i) |
|---|
| 447 | i=i+1 |
|---|
| 448 | ENDDO |
|---|
| 449 | CLOSE(unit_number) |
|---|
| 450 | ENDIF |
|---|
| 451 | #endif |
|---|
| 452 | |
|---|
| 453 | !- Correction of bad balancing file (or an empty file) => same nb of points for each procs |
|---|
| 454 | IF (ierr/=0 .OR. s/=Nbpoints) THEN |
|---|
| 455 | DO i=0,mpi_size-1 |
|---|
| 456 | Nbpoints_loc(i)=Nbpoints/mpi_size |
|---|
| 457 | IF (MOD(Nbpoints,mpi_size) > i) Nbpoints_loc(i)=Nbpoints_loc(i)+1 |
|---|
| 458 | ENDDO |
|---|
| 459 | ENDIF |
|---|
| 460 | |
|---|
| 461 | END SUBROUTINE Read_Load_balance |
|---|
| 462 | |
|---|
| 463 | SUBROUTINE Write_Load_balance(times) |
|---|
| 464 | IMPLICIT NONE |
|---|
| 465 | REAL(r_std),INTENT(IN) :: times |
|---|
| 466 | |
|---|
| 467 | #ifdef CPP_PARA |
|---|
| 468 | CHARACTER(len=255) :: filename='Load_balance_orchidee.dat' |
|---|
| 469 | INTEGER :: unit_number=10 |
|---|
| 470 | INTEGER :: i,ierr |
|---|
| 471 | REAL :: All_Times(0:mpi_size-1) |
|---|
| 472 | REAL :: average |
|---|
| 473 | REAL :: efficiency |
|---|
| 474 | INTEGER :: dp,S |
|---|
| 475 | INTEGER :: New_nbpoints(0:mpi_size-1) |
|---|
| 476 | #endif |
|---|
| 477 | |
|---|
| 478 | WRITE(numout,*) 'time',times |
|---|
| 479 | #ifndef CPP_PARA |
|---|
| 480 | RETURN |
|---|
| 481 | #else |
|---|
| 482 | |
|---|
| 483 | CALL MPI_GATHER(times,1,MPI_REAL_ORCH,All_times,1,MPI_REAL_ORCH,root_prc,MPI_COMM_ORCH,ierr) |
|---|
| 484 | IF (is_root_prc) WRITE(numout,*) 'ALL_times',All_times |
|---|
| 485 | |
|---|
| 486 | IF (is_root_prc) THEN |
|---|
| 487 | |
|---|
| 488 | OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr) |
|---|
| 489 | |
|---|
| 490 | average=sum(All_times(:))/mpi_size |
|---|
| 491 | DO i=0,mpi_size-1 |
|---|
| 492 | efficiency=All_times(i)/Nbp_para_nb(i) |
|---|
| 493 | New_nbpoints(i)=Nbp_para_nb(i)-(All_times(i)-average)/efficiency |
|---|
| 494 | ENDDO |
|---|
| 495 | |
|---|
| 496 | S=sum(new_nbpoints(:)) |
|---|
| 497 | dp=nbp_glo-S |
|---|
| 498 | |
|---|
| 499 | IF ( dp > 0 ) THEN |
|---|
| 500 | DO WHILE ( dp > 0 ) |
|---|
| 501 | New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))+1 |
|---|
| 502 | dp=dp-1 |
|---|
| 503 | ENDDO |
|---|
| 504 | ELSE |
|---|
| 505 | dp=-dp |
|---|
| 506 | DO WHILE ( dp > 0 ) |
|---|
| 507 | New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))-1 |
|---|
| 508 | dp=dp-1 |
|---|
| 509 | ENDDO |
|---|
| 510 | ENDIF |
|---|
| 511 | |
|---|
| 512 | ! If this algorithm diverge, we use previous repartition. |
|---|
| 513 | IF ( ANY(New_nbpoints(:) .LE. 0) ) THEN |
|---|
| 514 | New_nbpoints(:)=Nbp_para_nb(:) |
|---|
| 515 | ENDIF |
|---|
| 516 | |
|---|
| 517 | DO i=0,mpi_size-1 |
|---|
| 518 | WRITE(Unit_number,*) i,New_nbpoints(i) |
|---|
| 519 | ENDDO |
|---|
| 520 | CLOSE(Unit_number) |
|---|
| 521 | ENDIF |
|---|
| 522 | #endif |
|---|
| 523 | |
|---|
| 524 | END SUBROUTINE Write_Load_Balance |
|---|
| 525 | |
|---|
| 526 | |
|---|
| 527 | |
|---|
| 528 | END MODULE data_para |
|---|
| 529 | |
|---|
| 530 | #include "mpi_dummy.h" |
|---|
