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