sensor_contact.F File Reference

#include "implicit_f.inc"
#include "param_c.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_contact (sensor, ipari, dimfb, stabs, tabs, fbsav6)

Function/Subroutine Documentation

sensor_contact()

subroutine sensor_contact	(	type (sensor_str_), target	sensor,
		integer, dimension(npari,ninter)	ipari,
		integer	dimfb,
		integer	stabs,
		integer, dimension(stabs)	tabs,
		double precision, dimension(12,6,dimfb)	fbsav6 )

Definition at line 33 of file sensor_contact.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      "param_c.inc"
#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),IPARI(NPARI,NINTER)
      DOUBLE PRECISION FBSAV6(12,6,DIMFB)
      TYPE (SENSOR_STR_) ,TARGET   :: SENSOR
C----------------------------------------------------------
C Local Variables
C----------------------------------------------------------
      INTEGER :: INT_ID,INTSUB,ID_INTER,IDIR,ICRIT,ISECT,IFLAG
      my_real :: fmin,fmax,ff,fv,fv1,fv2,vv1,vv2,freq,
     .           tmin,tdelay,tcrit,tstart,tstops
C=======================================================================
      tmin   = sensor%TMIN
      tdelay = sensor%TDELAY
      tcrit  = sensor%TCRIT
      tstops = sensor%VALUE
c      
      int_id = sensor%IPARAM(1) 
      intsub = sensor%IPARAM(2) 
      idir   = sensor%IPARAM(3) 
      fmin   = sensor%RPARAM(1) 
      fmax   = sensor%RPARAM(2) 
      freq   = sensor%RPARAM(3) 
c
      isect = tabs(nsect+int_id+1)-tabs(nsect+int_id)
      icrit = 0
      iflag = 0
      ff    = zero
c
      IF (idir == 1) THEN
        ff = sqrt((fbsav6(1,1,isect) + fbsav6(1,2,isect)
     .      +  fbsav6(1,3,isect) + fbsav6(1,4,isect)
     .      +  fbsav6(1,5,isect) + fbsav6(1,6,isect))**2  
     .     + (fbsav6(2,1,isect) + fbsav6(2,2,isect)
     .      +  fbsav6(2,3,isect) + fbsav6(2,4,isect)
     .      +  fbsav6(2,5,isect) + fbsav6(2,6,isect))**2 
     .     + (fbsav6(3,1,isect) + fbsav6(3,2,isect)
     .      +  fbsav6(3,3,isect) + fbsav6(3,4,isect)
     .      +  fbsav6(3,5,isect) + fbsav6(3,6,isect))**2) 
      ELSEIF (idir == 2) THEN
        ff = sqrt((fbsav6(4,1,isect)+fbsav6(4,2,isect)
     .     +  fbsav6(4,3,isect)+fbsav6(4,4,isect)
     .     +  fbsav6(4,5,isect)+fbsav6(4,6,isect))**2 
     .     + (fbsav6(5,1,isect)+fbsav6(5,2,isect)
     .     +  fbsav6(5,3,isect)+fbsav6(5,4,isect)
     .     +  fbsav6(5,5,isect)+fbsav6(5,6,isect))**2
     .     + (fbsav6(6,1,isect)+fbsav6(6,2,isect)
     .     +  fbsav6(6,3,isect)+fbsav6(6,4,isect)
     .     +  fbsav6(6,5,isect)+fbsav6(6,6,isect))**2) 
      END IF
c
      IF (freq > zero) THEN   ! Filter contact forces (Butterworth) 
             IF (tt == zero) THEN                           
               vv1 = ff                                     
               vv2 = ff                                     
               fv1 = ff                                     
               fv2 = ff                                     
               sensor%VAR(1) = vv1                             
               sensor%VAR(2) = vv2                            
               sensor%VAR(3) = fv1                            
               sensor%VAR(4) = fv2                            
             ENDIF                                          
c
             vv1 = sensor%VAR(1)                                 
             vv2 = sensor%VAR(2)                                
             fv1 = sensor%VAR(3)                                
             fv2 = sensor%VAR(4)                                
             CALL butterworth(dt2,freq,vv2,vv1,ff,fv2,fv1,fv) 
             sensor%VAR(1) = ff                                  
             sensor%VAR(2) = vv1                                
             sensor%VAR(3) = fv                                 
             sensor%VAR(4) = fv1                                
             ff = fv
      END IF
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----------------------------------------------------------------
      id_inter = int_id
      IF (int_id > ninter) id_inter = intsub
c
      IF (ipari(29,id_inter) == 1) THEN
c
        IF (icrit == 1) THEN
          tcrit = min(tcrit, tt)
        ELSE
          tcrit = infinity
        ENDIF
        sensor%TCRIT = tcrit
 
        IF (tcrit + tmin <= tt) THEN  ! activation
          tstops = tt + tdelay
          sensor%VALUE  = tstops
 
          IF (sensor%STATUS == 0) THEN
            sensor%STATUS = 1
            tstart = tt
            sensor%TSTART = tstart
            IF (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 ,1300) fmin,ff
              ELSE IF (iflag == 2) THEN
                WRITE (iout ,1400) fmax,ff
              END IF
#include "lockoff.inc"
            ENDIF
          ENDIF
        ENDIF
c
      ELSE IF (tt > tstops .AND. sensor%STATUS == 1) THEN  ! deactivation
c
        sensor%STATUS = 0
        sensor%TSTART = infinity
        sensor%TCRIT  = infinity
        sensor%VALUE  = infinity
 
        IF (ispmd == 0) THEN
#include "lockon.inc"
          WRITE (istdo,1200) sensor%SENS_ID,tt
          WRITE (iout ,1200) sensor%SENS_ID,tt
#include "lockoff.inc"
        END IF
      ENDIF
c-----------------------------------------------------------------------      
1100  FORMAT(' SENSOR (INTER) NUMBER ',i10,' ACTIVATED AT TIME '  ,1pe12.5)
1200  FORMAT(' SENSOR (INTER) NUMBER ',i10,' DEACTIVATED AT TIME ',1pe12.5)
1300  FORMAT('    TARGET MIN FORCE = ',1pe12.5,/
     .       '    CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5/)
1400  FORMAT('    TARGET MAX FORCE = ',1pe12.5,/
     .       '    CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5/)
c-----------------------------------------------------------------------      
      RETURN