creategeometry_gambit.F [SRC] [CPP] [JOB] [SCAN]
TOOLS / VISU / SRC



   1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE creategeometry_gambit(meshfile,ensight_geometryfile,   &
   4 |      &           ntnode,ntdim)
   5 | !     ====================================================================!
   6 | !                                                                         !
   7 | !       ensight_gambit.F : Create geometry for ensight with a GAMBIt mesh !
   8 | !                                                                         !
   9 | !       author        : D. POITOU (june 2008)                             !
  10 | !                                                                         !
  11 | !      ===================================================================!
  12 | 
  13 |       USE ensightgold_geometry
  14 |       USE gambit_read
  15 | 
  16 |       IMPLICIT NONE 
  17 | 
  18 |       INCLUDE 'dom_constants.h'
  19 | 
  20 |       CHARACTER*80          :: meshfile,ensight_geometryfile
  21 |       DOM_INT               :: nfile,i_node,i_el,i_type,k,l
  22 |       DOM_INT               :: lenofchar,docall
  23 |       DOM_INT               :: ntnode,ntdim
  24 |       DOM_INT               :: ntelem,nlen,nvert  
  25 |       DOM_INT, DIMENSION(8) :: gambit_type
  26 | 
  27 |       gambit_meshfile = meshfile
  28 | 
  29 |       CALL readmsh 
  30 | 
  31 |       ntnode = NUMNP  
  32 |       ntdim  = NDFCD
  33 | 
  34 |       IF(allocated(geometry_coor)) deallocate(geometry_coor)
  35 |       ALLOCATE(geometry_coor(ntnode,3))
  36 | 
  37 | !     -------------!
  38 | !     3D treatment !
  39 | !     -------------!
  40 |       DO i_node=1,ntnode
  41 |         DO k=1,ntdim
  42 |           geometry_coor(i_node,k) = X(k,i_node)
  43 |         ENDDO
  44 |       ENDDO
  45 | 
  46 | !     -------------!
  47 | !     2D treatment !
  48 | !     -------------!
  49 |       IF (ntdim.eq.2) THEN 
  50 |         geometry_coor(:,3)=0.
  51 |       ENDIF
  52 | 
  53 |       nfile = len_trim(ensight_geometryfile)
  54 |       write(*,*) ' >>>> Writing geom to ', ensight_geometryfile(1:nfile)
  55 | 
  56 |         call ensightgold_write_geocoor_bin(ensight_geometryfile,nfile,  &
  57 |      &     ntnode,geometry_coor(:,1),                                   &
  58 |      &            geometry_coor(:,2),                                   &
  59 |      &            geometry_coor(:,3))
  60 | 
  61 | !     ------------------------!
  62 | !     Loop over element types !
  63 | !     ------------------------!
  64 |       gambit_type(1) = 3
  65 |       gambit_type(2) = 2
  66 |       gambit_type(3) = 6
  67 |       gambit_type(4) = 7
  68 |       gambit_type(5) = 5
  69 |       gambit_type(6) = 0 
  70 |       gambit_type(7) = 0
  71 |       gambit_type(8) = 0
  72 | 
  73 |       IF (ALLOCATED(int_buf_array)) DEALLOCATE(int_buf_array)
  74 |       ALLOCATE (int_buf_array(NDP_MAX*NELEM))
  75 |  
  76 |       DO i_type = 1,geometry_maxtype
  77 |         nlen   = 0 
  78 |         ntelem = 0
  79 |         docall = 0
  80 |         l      = 0
  81 |  
  82 |         DO i_el = 1,NELEM
  83 | 
  84 |           IF (NTYPE(i_el).eq.gambit_type(i_type)) THEN
  85 |             
  86 |             DO k = 1,NDP(i_el) 
  87 |               l = l + 1
  88 |               int_buf_array(l) = NODE(k,i_el)
  89 |               docall=1
  90 |             ENDDO 
  91 | 
  92 |             nlen  = nlen + 1
  93 |             nvert = NDP(i_el)
  94 | 
  95 |           ENDIF
  96 | 
  97 |         ENDDO
  98 | 
  99 |         ntelem = nlen * nvert
 100 |             
 101 |         IF(docall.eq.1) THEN
 102 |  
 103 |             lenofchar = len_trim(geometry_eltype(i_type))
 104 | 
 105 |             call ensightgold_write_geoelt_bin(ensight_geometryfile,     &
 106 |      &           nfile,geometry_eltype(i_type),lenofchar,               &
 107 |      &           nvert,nlen,int_buf_array(1:ntelem))
 108 |           ENDIF
 109 | 
 110 |         ENDDO
 111 |     
 112 |       IF(ALLOCATED(geometry_coor)) DEALLOCATE(geometry_coor)
 113 |       
 114 |       END SUBROUTINE creategeometry_gambit


creategeometry_gambit.F could be called by:
Makefile [TOOLS/VISU] - 69
visual_ensight.F [TOOLS/VISU/SRC] - 276