- Timestamp:
- 12/27/14 00:26:52 (10 years ago)
- 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 201 201 ENDIF 202 202 !$OMP END MASTER 203 !$OMP BARRIER 203 204 204 205 END SUBROUTINE write_restart … … 399 400 CALL getin("start_file_name",start_file_name) 400 401 402 !$OMP BARRIER 401 403 !$OMP MASTER 402 404 … … 427 429 IF (is_mpi_root) THEN 428 430 status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid) 429 ENDIF430 431 DO nf=1,nfield432 field=>field_array(nf)%field433 status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf))434 431 status = nf90_inq_varid(ncid, "iteration",itid) 435 432 IF (status==NF90_NOERR) THEN … … 438 435 status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it) 439 436 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)) 440 442 CALL read_start_field(field,fieldId(nf),ncid) 441 443 ENDDO … … 446 448 ENDIF 447 449 !$OMP END MASTER 450 !$OMP BARRIER 448 451 449 452 END SUBROUTINE read_start … … 468 471 TYPE(t_field),POINTER :: field_glo(:) 469 472 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_glo473 REAL(rstd),ALLOCATABLE :: global_field3d(:) 474 REAL(rstd),ALLOCATABLE :: global_field4d(:) 475 INTEGER :: i,j,l,q,ij,k,e,ind,ind_glo 473 476 INTEGER :: ndim, field_type 474 477 INTEGER :: status … … 506 509 507 510 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 517 524 ENDDO 518 525 ENDDO 519 526 ENDDO 520 527 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 530 542 ENDDO 531 543 ENDDO … … 553 565 ENDDO 554 566 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 566 581 ENDDO 567 582 ENDDO … … 569 584 ENDDO 570 585 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 584 604 ENDDO 585 605 ENDDO -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/transfert_mpi.f90
r287 r316 1596 1596 INTEGER :: ireq,nreq 1597 1597 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 1598 1608 1599 1609 IF (.NOT. using_mpi) THEN … … 1615 1625 ireq=0 1616 1626 IF (mpi_rank==0) THEN 1627 ALLOCATE(field_tmp(ndomain_glo)) 1617 1628 DO ind_glo=1,ndomain_glo 1618 1629 ireq=ireq+1 1619 1630 1620 1631 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 , & 1622 1634 domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 1623 1635 1624 1636 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 , & 1626 1639 domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 1627 1640 1628 1641 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 , & 1630 1645 domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 1631 1646 ENDIF … … 1633 1648 ENDDO 1634 1649 ENDIF 1650 1651 ALLOCATE(field_tmp2(ndomain)) 1635 1652 1636 1653 DO ind_loc=1,ndomain … … 1638 1655 1639 1656 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 , & 1641 1660 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1642 1661 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 , & 1644 1665 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1645 1666 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 , & 1647 1671 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1648 1672 ENDIF … … 1651 1675 1652 1676 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 1653 1704 1654 1705 ENDIF … … 1667 1718 INTEGER, ALLOCATABLE :: mpi_req(:) 1668 1719 INTEGER, ALLOCATABLE :: status(:,:) 1669 INTEGER :: ireq,nreq 1720 INTEGER :: ireq,nreq, root_request 1670 1721 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 1672 1733 IF (.NOT. using_mpi) THEN 1673 1734 … … 1677 1738 IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d 1678 1739 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 1679 1831 1680 1832 ELSE 1681 1833 CALL MPI_BARRIER(comm_icosa,ierr) 1682 1834 nreq=ndomain 1683 1835 IF (mpi_rank==0) nreq=nreq+ndomain_glo 1684 1836 ALLOCATE(mpi_req(nreq)) 1685 1837 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 1688 1904 ireq=0 1689 1905 IF (mpi_rank==0) THEN … … 1711 1927 1712 1928 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 , & 1714 1931 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1715 1932 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 , & 1717 1935 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1718 1936 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 , & 1720 1940 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1721 1941 ENDIF … … 1724 1944 1725 1945 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) 1726 1962 1727 1963 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.