# 2.3.6/test13.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2011  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