outp_mt.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/.
!||====================================================================
!||    outp_mt           ../engine/source/output/sty/outp_mt.F
!||--- called by ------------------------------------------------------
!||    genoutp           ../engine/source/output/sty/genoutp.F
!||--- calls      -----------------------------------------------------
!||    fretitl2          ../engine/source/input/freform.F
!||    spmd_glob_dsum9   ../engine/source/mpi/interfaces/spmd_th.F
!||====================================================================
      SUBROUTINE outp_mt(PM,NPART,PARTSAV,IPART,IPM)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
#include      "scr16_c.inc"
#include      "scr17_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPM(NPROPMI,*)
      my_real pm(npropm,*),partsav(npsav,*)
      INTEGER NPART,IPART(LIPART1,*)
      INTEGER LEN
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,USRMID,K,I1,M
      my_real mas,xm,ym,zm,ie,ke,partsav2(npsav,npart)
      CHARACTER*100 CARD
C
      DO m=1,npsav
        DO i=1,npart
          partsav2(m,i) = partsav(m,i)
        ENDDO
      END DO
C SPMD pre-processing: gather of PARTSAV and zeroing on remote procs
      IF(nspmd > 1) THEN
        CALL spmd_glob_dsum9(partsav2,npsav*npart)
        IF(ispmd/=0) THEN
          RETURN
        ENDIF
      ENDIF
      ie=zero
      ke=zero
      mas=zero
      xm=zero
      ym=zero
      zm=zero      
      i1=ipart(1,1)
      DO k = 1,npart+1
        IF(k<=npart)THEN
          i=ipart(1,k)
        ELSE
          i=0
        ENDIF
        IF(i1==0)THEN
         i1=i
        ELSEIF(i1/=i)THEN
         CALL fretitl2(card,ipm(npropmi-ltitr+1,i1),40)
         WRITE(iugeo,'(A,I10)')'/MATER     /',i1
         usrmid = ipm(1,i1)
         IF(usrmid==0) card=' '
         IF (outyy_fmt==2) THEN
           WRITE(iugeo,'(A)')card(1:80)
         ELSE
           WRITE(iugeo,'(A)')card
         END IF
         IF (outyy_fmt==2) THEN
          WRITE(iugeo,'(A)') '#FORMAT: (I8,1P3E16.9/8X,1P3E16.9) '
          WRITE(iugeo,'(2A)')'# USRMID INTERNAL_ENERGY  KINETIC_ENERGY',
     .                              '            MASS'
          WRITE(iugeo,'(2A)')'#             X_MOMENTUM      Y_MOMENTUM',
     .                               '      Z_MOMENTUM'
          WRITE(iugeo,'(I8,1P3E16.9/8X,1P3E16.9)') usrmid,
     .        ie,ke,mas,xm,ym,zm
         ELSE
          WRITE(iugeo,'(A)') '#FORMAT: (I10,1P3E20.13/8X,1P3E20.13) '
          WRITE(iugeo,'(2A)')'# USRMID INTERNAL_ENERGY  KINETIC_ENERGY',
     .                              '            MASS'
          WRITE(iugeo,'(2A)')'#             X_MOMENTUM      Y_MOMENTUM',
     .                               '      Z_MOMENTUM'
          WRITE(iugeo,'(I10,1P3E20.13/8X,1P3E20.13)') usrmid,
     .          ie,ke,mas,xm,ym,zm
         ENDIF
         ie=zero
         ke=zero
         mas=zero
         xm=zero
         ym=zero
         zm=zero 
         i1=i
        ENDIF
        IF(i>0)THEN
          ie=ie+partsav2(1,k)
          ke=ke+partsav2(2,k)
          mas=mas+partsav2(6,k)
          xm=xm+partsav2(3,k)
          ym=ym+partsav2(4,k)
          zm=zm+partsav2(5,k)
        ENDIF
      ENDDO
C
      RETURN
      END