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