sensor_base.F

Go to the documentation of this file.

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/.
!||====================================================================
!||    sensor_base             ../engine/source/tools/sensor/sensor_base.F
!||--- called by ------------------------------------------------------
!||    resol                   ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                  ../engine/source/output/message/message.F
!||    arret                   ../engine/source/system/arret.F
!||    sensor_acc              ../engine/source/tools/sensor/sensor_acc.F
!||    sensor_contact          ../engine/source/tools/sensor/sensor_contact.F
!||    sensor_dist             ../engine/source/tools/sensor/sensor_dist.F
!||    sensor_dist_surf        ../engine/source/tools/sensor/sensor_dist_surf.F
!||    sensor_energy           ../engine/source/tools/sensor/sensor_energy.F
!||    sensor_gauge            ../engine/source/tools/sensor/sensor_gauge.F
!||    sensor_hic              ../engine/source/tools/sensor/sensor_hic.F
!||    sensor_nic              ../engine/source/tools/sensor/sensor_nic.f
!||    sensor_python           ../engine/source/tools/sensor/sensor_python.F90
!||    sensor_rbody            ../engine/source/tools/sensor/sensor_rbody.F
!||    sensor_rwall            ../engine/source/tools/sensor/sensor_rwall.F
!||    sensor_section          ../engine/source/tools/sensor/sensor_section.F
!||    sensor_temp             ../engine/source/tools/sensor/sensor_temp.F
!||    sensor_time             ../engine/source/tools/sensor/sensor_time.F
!||    sensor_vel              ../engine/source/tools/sensor/sensor_vel.F
!||    sensor_work             ../engine/source/tools/sensor/sensor_work.F
!||--- uses       -----------------------------------------------------
!||    groupdef_mod            ../common_source/modules/groupdef_mod.F
!||    message_mod             ../engine/share/message_module/message_mod.F
!||    python_funct_mod        ../common_source/modules/python_mod.F90
!||    sensor_mod              ../common_source/modules/sensor_mod.F90
!||    sensor_python_mod       ../engine/source/tools/sensor/sensor_python.F90
!||====================================================================
      SUBROUTINE sensor_base(SENSORS  ,NSENSOR   ,TIME      ,TIMESTEP  ,
     .           XSENS     ,IPARI     ,PARTSAV2  ,GAUGE     ,FSAV      ,
     .           X         ,V         ,A         ,ACC       ,NPRW      ,
     .           SUBSET    ,IGRSURF   ,IGRNOD    ,PYTHON)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE python_funct_mod
      USE sensor_python_mod
      USE groupdef_mod
      USE sensor_mod
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.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      "userlib.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER                           ,INTENT(IN) :: NSENSOR
      INTEGER ,DIMENSION(NPARI,NINTER)  ,INTENT(IN) :: IPARI
      INTEGER ,DIMENSION(*)             ,INTENT(IN) :: NPRW
      my_real ,DIMENSION(3,NUMNOD)      ,INTENT(IN) :: x,v,a
      my_real ,DIMENSION(12,NSENSOR)    ,INTENT(INOUT) :: xsens
      my_real ,DIMENSION(LLACCELM,*)    ,INTENT(IN) :: acc
      my_real ,DIMENSION(NTHVKI,*)      ,INTENT(IN) :: fsav
      my_real ,DIMENSION(LLGAUGE,*)     ,INTENT(IN) :: gauge
      my_real ,DIMENSION(2,*)           ,INTENT(IN) :: partsav2
      my_real ,INTENT(IN) :: time,timestep
      TYPE (SUBSET_) ,DIMENSION(NSUBS)  ,INTENT(IN) :: SUBSET
      TYPE(surf_)    ,DIMENSION(NSURF)  ,INTENT(IN) :: IGRSURF
      TYPE(group_)   ,DIMENSION(NGRNOD) ,INTENT(IN) :: IGRNOD
      TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
      TYPE(python_), INTENT(INOUT) :: PYTHON
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER TYP,ISENS,SENS_ID,SIZE,STABS,SFSAV
      CHARACTER(LEN=256) :: OPTION
      LOGICAL :: ANY_PYTHON_SENSOR
      INTEGER, DIMENSION(:), ALLOCATABLE :: UIDS
      DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: RESULTS
      INTEGER, DIMENSION(:), ALLOCATABLE :: STATUSES
      INTEGER, DIMENSION(:), ALLOCATABLE :: TYPES
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C     this routine checks activation condition of all basic sensor types
C=======================================================================
      any_python_sensor = .false.
      stabs   = sensors%STABSEN 
      sfsav   = sensors%SFSAV
