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.AND. IF(NODE_ID1==0 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.AND..AND. ELSEIF((NX == ZERO)(NY == ZERO)(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.NOT. IF(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.NOT. IF(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:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
id
initmumps id
Definition multiplerhs_example.m:4
detonators_mod
Definition detonators_mod.F:80
groupdef_mod
Definition groupdef_mod.F:668
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
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
read_dfs_detplan
subroutine read_dfs_detplan(detonators, x, ipm, itabm1, unitab, lsubmodel)
Definition read_dfs_detplan.F:45
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
starter
program starter
Definition starter.F:39
detonators_mod::detonators_struct_
Definition detonators_mod.F:155
submodel_mod::submodel_data
Definition submodel_mod.F:728