32 parameter(fname =
"Unittest_MEDparameter_1.med")
33 character*64 pname1,pname2
34 parameter(pname1=
"first parameter name")
35 parameter(pname2=
"second parameter name")
38 character*200 desc1,desc2
39 parameter(desc1=
"First parameter description")
40 parameter(desc2=
"Second parameter description")
41 character*16 dtunit1,dtunit2
42 parameter(dtunit1=
"unit1")
43 parameter(dtunit2=
"unit2")
45 parameter(p1v1=1.0,p1v2=2.0)
46 integer p1numdt1,p1numdt2,p2numdt1,p2numdt2
47 parameter(p1numdt1=med_no_dt,p1numdt2=1)
48 parameter(p2numdt1=2, p2numdt2=3)
50 parameter(dt1=med_undef_dt,dt2=5.5)
52 parameter(p2v1=3,p2v2=4)
53 integer p1numit1, p1numit2, p2numit1, p2numit2
54 parameter(p1numit1=med_no_it, p1numit2=1)
55 parameter(p2numit1=2, p2numit2=3)
59 call mfiope(fid,fname,med_acc_creat,cret)
60 print *,
'Open file',cret
61 if (cret .ne. 0 )
then
62 print *,
'ERROR : file creation'
68 call mprcre(fid,pname1,type1,desc1,dtunit1,cret)
69 print *,
'parameter creation',cret
70 if (cret .ne. 0 )
then
71 print *,
'ERROR : parameter creation'
77 call mprrvw(fid,pname1,p1numdt1,p1numit1,dt1,p1v1,cret)
78 print *,
'write value',cret
79 if (cret .ne. 0 )
then
80 print *,
'ERROR : write value'
84 call mprrvw(fid,pname1,p1numdt2,p1numit2,dt2,p1v2,cret)
85 print *,
'write value',cret
86 if (cret .ne. 0 )
then
87 print *,
'ERROR : write value'
93 call mprcre(fid,pname2,type2,desc2,dtunit2,cret)
94 print *,
'parameter creation',cret
95 if (cret .ne. 0 )
then
96 print *,
'ERROR : parameter creation'
102 call mprivw(fid,pname2,p2numdt1,p2numit1,dt1,p2v1,cret)
103 print *,
'write value',cret
104 if (cret .ne. 0 )
then
105 print *,
'ERROR : write value'
109 call mprivw(fid,pname2,p2numdt2,p2numit2,dt2,p2v2,cret)
110 print *,
'write value',cret
111 if (cret .ne. 0 )
then
112 print *,
'ERROR : write value'
119 print *,
'Close file',cret
120 if (cret .ne. 0 )
then
121 print *,
'ERROR : close file'
subroutine mprivw(fid, name, numdt, numit, dt, val, cret)
subroutine mprcre(fid, name, type, des, dtunit, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mprrvw(fid, name, numdt, numit, dt, val, cret)
subroutine mficlo(fid, cret)