read__sensor__hic_8F_source.html

Copyright>        OpenRadioss

Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.

Copyright>

Copyright>        This program is free software: you can redistribute it and/or modify

Copyright>        it under the terms of the GNU Affero General Public License as published by

Copyright>        the Free Software Foundation, either version 3 of the License, or

Copyright>        (at your option) any later version.

Copyright>

Copyright>        This program is distributed in the hope that it will be useful,

Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of

Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

Copyright>        GNU Affero General Public License for more details.

Copyright>

Copyright>        You should have received a copy of the GNU Affero General Public License

Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.

Copyright>

Copyright>

Copyright>        Commercial Alternative: Altair Radioss Software

Copyright>

Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss

Copyright>        software under a commercial license.  Contact Altair to discuss further if the

Copyright>        commercial version may interest you: https://www.altair.com/radioss/.

!||====================================================================

!||    read_sensor_hic        ../starter/source/tools/sensor/read_sensor_hic.F

!||--- called by ------------------------------------------------------

!||    hm_read_sensors        ../starter/source/tools/sensor/hm_read_sensors.F

!||--- calls      -----------------------------------------------------

!||    ancmsg                 ../starter/source/output/message/message.F

!||    hm_get_floatv          ../starter/source/devtools/hm_reader/hm_get_floatv.F

!||    hm_get_intv            ../starter/source/devtools/hm_reader/hm_get_intv.F

!||    hm_get_string          ../starter/source/devtools/hm_reader/hm_get_string.F

!||--- uses       -----------------------------------------------------

!||    format_mod             ../starter/share/modules1/format_mod.F90

!||    hm_option_read_mod     ../starter/share/modules1/hm_option_read_mod.F

!||    message_mod            ../starter/share/message_module/message_mod.F

!||    submodel_mod           ../starter/share/modules1/submodel_mod.F

!||====================================================================


      SUBROUTINE read_sensor_hic(SENSOR_PTR ,SENS_ID  ,TITR      ,

     .           LACCELM  ,UNITAB   ,LSUBMODEL )

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


      END

my_real
#define my_real
Definition cppsort.cpp:32

hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415

hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523

hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76

id
initmumps id
Definition multiplerhs_example.m:4

hm_option_read_mod
Definition hm_option_read_mod.F:408

message_mod
Definition message_mod.F:1249

names_and_titles_mod
Definition names_and_titles_mod.F:997

names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000

names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005

submodel_mod
Definition submodel_mod.F:712

unitab_mod
Definition unitab_mod.F:513

nvar
integer function nvar(text)
Definition nvar.F:32

read_sensor_hic
subroutine read_sensor_hic(sensor_ptr, sens_id, titr, laccelm, unitab, lsubmodel)
Definition read_sensor_hic.F:40

ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889