Unittest_MEDlink_3.f
Aller à la documentation de ce fichier.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,mname
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(26)
00040 integer nlink,n,i
00041 parameter (nlink=2)
00042
00043
00044
00045 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00046 print *,'Open file',cret
00047 if (cret .ne. 0 ) then
00048 print *,'ERROR : open file'
00049 call efexit(-1)
00050 endif
00051
00052
00053
00054 call mlnnln(fid,n,cret)
00055 print *,'Number of link',cret
00056 if ((cret .ne. 0) .or.
00057 & (n .ne. nlink) ) then
00058 print *,'ERROR : number of link'
00059 call efexit(-1)
00060 endif
00061
00062
00063
00064 do i=1,n
00065 call mlnlni(fid,i,mname,lsize,cret)
00066 print *,'Link information',cret
00067 if (cret .ne. 0) then
00068 print *,'ERROR : link information'
00069 call efexit(-1)
00070 endif
00071
00072 if (i .eq. 1) then
00073 if ((mname .ne. mname1) .or.
00074 & (lsize .ne. lsize1)) then
00075 print *,'ERROR : link information'
00076 call efexit(-1)
00077 endif
00078 endif
00079
00080 if (i .eq. 2) then
00081 if ((mname .ne. mname2) .or.
00082 & (lsize .ne. lsize2)) then
00083 print *,'ERROR : link information'
00084 call efexit(-1)
00085 endif
00086 endif
00087
00088 enddo
00089
00090
00091
00092 call mficlo(fid,cret)
00093 print *,'Close file',cret
00094 if (cret .ne. 0 ) then
00095 print *,'ERROR : close file'
00096 call efexit(-1)
00097 endif
00098
00099
00100
00101 end
00102