Changeset 176


Ignore:
Timestamp:
10/16/13 12:02:24 (11 years ago)
Author:
ymipsl
Message:

Transfering data between domain on the same processus are now done by memory copy without use MPI CALL
=> prepare then new openMP version

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/transfert_mpi.f90

    r151 r176  
    1313    REAL,POINTER    :: buffer_r3(:,:) 
    1414    REAL,POINTER    :: buffer_r4(:,:,:) 
     15    INTEGER,POINTER :: src_value(:) 
    1516  END TYPE array 
    1617   
    … …  
    3738    TYPE(ARRAY),POINTER :: recv(:) 
    3839    INTEGER :: nsend 
     40    INTEGER :: nreq_mpi 
    3941    TYPE(ARRAY),POINTER :: send(:) 
    4042  END TYPE t_request 
    … …  
    5759    LOGICAL :: completed 
    5860    LOGICAL :: pending 
     61    INTEGER :: number 
    5962  END TYPE t_message 
     63   
     64  INTEGER,SAVE :: message_number=0 ; 
    6065   
    6166CONTAINS 
    … …  
    402407  IMPLICIT NONE 
    403408    TYPE(t_request),POINTER :: request(:) 
    404     TYPE(t_request),POINTER :: req 
     409    TYPE(t_request),POINTER :: req, req_src 
    405410    INTEGER :: nb_domain_recv(0:mpi_size-1) 
    406411    INTEGER :: nb_domain_send(0:mpi_size-1) 
    … …  
    411416 
    412417    INTEGER :: rank,i,j 
    413     INTEGER :: size,ind_glo,ind_loc 
     418    INTEGER :: size_,ind_glo,ind_loc, ind_src 
    414419    INTEGER :: isend, irecv, ireq, nreq 
    415420    INTEGER, ALLOCATABLE :: mpi_req(:) 
    … …  
    455460        irecv=list_domain_recv(req%src_domain(i)) 
    456461        req%recv(irecv)%size=req%recv(irecv)%size+1 
    457         size=req%recv(irecv)%size 
    458         req%recv(irecv)%value(size)=req%src_ind(i) 
    459         req%recv(irecv)%buffer(size)=req%target_ind(i) 
    460         req%recv(irecv)%sign(size)=req%target_sign(i) 
     462        size_=req%recv(irecv)%size 
     463        req%recv(irecv)%value(size_)=req%src_ind(i) 
     464        req%recv(irecv)%buffer(size_)=req%target_ind(i) 
     465        req%recv(irecv)%sign(size_)=req%target_sign(i) 
    461466      ENDDO 
    462467    ENDDO 
    … …  
    537542     DO irecv=1,req%nrecv 
    538543       ireq=ireq+1 
     544       CALL MPI_ISEND(ind_loc,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr) 
     545     ENDDO 
     546      
     547     DO isend=1,req%nsend 
     548       ireq=ireq+1 
     549       CALL MPI_IRECV(req%send(isend)%domain,1,MPI_INTEGER,req%send(isend)%rank,ind_loc,comm_icosa, mpi_req(ireq),ierr) 
     550     ENDDO 
     551   ENDDO 
     552    
     553   CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
     554   CALL MPI_BARRIER(comm_icosa,ierr) 
     555 
     556   ireq=0  
     557   DO ind_loc=1,ndomain 
     558     req=>request(ind_loc) 
     559      
     560     DO irecv=1,req%nrecv 
     561       ireq=ireq+1 
    539562       CALL MPI_ISEND(req%recv(irecv)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr) 
    540563     ENDDO 
    … …  
    577600     ENDDO 
    578601   ENDDO   
     602 
     603! domain is on the same mpi process 
    579604    
    580      
     605   DO ind_loc=1,ndomain 
     606     req=>request(ind_loc) 
     607      
     608     DO irecv=1,req%nrecv 
     609    
     610       IF (req%recv(irecv)%rank==mpi_rank) THEN 
     611           req_src=>request(req%recv(irecv)%domain) 
     612           DO isend=1,req_src%nsend 
     613             IF (req_src%send(isend)%rank==mpi_rank .AND. req_src%send(isend)%domain==ind_loc) THEN 
     614               req%recv(irecv)%src_value => req_src%send(isend)%value 
     615               IF ( size(req%recv(irecv)%value) /= size(req_src%send(isend)%value)) THEN 
     616                 STOP "size(req%recv(irecv)%value) /= size(req_src%send(isend)%value" 
     617               ENDIF 
     618             ENDIF 
     619           ENDDO 
     620       ENDIF 
     621      
     622     ENDDO 
     623   ENDDO 
     624    
     625! true number of mpi request 
     626   DO ind_loc=1,ndomain 
     627     req=>request(ind_loc) 
     628     req%nreq_mpi=0 
     629 
     630     DO isend=1,req%nsend 
     631      IF (req%send(isend)%rank/=mpi_rank .OR. .TRUE.) req%nreq_mpi=req%nreq_mpi+1   
     632     ENDDO 
     633      
     634     DO irecv=1,req%nrecv 
     635      IF (req%recv(irecv)%rank/=mpi_rank .OR. .TRUE.) req%nreq_mpi=req%nreq_mpi+1   
     636     ENDDO 
     637   
     638   ENDDO  
     639        
    581640  END SUBROUTINE Finalize_request  
    582641 
    … …  
    663722 
    664723!$OMP MASTER 
     724    message%number=message_number 
     725    message_number=message_number+1 
     726    IF (message_number==100) message_number=0 
     727     
    665728    message%request=>request 
    666729    nreq=sum(request(:)%nsend)+sum(request(:)%nrecv) 
    667     message%nreq=nreq 
     730!    message%nreq=nreq 
     731    message%nreq=sum(message%request(:)%nreq_mpi) 
    668732    ALLOCATE(message%mpi_req(nreq)) 
    669733    ALLOCATE(message%buffers(nreq)) 
    … …  
    778842    TYPE(t_field),POINTER :: field(:) 
    779843    TYPE(t_message) :: message 
    780     REAL(rstd),POINTER :: rval2d(:)  
    781     REAL(rstd),POINTER :: rval3d(:,:)  
    782     REAL(rstd),POINTER :: rval4d(:,:,:)  
     844    REAL(rstd),POINTER :: rval2d(:), src_rval2d(:)  
     845    REAL(rstd),POINTER :: rval3d(:,:), src_rval3d(:,:)  
     846    REAL(rstd),POINTER :: rval4d(:,:,:), src_rval4d(:,:,:)  
    783847    REAL(rstd),POINTER :: buffer_r2(:)  
    784848    REAL(rstd),POINTER :: buffer_r3(:,:)  
    … …  
    791855    INTEGER, ALLOCATABLE :: status(:,:) 
    792856    INTEGER :: irecv,isend 
    793     INTEGER :: ireq,nreq 
     857    INTEGER :: ireq,ireq_mpi,nreq 
    794858    INTEGER :: ind,n,l,m 
    795859    INTEGER :: dim3,dim4 
     860    INTEGER,POINTER :: src_value(:) 
     861    INTEGER,POINTER :: sign(:) 
    796862 
    797863!$OMP BARRIER 
    … …  
    799865    CALL trace_start("transfert_mpi") 
    800866 
    801     nreq=message%nreq 
     867!    nreq=message%nreq 
    802868    message%field=>field 
    803869 
    804870!$OMP MASTER 
    805     message%completed=.FALSE. 
    806     message%pending=.TRUE. 
     871    IF (message%nreq>0) THEN 
     872      message%completed=.FALSE. 
     873      message%pending=.TRUE. 
     874    ELSE 
     875      message%completed=.TRUE. 
     876      message%pending=.FALSE. 
     877    ENDIF 
     878     
    807879!$OMP END MASTER 
    808880     
    … …  
    811883 
    812884        ireq=0 
     885        ireq_mpi=0 
    813886        DO ind=1,ndomain 
    814887          rval2d=>field(ind)%rval2d 
    … …  
    818891            ireq=ireq+1 
    819892            send=>req%send(isend) 
    820             buffer_r2=>message%buffers(ireq)%r2 
    821893            value=>send%value 
    822894 
    823             CALL trace_in 
    824  
    825 !$OMP DO SCHEDULE(STATIC) 
    826             DO n=1,send%size 
    827               buffer_r2(n)=rval2d(value(n)) 
    828             ENDDO 
    829895             
    830             CALL trace_out 
    831  
    832 !$OMP MASTER 
    833             CALL MPI_ISSEND(buffer_r2,send%size,MPI_REAL8,send%rank,ind,comm_icosa, message%mpi_req(ireq),ierr) 
    834 !$OMP END MASTER 
     896            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN 
     897              ireq_mpi=ireq_mpi+1 
     898              buffer_r2=>message%buffers(ireq)%r2 
     899              CALL trace_in 
     900 
     901              !$OMP DO SCHEDULE(STATIC) 
     902              DO n=1,send%size 
     903                buffer_r2(n)=rval2d(value(n)) 
     904              ENDDO 
     905             
     906              CALL trace_out 
     907 
     908              !$OMP MASTER 
     909              CALL MPI_ISSEND(buffer_r2,send%size,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr) 
     910              !$OMP END MASTER 
     911              
     912             ENDIF 
    835913          ENDDO 
    836914         
    … …  
    838916            ireq=ireq+1 
    839917            recv=>req%recv(irecv) 
    840             buffer_r2=>message%buffers(ireq)%r2 
    841 !$OMP MASTER 
    842             CALL MPI_IRECV(buffer_r2,recv%size,MPI_REAL8,recv%rank,recv%domain,comm_icosa, message%mpi_req(ireq),ierr) 
    843 !$OMP END MASTER 
     918 
     919            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN 
     920              value=>recv%value 
     921              src_value => recv%src_value 
     922              src_rval2d=>field(recv%domain)%rval2d 
     923              sgn=>recv%sign 
     924              !$OMP DO SCHEDULE(STATIC) 
     925              DO n=1,recv%size 
     926                rval2d(value(n))=src_rval2d(src_value(n))*sgn(n) 
     927              ENDDO 
     928             
     929            ELSE 
     930               ireq_mpi=ireq_mpi+1 
     931               buffer_r2=>message%buffers(ireq)%r2 
     932              !$OMP MASTER 
     933              CALL MPI_IRECV(buffer_r2,recv%size,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr) 
     934              !$OMP END MASTER 
     935            ENDIF 
    844936          ENDDO 
    845937         
    … …  
    849941       
    850942        ireq=0 
     943        ireq_mpi=0 
    851944        DO ind=1,ndomain 
    852945          dim3=size(field(ind)%rval3d,2) 
    … …  
    857950            ireq=ireq+1 
    858951            send=>req%send(isend) 
    859             buffer_r3=>message%buffers(ireq)%r3 
    860952            value=>send%value 
    861953 
    862             CALL trace_in 
     954            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN 
     955              ireq_mpi=ireq_mpi+1 
     956              buffer_r3=>message%buffers(ireq)%r3 
     957  
     958              CALL trace_in 
    863959             
    864960!$OMP DO SCHEDULE(STATIC) 
    865               DO n=1,send%size 
    866                 buffer_r3(n,:)=rval3d(value(n),:) 
     961                DO n=1,send%size 
     962                  buffer_r3(n,:)=rval3d(value(n),:) 
     963                ENDDO 
     964 
     965               CALL trace_out 
     966 
     967  !$OMP MASTER 
     968              CALL MPI_ISSEND(buffer_r3,send%size*dim3,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr) 
     969  !$OMP END MASTER 
     970            ENDIF 
     971         ENDDO 
     972         
     973          DO irecv=1,req%nrecv 
     974            ireq=ireq+1 
     975            recv=>req%recv(irecv) 
     976 
     977            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN 
     978              value=>recv%value 
     979              src_value => recv%src_value 
     980              src_rval3d=>field(recv%domain)%rval3d 
     981              sgn=>recv%sign 
     982              !$OMP DO SCHEDULE(STATIC) 
     983              DO n=1,recv%size 
     984                rval3d(value(n),:)=src_rval3d(src_value(n),:)*sgn(n) 
    867985              ENDDO 
    868  
    869              CALL trace_out 
    870  
    871 !$OMP MASTER 
    872             CALL MPI_ISSEND(buffer_r3,send%size*dim3,MPI_REAL8,send%rank,ind,comm_icosa, message%mpi_req(ireq),ierr) 
     986             
     987            ELSE 
     988              ireq_mpi=ireq_mpi+1 
     989              buffer_r3=>message%buffers(ireq)%r3 
     990!$OMP MASTER            
     991              CALL MPI_IRECV(buffer_r3,recv%size*dim3,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr) 
    873992!$OMP END MASTER 
    874           ENDDO 
    875          
    876           DO irecv=1,req%nrecv 
    877             ireq=ireq+1 
    878             recv=>req%recv(irecv) 
    879             buffer_r3=>message%buffers(ireq)%r3 
    880 !$OMP MASTER            
    881             CALL MPI_IRECV(buffer_r3,recv%size*dim3,MPI_REAL8,recv%rank,recv%domain,comm_icosa, message%mpi_req(ireq),ierr) 
    882 !$OMP END MASTER 
    883  
     993            ENDIF 
    884994          ENDDO 
    885995         
    … …  
    889999     
    8901000        ireq=0 
     1001        ireq_mpi=0 
    8911002        DO ind=1,ndomain 
    8921003          dim3=size(field(ind)%rval4d,2) 
    … …  
    8981009            ireq=ireq+1 
    8991010            send=>req%send(isend) 
    900             buffer_r4=>message%buffers(ireq)%r4 
    9011011            value=>send%value 
    9021012 
    903             CALL trace_in 
     1013            IF (send%rank/=mpi_rank .OR. .TRUE.) THEN 
     1014              ireq_mpi=ireq_mpi+1 
     1015              buffer_r4=>message%buffers(ireq)%r4 
     1016              CALL trace_in 
    9041017 
    9051018!$OMP DO SCHEDULE(STATIC) 
    906             DO n=1,send%size 
    907                buffer_r4(n,:,:)=rval4d(value(n),:,:) 
    908             ENDDO 
    909  
    910            CALL trace_out 
     1019              DO n=1,send%size 
     1020                 buffer_r4(n,:,:)=rval4d(value(n),:,:) 
     1021              ENDDO 
     1022 
     1023             CALL trace_out 
    9111024 
    9121025!$OMP MASTER 
    913             CALL MPI_ISSEND(buffer_r4,send%size*dim3*dim4,MPI_REAL8,send%rank,ind,comm_icosa, message%mpi_req(ireq),ierr) 
     1026              CALL MPI_ISSEND(buffer_r4,send%size*dim3*dim4,MPI_REAL8,send%rank,ind+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr) 
    9141027!$OMP END MASTER 
     1028            ENDIF 
    9151029          ENDDO 
    9161030         
    … …  
    9181032            ireq=ireq+1 
    9191033            recv=>req%recv(irecv) 
    920             buffer_r4=>message%buffers(ireq)%r4 
     1034            IF (recv%rank==mpi_rank .AND. .FALSE.) THEN 
     1035              value=>recv%value 
     1036              src_value => recv%src_value 
     1037              src_rval4d=>field(recv%domain)%rval4d 
     1038              sgn=>recv%sign 
     1039 
     1040              !$OMP DO SCHEDULE(STATIC) 
     1041              DO n=1,recv%size 
     1042                rval4d(value(n),:,:)=src_rval4d(src_value(n),:,:)*sgn(n) 
     1043              ENDDO 
     1044             
     1045            ELSE 
     1046              ireq_mpi=ireq_mpi+1 
     1047              buffer_r4=>message%buffers(ireq)%r4 
    9211048!$OMP MASTER            
    922             CALL MPI_IRECV(buffer_r4,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%domain,comm_icosa, message%mpi_req(ireq),ierr) 
     1049              CALL MPI_IRECV(buffer_r4,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%domain+100*message%number,comm_icosa, message%mpi_req(ireq_mpi),ierr) 
    9231050!$OMP END MASTER 
     1051            ENDIF 
    9241052          ENDDO 
    9251053         
    … …  
    9291057       
    9301058    ENDIF 
    931  
     1059    IF (ireq_mpi /= message%nreq ) THEN 
     1060      STOP "ireq_mpi /= message%nreq" 
     1061    ENDIF 
     1062     
    9321063    CALL trace_end("transfert_mpi") 
    9331064!$OMP BARRIER 
    … …  
    10071138            ireq=ireq+1 
    10081139            recv=>req%recv(irecv) 
    1009             buffer_r2=>message%buffers(ireq)%r2 
    1010             value=>recv%value 
    1011             sgn=>recv%sign 
    1012  
    1013             CALL trace_in 
     1140            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN 
     1141              buffer_r2=>message%buffers(ireq)%r2 
     1142              value=>recv%value 
     1143              sgn=>recv%sign 
     1144 
     1145              CALL trace_in 
    10141146             
    10151147!$OMP DO SCHEDULE(STATIC) 
    1016             DO n=1,recv%size 
    1017               rval2d(value(n))=buffer_r2(n)*sgn(n)   
    1018             ENDDO         
    1019  
    1020             CALL trace_out 
    1021  
     1148              DO n=1,recv%size 
     1149                rval2d(value(n))=buffer_r2(n)*sgn(n)   
     1150              ENDDO         
     1151 
     1152              CALL trace_out 
     1153            ENDIF 
    10221154          ENDDO 
    10231155         
    … …  
    10441176            ireq=ireq+1 
    10451177            recv=>req%recv(irecv) 
    1046             buffer_r3=>message%buffers(ireq)%r3 
    1047             value=>recv%value 
    1048             sgn=>recv%sign 
    1049  
    1050             CALL trace_in 
     1178            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN 
     1179              buffer_r3=>message%buffers(ireq)%r3 
     1180              value=>recv%value 
     1181              sgn=>recv%sign 
     1182 
     1183              CALL trace_in 
    10511184             
    10521185!$OMP DO SCHEDULE(STATIC) 
    1053             DO n=1,recv%size 
    1054               rval3d(value(n),:)=buffer_r3(n,:)*sgn(n)   
    1055             ENDDO   
    1056  
    1057             CALL trace_out 
    1058  
     1186              DO n=1,recv%size 
     1187                rval3d(value(n),:)=buffer_r3(n,:)*sgn(n)   
     1188              ENDDO   
     1189 
     1190              CALL trace_out 
     1191            ENDIF 
    10591192          ENDDO 
    10601193         
    … …  
    10791212            ireq=ireq+1 
    10801213            recv=>req%recv(irecv) 
    1081             buffer_r4=>message%buffers(ireq)%r4 
    1082             value=>recv%value 
    1083             sgn=>recv%sign 
    1084  
    1085             CALL trace_in 
     1214            IF (recv%rank/=mpi_rank .OR. .TRUE.) THEN 
     1215              buffer_r4=>message%buffers(ireq)%r4 
     1216              value=>recv%value 
     1217              sgn=>recv%sign 
     1218 
     1219              CALL trace_in 
    10861220 
    10871221!$OMP DO SCHEDULE(STATIC) 
    1088             DO n=1,recv%size 
    1089               rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n)  
    1090             ENDDO 
    1091  
    1092             CALL trace_out 
    1093  
     1222              DO n=1,recv%size 
     1223                rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n)  
     1224              ENDDO 
     1225 
     1226              CALL trace_out 
     1227            ENDIF 
    10941228          ENDDO 
    10951229         
Note: See TracChangeset for help on using the changeset viewer.