MED fichier: Fichier source de test17.f90

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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