MED fichier
test15.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2023 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*8 fid
34  integer ret,cret
35  ! ** la dimension du maillage **
36  integer mdim,sdim
37  ! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
38  character*64 maa
39  character*200 desc
40  ! ** le nombre de noeuds **
41  integer :: nnoe = 0
42  ! ** table des coordonnees **
43  real*8, allocatable, dimension(:) :: coo
44  ! ** tables des noms et des unites des coordonnees
45  ! profil : (dimension) **
46  character*16 nomcoo(2)
47  character*16 unicoo(2)
48  character*16 dtunit
49  ! ** tables des noms, numeros, numeros de familles des noeuds
50  ! autant d'elements que de noeuds - les noms ont pout longueur
51  ! MED_SNAME_SIZE **
52  character*16, allocatable, dimension(:) :: nomnoe
53  integer, allocatable, dimension(:) :: numnoe,nufano
54  integer rep
55  integer inonoe,inunoe,inufa
56  character*16 str
57  integer i
58  character*255 argc
59  integer type,nstep,stype
60  integer chgt,tsf
61 
62  ! ** Ouverture du fichier **
63  call mfiope(fid,"test14.med",med_acc_rdonly, cret)
64  print *,cret
65 
66 
67  ! ** Lecture des infos concernant le premier maillage **
68  if (cret.eq.0) then
69  call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
70  print *,"Maillage de nom : ",maa," et de dimension : ",mdim
71  endif
72  print *,cret
73 
74  ! ** Lecture du nombre de noeud **
75  if (cret.eq.0) then
76  call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
77  print *,"Nombre de noeuds : ",nnoe
78  endif
79  print *,cret
80 
81  ! ** Allocations memoires **
82  ! ** table des coordonnees
83  ! ** profil : (dimension * nombre de noeuds ) **
84  allocate (coo(nnoe*sdim),stat=ret)
85  ! ** table des des numeros, des numeros de familles des noeuds
86  ! profil : (nombre de noeuds) **
87  allocate (numnoe(nnoe),nufano(nnoe),stat=ret)
88  ! ** table des noms des noeuds
89  ! profil : (nnoe*MED_TAILLE_PNOM+1) **
90  allocate (nomnoe(nnoe),stat=ret)
91 
92  ! ** Lecture des noeuds :
93  ! - Coordonnees
94  ! - Noms (optionnel dans un fichier MED)
95  ! - Numeros (optionnel dans un fichier MED)
96  ! - Numeros de familles **
97  if (cret.eq.0) then
98  call mmhnor(fid,maa,med_no_dt,med_no_it,med_full_interlace,coo,inonoe,nomnoe,inunoe,numnoe,inufa,nufano,cret)
99  endif
100 
101  ! ** Affichage des resulats **
102  if (cret.eq.0) then
103  print *,"Type de repere : ",rep
104  print *,"Nom des coordonnees : ",nomcoo
105 
106  print *,"Unites des coordonnees : ",unicoo
107 
108  print *,"Coordonnees des noeuds : ",coo
109 
110  if (inonoe .eq. med_true) then
111  print *,"Noms des noeuds : |",nomnoe,"|"
112  endif
113 
114  if (inunoe .eq. med_true) then
115  print *,"Numeros des noeuds : ",numnoe
116  endif
117 
118  if (inufa .eq. med_true) then
119  print *,"Numeros des familles des noeuds : ",nufano
120  else
121  print *,"Numeros des familles des noeuds : 0"
122  endif
123 
124  endif
125 
126  ! ** Liberation memoire **
127  deallocate(coo,nomnoe,numnoe,nufano)
128 
129  ! ** Fermeture du fichier **
130  call mficlo(fid,cret)
131  print *,cret
132 
133  ! **Code retour
134  call efexit(cret)
135 
136  end program test15
137 
mmhmii
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:110
test15
program test15
Definition: test15.f90:27
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mmhnme
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 étape de calcul donnée.
Definition: medmesh.f:551
mmhnor
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 étape de calcul donné...
Definition: medmesh.f:701
str
#define str(s)
Definition: mdump2.c:126
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42