2.3.6/test13.f90

Aller à la documentation de ce fichier.
00001 !*  This file is part of MED.
00002 !*
00003 !*  COPYRIGHT (C) 1999 - 2015  EDF R&D, CEA/DEN
00004 !*  MED is free software: you can redistribute it and/or modify
00005 !*  it under the terms of the GNU Lesser General Public License as published by
00006 !*  the Free Software Foundation, either version 3 of the License, or
00007 !*  (at your option) any later version.
00008 !*
00009 !*  MED is distributed in the hope that it will be useful,
00010 !*  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 !*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012 !*  GNU Lesser General Public License for more details.
00013 !*
00014 !*  You should have received a copy of the GNU Lesser General Public License
00015 !*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
00016 !*
00017 
00018 ! ******************************************************************************
00019 ! * - Nom du fichier : test13.f90
00020 ! *
00021 ! * - Description : lecture des equivalences dans un maillage MED.
00022 ! *
00023 ! ******************************************************************************
00024 
00025 program test13
00026   
00027   implicit none
00028   include 'med.hf'
00029 !
00030 !
00031   integer      ret,cret,fid
00032   character*32 maa
00033   integer      mdim,nequ,ncor
00034   integer, allocatable, dimension(:) :: cor
00035   character*32  equ
00036   character*200 des
00037   integer       i,j,k
00038   character*255 argc
00039   integer, parameter :: MED_NBR_MAILLE_EQU = 8
00040   integer,parameter  :: typmai(MED_NBR_MAILLE_EQU) =  (/ MED_POINT1,MED_SEG2,   
00041                                                         MED_SEG3,MED_TRIA3,    &
00042                                                         MED_TRIA6,MED_QUAD4,   &
00043                                                         MED_QUAD8,MED_POLYGONE/)
00044 
00045    integer,parameter :: typfac(MED_NBR_GEOMETRIE_FACE+1) = (/MED_TRIA3,MED_TRIA6,       
00046                                                  MED_QUAD4,MED_QUAD8, MED_POLYGONE/)
00047    integer,parameter ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,MED_SEG3/)
00048    character*200 desc
00049    integer type
00050  
00051    print *,"Indiquez le fichier med a decrire : "
00052    !!read(*,*) argc
00053    argc = "test12.med"
00054 
00055    !  ** Ouverture du fichier en lecture seule **
00056    call efouvr(fid,argc,MED_LECTURE, cret)
00057    print *,cret
00058    
00059      
00060    !  ** Lecture des infos sur le premier maillage **
00061    if (cret.eq.0) then
00062       call efmaai(fid,1,maa,mdim,type,desc,cret)
00063       print *,"Maillage de nom : ",maa," et de dimension : ", mdim
00064    endif
00065    print *,cret
00066 
00067 
00068    !  ** Lecture du nombre d'equivalence  **
00069    if (cret.eq.0) then
00070       call efnequ(fid,maa,nequ,cret)
00071       if (cret.eq.0) then
00072          print *,"Nombre d'equivalences : ",nequ
00073       endif
00074    endif
00075  
00076    !** Lecture de toutes les equivalences **
00077    if (cret.eq.0) then
00078       do i=1,nequ
00079          print *,"Equivalence numero : ",i
00080          !** Lecture des infos sur l'equivalence **
00081          if (cret.eq.0) then
00082             call efequi(fid,maa,i,equ,des,cret)
00083          endif
00084          print *,cret
00085          if (cret.eq.0) then
00086             print *,"Nom de l'equivalence : ",equ          
00087             print *,"Description de l'equivalence : ",des 
00088          endif
00089 
00090          !** Lecture des correspondances sur les differents types d'entites **
00091          if (cret.eq.0) then
00092             !** Les noeuds **
00093             call efncor(fid,maa,equ,MED_NOEUD,0,ncor,cret)
00094             print *,"Il y a ",ncor," correspondances sur les noeuds "
00095             if (ncor > 0) then
00096                allocate(cor(ncor*2),STAT=ret)
00097                call efequl(fid,maa,equ,cor,ncor,MED_NOEUD,0,cret)
00098                do j=0,(ncor-1)
00099                   print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
00100                end do
00101                deallocate(cor)
00102             end if
00103             
00104             !** Les mailles : on ne prend pas en compte les mailles 3D **
00105 
00106             do j=1,MED_NBR_MAILLE_EQU
00107                call efncor(fid,maa,equ,MED_MAILLE,typmai(j),ncor,cret)
00108                print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
00109                if (ncor > 0 ) then
00110                   allocate(cor(2*ncor),STAT=ret)
00111                   call efequl(fid,maa,equ,cor,ncor,MED_MAILLE,typmai(j),cret)
00112                   do k=0,(ncor-1)
00113                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00114                   end do
00115                   deallocate(cor)
00116                endif
00117             end do
00118 
00119             ! ** Les faces **
00120             do j=1,MED_NBR_GEOMETRIE_FACE+1
00121                call efncor(fid,maa,equ,MED_FACE,typfac(j),ncor,cret)
00122                print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
00123                if (ncor > 0 ) then
00124                   allocate(cor(2*ncor),STAT=ret)
00125                   call efequl(fid,maa,equ,cor,ncor,MED_FACE,typfac(j),cret)
00126                   do k=0,(ncor-1)
00127                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00128                   end do
00129                   deallocate(cor)
00130                endif
00131             end do
00132 
00133             ! **  Les aretes **
00134             do j=1,MED_NBR_GEOMETRIE_ARETE
00135                call efncor(fid,maa,equ,MED_ARETE,typare(j),ncor,cret)
00136                print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
00137                if (ncor > 0 ) then
00138                   allocate(cor(2*ncor),STAT=ret)
00139                   call efequl(fid,maa,equ,cor,ncor,MED_ARETE,typare(j),cret)
00140                   do k=0,(ncor-1)
00141                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00142                   end do
00143                   deallocate(cor)
00144                endif
00145             end do
00146 
00147          end if
00148       end do
00149    end if
00150 
00151 !  ** Fermeture du fichier   **
00152    call efferm (fid,cret)
00153    print *,cret
00154 
00155 !  ** Code retour
00156    call efexit(cret)
00157    
00158  end program test13
00159         
00160 
00161 
00162 
00163 

Généré le Thu Oct 8 14:26:17 2015 pour MED fichier par  doxygen 1.6.1