      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