hm__read__impflux_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/.

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

!||    hm_read_impflux        ../starter/source/constraints/thermic/hm_read_impflux.F

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

!||    lectur                 ../starter/source/starter/lectur.F

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

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

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

!||    hm_get_floatv_dim      ../starter/source/devtools/hm_reader/hm_get_floatv_dim.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

!||--- 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 hm_read_impflux(IB      ,FAC    ,ITAB   ,IXS    ,IGRSURF  ,

     .                      UNITAB ,IGRNOD ,IGRBRIC, LSUBMODEL,

     .                      NIMPFLUX,NITFLUX,LFACTHER)

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

C   M o d u l e s

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

      USE unitab_mod

      USE message_mod

      USE groupdef_mod

      USE submodel_mod

      USE hm_option_read_mod

      USE names_and_titles_mod , ONLY : nchartitle

      use element_mod , only : nixs

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      "units_c.inc"

#include      "com04_c.inc"

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

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

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

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

      INTEGER ,INTENT(IN)    :: NIMPFLUX

      INTEGER ,INTENT(IN)    :: NITFLUX

      INTEGER ,INTENT(IN)    :: LFACTHER

      INTEGER IB(NITFLUX,*), ITAB(*), IXS(NIXS,*)

C

      my_real fac(lfacther,*)


      TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)

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

      TYPE (GROUP_)  , DIMENSION(NGRNOD)  :: IGRNOD

      TYPE (GROUP_)  , DIMENSION(NGRBRIC) :: IGRBRIC

      TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF

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

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

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

      INTEGER I, J, K, I1, I2, IFU, ISENS, NN, ISU, IS,

     .        ID, UID, IFLAGUNIT, ITY

      INTEGER IEL, IGBR, K1, K2

C

      my_real fcx, fcy, fcx_dim, fcy_dim

      my_real tstart, tstop, tstop_dim

      CHARACTER MESS*40

      CHARACTER(LEN=NCHARTITLE)::TITR

      LOGICAL IS_AVAILABLE

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

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

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

      DATA mess/'THERMAL  FLUX  DEFINITION               '/

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

      is_available = .false.

      k =0

      k1=0

      k2=0

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

C START BROWSING MODEL THERMAL FLUX

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

      CALL hm_option_start('/IMPFLUX')

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

C BROWSING /RADIATION OPTIONS 1->NIMPFLUX

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

      DO i=1,nimpflux

        titr = ''

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

C EXTRACT DATAS OF /IMPFLUX/... LINE

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

        CALL hm_option_read_key(lsubmodel,

     .                       unit_id = uid,

     .                       option_id = id,

     .                       option_titr = titr)

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

C EXTRACT DATAS (INTEGER VALUES)

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

        CALL hm_get_intv('entityid',isu,is_available,lsubmodel)

        CALL hm_get_intv('curveid',ifu,is_available,lsubmodel)

        CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)

        CALL hm_get_intv('grbrick_id',igbr,is_available,lsubmodel)

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

C EXTRACT DATAS (REAL VALUES)

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

        CALL hm_get_floatv('xscale',fcx,is_available,lsubmodel,unitab)

        CALL hm_get_floatv_dim('xscale',fcx_dim,is_available,lsubmodel,unitab)

        CALL hm_get_floatv('magnitude',fcy,is_available,lsubmodel,unitab)

        CALL hm_get_floatv_dim('magnitude',fcy_dim,is_available,lsubmodel,unitab)

        CALL hm_get_floatv('rad_tstart',tstart,is_available,lsubmodel,unitab)

        CALL hm_get_floatv('rad_tstop',tstop,is_available,lsubmodel,unitab)

        CALL hm_get_floatv_dim('rad_tstop',tstop_dim,is_available,lsubmodel,unitab)

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

        iflagunit = 0

        DO j=1,unitab%NUNITS

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

            iflagunit = 1

            EXIT

          ENDIF

        ENDDO

        IF (uid /= 0.AND.iflagunit == 0) THEN

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

     .                i2=uid,i1=id,c1='HEAT FLUX',

     .                c2='HEAT FLUX',c3=titr)

        ENDIF

        IF(isu /= 0 .AND. igbr /=0) THEN

          CALL ancmsg(msgid=1229,anmode=aninfo,msgtype=msgerror,c1=titr,i1=isu,i2=igbr)

        ENDIF

C

        IF (fcx == zero) fcx = fcx_dim

        IF (fcy == zero) fcy = fcy_dim

        IF(tstop == zero) tstop= ep30 * tstop_dim

C

        IF(isu > 0) THEN

         is=0

         DO j=1,nsurf

          IF (isu == igrsurf(j)%ID) is=j

         ENDDO

         IF(is > 0)THEN

          nn =igrsurf(is)%NSEG

          DO j=1,nn

            k=k+1

            k1=k1+1

            ib(1,k)=igrsurf(is)%NODES(j,1)

            ib(2,k)=igrsurf(is)%NODES(j,2)

            ib(3,k)=igrsurf(is)%NODES(j,3)

            ity    =igrsurf(is)%ELTYP(j)

            IF(ity==7)THEN

