# 2.3.6/test7.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2012  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