OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_preread_properties.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr03_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_preread_properties (igeo, nsphsol, nply, nsub, nisub, lsubmodel, defaults)

Function/Subroutine Documentation

◆ hm_preread_properties()

subroutine hm_preread_properties ( integer, dimension(npropgi,*) igeo,
integer nsphsol,
integer, dimension (numgeo + numstack) nply,
integer, dimension (numgeo + numstack) nsub,
integer, dimension (numgeo + numstack) nisub,
type(submodel_data), dimension(*) lsubmodel,
type(defaults_), intent(in) defaults )

Definition at line 39 of file hm_preread_properties.F.

40C============================================================================
41C-----------------------------------------------
42C A n a l y s e M o d u l e
43C-----------------------------------------------
44 USE stack_var_mod
45 USE submodel_mod
46 USE hm_option_read_mod
47 USE defaults_mod
48 USE names_and_titles_mod , ONLY : nchartitle, ncharfield, ncharkey, ncharline
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com04_c.inc"
57#include "param_c.inc"
58#include "scr03_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER IGEO(NPROPGI,*),NSPHSOL
63 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
64 INTEGER ,DIMENSION (NUMGEO + NUMSTACK) :: NPLY,NSUB,NISUB
65 TYPE(DEFAULTS_), INTENT(IN) :: DEFAULTS
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I, IG, IGTYP, ISMSTR, NIP, J, IR1X, IR1Y, IR1Z, IREP,
70 . IR2X, IR2Y, IR2Z, ISHEAR, IRX, IROT, IMODE, IP, ISTRAIN,I8PT,
71 . ISK,ITU,IRB,IHON,IHBE,IPLAST,ITHK,IBID,IHBEOUTP,K,N,LAMINATE,
72 . IGFLU, IDS, NSHELL, NSHSUP, NSHINF, FLGBADI, NBADI,UID,
73 . NSST_D, NSST_DS, NPSH, ICPRE, ICSTR ,NPTS,ISEN,ISORTH,
74 . NSPHDIR, ID_SENS,D1,D2,D3,N1,N2,N3,INTRULE,NN,NS,NIS, NUMS,
75 . NLAM,NINTS,IFRAM,CPT,INUM,ID,IS,LAMINAT
76 DATA nshell /0/, nshsup /0/, nshinf /0/
77 my_real
78 . fn, ft, dx, angl,pun,htest,hclos,cvis,rbid,vx,vy,vz,
79 . knot1,knot2,knot3,r5(5),dn
80 CHARACTER(LEN=NCHARTITLE) :: IDTITL
81 CHARACTER(LEN=NCHARLINE) :: KEY, SOLVERKEYWORD
82 CHARACTER(LEN=NCHARFIELD) :: STRING
83 CHARACTER :: CHROT*7,MESS*40
84 INTEGER ISH3N,ITET4,IPLAS,NPT,ISROT,NP,LAMIN,NSUB_STACK,NISUB_STACK,NPLY_STACK,NPLY_SUB,ITET4_D
85 LOGICAL IS_AVAILABLE
86
87!! TYPE(STACK_INFO_ ) , DIMENSION(:), POINTER :: STACK_INFO
88C=======================================================================
89
90 ALLOCATE(numgeostack(numgeo + numstack))
91 numgeostack(:) = 0 ! global variable - STACK_VAR_MOD
92 nprop_stack = 0 ! global variable - STACK_VAR_MOD
93C
94 nsub(:) = 0
95 nisub(:) = 0
96 nply(:) = 0
97 itet4_d= defaults%SOLID%ITETRA4
98C--------------------------------------------------
99 is_available = .false.
100C--------------------------------------------------
101C START BROWSING MODEL PARTS
102C--------------------------------------------------
103 CALL hm_option_start('PROPERTY')
104C--------------------------------------------------
105C BROWSING MODEL PROPERTIES 1->HM_NUMGEO
106C--------------------------------------------------
107 numeltg6 = 0
108 i = 0
109 DO cpt=1,hm_numgeo
110 i = i + 1
111 key = ''
112 solverkeyword = ''
113 idtitl = ''
114C--------------------------------------------------
115C EXTRACT DATAS OF /PART/... LINE
116C--------------------------------------------------
117 CALL hm_option_read_key(lsubmodel,
118 . option_id = ig,
119 . keyword2 = key)
120C--------------------------------------------------
121 SELECT CASE(key(1:len_trim(key)))
122 CASE ('TYPE0','VOID')
123C--------------------------------------------------
124C HM READING PROPERTY TYPE0 (VOID)
125C--------------------------------------------------
126 CASE ('TYPE1','TYPE01','SHELL','TYPE9','TYPE09','SH_ORTH','TYPE11','SH_SANDW',
127 . 'SH_FABR','TYPE16')
128C--------------------------------------------------
129C HM READING PROPERTY TYPE1 (SHELL)
130C--------------------------------------------------
131 CALL hm_get_intv('Ishell',ihbe,is_available,lsubmodel)
132 CALL hm_get_intv('ISMSTR',ismstr,is_available,lsubmodel)
133 CALL hm_get_intv('ISH3',ish3n,is_available,lsubmodel)
134 CALL hm_get_intv('CVIS',cvis,is_available,lsubmodel)
135 IF(ish3n==31.AND.numeltg>0) numeltg6 = 1
136
137 CASE ('TYPE17','STACK')
138C--------------------------------------------------
139C HM READING PROPERTY TYPE17 (SHELL)
140C--------------------------------------------------
141 igtyp=17
142 nprop_stack = nprop_stack + 1
143 numgeostack(i) = nprop_stack
144C
145 CALL hm_get_intv('laminateconfig' ,lamin, is_available, lsubmodel)
146c
147 nsub_stack = 0
148 nisub_stack = 0
149 nply_stack = 0
150 IF (lamin > 0) THEN
151 CALL hm_get_intv('sublaminateidlistmax' ,nsub_stack, is_available, lsubmodel)
152 CALL hm_get_intv('interfacepairsize' ,nisub_stack, is_available, lsubmodel)
153
154 DO is = 1,nsub_stack
155 CALL hm_get_int_array_index('plyidlistmax',nply_sub,is,is_available,lsubmodel)
156 nply_stack = nply_stack + nply_sub
157 END DO
158c
159 ELSE ! property defined by a list of plies
160 CALL hm_get_intv('plyidlistmax' ,nply_stack ,is_available ,lsubmodel)
161 END IF
162 nply(nprop_stack) = nply_stack
163 nsub(nprop_stack) = nsub_stack
164 nisub(nprop_stack)= nisub_stack
165C--------------------------------------------------
166C HM READING PROPERTY TYPE14,6 (SOLID)
167C--------------------------------------------------
168 CASE ('TYPE6','SOL_ORTH')
169 CALL hm_get_intv('Itetra4',itet4,is_available,lsubmodel)
170 IF(itet4 == 0) itet4 = itet4_d
171 IF(itet4 == 1)iisrot = 1
172 CALL hm_get_intv('Ndir',nsphdir,is_available,lsubmodel)
173 igeo(1,i) =ig
174 igeo(37,i)=nsphdir
175 IF(nsphdir/=0)nsphsol=1
176C--------------------------------------------------
177C HM READING PROPERTY TYPE51 (SHELL)
178C--------------------------------------------------
179 CASE ('TYPE51')
180 nprop_stack = nprop_stack + 1
181 numgeostack(i) = nprop_stack
182c
183 CALL hm_get_intv('laminateconfig' ,laminate, is_available, lsubmodel)
184 IF (laminate > 0) THEN
185 CALL hm_get_intv('sublaminateidlistmax' ,NLAM, IS_AVAILABLE, LSUBMODEL)
186 CALL HM_GET_INTV('interfacepairsize' ,NINTS, IS_AVAILABLE, LSUBMODEL)
187 NSUB(NPROP_STACK) = NLAM
188 NISUB(NPROP_STACK) = NINTS
189 DO IS = 1,NLAM
190 CALL HM_GET_INT_ARRAY_2INDEXES('plyidlistmax',NP,IS,1,IS_AVAILABLE,LSUBMODEL)
191 NPLY(NPROP_STACK) = NPLY(NPROP_STACK) + NP
192 END DO
193 ELSE
194 CALL HM_GET_INTV('plyidlistmax' ,NP, IS_AVAILABLE, LSUBMODEL)
195 NPLY(NPROP_STACK) = NPLY(NPROP_STACK) + NP
196 END IF
197C-------------------------------------------------
198C HM READING PROPERTY TYPE14 (SOLID)
199C--------------------------------------------------
200 CASE ('type14','solid')
201 CALL HM_GET_INTV('i_rot',ITET4,IS_AVAILABLE,LSUBMODEL)
202 IF(ITET4 == 0) ITET4 = ITET4_D
203 IF(ITET4 == 1)IISROT = 1
204 CALL HM_GET_INTV('ndir',NSPHDIR,IS_AVAILABLE,LSUBMODEL)
205 IGEO(1,I) =IG
206 IGEO(37,I)=NSPHDIR
207 IF(NSPHDIR/=0)NSPHSOL=1
208C--------------------------------------------------
209 CASE ('pcompp')
210 IGTYP=52
211C--------------------------------------------------
212 CASE ('type29','type30','type31',
213 . 'user1' ,'user2' ,'user3')
214 IISROT = 1
215C--------------------------------------------------
216 END SELECT
217 ENDDO
218c-----------------------------------------------------------------------
219c stack object prelecture
220c-----------------------------------------------------------------------
221C
222 IF(NUMSTACK > 0) THEN
223 CALL HM_OPTION_START('/stack')
224 DO 700 I=1,NUMSTACK
225 CALL HM_OPTION_READ_KEY(LSUBMODEL,OPTION_ID = IG,KEYWORD2 = KEY)
226 NPROP_STACK = NPROP_STACK + 1
227 NUMGEOSTACK(NUMGEO + I) = NPROP_STACK
228 CALL HM_GET_INTV('laminateconfig' ,LAMINATE, IS_AVAILABLE, LSUBMODEL)
229 CALL HM_GET_INTV('laminateconfig' ,LAMIN , IS_AVAILABLE, LSUBMODEL)
230
231 IF (LAMINATE > 0) THEN
232 CALL HM_GET_INTV('sublaminateidlistmax' ,NLAM, IS_AVAILABLE, LSUBMODEL)
233 CALL HM_GET_INTV('interfacepairsize' ,NINTS, IS_AVAILABLE, LSUBMODEL)
234 NSUB(NPROP_STACK) = NLAM
235 NISUB(NPROP_STACK) = NINTS
236 DO IS = 1,NLAM
237 CALL HM_GET_INT_ARRAY_2INDEXES('plyidlistmax',NP,IS,1,IS_AVAILABLE,LSUBMODEL)
238 NPLY(NPROP_STACK) = NPLY(NPROP_STACK) + NP
239 END DO
240 ELSE
241 CALL HM_GET_INTV('plyidlistmax' ,NP, IS_AVAILABLE, LSUBMODEL)
242 NPLY(NPROP_STACK) = NPLY(NPROP_STACK) + NP
243 END IF
244C
245 700 CONTINUE
246 ENDIF
247
248c-----------
249C
250C Table allocation for type17,51 and 52
251C
252 IF(NPROP_STACK > 0) THEN
253 ALLOCATE(STACK_INFO(NPROP_STACK))
254 DO NUMS=1,NPROP_STACK
255 NN = NPLY(NUMS)
256 NS = NSUB(NUMS)
257 NIS = NISUB(NUMS)
258 NULLIFY(STACK_INFO(NUMS)%PID,STACK_INFO(NUMS)%MID,
259 . STACK_INFO(NUMS)%MID_IP,
260 . STACK_INFO(NUMS)%SUB,STACK_INFO(NUMS)%ISUB,
261 . STACK_INFO(NUMS)%THK,STACK_INFO(NUMS)%ANG,
262 . STACK_INFO(NUMS)%POS,STACK_INFO(NUMS)%DIR,
263 . STACK_INFO(NUMS)%THKLY,STACK_INFO(NUMS)%WEIGHT)
264
265 IF(NN > 0 ) THEN
266 ALLOCATE(STACK_INFO(NUMS)%PID(NN),STACK_INFO(NUMS)%MID(NN),
267 . STACK_INFO(NUMS)%MID_IP(NN),
268 . STACK_INFO(NUMS)%THK(NN),STACK_INFO(NUMS)%ANG(NN),
269 . STACK_INFO(NUMS)%POS(NN),STACK_INFO(NUMS)%DIR(NN),
270 . STACK_INFO(NUMS)%THKLY(NN),STACK_INFO(NUMS)%WEIGHT(NN))
271 STACK_INFO(NUMS)%PID(1:NN)= 0
272 STACK_INFO(NUMS)%MID(1:NN)= 0
273 STACK_INFO(NUMS)%MID_IP(1:NN)= 0
274 STACK_INFO(NUMS)%THK(1:NN)= ZERO
275 STACK_INFO(NUMS)%ANG(1:NN)= ZERO
276 STACK_INFO(NUMS)%POS(1:NN)= ZERO
277 STACK_INFO(NUMS)%THKLY(1:NN)= ONE
278 STACK_INFO(NUMS)%WEIGHT(1:NN)= ONE
279 ENDIF
280 IF(NS > 0)THEN
281 ALLOCATE(STACK_INFO(NUMS)%SUB(2*NS))
282 STACK_INFO(NUMS)%SUB(1:2*NS)= 0
283 ENDIF
284 IF(NIS > 0)THEN
285 ALLOCATE(STACK_INFO(NUMS)%ISUB(3*NIS))
286 STACK_INFO(NUMS)%ISUB(1:3*NIS)= 0
287 ENDIF
288 ENDDO
289 ELSE
290 ALLOCATE(STACK_INFO(0))
291 ENDIF ! NPROP_STACK
292 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
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
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
stack_var_mod
Definition stack_var_mod.F:33
stack_var_mod::numgeostack
integer, dimension(:), allocatable numgeostack
Definition stack_var_mod.F:42
stack_var_mod::nprop_stack
integer nprop_stack
Definition stack_var_mod.F:44
submodel_mod
Definition submodel_mod.F:712