Ignore:
Timestamp:
12/27/14 00:26:52 (9 years ago)
Author:
ymipsl
Message:

Solve the start/restart issue.

YM

Location:
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/restart.f90

    r314 r316  
    201201    ENDIF 
    202202!$OMP END MASTER 
     203!$OMP BARRIER 
    203204   
    204205  END SUBROUTINE write_restart 
    … …  
    399400    CALL getin("start_file_name",start_file_name) 
    400401 
     402!$OMP BARRIER 
    401403!$OMP MASTER 
    402404 
    … …  
    427429    IF (is_mpi_root) THEN 
    428430      status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid) 
    429     ENDIF 
    430     
    431     DO nf=1,nfield 
    432       field=>field_array(nf)%field 
    433       status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf)) 
    434431      status = nf90_inq_varid(ncid, "iteration",itid) 
    435432      IF (status==NF90_NOERR) THEN  
    … …  
    438435        status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it) 
    439436      ENDIF 
     437    ENDIF 
     438     
     439    DO nf=1,nfield 
     440      field=>field_array(nf)%field 
     441       IF (is_mpi_root) status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf)) 
    440442      CALL read_start_field(field,fieldId(nf),ncid) 
    441443    ENDDO 
    … …  
    446448    ENDIF 
    447449!$OMP END MASTER 
     450!$OMP BARRIER 
    448451   
    449452  END SUBROUTINE read_start 
    … …  
    468471    TYPE(t_field),POINTER :: field_glo(:) 
    469472    REAL(rstd),ALLOCATABLE :: global_field2d(:) 
    470     REAL(rstd),ALLOCATABLE :: global_field3d(:,:) 
    471     REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:) 
    472     INTEGER :: i,j,ij,k,e,ind,ind_glo 
     473    REAL(rstd),ALLOCATABLE :: global_field3d(:) 
     474    REAL(rstd),ALLOCATABLE :: global_field4d(:) 
     475    INTEGER :: i,j,l,q,ij,k,e,ind,ind_glo 
    473476    INTEGER :: ndim, field_type 
    474477    INTEGER :: status 
    … …  
    506509           
    507510          ELSE IF (ndim==3) THEN 
    508             ALLOCATE(global_field3d(ncell_glo,llm)) 
    509             status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /)) 
    510             DO ind=1,ndomain_glo 
    511               d=>domain_glo(ind) 
    512               DO j=d%jj_begin,d%jj_end 
    513                 DO i=d%ii_begin,d%ii_end 
    514                   ij=(j-1)*d%iim+i 
    515                   ind_glo=d%assign_cell_glo(i,j) 
    516                   field_glo(ind)%rval3d(ij,:) = global_field3d(ind_glo,:) 
     511 
     512            ALLOCATE(global_field3d(ncell_glo)) 
     513        
     514            DO l=1,llm 
     515              status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,l /),count=(/ ncell_glo,1 /)) 
     516              DO ind=1,ndomain_glo 
     517                d=>domain_glo(ind) 
     518                DO j=d%jj_begin,d%jj_end 
     519                 DO i=d%ii_begin,d%ii_end 
     520                    ij=(j-1)*d%iim+i 
     521                    ind_glo=d%assign_cell_glo(i,j) 
     522                    field_glo(ind)%rval3d(ij,l) = global_field3d(ind_glo) 
     523                  ENDDO 
    517524                ENDDO 
    518525              ENDDO 
    519526            ENDDO 
    520527          ELSE IF (ndim==4) THEN 
    521             ALLOCATE(global_field4d(ncell_glo,llm,nqtot)) 
    522             status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /)) 
    523             DO ind=1,ndomain_glo 
    524               d=>domain_glo(ind) 
    525               DO j=d%jj_begin,d%jj_end 
    526                 DO i=d%ii_begin,d%ii_end 
    527                   ij=(j-1)*d%iim+i 
    528                   ind_glo=d%assign_cell_glo(i,j) 
    529                   field_glo(ind)%rval4d(ij,:,:) = global_field4d(ind_glo,:,:) 
     528            ALLOCATE(global_field4d(ncell_glo)) 
     529             
     530            DO q=1,nqtot 
     531              DO l=1,llm          
     532                status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,l,q /),count=(/ ncell_glo,1,1 /)) 
     533                  DO ind=1,ndomain_glo 
     534                    d=>domain_glo(ind) 
     535                    DO j=d%jj_begin,d%jj_end 
     536                      DO i=d%ii_begin,d%ii_end 
     537                        ij=(j-1)*d%iim+i 
     538                        ind_glo=d%assign_cell_glo(i,j) 
     539                        field_glo(ind)%rval4d(ij,l,q) = global_field4d(ind_glo) 
     540                      ENDDO 
     541                    ENDDO 
    530542                ENDDO 
    531543              ENDDO 
    … …  
    553565            ENDDO 
    554566          ELSE IF (ndim==3) THEN 
    555             ALLOCATE(global_field3d(3*ncell_glo,llm)) 
    556             status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /)) 
    557             DO ind=1,ndomain_glo 
    558               d=>domain_glo(ind) 
    559               DO j=d%jj_begin,d%jj_end 
    560                 DO i=d%ii_begin,d%ii_end 
    561                   DO k=0,5 
    562                     ij=(j-1)*d%iim+i 
    563                     ind_glo=d%assign_cell_glo(i,j) 
    564                     e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))   
    565                     field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)=global_field3d(e,:)*d%edge_assign_sign(k,i,j) 
     567           
     568            ALLOCATE(global_field3d(3*ncell_glo)) 
     569            DO l=1,llm 
     570              status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,l /),count=(/ 3*ncell_glo,1 /)) 
     571              DO ind=1,ndomain_glo 
     572                d=>domain_glo(ind) 
     573                DO j=d%jj_begin,d%jj_end 
     574                  DO i=d%ii_begin,d%ii_end 
     575                    DO k=0,5 
     576                      ij=(j-1)*d%iim+i 
     577                      ind_glo=d%assign_cell_glo(i,j) 
     578                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))   
     579                      field_glo(ind)%rval3d(ij+d%u_pos(k+1),l)=global_field3d(e)*d%edge_assign_sign(k,i,j) 
     580                    ENDDO 
    566581                  ENDDO 
    567582                ENDDO 
    … …  
    569584            ENDDO 
    570585          ELSE IF (ndim==4) THEN 
    571             ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot)) 
    572             status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /)) 
    573             DO ind=1,ndomain_glo 
    574               d=>domain_glo(ind) 
    575               DO j=d%jj_begin,d%jj_end 
    576                 DO i=d%ii_begin,d%ii_end 
    577                   DO k=0,5 
    578                     ij=(j-1)*d%iim+i 
    579                     ind_glo=d%assign_cell_glo(i,j) 
    580                     e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))   
    581                     field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)=global_field4d(e,:,:)*d%edge_assign_sign(k,i,j) 
    582                   ENDDO 
    583                 ENDDO 
     586 
     587            ALLOCATE(global_field4d(3*ncell_glo)) 
     588            DO q=1,nqtot 
     589              DO l=1,llm 
     590               status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,l,q /),count=(/ 3*ncell_glo,1,1 /)) 
     591               DO ind=1,ndomain_glo 
     592                 d=>domain_glo(ind) 
     593                 DO j=d%jj_begin,d%jj_end 
     594                   DO i=d%ii_begin,d%ii_end 
     595                     DO k=0,5 
     596                       ij=(j-1)*d%iim+i 
     597                       ind_glo=d%assign_cell_glo(i,j) 
     598                       e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))   
     599                       field_glo(ind)%rval4d(ij+d%u_pos(k+1),l,q)=global_field4d(e)*d%edge_assign_sign(k,i,j) 
     600                     ENDDO 
     601                   ENDDO 
     602                 ENDDO 
     603               ENDDO 
    584604              ENDDO 
    585605            ENDDO 

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/transfert_mpi.f90

    r287 r316  
    15961596    INTEGER :: ireq,nreq 
    15971597    INTEGER :: ind_glo,ind_loc     
     1598    TYPE t_field_tmp 
     1599      REAL,POINTER :: rval2d(:) 
     1600      REAL,POINTER :: rval3d(:,:) 
     1601      REAL,POINTER :: rval4d(:,:,:) 
     1602    END TYPE t_field_tmp 
     1603       
     1604    TYPE(t_field_tmp),ALLOCATABLE :: field_tmp(:) 
     1605    TYPE(t_field_tmp),ALLOCATABLE :: field_tmp2(:) 
     1606 
     1607 
    15981608   
    15991609    IF (.NOT. using_mpi) THEN 
    … …  
    16151625      ireq=0 
    16161626      IF (mpi_rank==0) THEN 
     1627        ALLOCATE(field_tmp(ndomain_glo)) 
    16171628        DO ind_glo=1,ndomain_glo 
    16181629          ireq=ireq+1 
    16191630 
    16201631          IF (field_glo(ind_glo)%ndim==2) THEN 
    1621             CALL MPI_IRECV(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   & 
     1632            ALLOCATE(field_tmp(ind_glo)%rval2d(size(field_glo(ind_glo)%rval2d,1))) 
     1633            CALL MPI_IRECV(field_tmp(ind_glo)%rval2d(1),size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   & 
    16221634                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    16231635    
    16241636          ELSE IF (field_glo(ind_glo)%ndim==3) THEN 
    1625             CALL MPI_IRECV(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   & 
     1637            ALLOCATE(field_tmp(ind_glo)%rval3d(size(field_glo(ind_glo)%rval3d,1),size(field_glo(ind_glo)%rval3d,2))) 
     1638            CALL MPI_IRECV(field_tmp(ind_glo)%rval3d(1,1),size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   & 
    16261639                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    16271640 
    16281641          ELSE IF (field_glo(ind_glo)%ndim==4) THEN 
    1629             CALL MPI_IRECV(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   & 
     1642            ALLOCATE(field_tmp(ind_glo)%rval4d(size(field_glo(ind_glo)%rval4d,1),size(field_glo(ind_glo)%rval4d,2), & 
     1643                                             size(field_glo(ind_glo)%rval4d,3))) 
     1644            CALL MPI_IRECV(field_tmp(ind_glo)%rval4d(1,1,1),size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   & 
    16301645                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
    16311646          ENDIF 
    … …  
    16331648        ENDDO 
    16341649      ENDIF 
     1650 
     1651      ALLOCATE(field_tmp2(ndomain)) 
    16351652   
    16361653      DO ind_loc=1,ndomain 
    … …  
    16381655 
    16391656        IF (field_loc(ind_loc)%ndim==2) THEN 
    1640           CALL MPI_ISEND(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   & 
     1657          ALLOCATE(field_tmp2(ind_loc)%rval2d(size(field_loc(ind_loc)%rval2d,1))) 
     1658          field_tmp2(ind_loc)%rval2d=field_loc(ind_loc)%rval2d 
     1659          CALL MPI_ISEND(field_tmp2(ind_loc)%rval2d(1),size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   & 
    16411660                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    16421661        ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
    1643           CALL MPI_ISEND(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   & 
     1662          ALLOCATE(field_tmp2(ind_loc)%rval3d(size(field_loc(ind_loc)%rval3d,1),size(field_loc(ind_loc)%rval3d,2))) 
     1663          field_tmp2(ind_loc)%rval3d=field_loc(ind_loc)%rval3d 
     1664          CALL MPI_ISEND(field_tmp2(ind_loc)%rval3d(1,1),size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   & 
    16441665                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    16451666        ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
    1646           CALL MPI_ISEND(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   & 
     1667            ALLOCATE(field_tmp2(ind_loc)%rval4d(size(field_loc(ind_loc)%rval4d,1),size(field_loc(ind_loc)%rval4d,2), & 
     1668                                               size(field_loc(ind_loc)%rval4d,3))) 
     1669          field_tmp2(ind_loc)%rval4d=field_loc(ind_loc)%rval4d 
     1670          CALL MPI_ISEND(field_tmp2(ind_loc)%rval4d(1,1,1),size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   & 
    16471671                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    16481672        ENDIF 
    … …  
    16511675    
    16521676      CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
     1677 
     1678        DO ind_loc=1,ndomain 
     1679          IF (field_loc(ind_loc)%ndim==2) THEN 
     1680            DEALLOCATE(field_tmp2(ind_loc)%rval2d) 
     1681          ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
     1682            DEALLOCATE(field_tmp2(ind_loc)%rval3d) 
     1683          ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
     1684            DEALLOCATE(field_tmp2(ind_loc)%rval4d) 
     1685          ENDIF 
     1686        ENDDO 
     1687 
     1688      IF (mpi_rank==0) THEN 
     1689     
     1690        DO ind_glo=1,ndomain_glo 
     1691          IF (field_glo(ind_glo)%ndim==2) THEN 
     1692            field_glo(ind_glo)%rval2d=field_tmp(ind_glo)%rval2d 
     1693            DEALLOCATE(field_tmp(ind_glo)%rval2d) 
     1694          ELSE IF (field_glo(ind_glo)%ndim==3) THEN 
     1695            field_glo(ind_glo)%rval3d=field_tmp(ind_glo)%rval3d 
     1696            DEALLOCATE(field_tmp(ind_glo)%rval3d) 
     1697          ELSE IF (field_glo(ind_glo)%ndim==4) THEN 
     1698            field_glo(ind_glo)%rval4d=field_tmp(ind_glo)%rval4d 
     1699            DEALLOCATE(field_tmp(ind_glo)%rval4d) 
     1700          ENDIF 
     1701        ENDDO 
     1702       
     1703      ENDIF 
    16531704 
    16541705    ENDIF 
    … …  
    16671718    INTEGER, ALLOCATABLE :: mpi_req(:) 
    16681719    INTEGER, ALLOCATABLE :: status(:,:) 
    1669     INTEGER :: ireq,nreq 
     1720    INTEGER :: ireq,nreq, root_request 
    16701721    INTEGER :: ind_glo,ind_loc     
    1671    
     1722    INTEGER :: recv_size(ndomain) 
     1723    LOGICAL :: index 
     1724    INTEGER ::root_status(MPI_STATUS_SIZE) 
     1725    TYPE t_field_tmp 
     1726      REAL,POINTER :: rval2d(:) 
     1727      REAL,POINTER :: rval3d(:,:) 
     1728      REAL,POINTER :: rval4d(:,:,:) 
     1729    END TYPE t_field_tmp 
     1730       
     1731    TYPE(t_field_tmp),ALLOCATABLE :: field_tmp(:) 
     1732      
    16721733    IF (.NOT. using_mpi) THEN 
    16731734     
    … …  
    16771738        IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d 
    16781739      ENDDO 
     1740       
     1741    ELSE IF (.FALSE.) THEN 
     1742 
     1743      CALL MPI_BARRIER(comm_icosa,ierr)           
     1744 
     1745      IF (mpi_rank/=0) THEN 
     1746        nreq=ndomain 
     1747        ALLOCATE(mpi_req(nreq)) 
     1748        ALLOCATE(status(MPI_STATUS_SIZE,nreq)) 
     1749        ALLOCATE(field_tmp(ndomain)) 
     1750        ireq=0 
     1751        DO ind_loc=1,ndomain 
     1752          ireq=ireq+1 
     1753          IF (field_loc(ind_loc)%ndim==2) THEN 
     1754            ALLOCATE(field_tmp(ind_loc)%rval2d(size(field_loc(ind_loc)%rval2d,1))) 
     1755            CALL MPI_IRECV(field_tmp(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   & 
     1756                           0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1757!            DEALLOCATE(rval2d) 
     1758          ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
     1759            ALLOCATE(field_tmp(ind_loc)%rval3d(size(field_loc(ind_loc)%rval3d,1),size(field_loc(ind_loc)%rval3d,2))) 
     1760            CALL MPI_IRECV(field_tmp(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   & 
     1761                           0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1762!            DEALLOCATE(rval3d) 
     1763          ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
     1764            ALLOCATE(field_tmp(ind_loc)%rval4d(size(field_loc(ind_loc)%rval4d,1),size(field_loc(ind_loc)%rval4d,2), & 
     1765                                               size(field_loc(ind_loc)%rval4d,3))) 
     1766            CALL MPI_IRECV(field_tmp(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   & 
     1767                           0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1768!            DEALLOCATE(rval4d) 
     1769          ENDIF 
     1770       ENDDO 
     1771       
     1772       DO ind_loc=1,ndomain 
     1773         CALL MPI_WAITANY(nreq,mpi_req,index,status,ierr) 
     1774       ENDDO 
     1775 
     1776       DO ind_loc=1,ndomain 
     1777          IF (field_loc(ind_loc)%ndim==2) THEN 
     1778            field_loc(ind_loc)%rval2d=field_tmp(ind_loc)%rval2d 
     1779            DEALLOCATE(field_tmp(ind_loc)%rval2d) 
     1780          ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
     1781            field_loc(ind_loc)%rval3d=field_tmp(ind_loc)%rval3d 
     1782            DEALLOCATE(field_tmp(ind_loc)%rval3d) 
     1783          ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
     1784            field_loc(ind_loc)%rval4d=field_tmp(ind_loc)%rval4d 
     1785            DEALLOCATE(field_tmp(ind_loc)%rval4d) 
     1786          ENDIF 
     1787 
     1788       ENDDO 
     1789        
     1790     ELSE     
     1791     
     1792        DO ind_glo=1,ndomain_glo 
     1793 
     1794          IF (field_glo(ind_glo)%ndim==2) THEN 
     1795            
     1796            IF (domglo_rank(ind_glo)/=0) THEN 
     1797              CALL MPI_ISSEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 ,   & 
     1798                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, root_request, ierr) 
     1799              CALL MPI_WAIT(root_request,root_status,ierr) 
     1800            ELSE 
     1801              field_loc(domglo_loc_ind(ind_glo))%rval2d =  field_glo(ind_glo)%rval2d 
     1802            ENDIF 
     1803 
     1804          ELSE IF (field_glo(ind_glo)%ndim==3) THEN 
     1805            
     1806            IF (domglo_rank(ind_glo)/=0) THEN 
     1807              CALL MPI_ISSEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 ,   & 
     1808                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, root_request, ierr) 
     1809              CALL MPI_WAIT(root_request,root_status,ierr) 
     1810            ELSE 
     1811              field_loc(domglo_loc_ind(ind_glo))%rval3d =  field_glo(ind_glo)%rval3d 
     1812            ENDIF 
     1813 
     1814          ELSE IF (field_glo(ind_glo)%ndim==4) THEN 
     1815            
     1816            IF (domglo_rank(ind_glo)/=0) THEN 
     1817              CALL MPI_ISSEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 ,   & 
     1818                         domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, root_request, ierr) 
     1819              CALL MPI_WAIT(root_request,root_status,ierr) 
     1820            ELSE 
     1821              field_loc(domglo_loc_ind(ind_glo))%rval4d =  field_glo(ind_glo)%rval4d 
     1822            ENDIF 
     1823          
     1824          ENDIF 
     1825                          
     1826    
     1827          
     1828        ENDDO 
     1829      ENDIF 
     1830     
    16791831     
    16801832    ELSE 
    1681            
     1833      CALL MPI_BARRIER(comm_icosa,ierr)           
    16821834      nreq=ndomain 
    16831835      IF (mpi_rank==0) nreq=nreq+ndomain_glo  
    16841836      ALLOCATE(mpi_req(nreq)) 
    16851837      ALLOCATE(status(MPI_STATUS_SIZE,nreq)) 
    1686      
    1687      
     1838      ALLOCATE(field_tmp(ndomain)) 
     1839     
     1840     
     1841      IF (.FALSE.) THEN 
     1842       
     1843        ireq=0 
     1844        IF (mpi_rank==0) THEN 
     1845          DO ind_glo=1,ndomain_glo 
     1846            ireq=ireq+1 
     1847 
     1848            IF (field_glo(ind_glo)%ndim==2) THEN 
     1849              CALL MPI_ISEND(size(field_glo(ind_glo)%rval2d),1 , MPI_INTEGER ,   & 
     1850                           domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
     1851      
     1852            ELSE IF (field_glo(ind_glo)%ndim==3) THEN 
     1853              CALL MPI_ISEND(size(field_glo(ind_glo)%rval3d),1 , MPI_INTEGER ,   & 
     1854                           domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
     1855 
     1856            ELSE IF (field_glo(ind_glo)%ndim==4) THEN 
     1857              CALL MPI_ISEND(size(field_glo(ind_glo)%rval4d),1 , MPI_INTEGER ,   & 
     1858                           domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 
     1859            ENDIF 
     1860            
     1861          ENDDO 
     1862        ENDIF 
     1863     
     1864        DO ind_loc=1,ndomain 
     1865          ireq=ireq+1 
     1866 
     1867          IF (field_loc(ind_loc)%ndim==2) THEN 
     1868            CALL MPI_IRECV(recv_size(ind_loc),1 , MPI_INTEGER ,   & 
     1869                           0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1870          ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
     1871            CALL MPI_IRECV(recv_size(ind_loc),1, MPI_INTEGER ,   & 
     1872                           0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1873          ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
     1874            CALL MPI_IRECV(recv_size(ind_loc),1 , MPI_INTEGER ,   & 
     1875                           0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
     1876          ENDIF 
     1877         
     1878        ENDDO 
     1879      
     1880        CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
     1881 
     1882        DO ind_loc=1,ndomain 
     1883          IF (field_loc(ind_loc)%ndim==2) THEN 
     1884            IF (recv_size(ind_loc)/=size(field_loc(ind_loc)%rval2d)) THEN  
     1885              PRINT *,"Pb in  scatter_field : recv_size not conform :",recv_size(ind_loc),size(field_loc(ind_loc)%rval2d)     
     1886            ENDIF 
     1887          ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
     1888            IF (recv_size(ind_loc)/=size(field_loc(ind_loc)%rval3d)) THEN  
     1889              PRINT *,"Pb in  scatter_field : recv_size not conform :",recv_size(ind_loc),size(field_loc(ind_loc)%rval3d)     
     1890            ENDIF 
     1891          ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
     1892            IF (recv_size(ind_loc)/=size(field_loc(ind_loc)%rval4d)) THEN  
     1893              PRINT *,"Pb in  scatter_field : recv_size not conform :",recv_size(ind_loc),size(field_loc(ind_loc)%rval4d)     
     1894            ENDIF 
     1895          ENDIF 
     1896        ENDDO 
     1897        PRINT *,"scatter_field : Every thing OK ?"        
     1898        CALL MPI_BARRIER(comm_icosa,ierr) 
     1899        PRINT *,"YES scatter_field : Every thing is OK ?"        
     1900      ENDIF 
     1901 
     1902 
     1903 
    16881904      ireq=0 
    16891905      IF (mpi_rank==0) THEN 
    … …  
    17111927 
    17121928        IF (field_loc(ind_loc)%ndim==2) THEN 
    1713           CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   & 
     1929          ALLOCATE(field_tmp(ind_loc)%rval2d(size(field_loc(ind_loc)%rval2d,1))) 
     1930          CALL MPI_IRECV(field_tmp(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 ,   & 
    17141931                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    17151932        ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
    1716           CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   & 
     1933          ALLOCATE(field_tmp(ind_loc)%rval3d(size(field_loc(ind_loc)%rval3d,1),size(field_loc(ind_loc)%rval3d,2))) 
     1934          CALL MPI_IRECV(field_tmp(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 ,   & 
    17171935                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    17181936        ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
    1719           CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   & 
     1937          ALLOCATE(field_tmp(ind_loc)%rval4d(size(field_loc(ind_loc)%rval4d,1),size(field_loc(ind_loc)%rval4d,2), & 
     1938                                             size(field_loc(ind_loc)%rval4d,3))) 
     1939          CALL MPI_IRECV(field_tmp(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 ,   & 
    17201940                         0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 
    17211941        ENDIF 
    … …  
    17241944    
    17251945      CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 
     1946 
     1947      DO ind_loc=1,ndomain 
     1948          IF (field_loc(ind_loc)%ndim==2) THEN 
     1949            field_loc(ind_loc)%rval2d=field_tmp(ind_loc)%rval2d 
     1950            DEALLOCATE(field_tmp(ind_loc)%rval2d) 
     1951          ELSE IF (field_loc(ind_loc)%ndim==3) THEN 
     1952            field_loc(ind_loc)%rval3d=field_tmp(ind_loc)%rval3d 
     1953            DEALLOCATE(field_tmp(ind_loc)%rval3d) 
     1954          ELSE IF (field_loc(ind_loc)%ndim==4) THEN 
     1955            field_loc(ind_loc)%rval4d=field_tmp(ind_loc)%rval4d 
     1956            DEALLOCATE(field_tmp(ind_loc)%rval4d) 
     1957          ENDIF 
     1958 
     1959     ENDDO 
     1960       
     1961      CALL MPI_BARRIER(comm_icosa,ierr) 
    17261962 
    17271963    ENDIF 
Note: See TracChangeset for help on using the changeset viewer.