Changeset 176 for codes/icosagcm/trunk
- Timestamp:
- 10/16/13 12:02:24 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/transfert_mpi.f90
r151 r176 13 13 REAL,POINTER :: buffer_r3(:,:) 14 14 REAL,POINTER :: buffer_r4(:,:,:) 15 INTEGER,POINTER :: src_value(:) 15 16 END TYPE array 16 17 … … 37 38 TYPE(ARRAY),POINTER :: recv(:) 38 39 INTEGER :: nsend 40 INTEGER :: nreq_mpi 39 41 TYPE(ARRAY),POINTER :: send(:) 40 42 END TYPE t_request … … 57 59 LOGICAL :: completed 58 60 LOGICAL :: pending 61 INTEGER :: number 59 62 END TYPE t_message 63 64 INTEGER,SAVE :: message_number=0 ; 60 65 61 66 CONTAINS … … 402 407 IMPLICIT NONE 403 408 TYPE(t_request),POINTER :: request(:) 404 TYPE(t_request),POINTER :: req 409 TYPE(t_request),POINTER :: req, req_src 405 410 INTEGER :: nb_domain_recv(0:mpi_size-1) 406 411 INTEGER :: nb_domain_send(0:mpi_size-1) … … 411 416 412 417 INTEGER :: rank,i,j 413 INTEGER :: size ,ind_glo,ind_loc418 INTEGER :: size_,ind_glo,ind_loc, ind_src 414 419 INTEGER :: isend, irecv, ireq, nreq 415 420 INTEGER, ALLOCATABLE :: mpi_req(:) … … 455 460 irecv=list_domain_recv(req%src_domain(i)) 456 461 req%recv(irecv)%size=req%recv(irecv)%size+1 457 size =req%recv(irecv)%size458 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) 461 466 ENDDO 462 467 ENDDO … … 537 542 DO irecv=1,req%nrecv 538 543 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 539 562 CALL MPI_ISEND(req%recv(irecv)%size,1,MPI_INTEGER,req%recv(irecv)%rank,req%recv(irecv)%domain,comm_icosa, mpi_req(ireq),ierr) 540 563 ENDDO … … 577 600 ENDDO 578 601 ENDDO 602 603 ! domain is on the same mpi process 579 604 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 581 640 END SUBROUTINE Finalize_request 582 641 … … 663 722 664 723 !$OMP MASTER 724 message%number=message_number 725 message_number=message_number+1 726 IF (message_number==100) message_number=0 727 665 728 message%request=>request 666 729 nreq=sum(request(:)%nsend)+sum(request(:)%nrecv) 667 message%nreq=nreq 730 ! message%nreq=nreq 731 message%nreq=sum(message%request(:)%nreq_mpi) 668 732 ALLOCATE(message%mpi_req(nreq)) 669 733 ALLOCATE(message%buffers(nreq)) … … 778 842 TYPE(t_field),POINTER :: field(:) 779 843 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(:,:,:) 783 847 REAL(rstd),POINTER :: buffer_r2(:) 784 848 REAL(rstd),POINTER :: buffer_r3(:,:) … … 791 855 INTEGER, ALLOCATABLE :: status(:,:) 792 856 INTEGER :: irecv,isend 793 INTEGER :: ireq, nreq857 INTEGER :: ireq,ireq_mpi,nreq 794 858 INTEGER :: ind,n,l,m 795 859 INTEGER :: dim3,dim4 860 INTEGER,POINTER :: src_value(:) 861 INTEGER,POINTER :: sign(:) 796 862 797 863 !$OMP BARRIER … … 799 865 CALL trace_start("transfert_mpi") 800 866 801 nreq=message%nreq867 ! nreq=message%nreq 802 868 message%field=>field 803 869 804 870 !$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 807 879 !$OMP END MASTER 808 880 … … 811 883 812 884 ireq=0 885 ireq_mpi=0 813 886 DO ind=1,ndomain 814 887 rval2d=>field(ind)%rval2d … … 818 891 ireq=ireq+1 819 892 send=>req%send(isend) 820 buffer_r2=>message%buffers(ireq)%r2821 893 value=>send%value 822 894 823 CALL trace_in824 825 !$OMP DO SCHEDULE(STATIC)826 DO n=1,send%size827 buffer_r2(n)=rval2d(value(n))828 ENDDO829 895 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 835 913 ENDDO 836 914 … … 838 916 ireq=ireq+1 839 917 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 844 936 ENDDO 845 937 … … 849 941 850 942 ireq=0 943 ireq_mpi=0 851 944 DO ind=1,ndomain 852 945 dim3=size(field(ind)%rval3d,2) … … 857 950 ireq=ireq+1 858 951 send=>req%send(isend) 859 buffer_r3=>message%buffers(ireq)%r3860 952 value=>send%value 861 953 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 863 959 864 960 !$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) 867 985 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) 873 992 !$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 884 994 ENDDO 885 995 … … 889 999 890 1000 ireq=0 1001 ireq_mpi=0 891 1002 DO ind=1,ndomain 892 1003 dim3=size(field(ind)%rval4d,2) … … 898 1009 ireq=ireq+1 899 1010 send=>req%send(isend) 900 buffer_r4=>message%buffers(ireq)%r4901 1011 value=>send%value 902 1012 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 904 1017 905 1018 !$OMP DO SCHEDULE(STATIC) 906 DO n=1,send%size907 buffer_r4(n,:,:)=rval4d(value(n),:,:)908 ENDDO909 910 CALL trace_out1019 DO n=1,send%size 1020 buffer_r4(n,:,:)=rval4d(value(n),:,:) 1021 ENDDO 1022 1023 CALL trace_out 911 1024 912 1025 !$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) 914 1027 !$OMP END MASTER 1028 ENDIF 915 1029 ENDDO 916 1030 … … 918 1032 ireq=ireq+1 919 1033 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 921 1048 !$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) 923 1050 !$OMP END MASTER 1051 ENDIF 924 1052 ENDDO 925 1053 … … 929 1057 930 1058 ENDIF 931 1059 IF (ireq_mpi /= message%nreq ) THEN 1060 STOP "ireq_mpi /= message%nreq" 1061 ENDIF 1062 932 1063 CALL trace_end("transfert_mpi") 933 1064 !$OMP BARRIER … … 1007 1138 ireq=ireq+1 1008 1139 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 1014 1146 1015 1147 !$OMP DO SCHEDULE(STATIC) 1016 DO n=1,recv%size1017 rval2d(value(n))=buffer_r2(n)*sgn(n)1018 ENDDO1019 1020 CALL trace_out1021 1148 DO n=1,recv%size 1149 rval2d(value(n))=buffer_r2(n)*sgn(n) 1150 ENDDO 1151 1152 CALL trace_out 1153 ENDIF 1022 1154 ENDDO 1023 1155 … … 1044 1176 ireq=ireq+1 1045 1177 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 1051 1184 1052 1185 !$OMP DO SCHEDULE(STATIC) 1053 DO n=1,recv%size1054 rval3d(value(n),:)=buffer_r3(n,:)*sgn(n)1055 ENDDO1056 1057 CALL trace_out1058 1186 DO n=1,recv%size 1187 rval3d(value(n),:)=buffer_r3(n,:)*sgn(n) 1188 ENDDO 1189 1190 CALL trace_out 1191 ENDIF 1059 1192 ENDDO 1060 1193 … … 1079 1212 ireq=ireq+1 1080 1213 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 1086 1220 1087 1221 !$OMP DO SCHEDULE(STATIC) 1088 DO n=1,recv%size1089 rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n)1090 ENDDO1091 1092 CALL trace_out1093 1222 DO n=1,recv%size 1223 rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n) 1224 ENDDO 1225 1226 CALL trace_out 1227 ENDIF 1094 1228 ENDDO 1095 1229
Note: See TracChangeset
for help on using the changeset viewer.