c--------------------------------------------------
c     Parallel loop over sensor list
c--------------------------------------------------
 
!$OMP PARALLEL DO PRIVATE(ISENS,TYP)
c--------------------------------------------------
      DO isens = 1,nsensor
        sensors%SENSOR_TAB(isens)%RESULTS(sensor_result_size) = zero
        typ = sensors%SENSOR_TAB(isens)%TYPE
C--------------------------------
C       SENSOR - TIME
C--------------------------------
        IF (typ == 0) THEN
 
          CALL sensor_time(sensors%SENSOR_TAB(isens) ,time   ,timestep)
 
C--------------------------------
C       SENSOR - ACCELEROMETER
C--------------------------------
        ELSEIF (typ == 1) THEN
c
          CALL sensor_acc(sensors%SENSOR_TAB(isens) ,acc)
c
C--------------------------------
C       SENSOR - DISTANCE
C--------------------------------
        ELSEIF (typ == 2) THEN
c
          CALL sensor_dist(sensors%SENSOR_TAB(isens) ,x    ,xsens(1,isens))
c
C--------------------------------
C       SENSOR - CONTACT
C--------------------------------
        ELSEIF (typ == 6)THEN
          CALL sensor_contact(sensors%SENSOR_TAB(isens),
     .         ipari    ,sfsav   ,stabs   ,sensors%TABSENSOR   ,sensors%FSAV)
 
C--------------------------------
C       SENSOR - RWALL
C--------------------------------
        ELSEIF(typ == 7)THEN
 
          CALL sensor_rwall(sensors%SENSOR_TAB(isens) ,
     .         nprw    ,sfsav   ,stabs   ,sensors%TABSENSOR   ,sensors%FSAV)
 
C--------------------------------
C       SENSOR - NODAL VELOCITY
C--------------------------------
        ELSEIF(typ == 9)THEN
 
          CALL sensor_vel(sensors%SENSOR_TAB(isens),v)
 
C--------------------------------
C       SENSOR - GAUGE
C--------------------------------
        ELSEIF (typ == 10) THEN
 
          CALL sensor_gauge(sensors%SENSOR_TAB(isens) ,gauge)
 
C--------------------------------
C       SENSOR - RBODY
C--------------------------------
        ELSEIF (typ == 11) THEN
 
          CALL sensor_rbody(sensors%SENSOR_TAB(isens),sfsav   ,stabs   ,sensors%TABSENSOR,sensors%FSAV)
 
 
C--------------------------------
C       SENSOR - SECTION
C--------------------------------
        ELSEIF (typ == 12) THEN
 
          CALL sensor_section(sensors%SENSOR_TAB(isens),
     .         sfsav   ,stabs   ,sensors%TABSENSOR   ,fsav   ,sensors%FSAV  )
 
C--------------------------------
C       SENSOR WORK
C--------------------------------
        ELSEIF (typ == 13)THEN
 
          CALL sensor_work(sensors%SENSOR_TAB(isens),x   ,xsens(1,isens)   ,
     .         sfsav   ,stabs   ,sensors%TABSENSOR      ,sensors%FSAV  )
c
c--------------------------------
c       SENSOR --- ENERGY ---
c--------------------------------        
        ELSEIF (typ == 14) THEN
 
          CALL sensor_energy(sensors%SENSOR_TAB(isens),isens ,subset,partsav2,
     *                       sensors%NSENSOR,sensors%SENSOR_STRUCT )
c
c--------------------------------
c       SENSOR Distance to surface
C--------------------------------
        ELSEIF (typ == 15) THEN
c
          CALL sensor_dist_surf(sensors%SENSOR_TAB(isens) ,x   ,igrsurf  )
c
c--------------------------------
c       SENSOR HIC
c--------------------------------
        ELSEIF (typ == 16) THEN
