hm_read_sensors.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_sensors (python, sensors, laccelm, itabm1, ipart, lgauge, subset, nsets, igrsurf, igrnod, bufsf, skew, iskwn, unitab, lsubmodel, hm_nsens, sensor_user_struct)

Function/Subroutine Documentation

hm_read_sensors()

subroutine hm_read_sensors	(	type(python_), intent(inout)	python,
		type (sensors_), intent(inout), target	sensors,
		integer, dimension(3,*), intent(in)	laccelm,
		integer, dimension(*), intent(in)	itabm1,
		integer, dimension(lipart1,*), intent(in)	ipart,
		integer, dimension(3,*), intent(in)	lgauge,
		type (subset_), dimension(nsubs)	subset,
		integer, intent(in)	nsets,
		type (surf_), dimension(nsurf+nsets)	igrsurf,
		type (group_), dimension(ngrnod)	igrnod,
		dimension(*)	bufsf,
		dimension(lskew,*)	skew,
		integer, dimension(liskn,*), intent(in)	iskwn,
		type (unit_type_), intent(in)	unitab,
		type (submodel_data), dimension(nsubmod)	lsubmodel,
		integer, intent(out)	hm_nsens,
		type(sensor_user_struct_), intent(inout)	sensor_user_struct )

Definition at line 63 of file hm_read_sensors.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE python_funct_mod
      USE my_alloc_mod  
      USE unitab_mod
      USE message_mod
      USE groupdef_mod
      USE inoutfile_mod
      USE surf_mod
      USE submodel_mod
      USE sensor_mod
      USE hm_option_read_mod
      USE read_sensor_python_mod, ONLY : read_sensor_python
      USE names_and_titles_mod , ONLY : nchartitle
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      "scr17_c.inc"
#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-----------------------------------------------
      TYPE(PYTHON_), intent(inout) :: PYTHON
      INTEGER ,INTENT(IN)  :: NSETS
      INTEGER ,INTENT(OUT) :: HM_NSENS
      INTEGER ,DIMENSION(*)   ,INTENT(IN) :: ITABM1
      INTEGER ,DIMENSION(3,*) ,INTENT(IN) :: LACCELM,LGAUGE
      INTEGER ,DIMENSION(LISKN,*)   ,INTENT(IN) :: ISKWN
      INTEGER ,DIMENSION(LIPART1,*) ,INTENT(IN) :: IPART
      my_real ,DIMENSION(LSKEW,*) :: skew
      my_real ,DIMENSION(*)       :: bufsf
      TYPE (SENSORS_) ,INTENT(INOUT) ,TARGET   :: SENSORS
      TYPE (SURF_)       ,DIMENSION(NSURF+NSETS)     :: IGRSURF
      TYPE (GROUP_)      ,DIMENSION(NGRNOD)    :: IGRNOD
      TYPE (SUBSET_)     ,DIMENSION(NSUBS)     :: SUBSET
      TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
      TYPE (UNIT_TYPE_)  ,INTENT(IN) ::UNITAB 
      TYPE(SENSOR_USER_STRUCT_) ,INTENT(INOUT) :: SENSOR_USER_STRUCT
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ISEN,IUNIT,IFLAGUNIT,NS,TYP,UNIT_ID,SENS_ID
      my_real :: bid
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER KEY*40,MESS*40
      INTEGER ,DIMENSION(:) ,ALLOCATABLE   :: SID
      TYPE(PYTHON_FUNCTION), DIMENSION(:), ALLOCATABLE :: temp
      DATA mess/'SENSOR DEFINITION                       '/
C=======================================================================
c     Initialize sensor data structure
c---------------------------------------------
      CALL hm_option_count('/SENSOR', hm_nsens)
      CALL hm_option_count('/SENSOR/PYTHON', ns)
      IF(ns > 0) THEN
        call python_initialize(python_error)
        if(.not. allocated(python%functs)) then 
          allocate(python%functs(ns))
        else
          allocate(temp(python%nb_functs + ns))
          temp(1:python%nb_functs) = python%functs
          CALL move_alloc(from=temp,to=python%functs)
        endif
      END IF
      IF (hm_nsens > 0) THEN
        WRITE(istdo,'(A)')' .. SENSORS'
        WRITE (iout,'(///,A)')'          SENSORS'
        WRITE (iout,'(A/)')   '          -------'
      END IF
c---------------------------------------------
      IF (ALLOCATED(sensors%SENSOR_TAB)) DEALLOCATE(sensors%SENSOR_TAB)
      ALLOCATE(sensors%SENSOR_TAB(hm_nsens))
      CALL my_alloc (sid,hm_nsens)
      sensors%NSENSOR = hm_nsens
c
      CALL sensor_tab_init(sensors)
c
      CALL hm_option_start('/SENSOR')
c
c---------------------------------------------------
c
      DO isen = 1,hm_nsens
c            
        CALL hm_option_read_key(lsubmodel,
     .                          option_id   = sens_id,
     .                          option_titr = titr  ,
     .                          unit_id     = unit_id   ,
     .                          keyword2    = key   )
c--------------------------------------------------
c       CHECK IF UNIT_ID EXISTS
c--------------------------------------------------
        iflagunit = 0
        DO iunit=1,unitab%NUNITS
          IF (unitab%UNIT_ID(iunit) == unit_id) THEN
            iflagunit = 1
            EXIT
          ENDIF
        ENDDO
        IF (unit_id > 0 .AND. iflagunit == 0) THEN
          CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
     .                i2=unit_id,i1=sens_id,
     .                c1='SENSOR', c2='SENSOR', c3='TITR')                              
        ENDIF
c
        key = key(1:len_trim(key))
