1 !************************************************************************* 2 ! COPYRIGHT (C) 1999 - 2007 EDF R&D, CEA/DEN 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 : test17.f90 21 ! * 22 ! * - Description : lecture d'elements de maillages MED ecrits par test16 23 ! * via les routines de niveau 2 24 ! * - equivalent a test17.f90 25 ! * 26 ! ****************************************************************************** 27 28 program test17 29 30 implicit none 31 include 'med.hf' 32 33 integer :: cret,ret, fid, nse2, mdim 34 integer, allocatable, dimension(:) ::se2 35 character*16, allocatable, dimension(:) ::nomse2 36 integer, allocatable, dimension(:) ::numse2,nufase2 37 integer ntr3 38 integer, allocatable, dimension(:) ::tr3 39 character*16, allocatable, dimension(:) ::nomtr3 40 integer, allocatable, dimension(:) ::numtr3 41 integer, allocatable, dimension(:) ::nufatr3 42 character*32 :: maa = "maa1" 43 character*200 :: desc 44 logical :: inoele1,inuele1,inoele2,inuele2 45 integer tse2,ttr3 46 integer i,type 47 48 ! ** Ouverture du fichier test16.med en lecture seule ** 49 call efouvr(fid,'test16.med',MED_LECTURE, cret) 50 print *,cret 51 52 ! ** Lecture des informations sur le 1er maillage ** 53 if (cret.eq.0) then 54 call efmaai(fid,1,maa,mdim,type,desc,cret) 55 print *,"Maillage de nom : ",maa," et de dimension ",mdim 56 endif 57 print *,cret 58 59 ! ** Lecture du nombre de triangles et de segments ** 60 if (cret.eq.0) then 61 call efnema(fid,maa,MED_CONN,MED_ARETE,MED_SEG2,MED_DESC,nse2,cret) 62 endif 63 print *,cret 64 65 if (cret.eq.0) then 66 call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_TRIA3,MED_DESC,ntr3,cret) 67 endif 68 print *,cret 69 70 print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3 71 72 ! ** Allocations memoire ** 73 tse2 = 2; 74 allocate(se2(tse2*nse2),nomse2(nse2),numse2(nse2),nufase2(nse2),STAT=ret) 75 ttr3 = 3; 76 allocate(tr3(ntr3*ttr3),nomtr3(ntr3),numtr3(ntr3),nufatr3(ntr3),STAT=ret) 77 78 ! ** Lecture des aretes segments MED_SEG2 : 79 ! - Connectivite, 80 ! - Noms (optionnel) 81 ! - Numeros (optionnel) 82 ! - Numeros de familles ** 83 if (cret.eq.0) then 84 call efelel(fid,maa,mdim,se2,MED_NO_INTERLACE,nomse2,inoele1,numse2,inuele1, & 85 & nufase2,nse2,MED_ARETE,MED_SEG2,MED_DESC,cret) 86 endif 87 print *,cret 88 89 90 ! ** lecture des mailles triangles MED_TRIA3 : 91 ! - Connectivite, 92 ! - Noms (optionnel) 93 ! - Numeros (optionnel) 94 ! - Numeros de familles ** 95 if (cret.eq.0) then 96 call efelel(fid,maa,mdim,tr3,MED_NO_INTERLACE,nomtr3,inoele2,numtr3,inuele2, & 97 & nufatr3,ntr3,MED_MAILLE,MED_TRIA3,MED_DESC,cret) 98 endif 99 print *,cret 100 101 ! ** Fermeture du fichier ** 102 call efferm (fid,cret) 103 print *,cret 104 105 ! ** Affichage ** 106 if (cret.eq.0) then 107 print *,"Connectivite des segments : ",nse2 108 109 if (inoele1) then 110 print *,"Noms des segments : ",nomse2 111 endif 112 113 if (inuele1) then 114 print *,"Numeros des segments : ",numse2 115 endif 116 117 print *,"Numeros des familles des segments : ",nufase2 118 119 120 print *,"Connectivite des triangles : ",tr3 121 122 if (inoele2) then 123 print *,"Noms des triangles :", nomtr3 124 endif 125 126 if (inuele2) then 127 print *,"Numeros des triangles :", numtr3 128 endif 129 130 print *,"Numeros des familles des triangles :", nufatr3 131 132 end if 133 134 135 ! ** Nettoyage memoire ** 136 deallocate(se2,nomse2,numse2,nufase2); 137 deallocate(tr3,nomtr3,numtr3,nufatr3); 138 139 ! ** Code retour 140 call efexit(cret) 141 142 end program test17