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 38 of file hm_read_quad.F.

40C-----------------------------------------------
41C ROUTINE DESCRIPTION :
42C ===================
43C READ /QUAD ELEMENTS USING HM_READER
44C-----------------------------------------------
45C DUMMY ARGUMENTS DESCRIPTION:
46C ===================
47C
48C NAME DESCRIPTION
49C
50C IXQ /QUAD ARRAY : CONNECTIVITY, ID, MID PID
51C ITAB USER ID OF NODES
52C ITABM1 REVERSE TAB ITAB
53C IPART PART ARRAY
54C IPARTQ INTERNAL PART ID OF A GIVEN QUAD (INTERNAL ID)
55C IPM MATERIAL ARRAY (INTEGER)
56C IGEO PROP ARRAY (INTEGER)
57C UNITAB UNIT ARRAY
58C LSUBMODEL SUBMODEL STRUCTURE
59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE unitab_mod
63 USE message_mod
64 USE submodel_mod , ONLY : nsubmod, submodel_data
65 USE names_and_titles_mod , ONLY : nchartitle
66 USE reader_old_mod , ONLY : line
67 USE user_id_mod , ONLY : id_limit
68C--------------------------------------------------------
69C LECTURE DES ELEMENTS QUAD 4 NOEUDS
70C VERSIION NUMEROTATION DES NOEUDS 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,N,MID,PID,UID,NDEGEN,JC,STAT,
109 . IFLAGUNIT,FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,ISHXFEM,IOUTN,IERROR,INDEX_PART
110 CHARACTER MESS*40, MESS2*40
111 CHARACTER(LEN=NCHARTITLE) :: TITR
112 my_real bid,fac_l
113 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_QUAD,UID_QUAD
114C-----------------------------------------------
115C E x t e r n a l F u n c t i o n s
116C-----------------------------------------------
117 INTEGER NINTRN
118 INTEGER USR2SYS
119 DATA mess/'2d quad elements definition '/
120 DATA MESS2/'2d quad elements selection for th plot '/
121C=======================================================================
122C--------------------------------------------------
123C ALLOCS & INITS
124c use NUMELQ IN PLACE OF NUMELC ( NBADMESH routine is modifying NUMELC )
125C--------------------------------------------------
126 ALLOCATE (SUB_QUAD(NUMELQ),STAT=stat)
127 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR,C1='sub_quad')
128 ALLOCATE (UID_QUAD(NUMELQ),STAT=stat)
129 IF (STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR,C1='uid_quad')
130 SUB_QUAD(1:NUMELQ) = 0
131 UID_QUAD(1:NUMELQ) = 0
132 NDEGEN = 0
133 INDEX_PART = 1
134 UID = -1
135C--------------------------------------------------
136C READING QUADS INPUTS IN HM STRUCTURE
137C--------------------------------------------------
138 CALL CPP_QUAD_READ(IXQ,NIXQ,IPARTQ,SUB_QUAD,UID_QUAD)
139C--------------------------------------------------
140C FILL OTHER STRUCTURES + CHECKS
141C--------------------------------------------------
142 DO I=1,NUMELQ
143C--------------------------------------------------
144C SUBMODEL OFFSET
145C--------------------------------------------------
146 IF(SUB_QUAD(I) /= 0)THEN
147.AND. IF(UID_QUAD(I) == 0 LSUBMODEL(SUB_QUAD(I))%UID /= 0) UID_QUAD(I) = LSUBMODEL(SUB_QUAD(I))%UID
148 ENDIF
149C--------------------------------------------------
150C UNITS
151C--------------------------------------------------
152 IF(UID_QUAD(I) /= UID )THEN
153 UID = UID_QUAD(I)
154 IFLAGUNIT = 0
155 DO J=1,UNITAB%NUNITS
156 IF (UNITAB%UNIT_ID(J) == UID) THEN
157 FAC_L = UNITAB%FAC_L(J)
158 IFLAGUNIT = 1
159 ENDIF
160 ENDDO
161.AND. IF (UID/=0IFLAGUNIT==0) THEN
162 CALL ANCMSG(MSGID=643,ANMODE=ANINFO,MSGTYPE=MSGERROR,I1=UID,C1='/quad')
163 ENDIF
164 ENDIF
165C--------------------------------------------------
166C INTERNAL PART ID
167C--------------------------------------------------
168 IF( ipart(4,index_part) /= ipartq(i) )THEN
169 DO j=1,npart
170 IF(ipart(4,j)== ipartq(i) ) index_part = j
171 ENDDO
172 ENDIF
173 IF(ipart(4,index_part) /= ipartq(i)) THEN
174 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="QUAD",i1=ipartq(i),i2=ipartq(i),prmod=msg_cumu)
175 ENDIF
176 ipartq(i) = index_part
177C--------------------------------------------------
178 mt=ipart(1,index_part)
179 ipid=ipart(2,index_part)
180 ixq(1,i)=mt
181 ixq(6,i)=ipid
182 IF (ixq(nixq,i)>id_limit%GLOBAL)THEN
183 CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixq(nixq,i),c1=line,c2='/QUAD')
184 ELSEIF (nadmesh/=0.AND.ixq(nixq,i)>id_limit%ADMESH)THEN
185 CALL ancmsg(msgid=1069,anmode=aninfo,msgtype=msgerror,i1=ixq(nixq,i),c1=line,c2='/QUAD')
186 ENDIF
187 IF(( ixq(4,i) == ixq(5,i)) .OR. ( ixq(5,i) == 0 )) THEN
188 ndegen = ndegen + 1
189 CALL ancmsg(msgid=430,msgtype=msgwarning,i1=ixq(nixq,i),anmode=aninfo_blind_2,prmod=msg_cumu)
190 ENDIF
191
192 DO j=2,5
193 ixq(j,i)=usr2sys(ixq(j,i),itabm1,mess,id)
194 CALL anodset(ixq(j,i), check_shell)
195 ENDDO
196
197 ENDDO
198
199 IF(ALLOCATED(sub_quad)) DEALLOCATE(sub_quad)
200 IF(ALLOCATED(uid_quad)) DEALLOCATE(uid_quad)
201
202 i1=1
203 i2=min0(50,numelq)
204
205 IF(ipri>=5)THEN
206 90 WRITE (iout,'(//A/A//A,A/)')titre(110),titre(111),titre(102),titre(105)
207 DO i=i1,i2
208 mid = ipm(1,ixq(1,i))
209 pid = igeo(1,ixq(6,i))
210 WRITE (iout,fmt='(8(I10,1X),1PG20.13,1X,1PG20.13)') ixq(nixq,i),i,mid,pid,(itab(ixq(j,i)),j=2,5)
211 ENDDO
212 IF(i2==numelq)GOTO 200
213 i1=i1+50
214 i2=min0(i2+50,numelq)
215 GOTO 90
216 ENDIF
217C
218 200 CONTINUE
219C-----------
220 CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
221C-------------------------------------
222C Search Duplicated Ids
223C-------------------------------------
224 ids = 79
225 i = 0
226 j = 0
227 CALL vdouble(ixq(nixq,1),nixq,numelq,mess,0,bid)
228 ids = 17
229
230 RETURN
231
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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:884
submodel_mod::submodel_data
Definition submodel_mod.F:723