conv_vtk.F

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\conv_vtk.F
00002 !
00038       MODULE CONV_VTK
00039       CONTAINS
00040 !                       *****************
00041                         SUBROUTINE WRITE_VTK
00042 !                       *****************
00043      &(VTKFILE)
00044 !
00045 !***********************************************************************
00046 ! STBTEL   V6P1                                   11/07/2011
00047 !***********************************************************************
00048 !
00049 !BRIEF    WRITE A FILE OF SELAFIN FORMAT WITH THE MESH OBJECT
00050 !+        INFORMATIONS
00051 !
00052 !HISTORY  Y.AUDOUIN (EDF)
00053 !+        11/07/2011
00054 !+        V6P1
00055 !+   CREATION OF THE FILE
00056 !
00057 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00058 !| VTKFILE        |-->| NAME OF THE VTK FILE
00059 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00060 !
00061       USE DECLARATIONS_STBTEL
00062       USE LIB_VTK_IO
00063 !
00064       IMPLICIT NONE
00065       ! LANGAE AND OUTPUT VALUE
00066       INTEGER LNG,LU
00067       COMMON/INFO/LNG,LU
00068 !
00069 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00070 !
00071       CHARACTER(LEN=MAXLENHARD), INTENT(IN) :: VTKFILE
00072 !
00073 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00074 !
00075 #if defined(HAVE_VTK)
00076       INTEGER :: IERR,ITIME,I,J
00077       INTEGER, ALLOCATABLE :: CELL_TYPE(:), CONNECT(:)
00078       DOUBLE PRECISION, ALLOCATABLE :: TMP(:)
00079       CHARACTER(LEN=MAXLENHARD) :: FILENAME
00080       CHARACTER*8 :: TIMESTR
00081 !
00082       WRITE(LU,*) '----------------------------------------------------'
00083       IF(LNG.EQ.1) WRITE(LU,*) '------DEBUT ECRITURE FICHIER VTK'
00084       IF(LNG.EQ.2) WRITE(LU,*) '------BEGINNING WRITTING OF VTK FILE'
00085       WRITE(LU,*) '----------------------------------------------------'
00086 !
00087 !-----------------------------------------------------------------------
00088 !
00089       ! IF WE ARE IN 2D ADDING Z COORDINATES TO 0
00090       IF(MESH2%NDIM.EQ.2) THEN
00091         ALLOCATE(MESH2%Z(MESH2%NPOIN),STAT=IERR)
00092         CALL FNCT_CHECK(IERR,'ALLOCATE MESH2%Z')
00093         MESH2%Z(:) = 0.D0
00094       ENDIF
00095       ! MAKING A FILE FOR EACH TIME STEP
00096       DO ITIME=1,MESH2%TIMESTEP
00097         CALL NUMBER2STRING(TIMESTR,ITIME)
00098         FILENAME = TRIM(VTKFILE)//TIMESTR//'.vtk'
00099         IF(LNG.EQ.1) WRITE(LU,*) '-- ECRITURE DU FICHIER : ',FILENAME
00100         IF(LNG.EQ.2) WRITE(LU,*) '-- WRITTING FILE: ',FILENAME
00101         ! INITIALISING THE VTK FILE
00102         IERR=VTK_INI('ASCII',FILENAME,MESH2%TITLE,'UNSTRUCTURED_GRID')
00103         CALL FNCT_CHECK(IERR,'VTK_INI')
00104         ! WRITTING THE NODES COORDINATES
00105         IERR=VTK_GEO(MESH2%NPOIN,MESH2%X,MESH2%Y,MESH2%Z)
00106         CALL FNCT_CHECK(IERR,'VTK_GEO')
00107         ! DEFINING THE CELLS TYPE
00108         ALLOCATE(CELL_TYPE(MESH2%NELEM),STAT=IERR)
00109         CALL FNCT_CHECK(IERR,'ALLOCATE CELL_TYPE')
00110         ! VALUE CHOSEN IN PDF VTK FILE FORMAT (GOOGLE)
00111         SELECT CASE(MESH2%TYPE_ELEM)
00112         CASE(TYPE_TRIA3)
00113           CELL_TYPE(:) = 5
00114         CASE(TYPE_QUAD4)
00115           CELL_TYPE(:) = 9
00116         CASE(TYPE_TETRA4)
00117           CELL_TYPE(:) = 10
00118         CASE(TYPE_PRISM6)
00119           CELL_TYPE(:) = 13
00120         END SELECT
00121         ! BUILDING THE CONNECTION TABLE FOLLOWING THE VTK STANDARD
00122         ! FOR EACH CELL :
00123         !   FIRST THE NUMBER OF NODES COMPOSING THE CELL
00124         !   THEN THE NUMBER OF EACH NODE
00125         ! WE NEED TO RENUMBER TO NODES 0 TO NELEM-1
00126         ALLOCATE(CONNECT(MESH2%NELEM*(MESH2%NDP+1)),STAT=IERR)
00127         CALL FNCT_CHECK(IERR,'ALLOCATE CONNECT')
00128         DO I=1,MESH2%NELEM
00129           CONNECT((I-1)*(MESH2%NDP+1)+1) = MESH2%NDP
00130           DO J=1,MESH2%NDP
00131             CONNECT((I-1)*(MESH2%NDP+1)+J+1) =
00132      &              MESH2%IKLES((I-1)*MESH2%NDP+J)-1
00133           ENDDO
00134         ENDDO
00135         IERR=VTK_CON(MESH2%NELEM,CONNECT,CELL_TYPE)
00136         CALL FNCT_CHECK(IERR,'VTK_CON')
00137         ! ADDING THE NUMBER OF NODES ON WHICH THERE IS GONNA BE A
00138         ! VARAIBLE HERE EVERY ONE
00139         IERR=VTK_DAT(MESH2%NPOIN,'node')
00140         CALL FNCT_CHECK(IERR,'VTK_DAT')
00141         ! ADDING EACH VARAIBLE
00142         ALLOCATE(TMP(MESH2%NPOIN),STAT=IERR)
00143         CALL FNCT_CHECK(IERR,'ALLOCATE TMP')
00144         DO I=1,MESH2%NVAR
00145           DO J=1,MESH2%NPOIN
00146             TMP(J)= MESH2%RESULTS(ITIME,I,J)
00147           ENDDO
00148           IERR=VTK_VAR(MESH2%NPOIN,MESH2%NAMEVAR(I),
00149      &                 TMP)
00150           CALL FNCT_CHECK(IERR,'VTK_VAR '//MESH2%NAMEVAR(I))
00151         ENDDO
00152         DEALLOCATE(TMP)
00153         ! CLOSING THE FILE
00154         IERR=VTK_END()
00155         CALL FNCT_CHECK(IERR,'VTK_END')
00156         DEALLOCATE(CELL_TYPE,CONNECT)
00157       ENDDO
00158       IF(MESH2%NDIM.EQ.2) DEALLOCATE(MESH2%Z)
00159 
00160 !
00161 !-----------------------------------------------------------------------
00162 !
00163       WRITE(LU,*) '----------------------------------------------------'
00164       IF(LNG.EQ.1) WRITE(LU,*) '------FIN ECRITURE DU FICHIER VTK'
00165       IF(LNG.EQ.2) WRITE(LU,*) '------ENDING WRITTING OF VTK FILE'
00166       WRITE(LU,*) '----------------------------------------------------'
00167 #else
00168       IF(LNG.EQ.1) WRITE(LU,*)
00169      &       'ERREUR : TENTATIVE D ECRITURE D UN FICHIER VTK ',
00170      &       'SANS LA BIBLIOTHEQUE'
00171       IF(LNG.EQ.2) WRITE(LU,*)
00172      &       'ERROR : TRYING TO WRITE VTK FILE WITHOUT VTK LIBRARY'
00173       CALL PLANTE(1)
00174 
00175 #endif
00176       END SUBROUTINE
00177       END MODULE

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0