      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 : 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 : ",ntr3
     80       endif
     81
     82 !   ** Allocations memoire                                 **
     83       tse2 = 2
     84       allocate ( se2(tse2*nse2), nomse2(nse2),numse2(nse2), nufase2(nse2),STAT=ret )
     85 !      print *,ret
     86
     87       ttr3 = 3
     88       allocate ( tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),STAT=ret )
     89 !      print *,ret
     90
     91
     92 !   ** Lecture de la connectivite des segments avec profil           **
     93       if (cret.eq.0) then
     94          call efconl(fid,maa,mdim,se2,MED_NO_INTERLACE,profil,2,MED_ARETE, &
     95      &               MED_SEG2,MED_DESC,cret)
     96       endif
     97       print *,cret
     98       print *,se2
     99
    100 !   ** Lecture (optionnelle) des noms des segments         **
    101       if (cret.eq.0) then
    102          call efnoml(fid,maa,nomse2,nse2,MED_ARETE,         &
    103      &               MED_SEG2,ret)
    104       endif
    105
    106       if (ret <0) then
    107          inoele = .FALSE.
    108       else
    109          inoele = .TRUE.
    110       endif
    111
    112 !  ** Lecture (optionnelle) des numeros des segments       **
    113       if (cret.eq.0) then
    114          call efnuml(fid,maa,numse2,nse2,MED_ARETE,MED_SEG2,ret)
    115      endif
    116
    117      if (ret <0) then
    118         inuele = .FALSE.
    119      else
    120         inuele = .TRUE.
    121      endif
    122
    123 !  ** Lecture des numeros des familles des segments         **
    124      if (cret.eq.0) then
    125          call effaml(fid,maa,nufase2,nse2,MED_ARETE,MED_SEG2,cret)
    126       endif
    127       print *,cret
    128
    129 !  ** Lecture de la connectivite des triangles sans profil **
    130       if (cret.eq.0) then
    131          call efconl(fid,maa,mdim,tr3,MED_NO_INTERLACE,profil,0,MED_MAILLE, &
    132      &               MED_TRIA3,MED_DESC,cret)
    133       endif
    134       print *,cret
    135
    136 !  ** Lecture (optionnelle) des noms des triangles          **
    137       if (cret.eq.0) then
    138          call efnoml(fid,maa,nomtr3,ntr3,MED_MAILLE,         &
    139      &               MED_TRIA3,ret)
    140       endif
    141
    142       if (ret <0) then
    143          inoele = .FALSE.
    144       else
    145          inoele = .TRUE.
    146       endif
    147       print *,cret
    148
    149 !  ** Lecture (optionnelle) des numeros des segments       **
    150       if (cret.eq.0) then
    151          call efnuml(fid,maa,numtr3,ntr3,MED_MAILLE,MED_TRIA3,ret)
    152      endif
    153
    154      if (ret <0) then
    155         inuele = .FALSE.
    156      else
    157         inuele = .TRUE.
    158      endif
    159      print *,cret
    160
    161 !  ** Lecture des numeros des familles des segments         **
    162      if (cret.eq.0) then
    163          call effaml(fid,maa,nufatr3,ntr3,MED_MAILLE,MED_TRIA3,cret)
    164       endif
    165       print *,cret
    166
    167 !  ** Fermeture du fichier                                           **
    168      call efferm (fid,cret)
    169      print *,cret
    170
    171 !  ** Affichage des resulats                                         **
    172      if (cret.eq.0) then
    173
    174         print *,"Connectivite des segments : "
    175         print *, se2
    176
    177         if (inoele) then
    178            print *,"Noms des segments :"
    179            print *,nomse2
    180         endif
    181
    182         if (inuele) then
    183            print *,"Numeros des segments :"
    184            print *,numse2
    185         endif
    186
    187         print *,"Numeros des familles des segments :"
    188         print *,nufase2
    189
    190         print *,"Connectivite des triangles :"
    191         print *,tr3
    192
    193         if (inoele) then
    194            print *,"Noms des triangles :"
    195            print *,nomtr3
    196         endif
    197
    198         if (inuele) then
    199            print *,"Numeros des triangles :"
    200            print *,numtr3
    201         endif
    202
    203         print *,"Numeros des familles des triangles :"
    204         print *,nufatr3
    205
    206      endif
    207
    208 !  ** Nettoyage memoire                                          **
    209       deallocate (se2,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
    210
    211 !  ** Code retour
    212       call efexit(cret)
    213
    214     end program test7
    215