spmd_exch_min_max.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    spmd_exch_min_max                ../engine/source/mpi/ale/spmd_exch_min_max.F
!||--- called by ------------------------------------------------------
!||    ale51_gradient_reconstruction    ../engine/source/ale/alemuscl/ale51_gradient_reconstruction.F
!||    ale51_gradient_reconstruction2   ../engine/source/ale/alemuscl/ale51_gradient_reconstruction2.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                           ../engine/source/output/message/message.F
!||    arret                            ../engine/source/system/arret.F
!||--- uses       -----------------------------------------------------
!||    message_mod                      ../engine/share/message_module/message_mod.F
!||    spmd_comm_world_mod              ../engine/source/mpi/spmd_comm_world.F90
!||====================================================================
      SUBROUTINE spmd_exch_min_max(IAD_ELEM ,FR_ELEM ,MIN_ARRAY,MAX_ARRAY )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
        USE spmd_comm_world_mod, ONLY : spmd_comm_world
#include      "implicit_f.inc"
C-----------------------------------------------
C   M e s s a g e   P a s s i n g
C-----------------------------------------------
#include "spmd.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"     
#include      "com04_c.inc"     
#include      "task_c.inc"      
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IAD_ELEM(2,*),FR_ELEM(*)
          my_real , INTENT(INOUT) :: min_array(numnod),max_array(numnod)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
#ifdef MPI
       INTEGER LENCOM,MSGOFF ,MSGTYP
       my_real, dimension(:), ALLOCATABLE :: send_buf,rec_buf
       INTEGER STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD),REQ_S(NSPMD)
       INTEGER IERROR
       INTEGER P,J,NOD,SIZ,L,IAD
C-----------------------------------------------
       DATA msgoff/400/    
       msgtyp=msgoff
       
       lencom = ( iad_elem(1,nspmd+1) - iad_elem(1,1) )
 
C Allocation des Buffers           
       ALLOCATE(send_buf(2 * lencom),stat=ierror)
       IF(ierror/=0) THEN
          CALL ancmsg(msgid=20,anmode=aninfo)
          CALL arret(2)
       ENDIF
       
       ALLOCATE(rec_buf(2 * lencom),stat=ierror)
       IF(ierror/=0) THEN
          CALL ancmsg(msgid=20,anmode=aninfo)
          CALL arret(2)
       ENDIF   
C 
C ----------
C Set IRECV
C ----------
       l=1
       DO p=1,nspmd 
              siz = iad_elem(1,p+1)-iad_elem(1,p)
          IF(siz > 0) THEN 
           CALL mpi_irecv(
     s      rec_buf(l),2*siz,real,it_spmd(p),msgtyp,
     g      spmd_comm_world,req_r(p),ierror)
            l=l+2*siz
          ENDIF
       ENDDO
       
C -----------------
C PREPARE SEND_BUF       
C -----------------
       l=1
       DO p=1,nspmd 
         siz = iad_elem(1,p+1)-iad_elem(1,p)
         IF(siz > 0)THEN
           iad = l
           DO j=iad_elem(1,p),iad_elem(1,p+1)-1
              nod = fr_elem(j)
              send_buf(l)=min_array(nod)
              send_buf(l + 1)=max_array(nod)
              l=l+2
           ENDDO         
         
           CALL mpi_isend(
     s       send_buf(iad),2*siz,real,it_spmd(p),msgtyp,
     g       spmd_comm_world,req_s(p),ierror)
     
         ENDIF
       ENDDO
 
C ------------
C END RECEIVE
C ------------
       l=1
       DO p=1,nspmd 
         siz = iad_elem(1,p+1)-iad_elem(1,p)
         IF(siz > 0)THEN
           CALL mpi_wait(req_r(p),status,ierror)
            
           DO j=iad_elem(1,p),iad_elem(1,p+1)-1
             nod = fr_elem(j)
             min_array(nod) = min(min_array(nod), rec_buf(l))
             max_array(nod) = max(max_array(nod), rec_buf(l + 1))
             l = l+2
           ENDDO
         ENDIF
       ENDDO
 
C ------------
C END SEND
C ------------
      DO p = 1, nspmd
        IF(iad_elem(1,p+1)-iad_elem(1,p)>0)THEN
          CALL mpi_wait(req_s(p),status,ierror)
        ENDIF
      ENDDO
      IF (ALLOCATED(send_buf)) DEALLOCATE(send_buf)
      IF (ALLOCATED(rec_buf)) DEALLOCATE(rec_buf)
       
#endif
       
       END