OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_quad.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_quad ../starter/source/elements/reader/hm_read_quad.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.f
29!|| anodset ../starter/source/output/analyse/analyse_node.c
30!|| usr2sys ../starter/source/system/sysfus.F
31!|| vdouble ../starter/source/system/sysfus.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_quad(IXQ ,ITAB ,ITABM1,IPART,IPARTQ,
38 . IPM ,IGEO ,UNITAB ,LSUBMODEL)
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
230 END
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
hm_read_quad
subroutine hm_read_quad(ixq, itab, itabm1, ipart, ipartq, ipm, igeo, unitab, lsubmodel)
Definition hm_read_quad.F:39
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
vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:868
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:728