Changeset 898


Ignore:
Timestamp:
2008-04-22T17:35:20+02:00 (13 years ago)
Author:
rblod
Message:

Correct some bugs in agrif optimization and add MPP optimization, see #42

Location:
trunk/AGRIF/AGRIF_FILES
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/AGRIF/AGRIF_FILES/modbc.F

    r779 r898  
    13081308              child%var%oldvalues2d=0. 
    13091309C 
    1310               child % var % oldvalues2d(:,1:SIZE(tempoldvalues,1)) =  
     1310              child % var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) =  
    13111311     &        tempoldvalues(:,:) 
    13121312C 
  • trunk/AGRIF/AGRIF_FILES/modinterp.F

    r779 r898  
    631631      INTEGER,DIMENSION(nbdim,4)           :: tab3 
    632632      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4 
    633       INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t 
     633      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 
    634634      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 
     635      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1       
    635636      LOGICAL, DIMENSION(1) :: memberin1 
    636637C 
     
    650651     &       pttruetab,cetruetab,member,memberin,find_list_interp 
    651652#if defined AGRIF_MPI 
    652      &       ,tab4t,memberinall 
     653     &       ,tab4t,memberinall,sendtoproc1,recvfromproc1 
    653654#endif 
    654655     &    ) 
     
    823824      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 
    824825     &                  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           
    826833      endif      
    827834            
    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) 
    832844#else 
    833845      tempPextend%var => tempP%var 
     
    840852     &   pttruetab,cetruetab,member,memberin,nbdim 
    841853#if defined AGRIF_MPI 
    842      &   ,tab4t,memberinall 
     854     &   ,tab4t,memberinall,sendtoproc1,recvfromproc1 
    843855#endif 
    844856     &    ) 
     
    20482060     &      find_list_interp 
    20492061#if defined AGRIF_MPI 
    2050      &     ,tab4t,memberinall 
     2062     &     ,tab4t,memberinall,sendtoproc1,recvfromproc1 
    20512063#endif 
    20522064     &    )      
     
    20652077#ifdef AGRIF_MPI 
    20662078C 
    2067       INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t 
     2079      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 
    20682080      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 
     2081      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 
    20692082#endif  
    20702083                     
     
    20982111        parentarray = parcours%interp_loc%parentarray(1:nbdim,:,:) 
    20992112        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) 
    21012114        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) 
    21022118#endif         
    21032119        memberin = parcours%interp_loc%memberin 
     
    21152131     &                          member,memberin,nbdim 
    21162132#if defined AGRIF_MPI 
    2117      &      ,tab4t,memberinall 
     2133     &      ,tab4t,memberinall,sendtoproc1,recvfromproc1 
    21182134#endif 
    21192135     &    ) 
     
    21302146#ifdef AGRIF_MPI 
    21312147C 
    2132       INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t 
     2148      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 
    21332149      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 
     2150      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1 
     2151      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc1 
    21342152#endif                    
    21352153      Type(Agrif_List_Interp_loc), Pointer :: parcours 
     
    21572175     &       = parentarray(1:nbdim,:,:) 
    21582176      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)) 
    21602178      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))                   
    21612181      parcours%interp_loc%tab4t=tab4t    
    21622182      parcours%interp_loc%memberinall=memberinall    
     2183      parcours%interp_loc%sendtoproc1=sendtoproc1 
     2184      parcours%interp_loc%recvfromproc1=recvfromproc1             
    21632185#endif       
    21642186 
  • trunk/AGRIF/AGRIF_FILES/modinterpbasic.F

    r779 r898  
    385385      do i = 1,nc 
    386386C 
    387        y(i)=coeffparent(i,dir)*x(indparent(i,dir))+ 
     387       y(i)=coeffparent(i,dir)*x(MAX(indparent(i,dir),1))+ 
    388388     &      (1.-coeffparent(i,dir))*x(indparent(i,dir)+1) 
    389389C 
     
    10651065     &             indparentppm_1d(1:nc) + (i-1)*np 
    10661066       indchildppm (1+(i-1)*nc:i*nc,dir) =  
    1067      &             indchildppm_1d (1:nc) + (i-1)*np 
     1067     &             indchildppm_1d (1:nc)  
    10681068 
    10691069       End do 
  • trunk/AGRIF/AGRIF_FILES/modmpp.F

    r779 r898  
    3131      Contains 
    3232#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       
     59C pttruetab2 and cetruetab2 are modified arraysin order to always 
     60C 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 
     95C 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 
     112C 
     113              pttruetab2(i,Agrif_Procrank) = imintmp 
     114C 
     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 
     133C 
     134              cetruetab2(i,Agrif_Procrank) = imaxtmp 
     135C 
     136          endif 
     137C 
     138 
     139          ENDIF 
     140           enddo 
     141         enddo 
     142 
     143 
     144       do k = 0,Agrif_NbProcs-1 
     145C 
     146        sendtoproc(k) = .true. 
     147C 
     148!CDIR SHORTLOOP 
     149        do i = 1,nbdim 
     150C 
     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)) 
     155C 
     156          if (imin(i,k) > imax(i,k)) then 
     157C 
     158              sendtoproc(k) = .false. 
     159C 
     160          endif 
     161C 
     162        enddo 
     163        IF (.NOT.memberoutall(k)) THEN 
     164           sendtoproc(k) = .FALSE. 
     165        ENDIF 
     166C 
     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 
    33173C 
    34174      Subroutine Get_External_Data(tempC,tempCextend,pttruetab, 
     
    249389     &                        MPI_COMM_WORLD,code) 
    250390                CASE(3) 
     391                 
    251392                  Call Agrif_Send_3Darray(tempC%var%array3, 
    252393     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k) 
     
    529670 
    530671          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 
     692C 
     693C 
     694            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 
     695     &                    MPI_COMM_WORLD,code) 
     696C 
     697            if (sendtoproc(k)) then 
     698C 
     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) 
     705C 
     706            endif 
     707 
     708C 
     709      enddo 
     710C 
     711C 
     712C     Reception from others processors of the necessary part of the parent grid 
     713      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 
     714C 
     715C 
     716            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 
     717     &                    MPI_COMM_WORLD,statut,code) 
     718C 
     719            recvfromproc(k) = res 
     720 
     721C 
     722            if (recvfromproc(k)) then 
     723C 
     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 
     732C 
     733      enddo 
     734 
     735C     Reception from others processors of the necessary part of the parent grid 
     736      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 
     737C 
     738C 
     739             
     740            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 
     741     &                    MPI_COMM_WORLD,code) 
     742C 
     743            if (sendtoproc(k)) then 
     744C 
     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) 
     751C 
     752            endif 
     753 
     754C 
     755      enddo 
     756C 
     757C 
     758C     Reception from others processors of the necessary part of the parent grid 
     759      do k = Agrif_ProcRank-1,0,-1 
     760C 
     761C 
     762            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 
     763     &                    MPI_COMM_WORLD,statut,code) 
     764C 
     765            recvfromproc(k) = res 
     766 
     767C 
     768            if (recvfromproc(k)) then 
     769C 
     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 
     778C 
     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 
     824C 
     825C 
     826C 
     827            if (sendtoproc(k)) then 
     828C 
     829                datasize = 1 
     830C 
     831!CDIR SHORTLOOP 
     832                do i = 1,nbdim 
     833C 
     834                  datasize = datasize * (imax(i,k)-imin(i,k)+1) 
     835C 
     836                enddo 
     837C 
     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 
     883C 
     884            endif 
     885 
     886C 
     887      enddo 
     888C 
     889C 
     890C     Reception from others processors of the necessary part of the parent grid 
     891      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 
     892 
     893C 
     894            if (recvfromproc(k)) then 
     895 
     896                datasize = 1 
     897C 
     898!CDIR SHORTLOOP 
     899                do i = 1,nbdim 
     900C 
     901                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1) 
     902C 
     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) 
     940C                deallocate(temprecv%var) 
     941 
     942            endif 
     943 
     944C 
     945      enddo 
     946 
     947C     Reception from others processors of the necessary part of the parent grid 
     948      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 
     949C 
     950C 
     951            if (sendtoproc(k)) then 
     952C 
     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 
     1027C 
     1028            endif 
     1029 
     1030C 
     1031      enddo 
     1032C 
     1033C 
     1034C     Reception from others processors of the necessary part of the parent grid 
     1035      do k = Agrif_ProcRank-1,0,-1 
     1036C 
     1037 
     1038C 
     1039            if (recvfromproc(k)) then 
     1040C 
     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) 
     1083C                deallocate(temprecv%var) 
     1084            endif 
     1085 
     1086C 
     1087      enddo 
     1088                   
     1089          End Subroutine ExchangeSamelevel2 
     1090           
    5321091          Subroutine Agrif_Send_3Darray(tab3D,bounds,imin,imax,k) 
    5331092          integer, dimension(3) :: bounds, imin, imax 
  • trunk/AGRIF/AGRIF_FILES/modtypes.F

    r774 r898  
    267267      INTEGER,DIMENSION(:,:,:), POINTER :: tab5t 
    268268      LOGICAL, DIMENSION(:), POINTER :: memberinall2 
     269      LOGICAL, DIMENSION(:), POINTER :: sendtoproc1     
     270      LOGICAL, DIMENSION(:), POINTER :: recvfromproc1       
     271      LOGICAL, DIMENSION(:), POINTER :: sendtoproc2       
     272      LOGICAL, DIMENSION(:), POINTER :: recvfromproc2       
    269273#endif       
    270274      End Type Agrif_Interp_Loc 
  • trunk/AGRIF/AGRIF_FILES/modupdate.F

    r779 r898  
    11011101C 
    11021102      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2 
     1103      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 
     1104      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2       
    11031105      INTEGER                              :: code 
    11041106      INTEGER                              :: i,j,k 
    11051107      INTEGER,DIMENSION(nbdim,4)           :: tab3 
    11061108      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       
    11081111      LOGICAL :: find_list_update 
    11091112      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2 
     
    12511254      Call Agrif_Find_list_update(child%var%list_update,pttab,petab, 
    12521255     &                          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) 
    12541258      ELSE 
    12551259      find_list_update = .FALSE. 
     
    12781282      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 
    12791283     &                  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), 
    12841286     &            tab4t(:,:,2), 
    12851287     &            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) 
    12871302 
    12881303#else 
     
    13991414      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2, 
    14001415     &                  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           
    14021423      Call Agrif_Addto_list_update(child%var%list_update,pttab,petab, 
    14031424     &                          pttab_Child,pttab_Parent,nbdim 
    1404      &   ,tab4t,tab5t,memberinall,memberinall2)  
     1425     &   ,tab4t,tab5t,memberinall,memberinall2, 
     1426     &   sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)  
    14051427           
    14061428      endif 
    14071429       
    1408       Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1), 
    1409      &            tab5t(:,:,2), 
    1410      &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member, 
    1411      &            memberinall2) 
     1430c      Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1), 
     1431c     &            tab5t(:,:,2), 
     1432c     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member, 
     1433c     &            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)      
    14121439 
    14131440#else 
     
    24782505      Subroutine Agrif_Find_list_update(list_update,pttab,petab, 
    24792506     &                          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)      
    24812509      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update 
    24822510      INTEGER :: nbdim 
     
    24862514      INTEGER :: i 
    24872515C 
    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       
    24892518      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       
    24902521                     
    24912522      find_list_update = .FALSE. 
     
    25052536        EndDo 
    25062537         
    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) 
    25082539        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1) 
    25092540         
    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) 
    25112542        memberinall2 =  
    25122543     &       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)           
    25132552         
    25142553        find_list_update = .TRUE.    
     
    25202559      Subroutine Agrif_AddTo_list_update(list_update,pttab,petab, 
    25212560     &                          pttab_Child,pttab_Parent,nbdim 
    2522      &      ,tab4t,tab5t,memberinall,memberinall2) 
     2561     &      ,tab4t,tab5t,memberinall,memberinall2, 
     2562     &      sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 
    25232563           
    25242564      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update 
    25252565      INTEGER :: nbdim 
    25262566      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       
    25282569      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 
    25292572 
    25302573      Type(Agrif_List_Interp_loc), Pointer :: parcours 
     
    25372580      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim) 
    25382581      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)) 
    25402583      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)) 
    25412584       
    2542       Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,4)) 
     2585      Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8)) 
    25432586      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))             
    25442591             
    25452592      parcours%interp_loc%tab4t=tab4t    
     
    25482595      parcours%interp_loc%tab5t=tab5t    
    25492596      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       
    25502601             
    25512602      parcours%suiv => list_update 
Note: See TracChangeset for help on using the changeset viewer.