MED fichier
test15.f90
Aller à la documentation de ce fichier.
1!* This file is part of MED.
2!*
3!* COPYRIGHT (C) 1999 - 2020 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
27program 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
#define str(s)
Definition mdump2.c:127
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
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
program test15
Definition test15.f90:27