36
37
38
40
41
42
43#include "implicit_f.inc"
44
45
46
47 INTEGER ,INTENT(IN) :: NUMTABL
48 TYPE(TABLE_4D_) ,INTENT(INOUT) :: TABLE(NUMTABL)
49
50
51
52 INTEGER I,J,K,L,M,N,LEN,NPT,NDIM,STAT
53 INTEGER LDIM(4)
54 my_real,
DIMENSION(:) ,
ALLOCATABLE :: ytmp
55
56 DO n=1,numtabl
57 len = 1
59 len = 1
61 table(n)%NDIM = ndim
62 ALLOCATE(table(n)%X(ndim),stat=stat)
63
64 DO k=1,ndim
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)
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)
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)
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))
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
119
120 RETURN
void read_i_c(int *w, int *len)