00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program MEDprofile2
00023
00024 implicit none
00025 include 'med.hf'
00026
00027
00028 integer cret
00029 integer fid
00030 character*64 fname, pname1, pname2
00031 parameter (fname="Unittest_MEDprofile_1.med")
00032 parameter (pname1="Profile name1")
00033 parameter (pname2="Profile name 2")
00034 integer psize1,psize2
00035 parameter (psize1=4, psize2=2)
00036 integer profile1(4), profile2(2)
00037 data profile1 /1,2, 3,4/
00038 data profile2 /5,6/
00039 integer npro,n
00040 parameter (npro=2)
00041 integer it,psize
00042 character*64 pname
00043 integer profile(4)
00044
00045
00046
00047 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00048 print *,cret
00049 if (cret .ne. 0 ) then
00050 print *,'ERROR : open file'
00051 call efexit(-1)
00052 endif
00053
00054
00055
00056 call mpfnpf(fid,n,cret)
00057 print *,cret
00058 print *,n
00059 if (cret .ne. 0 ) then
00060 print *,'ERROR : number of profile'
00061 call efexit(-1)
00062 endif
00063 if (n .ne. npro) then
00064 print *,'ERROR : number of profile'
00065 call efexit(-1)
00066 endif
00067
00068
00069
00070
00071 do it=1,n
00072 call mpfpfi(fid,it,pname,psize,cret)
00073 print *,cret
00074 if (cret .ne. 0 ) then
00075 print *,'ERROR : name and size of profile'
00076 call efexit(-1)
00077 endif
00078
00079 call mpfprr(fid,pname,profile,cret)
00080 print *,cret
00081 if (cret .ne. 0 ) then
00082 print *,'ERROR : read profile'
00083 call efexit(-1)
00084 endif
00085
00086 if (it .eq. 1) then
00087 if ((pname .ne. pname2) .or.
00088 & (psize .ne. psize2)) then
00089 print *,'ERROR : name and size of profile'
00090 call efexit(-1)
00091 endif
00092 if ((profile(1) .ne. profile2(1)) .or.
00093 & (profile(2) .ne. profile2(2))) then
00094 print *,'ERROR : profile array'
00095 call efexit(-1)
00096 endif
00097 endif
00098
00099 if (it .eq. 2) then
00100 if ((pname .ne. pname1) .or.
00101 & (psize .ne. psize1)) then
00102 print *,'ERROR : name and size of profile'
00103 call efexit(-1)
00104 endif
00105 if ((profile(1) .ne. profile1(1)) .or.
00106 & (profile(2) .ne. profile1(2)) .or.
00107 & (profile(3) .ne. profile1(3)) .or.
00108 & (profile(4) .ne. profile1(4)) )then
00109 print *,'ERROR : profile array'
00110 call efexit(-1)
00111 endif
00112 endif
00113 enddo
00114
00115
00116
00117 call mpfpsn(fid,pname1,psize,cret)
00118 print *,cret
00119 if (cret .ne. 0 ) then
00120 print *,'ERROR : size of profile'
00121 call efexit(-1)
00122 endif
00123
00124 if (psize .ne. psize1) then
00125 print *,'ERROR : size of profile'
00126 call efexit(-1)
00127 endif
00128
00129 call mpfpsn(fid,pname2,psize,cret)
00130 print *,cret
00131 if (cret .ne. 0 ) then
00132 print *,'ERROR : size of profile'
00133 call efexit(-1)
00134 endif
00135
00136 if (psize .ne. psize2) then
00137 print *,'ERROR : size of profile'
00138 call efexit(-1)
00139 endif
00140
00141
00142
00143 call mficlo(fid,cret)
00144 print *,cret
00145 if (cret .ne. 0 ) then
00146 print *,'ERROR : close file'
00147 call efexit(-1)
00148 endif
00149
00150
00151
00152 end
00153