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.hf90'
00028 !     
00029 !     
00030       integer cret, ret
00031       integer fid
00032       
00033 !     ** la dimension du maillage et de l'espace de calcul**
00034       integer mdim, sdim
00035 !     ** nom du maillage de longueur maxi MED_SIZE_NAME  **
00036       character*64 maa
00037       character*200 desc
00038 !     ** le nombre de noeuds                              **
00039       integer nnoe 
00040 !     ** table des coordonnees                            **
00041       real*8, allocatable, dimension (:) ::  coo,coo1
00042 !     ** tables des noms et des unites des coordonnees    **
00043       character*16 nomcoo(2)   
00044       character*16 unicoo(2)
00045 !     ** tables des noms, numeros, numeros de familles des noeuds  **
00046 !     autant d'elements que de noeuds - les noms ont pout longueur **
00047 !     MED_SNAME_SIZE=16                                            
00048       character*16, allocatable, dimension (:) :: nomnoe
00049       integer,     allocatable, dimension (:) :: numnoe
00050       integer,     allocatable, dimension (:) :: nufano
00051       integer i
00052       logical inonoe,inunoe
00053       integer type,chgt,tsf
00054       integer flta(1)
00055       integer*8 flt(1)
00056       character(16)  :: dtunit
00057       integer nstep, stype, atype
00058       integer swm
00059 
00060 !     Ouverture du fichier en lecture seule             **
00061       call mfiope(fid,'test4.med',MED_ACC_RDONLY, cret)
00062       print *,cret
00063 
00064 !   ** Lecture des infos concernant le premier maillage **
00065       if (cret.eq.0) then
00066          call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00067       endif
00068       if (cret.ne.0) then
00069          call efexit(-1)
00070       endif
00071 
00072 
00073 !   ** Combien de noeuds a lire  **
00074       if (cret.eq.0) then
00075          nnoe = 0
00076          call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,MED_COORDINATE,MED_NO_CMODE,chgt,tsf,nnoe,cret)   
00077       endif
00078       print *,cret,' Nombre de noeuds : ',nnoe
00079       if (cret.ne.0) then
00080          call efexit(-1)
00081       endif
00082 
00083        
00084 !   ** Allocations memoires :  **
00085 !   ** table des coordonnees   **
00086 !     profil : (dimension * nombre de noeuds ) **
00087 !   ** table des des numeros, des numeros de familles des noeuds
00088 !   ** table des noms des noeuds ** 
00089       
00090       allocate( coo(nnoe*sdim),coo1(nnoe*sdim),numnoe(nnoe),nufano(nnoe),nomnoe(nnoe),STAT=ret )
00091       print *,ret
00092       coo1(:)=0.0
00093 
00094 !   ** Lecture des composantes des coordonnees des noeuds  avec et sans filtre     **
00095       if (cret.eq.0) then
00096          call mmhcor(fid,maa,MED_NO_DT,MED_NO_IT,MED_FULL_INTERLACE,coo,cret) 
00097       endif
00098       print *,'Lecture des toutes les composantes des coordonnees : '
00099       print *,coo
00100       if (cret.ne.0) then
00101          call efexit(-1)
00102       endif
00103 
00104 !    ** On cree un filtre  
00105      if (cret .eq. 0) then
00106         call mfrall(1,flt,cret)
00107      endif
00108      if (cret.ne.0) then
00109         call efexit(-1)
00110      endif
00111 
00112      if (cret .eq. 0) then
00113         call mfrcre(fid,nnoe,1,sdim,2,MED_FULL_INTERLACE,MED_GLOBAL_PFLMODE, &
00114                     MED_NO_PROFILE,MED_UNDEF_SIZE,flta,flt(1),cret)
00115      endif
00116      if (cret.ne.0) then
00117         call efexit(-1)
00118      endif
00119 
00120 !   ** Lecture des composantes n°2 des coordonnees des noeuds
00121       if (cret.eq.0) then
00122          call mmhcar(fid,maa,MED_NO_DT,MED_NO_IT,flt(1),coo1,cret) 
00123       endif
00124       print *,'Lecture de la composante numero 2 des coordonnees : '
00125       print *,coo1
00126 
00127 !   ** On desalloue le filtre
00128      if (cret .eq. 0) then
00129         call mfrdea(1,flt,cret)
00130      endif
00131      if (cret.ne.0) then
00132         call efexit(-1)
00133      endif
00134 
00135  
00136 !   ** Lecture des noms des noeuds (optionnel dans un fichier MED)  **
00137       if (cret.eq.0) then
00138          call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nomnoe,cret) 
00139       endif
00140     
00141       if (ret <0) then
00142          inonoe = .FALSE.
00143       else
00144          inonoe = .TRUE.
00145       endif
00146 
00147 !  ** Lecture des numeros des noeuds (optionnel dans un fichier MED) **
00148       if (cret.eq.0) then
00149          call mmhenr(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,numnoe,cret)
00150       endif
00151       if (ret <0) then
00152          inunoe = .FALSE.
00153       else
00154          inunoe = .TRUE.
00155       endif
00156       
00157 !   ** Lecture des numeros de familles des noeuds                  **      
00158       if (cret.eq.0) then
00159          call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nufano,cret)
00160       endif
00161       print *,cret
00162  
00163 
00164 !   ** Fermeture du fichier
00165       call mficlo(fid,cret)
00166       if (cret.ne.0) then
00167          call efexit(-1)
00168       endif
00169       
00170 
00171 !  ** Affichage des resulats                                         **
00172       if (cret.eq.0) then
00173 
00174          
00175          print *,"Type de repere         : ", atype
00176          print *,"Nom des coordonnees    : "
00177          print *, nomcoo
00178          
00179          print *,"Unites des coordonnees : "
00180          print *, unicoo
00181          
00182          print *,"Coordonnees des noeuds : "
00183          print *, coo 
00184          
00185          if (inonoe) then
00186             print *,"Noms des noeuds : "
00187             print *,nomnoe
00188          endif
00189 
00190          if (inunoe) then
00191             print *,"Numeros des noeuds : "
00192             print *,numnoe
00193          endif
00194 
00195          print *,"Numeros des familles des noeuds : "
00196          print *,nufano
00197          
00198       endif
00199       
00200 ! ** Liberation memoire                                            **
00201       deallocate(coo,coo1,nomnoe,numnoe,nufano);
00202 
00203 
00204 ! **  Code retour
00205       call efexit(cret)
00206       
00207       end program test5
00208 
00209 
00210 
00211 
00212 
00213 

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