hm__read__table1__1_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_table1_1           ../starter/source/tools/curve/hm_read_table1_1.F

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

!||    hm_read_table1             ../starter/source/tools/curve/hm_read_table.F

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

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

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

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

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

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

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


      SUBROUTINE hm_read_table1_1(NTABLE1,NTABLE, TABLE ,NFUNCT,

     .                            NPC ,PLD,L,

     .                            NOM_OPT,UNITAB, LSUBMODEL)

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

C   M o d u l e s

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

      USE table_mod

      USE message_mod

      USE submodel_mod

      USE hm_option_read_mod

      USE unitab_mod

      USE names_and_titles_mod , ONLY : nchartitle, ncharfield

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

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

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

#include      "implicit_f.inc"

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

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

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

      INTEGER NTABLE, NTABLE1,L,NFUNCT,NPC(*)

      my_real PLD(*)

      TYPE(ttable) TABLE(*)

      INTEGER NOM_OPT(LNOPT1,*)

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

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

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

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

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

#include      "scr17_c.inc"

#include      "units_c.inc"

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

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

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

      INTEGER ITYPE, IBID, NFUNCT0

      INTEGER I, J, K, II, N, NDIM, NX(4), NY,

     .        jrec, npts, stat, ll,npt,ipt

      INTEGER IERROR, NF, IDFUNC, NP

      my_real BID, F5(5), TIME, FUNCT

      CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1

      CHARACTER MESS*40

      CHARACTER(LEN=NCHARFIELD) :: KEY

      DATA mess/' FUNCTION & TABLE DEFINITION            '/

      LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE

C======================================================================|

      is_encrypted = .false.

      is_available = .false.


      CALL hm_option_start('/TABLE/1')

      DO i=1,ntable1


       CALL hm_option_read_key(lsubmodel,

     .                         option_titr = titr,

     .                         option_id = ll)

      CALL hm_option_is_encrypted(is_encrypted)

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

       nx(1) = 0

       nx(2) = 0

       nx(3) = 0

       nx(4) = 0


       CALL hm_get_intv('ORDER', ndim, is_available, lsubmodel)

       IF(ndim/=1.AND.ndim/=2.AND.ndim/=3.AND.ndim/=4)THEN

         CALL ancmsg(msgid=777,

     .               msgtype=msgerror,

     .               anmode=aninfo_blind_1,

     .               i1=ll,

     .               c1=titr)

       END IF

       CALL hm_get_intv('curverows', npt, is_available, lsubmodel) !size of X


       IF(ndim==1)THEN

          l=l+1

          npts=npt

          npc(nfunct+l+1)=ll

          npc(l+1)=npc(l)


          npts=0

c read abscissa values

          DO ipt = 1, npt

             CALL hm_get_float_array_index('table2darray',time,2*ipt-1,is_available,lsubmodel,unitab)

c read ordinate values

             CALL hm_get_float_array_index('table2darray',funct,2*ipt,is_available,lsubmodel, unitab)

             npts=npts+1

             pld(npc(l+1))=time

             IF(npts > 1 .AND. pld(npc(l+1)) <= pld(npc(l+1)-2))THEN

                 CALL ancmsg(msgid=156,

     .                       msgtype=msgerror,

     .                       anmode=aninfo_blind_1,

     .                       i1=ll,

     .                       c1=titr1,

     .                       i2=npts,

     .                       i3=npts-1)

             ENDIF

             npc(l+1)=npc(l+1)+1

             pld(npc(l+1))=funct

             npc(l+1)=npc(l+1)+1

          ENDDO ! IPT


C         build table structure

          table(l)%NOTABLE=ll

          table(l)%NDIM =1

          ALLOCATE(table(l)%X(1),stat=stat)

          IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,

     .                               msgtype=msgerror,

     .                         c1='TABLE')

          ALLOCATE(table(l)%X(1)%VALUES(npts),stat=stat)

          IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,

     .                               msgtype=msgerror,

     .                         c1='TABLE')


          ALLOCATE(table(l)%Y,stat=stat)

          IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,

     .                               msgtype=msgerror,

     .                         c1='TABLE')

          ALLOCATE(table(l)%Y%VALUES(npts),stat=stat)

          IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,

     .                               msgtype=msgerror,

     .                         c1='TABLE')


          DO n=1,npts

            table(l)%X(1)%VALUES(n)=pld(npc(l)+2*n-2)

            table(l)%Y%VALUES(n)   =pld(npc(l)+2*n-1)

          END DO

C

          IF (is_encrypted)THEN

            WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'

          ELSE

            WRITE(iout,2100) table(l)%NOTABLE, table(l)%NDIM

            DO k=1,table(l)%NDIM

              nx(k)=SIZE( table(l)%X(k)%VALUES )

              WRITE(iout,2200) k

              WRITE(iout,2250) (table(l)%X(k)%VALUES(n),n=1,nx(k))

            END DO

            ny=SIZE(table(l)%Y%VALUES)

            WRITE(iout,2300)

            WRITE(iout,2350) (table(l)%Y%VALUES(n),n=1,ny)

          END IF


        endif!(NDIM==1)

       ENDDO !I=1,NTABLE0


      RETURN

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

2000  FORMAT(//

     .        '    TABLES'/

     .        '    ------'/

     .        '    NUMBER OF TABLES . . . . . . . . . . =',i10/)

2100  FORMAT(/'    TABLE ID . . . . . . . . . . . . . . =',i10/

     .        '    NUMBER OF PARAMETERS . . . . . . . . =',i10/)

2200  FORMAT(/'    VALUES FOR PARAMETER NUMBER. . . . . .',i4,':'/)

2250  FORMAT((3x,5(1x,g20.13))/)

2300  FORMAT(/'    ORDINATE VALUES . . . . . . . . . . . :'/)

2350  FORMAT((3x,5(1x,g20.13))/)


      END

hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105

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

hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284

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

hm_read_table1_1
subroutine hm_read_table1_1(ntable1, ntable, table, nfunct, npc, pld, l, nom_opt, unitab, lsubmodel)
Definition hm_read_table1_1.F:43

hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410

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::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005

submodel_mod
Definition submodel_mod.F:712

table_mod
Definition table_mod.F:112

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

submodel_mod::submodel_data
Definition submodel_mod.F:723

table_mod::ttable
Definition table_mod.F:125

unitab_mod::unit_type_
Definition unitab_mod.F:520