spmd_glob_minv.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/.
C==========================================================================
C==========================================================================
!||====================================================================
!||    spmd_glob_minv        ../engine/source/mpi/generic/spmd_glob_minv.F
!||--- called by ------------------------------------------------------
!||    resol                 ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||    monvol_struct_mod     ../engine/share/modules/monvol_struct_mod.F
!||    spmd_comm_world_mod   ../engine/source/mpi/spmd_comm_world.F90
!||====================================================================
      SUBROUTINE spmd_glob_minv(T_MONVOL, DT2,ITYPTS,NELTS,VOLMON, FR_MV)
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
        USE monvol_struct_mod
#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"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(monvol_struct_) :: T_MONVOL(NVOLU)
      INTEGER ITYPTS, NELTS, FR_MV(NSPMD+2,NVOLU)
      my_real
     .        dt2, volmon(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
#ifdef MPI
      INTEGER I, J, N, MSGTYP, IERROR, LOC_PROC,
     .        INDEX, MSTOP1, MSTOP2, K1, KK1,
     .        LEN, myop,
     .        STATUS(MPI_STATUS_SIZE)
      my_real
     .        rbuf(3+nvolu*7), rrbuf(3+nvolu*7)
      INTEGER :: MY_TYPE
      INTEGER GLOB_MINV
      EXTERNAL glob_minv
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C
      loc_proc=ispmd+1
C
      rrbuf(1) = dt2
      rrbuf(2) = itypts
      rrbuf(3) = nelts
      DO i = 1, nvolu*7
        rrbuf(3+i) = zero
      END DO
      k1 = 1
      kk1 = 0
      DO i=1,nvolu
        IF(fr_mv(nspmd+2,i)==ispmd+1) THEN
          rrbuf(3+(i-1)*7+1)=volmon(kk1+1)
          rrbuf(3+(i-1)*7+2)=volmon(kk1+2)
          rrbuf(3+(i-1)*7+3)=volmon(kk1+5)
          rrbuf(3+(i-1)*7+4)=volmon(kk1+12)
          rrbuf(3+(i-1)*7+5)=volmon(kk1+16)
          rrbuf(3+(i-1)*7+6)=volmon(kk1+18)
          rrbuf(3+(i-1)*7+7)=volmon(kk1+21)
        END IF
        k1  = k1  + nimv
        kk1 = kk1 + nrvolu
      END DO
 
      len = 3+nvolu*7
 
      CALL mpi_type_contiguous(len,real,my_type,ierror)
      CALL mpi_type_commit(my_type,ierror)
      CALL mpi_op_create(glob_minv, .true., myop, ierror)
      
      CALL mpi_allreduce(rrbuf, rbuf, 1, my_type, myop,
     &                   spmd_comm_world, ierror)
     
      CALL mpi_op_free(myop, ierror)
      CALL mpi_type_free(my_type,ierror)
 
      dt2    = rbuf(1)
      itypts = rbuf(2)
      nelts  = rbuf(3)
      k1 = 1
      kk1 = 0
      DO i=1,nvolu
        volmon(kk1+1) =rbuf(3+(i-1)*7+1)
        volmon(kk1+2) =rbuf(3+(i-1)*7+2)
        volmon(kk1+5) =rbuf(3+(i-1)*7+3)
        volmon(kk1+12)=rbuf(3+(i-1)*7+4) ! pressure
        volmon(kk1+16)=rbuf(3+(i-1)*7+5) !Volume ?
        volmon(kk1+18)=rbuf(3+(i-1)*7+6) ! area
        volmon(kk1+21)=rbuf(3+(i-1)*7+7)
        t_monvol(i)%pressure = volmon(kk1+12)
        t_monvol(i)%temperature = volmon(kk1+13)
        t_monvol(i)%area = volmon(kk1+18)
!       write(6,*) "Pressure ", I, " is ", T_MONVOL(I)%pressure
!       write(6,*) "Temperature ", I, " is ", T_MONVOL(I)%temperature
!       write(6,*) "Area ", I, " is ", T_MONVOL(I)%area
!       write(6,*) "Volume ", I, " is ", VOLMON(KK1+16),T_MONVOL(I)%volume
        k1  = k1  + nimv
        kk1 = kk1 + nrvolu
      END DO
C
#endif
      RETURN
      END