read_sensor_user.F File Reference

#include "implicit_f.inc"
#include "scr17_c.inc"
#include "units_c.inc"
#include "scr15_c.inc"
#include "userlib.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	read_sensor_user (hm_nsensor, isen, title, unitab, lsubmodel, key, unit_id, sens_id, sensor_ptr, sensor_user_struct)

Function/Subroutine Documentation

read_sensor_user()

subroutine read_sensor_user	(	integer, intent(in)	hm_nsensor,
		integer, intent(in)	isen,
		character(len=nchartitle)	title,
		type (unit_type_), intent(in)	unitab,
		type (submodel_data), dimension(nsubmod)	lsubmodel,
		character(len=ncharkey)	key,
		integer, intent(in)	unit_id,
		integer, intent(in)	sens_id,
		type (sensor_str_), intent(out)	sensor_ptr,
		type(sensor_user_struct_), intent(inout)	sensor_user_struct )

Definition at line 42 of file read_sensor_user.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------  
      USE unitab_mod
      USE message_mod
      USE submodel_mod
      USE sensor_mod
      USE names_and_titles_mod , ONLY : ncharline, ncharkey
      USE format_mod ,ONLY :  fmt_f
      USE reader_old_mod , ONLY : key0, kcur, kline, line
      USE user_interface_mod,only : ksens_cur
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      "scr17_c.inc"
#include      "units_c.inc"
#include      "scr15_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) :: HM_NSENSOR,UNIT_ID ,SENS_ID,ISEN
      CHARACTER(LEN=ncharkey) :: KEY
      CHARACTER(LEN=nchartitle) :: TITLE
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
      TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
      TYPE (SENSOR_STR_)   ,INTENT(OUT)        :: SENSOR_PTR
      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 I,J,TYP
      my_real :: tdel
      LOGICAL :: IS_AVAILABLE
      LOGICAL :: ALREADY_DONE
      INTEGER NLINES
      CHARACTER(LEN=ncharline) :: RLINE
      CHARACTER (LEN=4) :: CSENS
      CHARACTER(LEN=4096) :: SCR_FILE_NAME
      INTEGER SCR_FILE_NAME_LEN
!
      CHARACTER(LEN=NCHARLINE) :: IUSER_KEY
      CHARACTER OPTION*256
      INTEGER SIZE
C=======================================================================
!
!     User libraries use the SET_U_SENS_xxx routines - it uses KSENS_CUR parameter.
      ksens_cur = isen
 
      IF(key(1:5)     == 'USER1')THEN
        typ=29
      ELSEIF(key(1:5) == 'USER2')THEN
        typ=30
      ELSEIF(key(1:5) == 'USER3')THEN
        typ=31
      ELSE
        CALL ancmsg(msgid=43,
     .              anmode=aninfo,
     .              msgtype=msgerror,
     .              c2=key(1:len_trim(key)),
     .              i1=sens_id,
     .              c1=title)
      ENDIF
c--------------------------------------------------
      is_available = .false.
      already_done = .false.
c--------------------------------------------------
      iuser_key = key(1:len_trim(key))
      IF (userl_avail == 0)THEN
      ! ERROR to be printed & exit
        option='/SENSOR/'//iuser_key
        size=len_trim(option)
        CALL ancmsg(msgid=1130,
     .              msgtype=msgerror,c1=option(1:size),anmode=aninfo)
        CALL arret(2)
      ENDIF
!------------
!     READING
!------------
      CALL hm_get_intv ('Number_of_datalines' ,nlines ,is_available, lsubmodel)
!
      IF (nlines > 1) THEN
!
!
        IF ((typ>28.AND.typ<38).AND. .NOT.(already_done) ) CALL sensor_user_alloc(already_done,sensor_user_struct)
!
c---------------------------------------
        IF (typ>=29.AND.typ<=31) THEN
