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