2.3.6/test15.f90

Aller à la documentation de ce fichier.
00001 !*  This file is part of MED.
00002 !*
00003 !*  COPYRIGHT (C) 1999 - 2015  EDF R&D, CEA/DEN
00004 !*  MED is free software: you can redistribute it and/or modify
00005 !*  it under the terms of the GNU Lesser General Public License as published by
00006 !*  the Free Software Foundation, either version 3 of the License, or
00007 !*  (at your option) any later version.
00008 !*
00009 !*  MED is distributed in the hope that it will be useful,
00010 !*  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 !*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012 !*  GNU Lesser General Public License for more details.
00013 !*
00014 !*  You should have received a copy of the GNU Lesser General Public License
00015 !*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
00016 !*
00017 
00018 ! *******************************************************************************
00019 ! * - Nom du fichier : test15.f90
00020 ! *
00021 ! * - Description : lecture des noeuds d'un maillage MED.
00022 ! *                 a l'aide des routines de niveau 2
00023 ! *                 - equivalent a test5.f90
00024 ! *
00025 ! ******************************************************************************
00026 
00027 program test15
00028   
00029   implicit none
00030   include 'med.hf'
00031 !  
00032 !
00033   integer  ret,cret, fid;
00034   !  ** la dimension du maillage                        **
00035   integer mdim
00036   !  ** nom du maillage de longueur maxi MED_TAILLE_NOM **
00037   character*32 maa
00038   character*200 desc
00039   !  ** le nombre de noeuds                             **
00040   integer :: nnoe = 0
00041   !  ** table des coordonnees                           **
00042   real*8, allocatable, dimension(:) :: coo
00043   !  ** tables des noms et des unites des coordonnees 
00044   !     profil : (dimension)                            **
00045   character*16 nomcoo(2)
00046   character*16 unicoo(2)
00047   !  ** tables des noms, numeros, numeros de familles des noeuds
00048   !     autant d'elements que de noeuds - les noms ont pout longueur
00049   !     MED_TAILLE_PNOM **
00050   character*16, allocatable, dimension(:) ::  nomnoe
00051   integer,      allocatable, dimension(:) ::  numnoe,nufano
00052   integer rep
00053   logical inonoe,inunoe
00054   character*16 str
00055   integer i
00056   character*255 argc
00057   integer type
00058 
00059   print *,"Indiquez le fichier med a decrire : "
00060   !! read(*,*) argc 
00061   argc = "test14.med"
00062 
00063   !  ** Ouverture du fichier **
00064   call efouvr(fid,argc,MED_LECTURE, cret)
00065   print *,cret
00066    
00067 
00068   !  ** Lecture des infos concernant le premier maillage **
00069   if (cret.eq.0) then
00070      call efmaai(fid,1,maa,mdim,type,desc,cret)
00071      print *,"Maillage de nom : ",maa," et de dimension : ",mdim
00072   endif
00073   print *,cret
00074   
00075   ! ** Lecture du nombre de noeud **
00076   if (cret.eq.0) then
00077      call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret)
00078      print *,"Nombre de noeuds : ",nnoe
00079   endif
00080   print *,cret
00081 
00082   ! ** Allocations memoires **
00083   ! ** table des coordonnees 
00084   ! ** profil : (dimension * nombre de noeuds ) **
00085   allocate (coo(nnoe*mdim),STAT=ret)
00086   ! ** table des des numeros, des numeros de familles des noeuds
00087   !   profil : (nombre de noeuds) **
00088   allocate (numnoe(nnoe),nufano(nnoe),STAT=ret)
00089   ! ** table des noms des noeuds 
00090   !   profil : (nnoe*MED_TAILLE_PNOM+1) **
00091   allocate (nomnoe(nnoe),STAT=ret)
00092 
00093   ! ** Lecture des noeuds : 
00094   !     - Coordonnees
00095   !     - Noms (optionnel dans un fichier MED) 
00096   !     - Numeros (optionnel dans un fichier MED) 
00097   !     - Numeros de familles   **
00098   if (cret.eq.0) then
00099      call efnoel(fid,maa,mdim,coo,MED_FULL_INTERLACE,rep,nomcoo,unicoo, &
00100  &                      nomnoe,inonoe,numnoe,inunoe,nufano,nnoe,cret)
00101   endif
00102   
00103   ! ** Affichage des resulats **
00104   if (cret.eq.0) then
00105       print *,"Type de repere : ",rep
00106       print *,"Nom des coordonnees : ",nomcoo
00107     
00108       print *,"Unites des coordonnees : ",unicoo
00109      
00110       print *,"Coordonnees des noeuds : ",coo
00111      
00112       if (inonoe) then
00113          print *,"Noms des noeuds : |",nomnoe,"|"
00114       endif
00115 
00116       if (inunoe) then
00117          print *,"Numeros des noeuds : ",numnoe
00118       endif
00119 
00120       print *,"Numeros des familles des noeuds : ",nufano
00121    endif
00122 
00123   ! ** Liberation memoire **
00124    deallocate(coo,nomnoe,numnoe,nufano)
00125  
00126   ! ** Fermeture du fichier **
00127    call efferm (fid,cret)
00128    print *,cret
00129 
00130   ! **Code retour
00131    call efexit(cret)
00132    
00133  end program test15
00134 

Généré le Thu Oct 8 14:26:17 2015 pour MED fichier par  doxygen 1.6.1