sensor_rbody.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "units_c.inc"
#include "comlock.inc"
#include "task_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	sensor_rbody (sensor, dimfb, stabs, tabs, fbsav6)

Function/Subroutine Documentation

sensor_rbody()

subroutine sensor_rbody	(	type (sensor_str_), target	sensor,
		integer	dimfb,
		integer	stabs,
		integer, dimension(stabs)	tabs,
		double precision, dimension(12,6,dimfb)	fbsav6 )

Definition at line 31 of file sensor_rbody.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE sensor_mod
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      "com04_c.inc"
#include      "com08_c.inc"
#include      "units_c.inc"
#include      "comlock.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER :: DIMFB,STABS
      INTEGER :: TABS(STABS)
      DOUBLE PRECISION FBSAV6(12,6,DIMFB)
      TYPE (SENSOR_STR_) ,TARGET   :: SENSOR
C----------------------------------------------------------
C Local Variables
C----------------------------------------------------------
      INTEGER I,RBOD_ID,IDIR,ICRIT,ISECT,IFLAG,IAD
c
      my_real :: fmin,fmax,fx,fy,fz,ff,tstart,tmin,tdelay,infinity
      parameter(infinity = 1.0e20)
C=======================================================================
      IF (sensor%STATUS == 1) RETURN   ! already activated
c
      tstart  = sensor%TSTART
      tmin    = sensor%TMIN
      tdelay  = sensor%TDELAY
c
      rbod_id = sensor%IPARAM(1)
      idir    = sensor%IPARAM(2)
      fmin    = sensor%RPARAM(1)
      fmax    = sensor%RPARAM(2)
      icrit   = 0
      iflag   = 0
c
      iad   = ninter + nrwall + rbod_id
      isect = tabs(rbod_id + nsect + ninter + nintsub+nrwall+1)
     .      - tabs(rbod_id + nsect + ninter + nintsub+nrwall)
      IF (idir == 1) THEN
        fx = fbsav6(1,1,isect) + fbsav6(1,2,isect)
     .     + fbsav6(1,3,isect) + fbsav6(1,4,isect)
     .     + fbsav6(1,5,isect) + fbsav6(1,6,isect)
        fy = fbsav6(2,1,isect) + fbsav6(2,2,isect)
     .     + fbsav6(2,3,isect) + fbsav6(2,4,isect)
     .     + fbsav6(2,5,isect) + fbsav6(2,6,isect)
        fz = fbsav6(3,1,isect) + fbsav6(3,2,isect)
     .     + fbsav6(3,3,isect) + fbsav6(3,4,isect)
     .     + fbsav6(3,5,isect) + fbsav6(3,6,isect)
        ff = sqrt(fx*fx + fy*fy + fz*fz) 
      ELSE !IF (IDIR == 2) THEN
        fx = fbsav6(4,1,isect) + fbsav6(4,2,isect)
     .     + fbsav6(4,3,isect) + fbsav6(4,4,isect)
     .     + fbsav6(4,5,isect) + fbsav6(4,6,isect)
        fy = fbsav6(5,1,isect) + fbsav6(5,2,isect)
     .     + fbsav6(5,3,isect) + fbsav6(5,4,isect)
     .     + fbsav6(5,5,isect) + fbsav6(5,6,isect)
        fz = fbsav6(6,1,isect) + fbsav6(6,2,isect)
     .     + fbsav6(6,3,isect) + fbsav6(6,4,isect)
     .     + fbsav6(6,5,isect) + fbsav6(6,6,isect)
        ff = sqrt(fx*fx + fy*fy + fz*fz) 
      ENDIF           
c
      IF (ff < fmin) THEN
        icrit = 1
        iflag = 1
      ELSE IF (ff > fmax) THEN
        icrit = 1
        iflag = 2
      END IF
      sensor%RESULTS(1) = ff
c----------------------------------------------------------------
c     check activation status
c----------------------------------------------------------------
      IF (sensor%TCRIT + tmin > tt) THEN
        IF (icrit == 0) THEN
          sensor%TCRIT = infinity
        ELSE IF (sensor%TCRIT == infinity) THEN
          sensor%TCRIT = tt
        END IF
      END IF
      IF (sensor%TCRIT < infinity) tstart = sensor%TCRIT + tmin + tdelay
      IF (tstart <= tt) THEN   ! sensor activation
        sensor%STATUS = 1
        sensor%TSTART = tstart
      END IF
c-----------------------------------------------------------------------      
      IF (sensor%STATUS == 1 .and. ispmd == 0) THEN
#include "lockon.inc"
        WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
        WRITE (iout ,1100) sensor%SENS_ID,sensor%TSTART
        IF (iflag == 1) THEN
          WRITE (iout ,1200) fmin,ff
        ELSE IF (iflag == 2) THEN
          WRITE (iout ,1300) fmax,ff
        END IF
#include "lockoff.inc"
      ENDIF
c-----------------------------------------------------------------------      
1100  FORMAT(' SENSOR (RBODY) NUMBER ',i10,' ,ACTIVATED AT TIME ',1pe12.5)
1200  FORMAT('      TARGET MIN FORCE = ',1pe12.5,/
     .       '      CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5)
1300  FORMAT('      TARGET MAX FORCE = ',1pe12.5,/
     .       '      CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5)
c-----------------------------------------------------------------------      
      RETURN