OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_mat_table.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine read_mat_table (table, numtabl)

Function/Subroutine Documentation

◆ read_mat_table()

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

Definition at line 35 of file read_mat_table.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE table4d_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER ,INTENT(IN) :: NUMTABL
48 TYPE(TABLE_4D_) ,INTENT(INOUT) :: TABLE(NUMTABL)
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I,J,K,L,M,N,LEN,NPT,NDIM,STAT
53 INTEGER LDIM(4)
54 my_real, DIMENSION(:) ,ALLOCATABLE :: ytmp
55c===============================================
56 DO n=1,numtabl
57 len = 1
58 CALL read_i_c(table(n)%NOTABLE,len)
59 len = 1
60 CALL read_i_c(ndim,len)
61 table(n)%NDIM = ndim
62 ALLOCATE(table(n)%X(ndim),stat=stat)
63c
64 DO k=1,ndim
65 CALL read_i_c(npt,len)
66 ALLOCATE(table(n)%X(k)%VALUES(npt) ,stat=stat)
67 CALL read_db(table(n)%X(k)%VALUES,npt)
68 ldim(k) = npt
69 END DO
70 npt = ldim(1)
71 IF (ndim == 1) THEN
72 ALLOCATE(table(n)%Y1D(npt) ,stat=stat)
73 CALL read_db(table(n)%Y1D,npt)
74 ELSE IF (ndim == 2) THEN
75 len = ldim(1)*ldim(2)
76 ALLOCATE(ytmp(len))
77 ALLOCATE(table(n)%Y2D(ldim(1),ldim(2)) ,stat=stat)
78 CALL read_db(ytmp,len)
79 m = 0
80 DO j=1,ldim(2)
81 DO i=1,npt
82 m = m+1
83 table(n)%Y2D(i,j) = ytmp(m)
84 END DO
85 END DO
86 ELSE IF (ndim == 3) THEN
87 len = ldim(1)*ldim(2)*ldim(3)
88 ALLOCATE(ytmp(len))
89 ALLOCATE(table(n)%Y3D(ldim(1),ldim(2),ldim(3)),stat=stat)
90 CALL read_db(ytmp,len)
91 m = 0
92 DO k=1,ldim(3)
93 DO j=1,ldim(2)
94 DO i=1,npt
95 m = m+1
96 table(n)%Y3D(i,j,k) = ytmp(m)
97 END DO
98 END DO
99 END DO
100 ELSE IF (ndim == 4) THEN
101 len = ldim(1)*ldim(2)*ldim(3)*ldim(4)
102 ALLOCATE(ytmp(len))
103 ALLOCATE(table(n)%Y4D(ldim(1),ldim(2),ldim(3),ldim(4)),stat=stat)
104 CALL read_db(ytmp,len)
105 m = 0
106 DO l=1,ldim(4)
107 DO k=1,ldim(3)
108 DO j=1,ldim(2)
109 DO i=1,npt
110 m = m+1
111 table(n)%Y4D(i,j,k,l) = ytmp(m)
112 END DO
113 END DO
114 END DO
115 END DO
116 END IF
117 IF (ALLOCATED(ytmp)) DEALLOCATE(ytmp)
118 END DO
119c-----------
120 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine read_db(a, n)
Definition read_db.F:88
void read_i_c(int *w, int *len)