      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