# 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 et de l'espace de calcul**
    00034       integer mdim, sdim
    00035 !     ** nom du maillage de longueur maxi MED_SIZE_NAME  **
    00036       character*64 maa
    00037       character*200 desc
    00038 !     ** le nombre de noeuds                              **
    00039       integer nnoe
    00040 !     ** table des coordonnees                            **
    00041       real*8, allocatable, dimension (:) ::  coo,coo1
    00042 !     ** tables des noms et des unites des coordonnees    **
    00043       character*16 nomcoo(2)
    00044       character*16 unicoo(2)
    00045 !     ** tables des noms, numeros, numeros de familles des noeuds  **
    00046 !     autant d'elements que de noeuds - les noms ont pout longueur **
    00047 !     MED_SNAME_SIZE=16
    00048       character*16, allocatable, dimension (:) :: nomnoe
    00049       integer,     allocatable, dimension (:) :: numnoe
    00050       integer,     allocatable, dimension (:) :: nufano
    00051       integer i
    00052       logical inonoe,inunoe
    00053       integer type,chgt,tsf
    00054       integer flta(1)
    00055       integer*8 flt(1)
    00056       character(16)  :: dtunit
    00057       integer nstep, stype, atype
    00058       integer swm
    00059
    00060 !     Ouverture du fichier en lecture seule             **
    00061       call mfiope(fid,'test4.med',MED_ACC_RDONLY, cret)
    00062       print *,cret
    00063
    00064 !   ** Lecture des infos concernant le premier maillage **
    00065       if (cret.eq.0) then
    00066          call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
    00067       endif
    00068       if (cret.ne.0) then
    00069          call efexit(-1)
    00070       endif
    00071
    00072
    00073 !   ** Combien de noeuds a lire  **
    00074       if (cret.eq.0) then
    00075          nnoe = 0
    00076          call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,MED_COORDINATE,MED_NO_CMODE,chgt,tsf,nnoe,cret)
    00077       endif
    00078       print *,cret,' Nombre de noeuds : ',nnoe
    00079       if (cret.ne.0) then
    00080          call efexit(-1)
    00081       endif
    00082
    00083
    00084 !   ** Allocations memoires :  **
    00085 !   ** table des coordonnees   **
    00086 !     profil : (dimension * nombre de noeuds ) **
    00087 !   ** table des des numeros, des numeros de familles des noeuds
    00088 !   ** table des noms des noeuds **
    00089
    00090       allocate( coo(nnoe*sdim),coo1(nnoe*sdim),numnoe(nnoe),nufano(nnoe),nomnoe(nnoe),STAT=ret )
    00091       print *,ret
    00092       coo1(:)=0.0
    00093
    00094 !   ** Lecture des composantes des coordonnees des noeuds  avec et sans filtre     **
    00095       if (cret.eq.0) then
    00096          call mmhcor(fid,maa,MED_NO_DT,MED_NO_IT,MED_FULL_INTERLACE,coo,cret)
    00097       endif
    00098       print *,'Lecture des toutes les composantes des coordonnees : '
    00099       print *,coo
    00100       if (cret.ne.0) then
    00101          call efexit(-1)
    00102       endif
    00103
    00104 !    ** On cree un filtre
    00105      if (cret .eq. 0) then
    00106         call mfrall(1,flt,cret)
    00107      endif
    00108      if (cret.ne.0) then
    00109         call efexit(-1)
    00110      endif
    00111
    00112      if (cret .eq. 0) then
    00113         call mfrcre(fid,nnoe,1,sdim,2,MED_FULL_INTERLACE,MED_GLOBAL_PFLMODE, &
    00114                     MED_NO_PROFILE,MED_UNDEF_SIZE,flta,flt(1),cret)
    00115      endif
    00116      if (cret.ne.0) then
    00117         call efexit(-1)
    00118      endif
    00119
    00120 !   ** Lecture des composantes n°2 des coordonnees des noeuds
    00121       if (cret.eq.0) then
    00122          call mmhcar(fid,maa,MED_NO_DT,MED_NO_IT,flt(1),coo1,cret)
    00123       endif
    00124       print *,'Lecture de la composante numero 2 des coordonnees : '
    00125       print *,coo1
    00126
    00127 !   ** On desalloue le filtre
    00128      if (cret .eq. 0) then
    00129         call mfrdea(1,flt,cret)
    00130      endif
    00131      if (cret.ne.0) then
    00132         call efexit(-1)
    00133      endif
    00134
    00135
    00136 !   ** Lecture des noms des noeuds (optionnel dans un fichier MED)  **
    00137       if (cret.eq.0) then
    00138          call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nomnoe,cret)
    00139       endif
    00140
    00141       if (ret <0) then
    00142          inonoe = .FALSE.
    00143       else
    00144          inonoe = .TRUE.
    00145       endif
    00146
    00147 !  ** Lecture des numeros des noeuds (optionnel dans un fichier MED) **
    00148       if (cret.eq.0) then
    00149          call mmhenr(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,numnoe,cret)
    00150       endif
    00151       if (ret <0) then
    00152          inunoe = .FALSE.
    00153       else
    00154          inunoe = .TRUE.
    00155       endif
    00156
    00157 !   ** Lecture des numeros de familles des noeuds                  **
    00158       if (cret.eq.0) then
    00159          call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nufano,cret)
    00160       endif
    00161       print *,cret
    00162
    00163
    00164 !   ** Fermeture du fichier
    00165       call mficlo(fid,cret)
    00166       if (cret.ne.0) then
    00167          call efexit(-1)
    00168       endif
    00169
    00170
    00171 !  ** Affichage des resulats                                         **
    00172       if (cret.eq.0) then
    00173
    00174
    00175          print *,"Type de repere         : ", atype
    00176          print *,"Nom des coordonnees    : "
    00177          print *, nomcoo
    00178
    00179          print *,"Unites des coordonnees : "
    00180          print *, unicoo
    00181
    00182          print *,"Coordonnees des noeuds : "
    00183          print *, coo
    00184
    00185          if (inonoe) then
    00186             print *,"Noms des noeuds : "
    00187             print *,nomnoe
    00188          endif
    00189
    00190          if (inunoe) then
    00191             print *,"Numeros des noeuds : "
    00192             print *,numnoe
    00193          endif
    00194
    00195          print *,"Numeros des familles des noeuds : "
    00196          print *,nufano
    00197
    00198       endif
    00199
    00200 ! ** Liberation memoire                                            **
    00201       deallocate(coo,coo1,nomnoe,numnoe,nufano);
    00202
    00203
    00204 ! **  Code retour
    00205       call efexit(cret)
    00206
    00207       end program test5
    00208
    00209
    00210
    00211
    00212
    00213