read__box__rect_8F_source.html

Copyright>        OpenRadioss

Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.

Copyright>

Copyright>        This program is free software: you can redistribute it and/or modify

Copyright>        it under the terms of the GNU Affero General Public License as published by

Copyright>        the Free Software Foundation, either version 3 of the License, or

Copyright>        (at your option) any later version.

Copyright>

Copyright>        This program is distributed in the hope that it will be useful,

Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of

Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

Copyright>        GNU Affero General Public License for more details.

Copyright>

Copyright>        You should have received a copy of the GNU Affero General Public License

Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.

Copyright>

Copyright>

Copyright>        Commercial Alternative: Altair Radioss Software

Copyright>

Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss

Copyright>        software under a commercial license.  Contact Altair to discuss further if the

Copyright>        commercial version may interest you: https://www.altair.com/radioss/.

!||====================================================================

!||    read_box_rect          ../starter/source/model/box/read_box_rect.F

!||--- called by ------------------------------------------------------

!||    hm_read_box            ../starter/source/model/box/hm_read_box.F

!||--- calls      -----------------------------------------------------

!||    ancmsg                 ../starter/source/output/message/message.F

!||    hm_get_floatv          ../starter/source/devtools/hm_reader/hm_get_floatv.F

!||    hm_get_intv            ../starter/source/devtools/hm_reader/hm_get_intv.F

!||    hm_option_read_key     ../starter/source/devtools/hm_reader/hm_option_read_key.F

!||    hm_option_start        ../starter/source/devtools/hm_reader/hm_option_start.F

!||    subrotpoint            ../starter/source/model/submodel/subrot.F

!||    usr2sys                ../starter/source/system/sysfus.F

!||--- uses       -----------------------------------------------------

!||    hm_option_read_mod     ../starter/share/modules1/hm_option_read_mod.F

!||    message_mod            ../starter/share/message_module/message_mod.F

!||    submodel_mod           ../starter/share/modules1/submodel_mod.F

!||====================================================================


      SUBROUTINE read_box_rect(

     .           IBOX     ,IAD      ,NBOX     ,ISKN     ,SKEW     ,

     .           ITABM1   ,X        ,RTRANS   ,UNITAB   ,LSUBMODEL)

C-----------------------------------------------

C   M o d u l e s

C-----------------------------------------------

      USE unitab_mod

      USE submodel_mod

      USE message_mod

      USE optiondef_mod

      USE hm_option_read_mod

      USE names_and_titles_mod , ONLY : nchartitle, ncharkey

C-----------------------------------------------

C   I m p l i c i t   T y p e s

C-----------------------------------------------

#include      "implicit_f.inc"

C-----------------------------------------------

C   C o m m o n   B l o c k s

C-----------------------------------------------

#include      "param_c.inc"

#include      "com04_c.inc"

#include      "sphcom.inc"

#include      "tabsiz_c.inc"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER, INTENT(IN)                                 :: NBOX

      INTEGER, INTENT(INOUT)                              :: IAD

      INTEGER, DIMENSION(LISKN,SISKWN/LISKN), INTENT(IN)  :: ISKN

      INTEGER, DIMENSION(NUMNOD) , INTENT(IN)             :: ITABM1

      my_real, DIMENSION(3,NUMNOD), INTENT(IN)            :: x

      my_real, DIMENSION(LSKEW,SSKEW/LSKEW), INTENT(IN)   :: skew

      my_real, DIMENSION(NTRANSF,NRTRANS), INTENT(IN)     :: rtrans

      TYPE (UNIT_TYPE_), INTENT(IN)                       :: UNITAB

      TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL

      TYPE (BOX_), DIMENSION(NBBOX)                       :: IBOX

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER :: I,J,N1,N2,UID,BOXID,SUB_ID,SKEW_ID,ISK,IUNIT,FLAGUNIT,

     .           SUB_INDEX

      my_real :: fac_l,xp1,yp1,zp1,xp2,yp2,zp2

      CHARACTER(LEN=NCHARKEY)    :: KEY

      CHARACTER(LEN=NCHARTITLE)  :: TITR,MESS

      LOGICAL :: IS_AVAILABLE

