test9.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 : test9.f90
00020 ! *
00021 ! * - Description : lecture des familles d'un maillage MED 
00022 ! *
00023 ! ******************************************************************************
00024 program test9
00025   
00026   implicit none
00027   include 'med.hf90'
00028 !
00029   integer        ret,cret,fid
00030   character*64   maa
00031   integer        mdim,sdim
00032   integer        nfam
00033   integer        i,j
00034   integer        ngro,natt 
00035   character*80,  allocatable, dimension (:) :: gro  
00036   integer,       allocatable, dimension (:) :: attid
00037   integer,       allocatable, dimension (:) :: attval
00038   character*200, allocatable, dimension (:) :: attdes
00039   character*200  desc     
00040   character*64   nomfam
00041   integer        numfam
00042   integer        type
00043   character(16)  :: dtunit
00044   integer nstep, stype, atype
00045   character*16 nomcoo(2)   
00046   character*16 unicoo(2)
00047 
00048 
00049 !  ** Ouverture du fichier test8.med en lecture seule **
00050   call mfiope(fid,'test8.med',MED_ACC_RDONLY, cret)
00051   print *,cret
00052 
00053 !  ** Lecture des infos sur le 1er maillage **
00054   if (cret.eq.0) then
00055      call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00056      print *,"Maillage de nom : ",maa," et de dimension : ", mdim
00057   endif
00058   print *,cret
00059 
00060 !  ** Lecture du nombre de famille **
00061   if (cret .eq. 0) then
00062      call mfanfa(fid,maa,nfam,cret)
00063      print *,' Nombre de familles a lire : ',nfam
00064   endif
00065   print *,cret
00066 
00067 !  ** Lecture de chaque famille **
00068   if (cret .eq. 0) then
00069      do i=1,nfam
00070         
00071 !       ** Lecture du nombre de groupe **
00072         if (cret .eq. 0) then
00073            call mfanfg(fid,maa,i,ngro,cret)
00074         endif
00075         print *,cret
00076 
00077 !       ** Lecture du nombre d'attributs pour les
00078 !          fichiers 2.3 **
00079         if (cret .eq. 0) then
00080            call mfaona(fid,maa,i,natt,cret)
00081         endif
00082         print *,cret
00083 
00084         print *,"Famille ",i," a ",ngro," groupes et ", natt, " attributs" 
00085 
00086 !       ** Lecture de : nom,numero,attributs,groupes **
00087         if (cret .eq. 0) then
00088            allocate(gro(ngro), attid(natt), attval(natt), attdes(natt),STAT=ret)
00089            print *,ret
00090 
00091            call mfaofi(fid,maa,i,nomfam,attid,attval,attdes,numfam,gro,cret)
00092            print *,cret
00093            print *,"Famille de nom ",nomfam," et de numero ",numfam
00094            do j=1,natt
00095               print *,"attid = ", attid(j)
00096               print *,"attval = ", attval(j)
00097               print *,"attdes =", attdes(j)
00098            enddo
00099            do j=1,ngro
00100               print *,"gro = ",gro(j)
00101            enddo
00102 
00103            deallocate(gro, attval, attid, attdes)
00104         endif
00105      enddo
00106   endif
00107      
00108      
00109 !  ** Fermeture du fichier                                           **
00110      call mficlo(fid,cret)
00111      print *,cret
00112      
00113 !  ** Code retour
00114      call efexit(cret)
00115      
00116    end program test9
00117 
00118 

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