MED fichier: Fichier source de test17.f90

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