MED fichier
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 
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
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
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
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
program test30
Definition: test30.f90:25
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
subroutine msdnjn(fid, maa, n, cret)
Cette routine permet la lecture du nombre de joint dans un maillage.
Definition: medjoint.f:70
subroutine affcorr(fid, maa, jnt, entlcl, geolcl, entdst, geodst)
Definition: test30.f90:116
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41