MED fichier
test17.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2021 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
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 étape de calcul donnée.
Definition: medmesh.f:551
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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:110
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 étape de cal...
Definition: medmesh.f:778