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.OR. IF(IGTYP == 17 IGTYP == 51) IPART_STACK = 1
214 IF(IGTYP == 52) IPART_PCOMPP = 1
215.OR. IF( (IGTYP == 0)
216.OR..OR..OR. . (IGTYP == 1)(IGTYP == 2)(IGTYP == 3)
217.OR..OR..OR. . (IGTYP == 6)(IGTYP == 9)(IGTYP == 10)
218.OR..OR..OR. . (IGTYP == 11)(IGTYP == 14)(IGTYP == 16)
219.OR..OR..OR. . (IGTYP == 18)(IGTYP == 20)(IGTYP == 21)
220.OR..OR..OR. . (IGTYP == 22)(IGTYP == 34)(IGTYP == 11)
221.OR..OR..OR. . (IGTYP == 17)(IGTYP == 51)(IGTYP == 52)
222.OR. . (IGTYP == 23)(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.and..or..or..or. IF (IXFEM > 0 (IGTYP==1 IGTYP==9 IGTYP==10
259.or. . IGTYP==11 IGTYP==51)) THEN
260 XFEMFLG = XFEMFLG + IXFEM
261 END IF
262.AND. IF (ILAW == 99IGTYP == 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.or..or..or. IF (ILAW==29 ILAW==30 ILAW==31 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.and..and..and..and..AND..AND..and. IF (((IGTYP==43) ((ILAW/=59 ILAW/=83 ILAW/=116 ILAW/=117 ILAW /=120ILAW/=169)
287.eqv..eqv..or. . (USER_LAW .false. ) ) .true.)
288.or..or..or..and..or. . ((ILAW==59 ILAW==83 ILAW==116 ILAW==117) IGTYP/=43)
289.and..OR..OR..OR..OR. . (ILAW==1 (IGTYP==9IGTYP==10IGTYP==11IGTYP==16
290.OR..OR..eqv..eqv. . IGTYP==17IGTYP==51IGTYP==52) .true.) .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.AND. IF (ILAW == 87 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.AND. IF (ILAW == 187 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.AND. IF(ILAW == 13 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.AND..AND..AND. IF(ILAW /= 108 ILAW /=113 ILAW /=114 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.AND. IF(ILAW == 70 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.OR. IF(JALE_FROM_PROP==1 JALE_FROM_MAT==1)THEN
397 WRITE(IOUT,'(a)')' framework : ale'
398.OR. ELSEIF(JALE_FROM_PROP==2 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.OR. IF( (IGTYP == 0)
406.OR..OR..OR. . (IGTYP == 1)(IGTYP == 9)(IGTYP == 10)
407.OR..OR..OR. . (IGTYP == 11)(IGTYP == 16)(IGTYP == 17)
408.OR..OR. . (IGTYP == 19)(IGTYP == 51)(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.AND..OR..OR. IF( THK_PART(I)>ZERO ((IGTYP == 3)(IGTYP == 2)
413.OR..OR..OR. . (IGTYP == 18)(IGTYP == 4)(IGTYP == 8)
414.OR..OR..OR. . (IGTYP == 12)(IGTYP == 13)(IGTYP == 23)
415.OR..OR. . (IGTYP == 25)(IGTYP == 26)(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 !Positive Ensure Identify
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
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:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
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:414
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
elbuftag_mod
Definition elbuftag_mod.F:230
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
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:235
submodel_mod::submodel_data
Definition submodel_mod.F:728