MED fichier
test15.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2016 EDF R&D, CEA/DEN
4 !* MED is free software: you can redistribute it and/or modify
5 !* it under the terms of the GNU Lesser General Public License as published by
6 !* the Free Software Foundation, either version 3 of the License, or
7 !* (at your option) any later version.
8 !*
9 !* MED is distributed in the hope that it will be useful,
10 !* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 !* GNU Lesser General Public License for more details.
13 !*
14 !* You should have received a copy of the GNU Lesser General Public License
15 !* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 !*
17 
18 ! *******************************************************************************
19 ! * - Nom du fichier : test15.f90
20 ! *
21 ! * - Description : lecture des noeuds d'un maillage MED.
22 ! * a l'aide des routines de niveau 2
23 ! * - equivalent a test5.f90
24 ! *
25 ! ******************************************************************************
26 
27 program test15
28 
29  implicit none
30  include 'med.hf90'
31 !
32 !
33  integer ret,cret, fid;
34  ! ** la dimension du maillage **
35  integer mdim,sdim
36  ! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
37  character*64 maa
38  character*200 desc
39  ! ** le nombre de noeuds **
40  integer :: nnoe = 0
41  ! ** table des coordonnees **
42  real*8, allocatable, dimension(:) :: coo
43  ! ** tables des noms et des unites des coordonnees
44  ! profil : (dimension) **
45  character*16 nomcoo(2)
46  character*16 unicoo(2)
47  character*16 dtunit
48  ! ** tables des noms, numeros, numeros de familles des noeuds
49  ! autant d'elements que de noeuds - les noms ont pout longueur
50  ! MED_SNAME_SIZE **
51  character*16, allocatable, dimension(:) :: nomnoe
52  integer, allocatable, dimension(:) :: numnoe,nufano
53  integer rep
54  integer inonoe,inunoe,inufa
55  character*16 str
56  integer i
57  character*255 argc
58  integer type,nstep,stype
59  integer chgt,tsf
60 
61  ! ** Ouverture du fichier **
62  call mfiope(fid,"test14.med",med_acc_rdonly, cret)
63  print *,cret
64 
65 
66  ! ** Lecture des infos concernant le premier maillage **
67  if (cret.eq.0) then
68  call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
69  print *,"Maillage de nom : ",maa," et de dimension : ",mdim
70  endif
71  print *,cret
72 
73  ! ** Lecture du nombre de noeud **
74  if (cret.eq.0) then
75  call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
76  print *,"Nombre de noeuds : ",nnoe
77  endif
78  print *,cret
79 
80  ! ** Allocations memoires **
81  ! ** table des coordonnees
82  ! ** profil : (dimension * nombre de noeuds ) **
83  allocate (coo(nnoe*sdim),stat=ret)
84  ! ** table des des numeros, des numeros de familles des noeuds
85  ! profil : (nombre de noeuds) **
86  allocate (numnoe(nnoe),nufano(nnoe),stat=ret)
87  ! ** table des noms des noeuds
88  ! profil : (nnoe*MED_TAILLE_PNOM+1) **
89  allocate (nomnoe(nnoe),stat=ret)
90 
91  ! ** Lecture des noeuds :
92  ! - Coordonnees
93  ! - Noms (optionnel dans un fichier MED)
94  ! - Numeros (optionnel dans un fichier MED)
95  ! - Numeros de familles **
96  if (cret.eq.0) then
97  call mmhnor(fid,maa,med_no_dt,med_no_it,med_full_interlace,coo,inonoe,nomnoe,inunoe,numnoe,inufa,nufano,cret)
98  endif
99 
100  ! ** Affichage des resulats **
101  if (cret.eq.0) then
102  print *,"Type de repere : ",rep
103  print *,"Nom des coordonnees : ",nomcoo
104 
105  print *,"Unites des coordonnees : ",unicoo
106 
107  print *,"Coordonnees des noeuds : ",coo
108 
109  if (inonoe .eq. med_true) then
110  print *,"Noms des noeuds : |",nomnoe,"|"
111  endif
112 
113  if (inunoe .eq. med_true) then
114  print *,"Numeros des noeuds : ",numnoe
115  endif
116 
117  if (inufa .eq. med_true) then
118  print *,"Numeros des familles des noeuds : ",nufano
119  else
120  print *,"Numeros des familles des noeuds : 0"
121  endif
122 
123  endif
124 
125  ! ** Liberation memoire **
126  deallocate(coo,nomnoe,numnoe,nufano)
127 
128  ! ** Fermeture du fichier **
129  call mficlo(fid,cret)
130  print *,cret
131 
132  ! **Code retour
133  call efexit(cret)
134 
135  end program test15
136 
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
subroutine mmhnor(fid, name, numdt, numit, swm, coo, iname, nname, inum, num, ifam, fam, cret)
Cette routine permet la lecture des noeuds d'un maillage non structuré pour une séquence de calcul do...
Definition: medmesh.f:669
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
Definition: medmesh.f:106
program test15
Definition: test15.f90:27
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une séquence de calcul donnée...
Definition: medmesh.f:525