OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_sensor_energy.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine read_sensor_energy (sensor_ptr, sens_id, titr, ipart, subset, unitab, lsubmodel)

Function/Subroutine Documentation

◆ read_sensor_energy()

subroutine read_sensor_energy ( type (sensor_str_) sensor_ptr,
integer, intent(in) sens_id,
character(len=nchartitle) titr,
integer, dimension(lipart1,*), intent(in) ipart,
type (subset_), dimension(nsubs) subset,
type (unit_type_), intent(in) unitab,
type (submodel_data), dimension(nsubmod) lsubmodel )

Definition at line 35 of file read_sensor_energy.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE unitab_mod
41 USE message_mod
42 USE groupdef_mod
43 USE submodel_mod
44 USE sensor_mod
45 USE hm_option_read_mod
46 USE names_and_titles_mod , ONLY : nchartitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scr17_c.inc"
55#include "com04_c.inc"
56#include "units_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER ,INTENT(IN) :: SENS_ID
61 INTEGER ,DIMENSION(LIPART1,*),INTENT(IN) :: IPART
62 CHARACTER(LEN=NCHARTITLE)::TITR
63 TYPE (SENSOR_STR_) :: SENSOR_PTR
64 TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
65 TYPE (SUBSET_) ,DIMENSION(NSUBS) :: SUBSET
66 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER :: J,ICONST,SENS_TYPE,PART_ID,SUB_ID,PARTN,SUBN,ISELECT,
71 . NPARIS,NPARRS,NVAR
72 my_real :: tdel,tmin,iemin,iemax,kemin,kemax,ietol,ietime,ketol,ketime
73 LOGICAL :: IS_AVAILABLE
74C--------------------------------
75C SENSOR BASED ON PART ENERGY
76C=======================================================================
77 is_available = .false.
78 sens_type = 14
79 iconst = 0 ! const energy option
80c--------------------------------------------------
81card1
82 CALL hm_get_floatv('Tdelay' ,tdel ,is_available,lsubmodel,unitab)
83card2
84 CALL hm_get_intv ('Part_Id' ,part_id ,is_available,lsubmodel)
85 CALL hm_get_intv ('Subset_ID' ,sub_id ,is_available,lsubmodel)
86 CALL hm_get_intv ('Iselect' ,iselect ,is_available,lsubmodel)
87card3
88 CALL hm_get_floatv('IEmin' ,iemin ,is_available,lsubmodel,unitab)
89 CALL hm_get_floatv('IEmax' ,iemax ,is_available,lsubmodel,unitab)
90 CALL hm_get_floatv('KEmin' ,kemin ,is_available,lsubmodel,unitab)
91 CALL hm_get_floatv('KEmax' ,kemax ,is_available,lsubmodel,unitab)
92 CALL hm_get_floatv('Tmin' ,tmin ,is_available,lsubmodel,unitab)
93card4
94 CALL hm_get_floatv('IEtol' ,ietol ,is_available,lsubmodel,unitab)
95 CALL hm_get_floatv('IEtime' ,ietime ,is_available,lsubmodel,unitab)
96 CALL hm_get_floatv('KEtol' ,ketol ,is_available,lsubmodel,unitab)
97 CALL hm_get_floatv('KEtime' ,ketime ,is_available,lsubmodel,unitab)
98c--------------------------------------------------
99c Defaults
100c--------------------------------------------------
101 IF (ietol > zero .and. ietime > zero .or. ketol > zero .and. ketime > zero) THEN
102 iconst = 1 ! constant energy option active
103 END IF
104 IF (iemax == zero) iemax = infinity
105 IF (kemax == zero) kemax = infinity
106 IF (iemin == zero) iemin =-infinity
107 IF (kemin == zero) kemin =-infinity
108 IF (ietime == zero) ietime = infinity
109 IF (ketime == zero) ketime = infinity
110 IF (iselect == 0) iselect= 1 ! sum of part energy by default
111c--------------------------------------------------
112c Check Part_ID, Sub_ID
113c--------------------------------------------------
114 partn = 0
115 subn = 0
116 is_available = .false.
117 DO j=1,npart
118 IF (ipart(4,j) == part_id) THEN
119 is_available = .true.
120 partn = j
121 EXIT
122 ENDIF
123 ENDDO
124 IF (.NOT. is_available) THEN
125 part_id = 0
126 ELSE ! ignore subset_id
127 sub_id = 0
128 ENDIF
129c
130 IF (.NOT. is_available) THEN
131 DO j=1,nsubs-1
132 IF (subset(j)%ID == sub_id) THEN
133 is_available = .true.
134 subn = j
135 EXIT
136 ENDIF
137 ENDDO
138 IF (.NOT. is_available) sub_id = 0
139 ENDIF
140c
141 IF (.NOT. is_available .and. iselect == 1) THEN
142 ! we take global subset including all parts
143 sub_id = subset(nsubs)%ID
144 subn = nsubs
145 ELSE IF (is_available) THEN
146 iselect = 1
147 ENDIF
148c------------------------------------------------------------
149 WRITE (iout, 1000) sens_id,tdel
150 IF (iselect == 2) THEN
151 WRITE (iout, 2400)
152 ELSE IF (part_id > 0) THEN
153 WRITE (iout, 2100) part_id
154 ELSE IF (sub_id > 0) THEN
155 WRITE (iout, 2200) sub_id
156 ELSE
157 WRITE (iout, 2300)
158 END IF
159 WRITE (iout ,3000) iemin,iemax,kemin,kemax,
160 . ietol,ketol,tmin,ietime,ketime
161c--------------------------------------------------
162 IF (ietime == infinity) THEN
163 ietime = zero
164 ietol = zero
165 END IF
166 IF (ketime == infinity) THEN
167 ketime = zero
168 ketol = zero
169 END IF
170c---------------------------
171c sensor data structure
172c--------------------------------------------------
173 nparis = 4
174 nparrs = 8
175 IF (iselect == 2) THEN
176 nvar = 10 ! additional terms to save total system internal and linetic energy
177 ELSE
178 nvar = 8
179 END IF
180c
181 ALLOCATE (sensor_ptr%IPARAM(nparis))
182 ALLOCATE (sensor_ptr%RPARAM(nparrs))
183 ALLOCATE (sensor_ptr%VAR(nvar))
184 sensor_ptr%VAR(:) = zero
185
186 sensor_ptr%NVAR = nvar
187 sensor_ptr%NPARI = nparis
188 sensor_ptr%NPARR = nparrs
189 sensor_ptr%TYPE = sens_type
190 sensor_ptr%SENS_ID = sens_id
191 sensor_ptr%STATUS = 0 ! status = deactivated
192 sensor_ptr%TSTART = infinity
193 sensor_ptr%TCRIT = infinity
194 sensor_ptr%TMIN = tmin
195 sensor_ptr%TDELAY = tdel ! time delay before activation
196 sensor_ptr%VALUE = zero
197c
198 sensor_ptr%IPARAM(1) = partn ! PART number
199 sensor_ptr%IPARAM(2) = subn ! SUBSET number
200 sensor_ptr%IPARAM(3) = iconst ! const energy option
201 sensor_ptr%IPARAM(4) = iselect ! global system energy vs PART/SUBSET energy selector
202c
203 sensor_ptr%RPARAM(1) = iemin
204 sensor_ptr%RPARAM(2) = iemax
205 sensor_ptr%RPARAM(3) = kemin
206 sensor_ptr%RPARAM(4) = kemax
207 sensor_ptr%RPARAM(5) = ietol
208 sensor_ptr%RPARAM(6) = ketol
209 sensor_ptr%RPARAM(7) = ietime
210 sensor_ptr%RPARAM(8) = ketime
211c------------------------------------------------------------
212 1000 FORMAT(
213 . 5x,' SENSOR TYPE 14: PART ENERGY '/,
214 . 5x,' --------------------------- '/,
215 . 5x,'SENSOR ID. . . . . . . . . . . . . . . . . =',i10/
216 . 5x,'TIME DELAY BEFORE ACTIVATION . . . . . . . =',e12.4)
217 2100 FORMAT(
218 . 5x,' PART ID. . . . . . . . . . . . . . . . . =',i10)
219 2200 FORMAT(
220 . 5x,' SUBSET ID. . . . . . . . . . . . . . . . =',i10)
221 2300 FORMAT(
222 . 5x,' GLOBAL SUBSET ENERGY (ALL PARTS) . . . . .')
223 2400 FORMAT(
224 . 5x,' TOTAL SYSTEM ENERGY (ENTIRE MODEL) . . . .')
225 3000 FORMAT(
226 . 5x,' MINIMUM INTERNAL ENERGY. . . . . . . . . =',e12.4/
227 . 5x,' MAXIMUM INTERNAL ENERGY. . . . . . . . . =',e12.4/
228 . 5x,' MINIMUM KINETIC ENERGY . . . . . . . . . =',e12.4/
229 . 5x,' MAXIMUM KINETIC ENERGY . . . . . . . . . =',e12.4/
230 . 5x,' TOLERANCE OF CONSTANT INTERNAL ENERGY. . =',e12.4/
231 . 5x,' TOLERANCE OF CONSTANT KINETIC ENERGY . . =',e12.4/
232 . 5x,' DURATION LIMIT OF MAX/MIN ENERGY . . . . =',e12.4/
233 . 5x,' DURATION LIMIT OF CONSTANT INT ENERGY. . =',e12.4/
234 . 5x,' DURATION LIMIT OF CONSTANT KIN ENERGY. . =',e12.4//)
235c-----------
236 RETURN
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
groupdef_mod
Definition groupdef_mod.F:662
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::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
nvar
integer function nvar(text)
Definition nvar.F:32