00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 program UsesCase_MEDfield_6
00024 
00025   implicit none
00026   include 'med.hf90'
00027 
00028   integer cret
00029   integer fid
00030   integer nfield, i, j
00031   character(64) :: mname
00032   
00033   character(64) :: finame
00034   
00035   integer nstep, nvals, lcmesh, fitype
00036   integer ncompo
00037   
00038   integer geotp
00039   integer, dimension(22) :: geotps
00040   
00041   integer mnumdt, mnumit
00042   integer csit, numit, numdt, it
00043   real*8 dt
00044   character(16) :: dtunit
00045   
00046   character(16), dimension(:), allocatable :: cpname
00047   
00048   character(16), dimension(:), allocatable :: cpunit  
00049   real*8, dimension(:), allocatable :: values
00050 
00051   geotps = MED_GET_CELL_GEOMETRY_TYPE
00052 
00053   
00054   call mfiope(fid,'UsesCase_MEDfield_4.med',MED_ACC_RDONLY, cret)
00055   if (cret .ne. 0 ) then
00056      print *,'ERROR : open file'
00057      call efexit(-1)
00058   endif
00059 
00060   
00061   
00062   call mfdnfd(fid,nfield,cret)
00063   if (cret .ne. 0 ) then
00064      print *,'ERROR : How many fields in the file ...'
00065      call efexit(-1)
00066   endif
00067   print *, 'Number of field(s) in the file :', nfield
00068 
00069   
00070   do i=1,nfield
00071      call mfdnfc(fid,i,ncompo,cret)
00072      if (cret .ne. 0 ) then
00073         print *,'ERROR : number of field components ...'
00074         call efexit(-1)
00075      endif
00076      print *, 'Field number :', nfield
00077      print *, 'Number of field(s) component(s) in the file :', ncompo
00078 
00079      allocate(cpname(ncompo),STAT=cret )
00080      if (cret > 0) then
00081         print *,'Memory allocation'
00082         call efexit(-1)
00083      endif
00084 
00085      allocate(cpunit(ncompo),STAT=cret )
00086      if (cret > 0) then
00087         print *,'Memory allocation'
00088         call efexit(-1)
00089      endif
00090 
00091      call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
00092      if (cret .ne. 0 ) then
00093         print *,'ERROR : Reading field infos ...'
00094         call efexit(-1)
00095      endif
00096      print *, 'Field name :', finame
00097      print *, 'Mesh name :', mname
00098      print *, 'Local mesh :', lcmesh
00099      print *, 'Field type :', fitype
00100      print *, 'Component name :', cpname
00101      print *, 'Component unit :', cpunit
00102      print *, 'Dtunit :', dtunit
00103      print *, 'Nstep :', nstep
00104      deallocate(cpname,cpunit)
00105 
00106      
00107      do csit=1, nstep
00108         call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
00109         if (cret .ne. 0 ) then
00110            print *,'ERROR : Computing step info ...'
00111            call efexit(-1)
00112         endif
00113         print *, 'Computing step :',csit
00114         print *, 'Numdt :', numdt
00115         print *, 'Numit :', numit
00116         print *, 'Dt :', dt
00117         print *, 'mnumdt :', mnumdt
00118         print *, 'mnumit :', mnumit
00119 
00120         
00121         do it=1,(MED_N_CELL_FIXED_GEO)
00122 
00123            geotp = geotps(it)
00124 
00125            call mfdnva(fid,finame,numdt,numit,MED_CELL,geotp,nvals,cret)
00126            if (cret .ne. 0 ) then
00127               print *,'ERROR : Read number of values ...'
00128               call efexit(-1)
00129            endif
00130            print *, 'Number of values of type :', geotp, ' :', nvals
00131 
00132            if (nvals .gt. 0) then
00133               allocate(values(nvals),STAT=cret )
00134               if (cret > 0) then
00135                  print *,'Memory allocation'
00136                  call efexit(-1)
00137               endif
00138 
00139               call mfdrvr(fid,finame,numdt,numit,MED_CELL,geotp,&
00140                           MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,values,cret)
00141               if (cret .ne. 0 ) then
00142                  print *,'ERROR : Read fields values for cells ...'
00143                  call efexit(-1)
00144               endif
00145               print *, 'Fields values for cells :', values
00146 
00147               deallocate(values)
00148            endif
00149         enddo
00150      enddo
00151   enddo
00152 
00153   
00154   call mficlo(fid,cret)
00155   if (cret .ne. 0 ) then
00156      print *,'ERROR :  close file'
00157      call efexit(-1)
00158   endif
00159 
00160 end program UsesCase_MEDfield_6
00161