619
621
622
623
624 USE spmd_comm_world_mod, ONLY : spmd_comm_world
625#include "implicit_f.inc"
626
627
628
629#include "spmd.inc"
630
631
632
633#include "com01_c.inc"
634#include "com_xfem1.inc"
635#include "task_c.inc"
636
637
638
639 INTEGER IAD_EDGE(*),FR_EDGE(*),
640 . SIZE,LSDRC,FR_NBEDGE(*),FLAG
641 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
642
643
644
645#ifdef MPI
646 INTEGER I,II,J,JJ,L0,L,CC,MSGTYP,LOC_PROC,IERROR,
647 . INDEX,SIZ,NBIRECV,IAD_RECV(NSPMD+1),
648 . STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD),
649 . REQ_S(NSPMD),IRINDEX(NSPMD),IED,ICUT,
650 . IBOUNDEDGE,NXLAY,ILAY,EN10,EN20,MSGOFF
651 INTEGER RBUF(SIZE*LSDRC),
652 . SBUF(SIZE*LSDRC)
653 DATA msgoff/228/
654
655 loc_proc = ispmd + 1
656
657 nxlay = int(nlevmax/nxel)
658 nbirecv = 0
659 l = 1
660 iad_recv(1) = 1
661 DO i = 1, nspmd
662 IF(iad_edge(i+1)-iad_edge(i) > 0)THEN
663 siz = size*fr_nbedge(i)
664 msgtyp = msgoff
665 nbirecv = nbirecv + 1
666 irindex(nbirecv) = i
668 . rbuf(l),siz,mpi_integer,it_spmd(i),msgtyp,
669 . spmd_comm_world,req_r(nbirecv),ierror)
670 l = l + siz
671 ENDIF
672 iad_recv(i+1) = l
673 ENDDO
674
675 l = 1
676
677 IF (flag == 0) THEN
678
679 DO i=1,nspmd
680 IF (iad_edge(i+1) > iad_edge(i)) THEN
681 l0 = l
682#include "vectorize.inc"
683 DO j=iad_edge(i),iad_edge(i+1)-1
684 ied = fr_edge(j)
685 IF(ied == 0)THEN
686 DO ilay=1,nxlay
687 sbuf(l+ilay-1) = 0
688 ENDDO
689 ELSE
690 DO ilay=1,nxlay
691 sbuf(l+ilay-1) = crkedge(ilay)%IBORDEDGE(ied)
692 ENDDO
693 ENDIF
694 l = l + SIZE
695 END DO
696 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
697 msgtyp = msgoff
698 CALL mpi_isend(sbuf(l0),siz,mpi_integer,it_spmd(i),msgtyp,
699 . spmd_comm_world,req_s(i),ierror)
700 ENDIF
701 ENDDO
702
703 ELSE IF (flag == 1) THEN
704
705 DO i=1,nspmd
706 IF (iad_edge(i+1) > iad_edge(i)) THEN
707 l0 = l
708#include "vectorize.inc"
709 DO j=iad_edge(i),iad_edge(i+1)-1
710 ied = fr_edge(j)
711 IF(ied == 0)THEN
712 DO ilay=1,nxlay
713 sbuf(l+ilay-1) = 0
714 ENDDO
715 ELSE
716 DO ilay=1,nxlay
717 sbuf(l+ilay-1) = crkedge(ilay)%ICUTEDGE(ied)
718 ENDDO
719 ENDIF
720 l = l + SIZE
721 END DO
722 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
723 msgtyp = msgoff
724 CALL mpi_isend(sbuf(l0),siz,mpi_integer,it_spmd(i),msgtyp,
725 . spmd_comm_world,req_s(i),ierror)
726 ENDIF
727 ENDDO
728
729 ELSE IF (flag == 2) THEN
730
731 DO i=1,nspmd
732 IF (iad_edge(i+1) > iad_edge(i)) THEN
733 l0 = l
734#include "vectorize.inc"
735 DO j=iad_edge(i),iad_edge(i+1)-1
736 ied = fr_edge(j)
737 IF(ied==0)THEN
738 DO ilay=1,nxlay
739 sbuf(l+ilay-1) = 0
740 ENDDO
741 ELSE
742 DO ilay=1,nxlay
743 sbuf(l+ilay-1) = crkedge(ilay)%ICUTEDGE(ied)
744 ENDDO
745 ENDIF
746 l = l + SIZE
747 END DO
748 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
749 msgtyp = msgoff
750 CALL mpi_isend(sbuf(l0),siz,mpi_integer,it_spmd(i),msgtyp,
751 . spmd_comm_world,req_s(i),ierror)
752 ENDIF
753 ENDDO
754
755 ELSE IF (flag == 3) THEN
756
757 DO i=1,nspmd
758 IF (iad_edge(i+1) > iad_edge(i)) THEN
759 l0 = l
760#include "vectorize.inc"
761 DO j=iad_edge(i),iad_edge(i+1)-1
762 ied = fr_edge(j)
763 IF(ied==0)THEN
764 DO ilay=1,nxlay
765 sbuf(l+ilay-1) = 0
766 sbuf(l+ilay-1+nxlay) = 0
767 sbuf(l+ilay-1+nxlay*2) = 0
768 sbuf(l+ilay-1+nxlay*3) = 0
769 sbuf(l+ilay-1+nxlay*4) = 0
770 sbuf(l+ilay-1+nxlay*5) = 0
771 ENDDO
772
773 ELSE
774 DO ilay=1,nxlay
775 sbuf(l+ilay-1) = crkedge(ilay)%ICUTEDGE(ied)
776 sbuf(l+ilay-1+nxlay) = crkedge(ilay)%EDGEENR(1,ied)
777 sbuf(l+ilay-1+nxlay*2) = crkedge(ilay)%EDGEENR(2,ied)
778 sbuf(l+ilay-1+nxlay*3) = crkedge(ilay)%EDGEICRK(ied)
779 sbuf(l+ilay-1+nxlay*4) = crkedge(ilay)%EDGETIP(1,ied)
780 sbuf(l+ilay-1+nxlay*5) = crkedge(ilay)%EDGETIP(2,ied)
781 ENDDO
782 ENDIF
783 l = l + SIZE
784 END DO
785 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
786 msgtyp = msgoff
787 CALL mpi_isend(sbuf(l0),siz,mpi_integer,it_spmd(i),msgtyp,
788 . spmd_comm_world,req_s(i),ierror)
789 ENDIF
790 ENDDO
791
792 END IF
793
794
795
796
797 DO ii=1,nbirecv
798 CALL mpi_waitany(nbirecv,req_r,index,status,ierror)
799 i = irindex(index)
800 l = iad_recv(i)
801#include "vectorize.inc"
802 DO j=iad_edge(i),iad_edge(i+1)-1
803 ied = fr_edge(j)
804 IF(ied/=0)THEN
805 IF (flag == 0) THEN
806 DO ilay=1,nxlay
807 iboundedge = crkedge(ilay)%IBORDEDGE(ied)
808 crkedge(ilay)%IBORDEDGE(ied) =
809 .
max(rbuf(l+ilay-1),iboundedge)
810 ENDDO
811 ELSE IF (flag == 1) THEN
812 DO ilay=1,nxlay
813 icut = crkedge(ilay)%ICUTEDGE(ied)
814 IF (icut + rbuf(l+ilay-1) /= 4) THEN
815 crkedge(ilay)%ICUTEDGE(ied) =
max(rbuf(l+ilay-1),icut)
816 ELSE
817 crkedge(ilay)%ICUTEDGE(ied) = 3
818 END IF
819 ENDDO
820 ELSE IF (flag == 2) THEN
821 DO ilay=1,nxlay
822 icut = crkedge(ilay)%ICUTEDGE(ied)
823 IF (icut > 0) crkedge(ilay)%ICUTEDGE(ied) =
min(1,icut)
824 ENDDO
825 ELSE IF (flag == 3) THEN
826 DO ilay=1,nxlay
827 icut = crkedge(ilay)%ICUTEDGE(ied)
828 en10 = crkedge(ilay)%EDGEENR(1,ied)
829 en20 = crkedge(ilay)%EDGEENR(2,ied)
830 IF (icut > 0) THEN
831 crkedge(ilay)%EDGEENR(1,ied)
832 . =
max(en10,rbuf(l+ilay-1+nxlay))
833 crkedge(ilay)%EDGEENR(2,ied)
834 . =
max(en20,rbuf(l+ilay-1+2*nxlay))
835
836 crkedge(ilay)%EDGEICRK(ied) =
837 .
max(crkedge(ilay)%EDGEICRK(ied),rbuf(l+ilay-1+3*nxlay))
838 crkedge(ilay)%EDGETIP(1,ied) =
max(
839 . crkedge(ilay)%EDGETIP(1,ied),rbuf(l+ilay-1+4*nxlay))
840 crkedge(ilay)%EDGETIP(2,ied) =
max(
841 . crkedge(ilay)%EDGETIP(2,ied),rbuf(l+ilay-1+5*nxlay))
842 ENDIF
843 ENDDO
844 END IF
845 ENDIF
846 l = l + SIZE
847 END DO
848 END DO
849
850
851
852 DO i = 1, nspmd
853 IF(iad_edge(i+1)-iad_edge(i) > 0)
854 .
CALL mpi_wait(req_s(i),status,ierror)
855 ENDDO
856
857#endif
858 RETURN
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)