init_tg.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	init_tg (iflow, ibuf, elem, x, xs, ys, zs, xd, yd, zd, rflow, normal, ta, af, cosg, dcp)

Function/Subroutine Documentation

init_tg()

subroutine init_tg	(	integer, dimension(*)	iflow,
		integer, dimension(*)	ibuf,
		integer, dimension(3,*)	elem,
			x,
			xs,
			ys,
			zs,
			xd,
			yd,
			zd,
			rflow,
			normal,
			ta,
			af,
			cosg,
			dcp )

Definition at line 28 of file init_tg.F.

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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IFLOW(*), IBUF(*), ELEM(3,*)
      my_real x(3,*), af(*), rflow(*), normal(3,*), ta(*), cosg(*), dcp(*)
      my_real xs, ys, zs, xd, yd, zd
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ILVOUT, NEL, IWAVE, FREESURF
      INTEGER N1, N2, N3, NN1, NN2, NN3, IEL, JEL
      my_real x1, y1, z1, x2, y2, z2, x3, y3, z3,
     .        xp, yp, zp, x12, y12, z12, x13, y13, z13,    
     .        nrx, nry, nrz, area2, dcs, ssp,
     .        xc, yc, zc, dirx, diry, dirz
C
      ilvout  = iflow(17)
      nel     = iflow(6)
      iwave   = iflow(22)
      freesurf= iflow(25)
C-------------------------------------------------------------------
C Compute Area Normal and Arrival Time
C-------------------------------------------------------------------
      ssp=rflow(2)    
      IF(iwave==1) THEN
        xc =rflow(9)    
        yc =rflow(10)    
        zc =rflow(11)
        dcs=rflow(12)
      ELSEIF(iwave==2) THEN
        dirx=rflow(9)
        diry=rflow(10)
        dirz=rflow(11)
      ENDIF
      DO iel=1,nel
         n1=elem(1,iel)
         n2=elem(2,iel)
         n3=elem(3,iel)
         nn1=ibuf(n1)
         nn2=ibuf(n2)
         nn3=ibuf(n3)
         x1=x(1,nn1)
         x2=x(1,nn2)
         x3=x(1,nn3)
         y1=x(2,nn1)
         y2=x(2,nn2)
         y3=x(2,nn3)
         z1=x(3,nn1)
         z2=x(3,nn2)
         z3=x(3,nn3)
C  Normale
         x12=x2-x1
         y12=y2-y1
         z12=z2-z1
         x13=x3-x1
         y13=y3-y1
         z13=z3-z1
         nrx=y12*z13-z12*y13
         nry=z12*x13-x12*z13
         nrz=x12*y13-y12*x13
         area2=sqrt(nrx**2+nry**2+nrz**2)
         normal(1,iel)=nrx/area2
         normal(2,iel)=nry/area2
         normal(3,iel)=nrz/area2
         af(iel)=half*area2
C Centroid
         xp=third*(x1+x2+x3)
         yp=third*(y1+y2+y3)    
         zp=third*(z1+z2+z3)
C  Arrival time
         IF(iwave==1) THEN
            dcp(iel) = sqrt((xp-xc)**2+(yp-yc)**2+(zp-zc)**2)
            ta(iel)  = (dcp(iel)-dcs)/ssp
            cosg(iel)= (nrx*(xp-xc)+nry*(yp-yc)+nrz*(zp-zc))/(area2*dcp(iel))
            IF(freesurf == 2) THEN
               jel=iel+nel
               dcp(jel) = sqrt((xp-xd)**2+(yp-yd)**2+(zp-zd)**2)
               ta(jel)  = (dcp(jel)-dcs)/ssp
               cosg(jel)= (nrx*(xp-xd)+nry*(yp-yd)+nrz*(zp-zd))/(area2*dcp(jel))
            ENDIF
         ELSEIF(iwave==2) THEN
            dcp(iel) = (xp-xs)*dirx+(yp-xs)*diry+(zp-zs)*dirz
            ta(iel)  = dcp(iel)/ssp
            cosg(iel)= (nrx*dirx+nry*diry+nrz*dirz)/area2
         ENDIF
      ENDDO     
 
      IF(ilvout>=2) THEN
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----1----+----2----+----3--
         WRITE (iout,'(//7X,2A)') 'ELEMENT   ARRIVAL TIME        AREA     DISTANCE   DIR.COSINE     ',
     .                            'NORMAL-X     NORMAL-Y     NORMAL-Z'
         DO iel = 1,nel
            WRITE (iout,'(5X,I10,7E13.5)')iel,ta(iel),af(iel),dcp(iel),cosg(iel),normal(1,iel),normal(2,iel),normal(3,iel)
         ENDDO
         IF(freesurf == 2) THEN
            WRITE (iout,'(//7X,2A)') 'ELEMENT   ARRIVAL TIME        AREA     DISTANCE   DIR.COSINE     '
            DO iel = 1,nel
               jel=iel+nel
               WRITE (iout,'(5X,I10,7E13.5)')iel,ta(jel),af(iel),dcp(jel),cosg(jel)
            ENDDO
         ENDIF
      ENDIF
      RETURN