hm_read_table.F File Reference

#include "implicit_f.inc"
#include "scr17_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_table1 (ntable, table, nfunct, npc, pld, nom_opt, unitab, lsubmodel)
subroutine	hm_read_table2 (ntable, table, nfunct, unitab, lsubmodel)

Function/Subroutine Documentation

hm_read_table1()

subroutine hm_read_table1	(	integer	ntable,
		type(ttable), dimension(*)	table,
		integer	nfunct,
		integer, dimension(*)	npc,
			pld,
		integer, dimension(lnopt1,*)	nom_opt,
		type(unit_type_), intent(in)	unitab,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel )

Definition at line 38 of file hm_read_table.F.

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 ITYPE, IBID, NFUNCT0, NTABLE0,NTABLE1, NFUNCT_PYTHON
      INTEGER I, J, K, II, N, L, NDIM, NX(4), NY,
     .        JREC, NPTS, STAT, LL
      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======================================================================|
      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/)
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))/)

hm_read_table2()

subroutine hm_read_table2	(	integer	ntable,
		type(ttable), dimension(*)	table,
		integer	nfunct,
		type(unit_type_), intent(in)	unitab,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel )

Definition at line 140 of file hm_read_table.F.

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,ITYPE, IBID, IDTAB(NTABLE)
      INTEGER I, J, K, II, N, L, ID, NDIM, NX(4), NY,
     .        JREC, NPTS, STAT, IDS, LL, LX(2), NOK(4)
      INTEGER,DIMENSION(:),ALLOCATABLE :: JPERM1,JPERM2
      INTEGER,DIMENSION(:,:),ALLOCATABLE :: ITAG
      INTEGER IERROR, NF, IDFUNC, NP, KK, IDEB, IFIN, IOK, NN, N1, N2, N11, N12, N13, KK1
      my_real bid, f5(5), xx, x1, x2, x234(3), yy, y1, y2, r, xmin, xmax, time, funct,scaley
      my_real,DIMENSION(2) :: xd2
      my_real,DIMENSION(:),ALLOCATABLE :: xv1, xstor1, xstor2
      my_real,DIMENSION(:,:),ALLOCATABLE :: xv2
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER :: MESS*40
      CHARACTER(LEN=NCHARFIELD) :: KEY
      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 Recherche des ID doubles (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
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))/)