# 2.3.6/test5.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 : test5.f90
    00020 !     *
    00021 !     * - Description : lecture des noeuds d'un maillage MED.
    00022 !     *
    00023 !     ******************************************************************************
    00024       program test5
    00025 !
    00026       implicit none
    00027       include 'med.hf'
    00028 !
    00029 !
    00030       integer cret, ret
    00031       integer fid
    00032
    00033 !     ** la dimension du maillage                         **
    00034       integer mdim
    00035 !     ** nom du maillage de longueur maxi MED_TAILLE_NOM  **
    00036       character*32 maa
    00037       character*200 desc
    00038 !     ** le nombre de noeuds                              **
    00039       integer nnoe
    00040 !     ** table des coordonnees                            **
    00041       real*8, allocatable, dimension (:) ::  coo
    00042       real*8, allocatable, dimension (:) ::  coo2
    00043 !     ** tables des noms et des unites des coordonnees    **
    00044       character*16 nomcoo(2)
    00045       character*16 unicoo(2)
    00046 !     ** tables des noms, numeros, numeros de familles des noeuds  **
    00047 !     autant d'elements que de noeuds - les noms ont pout longueur **
    00048 !     MED_TAILLE_PNOM=8
    00049       character*16, allocatable, dimension (:) :: nomnoe
    00050       integer,     allocatable, dimension (:) :: numnoe
    00051       integer,     allocatable, dimension (:) :: nufano
    00052       integer,     parameter                  :: profil(2) =  (/ 2, 3 /)
    00053
    00054       integer i,rep
    00055       logical inonoe,inunoe
    00056       integer type
    00057
    00058 !     Ouverture du fichier en lecture seule             **
    00059       call efouvr(fid,'test4.med',MED_LECTURE, cret)
    00060       print *,cret
    00061
    00062 !   ** Lecture des infos concernant le premier maillage **
    00063       if (cret.eq.0) then
    00064          call efmaai(fid,1,maa,mdim,type,desc,cret)
    00065       endif
    00066       print *,cret
    00067
    00068
    00069 !   ** Combien de noeuds a lire  **
    00070       if (cret.eq.0) then
    00071          nnoe = 0
    00072          call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,        &
    00073      &        nnoe,cret)
    00074       endif
    00075       print *,cret,' Nombre de noeuds : ',nnoe
    00076
    00077
    00078 !   ** Allocations memoires :  **
    00079 !   ** table des coordonnees   **
    00080 !     profil : (dimension * nombre de noeuds ) **
    00081 !   ** table des des numeros, des numeros de familles des noeuds
    00082 !   ** table des noms des noeuds **
    00083
    00084       allocate( coo(nnoe*mdim),coo2(nnoe*mdim), numnoe(nnoe),nufano(nnoe),  &
    00085      &     nomnoe(nnoe),STAT=ret )
    00086       print *,ret
    00087
    00088
    00089 !   ** Lecture des composantes n°2 des coordonnees des noeuds      **
    00090       if (cret.eq.0) then
    00091          call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE,   &
    00092      &        2,profil,0,rep,nomcoo,unicoo,cret)
    00093       endif
    00094       print *,cret
    00095       print *,'Lecture des composantes 2 des coordonnees : '
    00096       print *,coo
    00097
    00098 !   ** Lecture des composantes n°1 des coordonnees des noeuds      **
    00099       if (cret.eq.0) then
    00100          call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE,   &
    00101      &        1,profil,0,rep,nomcoo,unicoo,cret)
    00102       endif
    00103       print *,cret
    00104       print *,'Lecture des composantes 1 des coordonnees : '
    00105       print *,coo
    00106
    00107 !   ** Lecture des composantes n°1 des coordonnees des noeuds du profil  **
    00108       if (cret.eq.0) then
    00109          call efcool(fid,maa,mdim,coo2,MED_FULL_INTERLACE,   &
    00110      &        1,profil,2,rep,nomcoo,unicoo,cret)
    00111       endif
    00112       print *,cret
    00113       print *,'Lecture des composantes 1 des coordonnees avec le profil : '
    00114       print *,coo2
    00115
    00116 !   ** Lecture des toutes les composantes des coordonnees des noeuds      **
    00117       if (cret.eq.0) then
    00118          call efcool(fid,maa,mdim,coo2,MED_FULL_INTERLACE,   &
    00119      &        MED_ALL,profil,0,rep,nomcoo,unicoo,cret)
    00120       endif
    00121       print *,cret
    00122       print *,'Lecture des toutes les composantes des coordonnees : '
    00123       print *,coo2
    00124
    00125 !   ** Lecture des noms des noeuds (optionnel dans un fichier MED)  **
    00126       if (cret.eq.0) then
    00127          call efnoml(fid,maa,nomnoe,nnoe,MED_NOEUD,         &
    00128      &               0,ret)
    00129       endif
    00130
    00131       if (ret <0) then
    00132          inonoe = .FALSE.
    00133       else
    00134          inonoe = .TRUE.
    00135       endif
    00136
    00137 !  ** Lecture des numeros des noeuds (optionnel dans un fichier MED) **
    00138       if (cret.eq.0) then
    00139          call efnuml(fid,maa,numnoe,nnoe,MED_NOEUD,0,ret)
    00140       endif
    00141       if (ret <0) then
    00142          inunoe = .FALSE.
    00143       else
    00144          inunoe = .TRUE.
    00145       endif
    00146
    00147 !   ** Lecture des numeros de familles des noeuds                  **
    00148       if (cret.eq.0) then
    00149          call effaml(fid,maa,nufano,nnoe,MED_NOEUD,0,cret)
    00150       endif
    00151       print *,cret
    00152
    00153 !   ** Fermeture du fichier
    00154       call efferm (fid,cret)
    00155       print *,cret
    00156
    00157
    00158 !  ** Affichage des resulats                                         **
    00159       if (cret.eq.0) then
    00160
    00161
    00162          print *,"Type de repere         : ", rep
    00163          print *,"Nom des coordonnees    : "
    00164          print *, nomcoo
    00165
    00166          print *,"Unites des coordonnees : "
    00167          print *, unicoo
    00168
    00169          print *,"Coordonnees des noeuds : "
    00170          print *, coo
    00171
    00172          if (inonoe) then
    00173             print *,"Noms des noeuds : "
    00174             print *,nomnoe
    00175          endif
    00176
    00177          if (inunoe) then
    00178             print *,"Numeros des noeuds : "
    00179             print *,numnoe
    00180          endif
    00181
    00182          print *,"Numeros des familles des noeuds : "
    00183          print *,nufano
    00184
    00185       endif
    00186
    00187 ! ** Liberation memoire                                            **
    00188       deallocate(coo,nomnoe,numnoe,nufano);
    00189
    00190 ! **  Code retour
    00191       call efexit(cret)
    00192
    00193       end program test5
    00194
    00195
    00196
    00197
    00198
    00199