1 !*************************************************************************
2 ! COPYRIGHT (C) 1999 - 2007 EDF R&D, CEA/DEN
3 ! THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
4 ! IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE
5 ! AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION;
6 ! EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
7 !
8 ! THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
9 ! WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
10 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
11 ! LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
12 !
13 ! YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
14 ! ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
15 ! INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
16 !
17 !**************************************************************************
18
19 ! ******************************************************************************
20 ! * - Nom du fichier : test30.f90
21 ! *
22 ! * - Description : lecture des joints dans un maillage MED.
23 ! *
24 ! ******************************************************************************
25
26 program test30
27
28 implicit none
29 include 'med.hf'
30 !
31 !
32 integer ret,cret,fid
33 character*32 maa,maadst,corr, jnt
34 integer mdim,njnt,ncor,domdst,nc,nent
35 character*32 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
42 integer entlcl,geolcl, entdst, geodst
43
44 data nodent /"CorresTria3"/
45 data nodenn /"CorresNodes"/
46
47 print '(A)',"Indiquez le fichier med a decrire : "
48 !!read(*,*) argc
49 argc = "test29.med"
50
51 ! ** Ouverture du fichier en lecture seule **
52 call efouvr(fid,argc,MED_LECTURE, cret)
53 print '(I1)',cret
54
55
56 ! ** Lecture des infos sur le premier maillage **
57 if (cret.eq.0) then
58 call efmaai(fid,1,maa,mdim,type,desc,cret)
59 print '(A,A,A,I3)',"Maillage de nom : ",maa," et de dimension : ", mdim
60 endif
61 print '(I1)',cret
62
63
64 ! ** Lecture du nombre de joints **
65 if (cret.eq.0) then
66 call efnjnt(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 efjnti(fid,maa,i,jnt,des,domdst,maadst,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 endif
87
88 nc=1
89
90 do while (cret>=0)
91
92 call efjtco(fid,maa,jnt,nc,entlcl,geolcl,entdst,geodst,cret)
93 print '(I3)',cret
94
95 nc=nc+1
96 if (cret>=0) then
97 call affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
98 endif
99
100 end do
101
102
103
104 end do
105 end if
106
107 ! ** Fermeture du fichier **
108 call efferm (fid,cret)
109 print '(I2)',cret
110
111 call flush(6)
112
113
114 ! ** Code retour
115 call efexit(cret)
116
117 end program test30
118
119
120 subroutine affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
121
122 implicit none
123 include 'med.hf'
124
125 character*(*) maa,jnt
126 character*200 des;
127 integer ret,cret,ncor,ntypnent,i,j,fid,nent,ntypent
128 integer entlcl,geolcl, entdst, geodst
129 integer, allocatable, dimension(:) :: cortab
130
131
132 call efjnco(fid,maa,jnt,entlcl,geolcl,entdst,geodst,ncor,cret)
133 print '(I3,i5)',cret,ncor
134
135
136 !** Lecture des correspondances sur les differents types d'entites connus a priori **
137 if (cret.eq.0) then
138
139 print '(A,I4,A,I4,A,I4,A,I4,A)','correspondance entre les types : (',entlcl,'/',geolcl,') et (',entdst,'/',geodst,')'
140 print '(A,I4)','nombre de type de couples d''entite en regard ',ncor
141
142 call flush(6)
143
144 allocate(cortab(ncor*2),STAT=ret)
145 call efjntl(fid,maa,jnt,cortab,ncor,entlcl,geolcl,entdst,geodst,cret)
146 do j=0,(ncor-1)
147 print '(A,I3,A,I4,A,I4)',"Correspondance ",j+1," : ",cortab(2*j+1)," et ",cortab(2*j+2)
148 end do
149 deallocate(cortab)
150 end if
151
152
153
154 return
155 end subroutine affCorr
156
157
158