# 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*64 maa
    00033   integer      mdim,nequ,ncor,sdim
    00034   integer, allocatable, dimension(:) :: cor
    00035   character*64  equ
    00036   character*200 desc,des
    00037   integer       i,j,k
    00038   character*255 argc
    00039   integer,parameter :: MY_NOF_DESCENDING_FACE_TYPE =  5
    00040   integer,parameter :: MY_NOF_DESCENDING_EDGE_TYPE =  2
    00041
    00042
    00043   integer, parameter :: MED_NBR_MAILLE_EQU = 8
    00044   integer,parameter  :: typmai(MED_NBR_MAILLE_EQU) =  (/ MED_POINT1,MED_SEG2,
    00045                                                         MED_SEG3,MED_TRIA3,    &
    00046                                                         MED_TRIA6,MED_QUAD4,   &
    00047                                                         MED_QUAD8,MED_POLYGON/)
    00048
    00049    integer,parameter :: typfac(MY_NOF_DESCENDING_FACE_TYPE) = (/MED_TRIA3,MED_TRIA6,
    00050                                                  MED_QUAD4,MED_QUAD8, MED_POLYGON/)
    00051    integer,parameter ::typare(MY_NOF_DESCENDING_EDGE_TYPE) = (/MED_SEG2,MED_SEG3/)
    00052    integer type
    00053    character(16)  :: dtunit
    00054    integer nstep, stype, atype
    00055    character*16 nomcoo(3)
    00056    character*16 unicoo(3)
    00057    integer nctcor,nstepc
    00058
    00059
    00060    !  ** Ouverture du fichier en lecture seule **
    00061    call mfiope(fid,'test12.med',MED_ACC_RDONLY, cret)
    00062    print *,cret
    00063
    00064
    00065    !  ** Lecture des infos sur le premier maillage **
    00066    if (cret.eq.0) then
    00067       call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
    00068       print *,"Maillage de nom : ",maa," et de dimension : ", mdim
    00069    endif
    00070    print *,cret
    00071
    00072
    00073    !  ** Lecture du nombre d'equivalence  **
    00074    if (cret.eq.0) then
    00075       call meqneq(fid,maa,nequ,cret)
    00076       if (cret.eq.0) then
    00077          print *,"Nombre d'equivalence : ",nequ
    00078       endif
    00079    endif
    00080
    00081
    00082    !** Lecture de toutes les equivalences **
    00083    if (cret.eq.0) then
    00084       do i=1,nequ
    00085          print *,"Equivalence numero : ",i
    00086          !** Lecture des infos sur l'equivalence **
    00087          if (cret.eq.0) then
    00088             call meqeqi(fid,maa,i,equ,des,nstepc,nctcor,cret)
    00089          endif
    00090          print *,cret
    00091          if (cret.eq.0) then
    00092             print *,"Nom de l'equivalence : ",equ
    00093             print *,"Description de l'equivalence : ",des
    00094             print *,"Nombre de pas de temps sur l'equivalence : ",nstepc
    00095             print *,"Nombre de correspondance sur MED_NO_IT, MED_NO_DT : ", nctcor
    00096          endif
    00097
    00098          !** Lecture des correspondances sur les differents types d'entites **
    00099          if (cret.eq.0) then
    00100             !** Les noeuds **
    00101             call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,ncor,cret)
    00102             print *,cret
    00103             print *,"Il y a ",ncor," correspondances sur les noeuds "
    00104             if (ncor > 0) then
    00105                allocate(cor(ncor*2),STAT=ret)
    00106                call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,cor,cret)
    00107                do j=0,(ncor-1)
    00108                   print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
    00109                end do
    00110                deallocate(cor)
    00111             end if
    00112
    00113 !!$         !** Les mailles : on ne prend pas en compte les mailles 3D **
    00114
    00115             do j=1,MED_NBR_MAILLE_EQU
    00116                call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_CELL,typmai(j),ncor,cret)
    00117                print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
    00118                if (ncor > 0 ) then
    00119                   allocate(cor(2*ncor),STAT=ret)
    00120                   call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_CELL,typmai(j),cor,cret)
    00121                   do k=0,(ncor-1)
    00122                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
    00123                   end do
    00124                   deallocate(cor)
    00125                endif
    00126             end do
    00127
    00128 !!$         ! ** Les faces **
    00129             do j=1,MY_NOF_DESCENDING_FACE_TYPE
    00130                call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_FACE,typmai(j),ncor,cret)
    00131                print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
    00132                if (ncor > 0 ) then
    00133                   allocate(cor(2*ncor),STAT=ret)
    00134                   call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_FACE,typfac(j),cor,cret)
    00135                   do k=0,(ncor-1)
    00136                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
    00137                   end do
    00138                   deallocate(cor)
    00139                endif
    00140             end do
    00141
    00142 !!$         ! **  Les aretes **
    00143             do j=1,MY_NOF_DESCENDING_EDGE_TYPE
    00144                call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,typare(j),ncor,cret)
    00145                print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
    00146                if (ncor > 0 ) then
    00147                   allocate(cor(2*ncor),STAT=ret)
    00148                   call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,typare(j),cor,cret)
    00149                   do k=0,(ncor-1)
    00150                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
    00151                   end do
    00152                   deallocate(cor)
    00153                endif
    00154             end do
    00155
    00156          end if
    00157       end do
    00158    end if
    00159
    00160 !  ** Fermeture du fichier   **
    00161    call mficlo(fid,cret)
    00162    print *,cret
    00163
    00164 !  ** Code retour
    00165    call efexit(cret)
    00166
    00167  end program test13
    00168
    00169
    00170
    00171
    00172