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