MED fichier
test17.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 : test17.f90
20! *
21! * - Description : lecture d'elements de maillages MED ecrits par test16
22! * via les routines de niveau 2
23! * - equivalent a test17.f90
24! *
25! ******************************************************************************
26
27program test17
28
29 implicit none
30 include 'med.hf90'
31
32 integer*8 fid
33 integer :: cret, ret, nse2, mdim, sdim
34 integer, allocatable, dimension(:) ::se2
35 character*16, allocatable, dimension(:) ::nomse2
36 integer, allocatable, dimension(:) ::numse2,nufase2
37 integer ntr3
38 integer, allocatable, dimension(:) ::tr3
39 character*16, allocatable, dimension(:) ::nomtr3
40 integer, allocatable, dimension(:) ::numtr3
41 integer, allocatable, dimension(:) ::nufatr3
42 character*64 :: maa
43 character*200 :: desc
44 integer :: inoele1,inuele1,inoele2,inuele2,ifaele1,ifaele2
45 integer tse2,ttr3
46 integer i,type,rep,nstep,stype
47 integer chgt,tsf
48 character*16 nomcoo(2)
49 character*16 unicoo(2)
50 character*16 dtunit
51
52 ! ** Ouverture du fichier test16.med en lecture seule **
53 call mfiope(fid,'test16.med',med_acc_rdonly, cret)
54 print *,cret
55
56 ! ** Lecture des informations sur le 1er maillage **
57 if (cret.eq.0) then
58 call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
59 print *,"Maillage de nom : ",maa," et de dimension ",mdim
60 endif
61 print *,cret
62
63 ! ** Lecture du nombre de triangles et de segments **
64 if (cret.eq.0) then
65 call mmhnme(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_connectivity,med_descending,chgt,tsf,nse2,cret)
66 endif
67 print *,cret
68
69 if (cret.eq.0) then
70 call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_descending,chgt,tsf,ntr3,cret)
71 endif
72 print *,cret
73
74 print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
75
76 ! ** Allocations memoire **
77 tse2 = 2;
78 allocate(se2(tse2*nse2),nomse2(nse2),numse2(nse2),nufase2(nse2),stat=ret)
79 ttr3 = 3;
80 allocate(tr3(ntr3*ttr3),nomtr3(ntr3),numtr3(ntr3),nufatr3(ntr3),stat=ret)
81
82 ! ** Lecture des aretes segments MED_SEG2 :
83 ! - Connectivite,
84 ! - Noms (optionnel)
85 ! - Numeros (optionnel)
86 ! - Numeros de familles **
87 if (cret.eq.0) then
88 call mmhelr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending,med_no_interlace,se2,&
89 inoele1,nomse2,inuele1,numse2,ifaele1,nufase2,cret)
90 endif
91 print *,cret
92
93
94 ! ** lecture des mailles triangles MED_TRIA3 :
95 ! - Connectivite,
96 ! - Noms (optionnel)
97 ! - Numeros (optionnel)
98 ! - Numeros de familles **
99 if (cret.eq.0) then
100 call mmhelr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_descending,med_no_interlace,tr3,&
101 inoele2,nomtr3,inuele2,numtr3,ifaele2,nufatr3,cret)
102 endif
103 print *,cret
104
105 ! ** Fermeture du fichier **
106 call mficlo(fid,cret)
107 print *,cret
108
109 ! ** Affichage **
110 if (cret.eq.0) then
111 print *,"Connectivite des segments : ",se2
112
113 if (inoele1 .eq. med_true) then
114 print *,"Noms des segments : ",nomse2
115 endif
116
117 if (inuele1 .eq. med_true) then
118 print *,"Numeros des segments : ",numse2
119 endif
120
121 print *,"Numeros des familles des segments : ",nufase2
122
123
124 print *,"Connectivite des triangles : ",tr3
125
126 if (inoele2 .eq. med_true) then
127 print *,"Noms des triangles :", nomtr3
128 endif
129
130 if (inuele2 .eq. med_true) then
131 print *,"Numeros des triangles :", numtr3
132 endif
133
134 print *,"Numeros des familles des triangles :", nufatr3
135
136 end if
137
138
139 ! ** Nettoyage memoire **
140 deallocate(se2,nomse2,numse2,nufase2);
141 deallocate(tr3,nomtr3,numtr3,nufatr3);
142
143 ! ** Code retour
144 call efexit(cret)
145
146 end program test17
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mmhelr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, iname, nname, inum, num, ifam, fam, cret)
Definition medmesh.f:778
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 test17
Definition test17.f90:27