MED fichier
test17.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 : 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*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
mmhelr
subroutine mmhelr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, iname, nname, inum, num, ifam, fam, cret)
Definition: medmesh.f:778
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
test17
program test17
Definition: test17.f90:27
mfiope
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551