2.3.6/test5.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 : test5.f90
00020 !     *
00021 !     * - Description : lecture des noeuds d'un maillage MED.
00022 !     *
00023 !     ******************************************************************************
00024       program test5
00025 !     
00026       implicit none
00027       include 'med.hf'
00028 !     
00029 !     
00030       integer cret, ret
00031       integer fid
00032       
00033 !     ** la dimension du maillage                         **
00034       integer mdim
00035 !     ** nom du maillage de longueur maxi MED_TAILLE_NOM  **
00036       character*32 maa
00037       character*200 desc
00038 !     ** le nombre de noeuds                              **
00039       integer nnoe 
00040 !     ** table des coordonnees                            **
00041       real*8, allocatable, dimension (:) ::  coo
00042       real*8, allocatable, dimension (:) ::  coo2
00043 !     ** tables des noms et des unites des coordonnees    **
00044       character*16 nomcoo(2)   
00045       character*16 unicoo(2)
00046 !     ** tables des noms, numeros, numeros de familles des noeuds  **
00047 !     autant d'elements que de noeuds - les noms ont pout longueur **
00048 !     MED_TAILLE_PNOM=8                                            
00049       character*16, allocatable, dimension (:) :: nomnoe
00050       integer,     allocatable, dimension (:) :: numnoe
00051       integer,     allocatable, dimension (:) :: nufano
00052       integer,     parameter                  :: profil(2) =  (/ 2, 3 /)
00053  
00054       integer i,rep
00055       logical inonoe,inunoe
00056       integer type
00057 
00058 !     Ouverture du fichier en lecture seule             **
00059       call efouvr(fid,'test4.med',MED_LECTURE, cret)
00060       print *,cret
00061 
00062 !   ** Lecture des infos concernant le premier maillage **
00063       if (cret.eq.0) then
00064          call efmaai(fid,1,maa,mdim,type,desc,cret)
00065       endif
00066       print *,cret
00067     
00068 
00069 !   ** Combien de noeuds a lire  **
00070       if (cret.eq.0) then
00071          nnoe = 0
00072          call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,        &
00073      &        nnoe,cret)   
00074       endif
00075       print *,cret,' Nombre de noeuds : ',nnoe
00076 
00077        
00078 !   ** Allocations memoires :  **
00079 !   ** table des coordonnees   **
00080 !     profil : (dimension * nombre de noeuds ) **
00081 !   ** table des des numeros, des numeros de familles des noeuds
00082 !   ** table des noms des noeuds ** 
00083       
00084       allocate( coo(nnoe*mdim),coo2(nnoe*mdim), numnoe(nnoe),nufano(nnoe),  &
00085      &     nomnoe(nnoe),STAT=ret )
00086       print *,ret
00087       
00088 
00089 !   ** Lecture des composantes n°2 des coordonnees des noeuds      **
00090       if (cret.eq.0) then
00091          call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE,   & 
00092      &        2,profil,0,rep,nomcoo,unicoo,cret)
00093       endif
00094       print *,cret
00095       print *,'Lecture des composantes 2 des coordonnees : '
00096       print *,coo
00097 
00098 !   ** Lecture des composantes n°1 des coordonnees des noeuds      **
00099       if (cret.eq.0) then
00100          call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE,   & 
00101      &        1,profil,0,rep,nomcoo,unicoo,cret)
00102       endif
00103       print *,cret
00104       print *,'Lecture des composantes 1 des coordonnees : '
00105       print *,coo
00106 
00107 !   ** Lecture des composantes n°1 des coordonnees des noeuds du profil  **
00108       if (cret.eq.0) then
00109          call efcool(fid,maa,mdim,coo2,MED_FULL_INTERLACE,   & 
00110      &        1,profil,2,rep,nomcoo,unicoo,cret)
00111       endif
00112       print *,cret
00113       print *,'Lecture des composantes 1 des coordonnees avec le profil : '
00114       print *,coo2
00115 
00116 !   ** Lecture des toutes les composantes des coordonnees des noeuds      **
00117       if (cret.eq.0) then
00118          call efcool(fid,maa,mdim,coo2,MED_FULL_INTERLACE,   & 
00119      &        MED_ALL,profil,0,rep,nomcoo,unicoo,cret)
00120       endif
00121       print *,cret
00122       print *,'Lecture des toutes les composantes des coordonnees : '
00123       print *,coo2
00124  
00125 !   ** Lecture des noms des noeuds (optionnel dans un fichier MED)  **
00126       if (cret.eq.0) then
00127          call efnoml(fid,maa,nomnoe,nnoe,MED_NOEUD,         &
00128      &               0,ret)
00129       endif
00130     
00131       if (ret <0) then
00132          inonoe = .FALSE.
00133       else
00134          inonoe = .TRUE.
00135       endif
00136 
00137 !  ** Lecture des numeros des noeuds (optionnel dans un fichier MED) **
00138       if (cret.eq.0) then
00139          call efnuml(fid,maa,numnoe,nnoe,MED_NOEUD,0,ret)
00140       endif
00141       if (ret <0) then
00142          inunoe = .FALSE.
00143       else
00144          inunoe = .TRUE.
00145       endif
00146       
00147 !   ** Lecture des numeros de familles des noeuds                  **      
00148       if (cret.eq.0) then
00149          call effaml(fid,maa,nufano,nnoe,MED_NOEUD,0,cret)
00150       endif
00151       print *,cret
00152 
00153 !   ** Fermeture du fichier
00154       call efferm (fid,cret)
00155       print *,cret
00156       
00157 
00158 !  ** Affichage des resulats                                         **
00159       if (cret.eq.0) then
00160 
00161          
00162          print *,"Type de repere         : ", rep
00163          print *,"Nom des coordonnees    : "
00164          print *, nomcoo
00165          
00166          print *,"Unites des coordonnees : "
00167          print *, unicoo
00168          
00169          print *,"Coordonnees des noeuds : "
00170          print *, coo 
00171          
00172          if (inonoe) then
00173             print *,"Noms des noeuds : "
00174             print *,nomnoe
00175          endif
00176 
00177          if (inunoe) then
00178             print *,"Numeros des noeuds : "
00179             print *,numnoe
00180          endif
00181 
00182          print *,"Numeros des familles des noeuds : "
00183          print *,nufano
00184          
00185       endif
00186       
00187 ! ** Liberation memoire                                            **
00188       deallocate(coo,nomnoe,numnoe,nufano);
00189 
00190 ! **  Code retour
00191       call efexit(cret)
00192       
00193       end program test5
00194 
00195 
00196 
00197 
00198 
00199 

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