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