MED fichier
test30.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2021 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 
msdszi
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
affcorr
subroutine affcorr(fid, maa, jnt, entlcl, geolcl, entdst, geodst)
Definition: test30.f90:117
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
msdjni
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
msdcsz
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
test30
program test30
Definition: test30.f90:25
mmhmii
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
msdcrr
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:173
msdnjn
subroutine msdnjn(fid, maa, n, cret)
Cette routine permet la lecture du nombre de joint dans un maillage.
Definition: medjoint.f:72