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 - 2019 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*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
msdcsz
subroutine msdcsz(fid, mname, jname, numdt, numit, letype, lgtype, retype, rgtype, ncor, cret)
Definition: medjoint.f:145
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
msdjni
subroutine msdjni(fid, lmname, ind, jname, des, dom, rmname, nstep, ncor, cret)
Definition: medjoint.f:95
test30
program test30
Definition: test30.f90:25
mfiope
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
msdszi
subroutine msdszi(fid, mname, jname, numdt, numit, it, letype, lgtype, retype, rgtype, ncor, cret)
Definition: medjoint.f:118
msdcrr
subroutine msdcrr(fid, lmname, jname, numdt, numit, entlcl, geolcl, entdst, geodst, corrtab, cret)
Definition: medjoint.f:171
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82
msdnjn
subroutine msdnjn(fid, maa, n, cret)
Cette routine permet la lecture du nombre de joint dans un maillage.
Definition: medjoint.f:71
affcorr
subroutine affcorr(fid, maa, jnt, entlcl, geolcl, entdst, geodst)
Definition: test30.f90:117