hm_read_table.F

Go to the documentation of this file.

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         ../starter/source/tools/curve/hm_read_table.F
!||--- called by ------------------------------------------------------
!||    lectur                 ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    hm_option_count        ../starter/source/devtools/hm_reader/hm_option_count.F
!||    hm_read_table1_0       ../starter/source/tools/curve/hm_read_table1_0.F
!||    hm_read_table1_1       ../starter/source/tools/curve/hm_read_table1_1.F
!||--- uses       -----------------------------------------------------
!||    hm_option_read_mod     ../starter/share/modules1/hm_option_read_mod.F
!||    message_mod            ../starter/share/message_module/message_mod.F
!||    reader_old_mod         ../starter/share/modules1/reader_old_mod.F90
!||    submodel_mod           ../starter/share/modules1/submodel_mod.F
!||    table_mod              ../starter/share/modules1/table_mod.F
!||====================================================================
      SUBROUTINE hm_read_table1(NTABLE, TABLE ,NFUNCT ,NPC ,PLD,NOM_OPT, UNITAB, LSUBMODEL)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE table_mod
      USE message_mod
      USE submodel_mod , ONLY : nsubmod, submodel_data
      USE hm_option_read_mod
      USE unitab_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharfield
      USE reader_old_mod , ONLY : kfunct, nslash
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      "scr17_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NTABLE,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   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NFUNCT0, NTABLE0,NTABLE1, NFUNCT_PYTHON
      INTEGER L
      CHARACTER :: MESS*40
      DATA mess/' FUNCTION & TABLE DEFINITION            '/
      LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE     
C======================================================================|
      IF(ntable  == 0) RETURN 
!     Initialization
      is_encrypted = .false.
      is_available = .false.
 
      CALL hm_option_count('/FUNCT', nfunct0)
      CALL hm_option_count('/FUNCT_PYTHON', nfunct_python)
      nfunct0=nslash(kfunct)+nfunct0
      ! python functions are not associated with a table
      WRITE (iout,2000) ntable-(nfunct0-nfunct_python)
 
      l      =nfunct0 ! total number /TABLE + /FUNCT
      CALL hm_option_count('/table/0', NTABLE0)
      CALL HM_OPTION_COUNT('/table/1', NTABLE1)
C----------------------------
C ORDER 1 TABLES
C----------------------------
C----------------------------
C /FUNCT/TABLE/0/id, NDIM=1
C----------------------------
      IF (NTABLE0> 0) THEN
       CALL HM_READ_TABLE1_0(NTABLE0,NTABLE, TABLE ,NFUNCT ,NPC ,PLD,L,NOM_OPT, UNITAB, LSUBMODEL)      
      ENDIF
C----------------------------
C /FUNCT/TABLE/1/id, NDIM=1
C----------------------------
      IF(NTABLE1> 0) THEN
       CALL HM_READ_TABLE1_1(NTABLE1,NTABLE, TABLE ,NFUNCT ,NPC ,PLD,L,NOM_OPT, UNITAB, LSUBMODEL)      
      ENDIF
C
      RETURN
C-----------------------------------------------------------------
2000  FORMAT(//
     .        '    tables'/
     .        '    ------'/
     .        '    number of tables . . . . . . . . . . =',I10/)
      END
!||====================================================================
!||    hm_read_table2         ../starter/source/tools/curve/hm_read_table.F
!||--- called by ------------------------------------------------------
!||    lectur                 ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    hm_option_count        ../starter/source/devtools/hm_reader/hm_option_count.F
!||    hm_read_table2_0       ../starter/source/tools/curve/hm_read_table2_0.F
!||    hm_read_table2_1       ../starter/source/tools/curve/hm_read_table2_1.F
!||    udouble                ../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
!||    table_mod              ../starter/share/modules1/table_mod.F
!||====================================================================
      SUBROUTINE HM_READ_TABLE2(NTABLE, TABLE ,NFUNCT , 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,NFUNCT
      TYPE(TTABLE) TABLE(*)
      TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
      TYPE(UNIT_TYPE_), INTENT(IN) :: UNITAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NTABLE1, NTABLE0, IDTAB(NTABLE)
      INTEGER I, J, L, IDS
      my_real BID
      CHARACTER :: MESS*40
      DATA MESS/' FUNCTION & table definition            '/
      LOGICAL :: IS_ENCRYPTED, IS_AVAILABLE
C======================================================================|
c
      IF(NTABLE == 0) RETURN
!     Initialization
      IS_ENCRYPTED = .FALSE.
      IS_AVAILABLE = .FALSE.
      L = NFUNCT
C----------------------------
C HIGHER ORDERS TABLES
C----------------------------
      CALL HM_OPTION_COUNT('/table/0', NTABLE0)
      CALL HM_OPTION_COUNT('/table/1', NTABLE1)
C----------------------------
C /FUNCT/TABLE/0/id, NDIM>1
C----------------------------
      IF (NTABLE0> 0) THEN
       CALL HM_READ_TABLE2_0(NTABLE0,TABLE,L ,NFUNCT , UNITAB, LSUBMODEL)      
      ENDIF
C----------------------------
C /FUNCT/TABLE/1/id, NDIM>1
C----------------------------
      IF (NTABLE1> 0) THEN
       CALL HM_READ_TABLE2_1(NTABLE,NTABLE1, TABLE, L , UNITAB, LSUBMODEL)      
      ENDIF
C-------------------------------------
C Search for double id (Functions & Tables)
C-------------------------------------
      DO L=1,NTABLE
       IDTAB(L)=TABLE(L)%NOTABLE
      END DO
      IDS =  79
      I = 0
      J = 0
c      CALL ANCNTS(IDS,I)
      CALL UDOUBLE(IDTAB,1,NTABLE,MESS,0,BID)
c      CALL ANCNTG(IDS,I,J)
      IDS = 56
c      CALL ANCHECK(IDS)
      RETURN
      END