# 2.3.6/test9.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2011  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.hf'
    00028 !
    00029   integer        ret,cret,fid
    00030   character*32   maa
    00031   integer        mdim
    00032   integer        nfam
    00033   integer        i,j
    00034   integer        natt,ngro
    00035   character*200, allocatable, dimension (:) :: attdes
    00036   character*80,  allocatable, dimension (:) :: gro
    00037   integer,       allocatable, dimension (:) :: attval,attide
    00038   character*32   nomfam
    00039   character*200  desc
    00040   integer        numfam
    00041   integer        type
    00042
    00043
    00044 !  ** Ouverture du fichier test8.med en lecture seule **
    00045   call efouvr(fid,'test8.med',MED_LECTURE, cret)
    00046   print *,cret
    00047
    00048 !  ** Lecture des infos sur le 1er maillage **
    00049   if (cret.eq.0) then
    00050      call efmaai(fid,1,maa,mdim,type,desc,cret)
    00051      print *,"Maillage de nom : ",maa," et de dimension : ", mdim
    00052   endif
    00053   print *,cret
    00054
    00055 !  ** Lecture du nombre de famille **
    00056   if (cret .eq. 0) then
    00057      call efnfam(fid,maa,nfam,cret)
    00058      print *,' Nombre de familles a lire : ',nfam
    00059   endif
    00060   print *,cret
    00061
    00062 !  ** Lecture de chaque famille **
    00063   if (cret .eq. 0) then
    00064      do i=1,nfam
    00065
    00066 !       ** Lecture du nombre de groupe **
    00067         if (cret .eq. 0) then
    00068            call efngro(fid,maa,i,ngro,cret)
    00069         endif
    00070         print *,cret
    00071
    00072 !       ** Lecture du nombre d'attribut **
    00073         if (cret .eq. 0) then
    00074            call efnatt(fid,maa,i,natt,cret)
    00075         endif
    00076         print *,cret
    00077
    00078         print *,"Famille ",i," a ",natt," attributs et ",ngro," groupes "
    00079
    00080 !       ** Lecture de : nom,numero,attributs,groupes **
    00081         if (cret .eq. 0) then
    00082            allocate(attide(natt),attval(natt),attdes(natt),gro(ngro),STAT=ret)
    00083 !              print *,ret
    00084
    00085            call effami(fid,maa,i,nomfam,numfam,attide,     &
    00086                 &                     attval,attdes,natt,gro,ngro,cret)
    00087            print *,cret
    00088            print *,"Famille de nom ",nomfam," et de numero ",numfam
    00089            print *,"Attributs :"
    00090            do j=1,natt
    00091               print *,"ide = ",attide(j)," - val = ",attval(j)," - des = ",attdes(j)
    00092            enddo
    00093            deallocate(attide,attval,attdes)
    00094
    00095            do j=1,ngro
    00096               print *,"gro = ",gro(j)
    00097            enddo
    00098            deallocate(gro)
    00099         endif
    00100      enddo
    00101   endif
    00102
    00103
    00104 !  ** Fermeture du fichier                                           **
    00105      call efferm (fid,cret)
    00106      print *,cret
    00107
    00108 !  ** Code retour
    00109      call efexit(cret)
    00110
    00111    end program test9
    00112
    00113