C          true triangles (not segments built from 3 nodes).

             ib(4,k)=0

            ELSE

             ib(4,k)=igrsurf(is)%NODES(j,4)

            ENDIF

            ib(5,k)  = ifu

            ib(6,k)  = isens

            ib(7,k)  = igrsurf(is)%ELTYP(j)

            ib(8,k)  = igrsurf(is)%ELEM(j)

            IF(ity == 1) THEN

              ib(9,k)  = ixs(11,igrsurf(is)%ELEM(j))

            ELSE

              ib(9,k)  = 0

            ENDIF

            ib(10,k) = 0

C

            fac(1,k) = fcy

            fac(2,k) = one/fcx

            fac(3,k) = zero

            fac(4,k) = tstart

            fac(5,k) = tstop

            fac(6,k) = one

          ENDDO

         ELSE

          CALL ancmsg(msgid=1230,anmode=aninfo,msgtype=msgerror,c1=titr,i1=isu)

         ENDIF

C

        ELSEIF(igbr > 0) THEN

         is=0

         DO j=1,ngrbric

           IF (igbr == igrbric(j)%ID) is=j

         ENDDO

         IF(is > 0) THEN

            nn  = igrbric(is)%NENTITY

            DO j=1,nn

              k=k+1

              k2=k2+1

              iel = igrbric(is)%ENTITY(j)

              ib(1,k)  = 0

              ib(2,k)  = 0

              ib(3,k)  = 0

              ib(4,k)  = 0

              ib(5,k)  = ifu

              ib(6,k)  = isens

              ib(8,k)  = iel

              ib(9,k)  = ixs(11,iel)

              ib(10,k) = 1

C

              fac(1,k) = fcy

              fac(2,k) = one/fcx

              fac(3,k) = zero

              fac(4,k) = tstart

              fac(5,k) = tstop

              fac(6,k) = one

            ENDDO

         ELSE

          CALL ancmsg(msgid=1231,anmode=aninfo,msgtype=msgerror,c1=titr,i1=igbr)

         ENDIF

        ENDIF

      ENDDO ! I=1,NIMPFLUX

C

      IF(k1 > 0) THEN

       i =0

       i2=0

 100   WRITE (iout,2000)

       WRITE (iout,2001)

       i1=0

 150   i=i+1

       IF(ib(10,i) == 0) THEN

         i1=i1+1

         i2=i2+1

         WRITE (iout,'(5(1X,I10),2(1X,I10),1X,4G20.13)') i,

     .         itab(ib(1,i)),itab(ib(2,i)),itab(ib(3,i)),itab(ib(4,i)),

     .         ib(5,i),ib(6,i),fac(4,i),fac(5,i),one/fac(2,i),

     .         fac(1,i)

       ENDIF

       IF(i2 == k1)GO TO 200

       IF(i1 < 50) GO TO 150

       GO TO 100

 200   CONTINUE

      ENDIF

C

      IF(k2 > 0) THEN

       i =0

       i2=0

 300   WRITE (iout,3000)

       WRITE (iout,3001)

       i1=0

 350   i=i+1

       IF(ib(10,i) == 1) THEN

         i1=i1+1

         i2=i2+1

         WRITE (iout,'(2X,I10,2(2X,I10),1X,4G20.13)') ib(9,i),

     .         ib(5,i),ib(6,i),fac(4,i),fac(5,i),one/fac(2,i),

     .         fac(1,i)

       ENDIF

       IF(i2 == k2)GO TO 400

       IF(i1 < 50) GO TO 350

       GO TO 300

 400   CONTINUE

      ENDIF

C

      RETURN


C

 2000 FORMAT(//

     .'     SURFACIC HEAT FLUX DENSITY '/

     .'     -------------------------- ')

 2001 FORMAT(/

     .'    SEGMENT      NODE1      NODE2      NODE3      NODE4 ',

     .'     CURVE     SENSOR          T-START              T-STOP', 8x,

     .'     SCALE-X             SCALE-Y')

 3000 FORMAT(//

     .'     VOLUMIC HEAT FLUX DENSITY  '/

     .'     -------------------------  ')

 3001 FORMAT(/

     .'    BRICK ELEMENT  CURVE      SENSOR          T-START', 9x,

     .'     T-STOP             SCALE-X             SCALE-Y')


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:418

hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161

hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528

hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253

hm_read_impflux
subroutine hm_read_impflux(ib, fac, itab, ixs, igrsurf, unitab, igrnod, igrbric, lsubmodel, nimpflux, nitflux, lfacther)
Definition hm_read_impflux.F:42

hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414

groupdef_mod
Definition groupdef_mod.F:668

hm_option_read_mod
Definition hm_option_read_mod.F:412

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

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

submodel_mod::submodel_data
Definition submodel_mod.F:728