OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_bigbox2.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_bigbox2 ../starter/source/model/box/hm_bigbox2.F
25!||--- called by ------------------------------------------------------
26!|| hm_lecgre ../starter/source/groups/hm_lecgre.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| boxbox2 ../starter/source/model/box/boxbox.F
30!|| boxtage ../starter/source/model/box/bigbox.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE hm_bigbox2(X ,FLAG ,NEL ,
35 . SKEW ,IGS ,ISKN ,ITABM1,IBOX ,
36 . ID ,NADMESH,NIX ,IX ,NIX1 ,NUMEL ,
37 . IPARTE ,IPART ,KLEVTREE,ELTREE,KELTREE,BUFTMP,
38 . KEY ,TITR ,MES ,IGRELEM,NGRELE ,NN ,
39 . IADB ,IBOXMAX,IBUFBOX ,IDB)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE groupdef_mod
45 USE optiondef_mod
46 USE names_and_titles_mod , ONLY : nchartitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "scr17_c.inc"
56#include "param_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER JREC,FLAG,NEL,IGS,
61 . ISKN(LISKN,*),ITABM1(*),ID,NADMESH,
62 . NIX,IX(NIX,*),NIX1,NUMEL,IPARTE(*),IPART(LIPART1,*),
63 . KLEVTREE,KELTREE,ELTREE(KELTREE,*),
64 . BUFTMP(NUMEL*5),NGRELE,NN,IBOXMAX,IADB,IBUFBOX(*)
65 INTEGER,INTENT(IN) :: IDB
66 my_real X(3,*),SKEW(LSKEW,*)
67 CHARACTER KEY*4,MES*40
68 CHARACTER(LEN=NCHARTITLE) :: TITR
69C-----------------------------------------------
70 TYPE (GROUP_), DIMENSION(NGRELE) :: IGRELEM
71 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I,J,ISU,ISK,TAGN(NUMEL),BOXTYPE,
76 . negbox,tagneg(numel),tagpos(numel),
77 . nbox,boxele,icount,iter,flagg,iadisu
78 my_real xp1,yp1,zp1,xp2,yp2,zp2,diam,nodinb(3)
79 CHARACTER BOX*3
80 LOGICAL BOOL
81C-----------------------------------------------
82 DO I=1,nbbox
83 ibox(i)%NBLEVELS = 0
84 ibox(i)%LEVEL = 1
85 ibox(i)%ACTIBOX = 0
86 IF(ibox(i)%NBOXBOX > 0)THEN
87 ibox(i)%NBLEVELS = -1
88 ibox(i)%LEVEL = 0
89 END IF
90C
91 ibox(i)%BOXIAD = 0
92 END DO
93C-------
94 IF(key(1:4) == 'box2')THEN
95 BOXTYPE = 2
96 ELSE IF(KEY(1:3) == 'box')THEN
97 BOXTYPE = 1
98 END IF
99C-------
100C get box de box ID'S dans grshel:
101C-------
102 ISU = 0
103 DO I=1,NBBOX
104 IF(IDB == IBOX(I)%ID)THEN
105 ISU=I
106 EXIT
107 ENDIF
108 END DO
109C---
110 IF(ISU > 0)THEN
111 NBOX = IBOX(ISU)%NBOXBOX
112C super box activated:
113 IBOX(ISU)%ACTIBOX = 1
114 ELSE
115 IF(FLAG == 0)THEN
116 CALL ANCMSG(MSGID=798,
117 . MSGTYPE=MSGERROR,
118 . ANMODE=ANINFO,
119 . I1=ID,
120 . C1=TITR,
121 . I2=IDB)
122 END IF
123 END IF
124C---
125C simple box dans grshel:
126C---
127 BOOL =.FALSE.
128 IF(ISU>0)THEN
129.AND. IF(IBOX(ISU)%NBLEVELS == 0 IBOX(ISU)%LEVEL == 1) THEN
130 IF (NBOX == 0) THEN ! simple box (no sub box)
131 CALL BOXTAGE(X ,SKEW ,IBOX ,
132 . ISU ,BOXTYPE,IX ,NIX ,
133 . NIX1 ,IPARTE ,IPART ,KLEVTREE,ELTREE,
134 . KELTREE,NUMEL ,NADMESH,FLAG ,IBOXMAX,
135 . IADB ,IBUFBOX)
136 BOOL=.TRUE.
137 END IF
138 END IF
139 ENDIF
140C---
141C READ LEVELS OF BOXES ==> "SUBLEVEL DONE"
142C---
143.NOT. IF(BOOL)THEN
144 ICOUNT = 1
145 ITER = 0
146 DO WHILE (ICOUNT == 1)
147 ITER = ITER + 1
148 FLAGG = 0
149C--- count next level
150 CALL BOXBOX2(IBOX ,SKEW ,
151 . FLAGG ,ICOUNT,ITER ,BOXTYPE,
152 . X ,IX ,FLAG ,IBOXMAX,
153 . NIX ,NIX1 ,IPARTE ,IPART ,
154 . KLEVTREE,ELTREE,KELTREE ,NUMEL ,
155 . NADMESH ,ID ,TITR ,MES ,
156 . IADB ,IBUFBOX)
157C--- fill next level
158 FLAGG = 1
159 CALL BOXBOX2(IBOX ,SKEW ,
160 . FLAGG ,ICOUNT ,ITER ,BOXTYPE,
161 . X ,IX ,FLAG ,IBOXMAX,
162 . NIX ,NIX1 ,IPARTE ,IPART ,
163 . KLEVTREE,ELTREE ,KELTREE ,NUMEL ,
164 . NADMESH ,ID ,TITR ,MES ,
165 . IADB ,IBUFBOX)
166C---
167 ENDDO
168 ENDIF
169C---
170C tag group elements in main-box:
171C---
172 IF(ISU > 0)THEN
173 IF(FLAG == 0)THEN
174 BOXELE = IBOX(ISU)%NENTITY ! elements of main box
175 NEL = BOXELE
176 ELSE IF(FLAG == 1)THEN
177 BOXELE = IBOX(ISU)%NENTITY ! elements of main box
178 IADISU = IBOX(ISU)%BOXIAD ! addresses of elements in main box
179 NEL = BOXELE
180 DO I=1,BOXELE
181 J=IBUFBOX(IADISU+I-1)
182 NN = NN + 1
183 IGRELEM(IGS)%ENTITY(NN) = J
184 END DO
185 END IF
186 END IF
187C----------
188 RETURN
189 END
hm_bigbox2
subroutine hm_bigbox2(x, flag, nel, skew, igs, iskn, itabm1, ibox, id, nadmesh, nix, ix, nix1, numel, iparte, ipart, klevtree, eltree, keltree, buftmp, key, titr, mes, igrelem, ngrele, nn, iadb, iboxmax, ibufbox, idb)
Definition hm_bigbox2.F:40
groupdef_mod
Definition groupdef_mod.F:662
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
optiondef_mod
Definition optiondef_mod.F:90