OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_dfs_detplan.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_detplan ../starter/source/initial_conditions/detonation/read_dfs_detplan.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_detplan(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/DETPLAN')
101
102 DO idet=1,detonators%N_DET_PLANE
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', xc, is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('rad_det_locationA_Y', yc, is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('rad_det_locationA_Z', zc, is_available, lsubmodel, unitab)
128 CALL hm_get_floatv('rad_det_locationB_X', nx, is_available, lsubmodel, unitab)
129 CALL hm_get_floatv('rad_det_locationB_Y', ny, is_available, lsubmodel, unitab)
130 CALL hm_get_floatv('rad_det_locationB_Z', nz, 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 IF(is_node_defined)THEN
136 node_id1=usr2sys(uid1,itabm1,mess,det_id)
137 IF(node_id1 > 0)THEN
138 xc = x(1,node_id1)
139 yc = x(2,node_id1)
140 zc = x(3,node_id1)
141 ENDIF
142 node_id2=usr2sys(uid2,itabm1,mess,det_id)
143 IF(node_id2 > 0)THEN
144 xc2 = x(1,node_id2)
145 yc2 = x(2,node_id2)
146 zc2 = x(3,node_id2)
147 nx = x(1,node_id2) - x(1,node_id1)
148 ny = x(2,node_id2) - x(2,node_id1)
149 nz = x(3,node_id2) - x(3,node_id1)
150 ENDIF
151 IF(node_id1==0 .AND. node_id2==0)THEN
152 CALL ancmsg(msgid = 104,msgtype = msgerror,anmode = aninfo,
153 . c1 = '/DFS/DETPLAN/NODE',
154 . i1 = det_id,
155 . c2 = 'INVALID NODE_ID')
156 ENDIF
157 ENDIF
158 !---------------------------------!
159 ! CHECKING USER FLAGS !
160 ! +INTERNAL ID !
161 !---------------------------------!
162 mdet=mat !bak
163 IF (alt > infinity)alt= infinity
164 IF (alt < -infinity)alt=-infinity
165 unused=0
166 IF(mat > 0)unused=unused_mat_detonator(mat,nummat,ipm)
167 IF (mat < 0) THEN
168 CALL ancmsg(msgid=102,msgtype=msgerror,anmode=aninfo,
169 . i1=det_id,
170 . c1='DETONATOR IS REFERRING TO A NEGATIVE MATERIAL ID',
171 . c2='/DFS/DETPLANE',
172 . i2=mdet)
173 ELSEIF (unused==1) THEN
174 CALL ancmsg(msgid=102,msgtype=msgerror,anmode=aninfo,
175 . i1=det_id,
176 . c1='DETONATOR IS REFERRING TO AN UNKNOWN MATERIAL ID',
177 . c2='/DFS/DETPLANE',
178 . i2=mdet)
179 ELSEIF (unused==2) THEN
180 CALL ancmsg(msgid=102,msgtype=msgerror,anmode=aninfo,
181 . i1=det_id,
182 . c1='DETONATOR MUST REFER TO A JWL MATERIAL LAW (LAWS 5, 51, 97, 151)',
183 . c2='/DFS/DETPLANE',
184 . i2=mdet)
185 ELSEIF((nx == zero).AND.(ny == zero).AND.(nz == zero))THEN
186 CALL ancmsg(msgid=104,msgtype=msgerror,anmode=aninfo,
187 . c1='/DFS/DETPLANE',
188 . i1=det_id,
189 . c2='DIRECTION VECTOR IS NOT DEFINED')
190 ELSE
191 detonators%PLANE(idet)%IS_MAT_VALID = .true.
192 IF(is_node_defined)THEN
193 IF(.NOT.is_encrypted)WRITE(iout,1601) det_id,node_id1,xc,yc,zc,node_id2,xc2,yc2,zc2,nx,ny,nz, alt,mdet
194 ELSE
195 IF(.NOT.is_encrypted)WRITE(iout,1600) det_id,xc,yc,zc,nx,ny,nz, alt,mdet
196 ENDIF
197 IF(is_encrypted) WRITE(iout,1001)
198
199 detonators%PLANE(idet)%TDET = alt
200 detonators%PLANE(idet)%MAT = mat
201 detonators%PLANE(idet)%XDET = xc
202 detonators%PLANE(idet)%YDET = yc
203 detonators%PLANE(idet)%ZDET = zc
204 detonators%PLANE(idet)%NX = nx
205 detonators%PLANE(idet)%NY = ny
206 detonators%PLANE(idet)%NZ = nz
207 ENDIF
208
209 enddo!next IDET
210C-----------------------------------------------
211C O u t p u t F o r m a t
212C-----------------------------------------------
213 1001 FORMAT(///5x,
214 & 'PLANAR DETONATION ',i10,/5x,
215 & '----------------- ',/5x,
216 & 'CONFIDENTIAL DATA')
217 1600 FORMAT(///5x,
218 & 'PLANAR DETONATION ',i10,/5x,
219 & '---------------- ',/5x,
220 & ' X-COORDINATE =',1pg20.13,/5x,
221 & ' y-coordinate =',1PG20.13,/5X,
222 & ' z-coordinate =',1PG20.13,/5X,
223 & 'nx-coordinate =',1PG20.13,/5X,
224 & 'ny-coordinate =',1PG20.13,/5X,
225 & 'nz-coordinate =',1PG20.13,/5X,
226 & 'lighting time =',1PG20.13,/5X,
227 & 'explosive material number =',i10 )
228 1601 FORMAT(///5x,
229 & 'PLANAR DETONATION ',i10,/5x,
230 & '---------------- ',/5x,
231 & 'BASIS NODE ID =',i10 ,/5x,
232 & ' X-COORDINATE =',1pg20.13,/5x,
233 & ' Y-COORDINATE =',1pg20.13,/5x,
234 & ' Z-COORDINATE =',1pg20.13,/5x,
235 & 'NORMAL NODE ID =',i10 ,/5x,
236 & ' X-COORDINATE =',1pg20.13,/5x,
237 & ' Y-COORDINATE =',1pg20.13,/5x,
238 & ' Z-COORDINATE =',1pg20.13,/5x,
239 & 'NORMAL VECTOR ',/5x,
240 & ' X-COORDINATE =',1pg20.13,/5x,
241 & ' Y-COORDINATE =',1pg20.13,/5x,
242 & ' Z-COORDINATE =',1pg20.13,/5x,
243 & 'LIGHTING TIME =',1pg20.13,/5x,
244 & 'EXPLOSIVE MATERIAL NUMBER =',i10 )
245C-----------------------------------------------
246
247 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_detplan
subroutine read_dfs_detplan(detonators, x, ipm, itabm1, unitab, lsubmodel)
Definition read_dfs_detplan.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