# test17.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 : test17.f90
    00020 ! *
    00021 ! * - Description : lecture d'elements de maillages MED ecrits par test16
    00022 ! *                 via les routines de niveau 2
    00023 ! *                 - equivalent a test17.f90
    00024 ! *
    00025 ! ******************************************************************************
    00026
    00027 program test17
    00028
    00029   implicit none
    00030   include 'med.hf'
    00031
    00032   integer      :: cret,ret, fid, nse2, mdim, sdim
    00033   integer,     allocatable, dimension(:) ::se2
    00034   character*16, allocatable, dimension(:) ::nomse2
    00035   integer,     allocatable, dimension(:) ::numse2,nufase2
    00036   integer      ntr3
    00037   integer,     allocatable, dimension(:) ::tr3
    00038   character*16, allocatable, dimension(:) ::nomtr3
    00039   integer,     allocatable, dimension(:) ::numtr3
    00040   integer,     allocatable, dimension(:) ::nufatr3
    00041   character*64  :: maa
    00042   character*200 :: desc
    00043   integer      :: inoele1,inuele1,inoele2,inuele2,ifaele1,ifaele2
    00044   integer      tse2,ttr3
    00045   integer i,type,rep,nstep,stype
    00046   integer chgt,tsf
    00047   character*16 nomcoo(2)
    00048   character*16 unicoo(2)
    00049   character*16 dtunit
    00050
    00051   !   ** Ouverture du fichier test16.med en lecture seule **
    00052   call mfiope(fid,'test16.med',MED_ACC_RDONLY, cret)
    00053   print *,cret
    00054
    00055   !   ** Lecture des informations sur le 1er maillage **
    00056   if (cret.eq.0) then
    00057      call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
    00058      print *,"Maillage de nom : ",maa," et de dimension ",mdim
    00059   endif
    00060   print *,cret
    00061
    00062    !  ** Lecture du nombre de triangles et de segments **
    00063   if (cret.eq.0) then
    00064      call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_CONNECTIVITY,MED_DESCENDING,chgt,tsf,nse2,cret)
    00065   endif
    00066   print *,cret
    00067
    00068   if (cret.eq.0) then
    00069      call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_CONNECTIVITY,MED_DESCENDING,chgt,tsf,ntr3,cret)
    00070   endif
    00071   print *,cret
    00072
    00073   print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
    00074
    00075   !  ** Allocations memoire **
    00076   tse2 = 2;
    00077   allocate(se2(tse2*nse2),nomse2(nse2),numse2(nse2),nufase2(nse2),STAT=ret)
    00078   ttr3 = 3;
    00079   allocate(tr3(ntr3*ttr3),nomtr3(ntr3),numtr3(ntr3),nufatr3(ntr3),STAT=ret)
    00080
    00081   !  ** Lecture des aretes segments MED_SEG2 :
    00082   !     - Connectivite,
    00083   !     - Noms (optionnel)
    00084   !     - Numeros (optionnel)
    00085   !     - Numeros de familles **
    00086   if (cret.eq.0) then
    00087      call mmhelr(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING,MED_NO_INTERLACE,se2,&
    00088                  inoele1,nomse2,inuele1,numse2,ifaele1,nufase2,cret)
    00089   endif
    00090   print *,cret
    00091
    00092
    00093   !  ** lecture des mailles triangles MED_TRIA3 :
    00094   !     - Connectivite,
    00095   !     - Noms (optionnel)
    00096   !     - Numeros (optionnel)
    00097   !     - Numeros de familles **
    00098   if (cret.eq.0) then
    00099      call mmhelr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_DESCENDING,MED_NO_INTERLACE,tr3,&
    00100                  inoele2,nomtr3,inuele2,numtr3,ifaele2,nufatr3,cret)
    00101   endif
    00102   print *,cret
    00103
    00104   ! ** Fermeture du fichier **
    00105   call mficlo(fid,cret)
    00106   print *,cret
    00107
    00108   ! ** Affichage **
    00109   if (cret.eq.0) then
    00110       print *,"Connectivite des segments : ",se2
    00111
    00112       if (inoele1 .eq. MED_TRUE) then
    00113          print *,"Noms des segments : ",nomse2
    00114       endif
    00115
    00116       if (inuele1 .eq. MED_TRUE) then
    00117          print *,"Numeros des segments : ",numse2
    00118       endif
    00119
    00120       print *,"Numeros des familles des segments : ",nufase2
    00121
    00122
    00123       print *,"Connectivite des triangles : ",tr3
    00124
    00125       if (inoele2 .eq. MED_TRUE) then
    00126          print *,"Noms des triangles :", nomtr3
    00127       endif
    00128
    00129       if (inuele2 .eq. MED_TRUE) then
    00130           print *,"Numeros des triangles :", numtr3
    00131       endif
    00132
    00133       print *,"Numeros des familles des triangles :", nufatr3
    00134
    00135    end if
    00136
    00137
    00138    ! ** Nettoyage memoire **
    00139    deallocate(se2,nomse2,numse2,nufase2);
    00140    deallocate(tr3,nomtr3,numtr3,nufatr3);
    00141
    00142    ! ** Code retour
    00143    call efexit(cret)
    00144
    00145  end program test17