C-----------------------------------------------

C   E x t e r n a l   F u n c t i o n s

C-----------------------------------------------

      INTEGER USR2SYS

      DATA MESS/'MULTI-BOX DEFINITION                    '/

C-----------------------------------------------

C     IBOX(I)%ID       : BOX IDENTIFIER

C     IBOX(I)%TITLE    : BOX title

C     IBOX(I)%NBOXBOX  : NUMBER OF SUB BOXES (BOXES OF BOXES)

C     IBOX(I)%ISKBOX   : BOX SKEW_ID (RECTA)

C     IBOX(I)%NOD1     : FIRST NODE for box limit definition  - N1 -

C     IBOX(I)%NOD2     : SECOND NODE for box limit definition - N2 -

C     IBOX(I)%TYPE     : BOX SHAPE (1='RECTA',2='CYLIN' ,3='SPHER')

C     IBOX(I)%NBLEVELS : TEMPORARY LEVEL NB OF BOXES

C     IBOX(I)%LEVEL    : FLAG "SUBLEVEL DONE" FOR BOX OF BOXES

C     IBOX(I)%ACTIBOX  : FLAG FOR ACTIVATED BOX FOR (GRNOD,GRSHEL,LINE,SURF...)

C     IBOX(I)%NENTITY  : NUMBER OF BOX ENTITIES (NODES,ELEMS,LINES,SURF)

C                        WITHIN ACTIVATED BOX

C     IBOX(I)%SURFIAD  : temporary address for solid external surface (in box)

C     IBOX(I)%BOXIAD   : temporary address

C     IBOX(I)%DIAM     : BOX diameter (CYLIN + SPHER)

C     IBOX(I)%X1       : coord.X for N1

C     IBOX(I)%Y1       : coord.Y for N1

C     IBOX(I)%Z1       : coord.Z for N1

C     IBOX(I)%X2       : coord.X for N2

C     IBOX(I)%Y2       : coord.Y for N2

C     IBOX(I)%Z2       : coord.Z for N2

C=======================================================================

c

      CALL hm_option_start('/BOX/RECTA')

c

c--------------------------------------------------

      DO i = 1,nbox

c

        CALL hm_option_read_key(lsubmodel, option_id   = boxid,

     .                                     unit_id     = uid,

     .                                     submodel_id = sub_id,

     .                                     submodel_index = sub_index,

     .                                     option_titr = titr,

     .                                     keyword2    = key)

c-----------------------

c       check UNIT ID

c-----------------------

        IF (uid > 0) THEN

          flagunit = 0

          DO iunit=1,unitab%NUNITS

            IF (unitab%UNIT_ID(iunit) == uid) THEN

              flagunit = 1

              EXIT

            ENDIF

          ENDDO

          IF (uid > 0 .AND. flagunit == 0) THEN

            CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,

     .                  i2= uid  ,i1=boxid,

     .                  c1='BOX' ,

     .                  c2='BOX' ,

     .                  c3='TITR')

          ENDIF

        ENDIF

c-----------------------

c       read input data

c-----------------------

c

        CALL hm_get_intv  ('box_corner_node1' ,n1      ,is_available, lsubmodel)

        CALL hm_get_intv  ('box_corner_node2' ,n2      ,is_available, lsubmodel)

        CALL hm_get_intv  ('box_system'       ,skew_id ,is_available, lsubmodel)

c

        CALL hm_get_floatv('box_corner1_x'    ,xp1     ,is_available, lsubmodel, unitab)

        CALL hm_get_floatv('box_corner1_y'    ,yp1     ,is_available, lsubmodel, unitab)

        CALL hm_get_floatv('box_corner1_z'    ,zp1     ,is_available, lsubmodel, unitab)

