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