      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 : test15.f90
     21  ! *
     22  ! * - Description : lecture des noeuds d'un maillage MED.
     23  ! *                 a l'aide des routines de niveau 2
     24  ! *                 - equivalent a test5.f90
     25  ! *
     26  ! ******************************************************************************
     27
     28        program test15
     29
     30        implicit none
     31        include 'med.hf'
     32  !
     33  !
     34        integer  ret,cret, fid;
     35  !   ** la dimension du maillage                        **
     36        integer mdim
     37  !  ** nom du maillage de longueur maxi MED_TAILLE_NOM **
     38        character*32 maa
     39        character*200 desc
     40  !  ** le nombre de noeuds                             **
     41        integer :: nnoe = 0
     42  !  ** table des coordonnees                           **
     43       real*8, allocatable, dimension(:) :: coo
     44  !  ** tables des noms et des unites des coordonnees
     45  !     profil : (dimension)                            **
     46        character*16 nomcoo(2)
     47        character*16 unicoo(2)
     48  !  ** tables des noms, numeros, numeros de familles des noeuds
     49  !     autant d'elements que de noeuds - les noms ont pout longueur
     50  !     MED_TAILLE_PNOM **
     51        character*16, allocatable, dimension(:) ::  nomnoe
     52        integer,      allocatable, dimension(:) ::  numnoe,nufano
     53        integer rep
     54        logical inonoe,inunoe
     55        character*16 str
     56        integer i
     57        character*255 argc
     58        integer type
     59
     60        print *,"Indiquez le fichier med a decrire : "
     61        read(*,*) argc
     62
     63  !  ** Ouverture du fichier **
     64       call efouvr(fid,argc,MED_LECTURE, cret)
     65       print *,cret
     66
     67
     68  !  ** Lecture des infos concernant le premier maillage **
     69        if (cret.eq.0) then
     70          call efmaai(fid,1,maa,mdim,type,desc,cret)
     71          print *,"Maillage de nom : ",maa," et de dimension : ",mdim
     72        endif
     73        print *,cret
     74
     75  ! ** Lecture du nombre de noeud **
     76        if (cret.eq.0) then
     77          call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret)
     78          print *,"Nombre de noeuds : ",nnoe
     79        endif
     80        print *,cret
     81
     82  ! ** Allocations memoires **
     83  ! ** table des coordonnees
     84  ! ** profil : (dimension * nombre de noeuds ) **
     85        allocate (coo(nnoe*mdim),STAT=ret)
     86  ! ** table des des numeros, des numeros de familles des noeuds
     87  !   profil : (nombre de noeuds) **
     88        allocate (numnoe(nnoe),nufano(nnoe),STAT=ret)
     89  ! ** table des noms des noeuds
     90  !   profil : (nnoe*MED_TAILLE_PNOM+1) **
     91        allocate (nomnoe(nnoe),STAT=ret)
     92
     93  ! ** Lecture des noeuds :
     94  !     - Coordonnees
     95  !     - Noms (optionnel dans un fichier MED)
     96  !     - Numeros (optionnel dans un fichier MED)
     97  !     - Numeros de familles **
     98        if (cret.eq.0) then
     99          call efnoel(fid,maa,mdim,coo,MED_FULL_INTERLACE,rep,nomcoo,unicoo, &
    100       &       nomnoe,inonoe,numnoe,inunoe,nufano,nnoe,cret)
    101        endif
    102
    103  ! ** Affichage des resulats **
    104        if (cret.eq.0) then
    105          print *,"Type de repere : ",rep
    106          print *,"Nom des coordonnees : ",nomcoo
    107
    108          print *,"Unites des coordonnees : ",unicoo
    109
    110          print *,"Coordonnees des noeuds : ",coo
    111
    112          if (inonoe) then
    113               print *,"Noms des noeuds : |",nomnoe,"|"
    114          endif
    115
    116          if (inunoe) then
    117               print *,"Numeros des noeuds : ",numnoe
    118          endif
    119
    120          print *,"Numeros des familles des noeuds : ",nufano
    121        endif
    122
    123  ! ** Liberation memoire **
    124        deallocate(coo,nomnoe,numnoe,nufano)
    125
    126  ! ** Fermeture du fichier **
    127        call efferm (fid,cret)
    128        print *,cret
    129
    130        end program test15
    131