MED fichier: Fichier source de test15.f90

MED fichier

test15.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2023 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 : test15.f90
20 ! *
21 ! * - Description : lecture des noeuds d'un maillage MED.
22 ! * a l'aide des routines de niveau 2
23 ! * - equivalent a test5.f90
24 ! *
25 ! ******************************************************************************
26
27 program test15
28
29 implicit none
30 include 'med.hf90'
31 !
32 !
33 integer*8 fid
34 integer ret,cret
35 ! ** la dimension du maillage **
36 integer mdim,sdim
37 ! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
38 character*64 maa
39 character*200 desc
40 ! ** le nombre de noeuds **
41 integer :: nnoe = 0
42 ! ** table des coordonnees **
43 real*8, allocatable, dimension(:) :: coo
44 ! ** tables des noms et des unites des coordonnees
45 ! profil : (dimension) **
46 character*16 nomcoo(2)
47 character*16 unicoo(2)
48 character*16 dtunit
49 ! ** tables des noms, numeros, numeros de familles des noeuds
50 ! autant d'elements que de noeuds - les noms ont pout longueur
51 ! MED_SNAME_SIZE **
52 character*16, allocatable, dimension(:) :: nomnoe
53 integer, allocatable, dimension(:) :: numnoe,nufano
54 integer rep
55 integer inonoe,inunoe,inufa
56 character*16 str
57 integer i
58 character*255 argc
59 integer type,nstep,stype
60 integer chgt,tsf
61
62 ! ** Ouverture du fichier **
63 call mfiope(fid,"test14.med",med_acc_rdonly, cret)
64 print *,cret
65
66
67 ! ** Lecture des infos concernant le premier maillage **
68 if (cret.eq.0) then
69 call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
70 print *,"Maillage de nom : ",maa," et de dimension : ",mdim
71 endif
72 print *,cret
73
74 ! ** Lecture du nombre de noeud **
75 if (cret.eq.0) then
76 call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
77 print *,"Nombre de noeuds : ",nnoe
78 endif
79 print *,cret
80
81 ! ** Allocations memoires **
82 ! ** table des coordonnees
83 ! ** profil : (dimension * nombre de noeuds ) **
84 allocate (coo(nnoe*sdim),stat=ret)
85 ! ** table des des numeros, des numeros de familles des noeuds
86 ! profil : (nombre de noeuds) **
87 allocate (numnoe(nnoe),nufano(nnoe),stat=ret)
88 ! ** table des noms des noeuds
89 ! profil : (nnoe*MED_TAILLE_PNOM+1) **
90 allocate (nomnoe(nnoe),stat=ret)
91
92 ! ** Lecture des noeuds :
93 ! - Coordonnees
94 ! - Noms (optionnel dans un fichier MED)
95 ! - Numeros (optionnel dans un fichier MED)
96 ! - Numeros de familles **
97 if (cret.eq.0) then
98 call mmhnor(fid,maa,med_no_dt,med_no_it,med_full_interlace,coo,inonoe,nomnoe,inunoe,numnoe,inufa,nufano,cret)
99 endif
100
101 ! ** Affichage des resulats **
102 if (cret.eq.0) then
103 print *,"Type de repere : ",rep
104 print *,"Nom des coordonnees : ",nomcoo
105
106 print *,"Unites des coordonnees : ",unicoo
107
108 print *,"Coordonnees des noeuds : ",coo
109
110 if (inonoe .eq. med_true) then
111 print *,"Noms des noeuds : |",nomnoe,"|"
112 endif
113
114 if (inunoe .eq. med_true) then
115 print *,"Numeros des noeuds : ",numnoe
116 endif
117
118 if (inufa .eq. med_true) then
119 print *,"Numeros des familles des noeuds : ",nufano
120 else
121 print *,"Numeros des familles des noeuds : 0"
122 endif
123
124 endif
125
126 ! ** Liberation memoire **
127 deallocate(coo,nomnoe,numnoe,nufano)
128
129 ! ** Fermeture du fichier **
130 call mficlo(fid,cret)
131 print *,cret
132
133 ! **Code retour
134 call efexit(cret)
135
136 end program test15
137
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
test15
program test15
Definition: test15.f90:27
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
mmhnor
subroutine mmhnor(fid, name, numdt, numit, swm, coo, iname, nname, inum, num, ifam, fam, cret)
Cette routine permet la lecture des noeuds d'un maillage non structuré pour une étape de calcul donné...
Definition: medmesh.f:701
str
#define str(s)
Definition: mdump2.c:126
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42