OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_sensor_acc.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| read_sensor_acc ../starter/source/tools/sensor/read_sensor_acc.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_sensors ../starter/source/tools/sensor/hm_read_sensors.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
32!||--- uses -----------------------------------------------------
33!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE read_sensor_acc(SENSOR_PTR ,SENS_ID ,TITR ,
38 . LACCELM ,UNITAB ,LSUBMODEL )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE unitab_mod
43 USE message_mod
44 USE submodel_mod
45 USE sensor_mod
46 USE hm_option_read_mod
47 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
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(3,*) ,INTENT(IN) :: LACCELM
62 CHARACTER(LEN=NCHARTITLE)::TITR
63 TYPE (SENSOR_STR_) :: SENSOR_PTR
64 TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
65 TYPE (UNIT_TYPE_) ,INTENT(IN) ::UNITAB
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER :: I,J,LEN,NACC,NPARIS,NPARRS,NVAR,SENS_TYPE
70 my_real :: tdel
71 INTEGER ,DIMENSION(6) :: ACC_ID,IACC,IDIR
72 my_real ,DIMENSION(6) :: acc,tmin
73 CHARACTER(LEN=NCHARKEY) :: DIR(6),DIRACC
74 LOGICAL :: IS_AVAILABLE
75C--------------------------------
76C ACCELEROMETER BASED SENSOR
77C=======================================================================
78 is_available = .false.
79 sens_type = 1
80c--------------------------------------------------
81 CALL hm_get_floatv('Tdelay' ,tdel ,is_available,lsubmodel,unitab)
82 CALL hm_get_intv ('NACCEL1',nacc ,is_available,lsubmodel)
83c acc1
84 CALL hm_get_intv ('IACC1' ,acc_id(1) ,is_available,lsubmodel)
85 CALL hm_get_string('DIR1' ,dir(1) ,ncharfield,is_available)
86 CALL hm_get_floatv('Tomin1' ,acc(1) ,is_available,lsubmodel,unitab)
87 CALL hm_get_floatv('Tmin1' ,tmin(1) ,is_available,lsubmodel,unitab)
88c acc2
89 CALL hm_get_intv ('IACC2' ,acc_id(2) ,is_available,lsubmodel)
90 CALL hm_get_string('DIR2' ,dir(2) ,ncharfield,is_available)
91 CALL hm_get_floatv('Tomin2' ,acc(2) ,is_available,lsubmodel,unitab)
92 CALL hm_get_floatv('Tmin2' ,tmin(2) ,is_available,lsubmodel,unitab)
93c acc3
94 CALL hm_get_intv ('IACC3' ,acc_id(3) ,is_available,lsubmodel)
95 CALL hm_get_string('DIR3' ,dir(3) ,ncharfield,is_available)
96 CALL hm_get_floatv('Tomin3' ,acc(3) ,is_available,lsubmodel,unitab)
97 CALL hm_get_floatv('Tmin3' ,tmin(3) ,is_available,lsubmodel,unitab)
98c acc4
99 CALL hm_get_intv ('IACC4' ,acc_id(4) ,is_available,lsubmodel)
100 CALL hm_get_string('DIR4' ,dir(4) ,ncharfield,is_available)
101 CALL hm_get_floatv('Tomin4' ,acc(4) ,is_available,lsubmodel,unitab)
102 CALL hm_get_floatv('Tmin4' ,tmin(4) ,is_available,lsubmodel,unitab)
103c acc5
104 CALL hm_get_intv ('IACC5' ,acc_id(5) ,is_available,lsubmodel)
105 CALL hm_get_string('DIR5' ,dir(5) ,ncharfield,is_available)
106 CALL hm_get_floatv('Tomin5' ,acc(5) ,is_available,lsubmodel,unitab)
107 CALL hm_get_floatv('Tmin5' ,tmin(5) ,is_available,lsubmodel,unitab)
108c acc6
109 CALL hm_get_intv ('IACC6' ,acc_id(6) ,is_available,lsubmodel)
110 CALL hm_get_string('DIR6' ,dir(6) ,ncharfield,is_available)
111 CALL hm_get_floatv('Tomin6' ,acc(6) ,is_available,lsubmodel,unitab)
112 CALL hm_get_floatv('tmin6' ,TMIN(6) ,IS_AVAILABLE,LSUBMODEL,UNITAB)
113c--------------------------------------------------
114c Check input data
115c--------------------------------------------------
116 IF (NACC > 6) THEN
117 CALL ANCMSG(MSGID=44,MSGTYPE=MSGERROR,ANMODE=ANINFO,
118 . I1=SENS_ID, C1=TITR, I2=NACC)
119 NACC = MIN(NACC, 6)
120 ENDIF
121c
122 IACC(:) = 0
123 DO I = 1,NACC
124 DO J = 1,NACCELM
125 IF (ACC_ID(I) == LACCELM(2,J)) THEN
126 IACC(I) = J
127 EXIT
128 ENDIF
129 END DO
130 IF (IACC(I) == 0) THEN
131 CALL ANCMSG(MSGID=45, MSGTYPE=MSGERROR, ANMODE=ANINFO_BLIND_2,
132 . I1=SENS_ID, C1=TITR, I2=ACC_ID(I))
133 END IF
134 END DO
135c
136 DO I = 1,NACC
137 IDIR(I) = 0
138 LEN = LEN_TRIM(DIR(I))
139 DIRACC = DIR(I)(1:LEN)
140 IF (DIRACC(1:1) == 'x.OR.' DIRACC(1:1) == 'x') IDIR(I) = IDIR(I)+1
141 IF (DIRACC(1:1) == 'y.OR.' DIRACC(1:1) == 'y') IDIR(I) = IDIR(I)+2
142 IF (DIRACC(1:1) == 'z.OR.' DIRACC(1:1) == 'z') IDIR(I) = IDIR(I)+4
143 END DO
144c--------------------------------------------------
145c
146 SENSOR_PTR%TYPE = SENS_TYPE
147 SENSOR_PTR%SENS_ID = SENS_ID
148 SENSOR_PTR%STATUS = 0 ! status = deactivated
149 SENSOR_PTR%TSTART = INFINITY
150 SENSOR_PTR%TCRIT = INFINITY
151 SENSOR_PTR%TMIN = ZERO ! TMIN global
152 SENSOR_PTR%TDELAY = TDEL ! time delay before activation
153 SENSOR_PTR%VALUE = ZERO
154
155 NPARIS = NACC * 2 + 1
156 NPARRS = NACC * 3
157 NVAR = 0
158c
159 SENSOR_PTR%NPARI = NPARIS
160 SENSOR_PTR%NPARR = NPARRS
161 SENSOR_PTR%NVAR = NVAR
162c
163 ALLOCATE (SENSOR_PTR%IPARAM(NPARIS))
164 ALLOCATE (SENSOR_PTR%RPARAM(NPARRS))
165 ALLOCATE (SENSOR_PTR%VAR(NVAR))
166 SENSOR_PTR%VAR(:) = ZERO
167c
168 SENSOR_PTR%IPARAM(1) = NACC
169 J = 1
170 DO I = 1,NACC
171 SENSOR_PTR%IPARAM(J+1) = IACC(I)
172 SENSOR_PTR%IPARAM(J+2) = IDIR(I)
173 J = J+2
174 END DO
175 J = 0
176 DO I = 1,NACC
177 SENSOR_PTR%RPARAM(J+1) = ACC(I)
178 SENSOR_PTR%RPARAM(J+2) = TMIN(I)
179 SENSOR_PTR%RPARAM(J+3) = INFINITY
180 J = J+3
181 END DO
182c------------------------------------------------------------
183 WRITE(IOUT, 1000) SENS_ID,TDEL
184 WRITE(IOUT, 2000) NACC
185 DO I = 1,NACC
186 WRITE(IOUT, 3000) ACC_ID(I),IDIR(I),ACC(I),TMIN(I)
187 END DO
188c------------------------------------------------------------
189 1000 FORMAT(
190 . 5X,' sensor TYPE 1: accelerometer '/,
191 . 5X,' ----------------------------- '/,
192 . 5X,'sensor id. . . . . . . . . . . . . . . . .=',I10/
193 . 5X,'time delay before activation . . . . . . .=',E12.4)
194 2000 FORMAT(
195 . 5X,'number of accelerometers . . . . . . . . .=',I10)
196 3000 FORMAT(
197 . 5X,' accelerometer id. . . . . . . . . . . .=',I10/
198 . 5X,' direction . . . . . . . . . . . . . . .=',I10/
199 . 5X,' minimum acceleration for activation . .=',E12.4/
200 . 5X,' minimum acc. duration for activation .=',E12.4/)
201c-----------
202 RETURN
203 END
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:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:78
id
initmumps id
Definition multiplerhs_example.m:4
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
read_sensor_acc
subroutine read_sensor_acc(sensor_ptr, sens_id, titr, laccelm, unitab, lsubmodel)
Definition read_sensor_acc.F:39