      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