c

        CALL hm_get_floatv('box_corner2_x'    ,xp2     ,is_available, lsubmodel, unitab)

        CALL hm_get_floatv('box_corner2_y'    ,yp2     ,is_available, lsubmodel, unitab)

        CALL hm_get_floatv('box_corner2_z'    ,zp2     ,is_available, lsubmodel, unitab)

c-----------------------

c       check SKEW ID

c-----------------------

        IF (skew_id == 0 .and. sub_id > 0) skew_id = lsubmodel(sub_index)%SKEW

        isk = 0

        IF (skew_id > 0) THEN

          DO j=1,numskw+min(1,nspcond)*numsph+nsubmod

            IF (iskn(4,j+1) == skew_id) THEN

              isk = j

              EXIT

            END IF

          END DO

          IF (isk == 0) THEN

            CALL ancmsg(msgid=748,  msgtype=msgerror,

     .                              anmode=aninfo_blind_1,

     .                              c1='BOX' ,

     .                              i1=boxid ,

     .                              c2=titr  ,

     .                              c3=titr  ,

     .                              c4=' '   ,

     .                              i2=skew_id)

          END IF

        END IF

c-----------------------

c

        IF (n1 > 0 .and. n2 > 0) THEN

          !using coordinates from user node identifiers

          xp1 = x(1,usr2sys(n1,itabm1,mess,boxid))

          yp1 = x(2,usr2sys(n1,itabm1,mess,boxid))

          zp1 = x(3,usr2sys(n1,itabm1,mess,boxid))

          xp2 = x(1,usr2sys(n2,itabm1,mess,boxid))

          yp2 = x(2,usr2sys(n2,itabm1,mess,boxid))

          zp2 = x(3,usr2sys(n2,itabm1,mess,boxid))

        ELSE

          !Submodel rotation

          IF (sub_id > 0) CALL subrotpoint(xp1,yp1,zp1,rtrans,sub_id,lsubmodel)

          IF (sub_id > 0) CALL subrotpoint(xp2,yp2,zp2,rtrans,sub_id,lsubmodel)

        ENDIF

c

        IF ((xp1 == zero .and. yp1 == zero .and. zp1 == zero) .and.

     .      (xp2 == zero .and. yp2 == zero .and. zp2 == zero)) THEN

          CALL ancmsg(msgid=752,  msgtype=msgerror,

     .                            anmode=aninfo,

     .                            c1 = 'BOX',

     .                            i1 = boxid,

     .                            c2 = titr ,

     .                            c3 = titr ,

     .                            c4 = ' '  )

        END IF

c-----------------------

c

        iad = iad + 1

        ibox(iad)%TITLE   = trim(titr)

        ibox(iad)%ID      = boxid

        ibox(iad)%ISKBOX  = isk

        ibox(iad)%NBLEVELS= 0

        ibox(iad)%LEVEL   = 1

        ibox(iad)%TYPE    = 1

        ibox(iad)%ACTIBOX = 0

        ibox(iad)%NBOXBOX = 0

        ibox(iad)%NOD1    = n1

        ibox(iad)%NOD2    = n2

        ibox(iad)%DIAM    = zero

        ibox(iad)%X1      = xp1

        ibox(iad)%Y1      = yp1

        ibox(iad)%Z1      = zp1

        ibox(iad)%X2      = xp2

        ibox(iad)%Y2      = yp2

        ibox(iad)%Z2      = zp2

        ibox(iad)%SURFIAD = 0

        ibox(iad)%NENTITY = 0

        ibox(iad)%BOXIAD  = 0

c

      ENDDO


c-----------

      RETURN


      END

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

read_box_rect
subroutine read_box_rect(ibox, iad, nbox, iskn, skew, itabm1, x, rtrans, unitab, lsubmodel)
Definition read_box_rect.F:43

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

submodel_mod::submodel_data
Definition submodel_mod.F:723

subrotpoint
subroutine subrotpoint(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:180