2.3.6/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.hf'
00028 !     
00029 !           
00030       integer cret, ret, fid
00031 
00032       integer nse2
00033       integer,     allocatable, dimension (:) :: se2
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*32  :: maa  = "maa1"
00044       character*200 :: desc
00045       integer       :: mdim
00046       logical inoele,inuele
00047       integer, parameter :: profil (2) = (/ 2,3 /) 
00048       integer type
00049       integer tse2,ttr3, i
00050 
00051 !   ** Ouverture du fichier test6.med en lecture seule       **
00052       call efouvr(fid,'test6.med',MED_LECTURE, cret)
00053       print *,cret
00054 
00055 !   ** Lecture des infos concernant le premier maillage      **
00056       if (cret.eq.0) then
00057          call efmaai(fid,1,maa,mdim,type,desc,cret)
00058          print *,"Maillage de nom : ",maa," et de dimension :", mdim
00059       endif
00060       print *,cret
00061 
00062 !   ** Combien de segments et de triangles                   **
00063       if (cret.eq.0) then
00064          nse2 = 0
00065          call efnema(fid,maa,MED_CONN,MED_ARETE,MED_SEG2,MED_DESC,        &
00066      &        nse2,cret)   
00067       endif
00068       print *,cret
00069 
00070       if (cret.eq.0) then
00071          ntr3 = 0
00072          call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_TRIA3,MED_DESC,        &
00073      &        ntr3,cret)   
00074       endif
00075       print *,cret
00076 
00077       if (cret.eq.0) then
00078          print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3 
00079       endif
00080 
00081 !   ** Allocations memoire                                 **
00082       tse2 = 2
00083       allocate ( se2(tse2*nse2), nomse2(nse2),numse2(nse2), nufase2(nse2),STAT=ret )
00084 !      print *,ret
00085 
00086       ttr3 = 3
00087       allocate ( tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),STAT=ret )
00088 !      print *,ret
00089 
00090 
00091 !   ** Lecture de la connectivite des segments avec profil           **   
00092       if (cret.eq.0) then
00093          call efconl(fid,maa,mdim,se2,MED_NO_INTERLACE,profil,2,MED_ARETE, &
00094      &               MED_SEG2,MED_DESC,cret)
00095       endif
00096       print *,cret
00097       print *,se2
00098 
00099 !   ** Lecture (optionnelle) des noms des segments         **
00100       if (cret.eq.0) then
00101          call efnoml(fid,maa,nomse2,nse2,MED_ARETE,         &
00102      &               MED_SEG2,ret)
00103       endif
00104     
00105       if (ret <0) then
00106          inoele = .FALSE.
00107       else
00108          inoele = .TRUE.
00109       endif
00110 
00111 !  ** Lecture (optionnelle) des numeros des segments       **
00112       if (cret.eq.0) then
00113          call efnuml(fid,maa,numse2,nse2,MED_ARETE,MED_SEG2,ret)
00114      endif
00115 
00116      if (ret <0) then
00117         inuele = .FALSE.
00118      else
00119         inuele = .TRUE.
00120      endif
00121 
00122 !  ** Lecture des numeros des familles des segments         **
00123      if (cret.eq.0) then
00124          call effaml(fid,maa,nufase2,nse2,MED_ARETE,MED_SEG2,cret)
00125       endif
00126       print *,cret
00127 
00128 !  ** Lecture de la connectivite des triangles sans profil **
00129       if (cret.eq.0) then
00130          call efconl(fid,maa,mdim,tr3,MED_NO_INTERLACE,profil,0,MED_MAILLE, &
00131      &               MED_TRIA3,MED_DESC,cret)
00132       endif
00133       print *,cret
00134 
00135 !  ** Lecture (optionnelle) des noms des triangles          **
00136       if (cret.eq.0) then
00137          call efnoml(fid,maa,nomtr3,ntr3,MED_MAILLE,         &
00138      &               MED_TRIA3,ret)
00139       endif
00140     
00141       if (ret <0) then
00142          inoele = .FALSE.
00143       else
00144          inoele = .TRUE.
00145       endif
00146       print *,cret
00147 
00148 !  ** Lecture (optionnelle) des numeros des segments       **
00149       if (cret.eq.0) then
00150          call efnuml(fid,maa,numtr3,ntr3,MED_MAILLE,MED_TRIA3,ret)
00151      endif
00152 
00153      if (ret <0) then
00154         inuele = .FALSE.
00155      else
00156         inuele = .TRUE.
00157      endif
00158      print *,cret
00159 
00160 !  ** Lecture des numeros des familles des segments         **
00161      if (cret.eq.0) then
00162          call effaml(fid,maa,nufatr3,ntr3,MED_MAILLE,MED_TRIA3,cret)
00163       endif
00164       print *,cret
00165 
00166 !  ** Fermeture du fichier                                           **
00167      call efferm (fid,cret)
00168      print *,cret
00169  
00170 !  ** Affichage des resulats                                         **
00171      if (cret.eq.0) then
00172         
00173         print *,"Connectivite des segments : "
00174         print *, se2
00175         
00176         if (inoele) then
00177            print *,"Noms des segments :"
00178            print *,nomse2
00179         endif
00180         
00181         if (inuele) then
00182            print *,"Numeros des segments :"
00183            print *,numse2
00184         endif
00185         
00186         print *,"Numeros des familles des segments :"
00187         print *,nufase2
00188         
00189         print *,"Connectivite des triangles :"
00190         print *,tr3
00191         
00192         if (inoele) then
00193            print *,"Noms des triangles :"
00194            print *,nomtr3
00195         endif
00196         
00197         if (inuele) then
00198            print *,"Numeros des triangles :"
00199            print *,numtr3
00200         endif
00201         
00202         print *,"Numeros des familles des triangles :"
00203         print *,nufatr3
00204         
00205      endif
00206 
00207 !  ** Nettoyage memoire                                          **
00208       deallocate (se2,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
00209 
00210 !  ** Code retour
00211       call efexit(cret)
00212 
00213     end program test7
00214 

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