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 : 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, 62 & nse2,cret) 63 endif 64 print *,cret 65 66 if (cret.eq.0) then 67 call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_TRIA3,MED_DESC, 68 & ntr3,cret) 69 endif 70 print *,cret 71 72 print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3 73 74 ! ** Allocations memoire ** 75 tse2 = 2; 76 allocate(se2(tse2*nse2),nomse2(nse2),numse2(nse2),nufase2(nse2),STAT=ret) 77 ttr3 = 3; 78 allocate(tr3(ntr3*ttr3),nomtr3(ntr3),numtr3(ntr3),nufatr3(ntr3),STAT=ret) 79 80 ! ** Lecture des aretes segments MED_SEG2 : 81 ! - Connectivite, 82 ! - Noms (optionnel) 83 ! - Numeros (optionnel) 84 ! - Numeros de familles ** 85 if (cret.eq.0) then 86 call efelel(fid,maa,mdim,se2,MED_NO_INTERLACE,nomse2,inoele1 87 & ,numse2,inuele1, 88 & nufase2,nse2,MED_ARETE,MED_SEG2,MED_DESC,cret) 89 endif 90 print *,cret 91 92 93 ! ** lecture des mailles triangles MED_TRIA3 : 94 ! - Connectivite, 95 ! - Noms (optionnel) 96 ! - Numeros (optionnel) 97 ! - Numeros de familles ** 98 if (cret.eq.0) then 99 call efelel(fid,maa,mdim,tr3,MED_NO_INTERLACE,nomtr3,inoele2 100 & ,numtr3,inuele2, 101 & nufatr3,ntr3,MED_MAILLE,MED_TRIA3,MED_DESC,cret) 102 endif 103 print *,cret 104 105 ! ** Fermeture du fichier ** 106 call efferm (fid,cret) 107 print *,cret 108 109 ! ** Affichage ** 110 if (cret.eq.0) then 111 print *,"Connectivite des segments : ",nse2 112 113 if (inoele1) then 114 print *,"Noms des segments : ",nomse2 115 endif 116 117 if (inuele1) then 118 print *,"Numeros des segments : ",numse2 119 endif 120 121 print *,"Numeros des familles des segments : ",nufase2 122 123 print *,"Connectivite des triangles : ",tr3 124 125 if (inoele2) then 126 print *,"Noms des triangles :", nomtr3 127 endif 128 129 if (inuele2) then 130 print *,"Numeros des triangles :", numtr3 131 endif 132 133 print *,"Numeros des familles des triangles :", nufatr3 134 135 end if 136 137 138 ! ** Nettoyage memoire ** 139 deallocate(se2,nomse2,numse2,nufase2); 140 deallocate(tr3,nomtr3,numtr3,nufatr3); 141 142 end program test17