00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDlink2
00023 
00024       implicit none
00025       include 'med.hf'
00026 
00027 
00028       integer cret
00029       integer fid
00030       character*64 fname
00031       parameter (fname = "Unittest_MEDlink_1.med")
00032       character*64 mname1, mname2,lname1,lname2
00033       parameter(mname1 = "mesh name")
00034       parameter(lname1 = "/local/study1/filename.med")
00035       parameter(mname2 = "second mesh name")
00036       parameter(lname2 = "/local/study2/filename.med")
00037       integer lsize,lsize1,lsize2 
00038       parameter (lsize1=26, lsize2=26)
00039       character*64 lname
00040 
00041 
00042 
00043       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00044       print *,'Open file',cret
00045       if (cret .ne. 0 ) then
00046          print *,'ERROR : open file'
00047          call efexit(-1)
00048       endif 
00049 
00050 
00051 
00052       call mlnlai(fid, mname1, lsize, cret)
00053       print *,'read link information',cret,lsize
00054       if (cret .ne. 0 .or.
00055      &    lsize .ne. lsize1 ) then
00056          print *,'ERROR : link information'
00057          call efexit(-1)
00058       endif 
00059 
00060       call mlnlai(fid, mname2, lsize, cret)
00061       print *,'read link information',cret,lsize
00062       if (cret .ne. 0 .or.
00063      &    lsize .ne. lsize2 ) then
00064          print *,'ERROR : link information'
00065          call efexit(-1)
00066       endif 
00067 
00068 
00069 
00070       call mlnlir(fid,mname1,lname,cret)
00071       print *,'read link',cret,lname
00072       if (cret .ne. 0 ) then
00073          print *,'ERROR : read link'
00074          call efexit(-1)
00075       endif 
00076 
00077       call mlnlir(fid,mname2,lname,cret)
00078       print *,'read link',cret,lname
00079       if (cret .ne. 0 ) then
00080          print *,'ERROR : read link'
00081          call efexit(-1)
00082       endif 
00083 
00084 
00085 
00086       call mficlo(fid,cret)
00087       print *,'Close file',cret
00088       if (cret .ne. 0 ) then
00089          print *,'ERROR :  close file'
00090          call efexit(-1)
00091       endif  
00092 
00093 
00094 
00095       end
00096