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 
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 
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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:110
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:97
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:147
subroutine msdnjn(fid, maa, n, cret)
Cette routine permet la lecture du nombre de joint dans un maillage.
Definition: medjoint.f:72
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:120
subroutine msdcrr(fid, lmname, jname, numdt, numit, entlcl, geolcl, entdst, geodst, corrtab, cret)
Definition: medjoint.f:173
subroutine affcorr(fid, maa, jnt, entlcl, geolcl, entdst, geodst)
Definition: test30.f90:117
program test30
Definition: test30.f90:25