c-----------------------
        SELECT CASE(key)
c-----------------------
          CASE ('TIME' ,'TYPE0')
            CALL read_sensor_time(sensors%SENSOR_TAB(isen) ,sens_id  ,unitab   ,lsubmodel)  
c
          CASE ('ACCE' ,'TYPE1')
            CALL read_sensor_acc(sensors%SENSOR_TAB(isen) ,sens_id  ,titr     , 
     .           laccelm  ,unitab   ,lsubmodel)  
c
          CASE ('DIST' ,'TYPE2')
            CALL read_sensor_disp(sensors%SENSOR_TAB(isen) ,sens_id  ,
     .           itabm1   ,unitab   ,lsubmodel)   
c
          CASE ('SENS' ,'TYPE3')
            CALL read_sensor_sens(sensors%SENSOR_TAB(isen) ,sens_id  ,unitab   ,lsubmodel)
c
          CASE ('AND' ,'TYPE4')
            CALL read_sensor_and(sensors%SENSOR_TAB(isen) ,sens_id  ,unitab   ,lsubmodel)
c
          CASE ('OR' ,'TYPE5')
            CALL read_sensor_or(sensors%SENSOR_TAB(isen) ,sens_id  ,unitab   ,lsubmodel)
c
          CASE ('INTER' ,'TYPE6')
            CALL read_sensor_contact(sensors%SENSOR_TAB(isen) ,sens_id  ,titr     ,
     .           unitab   ,lsubmodel)
c
          CASE ('RWALL' ,'TYPE7')
            CALL read_sensor_rwall(sensors%SENSOR_TAB(isen) ,sens_id  ,titr     ,
     .           unitab   ,lsubmodel)
c
          CASE ('NOT' ,'TYPE8')
            CALL read_sensor_not(sensors%SENSOR_TAB(isen) ,sens_id  ,unitab   ,lsubmodel)
c
          CASE ('VEL' ,'TYPE9')
            CALL read_sensor_vel(sensors%SENSOR_TAB(isen) ,sens_id  ,
     .           itabm1   ,unitab   ,lsubmodel)   
c
          CASE ('GAUGE' ,'TYPE10')            
            CALL read_sensor_gauge(sensors%SENSOR_TAB(isen) ,sens_id  ,titr     ,
     .           lgauge   ,unitab   ,lsubmodel)
c
          CASE ('RBODY' ,'TYPE11')
            CALL read_sensor_rbody(sensors%SENSOR_TAB(isen) ,sens_id  ,titr     ,
     .           unitab   ,lsubmodel)
c
          CASE ('SECT' ,'TYPE12')
            CALL read_sensor_sect(sensors%SENSOR_TAB(isen) ,sens_id  ,titr     ,
     .           unitab   ,lsubmodel)
c
          CASE ('WORK' ,'TYPE13')
            CALL read_sensor_work(sensors%SENSOR_TAB(isen) ,sens_id  ,
     .           itabm1   ,unitab   ,lsubmodel)   
c
          CASE ('ENERGY' ,'TYPE14')
            CALL read_sensor_energy(sensors%SENSOR_TAB(isen) ,sens_id  ,titr     ,
     .           ipart   ,subset   ,unitab  ,lsubmodel)
c
          CASE ('DIST_SURF' ,'TYPE15')
            CALL read_sensor_dist_surf(sensors%SENSOR_TAB(isen) ,sens_id  ,
     .           itabm1   ,unitab   ,lsubmodel)   
c
          CASE ('HIC' ,'TYPE16')
            CALL read_sensor_hic(sensors%SENSOR_TAB(isen) ,sens_id  ,titr     , 
     .           laccelm  ,unitab   ,lsubmodel)  
c
          CASE ('TEMP')
            CALL read_sensor_temp(sensors%SENSOR_TAB(isen)  ,sens_id     ,titr     , 
     .           igrnod   ,unitab   ,lsubmodel)   
c
          CASE ('NIC_NIJ')
            CALL read_sensor_nic(
     .           sensors%SENSOR_TAB(isen)  ,sens_id    ,titr     ,iskwn    , 
     .           unitab      ,lsubmodel  )   
c
          CASE ('USER1' ,'USER2','USER3')
 
            sensors%SENSOR_TAB(isen)%TSTART = infinity
 
            CALL read_sensor_user(hm_nsens ,isen    ,titr,
     .           unitab    ,lsubmodel      ,key     ,unit_id ,sens_id ,
     .           sensors%SENSOR_TAB(isen),sensor_user_struct)
            sensors%SENSOR_TAB(isen)%SENS_ID = sens_id
          CASE('PYTHON')
            CALL read_sensor_python(python,
     .           sensors%SENSOR_TAB(isen)  ,sens_id    , lsubmodel  )   
 
          CASE DEFAULT
            CALL ancmsg(msgid=43, anmode=aninfo, msgtype=msgerror,
     .                  c2=key(1:len_trim(key)),
     .                  i1=sens_id,
     .                  c1=titr)        
        END SELECT 
c
        sensors%SENSOR_TAB(isen)%TITLE = titr
c-----------------
      END DO  ! NSENSOR
c-------------------------------------
c     Recherche des ID doubles  : activate this code when lecsen is removed
c-------------------------------------
      DO isen = 1,sensors%NSENSOR
        IF (sensors%SENSOR_TAB(isen)%SENS_ID > 0)  THEN
          sid(isen) = sensors%SENSOR_TAB(isen)%SENS_ID
        END IF
      END DO
      CALL udouble(sid,1,sensors%NSENSOR,mess,0,bid)
      DEALLOCATE(sid)
c-----------
      RETURN