00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDparameter1
00023 
00024       implicit none
00025       include 'med.hf'
00026 
00027 
00028       integer cret
00029       integer fid
00030       character*64 fname
00031       parameter (fname = "Unittest_MEDparameter_1.med")
00032       character*64 pname1,pname2
00033       parameter (pname1="first parameter name") 
00034       parameter (pname2="second parameter name") 
00035       integer type1,type2
00036       parameter (type1=MED_FLOAT64, type2=MED_INT)
00037       character*200 desc1,desc2
00038       parameter (desc1="First parameter description")
00039       parameter (desc2="Second parameter description")
00040       character*16 dtunit1,dtunit2
00041       parameter (dtunit1="unit1")
00042       parameter (dtunit2="unit2")
00043       real*8 p1v1, p1v2
00044       parameter (p1v1=1.0,p1v2=2.0)
00045       integer p1numdt1,p1numdt2,p2numdt1,p2numdt2
00046       parameter (p1numdt1=MED_NO_DT,p1numdt2=1)
00047       parameter (p2numdt1=2, p2numdt2=3)
00048       real*8 dt1, dt2
00049       parameter (dt1=MED_UNDEF_DT,dt2=5.5)
00050       integer p2v1,p2v2
00051       parameter (p2v1=3,p2v2=4)
00052       integer p1numit1, p1numit2, p2numit1, p2numit2
00053       parameter (p1numit1=MED_NO_IT, p1numit2=1)
00054       parameter (p2numit1=2, p2numit2=3)
00055 
00056 
00057 
00058       call mfiope(fid,fname,MED_ACC_CREAT,cret)
00059       print *,'Open file',cret
00060       if (cret .ne. 0 ) then
00061          print *,'ERROR : file creation'
00062          call efexit(-1)
00063       endif 
00064 
00065 
00066 
00067       call mprcre(fid,pname1,type1,desc1,dtunit1,cret)
00068       print *,'parameter creation',cret
00069       if (cret .ne. 0 ) then
00070          print *,'ERROR : parameter creation'
00071          call efexit(-1)
00072       endif 
00073 
00074 
00075 
00076       call mprrvw(fid,pname1,p1numdt1,p1numit1,dt1,p1v1,cret)
00077       print *,'write value',cret
00078       if (cret .ne. 0 ) then
00079          print *,'ERROR : write value'
00080          call efexit(-1)
00081       endif 
00082 
00083       call mprrvw(fid,pname1,p1numdt2,p1numit2,dt2,p1v2,cret)
00084       print *,'write value',cret
00085       if (cret .ne. 0 ) then
00086          print *,'ERROR : write value'
00087          call efexit(-1)
00088       endif 
00089 
00090 
00091 
00092       call mprcre(fid,pname2,type2,desc2,dtunit2,cret)
00093       print *,'parameter creation',cret
00094       if (cret .ne. 0 ) then
00095          print *,'ERROR : parameter creation'
00096          call efexit(-1)
00097       endif 
00098 
00099 
00100 
00101       call mprivw(fid,pname2,p2numdt1,p2numit1,dt1,p2v1,cret)
00102       print *,'write value',cret
00103       if (cret .ne. 0 ) then
00104          print *,'ERROR : write value'
00105          call efexit(-1)
00106       endif 
00107 
00108       call mprivw(fid,pname2,p2numdt2,p2numit2,dt2,p2v2,cret)
00109       print *,'write value',cret
00110       if (cret .ne. 0 ) then
00111          print *,'ERROR : write value'
00112          call efexit(-1)
00113       endif 
00114 
00115 
00116 
00117       call mficlo(fid,cret)
00118       print *,'Close file',cret
00119       if (cret .ne. 0 ) then
00120          print *,'ERROR :  close file'
00121          call efexit(-1)
00122       endif  
00123 
00124 
00125 
00126       end
00127