READ_DIME_FILEMESH.f90

Go to the documentation of this file.

!    Copyright (C) 2012 The SPEED FOUNDATION
!    Author: Ilario Mazzieri
!
!    This file is part of SPEED.
!
!    SPEED is free software; you can redistribute it and/or modify it
!    under the terms of the GNU Affero General Public License as
!    published by the Free Software Foundation, either version 3 of the
!    License, or (at your option) any later version.
!
!    SPEED 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
!    Affero General Public License for more details.
!
!    You should have received a copy of the GNU Affero General Public License
!    along with SPEED.  If not, see <http://www.gnu.org/licenses/>.
 
 
 
 
      subroutine read_dime_filemesh(gridfile,nb_mate,lab_mate,&
                           nb_diriX,lab_diriX,nb_diriY,lab_diriY,nb_diriZ,lab_diriZ,&
                           nb_neuX,lab_neuX,nb_neuY,lab_neuY,nb_neuZ,lab_neuZ,&
                           nb_neuN,lab_neuN, & 
                           nb_abc,lab_abc,&
                           nb_dg,lab_dg,&
                           nb_node,nb_hexa,nb_quad)
      
 
      implicit none
      
      character*70 :: gridfile
      character*80 :: inline
      character*20 :: el_code
 
      integer*4 :: nb_mate,nb_diriX,nb_diriY,nb_diriZ,nb_neuX,nb_neuY,nb_neuZ,nb_abc,nb_dg
      integer*4 :: nb_neuN 
      integer*4 :: nb_elem,ie,i,mat_code,ileft,iright,sl,trash,status,control
 
      integer*4, dimension(nb_mate) :: lab_mate
 
      integer*4, dimension(nb_diriX) :: lab_diriX
      integer*4, dimension(nb_diriY) :: lab_diriY
      integer*4, dimension(nb_diriZ) :: lab_diriZ
      integer*4, dimension(nb_neuX) :: lab_neuX
      integer*4, dimension(nb_neuY) :: lab_neuY
      integer*4, dimension(nb_neuZ) :: lab_neuZ
      integer*4, dimension(nb_neuN) :: lab_neuN
      integer*4, dimension(nb_abc) :: lab_abc
      integer*4, dimension(nb_dg) :: lab_dg
      integer*4 :: nb_node,nb_hexa,nb_quad
      
      
      nb_node = 0;  nb_hexa = 0;  nb_quad = 0
      
      open(40,file=gridfile)
      
      do 
         read(40,'(A)') inline
         if (inline(1:1) .ne. '#') exit
      enddo
      
      read(inline,*)nb_node,nb_elem
      
      do i = 1,nb_node
         read(40,'(A)')inline
      enddo
      
      do ie = 1,nb_elem
         read(40,'(A)')inline
         
         sl = len(inline)
         ileft = 0
         iright = 0 
         do i = 1,sl
            if (inline(i:i).ge.'A') exit
         enddo
         ileft = i
         do i = ileft,sl
            if (inline(i:i).lt.'A') exit
         enddo
         iright = i
         
         el_code = inline(ileft:iright)
         
         read(inline(1:ileft),*)trash,mat_code
         
         if ((el_code.eq.'hex').or.(el_code.eq.'HEX')) then
            control = 0
            do i = 1,nb_mate
               if (lab_mate(i).eq.mat_code) control = 1
            enddo
            !
            if (control.ne.0) nb_hexa = nb_hexa +1
         !
         elseif ((el_code.eq.'quad').or.(el_code.eq.'QUAD')) then
            control = 0
            do i = 1,nb_dirix
               if (lab_dirix(i).eq.mat_code) control = 1
            enddo
            do i = 1,nb_diriy
               if (lab_diriy(i).eq.mat_code) control = 1
            enddo
            do i = 1,nb_diriz
               if (lab_diriz(i).eq.mat_code) control = 1
            enddo
            do i = 1,nb_neux
               if (lab_neux(i).eq.mat_code) control = 1
            enddo
            do i = 1,nb_neuy
               if (lab_neuy(i).eq.mat_code) control = 1
            enddo
            do i = 1,nb_neuz
               if (lab_neuz(i).eq.mat_code) control = 1
            enddo
            do i = 1,nb_neun                                                        
               if (lab_neun(i).eq.mat_code) control = 1                                
            enddo                                                                
            do i = 1,nb_abc
               if (lab_abc(i).eq.mat_code) control = 1
            enddo
            do i = 1,nb_dg
               if (lab_dg(i).eq.mat_code) control = 1
            enddo
            
 
            if (control.ne.0) nb_quad = nb_quad +1
         endif
      enddo
      
      close(40)
      
      return
      end subroutine read_dime_filemesh