OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_quad.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "scr03_c.inc"
#include "param_c.inc"
#include "titr_c.inc"
#include "remesh_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_quad (ixq, itab, itabm1, ipart, ipartq, ipm, igeo, unitab, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_quad()

subroutine hm_read_quad ( integer, dimension(nixq,*), intent(out) ixq,
integer, dimension(*), intent(in) itab,
integer, dimension(*), intent(in) itabm1,
integer, dimension(lipart1,*), intent(in) ipart,
integer, dimension(*), intent(out) ipartq,
integer, dimension(npropmi,*), intent(in) ipm,
integer, dimension(npropgi,*), intent(in) igeo,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 37 of file hm_read_quad.F.

39C-----------------------------------------------
40C ROUTINE DESCRIPTION :
41C ===================
42C READ /QUAD ELEMENTS USING HM_READER
43C-----------------------------------------------
44C DUMMY ARGUMENTS DESCRIPTION:
45C ===================
46C
47C NAME DESCRIPTION
48C
49C IXQ /QUAD ARRAY : CONNECTIVITY, ID, MID PID
50C ITAB USER ID OF NODES
51C ITABM1 REVERSE TAB ITAB
52C IPART PART ARRAY
53C IPARTQ INTERNAL PART ID OF A GIVEN QUAD (INTERNAL ID)
54C IPM MATERIAL ARRAY (INTEGER)
55C IGEO PROP ARRAY (INTEGER)
56C UNITAB UNIT ARRAY
57C LSUBMODEL SUBMODEL STRUCTURE
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE unitab_mod
62 USE message_mod
63 USE submodel_mod , ONLY : nsubmod, submodel_data
64 USE names_and_titles_mod , ONLY : nchartitle
65 USE reader_old_mod , ONLY : line
66 USE user_id_mod , ONLY : id_limit
67 use element_mod , only : nixq
68C--------------------------------------------------------
69C READING DES ELEMENTS QUAD 4 NODES
70C VERSIION NUMEROTATION DES NODES LIBRE/MARS 90/DIM
71C--------------------------------------------------------
72C
73C-----------------------------------------------
74C I m p l i c i t T y p e s
75C-----------------------------------------------
76#include "implicit_f.inc"
77C-----------------------------------------------
78C A n a l y s e M o d u l e
79C-----------------------------------------------
80#include "analyse_name.inc"
81C-----------------------------------------------
82C C o m m o n B l o c k s
83C-----------------------------------------------
84#include "scr17_c.inc"
85#include "com04_c.inc"
86#include "units_c.inc"
87#include "scr03_c.inc"
88#include "param_c.inc"
89#include "titr_c.inc"
90#include "remesh_c.inc"
91C-----------------------------------------------
92C D u m m y A r g u m e n t s
93C-----------------------------------------------
94C INPUT ARGUMENTS
95 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
96 INTEGER,INTENT(IN)::ITAB(*)
97 INTEGER,INTENT(IN)::ITABM1(*)
98 INTEGER,INTENT(IN)::IPART(LIPART1,*)
99 INTEGER,INTENT(IN)::IGEO(NPROPGI,*)
100 INTEGER,INTENT(IN)::IPM(NPROPMI,*)
101 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(NSUBMOD)
102C OUTPUT ARGUMENTS
103 INTEGER,INTENT(OUT)::IXQ(NIXQ,*)
104 INTEGER,INTENT(OUT)::IPARTQ(*)
105C-----------------------------------------------
106C L o c a l V a r i a b l e s
107C-----------------------------------------------
108 INTEGER I, J, I1, I2, ID,IDS,IPID,MT,MID,PID,UID,NDEGEN,STAT,
109 . IFLAGUNIT,INDEX_PART
110 CHARACTER MESS*40, MESS2*40
111 my_real bid,fac_l
112 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_QUAD,UID_QUAD
113C-----------------------------------------------
114C E x t e r n a l F u n c t i o n s
115C-----------------------------------------------
116 INTEGER USR2SYS
117 DATA mess/'2D QUAD ELEMENTS DEFINITION '/
118 DATA mess2/'2D QUAD ELEMENTS SELECTION FOR TH PLOT '/
119C=======================================================================
120C--------------------------------------------------
121C ALLOCS & INITS
122c use NUMELQ IN PLACE OF NUMELC ( NBADMESH routine is modifying NUMELC )
123C--------------------------------------------------
124 ALLOCATE (sub_quad(numelq),stat=stat)
125 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_QUAD')
126 ALLOCATE (uid_quad(numelq),stat=stat)
127 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='UID_QUAD')
128 sub_quad(1:numelq) = 0
129 uid_quad(1:numelq) = 0
130 ndegen = 0
131 index_part = 1
132 uid = -1
133C--------------------------------------------------
134C READING QUADS INPUTS IN HM STRUCTURE
135C--------------------------------------------------
136 CALL cpp_quad_read(ixq,nixq,ipartq,sub_quad,uid_quad)
137C--------------------------------------------------
138C FILL OTHER STRUCTURES + CHECKS
139C--------------------------------------------------
140 DO i=1,numelq
141C--------------------------------------------------
142C SUBMODEL OFFSET
143C--------------------------------------------------
144 IF(sub_quad(i) /= 0)THEN
145 IF(uid_quad(i) == 0 .AND. lsubmodel(sub_quad(i))%UID /= 0) uid_quad(i) = lsubmodel(sub_quad(i))%UID
146 ENDIF
147C--------------------------------------------------
148C UNITS
149C--------------------------------------------------
150 IF(uid_quad(i) /= uid )THEN
151 uid = uid_quad(i)
152 iflagunit = 0
153 DO j=1,unitab%NUNITS
154 IF (unitab%UNIT_ID(j) == uid) THEN
155 fac_l = unitab%FAC_L(j)
156 iflagunit = 1
157 ENDIF
158 ENDDO
159 IF (uid/=0.AND.iflagunit==0) THEN
160 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1='/QUAD')
161 ENDIF
162 ENDIF
163C--------------------------------------------------
164C INTERNAL PART ID
165C--------------------------------------------------
166 IF( ipart(4,index_part) /= ipartq(i) )THEN
167 DO j=1,npart
168 IF(ipart(4,j)== ipartq(i) ) index_part = j
169 ENDDO
170 ENDIF
171 IF(ipart(4,index_part) /= ipartq(i)) THEN
172 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="QUAD",i1=ipartq(i),i2=ipartq(i),prmod=msg_cumu)
173 ENDIF
174 ipartq(i) = index_part
175C--------------------------------------------------
176 mt=ipart(1,index_part)
177 ipid=ipart(2,index_part)
178 ixq(1,i)=mt
179 ixq(6,i)=ipid
180 IF (ixq(nixq,i)>id_limit%GLOBAL)THEN
181 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixq(nixq,i),c1=line,c2='/QUAD')
182 ELSEIF (nadmesh/=0.AND.ixq(nixq,i)>id_limit%ADMESH)THEN
183 CALL ancmsg(msgid=1069,anmode=aninfo,msgtype=msgerror,i1=ixq(nixq,i),c1=line,c2='/QUAD')
184 ENDIF
185 IF(( ixq(4,i) == ixq(5,i)) .OR. ( ixq(5,i) == 0 )) THEN
186 ndegen = ndegen + 1
187 CALL ancmsg(msgid=430,msgtype=msgwarning,i1=ixq(nixq,i),anmode=aninfo_blind_2,prmod=msg_cumu)
188 ENDIF
189
190 DO j=2,5
191 ixq(j,i)=usr2sys(ixq(j,i),itabm1,mess,id)
192 CALL anodset(ixq(j,i), check_shell)
193 ENDDO
194
195 ENDDO
196
197 IF(ALLOCATED(sub_quad)) DEALLOCATE(sub_quad)
198 IF(ALLOCATED(uid_quad)) DEALLOCATE(uid_quad)
199
200 i1=1
201 i2=min0(50,numelq)
202
203 IF(ipri>=5)THEN
204 90 WRITE (iout,'(//A/A//A,A/)')titre(110),titre(111),titre(102),titre(105)
205 DO i=i1,i2
206 mid = ipm(1,ixq(1,i))
207 pid = igeo(1,ixq(6,i))
208 WRITE (iout,fmt='(8(I10,1X),1PG20.13,1X,1PG20.13)') ixq(nixq,i),i,mid,pid,(itab(ixq(j,i)),j=2,5)
209 ENDDO
210 IF(i2==numelq)GOTO 200
211 i1=i1+50
212 i2=min0(i2+50,numelq)
213 GOTO 90
214 ENDIF
215C
216 200 CONTINUE
217C-----------
218 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
219C-------------------------------------
220C Search Duplicated Ids
221C-------------------------------------
222 ids = 79
223 i = 0
224 j = 0
225 CALL vdouble(ixq(nixq,1),nixq,numelq,mess,0,bid)
226 ids = 17
227
228 RETURN
229
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
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:895
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:868
submodel_mod::submodel_data
Definition submodel_mod.F:728