OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_dfs_detline.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_dfs_detline ../starter/source/initial_conditions/detonation/read_dfs_detline.F
25!||--- called by ------------------------------------------------------
26!|| read_detonators ../starter/source/initial_conditions/detonation/read_detonators.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_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
32!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
33!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
34!|| nintri ../starter/source/system/nintrr.F
35!|| nodgrnr5 ../starter/source/starter/freform.F
36!|| unused_mat_detonator ../starter/source/initial_conditions/detonation/unused_mat_detonator.F
37!|| usr2sys ../starter/source/system/sysfus.F
38!||--- uses -----------------------------------------------------
39!|| detonators_mod ../starter/share/modules1/detonators_mod.F
40!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
41!|| message_mod ../starter/share/message_module/message_mod.F
42!|| submodel_mod ../starter/share/modules1/submodel_mod.f
43!||====================================================================
44 SUBROUTINE read_dfs_detline(DETONATORS,X,IPM,ITABM1,UNITAB,LSUBMODEL)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE unitab_mod
49 USE message_mod
50 USE detonators_mod
51 USE groupdef_mod
52 USE hm_option_read_mod
53 USE submodel_mod
54 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com04_c.inc"
63#include "units_c.inc"
64#include "param_c.inc"
65#include "tabsiz_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
70 INTEGER,INTENT(IN) :: ITABM1(SITABM1)
71 INTEGER,INTENT(IN) :: IPM(NPROPMI,NUMMAT)
72 my_real,INTENT(IN) :: x(3,numnod)
73 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(NSUBMOD)
74 TYPE(detonators_struct_),INTENT(INOUT) :: DETONATORS
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER :: I, MAT, J, NPEM,NPCM,K,IGU,IGS,JJ,MDET,DET_ID,IDET
79 INTEGER :: IBID, NODE_ID1, NODE_ID2,uID1,uID2, IOPT, IUNIT, UID
80 INTEGER :: FLAG_FMT,IMAT,IFLAGUNIT,UNUSED
81 INTEGER :: STAT
82 my_real :: xc, yc, zc, alt, xc1, yc1, zc1, xc2, yc2, zc2, nx, ny, nz, bid, vcj
83 CHARACTER*40 :: MESS
84 CHARACTER*64 :: chain1,chain2
85 CHARACTER(LEN=NCHARKEY) :: KEY, KEY2
86 CHARACTER(LEN=NCHARTITLE) :: TITR
87 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
88 LOGICAL :: IS_NODE_DEFINED
89 INTEGER :: NDETPS,NDETSG,NECRAN,NDETPL,NDETCORD
90C-----------------------------------------------
91C E x t e r n a l F u n c t i o n s
92C-----------------------------------------------
93 INTEGER,EXTERNAL :: NODGRNR5, USR2SYS, NINTRI
94 INTEGER :: UNUSED_MAT_DETONATOR
95 DATA mess/'DETONATORS DEFINITION '/
96C-----------------------------------------------
97C S o u r c e L i n e s
98C-----------------------------------------------
99
100 CALL hm_option_start('/DFS/DETLINE')
101
102 DO idet=1,detonators%N_DET_LINE
103
104 CALL hm_option_read_key(lsubmodel,option_id=det_id, unit_id=uid,keyword2=key,keyword3=key2)
105 IF (len_trim(key) > 0) key = key(1:7)
106 IF (len_trim(key2) > 0) key2 = key2(1:4)
107
108 is_encrypted= .false.
109 is_available = .false.
110 is_node_defined = .false.
111 IF(key2(1:4) == 'NODE')is_node_defined = .true.
112 CALL hm_option_is_encrypted(is_encrypted)
113 !---------------------------------!
114 ! READING !
115 !---------------------------------!
116 IF(is_node_defined)THEN
117 CALL hm_get_floatv('rad_det_time', alt, is_available, lsubmodel,unitab)
118 CALL hm_get_intv('rad_det_materialid', mat, is_available, lsubmodel )
119 CALL hm_get_intv('rad_det_node1', uid1, is_available, lsubmodel)
120 CALL hm_get_intv('rad_det_node2', uid2, is_available, lsubmodel)
121 xc=zero
122 yc=zero
123 zc=zero
124 ELSE
125 CALL hm_get_floatv('rad_det_locationA_X', xc1, is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('rad_det_locationA_Y', yc1, is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('rad_det_locationA_Z', zc1, is_available, lsubmodel, unitab)
128 CALL hm_get_floatv('rad_det_locationB_X', xc2, is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('rad_det_locationB_Y', yc2, is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('rad_det_locationB_Z', zc2, is_available, lsubmodel, unitab)
131 CALL hm_get_floatv('rad_det_time', alt, is_available, lsubmodel,unitab)
132 CALL hm_get_intv('rad_det_materialid', mat, is_available, lsubmodel)
133 ENDIF
134
135 ! COORDINATES
136 IF(is_node_defined)THEN
137 node_id1=usr2sys(uid1,itabm1,mess,det_id)
138 IF(node_id1 > 0)THEN
139 xc1 = x(1,node_id1)
140 yc1 = x(2,node_id1)
141 zc1 = x(3,node_id1)
142 ENDIF
143 node_id2=usr2sys(uid2,itabm1,mess,det_id)
144 IF(node_id2 > 0)THEN
145 xc2 = x(1,node_id2)
146 yc2 = x(2,node_id2)
147 zc2 = x(3,node_id2)
148 ENDIF
149 IF(node_id1 == 0 .AND. node_id2 == 0)THEN
150 CALL ancmsg(msgid = 104,msgtype = msgerror,anmode = aninfo,
151 . c1='/DFS/DETLINE/NODE',
152 . i1=det_id,
153 . c2='INVALID NODE_ID')
154 ENDIF
155 ENDIF
156 !---------------------------------!
157 ! CHECKING USER FLAGS !
158 ! +INTERNAL ID !
159 !---------------------------------!
160 mdet=mat !bak
161 IF (alt > infinity)alt= infinity
162 IF (alt < -infinity)alt=-infinity
163 unused=0
164 IF(mat > 0)unused=unused_mat_detonator(mat,nummat,ipm)
165 IF (mat < 0) THEN
166 CALL ancmsg(msgid=102,msgtype=msgerror,anmode=aninfo,
167 . i1=det_id,
168 . c1='DETONATOR IS REFERRING TO A NEGATIVE MATERIAL ID',
169 . c2='/DFS/DETLINE',
170 . i2=mdet)
171 ELSEIF (unused == 1) THEN
172 CALL ancmsg(msgid=102,msgtype=msgerror,anmode=aninfo,
173 . i1=det_id,
174 . c1='DETONATOR IS REFERRING TO AN UNKNOWN MATERIAL ID',
175 . c2='/DFS/DETLINE',
176 . i2=mdet)
177 ELSEIF (unused == 2) THEN
178 CALL ancmsg(msgid=102,msgtype=msgerror,anmode=aninfo,
179 . i1=det_id,
180 . c1='DETONATOR MUST REFER TO A JWL MATERIAL LAW (LAWS 5, 51, 97, 151)',
181 . c2='/DFS/DETLINE',
182 . i2=mdet)
183 ELSE
184 detonators%LINE(idet)%IS_MAT_VALID = .true.
185 !---------------------------------!
186 ! LISTING PRINTOUT !
187 !---------------------------------!
188 IF(is_node_defined)THEN
189 IF(.NOT.is_encrypted)WRITE(iout,1501) det_id,node_id1,xc1,yc1,zc1,node_id2,xc2,yc2,zc2,alt,mdet
190 ELSE
191 IF(.NOT.is_encrypted)WRITE(iout,1500) det_id,xc1,yc1,zc1,xc2,yc2,zc2,alt,mdet
192 ENDIF
193 IF(is_encrypted)WRITE(iout,1001)
194
195 detonators%LINE(idet)%TDET = alt
196 detonators%LINE(idet)%MAT = mat
197 detonators%LINE(idet)%XDET_1 = xc1
198 detonators%LINE(idet)%YDET_1 = yc1
199 detonators%LINE(idet)%ZDET_1 = zc1
200 detonators%LINE(idet)%XDET_2 = xc2
201 detonators%LINE(idet)%YDET_2 = yc2
202 detonators%LINE(idet)%ZDET_2 = zc2
203 END IF
204
205 ENDDO
206
207C-----------------------------------------------
208C O u t p u t F o r m a t
209C-----------------------------------------------
210 1001 FORMAT(///5x,
211 & 'DETONATION LINE ',i10,/5x,
212 & '--------------- ',/5x,
213 & 'CONFIDENTIAL DATA')
214 1500 FORMAT(///5x,
215 & 'DETONATION LINE ',i10,/5x,
216 & '--------------- ',/5x,
217 & 'X-COORDINATE FIRST POINT =',1pg20.13,/5x,
218 & 'Y-COORDINATE FIRST POINT =',1pg20.13,/5x,
219 & 'Z-COORDINATE FIRST POINT =',1pg20.13,/5x,
220 & 'X-COORDINATE SECOND POINT =',1pg20.13,/5x,
221 & 'Y-COORDINATE SECOND POINT =',1pg20.13,/5x,
222 & 'Z-COORDINATE SECOND POINT =',1pg20.13,/5x,
223 & 'LIGHTING TIME =',1pg20.13,/5x,
224 & 'EXPLOSIVE MATERIAL NUMBER =',i10 )
225 1501 FORMAT(///5x,
226 & 'DETONATION LINE ',i10,/5x,
227 & '--------------- ',/5x,
228 & 'FIRST NODE ID =',i10 ,/5x,
229 & ' X-COORDINATE FIRST POINT =',1pg20.13,/5x,
230 & ' Y-COORDINATE FIRST POINT =',1pg20.13,/5x,
231 & ' Z-COORDINATE FIRST POINT =',1pg20.13,/5x,
232 & 'SECOND NODE ID =',i10 ,/5x,
233 & ' X-COORDINATE SECOND POINT=',1pg20.13,/5x,
234 & ' Y-COORDINATE SECOND POINT=',1pg20.13,/5x,
235 & ' Z-COORDINATE SECOND POINT=',1pg20.13,/5x,
236 & 'LIGHTING TIME =',1pg20.13,/5x,
237 & 'EXPLOSIVE MATERIAL NUMBER =',i10 )
238C-----------------------------------------------
239
240 END SUBROUTINE
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
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
detonators_mod
Definition detonators_mod.F:79
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
read_dfs_detline
subroutine read_dfs_detline(detonators, x, ipm, itabm1, unitab, lsubmodel)
Definition read_dfs_detline.F:45
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
starter
program starter
Definition starter.F:39
detonators_mod::detonators_struct_
Definition detonators_mod.F:154
submodel_mod::submodel_data
Definition submodel_mod.F:723