read_sensor_hic.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	read_sensor_hic (sensor_ptr, sens_id, titr, laccelm, unitab, lsubmodel)

Function/Subroutine Documentation

read_sensor_hic()

subroutine read_sensor_hic	(	type (sensor_str_), intent(inout)	sensor_ptr,
		integer, intent(in)	sens_id,
		character (len=nchartitle)	titr,
		integer, dimension(3,*), intent(in)	laccelm,
		type (unit_type_), intent(in)	unitab,
		type (submodel_data), dimension(nsubmod)	lsubmodel )

Definition at line 38 of file read_sensor_hic.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------  
      USE unitab_mod
      USE message_mod
      USE submodel_mod
      USE sensor_mod
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : ncharkey, ncharfield
      USE format_mod , ONLY : lfield
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      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: SENS_ID
      INTEGER ,DIMENSION(3,*) ,INTENT(IN) :: LACCELM
      CHARACTER (len=nchartitle) TITR
      TYPE (SENSOR_STR_) ,INTENT(INOUT) :: SENSOR_PTR
      TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
      TYPE (UNIT_TYPE_)    ,INTENT(IN) ::UNITAB 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: K,SENS_TYPE,INP_FLAG,ACC_ID,IACC,IDIR,
     .   NPOINT,NPARIS,NPARRS,NVAR
      my_real :: tdel,period,hic_crit,def_gravity,gravity,tmin,
     .   fac_grav,time_unit
      CHARACTER(LEN=NCHARKEY) :: DIR
      LOGICAL :: IS_AVAILABLE
      DATA def_gravity/9.80665/
C--------------------------------
C     SENSOR BASED ON HEAD INJURY INDEX CRITERION 
C=======================================================================
      is_available = .false.
c
      sens_type = 16
      inp_flag    = 1       ! input is accelerometer ID (instead of node ID)
      npoint      = 200     ! default value
c--------------------------------------------------
card1
      CALL hm_get_floatv('Tdelay' ,tdel   ,is_available,lsubmodel,unitab)
card2
      CALL hm_get_intv  ('IACC1'  ,acc_id ,is_available,lsubmodel)
      CALL hm_get_string('DIR '   ,dir    ,ncharfield,is_available)
card3
      CALL hm_get_floatv('HIC_Period'  ,period   ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('HIC_Value'   ,hic_crit ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('HIC_Gravity' ,gravity  ,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('Tmin'        ,tmin     ,is_available,lsubmodel,unitab)
c--------------------------------------------------
c     Check input data
c--------------------------------------------------
      iacc = 0                                                              
      IF (acc_id > 0) THEN                                                  
        DO k =1,naccelm                                                     
          IF (acc_id == laccelm(2,k))THEN                                   
            iacc = k                                                        
            EXIT                                                            
          ENDIF                                                             
        ENDDO                                                               
      END IF
      IF (iacc == 0) THEN                                                 
        CALL ancmsg(msgid=45, msgtype=msgerror, anmode=aninfo_blind_2,
     .              i1=sens_id,                                         
     .              c1=titr,                                              
     .              i2=iacc)                                              
      END IF
c--------------------             
      idir = 0  
      DO k = 1,lfield                                            
        IF (dir(k:k) == 'R' .or .dir(k:k) == 'r') THEN
          idir = 1
          dir(1:1) = 'R'
        ELSE IF (dir(k:k) == 'X' .or .dir(k:k) == 'x') THEN
          idir = 2
          dir(1:1) = 'X'
        ELSE IF (dir(k:k) == 'Y' .or .dir(k:k) == 'y') THEN
          idir = 3
          dir(1:1) = 'Y'            
        ELSE IF (dir(k:k) == 'Z' .or .dir(k:k) == 'z') THEN
          idir = 4
          dir(1:1) = 'Z'            
        END IF
        IF (idir > 0) THEN
          dir(1:1) =  dir(k:k)
          EXIT         
        END IF
      ENDDO
      IF (idir == 0) THEN
        dir(1:1) =  'R'
        idir = 1
      END IF 
c--------------------             
      IF (gravity == zero) THEN
        fac_grav  = unitab%FAC_T_WORK**2 / unitab%FAC_L_WORK
        gravity   = def_gravity * fac_grav
      END IF
      IF (hic_crit == zero) hic_crit = infinity
      IF (period == zero) THEN
        period = 0.036     ! m/s
        period = period / unitab%FAC_T_WORK
      END IF
c
      time_unit = unitab%FAC_T_WORK
c-------------------------------                          
      sensor_ptr%TYPE    = sens_type
      sensor_ptr%SENS_ID = sens_id
      sensor_ptr%STATUS  = 0            ! status = deactivated
      sensor_ptr%TSTART  = infinity
      sensor_ptr%TCRIT   = infinity
      sensor_ptr%TMIN    = tmin
      sensor_ptr%TDELAY  = tdel         ! time delay before activation
      sensor_ptr%VALUE   = zero
c
      nparis = 4
      nparrs = 4
      nvar   = 4 + npoint
c
      sensor_ptr%NPARI  = nparis
      sensor_ptr%NPARR  = nparrs
      sensor_ptr%NVAR   = nvar
c
      ALLOCATE (sensor_ptr%IPARAM(nparis))
      ALLOCATE (sensor_ptr%RPARAM(nparrs))
      ALLOCATE (sensor_ptr%VAR(nvar))
      sensor_ptr%VAR(:) = zero
c
      sensor_ptr%IPARAM(1) = inp_flag
      sensor_ptr%IPARAM(2) = iacc
      sensor_ptr%IPARAM(3) = npoint
      sensor_ptr%IPARAM(4) = idir
c
      sensor_ptr%RPARAM(1) = period
      sensor_ptr%RPARAM(2) = hic_crit
      sensor_ptr%RPARAM(3) = gravity          
      sensor_ptr%RPARAM(4) = time_unit          
c-----------------------------------------------------------------------
      WRITE (iout, 1000) sens_id,tdel
      WRITE (iout, 2000) acc_id,dir(1:1),tdel,period,hic_crit,tmin,gravity
c-----------------------------------------------------------------------
 1000 FORMAT(
     . 5x,'    SENSOR TYPE 16: HIC   '/,
     . 5x,'    -------------------   '/,
     . 5x,'SENSOR ID. . . . . . . . . . . . . . . . .=',i10/
     . 5x,'TIME DELAY BEFORE ACTIVATION . . . . . . .=',e12.4)
 2000 FORMAT(
     . 5x,'ACCELEROMETER ID . . . . . . . . . . . . =',i10/
     . 5x,'DIRECTION. . . . . . . . . . . . . . . . =',a10/
     . 5x,'TIME DELAY BEFORE ACTIVATION . . . . . . =',e12.4/
     . 5x,'HIC PERIOD . . . . . . . . . . . . . . . =',e12.4/,
     . 5x,'HIC CRITERION. . . . . . . . . . . . . . =',e12.4/,
     . 5x,'HIC DURATION TO ACTIVATE . . . . . . . . =',e12.4/,
     . 5x,'GRAVITY VALUE. . . . . . . . . . . . . . =',e12.4//)
c-----------
      RETURN