OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_sensor_disp.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine read_sensor_disp (sensor_ptr, sens_id, itabm1, unitab, lsubmodel)

Function/Subroutine Documentation

◆ read_sensor_disp()

subroutine read_sensor_disp ( type (sensor_str_) sensor_ptr,
integer, intent(in) sens_id,
integer, dimension(numnod), intent(in) itabm1,
type (unit_type_), intent(in) unitab,
type (submodel_data), dimension(nsubmod) lsubmodel )

Definition at line 38 of file read_sensor_disp.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE unitab_mod
44 USE message_mod
45 USE submodel_mod
46 USE sensor_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C A n a l y s e M o d u l e
54C-----------------------------------------------
55#include "analyse_name.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com01_c.inc"
60#include "com04_c.inc"
61#include "units_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER ,INTENT(IN) :: SENS_ID
66 INTEGER ,DIMENSION(NUMNOD) ,INTENT(IN) :: ITABM1
67 TYPE (SENSOR_STR_) :: SENSOR_PTR
68 TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
69 TYPE (UNIT_TYPE_) ,INTENT(IN) ::UNITAB
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER :: NOD1,NOD2,N1,N2,NS,NPARIS,NPARRS,NVAR,SENS_TYPE,DFLAG,P
74 my_real :: tdel,tmin,dmin,dmax
75 CHARACTER MESS*40
76 LOGICAL :: IS_AVAILABLE
77 DATA mess/'SENSOR DEFINITION '/
78C-----------------------------------------------
79C E x t e r n a l F u n c t i o n s
80C-----------------------------------------------
81 INTEGER USR2SYS
82C--------------------------------
83C SENSOR BASED ON RELATIVE DISPLACEMENT OF TWO NODES
84C=======================================================================
85 is_available = .false.
86 sens_type = 2
87c--------------------------------------------------
88card1
89 CALL hm_get_floatv('Tdelay' ,tdel ,is_available,lsubmodel,unitab)
90card2
91 CALL hm_get_intv ('N1' ,nod1 ,is_available,lsubmodel)
92 CALL hm_get_intv ('N2' ,nod2 ,is_available,lsubmodel)
93 CALL hm_get_floatv('Dmin' ,dmin ,is_available,lsubmodel,unitab)
94 CALL hm_get_floatv('Dmax' ,dmax ,is_available,lsubmodel,unitab)
95 CALL hm_get_floatv('Tmin' ,tmin ,is_available,lsubmodel,unitab)
96 CALL hm_get_intv ('Dflag' ,dflag ,is_available,lsubmodel)
97c--------------------------------------------------
98c Check input data
99c--------------------------------------------------
100 n1 = usr2sys(nod1,itabm1,mess,ns)
101 n2 = usr2sys(nod2,itabm1,mess,ns)
102 CALL anodset(n1, check_used)
103 CALL anodset(n2, check_used)
104 DO p = 1, nspmd
105 CALL ifrontplus(n1,p)
106 CALL ifrontplus(n2,p)
107 ENDDO
108c--------------------------------------------------
109 sensor_ptr%TYPE = sens_type
110 sensor_ptr%SENS_ID = sens_id
111 sensor_ptr%STATUS = 0 ! status = deactivated
112 sensor_ptr%TSTART = infinity ! activation time
113 sensor_ptr%TCRIT = infinity
114 sensor_ptr%TMIN = tmin
115 sensor_ptr%TDELAY = tdel ! time delay before activation
116 sensor_ptr%VALUE = infinity
117
118 nparis = 3
119 nparrs = 2
120 nvar = 0
121c
122 sensor_ptr%NPARI = nparis
123 sensor_ptr%NPARR = nparrs
124 sensor_ptr%NVAR = nvar
125c
126 ALLOCATE (sensor_ptr%IPARAM(nparis))
127 ALLOCATE (sensor_ptr%RPARAM(nparrs))
128 ALLOCATE (sensor_ptr%VAR(nvar))
129 sensor_ptr%VAR(:) = zero
130
131 sensor_ptr%IPARAM(1) = n1
132 sensor_ptr%IPARAM(2) = n2
133 sensor_ptr%IPARAM(3) = dflag
134 sensor_ptr%RPARAM(1) = dmin
135 sensor_ptr%RPARAM(2) = dmax
136c------------------------------------------------------------
137 WRITE(iout, 1000) sens_id,tdel
138 WRITE(iout, 2000) nod1,nod2,dflag,dmin,dmax,tmin
139c------------------------------------------------------------
140 1000 FORMAT(
141 . 5x,' SENSOR TYPE 2: RELATIVE NODE DISTANCE '/,
142 . 5x,' ------------------------------------- '/,
143 . 5x,'SENSOR ID. . . . . . . . . . . . . . . . .=',i10/
144 . 5x,'TIME DELAY BEFORE ACTIVATION . . . . . . .=',e12.4)
145 2000 FORMAT(
146 . 5x,' NODE 1 ID . . . . . . . . . . . . . . .=',i10/
147 . 5x,' NODE 2 ID . . . . . . . . . . . . . . .=',i10/
148 . 5x,' DEACTIVATION FLAG . . . . . . . . . . .=',i10/
149 . 5x,' MINIMAL DISPLACEMENT. . . . . . . . . .=',e12.4/
150 . 5x,' MAXIMAL DISPLACEMENT. . . . . . . . . .=',e12.4/
151 . 5x,' MIN TIME DURATION TO ACTIVATE . . . . .=',e12.4/)
152c-----------
153 RETURN
void anodset(int *id, int *type)
#define my_real
Definition cppsort.cpp:32
subroutine ifrontplus(n, p)
Definition frontplus.F:100
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
integer function nvar(text)
Definition nvar.F:32
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160