table_rresti_mat.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	table_rresti_mat (table, numtabl)

Function/Subroutine Documentation

table_rresti_mat()

subroutine table_rresti_mat	(	type(table_4d_), dimension(numtabl), intent(inout)	table,
		integer, intent(in)	numtabl )

Definition at line 31 of file table_rresti_mat.F.

C-----------------------------------------------
      USE table4d_mod
      USE message_mod
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         ,INTENT(IN)    :: NUMTABL
      TYPE(TABLE_4D_) ,INTENT(INOUT) :: TABLE(NUMTABL)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER LEN, N, K, STAT, NDIM
      INTEGER NXK(4)
c===============================================
      DO n=1,numtabl
        len = 1
        CALL read_i_c(table(n)%NOTABLE,len)
        len = 1
        IF (table(n)%NOTABLE > 0) THEN
          CALL read_i_c(ndim,len)
          table(n)%NDIM = ndim
          ALLOCATE(table(n)%X(ndim),stat=stat)
          DO k=1,ndim
            CALL read_i_c(nxk(k),len)
            ALLOCATE(table(n)%X(k)%VALUES(nxk(k)),stat=stat)
          END DO
          IF (ndim == 1) THEN
            ALLOCATE(table(n)%Y1D(nxk(1)),stat=stat)
          ELSE IF (ndim == 2) THEN
            ALLOCATE(table(n)%Y2D(nxk(1),nxk(2)),stat=stat)
          ELSE IF (ndim == 3) THEN
            ALLOCATE(table(n)%Y3D(nxk(1),nxk(2),nxk(3)),stat=stat)
          ELSE IF (ndim == 4) THEN
            ALLOCATE(table(n)%Y4D(nxk(1),nxk(2),nxk(3),nxk(4)),stat=stat)
          END IF          
        END IF
      END DO
c-----------
      RETURN