00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program MEDparameter3
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,pname
00033 parameter (pname1="first parameter name")
00034 parameter (pname2="second parameter name")
00035 integer type1,type2,type
00036 parameter (type1=MED_FLOAT64, type2=MED_INT)
00037 character*200 desc1,desc2,desc
00038 parameter (desc1="First parameter description")
00039 parameter (desc2="Second parameter description")
00040 character*16 dtunit1,dtunit2,dtunit
00041 parameter (dtunit1="unit1")
00042 parameter (dtunit2="unit2")
00043 real*8 p1v1, p1v2,rv
00044 parameter (p1v1=1.0,p1v2=2.0)
00045 integer p1numdt1,p1numdt2,p2numdt1,p2numdt2,numdt
00046 parameter (p1numdt1=MED_NO_DT,p1numdt2=1)
00047 parameter (p2numdt1=2, p2numdt2=3)
00048 real*8 dt1, dt2,dt
00049 parameter (dt1=MED_UNDEF_DT,dt2=5.5)
00050 integer p2v1,p2v2,iv
00051 parameter (p2v1=3,p2v2=4)
00052 integer p1numit1, p1numit2, p2numit1, p2numit2
00053 integer numit
00054 parameter (p1numit1=MED_NO_IT, p1numit2=1)
00055 parameter (p2numit1=2, p2numit2=3)
00056 integer nstep1,nstep2,nstep,sit
00057 parameter (nstep1=2,nstep2=2)
00058 integer np,np1,it
00059 parameter (np1=2)
00060
00061
00062
00063 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00064 print *,'Open file',cret
00065 if (cret .ne. 0 ) then
00066 print *,'ERROR : open file'
00067 call efexit(-1)
00068 endif
00069
00070
00071
00072 call mprnpr(fid,np,cret)
00073 print *,'Number of parameter',cret
00074 if ((cret .ne. 0) .or.
00075 & (np .ne. np1)) then
00076 print *,'ERROR : number of parameter'
00077 call efexit(-1)
00078 endif
00079
00080
00081
00082 do it=1,np
00083
00084 call mprpri(fid,it,pname,type,desc,
00085 & dtunit,nstep,cret)
00086 print *,'interpolation information',cret
00087 if (cret .ne. 0 ) then
00088 print *,'ERROR : interpolation information'
00089 call efexit(-1)
00090 endif
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114 do sit=1,nstep
00115
00116 call mprcsi(fid,pname,sit,numdt,numit,
00117 & dt,cret)
00118 print *,'computation step information',cret
00119 if (cret .ne. 0 ) then
00120 print *,'ERROR : computation step information'
00121 call efexit(-1)
00122 endif
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198
00199
00200
00201
00202
00203 enddo
00204
00205 enddo
00206
00207
00208
00209 call mficlo(fid,cret)
00210 print *,'Close file',cret
00211 if (cret .ne. 0 ) then
00212 print *,'ERROR : close file'
00213 call efexit(-1)
00214 endif
00215
00216
00217
00218 end
00219