1 !************************************************************************* 2 ! COPYRIGHT (C) 1999 - 2003 EDF R&D 3 ! THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY 4 ! IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 5 ! AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 6 ! EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. 7 ! 8 ! THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT 9 ! WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF 10 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU 11 ! LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. 12 ! 13 ! YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE 14 ! ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION, 15 ! INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA 16 ! 17 !************************************************************************** 18 19 ! ****************************************************************************** 20 ! * - Nom du fichier : test13.f90 21 ! * 22 ! * - Description : lecture des equivalences dans un maillage MED. 23 ! * 24 ! ****************************************************************************** 25 26 program test13 27 28 implicit none 29 include 'med.hf' 30 ! 31 ! 32 integer ret,cret,fid 33 character*32 maa 34 integer mdim,nequ,ncor 35 integer, allocatable, dimension(:) :: cor 36 character*32 equ 37 character*200 des 38 integer i,j,k 39 character*255 argc 40 integer, parameter :: MED_NBR_MAILLE_EQU = 8 41 integer,parameter :: typmai(MED_NBR_MAILLE_EQU) = 42 & (/ MED_POINT1,MED_SEG2, & 43 & MED_SEG3,MED_TRIA3, & 44 & MED_TRIA6,MED_QUAD4, & 45 & MED_QUAD8,MED_POLYGONE/) 46 47 integer,parameter :: typfac(MED_NBR_GEOMETRIE_FACE+1) = & 48 & (/MED_TRIA3,MED_TRIA6, & 49 & MED_QUAD4,MED_QUAD8, MED_POLYGONE/) 50 integer,parameter ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,& 51 & MED_SEG3/) 52 character*200 desc 53 integer type 54 55 print *,'Indiquez le fichier med a decrire : ' 56 read(*,*) argc 57 58 ! ** Ouverture du fichier en lecture seule ** 59 call efouvr(fid,argc,MED_LECTURE, cret) 60 print *,cret 61 62 63 ! ** Lecture des infos sur le premier maillage ** 64 if (cret.eq.0) then 65 call efmaai(fid,1,maa,mdim,type,desc,cret) 66 print *,"Maillage de nom : ",maa," et de dimension : ", mdim 67 endif 68 print *,cret 69 70 71 ! ** Lecture du nombre d'equivalence ** 72 if (cret.eq.0) then 73 call efnequ(fid,maa,nequ,cret) 74 if (cret.eq.0) then 75 print *,"Nombre d'equivalences : ",nequ 76 endif 77 endif 78 79 !** Lecture de toutes les equivalences ** 80 if (cret.eq.0) then 81 do i=1,nequ 82 print *,"Equivalence numero : ",i 83 ! ** Lecture des infos sur l'equivalence ** 84 if (cret.eq.0) then 85 call efequi(fid,maa,i,equ,des,cret) 86 endif 87 print *,cret 88 if (cret.eq.0) then 89 print *,"Nom de l'equivalence : ",equ 90 print *,"Description de l'equivalence : ",des 91 endif 92 93 !** Lecture des correspondances sur les differents types d'entites ** 94 if (cret.eq.0) then 95 !** Les noeuds ** 96 call efncor(fid,maa,equ,MED_NOEUD,0,ncor,cret) 97 print *,"Il y a ",ncor 98 print "correspondances sur les noeuds " 99 if (ncor > 0) then 100 allocate(cor(ncor*2),STAT=ret) 101 call efequl(fid,maa,equ,cor,ncor,MED_NOEUD,0,cret) 102 do j=0,(ncor-1) 103 print *,"Correspondance ",j+1," : ", 104 print *,cor(2*j+1)," et ",cor(2*j+2) 105 end do 106 deallocate(cor) 107 end if 108 109 !** Les mailles : on ne prend pas en compte les mailles 3D ** 110 111 do j=1,MED_NBR_MAILLE_EQU 112 call efncor(fid,maa,equ,MED_MAILLE,typmai(j), & 113 & ncor,cret) 114 print *,"Il y a ",ncor," correspondances sur" 115 print *," les mailles ",typmai(j) 116 if (ncor > 0 ) then 117 allocate(cor(2*ncor),STAT=ret) 118 call efequl(fid,maa,equ,cor,ncor,& 119 & MED_MAILLE,typmai(j),cret) 120 do k=0,(ncor-1) 121 print *,"Correspondance ",k+1," : ", 122 print *,cor(2*k+1)," et ",cor(2*k+2) 123 end do 124 deallocate(cor) 125 endif 126 end do 127 128 ! ** Les faces ** 129 do j=1,MED_NBR_GEOMETRIE_FACE+1 130 call efncor(fid,maa,equ,MED_FACE,typfac(j), & 131 & ncor,cret) 132 print *,"Il y a ",ncor," correspondances sur " 133 print *,"les faces ",typfac(j) 134 if (ncor > 0 ) then 135 allocate(cor(2*ncor),STAT=ret) 136 call efequl(fid,maa,equ,cor,ncor,MED_FACE, & 137 & typfac(j),cret) 138 do k=0,(ncor-1) 139 print *,"Correspondance ",k+1," : " 140 print *,cor(2*k+1)," et ",cor(2*k+2) 141 end do 142 deallocate(cor) 143 endif 144 end do 145 146 ! ** Les aretes ** 147 do j=1,MED_NBR_GEOMETRIE_ARETE 148 call efncor(fid,maa,equ,MED_ARETE,typare(j), & 149 & ncor,cret) 150 print *,"Il y a ",ncor 151 print *," correspondances sur les aretes " 152 print *,typare(j) 153 if (ncor > 0 ) then 154 allocate(cor(2*ncor),STAT=ret) 155 call efequl(fid,maa,equ,cor,ncor,MED_ARETE, & 156 & typare(j),cret) 157 do k=0,(ncor-1) 158 print *,"Correspondance ",k+1," : ", 159 print *,cor(2*k+1)," et ",cor(2*k+2) 160 end do 161 deallocate(cor) 162 endif 163 end do 164 165 end if 166 end do 167 end if 168 169 ! ** Fermeture du fichier ** 170 call efferm (fid,cret) 171 print *,cret 172 173 end program test13 174 175 176