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