MED fichier: Fichier source de test30.f90

MED fichier

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

test30.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 : test30.f90
20 ! *
21 ! * - Description : lecture des joints dans un maillage MED.
22 ! *
23 ! ******************************************************************************
24
25 program test30
26
27 implicit none
28 include 'med.hf90'
29 !
30 !
31 integer ret,cret,fid,edim
32 character*64 maa,maadst,corr,jnt
33 integer mdim,njnt,ncor,domdst,nc,nent
34 character*64 equ,ent, nodenn, nodent
35 character*200 des, dcornn, dcornt
36 integer i,j,k
37 character*255 argc
38 character*200 desc
39 integer type
40 integer nstep,stype,atype
41 character*16 nomcoo(2)
42 character*16 unicoo(2)
43 character*16 dtunit
44 integer entlcl,geolcl, entdst, geodst
45
46 data nodent /"CorresTria3"/
47 data nodenn /"CorresNodes"/
48
49 argc = "test29.med"
50
51 ! ** Ouverture du fichier en lecture seule **
52 call mfiope(fid,argc,med_acc_rdonly, cret)
53 print '(I1)',cret
54
55
56 ! ** Lecture des infos sur le premier maillage **
57 if (cret.eq.0) then
58 call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
59 print '(A,A,A,I3)',"Maillage de nom : ",maa
60 endif
61 print '(I1)',cret
62
63
64 ! ** Lecture du nombre de joints **
65 if (cret.eq.0) then
66 call msdnjn(fid,maa,njnt,cret)
67 if (cret.eq.0) then
68 print '(A,I3)',"Nombre de joints : ",njnt
69 endif
70 endif
71
72 !** Lecture de tous les joints **
73 if (cret.eq.0) then
74 do i=1,njnt
75 print '(A,I3)',"Joint numero : ",i
76 !** Lecture des infos sur le joint **
77 if (cret.eq.0) then
78 call msdjni(fid,maa,i,jnt,des,domdst,maadst,nstep,ncor,cret)
79 endif
80 print '(I1)',cret
81 if (cret.eq.0) then
82 print '(A,A)',"Nom du joint : ",jnt
83 print '(A,A)' ,"Description du joint : ",des
84 print '(A,I3)',"Domaine en regard : ",domdst
85 print '(A,A)' ,"Maillage en regard : ",maadst
86 print '(A,I3)',"Nombre de sequence : ",nstep
87 print '(A,I3)',"Nombre de correspondance (NO_DT,NO_IT) : ",ncor
88 endif
89
90 do nc=1,ncor
91 call msdszi(fid,maa,jnt,med_no_dt,med_no_it,nc,entlcl,geolcl,entdst,geodst,ncor,cret)
92 print '(I3)',cret
93 if (cret>=0) then
94 call affcorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
95 endif
96 enddo
97
98
99 end do
100 end if
101
102 ! ** Fermeture du fichier **
103 call mficlo (fid,cret)
104 print '(I2)',cret
105
106 ! call flush(6)
107
108
109 ! ** Code retour
110 call efexit(cret)
111
112 end program test30
113
114
115 subroutine affcorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
116
117 implicit none
118 include 'med.hf90'
119
120 character*(*) maa,jnt
121 character*200 des;
122 integer ret,cret,ncor,ntypnent,i,j,fid,nent,ntypent
123 integer entlcl,geolcl, entdst, geodst
124 integer, allocatable, dimension(:) :: cortab
125
126
127 call msdcsz(fid,maa,jnt,med_no_dt,med_no_it,entlcl,geolcl,entdst,geodst,ncor,cret)
128 print '(I3,i5)',cret,ncor
129
130
131 !** Lecture des correspondances sur les differents types d'entites connus a priori **
132 if (cret.eq.0) then
133
134 print '(A,I4,A,I4,A,I4,A,I4,A)','correspondance entre les types : (',entlcl,'/',geolcl,') et (',entdst,'/',geodst,')'
135 print '(A,I4)','nombre de type de couples d''entite en regard ',ncor
136
137 ! call flush(6)
138
139 allocate(cortab(ncor*2),stat=ret)
140 call msdcrr(fid,maa,jnt,med_no_dt,med_no_it,entlcl,geolcl,entdst,geodst,cortab,cret)
141 do j=0,(ncor-1)
142 print '(A,I3,A,I4,A,I4)',"Correspondance ",j+1," : ",cortab(2*j+1)," et ",cortab(2*j+2)
143 end do
144 deallocate(cortab)
145 end if
146
147
148
149 return
150 end subroutine affcorr
151
152
153
msdszi
subroutine msdszi(fid, mname, jname, numdt, numit, it, letype, lgtype, retype, rgtype, ncor, cret)
Cette routine permet de lire les informations sur les couples d'entités en correspondance dans un joi...
Definition: medjoint.f:116
msdjni
subroutine msdjni(fid, lmname, ind, jname, des, dom, rmname, nstep, ncor, cret)
Cette routine permet de lire les informations sur un joint dans un maillage.
Definition: medjoint.f:94
msdcrr
subroutine msdcrr(fid, lmname, jname, numdt, numit, entlcl, geolcl, entdst, geodst, corrtab, cret)
Cette routine permet la lecture d'une correspondance dans un joint pour un type de couple d'entité en...
Definition: medjoint.f:167
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
msdcsz
subroutine msdcsz(fid, mname, jname, numdt, numit, letype, lgtype, retype, rgtype, ncor, cret)
Cette routine permet la lecture du nombre d'entités en correspondance dans un joint pour un couple d'...
Definition: medjoint.f:142
test30
program test30
Definition: test30.f90:25
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
msdnjn
subroutine msdnjn(fid, maa, n, cret)
Cette routine permet la lecture du nombre de joint dans un maillage.
Definition: medjoint.f:70
affcorr
subroutine affcorr(fid, maa, jnt, entlcl, geolcl, entdst, geodst)
Definition: test30.f90:116
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41