      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 : test13.f90
     21  ! *
     22  ! * - Description : lecture des equivalences dans un maillage MED.
     23  ! *
     24  ! ******************************************************************************
     25
     26          program test13
     27
     28          implicit none
     29          include 'med.hf'
     30  !
     31  !
     32          integer      ret,cret,fid
     33          character*32 maa
     34          integer      mdim,nequ,ncor
     35          integer, allocatable, dimension(:) :: cor
     36          character*32  equ
     37          character*200 des
     38          integer       i,j,k
     39          character*255 argc
     40          integer, parameter :: MED_NBR_MAILLE_EQU = 8
     41          integer,parameter  :: typmai(MED_NBR_MAILLE_EQU) =
     42       &  (/ MED_POINT1,MED_SEG2,   &
     43       &     MED_SEG3,MED_TRIA3,    &
     44       &     MED_TRIA6,MED_QUAD4,   &
     45       &     MED_QUAD8,MED_POLYGONE/)
     46
     47          integer,parameter :: typfac(MED_NBR_GEOMETRIE_FACE+1) = &
     48       &   (/MED_TRIA3,MED_TRIA6,       &
     49       &   MED_QUAD4,MED_QUAD8, MED_POLYGONE/)
     50          integer,parameter ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,&
     51       &                                                          MED_SEG3/)
     52          character*200 desc
     53          integer type
     54
     55          print *,'Indiquez le fichier med a decrire : '
     56          read(*,*) argc
     57
     58  !       ** Ouverture du fichier en lecture seule **
     59          call efouvr(fid,argc,MED_LECTURE, cret)
     60          print *,cret
     61
     62
     63  !       ** Lecture des infos sur le premier maillage **
     64          if (cret.eq.0) then
     65              call efmaai(fid,1,maa,mdim,type,desc,cret)
     66              print *,"Maillage de nom : ",maa," et de dimension : ", mdim
     67          endif
     68          print *,cret
     69
     70
     71  !       ** Lecture du nombre d'equivalence  **
     72          if (cret.eq.0) then
     73              call efnequ(fid,maa,nequ,cret)
     74              if (cret.eq.0) then
     75                  print *,"Nombre d'equivalences : ",nequ
     76              endif
     77          endif
     78
     79  !** Lecture de toutes les equivalences **
     80          if (cret.eq.0) then
     81              do i=1,nequ
     82                  print *,"Equivalence numero : ",i
     83  !               ** Lecture des infos sur l'equivalence **
     84                  if (cret.eq.0) then
     85                      call efequi(fid,maa,i,equ,des,cret)
     86                  endif
     87                  print *,cret
     88                  if (cret.eq.0) then
     89                      print *,"Nom de l'equivalence : ",equ
     90                      print *,"Description de l'equivalence : ",des
     91                  endif
     92
     93  !**             Lecture des correspondances sur les differents types d'entites **
     94                  if (cret.eq.0) then
     95  !**                 Les noeuds **
     96                      call efncor(fid,maa,equ,MED_NOEUD,0,ncor,cret)
     97                      print *,"Il y a ",ncor
     98                      print "correspondances sur les noeuds "
     99                      if (ncor > 0) then
    100                          allocate(cor(ncor*2),STAT=ret)
    101                          call efequl(fid,maa,equ,cor,ncor,MED_NOEUD,0,cret)
    102                          do j=0,(ncor-1)
    103                              print *,"Correspondance ",j+1," : ",
    104                              print *,cor(2*j+1)," et ",cor(2*j+2)
    105                          end do
    106                          deallocate(cor)
    107                      end if
    108
    109  !** Les mailles : on ne prend pas en compte les mailles 3D **
    110
    111                      do j=1,MED_NBR_MAILLE_EQU
    112                          call efncor(fid,maa,equ,MED_MAILLE,typmai(j), &
    113       &                              ncor,cret)
    114                          print *,"Il y a ",ncor," correspondances sur"
    115                          print *," les mailles ",typmai(j)
    116                          if (ncor > 0 ) then
    117                              allocate(cor(2*ncor),STAT=ret)
    118                              call efequl(fid,maa,equ,cor,ncor,&
    119       &                           MED_MAILLE,typmai(j),cret)
    120                              do k=0,(ncor-1)
    121                                  print *,"Correspondance ",k+1," : ",
    122                                  print *,cor(2*k+1)," et ",cor(2*k+2)
    123                              end do
    124                              deallocate(cor)
    125                          endif
    126                      end do
    127
    128  !           ** Les faces **
    129                      do j=1,MED_NBR_GEOMETRIE_FACE+1
    130                          call efncor(fid,maa,equ,MED_FACE,typfac(j), &
    131       &                              ncor,cret)
    132                          print *,"Il y a ",ncor," correspondances sur "
    133                          print *,"les faces ",typfac(j)
    134                          if (ncor > 0 ) then
    135                              allocate(cor(2*ncor),STAT=ret)
    136                              call efequl(fid,maa,equ,cor,ncor,MED_FACE, &
    137       &                                  typfac(j),cret)
    138                              do k=0,(ncor-1)
    139                                  print *,"Correspondance ",k+1," : "
    140                                  print *,cor(2*k+1)," et ",cor(2*k+2)
    141                              end do
    142                              deallocate(cor)
    143                          endif
    144                      end do
    145
    146  !            **  Les aretes **
    147                      do j=1,MED_NBR_GEOMETRIE_ARETE
    148                          call efncor(fid,maa,equ,MED_ARETE,typare(j), &
    149       &                              ncor,cret)
    150                          print *,"Il y a ",ncor
    151                          print *," correspondances sur les aretes "
    152                          print *,typare(j)
    153                          if (ncor > 0 ) then
    154                              allocate(cor(2*ncor),STAT=ret)
    155                              call efequl(fid,maa,equ,cor,ncor,MED_ARETE, &
    156       &                                  typare(j),cret)
    157                              do k=0,(ncor-1)
    158                                  print *,"Correspondance ",k+1," : ",
    159                                  print *,cor(2*k+1)," et ",cor(2*k+2)
    160                              end do
    161                              deallocate(cor)
    162                          endif
    163                      end do
    164
    165                  end if
    166              end do
    167          end if
    168
    169  !       ** Fermeture du fichier   **
    170          call efferm (fid,cret)
    171          print *,cret
    172
    173          end program test13
    174
    175
    176