c
          CALL sensor_hic(sensors%SENSOR_TAB(isens) ,a   ,acc  )
c
c--------------------------------
c       SENSOR TEMPERATURE
c--------------------------------
        ELSEIF (typ == 17) THEN
c
          CALL sensor_temp(sensors%SENSOR_TAB(isens) ,isens ,igrnod)
c
c--------------------------------
        ELSEIF (typ == 19) THEN
c--------------------------------
c       SENSOR NIC-Nij
c
          CALL sensor_nic(sensors%SENSOR_TAB(isens) )
c
c--------------------------------
        ELSEIF (typ == 29) THEN
c--------------------------------
c       USER SENSOR TYPE 29
 
          sens_id  = sensors%SENSOR_TAB(isens)%SENS_ID
 
          IF (userl_avail==1) THEN
              CALL eng_userlib_user_sens(typ,sens_id)
          ELSE
              ! ----------------
              ! ERROR to be printed & exit
              option='USER SENSOR 29'
              size=len_trim(option)
              CALL ancmsg(msgid=257,c1=option(1:size),anmode=aninfo)
              CALL arret(2)
             ! ----------------
          ENDIF
c--------------------------------
        ELSEIF (typ == 30) THEN
c--------------------------------
c       USER SENSOR TYPE 30
 
          sens_id  = sensors%SENSOR_TAB(isens)%SENS_ID
 
          IF (userl_avail==1) THEN
              CALL eng_userlib_user_sens(typ,sens_id)
          ELSE
              ! ----------------
              ! ERROR to be printed & exit
              option='USER SENSOR 30'
              size=len_trim(option)
              CALL ancmsg(msgid=257,c1=option(1:size),anmode=aninfo)
              CALL arret(2)
             ! ----------------
          ENDIF
c--------------------------------
        ELSEIF (typ == 31) THEN
c--------------------------------
c       USER SENSOR TYPE 31
          sens_id  = sensors%SENSOR_TAB(isens)%SENS_ID
 
          IF (userl_avail==1) THEN
              CALL eng_userlib_user_sens(typ,sens_id)
          ELSE
              ! ----------------
              ! ERROR to be printed & exit
              option='USER SENSOR 31'
              size=len_trim(option)
              CALL ancmsg(msgid=257,c1=option(1:size),anmode=aninfo)
              CALL arret(2)
             ! ----------------
          ENDIF
       ELSEIF (typ == sensor_type_python) THEN
c         CALL SENSOR_PYTHON(SENSORS%SENSOR_TAB(ISENS) )
         any_python_sensor = .true.
       ENDIF  ! TYP 
c----
      END DO  ! ISENS
c--------------------------------------------------
c     END of parallel loop
!$OMP END PARALLEL DO
c--------------------------------------------------
      IF(python%NB_FUNCTS > 0) THEN
        ALLOCATE(uids(nsensor))
        ALLOCATE(results(sensor_result_size,nsensor))
        ALLOCATE(statuses(nsensor))
        ALLOCATE(types(nsensor))
        DO isens = 1,nsensor
          typ = sensors%SENSOR_TAB(isens)%TYPE
          types(isens) = typ
          uids(isens) = sensors%SENSOR_TAB(isens)%SENS_ID
          statuses(isens) = sensors%SENSOR_TAB(isens)%STATUS 
          results(1:sensor_result_size,isens) = sensors%SENSOR_TAB(isens)%RESULTS(1:sensor_result_size)
        END DO  ! ISENS
        CALL python_update_sensors(types,uids,statuses,results,nsensor)
        DEALLOCATE(types)
        DEALLOCATE(uids)
        DEALLOCATE(results)
        DEALLOCATE(statuses)
      ENDIF
      IF (any_python_sensor) THEN
        DO isens = 1,nsensor
          typ = sensors%SENSOR_TAB(isens)%TYPE
          IF (typ == sensor_type_python) THEN
            CALL sensor_python(sensors%SENSOR_TAB(isens))
          ENDIF  ! TYP 
        END DO  ! ISENS
      ENDIF
c
c--------------------------------------------------
      IF (stabs > 0) sensors%FSAV(1:12,1:6,1:sfsav) = zero
 
c-----------
      RETURN
      END