C--------------------------------
C         USER SENSOR
C--------------------
 
          ! Allocate Userbuffer Sensors
          ! Global sensor variables / Not need with user sensors
          sensor_ptr%NPARI  = 0
          sensor_ptr%NPARR  = 0
          sensor_ptr%NVAR  = 0
          ALLOCATE(sensor_ptr%IPARAM(sensor_ptr%NPARI))
          ALLOCATE(sensor_ptr%RPARAM(sensor_ptr%NPARR))
          ALLOCATE(sensor_ptr%VAR(sensor_ptr%NVAR))
          ! User Sensor Buffer
          ALLOCATE(sensor_ptr%INTEGER_USERBUF(isenbuf))
          ALLOCATE(sensor_ptr%FLOAT_USERBUF(lsenbuf))
 
          ALLOCATE(sensor_ptr%INTEGER_USERPARAM(nsenpari))
          ALLOCATE(sensor_ptr%FLOAT_USERPARAM(nsenparr))
 
          ! Initialize to Zero
          sensor_ptr%INTEGER_USERBUF(1:isenbuf)=0
          sensor_ptr%FLOAT_USERBUF(1:lsenbuf)=zero
 
          sensor_ptr%INTEGER_USERPARAM(1:nsenpari)=0
          sensor_ptr%FLOAT_USERPARAM(1:nsenparr)=zero
 
 
          IF (userl_avail==1 .AND. (typ==29.OR.typ==30.OR.typ==31)) THEN
!
            WRITE(csens,'(I4.4)')typ
            scr_file_name='SI'//rootnam(1:rootlen)//'_'//csens//'.scr'
            scr_file_name_len=len_trim(scr_file_name)
            OPEN(unit=30,file=trim(scr_file_name),form='FORMATTED',recl=ncharline)
!
            j=1
            CALL hm_get_string_index('arraydatalines', rline, j, ncharline, is_available)
            READ(rline,err=999,fmt=fmt_f)tdel
 
C           global activation time
            sensor_ptr%TDELAY  = tdel
!
           ! Read & Dump in scratch file
            DO j=2,nlines
              CALL hm_get_string_index('arraydatalines', rline, j, ncharline, is_available)
              WRITE(30,fmt='(A)')trim(rline)
            ENDDO
            CLOSE(unit=30)
          ENDIF ! IF (TYP>=29.AND.TYP<=31)
!
 
          WRITE (iout,'(A,I10)') ' SENSOR ID = ', sens_id
 
 
          sensor_ptr%TYPE    = typ   ! TYP initialization is need for callback routines
 
          IF(typ == 29)THEN
 
            WRITE (iout,'(A,/,A,I10)') ' TYPE 29 SENSOR : USER1'
            WRITE (iout,'(A,1PG20.13)') ' TIME DELAY BEFORE ACTIVATION . . . . .',tdel
 
            sensor_ptr%TSTART  = infinity
 
            IF (userl_avail==1)THEN
              CALL st_userlib_lecsen(typ,rootnam,rootlen)
              CALL user_output(iout,typ,rootnam,rootlen,1)
            ENDIF
 
          ELSEIF(typ == 30)THEN
 
            WRITE (iout,'(A,/,A,I10)') ' TYPE 30 SENSOR : USER2'
            WRITE (iout,'(A,1PG20.13)') ' TIME DELAY BEFORE ACTIVATION . . . . .',tdel
 
            sensor_ptr%TSTART  = infinity
 
            IF (userl_avail==1)THEN
              CALL st_userlib_lecsen(typ,rootnam,rootlen)
              CALL user_output(iout,typ,rootnam,rootlen,1)
            ENDIF
 
          ELSEIF(typ == 31)THEN
 
            WRITE (iout,'(A,/,A,I10)') ' TYPE 31 SENSOR : USER3'
            WRITE (iout,'(A,1PG20.13)') ' TIME DELAY BEFORE ACTIVATION . . . . .',tdel
 
            sensor_ptr%TSTART  = infinity
 
            IF (userl_avail==1)THEN
              CALL st_userlib_lecsen(typ,rootnam,rootlen)
              CALL user_output(iout,typ,rootnam,rootlen,1)
            ENDIF
 
          ENDIF
        ELSE
            CALL ancmsg(msgid=43,
     .                  anmode=aninfo,
     .                  msgtype=msgerror,
     .                  c2=key(1:len_trim(key)),
     .                  i1=sens_id,
     .                  c1=title)
        ENDIF ! IF (TYP>=29.AND.TYP<=31)
 
        sensor_ptr%TYPE    = typ
        sensor_ptr%SENS_ID = sens_id
        sensor_ptr%STATUS  = 0
        sensor_ptr%TDELAY  = tdel
        sensor_ptr%TSTART  = infinity
        sensor_ptr%TCRIT   = infinity
        sensor_ptr%TMIN    = zero
!
      ELSE
!   error TBD
      ENDIF ! IF(NLINES > 0)THEN
C-----------
      RETURN
 999  CALL ancmsg(msgid=55,anmode=aninfo,msgtype=msgerror,c1=key0(kcur),c2=kline,c3=line)
      CALL arret(2)
C-----------
      RETURN