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