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