test7.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 : test7.f90
00020 ! *
00021 ! * - Description : lecture des elements du maillage MED ecrits par test6
00022 ! *
00023 ! ******************************************************************************
00024       program test7
00025     
00026       implicit none
00027       include 'med.hf90'
00028 !     
00029 !           
00030       integer cret, ret, fid
00031 
00032       integer nse2
00033       integer,     allocatable, dimension (:) :: se2,se21
00034       character*16, allocatable, dimension (:) :: nomse2
00035       integer,     allocatable, dimension (:) :: numse2,nufase2
00036  
00037       integer ntr3
00038       integer,     allocatable, dimension (:) :: tr3
00039       character*16, allocatable, dimension (:) :: nomtr3
00040       integer,     allocatable, dimension (:) :: numtr3,nufatr3
00041    
00042 !     ** nom du maillage de longueur maxi MED_TAILLE_NOM    **
00043       character*64  :: maa
00044       character*200 :: desc
00045       integer       :: mdim,edim,nstep,stype,atype
00046       logical inoele,inuele
00047       integer, parameter :: profil (2) = (/ 2,3 /) 
00048       integer type
00049       integer tse2,ttr3, i
00050       character*16 nomcoo(2)
00051       character*16 unicoo(2)
00052       character*16 dtunit
00053       integer :: chgt,tsf
00054       integer flta(1)
00055       integer*8 flt(1)
00056 
00057 !   ** Ouverture du fichier test6.med en lecture seule       **
00058       call mfiope(fid,'test6.med',MED_ACC_RDONLY, cret)     
00059       print *,cret
00060 
00061 !   ** Lecture des infos concernant le premier maillage      **
00062       if (cret.eq.0) then
00063          call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00064          print *,"Maillage de nom : ",maa," et de dimension :", mdim
00065       endif
00066       if (cret.ne.0) then
00067          call efexit(-1)
00068       endif
00069 !   ** Combien de segments et de triangles                   **
00070       if (cret.eq.0) then
00071          nse2 = 0
00072          call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_CONNECTIVITY,MED_DESCENDING,chgt,tsf,nse2,cret)   
00073       endif
00074       if (cret.ne.0) then
00075          call efexit(-1)
00076       endif
00077 
00078       if (cret.eq.0) then
00079          ntr3 = 0
00080          call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_CONNECTIVITY,MED_DESCENDING,chgt,tsf,ntr3,cret)  
00081       endif
00082       if (cret.ne.0) then
00083          call efexit(-1)
00084       endif
00085 
00086       if (cret.eq.0) then
00087          print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3 
00088       endif
00089 
00090 !   ** Allocations memoire                                 **
00091       tse2 = 2
00092       allocate (se2(tse2*nse2),se21(tse2*nse2),nomse2(nse2),numse2(nse2), nufase2(nse2),STAT=ret )
00093       se2(:)=0; se21(:)=0
00094 !      print *,ret
00095 
00096       ttr3 = 3
00097       allocate (tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),STAT=ret )
00098       tr3(:)=0
00099 !      print *,ret
00100 
00101 
00102 !   ** Lecture de la connectivite des segments           **   
00103       if (cret.eq.0) then
00104         call mmhcyr(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING,MED_FULL_INTERLACE,se2,cret)
00105       endif
00106       if (cret.ne.0) then
00107          call efexit(-1)
00108       endif
00109       print *,se2
00110 
00111 !    ** Lecture de de la composante 2 de la connectivite des segments           **  
00112 !    ** On cree un filtre  associe
00113      if (cret .eq. 0) then
00114         call mfrall(1,flt,cret)
00115      endif
00116      if (cret.ne.0) then
00117         call efexit(-1)
00118      endif
00119 
00120 !    ** on initialise le filtre pour lire uniquement la deuxième composante.
00121      if (cret .eq. 0) then
00122         call mfrcre(fid,nse2,1,edim,2,MED_FULL_INTERLACE,MED_GLOBAL_PFLMODE, &
00123                     MED_NO_PROFILE,MED_UNDEF_SIZE,flta,flt(1),cret)
00124      endif
00125      if (cret.ne.0) then
00126         call efexit(-1)
00127      endif
00128 
00129 !   ** Lecture des composantes n°2 des segments
00130      if (cret.eq.0) then
00131         call mmhyar(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING, &
00132                     flt(1),se21,cret)
00133      endif
00134      if (cret.ne.0) then
00135         call efexit(-1)
00136      endif
00137      print *,se21
00138 
00139 !   ** On desalloue le filtre
00140      if (cret .eq. 0) then
00141         call mfrdea(1,flt,cret)
00142      endif
00143      if (cret.ne.0) then
00144         call efexit(-1)
00145      endif
00146 
00147 !   ** Lecture (optionnelle) des noms des segments         **
00148       if (cret.eq.0) then
00149          call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,nomse2,cret) 
00150       endif
00151     
00152       if (ret <0) then
00153          inoele = .FALSE.
00154       else
00155          inoele = .TRUE.
00156       endif
00157 
00158 !  ** Lecture (optionnelle) des numeros des segments       **
00159       if (cret.eq.0) then
00160          call mmhenr(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,numse2,cret)
00161      endif
00162 
00163      if (ret <0) then
00164         inuele = .FALSE.
00165      else
00166         inuele = .TRUE.
00167      endif
00168 
00169 !  ** Lecture des numeros des familles des segments         **
00170      if (cret.eq.0) then
00171         call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,nufase2,cret)
00172       endif
00173      if (cret.ne.0) then
00174         call efexit(-1)
00175      endif
00176 
00177 !  ** Lecture de la connectivite des triangles sans profil **
00178       if (cret.eq.0) then
00179         call mmhcyr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_DESCENDING,MED_NO_INTERLACE,tr3,cret)
00180       endif
00181      if (cret.ne.0) then
00182         call efexit(-1)
00183      endif
00184 
00185 !  ** Lecture (optionnelle) des noms des triangles          **
00186       if (cret.eq.0) then
00187          call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,nomtr3,cret) 
00188       endif
00189     
00190       if (ret <0) then
00191          inoele = .FALSE.
00192       else
00193          inoele = .TRUE.
00194       endif
00195       print *,cret
00196 
00197 !  ** Lecture (optionnelle) des numeros des segments       **
00198       if (cret.eq.0) then
00199         call mmhenr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,numtr3,cret)
00200      endif
00201 
00202      if (ret <0) then
00203         inuele = .FALSE.
00204      else
00205         inuele = .TRUE.
00206      endif
00207      print *,cret
00208 
00209 !  ** Lecture des numeros des familles des segments         **
00210      if (cret.eq.0) then
00211         call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,nufatr3,cret)
00212       endif
00213       print *,cret
00214 
00215 !  ** Fermeture du fichier                                           **
00216      call mficlo(fid,cret)
00217      if (cret.ne.0) then
00218         call efexit(-1)
00219      endif
00220  
00221 !  ** Affichage des resulats                                         **
00222      if (cret.eq.0) then
00223         
00224         print *,"Connectivite des segments : "
00225         print *, se2
00226         
00227         if (inoele) then
00228            print *,"Noms des segments :"
00229            print *,nomse2
00230         endif
00231         
00232         if (inuele) then
00233            print *,"Numeros des segments :"
00234            print *,numse2
00235         endif
00236         
00237         print *,"Numeros des familles des segments :"
00238         print *,nufase2
00239         
00240         print *,"Connectivite des triangles :"
00241         print *,tr3
00242         
00243         if (inoele) then
00244            print *,"Noms des triangles :"
00245            print *,nomtr3
00246         endif
00247         
00248         if (inuele) then
00249            print *,"Numeros des triangles :"
00250            print *,numtr3
00251         endif
00252         
00253         print *,"Numeros des familles des triangles :"
00254         print *,nufatr3
00255         
00256      endif
00257 
00258 !  ** Nettoyage memoire                                          **
00259       deallocate (se2,se21,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
00260 
00261 !  ** Code retour
00262       call efexit(cret)
00263 
00264     end program test7
00265 

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