MED fichier
test15.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2019 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 
subroutine mmhnor(fid, name, numdt, numit, swm, coo, iname, nname, inum, num, ifam, fam, cret)
Definition: medmesh.f:701
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
program test15
Definition: test15.f90:27
subroutine mficlo(fid, cret)
Definition: medfile.f:82