00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 
00024 
00025 program test30
00026   
00027   implicit none
00028   include 'med.hf'
00029 
00030 
00031   integer      ret,cret,fid
00032   character*32 maa,maadst,corr, jnt
00033   integer      mdim,njnt,ncor,domdst,nc,nent
00034   character*32  equ,ent, nodenn, nodent
00035   character*200 des, dcornn, dcornt
00036   integer       i,j,k
00037   character*255 argc
00038    character*200 desc
00039    integer type
00040    
00041    integer entlcl,geolcl, entdst, geodst
00042 
00043    data nodent /"CorresTria3"/
00044    data nodenn /"CorresNodes"/
00045  
00046    print '(A)',"Indiquez le fichier med a decrire : "
00047    
00048    argc = "test29.med"
00049 
00050    
00051    call efouvr(fid,argc,MED_LECTURE, cret)
00052    print '(I1)',cret
00053    
00054      
00055    
00056    if (cret.eq.0) then
00057       call efmaai(fid,1,maa,mdim,type,desc,cret)
00058       print '(A,A,A,I3)',"Maillage de nom : ",maa," et de dimension : ", mdim
00059    endif
00060    print '(I1)',cret
00061 
00062 
00063    
00064    if (cret.eq.0) then
00065       call efnjnt(fid,maa,njnt,cret)
00066       if (cret.eq.0) then
00067          print '(A,I3)',"Nombre de joints : ",njnt
00068       endif
00069    endif
00070  
00071    
00072    if (cret.eq.0) then
00073       do i=1,njnt
00074          print '(A,I3)',"Joint numero : ",i
00075          
00076          if (cret.eq.0) then
00077             call efjnti(fid,maa,i,jnt,des,domdst,maadst,cret)
00078          endif
00079          print '(I1)',cret
00080          if (cret.eq.0) then
00081             print '(A,A)',"Nom du joint               : ",jnt          
00082             print '(A,A)' ,"Description du joint       : ",des 
00083             print '(A,I3)',"Domaine en regard          : ",domdst
00084             print '(A,A)' ,"Maillage en regard         : ",maadst
00085          endif
00086          
00087          nc=1
00088 
00089          do while (cret>=0)
00090 
00091             call efjtco(fid,maa,jnt,nc,entlcl,geolcl,entdst,geodst,cret)
00092             print '(I3)',cret
00093            
00094             nc=nc+1
00095             if (cret>=0) then
00096                call affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
00097             endif
00098 
00099          end do
00100 
00101 
00102          
00103       end do
00104    end if
00105 
00106 
00107    call efferm (fid,cret)
00108    print '(I2)',cret
00109    
00110 
00111 
00112 
00113 
00114    call efexit(cret)
00115 
00116  end program test30
00117         
00118 
00119  subroutine affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
00120    
00121    implicit none
00122    include 'med.hf'
00123 
00124    character*(*) maa,jnt
00125    character*200 des;
00126    integer ret,cret,ncor,ntypnent,i,j,fid,nent,ntypent
00127    integer entlcl,geolcl, entdst, geodst
00128    integer, allocatable, dimension(:) :: cortab
00129 
00130    
00131    call efjnco(fid,maa,jnt,entlcl,geolcl,entdst,geodst,ncor,cret)
00132    print '(I3,i5)',cret,ncor
00133            
00134 
00135    
00136    if (cret.eq.0) then
00137 
00138       print '(A,I4,A,I4,A,I4,A,I4,A)','correspondance entre les types : (',entlcl,'/',geolcl,') et (',entdst,'/',geodst,')'
00139       print '(A,I4)','nombre de type de couples d''entite en regard ',ncor
00140 
00141 
00142 
00143       allocate(cortab(ncor*2),STAT=ret)
00144       call efjntl(fid,maa,jnt,cortab,ncor,entlcl,geolcl,entdst,geodst,cret)
00145       do j=0,(ncor-1)
00146          print '(A,I3,A,I4,A,I4)',"Correspondance ",j+1," : ",cortab(2*j+1)," et ",cortab(2*j+2)
00147       end do
00148       deallocate(cortab)
00149    end if
00150 
00151 
00152          
00153    return
00154  end subroutine affCorr
00155 
00156 
00157