      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 : test7.f90
     21  ! *
     22  ! * - Description : lecture des elements du maillage MED ecrits par test6
     23  ! *
     24  ! ******************************************************************************
     25        program test7
     26
     27        implicit none
     28        include 'med.hf'
     29  !
     30  !
     31        integer cret, ret, fid
     32
     33        integer nse2
     34        integer,     allocatable, dimension (:) :: se2
     35        character*16, allocatable, dimension (:) :: nomse2
     36        integer,     allocatable, dimension (:) :: numse2,nufase2
     37
     38        integer ntr3
     39        integer,     allocatable, dimension (:) :: tr3
     40        character*16, allocatable, dimension (:) :: nomtr3
     41        integer,     allocatable, dimension (:) :: numtr3,nufatr3
     42
     43  !     ** nom du maillage de longueur maxi MED_TAILLE_NOM    **
     44        character*32  :: maa  = "maa1"
     45        character*200 :: desc
     46        integer       :: mdim
     47        logical inoele,inuele
     48        integer, parameter :: profil (2) = (/ 2,3 /)
     49        integer type
     50        integer tse2,ttr3, i
     51
     52  !   ** Ouverture du fichier test6.med en lecture seule       **
     53        call efouvr(fid,'test6.med',MED_LECTURE, cret)
     54        print *,cret
     55
     56  !   ** Lecture des infos concernant le premier maillage      **
     57        if (cret.eq.0) then
     58           call efmaai(fid,1,maa,mdim,type,desc,cret)
     59           print *,"Maillage de nom : ",maa," et de dimension :", mdim
     60        endif
     61        print *,cret
     62
     63  !   ** Combien de segments et de triangles                   **
     64        if (cret.eq.0) then
     65           nse2 = 0
     66           call efnema(fid,maa,MED_CONN,MED_ARETE,MED_SEG2,MED_DESC,        &
     67       &        nse2,cret)
     68        endif
     69        print *,cret
     70
     71        if (cret.eq.0) then
     72           ntr3 = 0
     73           call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_TRIA3,MED_DESC,        &
     74       &        ntr3,cret)
     75        endif
     76        print *,cret
     77
     78        if (cret.eq.0) then
     79           print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 "
     80       &            ,ntr3
     81        endif
     82
     83  !   ** Allocations memoire                                 **
     84        tse2 = 2
     85        allocate (se2(tse2*nse2),nomse2(nse2),numse2(nse2),nufase2(nse2),
     86       &          STAT=ret )
     87  !     print *,ret
     88
     89        ttr3 = 3
     90        allocate (tr3(ntr3*ttr3),nomtr3(ntr3),numtr3(ntr3),nufatr3(ntr3),
     91       &           STAT=ret )
     92  !     print *,ret
     93
     94
     95  !   ** Lecture de la connectivite des segments avec profil           **
     96        if (cret.eq.0) then
     97           call efconl(fid,maa,mdim,se2,MED_NO_INTERLACE,profil,2,MED_ARETE, &
     98       &               MED_SEG2,MED_DESC,cret)
     99        endif
    100        print *,cret
    101        print *,se2
    102
    103  !   ** Lecture (optionnelle) des noms des segments         **
    104        if (cret.eq.0) then
    105           call efnoml(fid,maa,nomse2,nse2,MED_ARETE,         &
    106       &               MED_SEG2,ret)
    107        endif
    108
    109        if (ret <0) then
    110           inoele = .FALSE.
    111        else
    112           inoele = .TRUE.
    113        endif
    114
    115  !  ** Lecture (optionnelle) des numeros des segments       **
    116        if (cret.eq.0) then
    117           call efnuml(fid,maa,numse2,nse2,MED_ARETE,MED_SEG2,ret)
    118        endif
    119
    120        if (ret <0) then
    121          inuele = .FALSE.
    122        else
    123          inuele = .TRUE.
    124        endif
    125
    126  !  ** Lecture des numeros des familles des segments         **
    127        if (cret.eq.0) then
    128           call effaml(fid,maa,nufase2,nse2,MED_ARETE,MED_SEG2,cret)
    129        endif
    130        print *,cret
    131
    132  !  ** Lecture de la connectivite des triangles sans profil **
    133        if (cret.eq.0) then
    134           call efconl(fid,maa,mdim,tr3,MED_NO_INTERLACE,profil,0,MED_MAILLE, &
    135       &               MED_TRIA3,MED_DESC,cret)
    136        endif
    137        print *,cret
    138
    139  !  ** Lecture (optionnelle) des noms des triangles          **
    140        if (cret.eq.0) then
    141           call efnoml(fid,maa,nomtr3,ntr3,MED_MAILLE,         &
    142       &               MED_TRIA3,ret)
    143        endif
    144
    145        if (ret <0) then
    146           inoele = .FALSE.
    147        else
    148           inoele = .TRUE.
    149        endif
    150        print *,cret
    151
    152  !  ** Lecture (optionnelle) des numeros des segments       **
    153        if (cret.eq.0) then
    154           call efnuml(fid,maa,numtr3,ntr3,MED_MAILLE,MED_TRIA3,ret)
    155        endif
    156
    157        if (ret <0) then
    158          inuele = .FALSE.
    159        else
    160          inuele = .TRUE.
    161        endif
    162        print *,cret
    163
    164  !  ** Lecture des numeros des familles des segments         **
    165        if (cret.eq.0) then
    166           call effaml(fid,maa,nufatr3,ntr3,MED_MAILLE,MED_TRIA3,cret)
    167        endif
    168        print *,cret
    169
    170  !  ** Fermeture du fichier                                           **
    171        call efferm (fid,cret)
    172        print *,cret
    173
    174  !  ** Affichage des resulats                                         **
    175        if (cret.eq.0) then
    176
    177          print *,"Connectivite des segments : "
    178          print *, se2
    179
    180          if (inoele) then
    181             print *,"Noms des segments :"
    182             print *,nomse2
    183          endif
    184
    185          if (inuele) then
    186             print *,"Numeros des segments :"
    187             print *,numse2
    188          endif
    189
    190          print *,"Numeros des familles des segments :"
    191          print *,nufase2
    192
    193          print *,"Connectivite des triangles :"
    194          print *,tr3
    195
    196          if (inoele) then
    197             print *,"Noms des triangles :"
    198             print *,nomtr3
    199          endif
    200
    201          if (inuele) then
    202             print *,"Numeros des triangles :"
    203             print *,numtr3
    204          endif
    205
    206          print *,"Numeros des familles des triangles :"
    207          print *,nufatr3
    208
    209        endif
    210
    211  !  ** Nettoyage memoire                                          **
    212        deallocate (se2,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
    213
    214        end program test7
    215