# 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*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