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.hf90'
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 

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