      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 : 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   argc = "test14.med"
     63
     64   !  ** Ouverture du fichier **
     65   call efouvr(fid,argc,MED_LECTURE, cret)
     66   print *,cret
     67
     68
     69   !  ** Lecture des infos concernant le premier maillage **
     70   if (cret.eq.0) then
     71      call efmaai(fid,1,maa,mdim,type,desc,cret)
     72      print *,"Maillage de nom : ",maa," et de dimension : ",mdim
     73   endif
     74   print *,cret
     75
     76   ! ** Lecture du nombre de noeud **
     77   if (cret.eq.0) then
     78      call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret)
     79      print *,"Nombre de noeuds : ",nnoe
     80   endif
     81   print *,cret
     82
     83   ! ** Allocations memoires **
     84   ! ** table des coordonnees
     85   ! ** profil : (dimension * nombre de noeuds ) **
     86   allocate (coo(nnoe*mdim),STAT=ret)
     87   ! ** table des des numeros, des numeros de familles des noeuds
     88   !   profil : (nombre de noeuds) **
     89   allocate (numnoe(nnoe),nufano(nnoe),STAT=ret)
     90   ! ** table des noms des noeuds
     91   !   profil : (nnoe*MED_TAILLE_PNOM+1) **
     92   allocate (nomnoe(nnoe),STAT=ret)
     93
     94   ! ** Lecture des noeuds :
     95   !     - Coordonnees
     96   !     - Noms (optionnel dans un fichier MED)
     97   !     - Numeros (optionnel dans un fichier MED)
     98   !     - Numeros de familles   **
     99   if (cret.eq.0) then
    100      call efnoel(fid,maa,mdim,coo,MED_FULL_INTERLACE,rep,nomcoo,unicoo, &
    101  &                      nomnoe,inonoe,numnoe,inunoe,nufano,nnoe,cret)
    102   endif
    103
    104   ! ** Affichage des resulats **
    105   if (cret.eq.0) then
    106       print *,"Type de repere : ",rep
    107       print *,"Nom des coordonnees : ",nomcoo
    108
    109       print *,"Unites des coordonnees : ",unicoo
    110
    111       print *,"Coordonnees des noeuds : ",coo
    112
    113       if (inonoe) then
    114          print *,"Noms des noeuds : |",nomnoe,"|"
    115       endif
    116
    117       if (inunoe) then
    118          print *,"Numeros des noeuds : ",numnoe
    119       endif
    120
    121       print *,"Numeros des familles des noeuds : ",nufano
    122    endif
    123
    124   ! ** Liberation memoire **
    125    deallocate(coo,nomnoe,numnoe,nufano)
    126
    127   ! ** Fermeture du fichier **
    128    call efferm (fid,cret)
    129    print *,cret
    130
    131   ! **Code retour
    132    call efexit(cret)
    133
    134  end program test15
    135