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.hf90'
00029 
00030 
00031   integer      ret,cret,fid,edim
00032   character*64 maa,maadst,corr,jnt
00033   integer      mdim,njnt,ncor,domdst,nc,nent
00034   character*64  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   integer nstep,stype,atype
00041   character*16 nomcoo(2)
00042   character*16 unicoo(2)
00043   character*16 dtunit
00044   integer entlcl,geolcl, entdst, geodst
00045   
00046   data nodent /"CorresTria3"/
00047   data nodenn /"CorresNodes"/
00048   
00049   argc = "test29.med"
00050   
00051   
00052   call mfiope(fid,argc,MED_ACC_RDONLY, cret)
00053   print '(I1)',cret
00054   
00055      
00056   
00057   if (cret.eq.0) then
00058       call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00059       print '(A,A,A,I3)',"Maillage de nom : ",maa
00060    endif
00061    print '(I1)',cret
00062    
00063 
00064    
00065    if (cret.eq.0) then
00066       call  msdnjn(fid,maa,njnt,cret)
00067       if (cret.eq.0) then
00068          print '(A,I3)',"Nombre de joints : ",njnt
00069       endif
00070    endif
00071    
00072    
00073    if (cret.eq.0) then
00074       do i=1,njnt
00075          print '(A,I3)',"Joint numero : ",i
00076          
00077          if (cret.eq.0) then
00078             call msdjni(fid,maa,i,jnt,des,domdst,maadst,nstep,ncor,cret)
00079          endif
00080          print '(I1)',cret
00081          if (cret.eq.0) then
00082             print '(A,A)',"Nom du joint                              : ",jnt          
00083             print '(A,A)' ,"Description du joint                     : ",des 
00084             print '(A,I3)',"Domaine en regard                        : ",domdst
00085             print '(A,A)' ,"Maillage en regard                       : ",maadst
00086             print '(A,I3)',"Nombre de sequence                       : ",nstep
00087             print '(A,I3)',"Nombre de correspondance (NO_DT,NO_IT)   : ",ncor
00088          endif
00089          
00090          do nc=1,ncor
00091             call msdszi(fid,maa,jnt,MED_NO_DT,MED_NO_IT,nc,entlcl,geolcl,entdst,geodst,ncor,cret)
00092             print '(I3)',cret
00093             if (cret>=0) then
00094                call affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
00095             endif
00096          enddo
00097 
00098          
00099       end do
00100    end if
00101 
00102 
00103    call mficlo (fid,cret)
00104    print '(I2)',cret
00105    
00106 
00107 
00108 
00109 
00110    call efexit(cret)
00111    
00112  end program test30
00113         
00114 
00115  subroutine affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
00116    
00117    implicit none
00118    include 'med.hf90'
00119 
00120    character*(*) maa,jnt
00121    character*200 des;
00122    integer ret,cret,ncor,ntypnent,i,j,fid,nent,ntypent
00123    integer entlcl,geolcl, entdst, geodst
00124    integer, allocatable, dimension(:) :: cortab
00125 
00126    
00127    call msdcsz(fid,maa,jnt,MED_NO_DT,MED_NO_IT,entlcl,geolcl,entdst,geodst,ncor,cret)
00128    print '(I3,i5)',cret,ncor
00129            
00130 
00131    
00132    if (cret.eq.0) then
00133 
00134       print '(A,I4,A,I4,A,I4,A,I4,A)','correspondance entre les types : (',entlcl,'/',geolcl,') et (',entdst,'/',geodst,')'
00135       print '(A,I4)','nombre de type de couples d''entite en regard ',ncor
00136 
00137 
00138       
00139       allocate(cortab(ncor*2),STAT=ret)
00140       call msdcrr(fid,maa,jnt,MED_NO_DT,MED_NO_IT,entlcl,geolcl,entdst,geodst,cortab,cret)
00141       do j=0,(ncor-1)
00142          print '(A,I3,A,I4,A,I4)',"Correspondance ",j+1," : ",cortab(2*j+1)," et ",cortab(2*j+2)
00143       end do
00144       deallocate(cortab)
00145    end if
00146 
00147 
00148          
00149    return
00150  end subroutine affCorr
00151 
00152 
00153