OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_dfs_detcord.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_detcord ../starter/source/initial_conditions/detonation/read_dfs_detcord.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!|| detcord0 ../starter/source/initial_conditions/detonation/detcord0.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
33!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| ifrontplus ../starter/source/spmd/node/frontplus.F
36!|| nintri ../starter/source/system/nintrr.F
37!|| nodgrnr5 ../starter/source/starter/freform.F
38!|| unused_mat_detonator ../starter/source/initial_conditions/detonation/unused_mat_detonator.F
39!|| usr2sys ../starter/source/system/sysfus.F
40!||--- uses -----------------------------------------------------
41!|| detonators_mod ../starter/share/modules1/detonators_mod.F
42!|| format_mod ../starter/share/modules1/format_mod.F90
43!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
44!|| message_mod ../starter/share/message_module/message_mod.F
45!|| submodel_mod ../starter/share/modules1/submodel_mod.F
46!||====================================================================
47 SUBROUTINE read_dfs_detcord(DETONATORS,X,IGRNOD,IPM,ITABM1,UNITAB,LSUBMODEL,ITAB)
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE unitab_mod
52 USE message_mod
53 USE detonators_mod
54 USE groupdef_mod
55 USE hm_option_read_mod
56 USE submodel_mod
57 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
58 USE format_mod , ONLY : fmw_10i
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "com04_c.inc"
67#include "units_c.inc"
68#include "param_c.inc"
69#include "tabsiz_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
74 INTEGER,INTENT(IN) :: ITABM1(SITABM1),ITAB(NUMNOD)
75 INTEGER,INTENT(IN) :: IPM(NPROPMI,NUMMAT)
76 my_real,INTENT(IN) :: x(3,numnod)
77 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(NSUBMOD)
78 TYPE(detonators_struct_),INTENT(INOUT) :: DETONATORS
79 TYPE (GROUP_),DIMENSION(NGRNOD),INTENT(IN) :: IGRNOD
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER :: I, MAT, J, NPEM, K,IGU,IGS,JJ,MDET,DET_ID,IDET
84 INTEGER :: IBID, NODE_ID1, NODE_ID2,uID1,uID2, IOPT, IUNIT, UID
85 INTEGER :: FLAG_FMT,IMAT,IFLAGUNIT,UNUSED,NNOD
86 INTEGER :: STAT,NPE,NPE2
87 my_real :: xc, yc, zc, alt, xc1, yc1, zc1, xc2, yc2, zc2, nx, ny, nz, bid, vcj
88 CHARACTER*40 :: MESS
89 CHARACTER*64 :: chain1,chain2
90 CHARACTER(LEN=NCHARKEY) :: KEY, KEY2
91 CHARACTER(LEN=NCHARTITLE) :: TITR
92 LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
93 INTEGER :: NDETPS,NDETSG,NECRAN,NDETPL,NDETCORD
94C-----------------------------------------------
95C E x t e r n a l F u n c t i o n s
96C-----------------------------------------------
97 INTEGER,EXTERNAL :: NODGRNR5, USR2SYS, NINTRI
98 INTEGER :: UNUSED_MAT_DETONATOR
99 DATA mess/'DETONATORS DEFINITION '/
100C-----------------------------------------------
101C S o u r c e L i n e s
102C-----------------------------------------------
103 CALL hm_option_start('/DFS/DETCORD')
104
105 DO idet=1,detonators%N_DET_CORD
106
107 CALL hm_option_read_key(lsubmodel,option_id=det_id, unit_id=uid,keyword2=key,keyword3=key2)
108 IF (len_trim(key) > 0) key = key(1:7)
109 IF (len_trim(key2) > 0) key2 = key2(1:4)
110
111 is_encrypted= .false.
112 is_available = .false.
113 CALL hm_option_is_encrypted(is_encrypted)
114 !---------------------------------!
115 ! READING !
116 !---------------------------------!
117 CALL hm_get_floatv('magnitude', vcj, is_available, lsubmodel, unitab)
118 CALL hm_get_floatv('rad_det_time', alt, is_available, lsubmodel, unitab)
119 CALL hm_get_intv('rad_det_iopt', iopt, is_available, lsubmodel)
120 CALL hm_get_intv('rad_det_materialid', mat, is_available, lsubmodel)
121 CALL hm_get_intv('entityid', igu, is_available, lsubmodel)
122
123 !---------------------------------!
124 ! CHECKING USER FLAGS !
125 ! +INTERNAL ID !
126 !---------------------------------!
127 mdet=mat !bak
128 IF (alt > infinity) alt=infinity
129 IF (alt < -infinity)alt=-infinity
130 nnod = nodgrnr5(igu ,igs,detonators%CORD(idet)%NODES,igrnod,itabm1,mess)
131 IF(igrnod(igs)%SORTED /= 1)THEN
132 CALL ancmsg(msgid = 104,msgtype = msgerror,anmode = aninfo,
133 . c1 = '/DFS/DETCORD',
134 . i1 = det_id,
135 . c2 = 'ORDERED GROUP OF NODES IS REQUIRED')
136 ENDIF
137 unused = 0
138 IF(mat > 0)unused=unused_mat_detonator(mat,nummat,ipm)
139 IF (mat < 0) THEN
140 CALL ancmsg(msgid=102,msgtype=msgerror,anmode=aninfo,
141 . i1=det_id,
142 . c1='DETONATOR IS REFERRING TO A NEGATIVE MATERIAL ID',
143 . c2='/DFS/DETCORD',
144 . i2=mdet)
145 ELSEIF (unused==1) THEN
146 CALL ancmsg(msgid=102,
147 . msgtype=msgerror,
148 . anmode=aninfo,
149 . i1=det_id,
150 . c1='DETONATOR IS REFERRING TO AN UNKNOWN MATERIAL ID',
151 . c2='/DFS/DETCORD',
152 . i2=mdet)
153 ELSEIF (unused==2) THEN
154 CALL ancmsg(msgid=102,msgtype=msgerror,anmode=aninfo,
155 . i1=det_id,
156 . c1='DETONATOR MUST REFER TO A JWL MATERIAL LAW (LAWS 5, 51, 97, 151)',
157 . c2='/DFS/DETCORD',
158 . i2=mdet)
159 ELSEIF (nnod == 0) THEN
160
161 ELSE
162 detonators%CORD(idet)%IS_MAT_VALID = .true.
163 !---------------------------------!
164 ! LISTING PRINTOUT !
165 !---------------------------------!
166 !IOPT=0 : def=3
167 !IOPT=1 : Vdet - multiple segments (experimental / osbslete)
168 !IOPT=2 : instantaneous - multiple segments (experimental / obsolete)
169 !IOPT=3 : Centripetal-Catmull-Rom SPLINE interpolation + projection along neutral fiber
170 IF(is_encrypted) WRITE(iout,1001)
171 IF(iopt == 0)iopt=3
172 IF(iopt == 2)THEN
173 IF(.NOT.is_encrypted)WRITE(iout,1700) det_id,igu,nnod,alt,mdet
174 ELSEIF(iopt == 1)THEN
175 IF(.NOT.is_encrypted)WRITE(iout,1701) det_id,igu,nnod,alt,vcj,mdet
176 ELSEIF(iopt==3)THEN
177 IF(.NOT.is_encrypted)WRITE(iout,1700) det_id,igu,nnod,alt,mdet
178 ENDIF
179
180 IF(.NOT.is_encrypted)WRITE(iout,fmt=fmw_10i) (itab(detonators%CORD(idet)%NODES(i)),i=1,nnod)
181 DO i=1,nnod
182 CALL ifrontplus(detonators%CORD(idet)%NODES(i),1)
183 END DO
184 IF(iopt == 1 .AND. vcj <= zero)iopt=2
185
186 CALL detcord0(detonators%CORD(idet),alt,x,vcj,iopt)
187
188 !---------------------------------!
189 detonators%CORD(idet)%TDET= alt
190 detonators%CORD(idet)%MAT = mat
191 detonators%CORD(idet)%VDET = vcj
192 detonators%CORD(idet)%IOPT = iopt
193 END IF
194
195 END do!next IDET
196
197C-----------------------------------------------
198C O u t p u t F o r m a t
199C-----------------------------------------------
200 1001 FORMAT(///5x,
201 & 'DETONATING CORD ',i10,/5x,
202 & '--------------- ',/5x,
203 & 'CONFIDENTIAL DATA')
204 1700 FORMAT(///5x,
205 & 'DETONATING CORD ',i10,/5x,
206 & '---------------- ',/5x,
207 & 'node group identifier =',I10 ,/5X,
208 & 'number of points(cord) =',I10 ,/5X,
209 & 'lighting time =',1PG20.13,/5X,
210 & 'explosive material number =',I10 ,/5X,
211 & 'cord definition : ')
212 1701 FORMAT(///5X,
213 & 'detonating cord ',I10,/5X,
214 & '---------------- ',/5X,
215 & 'node group identifier =',I10 ,/5X,
216 & 'number of points(cord) =',I10 ,/5X,
217 & 'lighting time =',1PG20.13,/5X,
218 & 'detonation velocity =',1PG20.13,/5X,
219 & 'explosive material number =',I10 ,/5X,
220 & 'cord definition : ')
221C-----------------------------------------------
222
223 END SUBROUTINE
my_real
#define my_real
Definition cppsort.cpp:32
detcord0
subroutine detcord0(detonator_cord, alt, x, vdet2, iopt)
Definition detcord0.F:31
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:100
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_detcord
subroutine read_dfs_detcord(detonators, x, igrnod, ipm, itabm1, unitab, lsubmodel, itab)
Definition read_dfs_detcord.F:48
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
detonators_mod::detonators_struct_
Definition detonators_mod.F:154
submodel_mod::submodel_data
Definition submodel_mod.F:723