Changeset 898 for trunk/AGRIF
- Timestamp:
- 2008-04-22T17:35:20+02:00 (16 years ago)
- Location:
- trunk/AGRIF/AGRIF_FILES
- Files:
-
- 6 edited
-
modbc.F (modified) (1 diff)
-
modinterp.F (modified) (10 diffs)
-
modinterpbasic.F (modified) (2 diffs)
-
modmpp.F (modified) (3 diffs)
-
modtypes.F (modified) (1 diff)
-
modupdate.F (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/AGRIF/AGRIF_FILES/modbc.F
r779 r898 1308 1308 child%var%oldvalues2d=0. 1309 1309 C 1310 child % var % oldvalues2d(:,1:SIZE(tempoldvalues, 1)) =1310 child % var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = 1311 1311 & tempoldvalues(:,:) 1312 1312 C -
trunk/AGRIF/AGRIF_FILES/modinterp.F
r779 r898 631 631 INTEGER,DIMENSION(nbdim,4) :: tab3 632 632 INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4 633 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1, 4) :: tab4t633 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 634 634 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 635 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 635 636 LOGICAL, DIMENSION(1) :: memberin1 636 637 C … … 650 651 & pttruetab,cetruetab,member,memberin,find_list_interp 651 652 #if defined AGRIF_MPI 652 & ,tab4t,memberinall 653 & ,tab4t,memberinall,sendtoproc1,recvfromproc1 653 654 #endif 654 655 & ) … … 823 824 CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 824 825 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 825 826 827 Call Get_External_Data_first(tab4t(:,:,1), 828 & tab4t(:,:,2), 829 & tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin, 830 & memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5), 831 & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8)) 832 826 833 endif 827 834 828 Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1), 829 & tab4t(:,:,2), 830 & tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin, 831 & memberinall) 835 ! Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1), 836 ! & tab4t(:,:,2), 837 ! & tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin, 838 ! & memberinall) 839 840 Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim, 841 & tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6), 842 & tab4t(:,:,7),tab4t(:,:,8),memberin,tempP, 843 & tempPextend) 832 844 #else 833 845 tempPextend%var => tempP%var … … 840 852 & pttruetab,cetruetab,member,memberin,nbdim 841 853 #if defined AGRIF_MPI 842 & ,tab4t,memberinall 854 & ,tab4t,memberinall,sendtoproc1,recvfromproc1 843 855 #endif 844 856 & ) … … 2048 2060 & find_list_interp 2049 2061 #if defined AGRIF_MPI 2050 & ,tab4t,memberinall 2062 & ,tab4t,memberinall,sendtoproc1,recvfromproc1 2051 2063 #endif 2052 2064 & ) … … 2065 2077 #ifdef AGRIF_MPI 2066 2078 C 2067 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1, 4) :: tab4t2079 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 2068 2080 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 2081 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 2069 2082 #endif 2070 2083 … … 2098 2111 parentarray = parcours%interp_loc%parentarray(1:nbdim,:,:) 2099 2112 member = parcours%interp_loc%member 2100 tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1: 4)2113 tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8) 2101 2114 memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1) 2115 sendtoproc1 = parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1) 2116 recvfromproc1 = 2117 & parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1) 2102 2118 #endif 2103 2119 memberin = parcours%interp_loc%memberin … … 2115 2131 & member,memberin,nbdim 2116 2132 #if defined AGRIF_MPI 2117 & ,tab4t,memberinall 2133 & ,tab4t,memberinall,sendtoproc1,recvfromproc1 2118 2134 #endif 2119 2135 & ) … … 2130 2146 #ifdef AGRIF_MPI 2131 2147 C 2132 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1, 4) :: tab4t2148 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 2133 2149 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 2150 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1 2151 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc1 2134 2152 #endif 2135 2153 Type(Agrif_List_Interp_loc), Pointer :: parcours … … 2157 2175 & = parentarray(1:nbdim,:,:) 2158 2176 parcours%interp_loc%member = member 2159 Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1, 4))2177 Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8)) 2160 2178 Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)) 2179 Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)) 2180 Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)) 2161 2181 parcours%interp_loc%tab4t=tab4t 2162 2182 parcours%interp_loc%memberinall=memberinall 2183 parcours%interp_loc%sendtoproc1=sendtoproc1 2184 parcours%interp_loc%recvfromproc1=recvfromproc1 2163 2185 #endif 2164 2186 -
trunk/AGRIF/AGRIF_FILES/modinterpbasic.F
r779 r898 385 385 do i = 1,nc 386 386 C 387 y(i)=coeffparent(i,dir)*x( indparent(i,dir))+387 y(i)=coeffparent(i,dir)*x(MAX(indparent(i,dir),1))+ 388 388 & (1.-coeffparent(i,dir))*x(indparent(i,dir)+1) 389 389 C … … 1065 1065 & indparentppm_1d(1:nc) + (i-1)*np 1066 1066 indchildppm (1+(i-1)*nc:i*nc,dir) = 1067 & indchildppm_1d (1:nc) + (i-1)*np1067 & indchildppm_1d (1:nc) 1068 1068 1069 1069 End do -
trunk/AGRIF/AGRIF_FILES/modmpp.F
r779 r898 31 31 Contains 32 32 #ifdef AGRIF_MPI 33 Subroutine Get_External_Data_first(pttruetab, 34 & cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin, 35 & memberout,memberoutall1,sendtoproc,recvfromproc,imin,imax, 36 & imin_recv,imax_recv) 37 38 IMPLICIT NONE 39 #include "mpif.h" 40 INTEGER :: nbdim 41 INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1) :: pttruetab, 42 & cetruetab 43 INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1) :: pttruetabwhole, 44 & cetruetabwhole 45 INTEGER :: k,i,k2 46 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc, recvfromproc 47 INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1):: imin,imax, 48 & imin_recv,imax_recv 49 LOGICAL :: memberin, memberout 50 INTEGER :: imintmp, imaxtmp,j,i1 51 INTEGER :: imin1,imax1 52 LOGICAL :: tochange,tochangebis 53 INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1) :: pttruetab2, 54 & cetruetab2 55 LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1) 56 LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1) 57 INTEGER :: code 58 59 C pttruetab2 and cetruetab2 are modified arraysin order to always 60 C send the most inner points 61 62 63 IF (present(memberoutall1)) THEN 64 memberoutall = memberoutall1 65 ELSE 66 memberout1(1) = memberout 67 68 CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall, 69 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 70 ENDIF 71 pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank) 72 cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank) 73 do k2=0,Agrif_Nbprocs-1 74 do i=1,nbdim 75 76 tochangebis=.TRUE. 77 DO i1=1,nbdim 78 IF (i .NE. i1) THEN 79 IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR. 80 & (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN 81 tochangebis = .FALSE. 82 EXIT 83 ENDIF 84 ENDIF 85 ENDDO 86 87 IF (tochangebis) THEN 88 89 90 imin1 = max(pttruetab(i,Agrif_Procrank), 91 & pttruetab(i,k2)) 92 imax1 = min(cetruetab(i,Agrif_Procrank), 93 & cetruetab(i,k2)) 94 95 C Always send the most interior points 96 97 tochange = .false. 98 IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN 99 100 DO j=imin1,imax1 101 IF ((cetruetab(i,k2)-j) > 102 & (j-pttruetab(i,Agrif_Procrank))) THEN 103 imintmp = j+1 104 tochange = .TRUE. 105 ELSE 106 EXIT 107 ENDIF 108 ENDDO 109 ENDIF 110 111 if (tochange) then 112 C 113 pttruetab2(i,Agrif_Procrank) = imintmp 114 C 115 endif 116 117 tochange = .FALSE. 118 imaxtmp=0 119 IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN 120 DO j=imax1,imin1,-1 121 IF ((j-pttruetab(i,k2)) > 122 & (cetruetab(i,Agrif_Procrank)-j)) THEN 123 imaxtmp = j-1 124 tochange = .TRUE. 125 ELSE 126 EXIT 127 ENDIF 128 ENDDO 129 130 ENDIF 131 132 if (tochange) then 133 C 134 cetruetab2(i,Agrif_Procrank) = imaxtmp 135 C 136 endif 137 C 138 139 ENDIF 140 enddo 141 enddo 142 143 144 do k = 0,Agrif_NbProcs-1 145 C 146 sendtoproc(k) = .true. 147 C 148 !CDIR SHORTLOOP 149 do i = 1,nbdim 150 C 151 imin(i,k) = max(pttruetab2(i,Agrif_Procrank), 152 & pttruetabwhole(i,k)) 153 imax(i,k) = min(cetruetab2(i,Agrif_Procrank), 154 & cetruetabwhole(i,k)) 155 C 156 if (imin(i,k) > imax(i,k)) then 157 C 158 sendtoproc(k) = .false. 159 C 160 endif 161 C 162 enddo 163 IF (.NOT.memberoutall(k)) THEN 164 sendtoproc(k) = .FALSE. 165 ENDIF 166 C 167 enddo 168 169 Call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax, 170 & recvfromproc,imin_recv,imax_recv) 171 172 End Subroutine Get_External_Data_first 33 173 C 34 174 Subroutine Get_External_Data(tempC,tempCextend,pttruetab, … … 249 389 & MPI_COMM_WORLD,code) 250 390 CASE(3) 391 251 392 Call Agrif_Send_3Darray(tempC%var%array3, 252 393 & lbound(tempC%var%array3),imin(:,k),imax(:,k),k) … … 529 670 530 671 End Subroutine ExchangeSamelevel 531 672 673 Subroutine ExchangeSameLevel_first(sendtoproc,nbdim,imin,imax, 674 & recvfromproc,imin_recv,imax_recv) 675 Implicit None 676 INTEGER :: nbdim 677 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax 678 INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp 679 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv 680 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc 681 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc 682 LOGICAL :: res 683 684 #include "mpif.h" 685 INTEGER :: i,k 686 INTEGER :: etiquette = 100 687 INTEGER :: code, datasize 688 INTEGER,DIMENSION(MPI_STATUS_SIZE) :: statut 689 690 691 do k = 0,Agrif_ProcRank-1 692 C 693 C 694 Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 695 & MPI_COMM_WORLD,code) 696 C 697 if (sendtoproc(k)) then 698 C 699 iminmax_temp(:,1,k) = imin(:,k) 700 iminmax_temp(:,2,k) = imax(:,k) 701 702 Call MPI_SEND(iminmax_temp(:,:,k), 703 & 2*nbdim,MPI_INTEGER,k,etiquette, 704 & MPI_COMM_WORLD,code) 705 C 706 endif 707 708 C 709 enddo 710 C 711 C 712 C Reception from others processors of the necessary part of the parent grid 713 do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 714 C 715 C 716 Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 717 & MPI_COMM_WORLD,statut,code) 718 C 719 recvfromproc(k) = res 720 721 C 722 if (recvfromproc(k)) then 723 C 724 Call MPI_RECV(iminmax_temp(:,:,k), 725 & 2*nbdim,MPI_INTEGER,k,etiquette, 726 & MPI_COMM_WORLD,statut,code) 727 728 imin_recv(:,k) = iminmax_temp(:,1,k) 729 imax_recv(:,k) = iminmax_temp(:,2,k) 730 endif 731 732 C 733 enddo 734 735 C Reception from others processors of the necessary part of the parent grid 736 do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 737 C 738 C 739 740 Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 741 & MPI_COMM_WORLD,code) 742 C 743 if (sendtoproc(k)) then 744 C 745 iminmax_temp(:,1,k) = imin(:,k) 746 iminmax_temp(:,2,k) = imax(:,k) 747 748 Call MPI_SEND(iminmax_temp(:,:,k), 749 & 2*nbdim,MPI_INTEGER,k,etiquette, 750 & MPI_COMM_WORLD,code) 751 C 752 endif 753 754 C 755 enddo 756 C 757 C 758 C Reception from others processors of the necessary part of the parent grid 759 do k = Agrif_ProcRank-1,0,-1 760 C 761 C 762 Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 763 & MPI_COMM_WORLD,statut,code) 764 C 765 recvfromproc(k) = res 766 767 C 768 if (recvfromproc(k)) then 769 C 770 Call MPI_RECV(iminmax_temp(:,:,k), 771 & 2*nbdim,MPI_INTEGER,k,etiquette, 772 & MPI_COMM_WORLD,statut,code) 773 774 imin_recv(:,k) = iminmax_temp(:,1,k) 775 imax_recv(:,k) = iminmax_temp(:,2,k) 776 endif 777 778 C 779 enddo 780 781 End Subroutine ExchangeSamelevel_first 782 783 Subroutine ExchangeSameLevel2(sendtoproc,recvfromproc, 784 & nbdim, 785 & pttruetabwhole,cetruetabwhole,imin,imax, 786 & imin_recv,imax_recv,memberout,tempC,tempCextend) 787 Implicit None 788 INTEGER :: nbdim 789 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax 790 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: pttruetabwhole, 791 & cetruetabwhole 792 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv 793 TYPE(Agrif_PVARIABLE) :: tempC,tempCextend 794 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc 795 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc 796 LOGICAL :: res 797 LOGICAL :: memberout 798 TYPE(AGRIF_PVARIABLE), SAVE :: temprecv 799 800 #include "mpif.h" 801 INTEGER :: i,k 802 INTEGER :: etiquette = 100 803 INTEGER :: code, datasize 804 INTEGER,DIMENSION(MPI_STATUS_SIZE) :: statut 805 806 IF (memberout) THEN 807 Call Agrif_nbdim_allocation(tempCextend%var, 808 & pttruetabwhole(:,Agrif_ProcRank), 809 & cetruetabwhole(:,Agrif_ProcRank),nbdim) 810 call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim) 811 ENDIF 812 813 IF (sendtoproc(Agrif_ProcRank)) THEN 814 Call Agrif_nbdim_VarEQvar(tempCextend%var, 815 & imin(:,Agrif_Procrank), 816 & imax(:,Agrif_Procrank), 817 & tempC%var, 818 & imin(:,Agrif_Procrank), 819 & imax(:,Agrif_Procrank), 820 & nbdim) 821 ENDIF 822 823 do k = 0,Agrif_ProcRank-1 824 C 825 C 826 C 827 if (sendtoproc(k)) then 828 C 829 datasize = 1 830 C 831 !CDIR SHORTLOOP 832 do i = 1,nbdim 833 C 834 datasize = datasize * (imax(i,k)-imin(i,k)+1) 835 C 836 enddo 837 C 838 839 SELECT CASE(nbdim) 840 CASE(1) 841 Call MPI_SEND(tempC%var%array1( 842 & imin(1,k):imax(1,k)), 843 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 844 & MPI_COMM_WORLD,code) 845 CASE(2) 846 Call MPI_SEND(tempC%var%array2( 847 & imin(1,k):imax(1,k), 848 & imin(2,k):imax(2,k)), 849 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 850 & MPI_COMM_WORLD,code) 851 CASE(3) 852 853 Call Agrif_Send_3Darray(tempC%var%array3, 854 & lbound(tempC%var%array3),imin(:,k),imax(:,k),k) 855 CASE(4) 856 Call MPI_SEND(tempC%var%array4( 857 & imin(1,k):imax(1,k), 858 & imin(2,k):imax(2,k), 859 & imin(3,k):imax(3,k), 860 & imin(4,k):imax(4,k)), 861 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 862 & MPI_COMM_WORLD,code) 863 CASE(5) 864 Call MPI_SEND(tempC%var%array5( 865 & imin(1,k):imax(1,k), 866 & imin(2,k):imax(2,k), 867 & imin(3,k):imax(3,k), 868 & imin(4,k):imax(4,k), 869 & imin(5,k):imax(5,k)), 870 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 871 & MPI_COMM_WORLD,code) 872 CASE(6) 873 Call MPI_SEND(tempC%var%array6( 874 & imin(1,k):imax(1,k), 875 & imin(2,k):imax(2,k), 876 & imin(3,k):imax(3,k), 877 & imin(4,k):imax(4,k), 878 & imin(5,k):imax(5,k), 879 & imin(6,k):imax(6,k)), 880 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 881 & MPI_COMM_WORLD,code) 882 END SELECT 883 C 884 endif 885 886 C 887 enddo 888 C 889 C 890 C Reception from others processors of the necessary part of the parent grid 891 do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 892 893 C 894 if (recvfromproc(k)) then 895 896 datasize = 1 897 C 898 !CDIR SHORTLOOP 899 do i = 1,nbdim 900 C 901 datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1) 902 C 903 enddo 904 905 IF (.Not.Associated(temprecv%var)) allocate(temprecv%var) 906 call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k), 907 & imax_recv(:,k),nbdim) 908 SELECT CASE(nbdim) 909 CASE(1) 910 Call MPI_RECV(temprecv%var%array1, 911 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 912 & MPI_COMM_WORLD,statut,code) 913 CASE(2) 914 Call MPI_RECV(temprecv%var%array2, 915 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 916 & MPI_COMM_WORLD,statut,code) 917 CASE(3) 918 Call MPI_RECV(temprecv%var%array3, 919 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 920 & MPI_COMM_WORLD,statut,code) 921 922 CASE(4) 923 Call MPI_RECV(temprecv%var%array4, 924 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 925 & MPI_COMM_WORLD,statut,code) 926 CASE(5) 927 Call MPI_RECV(temprecv%var%array5, 928 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 929 & MPI_COMM_WORLD,statut,code) 930 CASE(6) 931 Call MPI_RECV(temprecv%var%array6, 932 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 933 & MPI_COMM_WORLD,statut,code) 934 END SELECT 935 936 Call where_valtabtotab_mpi(tempCextend%var, 937 & temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim) 938 939 Call Agrif_nbdim_deallocation(temprecv%var,nbdim) 940 C deallocate(temprecv%var) 941 942 endif 943 944 C 945 enddo 946 947 C Reception from others processors of the necessary part of the parent grid 948 do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 949 C 950 C 951 if (sendtoproc(k)) then 952 C 953 SELECT CASE(nbdim) 954 CASE(1) 955 datasize=SIZE(tempC%var%array1( 956 & imin(1,k):imax(1,k))) 957 Call MPI_SEND(tempC%var%array1( 958 & imin(1,k):imax(1,k)), 959 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 960 & MPI_COMM_WORLD,code) 961 CASE(2) 962 datasize=SIZE(tempC%var%array2( 963 & imin(1,k):imax(1,k), 964 & imin(2,k):imax(2,k))) 965 Call MPI_SEND(tempC%var%array2( 966 & imin(1,k):imax(1,k), 967 & imin(2,k):imax(2,k)), 968 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 969 & MPI_COMM_WORLD,code) 970 CASE(3) 971 datasize=SIZE(tempC%var%array3( 972 & imin(1,k):imax(1,k), 973 & imin(2,k):imax(2,k), 974 & imin(3,k):imax(3,k))) 975 Call MPI_SEND(tempC%var%array3( 976 & imin(1,k):imax(1,k), 977 & imin(2,k):imax(2,k), 978 & imin(3,k):imax(3,k)), 979 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 980 & MPI_COMM_WORLD,code) 981 CASE(4) 982 datasize=SIZE(tempC%var%array4( 983 & imin(1,k):imax(1,k), 984 & imin(2,k):imax(2,k), 985 & imin(3,k):imax(3,k), 986 & imin(4,k):imax(4,k))) 987 Call MPI_SEND(tempC%var%array4( 988 & imin(1,k):imax(1,k), 989 & imin(2,k):imax(2,k), 990 & imin(3,k):imax(3,k), 991 & imin(4,k):imax(4,k)), 992 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 993 & MPI_COMM_WORLD,code) 994 CASE(5) 995 datasize=SIZE(tempC%var%array5( 996 & imin(1,k):imax(1,k), 997 & imin(2,k):imax(2,k), 998 & imin(3,k):imax(3,k), 999 & imin(4,k):imax(4,k), 1000 & imin(5,k):imax(5,k))) 1001 Call MPI_SEND(tempC%var%array5( 1002 & imin(1,k):imax(1,k), 1003 & imin(2,k):imax(2,k), 1004 & imin(3,k):imax(3,k), 1005 & imin(4,k):imax(4,k), 1006 & imin(5,k):imax(5,k)), 1007 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1008 & MPI_COMM_WORLD,code) 1009 CASE(6) 1010 datasize=SIZE(tempC%var%array6( 1011 & imin(1,k):imax(1,k), 1012 & imin(2,k):imax(2,k), 1013 & imin(3,k):imax(3,k), 1014 & imin(4,k):imax(4,k), 1015 & imin(5,k):imax(5,k), 1016 & imin(6,k):imax(6,k))) 1017 Call MPI_SEND(tempC%var%array6( 1018 & imin(1,k):imax(1,k), 1019 & imin(2,k):imax(2,k), 1020 & imin(3,k):imax(3,k), 1021 & imin(4,k):imax(4,k), 1022 & imin(5,k):imax(5,k), 1023 & imin(6,k):imax(6,k)), 1024 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1025 & MPI_COMM_WORLD,code) 1026 END SELECT 1027 C 1028 endif 1029 1030 C 1031 enddo 1032 C 1033 C 1034 C Reception from others processors of the necessary part of the parent grid 1035 do k = Agrif_ProcRank-1,0,-1 1036 C 1037 1038 C 1039 if (recvfromproc(k)) then 1040 C 1041 IF (.Not.Associated(temprecv%var)) allocate(temprecv%var) 1042 call Agrif_nbdim_allocation(temprecv%var, 1043 & imin_recv(:,k),imax_recv(:,k),nbdim) 1044 SELECT CASE(nbdim) 1045 CASE(1) 1046 datasize=SIZE(temprecv%var%array1) 1047 Call MPI_RECV(temprecv%var%array1, 1048 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1049 & MPI_COMM_WORLD,statut,code) 1050 CASE(2) 1051 datasize=SIZE(temprecv%var%array2) 1052 Call MPI_RECV(temprecv%var%array2, 1053 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1054 & MPI_COMM_WORLD,statut,code) 1055 CASE(3) 1056 datasize=SIZE(temprecv%var%array3) 1057 Call MPI_RECV(temprecv%var%array3, 1058 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1059 & MPI_COMM_WORLD,statut,code) 1060 1061 CASE(4) 1062 datasize=SIZE(temprecv%var%array4) 1063 Call MPI_RECV(temprecv%var%array4, 1064 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1065 & MPI_COMM_WORLD,statut,code) 1066 CASE(5) 1067 datasize=SIZE(temprecv%var%array5) 1068 Call MPI_RECV(temprecv%var%array5, 1069 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1070 & MPI_COMM_WORLD,statut,code) 1071 CASE(6) 1072 datasize=SIZE(temprecv%var%array6) 1073 Call MPI_RECV(temprecv%var%array6, 1074 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1075 & MPI_COMM_WORLD,statut,code) 1076 END SELECT 1077 1078 Call where_valtabtotab_mpi(tempCextend%var, 1079 & temprecv%var,imin_recv(:,k),imax_recv(:,k) 1080 & ,0.,nbdim) 1081 1082 Call Agrif_nbdim_deallocation(temprecv%var,nbdim) 1083 C deallocate(temprecv%var) 1084 endif 1085 1086 C 1087 enddo 1088 1089 End Subroutine ExchangeSamelevel2 1090 532 1091 Subroutine Agrif_Send_3Darray(tab3D,bounds,imin,imax,k) 533 1092 integer, dimension(3) :: bounds, imin, imax -
trunk/AGRIF/AGRIF_FILES/modtypes.F
r774 r898 267 267 INTEGER,DIMENSION(:,:,:), POINTER :: tab5t 268 268 LOGICAL, DIMENSION(:), POINTER :: memberinall2 269 LOGICAL, DIMENSION(:), POINTER :: sendtoproc1 270 LOGICAL, DIMENSION(:), POINTER :: recvfromproc1 271 LOGICAL, DIMENSION(:), POINTER :: sendtoproc2 272 LOGICAL, DIMENSION(:), POINTER :: recvfromproc2 269 273 #endif 270 274 End Type Agrif_Interp_Loc -
trunk/AGRIF/AGRIF_FILES/modupdate.F
r779 r898 1101 1101 C 1102 1102 INTEGER,DIMENSION(nbdim) :: indminglob2,indmaxglob2 1103 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 1104 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2 1103 1105 INTEGER :: code 1104 1106 INTEGER :: i,j,k 1105 1107 INTEGER,DIMENSION(nbdim,4) :: tab3 1106 1108 INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4 1107 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t, tab5t 1109 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 1110 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t 1108 1111 LOGICAL :: find_list_update 1109 1112 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2 … … 1251 1254 Call Agrif_Find_list_update(child%var%list_update,pttab,petab, 1252 1255 & pttab_Child,pttab_Parent,nbdim, 1253 & find_list_update,tab4t,tab5t,memberinall,memberinall2) 1256 & find_list_update,tab4t,tab5t,memberinall,memberinall2, 1257 & sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 1254 1258 ELSE 1255 1259 find_list_update = .FALSE. … … 1278 1282 CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 1279 1283 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 1280 1281 endif 1282 1283 Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1), 1284 1285 Call Get_External_Data_first(tab4t(:,:,1), 1284 1286 & tab4t(:,:,2), 1285 1287 & tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin, 1286 & memberinall) 1288 & memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5), 1289 & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8)) 1290 1291 endif 1292 1293 Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim, 1294 & tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6), 1295 & tab4t(:,:,7),tab4t(:,:,8),memberin,tempC, 1296 & tempCextend) 1297 1298 ! Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1), 1299 ! & tab4t(:,:,2), 1300 ! & tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin, 1301 ! & memberinall) 1287 1302 1288 1303 #else … … 1399 1414 CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2, 1400 1415 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 1401 1416 1417 Call Get_External_Data_first(tab5t(:,:,1), 1418 & tab5t(:,:,2), 1419 & tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member, 1420 & memberinall2,sendtoproc2,recvfromproc2,tab5t(:,:,5), 1421 & tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8)) 1422 1402 1423 Call Agrif_Addto_list_update(child%var%list_update,pttab,petab, 1403 1424 & pttab_Child,pttab_Parent,nbdim 1404 & ,tab4t,tab5t,memberinall,memberinall2) 1425 & ,tab4t,tab5t,memberinall,memberinall2, 1426 & sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 1405 1427 1406 1428 endif 1407 1429 1408 Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1), 1409 & tab5t(:,:,2), 1410 & tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member, 1411 & memberinall2) 1430 c Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1), 1431 c & tab5t(:,:,2), 1432 c & tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member, 1433 c & memberinall2) 1434 1435 Call ExchangeSameLevel2(sendtoproc2,recvfromproc2,nbdim, 1436 & tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6), 1437 & tab5t(:,:,7),tab5t(:,:,8),member,tempP, 1438 & tempPextend) 1412 1439 1413 1440 #else … … 2478 2505 Subroutine Agrif_Find_list_update(list_update,pttab,petab, 2479 2506 & pttab_Child,pttab_Parent,nbdim, 2480 & find_list_update,tab4t,tab5t,memberinall,memberinall2) 2507 & find_list_update,tab4t,tab5t,memberinall,memberinall2, 2508 & sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 2481 2509 TYPE(Agrif_List_Interp_Loc), Pointer :: list_update 2482 2510 INTEGER :: nbdim … … 2486 2514 INTEGER :: i 2487 2515 C 2488 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t, tab5t 2516 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 2517 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t 2489 2518 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall,memberinall2 2519 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 2520 LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2 2490 2521 2491 2522 find_list_update = .FALSE. … … 2505 2536 EndDo 2506 2537 2507 tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1: 4)2538 tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8) 2508 2539 memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1) 2509 2540 2510 tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1: 4)2541 tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8) 2511 2542 memberinall2 = 2512 2543 & parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1) 2544 sendtoproc1 = 2545 & parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1) 2546 recvfromproc1 = 2547 & parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1) 2548 sendtoproc2 = 2549 & parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1) 2550 recvfromproc2 = 2551 & parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1) 2513 2552 2514 2553 find_list_update = .TRUE. … … 2520 2559 Subroutine Agrif_AddTo_list_update(list_update,pttab,petab, 2521 2560 & pttab_Child,pttab_Parent,nbdim 2522 & ,tab4t,tab5t,memberinall,memberinall2) 2561 & ,tab4t,tab5t,memberinall,memberinall2, 2562 & sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 2523 2563 2524 2564 TYPE(Agrif_List_Interp_Loc), Pointer :: list_update 2525 2565 INTEGER :: nbdim 2526 2566 INTEGER,DIMENSION(nbdim) :: pttab,petab,pttab_Child,pttab_Parent 2527 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t, tab5t 2567 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 2568 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t 2528 2569 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2 2570 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1 2571 LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2, recvfromproc2 2529 2572 2530 2573 Type(Agrif_List_Interp_loc), Pointer :: parcours … … 2537 2580 parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim) 2538 2581 parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim) 2539 Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1, 4))2582 Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8)) 2540 2583 Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)) 2541 2584 2542 Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1, 4))2585 Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8)) 2543 2586 Allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)) 2587 Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)) 2588 Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)) 2589 Allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)) 2590 Allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)) 2544 2591 2545 2592 parcours%interp_loc%tab4t=tab4t … … 2548 2595 parcours%interp_loc%tab5t=tab5t 2549 2596 parcours%interp_loc%memberinall2=memberinall2 2597 parcours%interp_loc%sendtoproc1=sendtoproc1 2598 parcours%interp_loc%recvfromproc1=recvfromproc1 2599 parcours%interp_loc%sendtoproc2=sendtoproc2 2600 parcours%interp_loc%recvfromproc2=recvfromproc2 2550 2601 2551 2602 parcours%suiv => list_update
Note: See TracChangeset
for help on using the changeset viewer.
