MED fichier: Fichier source de test15.f90

MED fichier

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

test15.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 : 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 ret,cret, fid;
34 ! ** la dimension du maillage **
35 integer mdim,sdim
36 ! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
37 character*64 maa
38 character*200 desc
39 ! ** le nombre de noeuds **
40 integer :: nnoe = 0
41 ! ** table des coordonnees **
42 real*8, allocatable, dimension(:) :: coo
43 ! ** tables des noms et des unites des coordonnees
44 ! profil : (dimension) **
45 character*16 nomcoo(2)
46 character*16 unicoo(2)
47 character*16 dtunit
48 ! ** tables des noms, numeros, numeros de familles des noeuds
49 ! autant d'elements que de noeuds - les noms ont pout longueur
50 ! MED_SNAME_SIZE **
51 character*16, allocatable, dimension(:) :: nomnoe
52 integer, allocatable, dimension(:) :: numnoe,nufano
53 integer rep
54 integer inonoe,inunoe,inufa
55 character*16 str
56 integer i
57 character*255 argc
58 integer type,nstep,stype
59 integer chgt,tsf
60
61 ! ** Ouverture du fichier **
62 call mfiope(fid,"test14.med",med_acc_rdonly, cret)
63 print *,cret
64
65
66 ! ** Lecture des infos concernant le premier maillage **
67 if (cret.eq.0) then
68 call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
69 print *,"Maillage de nom : ",maa," et de dimension : ",mdim
70 endif
71 print *,cret
72
73 ! ** Lecture du nombre de noeud **
74 if (cret.eq.0) then
75 call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
76 print *,"Nombre de noeuds : ",nnoe
77 endif
78 print *,cret
79
80 ! ** Allocations memoires **
81 ! ** table des coordonnees
82 ! ** profil : (dimension * nombre de noeuds ) **
83 allocate (coo(nnoe*sdim),stat=ret)
84 ! ** table des des numeros, des numeros de familles des noeuds
85 ! profil : (nombre de noeuds) **
86 allocate (numnoe(nnoe),nufano(nnoe),stat=ret)
87 ! ** table des noms des noeuds
88 ! profil : (nnoe*MED_TAILLE_PNOM+1) **
89 allocate (nomnoe(nnoe),stat=ret)
90
91 ! ** Lecture des noeuds :
92 ! - Coordonnees
93 ! - Noms (optionnel dans un fichier MED)
94 ! - Numeros (optionnel dans un fichier MED)
95 ! - Numeros de familles **
96 if (cret.eq.0) then
97 call mmhnor(fid,maa,med_no_dt,med_no_it,med_full_interlace,coo,inonoe,nomnoe,inunoe,numnoe,inufa,nufano,cret)
98 endif
99
100 ! ** Affichage des resulats **
101 if (cret.eq.0) then
102 print *,"Type de repere : ",rep
103 print *,"Nom des coordonnees : ",nomcoo
104
105 print *,"Unites des coordonnees : ",unicoo
106
107 print *,"Coordonnees des noeuds : ",coo
108
109 if (inonoe .eq. med_true) then
110 print *,"Noms des noeuds : |",nomnoe,"|"
111 endif
112
113 if (inunoe .eq. med_true) then
114 print *,"Numeros des noeuds : ",numnoe
115 endif
116
117 if (inufa .eq. med_true) then
118 print *,"Numeros des familles des noeuds : ",nufano
119 else
120 print *,"Numeros des familles des noeuds : 0"
121 endif
122
123 endif
124
125 ! ** Liberation memoire **
126 deallocate(coo,nomnoe,numnoe,nufano)
127
128 ! ** Fermeture du fichier **
129 call mficlo(fid,cret)
130 print *,cret
131
132 ! **Code retour
133 call efexit(cret)
134
135 end program test15
136
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 séquence de calcul do...
Definition: medmesh.f:669
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
test15
program test15
Definition: test15.f90:27
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41