# test15.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 : test15.f90
    00020 ! *
    00021 ! * - Description : lecture des noeuds d'un maillage MED.
    00022 ! *                 a l'aide des routines de niveau 2
    00023 ! *                 - equivalent a test5.f90
    00024 ! *
    00025 ! ******************************************************************************
    00026
    00027 program test15
    00028
    00029   implicit none
    00030   include 'med.hf'
    00031 !
    00032 !
    00033   integer  ret,cret, fid;
    00034   !  ** la dimension du maillage                        **
    00035   integer mdim,sdim
    00036   !  ** nom du maillage de longueur maxi MED_TAILLE_NOM **
    00037   character*64 maa
    00038   character*200 desc
    00039   !  ** le nombre de noeuds                             **
    00040   integer :: nnoe = 0
    00041   !  ** table des coordonnees                           **
    00042   real*8, allocatable, dimension(:) :: coo
    00043   !  ** tables des noms et des unites des coordonnees
    00044   !     profil : (dimension)                            **
    00045   character*16 nomcoo(2)
    00046   character*16 unicoo(2)
    00047   character*16 dtunit
    00048   !  ** tables des noms, numeros, numeros de familles des noeuds
    00049   !     autant d'elements que de noeuds - les noms ont pout longueur
    00050   !     MED_SNAME_SIZE **
    00051   character*16, allocatable, dimension(:) ::  nomnoe
    00052   integer,      allocatable, dimension(:) ::  numnoe,nufano
    00053   integer rep
    00054   integer inonoe,inunoe,inufa
    00055   character*16 str
    00056   integer i
    00057   character*255 argc
    00058   integer type,nstep,stype
    00059   integer chgt,tsf
    00060
    00061   !  ** Ouverture du fichier **
    00062   call mfiope(fid,"test14.med",MED_ACC_RDONLY, cret)
    00063   print *,cret
    00064
    00065
    00066   !  ** Lecture des infos concernant le premier maillage **
    00067   if (cret.eq.0) then
    00068      call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
    00069      print *,"Maillage de nom : ",maa," et de dimension : ",mdim
    00070   endif
    00071   print *,cret
    00072
    00073   ! ** Lecture du nombre de noeud **
    00074   if (cret.eq.0) then
    00075      call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,MED_COORDINATE,MED_NO_CMODE,chgt,tsf,nnoe,cret)
    00076      print *,"Nombre de noeuds : ",nnoe
    00077   endif
    00078   print *,cret
    00079
    00080   ! ** Allocations memoires **
    00081   ! ** table des coordonnees
    00082   ! ** profil : (dimension * nombre de noeuds ) **
    00083   allocate (coo(nnoe*sdim),STAT=ret)
    00084   ! ** table des des numeros, des numeros de familles des noeuds
    00085   !   profil : (nombre de noeuds) **
    00086   allocate (numnoe(nnoe),nufano(nnoe),STAT=ret)
    00087   ! ** table des noms des noeuds
    00088   !   profil : (nnoe*MED_TAILLE_PNOM+1) **
    00089   allocate (nomnoe(nnoe),STAT=ret)
    00090
    00091   ! ** Lecture des noeuds :
    00092   !     - Coordonnees
    00093   !     - Noms (optionnel dans un fichier MED)
    00094   !     - Numeros (optionnel dans un fichier MED)
    00095   !     - Numeros de familles   **
    00096   if (cret.eq.0) then
    00097      call mmhnor(fid,maa,MED_NO_DT,MED_NO_IT,MED_FULL_INTERLACE,coo,inonoe,nomnoe,inunoe,numnoe,inufa,nufano,cret)
    00098   endif
    00099
    00100   ! ** Affichage des resulats **
    00101   if (cret.eq.0) then
    00102       print *,"Type de repere : ",rep
    00103       print *,"Nom des coordonnees : ",nomcoo
    00104
    00105       print *,"Unites des coordonnees : ",unicoo
    00106
    00107       print *,"Coordonnees des noeuds : ",coo
    00108
    00109       if (inonoe .eq. MED_TRUE) then
    00110          print *,"Noms des noeuds : |",nomnoe,"|"
    00111       endif
    00112
    00113       if (inunoe .eq. MED_TRUE) then
    00114          print *,"Numeros des noeuds : ",numnoe
    00115       endif
    00116
    00117       if (inufa .eq. MED_TRUE) then
    00118          print *,"Numeros des familles des noeuds : ",nufano
    00119       else
    00120          print *,"Numeros des familles des noeuds : 0"
    00121       endif
    00122
    00123    endif
    00124
    00125   ! ** Liberation memoire **
    00126    deallocate(coo,nomnoe,numnoe,nufano)
    00127
    00128   ! ** Fermeture du fichier **
    00129    call mficlo(fid,cret)
    00130    print *,cret
    00131
    00132   ! **Code retour
    00133    call efexit(cret)
    00134
    00135  end program test15
    00136