GRIDMAN
grid managment library
vtk.f
Go to the documentation of this file.
1 C> @file formats/vtk.f
2 C> Writing files in VTK format for graphical programms (e.g. Paraview)
3 C GRIDMAN, grid managment library. Author: Vladislav Kotov, v.kotov@fz-juelich.de
4 
5 ! Copyright (c) 2017 Forschungszentrum Juelich GmbH
6 ! Vladislav Kotov
7 !
8 ! This file is part of GRIDMAN.
9 !
10 ! GRIDMAN is free software: you can redistribute it and/or modify
11 ! it under the terms of the GNU General Public License as published by
12 ! the Free Software Foundation, either version 3 of the License, or
13 ! (at your option) any later version.
14 !
15 ! GRIDMAN is distributed in the hope that it will be useful,
16 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ! GNU General Public License for more details.
19 !
20 ! You should have received a copy of the GNU General Public License
21 ! along with GRIDMAN. If not, see <http://www.gnu.org/licenses/>.
22 
23 C*********************************************************************************
24 C> Write grid and data in VTK ASCII legacy format (interface)
25 C*********************************************************************************
26  SUBROUTINE gridman_vtk_write(FNAME,HEADER,
27  s npoints,ncells,nvertex,nd,
28  s x,ifirst,lvertex,ivertex,ctype,
29  s ncs,ncv,nps,npv,ierr,
30  s cell_scalar,csname,
31  s cell_vector,cvname,
32  s point_scalar,psname,
33  s point_vector,pvname)
34  USE gridman,ONLY:gridman_sp,gridman_dp,gridman_dbg,gridman_unit
35  USE gridman_lib,ONLY:gridman_vtk_write_grid,
36  u gridman_vtk_write_scalars,
37  u gridman_vtk_write_vectors
38  IMPLICIT NONE
39  INTRINSIC len_trim
40 C> Name of the output file
41  CHARACTER(*),INTENT(IN) :: FNAME
42 C> String with short description of the data set
43  CHARACTER(*),INTENT(IN) :: HEADER
44 C> Number of points
45  INTEGER(GRIDMAN_SP),INTENT(IN) :: NPOINTS
46 C> Number of cells
47  INTEGER(GRIDMAN_SP),INTENT(IN) :: NCELLS
48 C> Total number of vertices
49  INTEGER(GRIDMAN_SP),INTENT(IN) :: NVERTEX
50 C> First dimension of array X, can be 2 or 3
51 C>
52 C> If ND=2 then third dimension is set to 0
53  INTEGER,INTENT(IN) :: ND
54 C> Array of coordinates
55  REAL(GRIDMAN_DP),INTENT(IN) :: X(nd,npoints)
56 C> First index which corresponds to each cell in array IVERTEX
57  INTEGER(GRIDMAN_SP),INTENT(IN) :: IFIRST(ncells)
58 C> Number of vertices of each cell
59  INTEGER(GRIDMAN_SP),INTENT(IN) :: LVERTEX(ncells)
60 C> List of points (vertices) belonging to each cell
61 C>
62 C> WARNING: in VTK indexing begins from 0, not from 1.
63 C> IVERTEX must contain VTK indexing, that is,
64 C> index in X shifted by "minus one"
65  INTEGER(GRIDMAN_SP),INTENT(IN) :: IVERTEX(nvertex)
66 C> VTK cell type index
67  INTEGER,INTENT(IN) :: CTYPE(ncells)
68 C> Number of scalar cell data sets
69  INTEGER,INTENT(IN) :: NCS
70 C> Number of vector cell data sets
71  INTEGER,INTENT(IN) :: NCV
72 C> Number of scalar point data sets
73  INTEGER,INTENT(IN) :: NPS
74 C> Number of vector point data sets
75  INTEGER,INTENT(IN) :: NPV
76 C> Error code
77  INTEGER,INTENT(OUT) :: IERR
78 C> Scalar cell data
79  REAL(GRIDMAN_DP),INTENT(IN),OPTIONAL :: CELL_SCALAR(ncells,ncs)
80 C> Names of the scalar cell data sets
81  CHARACTER(*),INTENT(IN),OPTIONAL :: CSNAME(ncs)
82 C> Vector cell data
83  REAL(GRIDMAN_DP),INTENT(IN),OPTIONAL ::
84  r cell_vector(nd,ncells,ncv)
85 C> Names of the vector cell data sets
86  CHARACTER(*),INTENT(IN),OPTIONAL :: CVNAME(ncv)
87 C> Scalar point data
88  REAL(GRIDMAN_DP),INTENT(IN),OPTIONAL :: POINT_SCALAR(npoints,nps)
89 C> Names of the scalar point data sets
90  CHARACTER(*),INTENT(IN),OPTIONAL :: PSNAME(nps)
91 C> Vector cell data
92  REAL(GRIDMAN_DP),INTENT(IN),OPTIONAL ::
93  r point_vector(nd,npoints,npv)
94 C> Names of the vector point data sets
95  CHARACTER(*),INTENT(IN),OPTIONAL :: PVNAME(npv)
96 
97  INTEGER :: IO,ID
98  CHARACTER*64 :: DATANAME
99 
100  IF(gridman_dbg)
101  w WRITE(gridman_unit,*) "Starting GRIDMAN_VTK_WRITE"
102 
103  ierr=0
104 
105 C OPEN FILE
106  OPEN(3,file=fname,status='REPLACE',iostat=io)
107  IF(io.NE.0) THEN
108  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE: ",
109  w "can not open file ",
110  w fname(1:len_trim(fname))
111  WRITE(gridman_unit,*) "Writing skipped!"
112  ierr=300
113  RETURN
114  END IF
115 C HEADER AND GRID
116  CALL gridman_vtk_write_grid(3,header,npoints,ncells,nvertex,nd,
117  s x,ifirst,lvertex,ivertex,ctype,ierr)
118  IF(ierr.NE.0) GOTO 100
119 C
120 C CELL DATA
121 C
122  IF(PRESENT(cell_scalar).OR.PRESENT(cell_vector)) THEN
123  WRITE(3,'(A)',iostat=io) ' '
124  IF(io.NE.0) GOTO 300
125  WRITE(3,'(A10,I7)',iostat=io) "CELL_DATA ",ncells
126  IF(io.NE.0) GOTO 300
127  END IF
128 C CELL SCALARS
129  IF(PRESENT(cell_scalar)) THEN
130  IF(ncs.LT.1) THEN
131  ierr=100
132  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE: ",
133  w "incorrect number of cell scalars"
134  WRITE(gridman_unit,*) " NCS ",ncs
135  GOTO 200
136  END IF
137  IF(.NOT.PRESENT(csname)) THEN
138  WRITE(gridman_unit,*) "WARNING from GRIDMAN_VTK_WRITE: ",
139  w "names of Cell Scalars are not defined"
140  END IF
141  DO id=1,ncs
142  IF(PRESENT(csname)) THEN
143  dataname=csname(id)
144  ELSE
145  WRITE(dataname,'(A11,I4.4)') "CELL_SCALAR",id
146  END IF
147  CALL gridman_vtk_write_scalars(3,dataname,ncells,
148  c cell_scalar(:,id),ierr)
149  IF(ierr.NE.0) GOTO 100
150  END DO
151  END IF
152 C CELL VECTORS
153  IF(PRESENT(cell_vector)) THEN
154  IF(ncv.LT.1) THEN
155  ierr=100
156  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE: ",
157  w "incorrect number of cell vectors"
158  WRITE(gridman_unit,*) " NCV ",ncv
159  GOTO 200
160  END IF
161  IF(.NOT.PRESENT(cvname)) THEN
162  WRITE(gridman_unit,*) "WARNING from GRIDMAN_VTK_WRITE: ",
163  w "names of Cell Vectors are not defined"
164  END IF
165  DO id=1,ncv
166  IF(PRESENT(cvname)) THEN
167  dataname=cvname(id)
168  ELSE
169  WRITE(dataname,'(A11,I4.4)') "CELL_VECTOR",id
170  END IF
171  CALL gridman_vtk_write_vectors(3,dataname,ncells,nd,
172  c cell_vector(:,:,id),ierr)
173  IF(ierr.NE.0) GOTO 100
174  END DO
175  END IF
176 C
177 C POINT DATA
178 C
179  IF(PRESENT(point_scalar).OR.PRESENT(point_vector)) THEN
180  WRITE(3,'(A)',iostat=io) ' '
181  IF(io.NE.0) GOTO 300
182  WRITE(3,'(A10,I7)',iostat=io) "POINT_DATA ",npoints
183  IF(io.NE.0) GOTO 300
184  END IF
185 C POINT SCALARS
186  IF(PRESENT(point_scalar)) THEN
187  IF(nps.LT.1) THEN
188  ierr=100
189  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE: ",
190  w "incorrect number of point scalars"
191  WRITE(gridman_unit,*) " NPS ",nps
192  GOTO 200
193  END IF
194  IF(.NOT.PRESENT(psname)) THEN
195  WRITE(gridman_unit,*) "WARNING from GRIDMAN_VTK_WRITE: ",
196  w "names of Point Scalars are not defined"
197  END IF
198  DO id=1,nps
199  IF(PRESENT(psname)) THEN
200  dataname=psname(id)
201  ELSE
202  WRITE(dataname,'(A12,I4.4)') "POINT_SCALAR",id
203  END IF
204  CALL gridman_vtk_write_scalars(3,dataname,npoints,
205  c point_scalar(:,id),ierr)
206  IF(ierr.NE.0) GOTO 100
207  END DO
208  END IF
209 C CELL VECTORS
210  IF(PRESENT(point_vector)) THEN
211  IF(npv.LT.1) THEN
212  ierr=100
213  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE: ",
214  w "incorrect number of point vectors"
215  WRITE(gridman_unit,*) " NPV ",npv
216  GOTO 200
217  END IF
218  IF(.NOT.PRESENT(pvname)) THEN
219  WRITE(gridman_unit,*) "WARNING from GRIDMAN_VTK_WRITE: ",
220  w "names of Point Vectors are not defined"
221  END IF
222  DO id=1,npv
223  IF(PRESENT(pvname)) THEN
224  dataname=pvname(id)
225  ELSE
226  WRITE(dataname,'(A12,I4.4)') "POINT_VECTOR",id
227  END IF
228  CALL gridman_vtk_write_vectors(3,dataname,npoints,nd,
229  c point_vector(:,:,id),ierr)
230  IF(ierr.NE.0) GOTO 100
231  END DO
232  END IF
233 
234  CLOSE(3)
235 
236  IF(gridman_dbg)
237  w WRITE(gridman_unit,*) "GRIDMAN_VTK_WRITE finished"
238 
239  RETURN
240 
241  100 WRITE(gridman_unit,*) "GRIDMAN_VTK_WRITE terminated"
242  WRITE(gridman_unit,*) " File ", fname(1:len_trim(fname))
243  200 CLOSE(3)
244  RETURN
245  300 ierr=300
246  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
247  w "can not write to file ",
248  w fname(1:len_trim(fname))
249  WRITE(gridman_unit,*) "Writing skipped!"
250  CLOSE(3)
251 
252  END SUBROUTINE gridman_vtk_write
253 
254 
255 C*********************************************************************************
256 C> Write header and grid in VTK ASCII legacy format
257 C*********************************************************************************
258  SUBROUTINE gridman_vtk_write_grid(IOUT,HEADER,
259  s npoints,ncells,nvertex,nd,
260  s x,ifirst,lvertex,ivertex,
261  s ctype,ierr)
262  USE gridman,ONLY:gridman_sp,gridman_dp,gridman_dbg,gridman_unit
263  IMPLICIT NONE
264  INTRINSIC len_trim,min
265 C> Index of the output unit
266  INTEGER,INTENT(IN) :: IOUT
267 C> String with short description of the data set
268  CHARACTER(*),INTENT(IN) :: HEADER
269 C> Number of points
270  INTEGER(GRIDMAN_SP),INTENT(IN) :: NPOINTS
271 C> Number of cells
272  INTEGER(GRIDMAN_SP),INTENT(IN) :: NCELLS
273 C> Total number of vertices
274  INTEGER(GRIDMAN_SP),INTENT(IN) :: NVERTEX
275 C> First dimension of array X, can be 2 or 3
276 C>
277 C> If ND=2 then third dimension is set to 0
278  INTEGER,INTENT(IN) :: ND
279 C> Array of coordinates
280  REAL(GRIDMAN_DP),INTENT(IN) :: X(nd,npoints)
281 C> First index which corresponds to each cell in array IVERTEX
282  INTEGER(GRIDMAN_SP),INTENT(IN) :: IFIRST(ncells)
283 C> Number of vertices of each cell
284  INTEGER(GRIDMAN_SP),INTENT(IN) :: LVERTEX(ncells)
285 C> List of points (vertices) belonging to each cell
286 C>
287 C> WARNING: in VTK indexing begins from 0, not from 1.
288 C> IVERTEX must contain VTK indexing, that is,
289 C> index in X shifted by "minus one"
290  INTEGER(GRIDMAN_SP),INTENT(IN) :: IVERTEX(nvertex)
291 C> VTK cell type index
292  INTEGER,INTENT(IN) :: CTYPE(ncells)
293 C> Error code
294  INTEGER,INTENT(OUT) :: IERR
295 
296  INTEGER(GRIDMAN_SP) :: IPOINT,ICELL,IV1,IV2
297  INTEGER :: IO
298  CHARACTER*32 :: FRM !FORMAT STRING
299 
300  IF(gridman_dbg)
301  w WRITE(gridman_unit,*) "Starting GRIDMAN_VTK_WRITE_GRID"
302 
303  ierr=0
304 
305  IF(npoints.LT.1.OR.ncells.LT.1.OR.nvertex.LT.npoints) THEN
306  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
307  w " wrong input dimensions"
308  WRITE(gridman_unit,*) " NPOINTS, NCELLS, NVERTEX ",
309  w npoints, ncells, nvertex
310  WRITE(gridman_unit,*) "Writing skipped!"
311  ierr=100
312  RETURN
313  END IF
314 
315  IF(nd.NE.2.AND.nd.NE.3) THEN
316  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
317  w "wrong dimensionality of coordinates"
318  WRITE(gridman_unit,*) " Can be 2 or 3, ND ",nd
319  END IF
320 
321 C HEADER
322  WRITE(iout,'(A)',iostat=io) "# vtk DataFile Version 2.0"
323  IF(io.NE.0) GOTO 100
324  WRITE(iout,'(A)',iostat=io) header(1:min(len_trim(header),256))
325  IF(io.NE.0) GOTO 100
326  WRITE(iout,'(A)',iostat=io) "ASCII"
327  IF(io.NE.0) GOTO 100
328  WRITE(iout,'(A)',iostat=io) "DATASET UNSTRUCTURED_GRID"
329  IF(io.NE.0) GOTO 100
330 
331 C POINTS
332  WRITE(iout,'(A7,I7,A7)',iostat=io) "POINTS ",npoints," float"
333  IF(io.NE.0) GOTO 100
334  IF(nd.EQ.2) THEN
335  DO ipoint=1,npoints
336  WRITE(iout,'(2E15.7,F4.1)',iostat=io) x(1:2,ipoint),0.
337  IF(io.NE.0) GOTO 100
338  END DO
339  ELSE IF(nd.EQ.3) THEN
340  DO ipoint=1,npoints
341  WRITE(iout,'(3E15.7)',iostat=io) x(1:3,ipoint)
342  IF(io.NE.0) GOTO 100
343  END DO
344  END IF
345 
346 C CELLS
347  WRITE(iout,'(A)',iostat=io) ' '
348  IF(io.NE.0) GOTO 100
349  WRITE(iout,'(A6,2I7)',iostat=io) "CELLS ",ncells,nvertex+ncells
350  IF(io.NE.0) GOTO 100
351  DO icell=1,ncells
352  iv1=ifirst(icell)
353  IF(icell.GT.1) THEN
354  IF(iv1.LT.ifirst(icell-1).OR.iv1.GT.nvertex) THEN
355  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
356  w " wrong first index"
357  WRITE(gridman_unit,*)
358  w " ICELL, IFIRST(ICELL-1),IFIRST(ICELL), NVERTEX",
359  w icell, ifirst(icell-1), iv1, nvertex
360  ierr=100
361  RETURN
362  END IF
363  ELSE
364  IF(iv1.LT.1.OR.iv1.GT.nvertex) THEN
365  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
366  w " first index out of range"
367  WRITE(gridman_unit,*) " ICELL, IFIRST(ICELL), NVERTEX ",
368  w icell, ifirst(icell), nvertex
369  ierr=100
370  RETURN
371  END IF
372  END IF
373  IF(lvertex(icell).LT.1) THEN
374  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
375  w " non-positive number of vertices"
376  WRITE(gridman_unit,*) " ICELL, LVERTEX ",icell,lvertex(icell)
377  ierr=100
378  RETURN
379  END IF
380  iv2=iv1+lvertex(icell)-1
381  IF(iv2.GT.nvertex) THEN
382  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
383  w " last index out of range"
384  WRITE(gridman_unit,*) " ICELL, IFIRST, LVERTEX, NVERTEX ",
385  w icell,ifirst(icell),lvertex(icell),nvertex
386  ierr=100
387  RETURN
388  END IF
389  WRITE(frm,210) lvertex(icell)
390  210 FORMAT('(I4,',i4,'I7)')
391  WRITE(iout,frm,iostat=io) lvertex(icell),ivertex(iv1:iv2)
392  IF(io.NE.0) GOTO 100
393  END DO
394 
395 C CELL TYPES
396  WRITE(iout,'(A)',iostat=io) ' '
397  IF(io.NE.0) GOTO 100
398  WRITE(iout,'(A11,I7)',iostat=io) "CELL_TYPES ",ncells
399  IF(io.NE.0) GOTO 100
400  DO icell=1,ncells
401  IF(ctype(icell).EQ.1) THEN !VTK_VERTEX
402  IF(lvertex(icell).NE.1) THEN
403  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
404  w "mismatch between cell type and number of vertices"
405  WRITE(gridman_unit,*) "VTK_VERTEX must have 1 vertex"
406  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
407  w icell, ctype(icell),lvertex(icell)
408  ierr=100
409  RETURN
410  END IF
411  ELSE IF(ctype(icell).EQ.3) THEN !VTK_LINE
412  IF(lvertex(icell).NE.2) THEN
413  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
414  w "mismatch between cell type and number of vertices"
415  WRITE(gridman_unit,*) "VTK_LINE must have 2 vertices"
416  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
417  w icell, ctype(icell),lvertex(icell)
418  ierr=100
419  RETURN
420  END IF
421  ELSE IF(ctype(icell).EQ.5) THEN !VTK_TRIANGLE
422  IF(lvertex(icell).NE.3) THEN
423  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
424  w "mismatch between cell type and number of vertices"
425  WRITE(gridman_unit,*) "VTK_TRIANGLE must have 3 vertices"
426  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
427  w icell, ctype(icell),lvertex(icell)
428  ierr=100
429  RETURN
430  END IF
431  ELSE IF(ctype(icell).EQ.7) THEN !VTK_POLYGON
432  IF(lvertex(icell).LT.3) THEN
433  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
434  w "mismatch between cell type and number of vertices"
435  WRITE(gridman_unit,*) "VTK_POLYGON must have >2 vertices"
436  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
437  w icell, ctype(icell),lvertex(icell)
438  ierr=100
439  RETURN
440  END IF
441  ELSE IF(ctype(icell).EQ.9) THEN !VTK_QUAD
442  IF(lvertex(icell).NE.4) THEN
443  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
444  w "mismatch between cell type and number of vertices"
445  WRITE(gridman_unit,*) "VTK_QUAD must have 4 vertices"
446  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
447  w icell, ctype(icell),lvertex(icell)
448  ierr=100
449  RETURN
450  END IF
451  ELSE IF(ctype(icell).EQ.10) THEN !VTK_TETRA
452  IF(lvertex(icell).NE.4) THEN
453  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
454  w "mismatch between cell type and number of vertices"
455  WRITE(gridman_unit,*) "VTK_TETRA must have 4 vertices"
456  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
457  w icell, ctype(icell),lvertex(icell)
458  ierr=100
459  RETURN
460  END IF
461  ELSE IF(ctype(icell).EQ.12) THEN !VTK_HEXAHEDRON
462  IF(lvertex(icell).NE.8) THEN
463  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
464  w "mismatch between cell type and number of vertices"
465  WRITE(gridman_unit,*) "VTK_HEXAHEDRON must have 8 vertices"
466  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
467  w icell, ctype(icell),lvertex(icell)
468  ierr=100
469  RETURN
470  END IF
471  ELSE IF(ctype(icell).EQ.13) THEN !VTK_WEDGE
472  IF(lvertex(icell).NE.6) THEN
473  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
474  w "mismatch between cell type and number of vertices"
475  WRITE(gridman_unit,*) "VTK_WEDGE must have 6 vertices"
476  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
477  w icell, ctype(icell),lvertex(icell)
478  ierr=100
479  RETURN
480  END IF
481  ELSE IF(ctype(icell).EQ.14) THEN !VTK_PYRAMID
482  IF(lvertex(icell).NE.5) THEN
483  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
484  w "mismatch between cell type and number of vertices"
485  WRITE(gridman_unit,*) "VTK_PYRAMID must have 5 vertices"
486  WRITE(gridman_unit,*) " ICELL, CELL_TYPE, N ",
487  w icell, ctype(icell),lvertex(icell)
488  ierr=100
489  RETURN
490  END IF
491  ELSE
492  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
493  w "unsupported cell type"
494  WRITE(gridman_unit,*) " ICELL, CELL_TYPE ", icell,ctype(icell)
495  ierr=100
496  RETURN
497  END IF
498  WRITE(iout,'(I3)',iostat=io) ctype(icell)
499  IF(io.NE.0) GOTO 100
500  END DO
501 
502  IF(gridman_dbg)
503  w WRITE(gridman_unit,*) "GRIDMAN_VTK_WRITE_GRID finished"
504 
505  RETURN
506 
507  100 ierr=300
508  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_GRID: ",
509  w "can not write to file"
510  WRITE(gridman_unit,*) "Writing skipped!"
511 
512  END SUBROUTINE gridman_vtk_write_grid
513 
514 C*********************************************************************************
515 C> Write scalar data in VTK format
516 C*********************************************************************************
517  SUBROUTINE gridman_vtk_write_scalars(IOUT,DATANAME,N,S,IERR)
518  USE gridman,ONLY:gridman_sp,gridman_dp,gridman_dbg,gridman_unit
519  IMPLICIT NONE
520  INTRINSIC abs,min,max
521 C> Index of the output unit
522  INTEGER,INTENT(IN) :: IOUT
523 C> String with short description of the data set
524  CHARACTER(*),INTENT(IN) :: DATANAME
525 C> Length of the data array
526  INTEGER(GRIDMAN_SP),INTENT(IN) :: N
527 C> Data array
528  REAL(GRIDMAN_DP),INTENT(IN) :: S(n)
529 C> Error code
530  INTEGER,INTENT(OUT) :: IERR
531 
532  INTEGER(GRIDMAN_SP) :: I
533  INTEGER :: IO
534  REAL(GRIDMAN_DP) :: X
535 
536  IF(gridman_dbg)
537  w WRITE(gridman_unit,*) "Starting GRIDMAN_VTK_WRITE_SCALARS"
538 
539  ierr=0
540 
541  IF(n.LT.1) THEN
542  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_SCALARS: ",
543  w "wrong input dimension N ",n
544  END IF
545 
546  WRITE(iout,'(A8,A,A6)',iostat=io) 'SCALARS ',dataname,' float'
547  IF(io.NE.0) GOTO 100
548  WRITE(iout,'(A)',iostat=io) 'LOOKUP_TABLE default'
549  IF(io.NE.0) GOTO 100
550 
551  DO i=1,n
552  x=s(i)
553  IF(abs(x).LT.1e-98_gridman_dp) x=0.
554  x=min(x,1e98_gridman_dp)
555  x=max(x,-1e98_gridman_dp)
556  WRITE(iout,'(E15.7)',iostat=io) x
557  IF(io.NE.0) GOTO 100
558  END DO
559  IF(gridman_dbg)
560  w WRITE(gridman_unit,*) "GRIDMAN_VTK_WRITE_SCALARS finished"
561 
562  RETURN
563 
564  100 ierr=300
565  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_SCALARS: ",
566  w "can not write to file"
567  WRITE(gridman_unit,*) "Writing skipped!"
568 
569  END SUBROUTINE gridman_vtk_write_scalars
570 
571 C*********************************************************************************
572 C> Write vector data in VTK format
573 C*********************************************************************************
574  SUBROUTINE gridman_vtk_write_vectors(IOUT,DATANAME,N,ND,V,IERR)
575  USE gridman,ONLY:gridman_sp,gridman_dp,gridman_dbg,gridman_unit
576  IMPLICIT NONE
577  INTRINSIC abs,min,max
578 C> Index of the output unit
579  INTEGER,INTENT(IN) :: IOUT
580 C> String with short description of the data set
581  CHARACTER(*) :: DATANAME
582 C> Length of the data array
583  INTEGER(GRIDMAN_SP),INTENT(IN) :: N
584 C> Dimenisonality of vectors, can be 2 or 3
585  INTEGER,INTENT(IN) :: ND
586 C> Data array
587  REAL(GRIDMAN_DP) :: V(nd,n)
588 C> Error code
589  INTEGER,INTENT(OUT) :: IERR
590 
591  INTEGER(GRIDMAN_SP) :: I,K
592  INTEGER :: IO
593  REAL(GRIDMAN_DP) :: X(3)
594 
595  IF(gridman_dbg)
596  w WRITE(gridman_unit,*) "Starting GRIDMAN_VTK_WRITE_VECTORS"
597 
598  ierr=0
599 
600  IF(n.LT.1) THEN
601  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_VECTORS: ",
602  w "wrong data array length N ",n
603  END IF
604 
605  IF(nd.NE.2.AND.nd.NE.3) THEN
606  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_VECTORS: ",
607  w "wrong dimensionality of vectors"
608  WRITE(gridman_unit,*) " Can be 2 or 3, ND ",nd
609  END IF
610 
611  WRITE(iout,'(A8,A,A6)',iostat=io) 'VECTORS ',dataname,' float'
612  IF(io.NE.0) GOTO 100
613  DO i=1,n
614  x(1:nd)=v(1:nd,i)
615  DO k=1,nd
616  IF(abs(x(k)).LT.1.e-98_gridman_dp) x(k)=0.
617  x(k)=min(x(k),1.e98_gridman_dp)
618  x(k)=max(x(k),-1.e98_gridman_dp)
619  END DO
620  IF(nd.EQ.3) THEN
621  WRITE(iout,'(3E15.7)',iostat=io) x(1:3)
622  ELSEIF(nd.EQ.2) THEN
623  WRITE(iout,'(2E15.7,F4.1)',iostat=io) x(1:2),0.
624  END IF
625  IF(io.NE.0) GOTO 100
626  END DO
627 
628  IF(gridman_dbg)
629  w WRITE(gridman_unit,*) "GRIDMAN_VTK_WRITE_VECTORS finished"
630 
631  RETURN
632 
633  100 ierr=300
634  WRITE(gridman_unit,*) "ERROR in GRIDMAN_VTK_WRITE_VECTORS: ",
635  w "can not write to file"
636  WRITE(gridman_unit,*) "Writing skipped!"
637 
638  END SUBROUTINE gridman_vtk_write_vectors
gridman_vtk_write_scalars
subroutine gridman_vtk_write_scalars(IOUT, DATANAME, N, S, IERR)
Write scalar data in VTK format.
Definition: vtk.f:518
gridman::gridman_unit
integer, save, public gridman_unit
Index of the standard output unit.
Definition: gridman.f:116
gridman::gridman_dp
integer, parameter, public gridman_dp
Kind parameter for real numbers.
Definition: gridman.f:93
gridman_lib
Explicit interfaces to GRIDMAN subroutines and functions.
Definition: gridman.f:251
gridman_vtk_write_grid
subroutine gridman_vtk_write_grid(IOUT, HEADER, NPOINTS, NCELLS, NVERTEX, ND, X, IFIRST, LVERTEX, IVERTEX, CTYPE, IERR)
Write header and grid in VTK ASCII legacy format.
Definition: vtk.f:262
gridman::gridman_dbg
logical, save, public gridman_dbg
Switch for debugging mode.
Definition: gridman.f:122
gridman_vtk_write_vectors
subroutine gridman_vtk_write_vectors(IOUT, DATANAME, N, ND, V, IERR)
Write vector data in VTK format.
Definition: vtk.f:575
gridman
Definition of data types, global constants and variables.
Definition: gridman.f:83
gridman_vtk_write
subroutine gridman_vtk_write(FNAME, HEADER, NPOINTS, NCELLS, NVERTEX, ND, X, IFIRST, LVERTEX, IVERTEX, CTYPE, NCS, NCV, NPS, NPV, IERR, CELL_SCALAR, CSNAME, CELL_VECTOR, CVNAME, POINT_SCALAR, PSNAME, POINT_VECTOR, PVNAME)
Write grid and data in VTK ASCII legacy format (interface)
Definition: vtk.f:34
gridman::gridman_sp
integer, parameter, public gridman_sp
Kind parameter for integer numbers.
Definition: gridman.f:95
Generated on Thu Oct 5 2017 09:49:56 for GRIDMAN by   doxygen 1.8.9.1