sensor_rwall.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_rwall (sensor, nprw, dimfb, stabs, tabs, fbsav6)

Function/Subroutine Documentation

sensor_rwall()

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

Definition at line 31 of file sensor_rwall.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),NPRW(*)
      DOUBLE PRECISION FBSAV6(12,6,DIMFB)
      TYPE (SENSOR_STR_) ,TARGET   :: SENSOR
C----------------------------------------------------------
C Local Variables
C----------------------------------------------------------
      INTEGER :: RW_ID,IDIR,ICRIT,ISECT,N5,ACTI
      my_real :: fmin,fmax,ff,fx,fy,fz,tmin,tdelay,tstart,tstops,infinity
      parameter(infinity = 1.0e20)
C=======================================================================
      tmin   = sensor%TMIN
      tdelay = sensor%TDELAY
      tstart = sensor%TSTART
      tstops = sensor%VALUE
c      
      rw_id = sensor%IPARAM(1) 
      idir  = sensor%IPARAM(2) 
      fmin  = sensor%RPARAM(1) 
      fmax  = sensor%RPARAM(2) 
      icrit = 0
      acti  = 0
      ff = zero
      fx = zero
      fy = zero
      fz = zero
c
      isect = tabs(nsect+rw_id+1)-tabs(nsect+rw_id)
      n5 = rw_id + 4*nrwall
c
      IF (nprw(n5) == 1) THEN   ! NPRW(N5) = ICONT - rigid wall contact flag
        isect = tabs(rw_id+nsect+ninter+nintsub+1)-tabs(rw_id+nsect+ninter+nintsub)
        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)
          ff = fx
        ELSEIF (idir == 2) THEN
          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)
          ff = fy
        ELSEIF (idir == 4) THEN
          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 = fz
        ELSEIF (idir == 5) 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) 
        ELSEIF (idir == 6) 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
        sensor%RESULTS(1) = ff
c
        IF (ff < fmin .OR. ff > fmax .OR. idir == 0) icrit = 1
c  
        ! check activation
c 
        IF (icrit == 1) THEN
          sensor%TCRIT = min(sensor%TCRIT, tt)
        ELSE
          sensor%TCRIT = infinity
        END IF
        IF (sensor%TCRIT + tmin <= tt) THEN
          tstops = tt + tdelay
          sensor%VALUE = tstops
          IF (sensor%STATUS == 0) THEN
            sensor%STATUS = 1
            sensor%TSTART = tt
            acti = 1
          END IF
        END IF
c
      ELSE   ! ICONT = 0 => no contact
        IF (tt > tstops .AND. sensor%STATUS == 1) THEN 
          sensor%STATUS = 0
          sensor%TSTART = infinity
          sensor%VALUE  = infinity
          acti = 2
        END IF
      END IF
c
c-----------------------------------------------------------------------
      ! Output   
      IF (acti == 1) THEN    
        IF (ispmd == 0) THEN
#include "lockon.inc"
          WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
          IF (ff < fmin) THEN
            WRITE (iout ,1200) sensor%SENS_ID,sensor%TSTART,fmin,ff
          ELSE IF (ff > fmax) THEN
            WRITE (iout ,1200) sensor%SENS_ID,sensor%TSTART,fmax,ff
          END IF
#include "lockoff.inc"
        ENDIF
      ELSE IF (acti == 2) THEN
        IF (ispmd == 0) THEN
#include   "lockon.inc"
          WRITE (istdo,1300) sensor%SENS_ID,sensor%TSTART
          WRITE (iout ,1300) sensor%SENS_ID,sensor%TSTART
#include "lockoff.inc"
        END IF
      END IF
c-----------------------------------------------------------------------      
1100  FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,ACTIVATED AT TIME '  ,1pe12.5)
1200  FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,ACTIVATED AT TIME ',1pe12.5/     
     .       '      TARGET FORCE VALUE =',1pe12.5/
     .       '      CURRENT VALUE AT TMIN + TDELAY =',1pe12.5)
1300  FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,DEACTIVATED AT TIME ',1pe12.5)     
c-----------------------------------------------------------------------      
      RETURN