OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_part.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!|| hm_read_part ../starter/source/model/assembling/hm_read_part.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ale_euler_init ../starter/source/materials/ale/ale_euler_init.F
29!|| ancmsg ../starter/source/output/message/message.F
30!|| fretitl ../starter/source/starter/freform.F
31!|| fretitl2 ../starter/source/starter/freform.F
32!|| get_u_geo ../starter/source/user_interface/uaccess.F
33!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
34!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
35!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
36!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
37!|| nintri ../starter/source/system/nintrr.F
38!|| udouble ../starter/source/system/sysfus.F
39!||--- uses -----------------------------------------------------
40!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
41!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
42!|| message_mod ../starter/share/message_module/message_mod.F
43!|| submodel_mod ../starter/share/modules1/submodel_mod.F
44!||====================================================================
45 SUBROUTINE hm_read_part(IPART,PM,GEO,IPM,IGEO,IWA,THK_PART,
46 . UNITAB,LSUBMODEL,MULTI_FVM,MLAW_TAG,
47 . MAT_PARAM,GLOB_THERM)
48C-----------------------------------------------
49C ROUTINE DESCRIPTION :
50C ===================
51C READ /PART USING HM_READER
52C-----------------------------------------------
53C DUMMY ARGUMENTS DESCRIPTION:
54C ===================
55C
56C NAME DESCRIPTION
57C
58C IPART PART ARRAY
59C PM MATERIAL ARRAY(REAL)
60C GEO PROPERTY ARRAY(REAL)
61C IPM MATERIAL ARRAY(INTEGER)
62C IGEO PROPERTY ARRAY(INTEGER)
63C THK_PART VIRTUAL THICKNESS FOR PART ( USE BY CONTACT INTERFACES )
64C UNITAB UNITS ARRAY
65C LSUBMODEL SUBMODEL STRUCTURE
66C============================================================================
67C-----------------------------------------------
68C M o d u l e s
69C-----------------------------------------------
70 USE unitab_mod
71 USE message_mod
72 USE submodel_mod
73 USE hm_option_read_mod
74 USE multi_fvm_mod
75 USE elbuftag_mod
76 USE ale_mod
77 USE mat_elem_mod
78 USE names_and_titles_mod , ONLY : nchartitle
79 use glob_therm_mod
80C-----------------------------------------------
81C I m p l i c i t T y p e s
82C-----------------------------------------------
83#include "implicit_f.inc"
84C-----------------------------------------------
85C C o m m o n B l o c k s
86C-----------------------------------------------
87#include "scr17_c.inc"
88#include "units_c.inc"
89#include "com01_c.inc"
90#include "com04_c.inc"
91#include "com_xfem1.inc"
92#include "param_c.inc"
93C-----------------------------------------------
94C D u m m y A r g u m e n t s
95C-----------------------------------------------
96C INPUT ARGUMENTS
97 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
98 my_real,INTENT(IN)::GEO(NPROPG,NUMGEO)
99 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
100C OUTPUT ARGUMENTS
101 INTEGER,INTENT(OUT)::IPART(LIPART1,*)
102 INTEGER,INTENT(OUT)::IWA(*)
103 my_real,INTENT(OUT)::thk_part(*)
104C MODIFIED ARGUMENT
105 INTEGER,INTENT(INOUT)::IGEO(NPROPGI,NUMGEO)
106 INTEGER,INTENT(INOUT)::IPM(NPROPMI,NUMMAT)
107 my_real,INTENT(INOUT)::pm(npropm,nummat)
108 TYPE(multi_fvm_struct),INTENT(INOUT)::MULTI_FVM
109 TYPE(mlaw_tag_) , DIMENSION(NUMMAT) , INTENT(INOUT) :: MLAW_TAG
110 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
111 type (glob_therm_) ,intent(inout) :: glob_therm
112C-----------------------------------------------
113C L o c a l V a r i a b l e s
114C-----------------------------------------------
115 CHARACTER MESS*40
116 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1,TITR2,LINE1
117 CHARACTER*5 CHAR_PROP,CHAR_MAT
118 CHARACTER*7::CHAR_MAT_TYPE,CHAR_PROP_TYPE
119 LOGICAL IS_AVAILABLE, USER_LAW, IS_ASSOCIATED_LAW51
120 INTEGER PID,MID,SID,ID,ID1,ID2,I,IMID,IPID,ISID,K,ITH, IGTYP,XFEMFLG,
121 . ixfem,ihbe,ilaw,uid,iflagunit,j,idmat_ply,
122 . ilaw_ply,ipmat,npt,idpartsph,sub_index,SIZE, ids, cnt,
123 . ifix_tmp,stat,jale_from_prop,jale_from_mat
124 my_real bid, thick,fac_l,mp,vol,diam
125C-----------------------------------------------
126C E x t e r n a l F u n c t i o n s
127C-----------------------------------------------
128 my_real get_u_geo
129 EXTERNAL get_u_geo
130 INTEGER NINTRI
131 DATA mess/' PART DEFINITION '/
132C-----------------------------------------------
133C S o u r c e L i n e s
134C-----------------------------------------------
135
136 titr1 = repeat(" ",nchartitle)
137 titr2 = repeat(" ",nchartitle)
138 titr = repeat(" ",nchartitle)
139 line1 = repeat(" ",nchartitle)
140 char_prop = repeat(" ",5)
141 char_mat = repeat(" ",5)
142 char_mat_type = repeat(" ",7)
143 char_prop_type = repeat(" ",7)
144
145
146 is_associated_law51 = .false.
147 is_available = .false.
148 sub_index = 0
149 uid = 0
150 fac_l = one
151 xfemflg = 0
152 ixfem = 0
153
154 WRITE(iout,'(//A)')' PARTS'
155 WRITE(iout,'(A//)')' -----'
156
157 DO i=1,numgeo
158 iwa(i) = 0
159 ENDDO
160 DO i=1,nummat
161 iwa(numgeo+i) = 0
162 ENDDO
163C--------------------------------------------------
164C ALE or EULER CONVECTION CODES (CONVECTION/REZONING/EBCS)
165C--------------------------------------------------
166 ale%GLOBAL%CODV(1:ale%GLOBAL%LCONV)=0
167C--------------------------------------------------
168C START BROWSING MODEL PARTS
169C--------------------------------------------------
170 CALL hm_option_start('PART')
171C--------------------------------------------------
172C BROWSING MODEL PARTS 1->NPART
173C--------------------------------------------------
174 DO i=1,npart
175 titr = ''
176C--------------------------------------------------
177C EXTRACT DATAS OF /PART/... LINE
178C--------------------------------------------------
179 CALL hm_option_read_key(lsubmodel,
180 . option_id = id,
181 . unit_id = uid,
182 . submodel_index = sub_index,
183 . option_titr = titr)
184C--------------------------------------------------
185C EXTRACT DATAS (INTEGER VALUES)
186C--------------------------------------------------
187 CALL hm_get_intv('propertyid',pid,is_available,lsubmodel)
188 CALL hm_get_intv('materialid',mid,is_available,lsubmodel)
189 CALL hm_get_intv('subsetid',sid,is_available,lsubmodel)
190C--------------------------------------------------
191C EXTRACT DATAS (REAL VALUES)
192C--------------------------------------------------
193 CALL hm_get_floatv('THICK',thick,is_available,lsubmodel,unitab)
194C--------------------------------------------------
195
196 CALL fretitl(titr,ipart(lipart1-ltitr+1,i),ltitr)
197
198 thk_part(i) = thick
199
200C--------------------------------------------------
201C MATERIAL & PROPERTY CHECKS
202C--------------------------------------------------
203 ipid = nintri(pid,igeo,npropgi,numgeo,1)
204 IF(ipid == 0) THEN
205 ipid=1
206 CALL ancmsg(msgid=178,msgtype=msgerror,anmode=aninfo,i1=id,c1=titr,i2=pid)
207 titr1=' '
208 ELSE
209 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid),ltitr)
210 ENDIF
211
212 igtyp=nint(geo(12,ipid))
213 IF(igtyp == 17 .OR. igtyp == 51) ipart_stack = 1
214 IF(igtyp == 52) ipart_pcompp = 1
215 IF( (igtyp == 0).OR.
216 . (igtyp == 1).OR.(igtyp == 2).OR.(igtyp == 3).OR.
217 . (igtyp == 6).OR.(igtyp == 9).OR.(igtyp == 10).OR.
218 . (igtyp == 11).OR.(igtyp == 14).OR.(igtyp == 16).OR.
219 . (igtyp == 18).OR.(igtyp == 20).OR.(igtyp == 21).OR.
220 . (igtyp == 22).OR.(igtyp == 34).OR.(igtyp == 11).OR.
221 . (igtyp == 17).OR.(igtyp == 51).OR.(igtyp == 52).OR.
222 . (igtyp == 23).OR.(igtyp == 43)) THEN
223 IF(mid == 0) THEN
224 CALL ancmsg(msgid=179,
225 . msgtype=msgerror,
226 . anmode=aninfo,
227 . i1=id,
228 . c1=titr,
229 . i2=mid)
230 ENDIF
231 ENDIF
232 !--- check material identifier
233 IF(mid == 0) THEN
234 !fictitious material law for spring elements
235 imid=nummat
236 ilaw=ipm(2,imid)
237 ELSE
238 imid = nintri(mid,ipm,npropmi,nummat,1)
239 IF(imid == 0) THEN
240 CALL ancmsg(msgid=179,
241 . msgtype=msgerror,
242 . anmode=aninfo,
243 . i1=id,
244 . c1=titr,
245 . i2=mid)
246 ilaw=0
247 ELSE
248 ilaw = ipm(2,imid)
249 ixfem = mat_param(imid)%IXFEM
250 CALL fretitl2(titr2,ipm(npropmi-ltitr+1,imid),ltitr)
251 ENDIF
252 !check if law151 is used
253 IF(ilaw == 151)is_associated_law51=.true.
254
255 !--- check property identifier
256 igtyp=0
257 IF(ipid > 0) igtyp=igeo(11,ipid)
258 IF (ixfem > 0 .and. (igtyp==1 .or. igtyp==9 .or. igtyp==10 .or.
259 . igtyp==11 .or. igtyp==51)) THEN
260 xfemflg = xfemflg + ixfem
261 END IF
262 IF (ilaw == 99.AND.igtyp == 14) THEN
263 ihbe=igeo(10,ipid)
264 IF (ihbe == 12) THEN
265 CALL ancmsg(msgid=768,
266 . msgtype=msgerror,
267 . anmode=aninfo,
268 . i1=id,
269 . c1=titr,
270 . i2=pid,
271 . c2=titr1,
272 . i3=mid,
273 . c3=titr2,
274 . c4='SOLID',
275 . i4=ihbe)
276 END IF
277 END IF
278 !tag for user material law
279 IF (ilaw==29 .or. ilaw==30 .or. ilaw==31 .or. ilaw==99) THEN
280 user_law = .true.
281 ELSE
282 user_law = .false.
283 ENDIF
284
285 !check compatibility between material law and property
286 IF (((igtyp==43) .and. ((ilaw/=59 .and. ilaw/=83 .and. ilaw/=116 .and. ilaw/=117 .AND. ilaw /=120.AND.ilaw/=169) .and.
287 . (user_law .eqv. .false. ) ).eqv. .true.) .or.
288 . ((ilaw==59 .or. ilaw==83 .or. ilaw==116 .or. ilaw==117) .and. igtyp/=43) .or.
289 . (ilaw==1 .and. (igtyp==9.OR.igtyp==10.OR.igtyp==11.OR.igtyp==16.OR.
290 . igtyp==17.OR.igtyp==51.OR.igtyp==52) .eqv. .true.) .eqv. .true.) THEN
291 CALL ancmsg(msgid=658,
292 . msgtype=msgerror,
293 . anmode=aninfo_blind_2,
294 . i1=pid,
295 . c1=titr1,
296 . i2=ilaw,
297 . i3=igtyp)
298 ENDIF
299
300 !anisotropic material law not compatible with isotropic property
301 IF (ilaw == 87 .AND. igtyp /= 9) THEN
302 CALL ancmsg(msgid=1110,
303 . msgtype=msgwarning,
304 . anmode=aninfo_blind_1,
305 . i1=id,
306 . c1=titr,
307 . i2=ilaw,
308 . i3=igtyp)
309 ENDIF
310 IF (ilaw == 187 .AND. igtyp /= 6) THEN
311 CALL ancmsg(msgid=1110,
312 . msgtype=msgwarning,
313 . anmode=aninfo_blind_1,
314 . i1=id,
315 . c1=titr,
316 . i2=ilaw,
317 . i3=igtyp)
318 ENDIF
319
320 !rigid material law (obsolete)
321 IF(ilaw == 13 .AND. iroddl == 0) iroddl = 1
322
323 ENDIF
324
325 ! compatibility of global material and ply material for type11
326 IF(igtyp == 11) THEN
327 npt=igeo(4,ipid)
328 ipmat = 100
329 DO j=1,npt
330 idmat_ply= igeo(ipmat+j,ipid)
331 ilaw_ply = ipm(2,idmat_ply)
332 IF(ilaw_ply /= ilaw) THEN
333 CALL ancmsg(msgid=1083,
334 . msgtype=msgerror,
335 . anmode=aninfo,
336 . i1=id,
337 . c1=titr,
338 . i2=pid,
339 . c2=titr1,
340 . i3=mid,
341 . c3=titr2)
342 ENDIF
343 ENDDO
344 ENDIF
345
346 !spring type 23 & material compatibility
347 IF(igtyp == 23) THEN
348 imid = nintri(mid,ipm,npropmi,nummat,1)
349 ilaw=ipm(2,imid)
350 IF(ilaw /= 108 .AND. ilaw /=113.AND. ilaw /=114 .AND. ilaw /= 0 ) THEN
351 CALL ancmsg(msgid = 1715,
352 . msgtype=msgerror,
353 . anmode=aninfo,
354 . i1=id,
355 . c1=titr)
356 ENDIF
357 ENDIF
358
359 ! law70 (/MAT/FOAM_TAB)
360 IF(ilaw == 70 .AND. igeo(31,ipid) == 1) WRITE(iout,2000)
361
362c-------------------------------------------------------------------
363c ALE EULER SPECIFIC TREATMENTS
364c-------------------------------------------------------------------
365 !SSP BUFFER + UPWIND + TURB + CHECK + CONVECTION FLAGS
366 CALL ale_euler_init( mlaw_tag,ipm,pm,igeo,titr,titr1,titr2,igtyp,
367 . id,ilaw,mid,imid,pid,ipid,jale_from_prop,jale_from_mat,
368 . glob_therm%ITHERM,glob_therm%ITHERM_FE)
369
370c-------------------------------------------------------------------
371c STARTER PRINTOUT
372c-------------------------------------------------------------------
373 WRITE(iout,'(/A,I10,2A)')'part:',ID,',',TRIM(TITR)
374 WRITE(IOUT,'(a)') '----'
375
376C----PROPERTY OUTPUT
377 CHAR_PROP_TYPE='TYPE ? '
378 IF(IPID>0)THEN
379 WRITE(CHAR_PROP_TYPE(5:7),FMT='(i3)')IGTYP
380 IF(IGTYP<10)WRITE(CHAR_PROP_TYPE(6:6),FMT='(a1)') '0'
381 ENDIF
382 WRITE(IOUT,'(a,i10,4a)')' property :',PID,' (',TRIM(CHAR_PROP_TYPE),'),',TRIM(TITR1)
383
384C----MATERIAL OUTPUT
385 CHAR_MAT_TYPE='law ? '
386 IF(IMID>0)THEN
387 WRITE(CHAR_MAT_TYPE(5:7),FMT='(i3)')ILAW
388 IF(ILAW<10)WRITE(CHAR_MAT_TYPE(6:6),FMT='(a1)') '0'
389 ENDIF
390 IF( imid /= 0) WRITE(iout,'(A,I10,4A)')' MATERIAL :',mid,' (',trim(char_mat_type),'),',trim(titr2)
391
392C----SUBSET OUTPUT
393 WRITE(iout,'(A,I10,2A)')' SUBSET :',sid
394
395C----FRAMEWORK OUTPUT
396 IF(jale_from_prop==1 .OR. jale_from_mat==1)THEN
397 WRITE(iout,'(A)')' FRAMEWORK : ALE'
398 ELSEIF(jale_from_prop==2 .OR. jale_from_mat==2)THEN
399 WRITE(iout,'(A)')' FRAMEWORK : EULER'
400 ELSE
401 WRITE(iout,'(A)')' FRAMEWORK : LAGRANGE'
402 ENDIF
403
404C----VIRTUAL THICKNESS OUTPUT (For properties which are compatible with shell elements : /SHELL and /SH3N)
405 IF( (igtyp == 0).OR.
406 . (igtyp == 1).OR.(igtyp == 9).OR.(igtyp == 10).OR.
407 . (igtyp == 11).OR.(igtyp == 16).OR.(igtyp == 17).OR.
408 . (igtyp == 19).OR.(igtyp == 51).OR.(igtyp == 52)) THEN
409 WRITE(iout,'(A,1PG20.13,2A)')' VIRT. THICKN: ',thk_part(i)
410 ENDIF
411C----VIRTUAL THICKNESS OUTPUT (extended to /BEAM /TRUSS /SPRING)
412 IF( thk_part(i)>zero .AND. ((igtyp == 3).OR.(igtyp == 2).OR.
413 . (igtyp == 18).OR.(igtyp == 4).OR.(igtyp == 8).OR.
414 . (igtyp == 12).OR.(igtyp == 13).OR.(igtyp == 23).OR.
415 . (igtyp == 25).OR.(igtyp == 26).OR.(igtyp == 27))) THEN
416 WRITE(iout,'(A,1PG20.13,2A)')' VIRT. THICKN: ',thk_part(i)
417 ENDIF
418
419C----SPH SMOOTHING LENGTH OUTPUT ( /PROP/SPH (Type34) )
420 IF (igeo(11,ipid) == 34) THEN
421 diam =get_u_geo(6,ipid)
422 IF(diam == zero) THEN
423 mp = get_u_geo(1,ipid)
424 vol = mp/pm(1,imid)
425 diam= (sqr2*vol)**third
426 WRITE(iout,'(A,1PG20.13,2A)')' SPH SMOOTHING LENGTH: ',diam
427 ENDIF
428 ENDIF
429
430c-------------------------------------------------------------------
431c STORAGE
432c-------------------------------------------------------------------
433 ipart(1,i)=imid
434 ipart(2,i)=ipid
435 isid=0
436 ipart(3,i)=isid
437 ipart(4,i)=id
438 ipart(5,i)=mid
439 ipart(6,i)=pid
440 ipart(7,i)=sid
441 ith=0
442 ipart(8,i)=ith
443 ipart(9,i)=sub_index
444
445 !ensure positive identifier
446 IF(ipart(4,i) == 0) THEN
447 CALL ancmsg(msgid=494,msgtype=msgerror,anmode=aninfo_blind_1,c1=line1)
448 ENDIF
449
450 ENDDO ! NPART
451
452C--------------------------------------------------
453C ALE or EULER CONVECTION CODES (CONVECTION/REZONING/EBCS)
454C--------------------------------------------------
455 ale%GLOBAL%NVCONV=0
456 DO i=1,ale%GLOBAL%LCONV
457 IF(ale%GLOBAL%CODV(i) == 1)THEN
458 ale%GLOBAL%NVCONV=ale%GLOBAL%NVCONV+1
459 ale%GLOBAL%CODV(i)=ale%GLOBAL%NVCONV
460 ENDIF
461 ENDDO
462C--------------------------------------------------
463C LAW151 - MULTIFLUID
464C--------------------------------------------------
465 multi_fvm%IS_USED = is_associated_law51
466 imulti_fvm = 0
467 IF (multi_fvm%IS_USED) THEN
468 imulti_fvm = 1
469 IF (n2d == 0) THEN
470 ALLOCATE(multi_fvm%VEL(3, numels), stat=stat)
471 ELSE
472 ALLOCATE(multi_fvm%VEL(3, numelq + numeltg), stat=stat)
473 ENDIF
474 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='MULTI_FVM%VEL')
475 multi_fvm%VEL(: ,:) = zero
476 ENDIF
477C--------------------------------------------------
478 IF (xfemflg == 0) icrack3d = 0
479C--------------------------------------------------
480 DO i=1,npart
481 iwa(ipart(2,i)) = 1
482 iwa(numgeo+ipart(1,i)) = 1
483 ENDDO
484C--------------------------------------------------
485 cnt = 0
486 DO i=1,numgeo
487 IF (iwa(i) == 0) cnt = cnt+1
488 ENDDO
489 ids = 52
490 cnt = 0
491 DO i=1,nummat
492 IF (iwa(numgeo+i) == 0) cnt = cnt+1
493 ENDDO
494 ids = 3
495C-------------------------------------
496C SOL2SPH : Orthotropic flag transferred to SPH property
497C-------------------------------------
498 DO i=1,npart
499 idpartsph = igeo(38,ipart(2,i))
500 IF (idpartsph > 0) THEN
501 igeo(17,ipart(2,idpartsph)) = igeo(17,ipart(2,i))
502 ENDIF
503 ENDDO
504C-------------------------------------
505C DUPLICATED IDs
506C-------------------------------------
507 CALL udouble(ipart(4,1),lipart1,npart,mess,0,bid)
508C-------------------------------------
509 RETURN
510 2000 FORMAT(5x,'for law 70 the default VALUE of qa and qb is 0' )
511C
512 END
513!||====================================================================
514!|| hm_preread_part ../starter/source/model/assembling/hm_read_part.F
515!||--- called by ------------------------------------------------------
516!|| contrl ../starter/source/starter/contrl.F
517!|| lectur ../starter/source/starter/lectur.F
518!||--- calls -----------------------------------------------------
519!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
520!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
521!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
522!|| nintri ../starter/source/system/nintrr.F
523!||--- uses -----------------------------------------------------
524!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
525!|| message_mod ../starter/share/message_module/message_mod.F
526!|| submodel_mod ../starter/share/modules1/submodel_mod.F
527!||====================================================================
528 SUBROUTINE HM_PREREAD_PART(IPART,IGEO,LSUBMODEL)
529C============================================================================
530C M o d u l e s
531C-----------------------------------------------
532 USE MESSAGE_MOD
533 USE SUBMODEL_MOD
534 USE HM_OPTION_READ_MOD
535 USE NAMES_AND_TITLES_MOD , ONLY : NCHARTITLE
536C-----------------------------------------------
537C I m p l i c i t T y p e s
538C-----------------------------------------------
539#include "implicit_f.inc"
540C-----------------------------------------------
541C C o m m o n B l o c k s
542C-----------------------------------------------
543#include "scr17_c.inc"
544#include "com04_c.inc"
545#include "param_c.inc"
546C-----------------------------------------------
547C D u m m y A r g u m e n t s
548C-----------------------------------------------
549 INTEGER IPART(LIPART1,*),IGEO(NPROPGI,*)
550C-----------------------------------------------
551C L o c a l V a r i a b l e s
552C-----------------------------------------------
553 INTEGER PID,ID,I,IPID,UID,SUB_INDEX
554 CHARACTER MESS*40
555 INTEGER IFIX_TMP
556 CHARACTER(LEN=NCHARTITLE)::TITR
557 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
558 LOGICAL IS_AVAILABLE
559C-----------------------------------------------
560C E x t e r n a l F u n c t i o n s
561C-----------------------------------------------
562 INTEGER NINTRI
563 DATA MESS/' part pre-reading '/
564C-----------------------------------------------
565C S o u r c e L i n e s
566C-----------------------------------------------
567 IS_AVAILABLE = .FALSE.
568 CALL HM_OPTION_START('part')
569C--------------------------------------------------
570 DO I=1,NPART
571 TITR = ''
572 CALL HM_OPTION_READ_KEY(LSUBMODEL,
573 . OPTION_ID = ID,
574 . UNIT_ID = UID,
575 . SUBMODEL_INDEX = SUB_INDEX,
576 . OPTION_TITR = TITR)
577 CALL HM_GET_INTV('propertyid',PID,IS_AVAILABLE,LSUBMODEL)
578 IPID = NINTRI(PID,IGEO,NPROPGI,NUMGEO,1)
579 IPART(2,I)=IPID
580 IPART(4,I)=ID
581 IPART(9,I)=SUB_INDEX
582 ENDDO
583
584 RETURN
585
586 END
ale_euler_init
subroutine ale_euler_init(mlaw_tag, ipm, pm, igeo, titr, titr1, titr2, igtyp, id, ilaw, mid, imid, pid, ipid, jale_from_prop, jale_from_mat, itherm, itherm_fe)
Definition ale_euler_init.F:38
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_part
subroutine hm_read_part(ipart, pm, geo, ipm, igeo, iwa, thk_part, unitab, lsubmodel, multi_fvm, mlaw_tag, mat_param, glob_therm)
Definition hm_read_part.F:48
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
elbuftag_mod
Definition elbuftag_mod.F:227
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
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232
submodel_mod::submodel_data
Definition submodel_mod.F:723