OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_box_rect.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine read_box_rect (ibox, iad, nbox, iskn, skew, itabm1, x, rtrans, unitab, lsubmodel)

Function/Subroutine Documentation

◆ read_box_rect()

subroutine read_box_rect ( type (box_), dimension(nbbox) ibox,
integer, intent(inout) iad,
integer, intent(in) nbox,
integer, dimension(liskn,siskwn/liskn), intent(in) iskn,
intent(in) skew,
integer, dimension(numnod), intent(in) itabm1,
intent(in) x,
intent(in) rtrans,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 40 of file read_box_rect.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE unitab_mod
47 USE submodel_mod
48 USE message_mod
49 USE optiondef_mod
50 USE hm_option_read_mod
51 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "param_c.inc"
60#include "com04_c.inc"
61#include "sphcom.inc"
62#include "tabsiz_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER, INTENT(IN) :: NBOX
67 INTEGER, INTENT(INOUT) :: IAD
68 INTEGER, DIMENSION(LISKN,SISKWN/LISKN), INTENT(IN) :: ISKN
69 INTEGER, DIMENSION(NUMNOD) , INTENT(IN) :: ITABM1
70 my_real, DIMENSION(3,NUMNOD), INTENT(IN) :: x
71 my_real, DIMENSION(LSKEW,SSKEW/LSKEW), INTENT(IN) :: skew
72 my_real, DIMENSION(NTRANSF,NRTRANS), INTENT(IN) :: rtrans
73 TYPE (UNIT_TYPE_), INTENT(IN) :: UNITAB
74 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
75 TYPE (BOX_), DIMENSION(NBBOX) :: IBOX
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER :: I,J,N1,N2,UID,BOXID,SUB_ID,SKEW_ID,ISK,IUNIT,FLAGUNIT,
80 . SUB_INDEX
81 my_real :: fac_l,xp1,yp1,zp1,xp2,yp2,zp2
82 CHARACTER(LEN=NCHARKEY) :: KEY
83 CHARACTER(LEN=NCHARTITLE) :: TITR,MESS
84 LOGICAL :: IS_AVAILABLE
85C-----------------------------------------------
86C E x t e r n a l F u n c t i o n s
87C-----------------------------------------------
88 INTEGER USR2SYS
89 DATA mess/'MULTI-BOX DEFINITION '/
90C-----------------------------------------------
91C IBOX(I)%ID : BOX IDENTIFIER
92C IBOX(I)%TITLE : BOX title
93C IBOX(I)%NBOXBOX : NUMBER OF SUB BOXES (BOXES OF BOXES)
94C IBOX(I)%ISKBOX : BOX SKEW_ID (RECTA)
95C IBOX(I)%NOD1 : FIRST NODE for box limit definition - N1 -
96C IBOX(I)%NOD2 : SECOND NODE for box limit definition - N2 -
97C IBOX(I)%TYPE : BOX SHAPE (1='RECTA',2='CYLIN' ,3='SPHER')
98C IBOX(I)%NBLEVELS : TEMPORARY LEVEL NB OF BOXES
99C IBOX(I)%LEVEL : FLAG "SUBLEVEL DONE" FOR BOX OF BOXES
100C IBOX(I)%ACTIBOX : FLAG FOR ACTIVATED BOX FOR (GRNOD,GRSHEL,LINE,SURF...)
101C IBOX(I)%NENTITY : NUMBER OF BOX ENTITIES (NODES,ELEMS,LINES,SURF)
102C WITHIN ACTIVATED BOX
103C IBOX(I)%SURFIAD : temporary address for solid external surface (in box)
104C IBOX(I)%BOXIAD : temporary address
105C IBOX(I)%DIAM : BOX diameter (CYLIN + SPHER)
106C IBOX(I)%X1 : coord.X for N1
107C IBOX(I)%Y1 : coord.Y for N1
108C IBOX(I)%Z1 : coord.Z for N1
109C IBOX(I)%X2 : coord.X for N2
110C IBOX(I)%Y2 : coord.Y for N2
111C IBOX(I)%Z2 : coord.Z for N2
112C=======================================================================
113c
114 CALL hm_option_start('/BOX/RECTA')
115c
116c--------------------------------------------------
117 DO i = 1,nbox
118c
119 CALL hm_option_read_key(lsubmodel, option_id = boxid,
120 . unit_id = uid,
121 . submodel_id = sub_id,
122 . submodel_index = sub_index,
123 . option_titr = titr,
124 . keyword2 = key)
125c-----------------------
126c check UNIT ID
127c-----------------------
128 IF (uid > 0) THEN
129 flagunit = 0
130 DO iunit=1,unitab%NUNITS
131 IF (unitab%UNIT_ID(iunit) == uid) THEN
132 flagunit = 1
133 EXIT
134 ENDIF
135 ENDDO
136 IF (uid > 0 .AND. flagunit == 0) THEN
137 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
138 . i2= uid ,i1=boxid,
139 . c1='BOX' ,
140 . c2='BOX' ,
141 . c3='TITR')
142 ENDIF
143 ENDIF
144c-----------------------
145c read input data
146c-----------------------
147c
148 CALL hm_get_intv ('box_corner_node1' ,n1 ,is_available, lsubmodel)
149 CALL hm_get_intv ('box_corner_node2' ,n2 ,is_available, lsubmodel)
150 CALL hm_get_intv ('box_system' ,skew_id ,is_available, lsubmodel)
151c
152 CALL hm_get_floatv('box_corner1_x' ,xp1 ,is_available, lsubmodel, unitab)
153 CALL hm_get_floatv('box_corner1_y' ,yp1 ,is_available, lsubmodel, unitab)
154 CALL hm_get_floatv('box_corner1_z' ,zp1 ,is_available, lsubmodel, unitab)
155c
156 CALL hm_get_floatv('box_corner2_x' ,xp2 ,is_available, lsubmodel, unitab)
157 CALL hm_get_floatv('box_corner2_y' ,yp2 ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('box_corner2_z' ,zp2 ,is_available, lsubmodel, unitab)
159c-----------------------
160c check SKEW ID
161c-----------------------
162 IF (skew_id == 0 .and. sub_id > 0) skew_id = lsubmodel(sub_index)%SKEW
163 isk = 0
164 IF (skew_id > 0) THEN
165 DO j=1,numskw+min(1,nspcond)*numsph+nsubmod
166 IF (iskn(4,j+1) == skew_id) THEN
167 isk = j
168 EXIT
169 END IF
170 END DO
171 IF (isk == 0) THEN
172 CALL ancmsg(msgid=748, msgtype=msgerror,
173 . anmode=aninfo_blind_1,
174 . c1='BOX' ,
175 . i1=boxid ,
176 . c2=titr ,
177 . c3=titr ,
178 . c4=' ' ,
179 . i2=skew_id)
180 END IF
181 END IF
182c-----------------------
183c
184 IF (n1 > 0 .and. n2 > 0) THEN
185 !using coordinates from user node identifiers
186 xp1 = x(1,usr2sys(n1,itabm1,mess,boxid))
187 yp1 = x(2,usr2sys(n1,itabm1,mess,boxid))
188 zp1 = x(3,usr2sys(n1,itabm1,mess,boxid))
189 xp2 = x(1,usr2sys(n2,itabm1,mess,boxid))
190 yp2 = x(2,usr2sys(n2,itabm1,mess,boxid))
191 zp2 = x(3,usr2sys(n2,itabm1,mess,boxid))
192 ELSE
193 !Submodel rotation
194 IF (sub_id > 0) CALL subrotpoint(xp1,yp1,zp1,rtrans,sub_id,lsubmodel)
195 IF (sub_id > 0) CALL subrotpoint(xp2,yp2,zp2,rtrans,sub_id,lsubmodel)
196 ENDIF
197c
198 IF ((xp1 == zero .and. yp1 == zero .and. zp1 == zero) .and.
199 . (xp2 == zero .and. yp2 == zero .and. zp2 == zero)) THEN
200 CALL ancmsg(msgid=752, msgtype=msgerror,
201 . anmode=aninfo,
202 . c1 = 'BOX',
203 . i1 = boxid,
204 . c2 = titr ,
205 . c3 = titr ,
206 . c4 = ' ' )
207 END IF
208c-----------------------
209c
210 iad = iad + 1
211 ibox(iad)%TITLE = trim(titr)
212 ibox(iad)%ID = boxid
213 ibox(iad)%ISKBOX = isk
214 ibox(iad)%NBLEVELS= 0
215 ibox(iad)%LEVEL = 1
216 ibox(iad)%TYPE = 1
217 ibox(iad)%ACTIBOX = 0
218 ibox(iad)%NBOXBOX = 0
219 ibox(iad)%NOD1 = n1
220 ibox(iad)%NOD2 = n2
221 ibox(iad)%DIAM = zero
222 ibox(iad)%X1 = xp1
223 ibox(iad)%Y1 = yp1
224 ibox(iad)%Z1 = zp1
225 ibox(iad)%X2 = xp2
226 ibox(iad)%Y2 = yp2
227 ibox(iad)%Z2 = zp2
228 ibox(iad)%SURFIAD = 0
229 ibox(iad)%NENTITY = 0
230 ibox(iad)%BOXIAD = 0
231c
232 ENDDO
233
234c-----------
235 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
optiondef_mod
Definition optiondef_mod.F:90
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
subrotpoint
subroutine subrotpoint(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:180