OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_sensor_user.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_user ../starter/source/tools/sensor/read_sensor_user.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!|| arret ../starter/source/system/arret.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_get_string_index ../starter/source/devtools/hm_reader/hm_get_string_index.F
32!|| sensor_user_alloc ../starter/source/tools/sensor/sensor_user_alloc.F
33!|| user_output ../starter/source/user_interface/user_output.F
34!|| usr2sys ../starter/source/system/sysfus.F
35!||--- uses -----------------------------------------------------
36!|| format_mod ../starter/share/modules1/format_mod.F90
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
39!|| submodel_mod ../starter/share/modules1/submodel_mod.F
40!|| user_interface_mod ../starter/source/modules/user_interface_mod.F90
41!||====================================================================
42 SUBROUTINE read_sensor_user(HM_NSENSOR,ISEN ,TITLE ,
43 . UNITAB ,LSUBMODEL ,KEY ,UNIT_ID ,SENS_ID,
44 . SENSOR_PTR,SENSOR_USER_STRUCT)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE unitab_mod
49 USE message_mod
50 USE submodel_mod
51 USE sensor_mod
52 USE names_and_titles_mod , ONLY : ncharline, ncharkey
53 USE format_mod ,ONLY : fmt_f
54 USE reader_old_mod , ONLY : key0, kcur, kline, line
55 USE user_interface_mod,only : ksens_cur
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "scr17_c.inc"
64#include "units_c.inc"
65#include "scr15_c.inc"
66#include "userlib.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER ,INTENT(IN) :: HM_NSENSOR,UNIT_ID ,SENS_ID,ISEN
71 CHARACTER(LEN=ncharkey) :: KEY
72 CHARACTER(LEN=nchartitle) :: TITLE
73 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
74 TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
75 TYPE (SENSOR_STR_) ,INTENT(OUT) :: SENSOR_PTR
76 TYPE(sensor_user_struct_), INTENT(INOUT) :: SENSOR_USER_STRUCT
77C-----------------------------------------------
78C E x t e r n a l F u n c t i o n s
79C-----------------------------------------------
80 INTEGER USR2SYS
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I,J,TYP
85 my_real :: TDEL
86 LOGICAL :: IS_AVAILABLE
87 LOGICAL :: ALREADY_DONE
88 INTEGER NLINES
89 CHARACTER(LEN=ncharline) :: RLINE
90 CHARACTER (LEN=4) :: CSENS
91 CHARACTER(LEN=4096) :: SCR_FILE_NAME
92 INTEGER SCR_FILE_NAME_LEN
93!
94 CHARACTER(LEN=NCHARLINE) :: IUSER_KEY
95 CHARACTER OPTION*256
96 INTEGER SIZE
97C=======================================================================
98!
99! User libraries use the SET_U_SENS_xxx routines - it uses KSENS_CUR parameter.
100 ksens_cur = isen
101
102 IF(key(1:5) == 'USER1')THEN
103 typ=29
104 ELSEIF(key(1:5) == 'USER2')THEN
105 typ=30
106 ELSEIF(key(1:5) == 'USER3')THEN
107 typ=31
108 ELSE
109 CALL ancmsg(msgid=43,
110 . anmode=aninfo,
111 . msgtype=msgerror,
112 . c2=key(1:len_trim(key)),
113 . i1=sens_id,
114 . c1=title)
115 ENDIF
116c--------------------------------------------------
117 is_available = .false.
118 already_done = .false.
119c--------------------------------------------------
120 iuser_key = key(1:len_trim(key))
121 IF (userl_avail == 0)THEN
122 ! ERROR to be printed & exit
123 option='/SENSOR/'//iuser_key
124 size=len_trim(option)
125 CALL ancmsg(msgid=1130,
126 . msgtype=msgerror,c1=option(1:size),anmode=aninfo)
127 CALL arret(2)
128 ENDIF
129!------------
130! READING
131!------------
132 CALL hm_get_intv ('Number_of_datalines' ,nlines ,is_available, lsubmodel)
133!
134 IF (nlines > 1) THEN
135!
136!
137 IF ((typ>28.AND.typ<38).AND. .NOT.(already_done) ) CALL sensor_user_alloc(already_done,sensor_user_struct)
138!
139c---------------------------------------
140 IF (typ>=29.AND.typ<=31) THEN
141C--------------------------------
142C USER SENSOR
143C--------------------
144
145 ! Allocate Userbuffer Sensors
146 ! Global sensor variables / Not need with user sensors
147 sensor_ptr%NPARI = 0
148 sensor_ptr%NPARR = 0
149 sensor_ptr%NVAR = 0
150 ALLOCATE(sensor_ptr%IPARAM(sensor_ptr%NPARI))
151 ALLOCATE(sensor_ptr%RPARAM(sensor_ptr%NPARR))
152 ALLOCATE(sensor_ptr%VAR(sensor_ptr%NVAR))
153 ! User Sensor Buffer
154 ALLOCATE(sensor_ptr%INTEGER_USERBUF(isenbuf))
155 ALLOCATE(sensor_ptr%FLOAT_USERBUF(lsenbuf))
156
157 ALLOCATE(sensor_ptr%INTEGER_USERPARAM(nsenpari))
158 ALLOCATE(sensor_ptr%FLOAT_USERPARAM(nsenparr))
159
160 ! Initialize to Zero
161 sensor_ptr%INTEGER_USERBUF(1:isenbuf)=0
162 sensor_ptr%FLOAT_USERBUF(1:lsenbuf)=zero
163
164 sensor_ptr%INTEGER_USERPARAM(1:nsenpari)=0
165 sensor_ptr%FLOAT_USERPARAM(1:nsenparr)=zero
166
167
168 IF (userl_avail==1 .AND. (typ==29.OR.typ==30.OR.typ==31)) THEN
169!
170 WRITE(csens,'(I4.4)')typ
171 scr_file_name='SI'//rootnam(1:rootlen)//'_'//csens//'.scr'
172 scr_file_name_len=len_trim(scr_file_name)
173 OPEN(unit=30,file=trim(scr_file_name),form='FORMATTED',recl=ncharline)
174!
175 j=1
176 CALL hm_get_string_index('arraydatalines', rline, j, ncharline, is_available)
177 READ(rline,err=999,fmt=fmt_f)tdel
178
179C global activation time
180 sensor_ptr%TDELAY = tdel
181!
182 ! Read & Dump in scratch file
183 DO j=2,nlines
184 CALL hm_get_string_index('arraydatalines', rline, j, ncharline, is_available)
185 WRITE(30,fmt='(A)')trim(rline)
186 ENDDO
187 CLOSE(unit=30)
188 ENDIF ! IF (TYP>=29.AND.TYP<=31)
189!
190
191 WRITE (iout,'(A,I10)') ' SENSOR ID = ', sens_id
192
193
194 sensor_ptr%TYPE = typ ! TYP initialization is need for callback routines
195
196 IF(typ == 29)THEN
197
198 WRITE (iout,'(A,/,A,I10)') ' TYPE 29 SENSOR : USER1'
199 WRITE (iout,'(A,1PG20.13)') ' TIME DELAY BEFORE ACTIVATION . . . . .',tdel
200
201 sensor_ptr%TSTART = infinity
202
203 IF (userl_avail==1)THEN
204 CALL st_userlib_lecsen(typ,rootnam,rootlen)
205 CALL user_output(iout,typ,rootnam,rootlen,1)
206 ENDIF
207
208 ELSEIF(typ == 30)THEN
209
210 WRITE (iout,'(A,/,A,I10)') ' TYPE 30 SENSOR : USER2'
211 WRITE (iout,'(A,1PG20.13)') ' TIME DELAY BEFORE ACTIVATION . . . . .',tdel
212
213 sensor_ptr%TSTART = infinity
214
215 IF (userl_avail==1)THEN
216 CALL st_userlib_lecsen(typ,rootnam,rootlen)
217 CALL user_output(iout,typ,rootnam,rootlen,1)
218 ENDIF
219
220 ELSEIF(typ == 31)THEN
221
222 WRITE (iout,'(A,/,A,I10)') ' TYPE 31 SENSOR : USER3'
223 WRITE (iout,'(A,1PG20.13)') ' TIME DELAY BEFORE ACTIVATION . . . . .',tdel
224
225 sensor_ptr%TSTART = infinity
226
227 IF (userl_avail==1)THEN
228 CALL st_userlib_lecsen(typ,rootnam,rootlen)
229 CALL user_output(iout,typ,rootnam,rootlen,1)
230 ENDIF
231
232 ENDIF
233 ELSE
234 CALL ancmsg(msgid=43,
235 . anmode=aninfo,
236 . msgtype=msgerror,
237 . c2=key(1:len_trim(key)),
238 . i1=sens_id,
239 . c1=title)
240 ENDIF ! IF (TYP>=29.AND.TYP<=31)
241
242 sensor_ptr%TYPE = typ
243 sensor_ptr%SENS_ID = sens_id
244 sensor_ptr%STATUS = 0
245 sensor_ptr%TDELAY = tdel
246 sensor_ptr%TSTART = infinity
247 sensor_ptr%TCRIT = infinity
248 sensor_ptr%TMIN = zero
249!
250 ELSE
251! error TBD
252 ENDIF ! IF(NLINES > 0)THEN
253C-----------
254 RETURN
255 999 CALL ancmsg(msgid=55,anmode=aninfo,msgtype=msgerror,c1=key0(kcur),c2=kline,c3=line)
256 CALL arret(2)
257C-----------
258 RETURN
259 END
260
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
read_sensor_user
subroutine read_sensor_user(hm_nsensor, isen, title, unitab, lsubmodel, key, unit_id, sens_id, sensor_ptr, sensor_user_struct)
Definition read_sensor_user.F:45
sensor_user_alloc
subroutine sensor_user_alloc(already_done, sensor_user_struct)
Definition sensor_user_alloc.F:30
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
user_output
subroutine user_output(iout, ilaw, rootn, rootlen, inpf)
Definition user_output.F:38