outp_mt.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	outp_mt (pm, npart, partsav, ipart, ipm)

Function/Subroutine Documentation

outp_mt()

subroutine outp_mt	(		pm,
		integer	npart,
			partsav,
		integer, dimension(lipart1,*)	ipart,
		integer, dimension(npropmi,*)	ipm )

Definition at line 31 of file outp_mt.F.

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 pre traitement SPMD : gather de PARTSAV et mise a zero sur procs remote
      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