1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
! Copyright (C) 2006 Imperial College London and others.
!
! Please see the AUTHORS file in the main source directory for a full list
! of copyright holders.
!
! Prof. C Pain
! Applied Modelling and Computation Group
! Department of Earth Science and Engineering
! Imperial College London
!
! amcgsoftware@imperial.ac.uk
!
! This library is free software; you can redistribute it and/or
! modify it under the terms of the GNU Lesser General Public
! License as published by the Free Software Foundation,
! version 2.1 of the License.
!
! This library is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
! Lesser General Public License for more details.
!
! You should have received a copy of the GNU Lesser General Public
! License along with this library; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
! USA
#define "confdefs.h"
SUBROUTINE VTKOUT2D(outName, vtkTitle, indexName, NNodes, NElems, X, Y, &
FIELDS, FSTRIDE, NFIELDS, &
NDGLNO, sizeNDGLNO, elementTypes, elementSizes, NODDOM)
IMPLICIT NONE
CHARACTER*(*), INTENT(IN)::outName, vtkTitle, indexName
INTEGER, INTENT(IN)::NNodes, NElems, FSTRIDE, NFIELDS, sizeNDGLNO, &
NDGLNO(sizeNDGLNO), NODDOM(NElems), elementTypes(NElems), elementSizes(NElems)
REAL, INTENT(IN):: X(NNodes), Y(NNodes), FIELDS(NNodes*NFIELDS)
REAL, ALLOCATABLE, DIMENSION(:)::Z
INTEGER I, J, IERR, position, cell(100)
LOGICAL haveIndex, moreFields
CHARACTER(LEN=2048) type, dataName
INTEGER type_len, dataName_len
REAL*4 dataArray(9), dataArray2(9)
INTEGER ids(100), ids_cnt
ids_cnt = 100;
ALLOCATE( Z(NNodes) )
Z = 0.0
#ifdef DEBUG
ewrite(1,*) 'Just inside VTKOUT()'
ewrite(3,*) 'outName = ', outName
ewrite(3,*) 'vtkTitle = ', vtkTitle
#endif
! Open and initalize the file
CALL vtkopen(outName, LEN_TRIM(outName), vtkTitle, LEN_TRIM(vtkTitle))
#ifdef DEBUG
ewrite(3,*) 'Writting out mesh geometry.'
#endif
CALL vtkwritemesh(NNodes, NElems, X, Y, Z, NDGLNO, elementTypes, elementSizes)
! Output all the field-data
CALL FL_FLDopen(indexName, LEN_TRIM(indexName), IERR)
IF(IERR==0) THEN
haveIndex = .TRUE.
ELSE
haveIndex = .FALSE.
END IF
CALL vtkstartN()
IF( haveIndex ) THEN
DO
CALL FL_FLDread(type, type_len, dataName, dataName_len, ids, ids_cnt, IERR)
IF(IERR .NE. 0) EXIT
DO J=1, ids_cnt
ids(J) = ids(J)-1
END DO
! Scalar support
IF(type(1:type_len) .EQ. 'SCALAR') THEN
CALL vtkwriteFSN(FIELDS(ids(1)*FSTRIDE+1), dataName, dataName_len)
! Vector support
ELSE IF(type(1:type_len) .EQ. 'VECTOR') THEN
CALL vtkwriteFVN( &
FIELDS(ids(1)*FSTRIDE+1), &
FIELDS(ids(2)*FSTRIDE+1), &
Z, dataName, dataName_len)
! Tensor support
ELSE IF(type(1:type_len) .EQ. 'TENSOR') THEN
CONTINUE
ELSE IF(type(1:type_len) .EQ. 'CONDUCTIVITY') THEN
CONTINUE
END IF
END DO
CALL FL_FLDclose();
ELSE
! Default action is to output all the fields as scalars
DO I=0, NFIELDS-1
CALL vtkwriteFSN(FIELDS(I*FSTRIDE+1), "", 0)
END DO
END IF
CALL vtkstartC();
CALL vtkwriteISC(NODDOM, "GraphPartitioning", 17)
! Finalize
CALL vtkclose(outName, LEN_TRIM(outName), vtkTitle, LEN_TRIM(vtkTitle))
DEALLOCATE(Z)
RETURN
END SUBROUTINE VTKOUT2D
|