00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022 program UsesCase_MEDfield_2
00023 
00024   implicit none
00025   include 'med.hf90'
00026 
00027   integer cret
00028   integer fid
00029   character(64) :: mname
00030   
00031   character(64) :: finame = 'TEMPERATURE_FIELD'
00032   
00033   integer nstep, nvals, lcmesh, fitype
00034   
00035   character(16) :: cpname
00036   
00037   character(16) :: cpunit
00038   character(16) :: dtunit
00039 
00040   
00041   real*8, dimension(:), allocatable :: verval
00042   real*8, dimension(:), allocatable :: tria3v
00043   real*8, dimension(:), allocatable :: quad4v
00044 
00045   
00046   call mfiope(fid,'UsesCase_MEDfield_1.med',MED_ACC_RDONLY,cret)
00047   if (cret .ne. 0 ) then
00048      print *,'ERROR : opening file'
00049      call efexit(-1)
00050   endif
00051 
00052   
00053   
00054 
00055   
00056   call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
00057     print *,cret
00058   if (cret .ne. 0 ) then
00059      print *,'ERROR : field info by name'
00060      call efexit(-1)
00061   endif
00062   print *, 'Mesh name :', mname
00063   print *, 'Local mesh :', lcmesh
00064   print *, 'Field type :', fitype
00065   print *, 'Component name :', cpname
00066   print *, 'Component unit :', cpunit
00067   print *, 'dtunit :', dtunit
00068   print *, 'nstep :', nstep
00069 
00070   
00071   
00072 
00073   
00074   call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nvals,cret)
00075   if (cret .ne. 0 ) then
00076      print *,'ERROR : read number of values ...'
00077      call efexit(-1)
00078   endif
00079 
00080   print *, 'Node number :', nvals
00081 
00082   allocate ( verval(nvals),STAT=cret )
00083   if (cret > 0) then
00084      print *,'Memory allocation'
00085      call efexit(-1)
00086   endif
00087 
00088   call mfdrvr(fid,finame,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,verval,cret)
00089   if (cret .ne. 0 ) then
00090      print *,'ERROR : read fields values on vertices ...'
00091      call efexit(-1)
00092   endif
00093 
00094   print *, 'Fields values on vertices :', verval
00095 
00096   deallocate(verval)
00097 
00098   
00099   call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,nvals,cret)
00100   if (cret .ne. 0 ) then
00101      print *,'ERROR : read number of values ...'
00102      call efexit(-1)
00103   endif
00104 
00105   print *, 'Triangulars cells number :', nvals
00106 
00107   allocate ( tria3v(nvals),STAT=cret )
00108   if (cret > 0) then
00109      print *,'Memory allocation'
00110      call efexit(-1)
00111   endif
00112 
00113   call mfdrvr(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,tria3v,cret)
00114   if (cret .ne. 0 ) then
00115      print *,'ERROR : read fields values for MED_TRIA3 cells ...'
00116      call efexit(-1)
00117   endif
00118 
00119   print *, 'Fiels values for MED_TRIA3 cells :', tria3v
00120 
00121   deallocate(tria3v)
00122 
00123   
00124   call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,nvals,cret)
00125   if (cret .ne. 0 ) then
00126      print *,'ERROR : read number of values ...'
00127      call efexit(-1)
00128   endif
00129 
00130   print *, 'Quadrangulars cells number :', nvals
00131 
00132   allocate ( quad4v(nvals),STAT=cret )
00133   if (cret > 0) then
00134      print *,'Memory allocation'
00135      call efexit(-1)
00136   endif
00137 
00138   call mfdrvr(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,quad4v,cret)
00139   if (cret .ne. 0 ) then
00140      print *,'ERROR : read fields values for MED_QUAD4 cells ...'
00141      call efexit(-1)
00142   endif
00143 
00144   print *, 'Fiels values for MED_QUAD4 cells :', quad4v
00145 
00146   deallocate(quad4v)
00147 
00148   
00149   call mficlo(fid,cret)
00150   if (cret .ne. 0 ) then
00151      print *,'ERROR :  close file'
00152      call efexit(-1)
00153   endif
00154 
00155 end program UsesCase_MEDfield_2
00156