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_3
00023 
00024   implicit none
00025   include 'med.hf90'
00026 
00027   integer cret
00028   integer fid
00029   integer nfield, i, j
00030   character(64) :: mname
00031   
00032   character(64) :: finame
00033   
00034   integer nstep, nvals, lcmesh, fitype
00035   integer ncompo
00036   
00037   integer geotp
00038   integer, dimension(22):: geotps
00039   character(16) :: dtunit
00040   
00041   character(16), dimension(:), allocatable :: cpname
00042   
00043   character(16), dimension(:), allocatable :: cpunit
00044   real*8, dimension(:), allocatable :: values
00045 
00046   geotps = MED_GET_CELL_GEOMETRY_TYPE
00047 
00048   
00049   call mfiope(fid,'UsesCase_MEDfield_1.med',MED_ACC_RDONLY, cret)
00050   if (cret .ne. 0 ) then
00051      print *,'ERROR : opening file'
00052      call efexit(-1)
00053   endif
00054 
00055   
00056   
00057   call mfdnfd(fid,nfield,cret)
00058   if (cret .ne. 0 ) then
00059      print *,'ERROR : How many fields in the file ...'
00060      call efexit(-1)
00061   endif
00062   print *, 'Number of field(s) in the file :', nfield
00063 
00064   do i=1,nfield
00065      
00066      
00067      
00068      call mfdnfc(fid,i,ncompo,cret)
00069      if (cret .ne. 0 ) then
00070         print *,'ERROR : number of field components ...'
00071         call efexit(-1)
00072      endif
00073      print *, 'Number of field(s) component(s) in the file :', ncompo
00074 
00075      allocate(cpname(ncompo),STAT=cret )
00076      if (cret > 0) then
00077         print *,'Memory allocation'
00078         call efexit(-1)
00079      endif
00080 
00081      allocate(cpunit(ncompo),STAT=cret )
00082      if (cret > 0) then
00083         print *,'Memory allocation'
00084         call efexit(-1)
00085      endif
00086 
00087      call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
00088      if (cret .ne. 0 ) then
00089         print *,'ERROR : Reading field infos ...'
00090         call efexit(-1)
00091      endif
00092      print *, 'Field name :', finame
00093      print *, 'Mesh name :', mname
00094      print *, 'Local mesh :', lcmesh
00095      print *, 'Field type :', fitype
00096      print *, 'Component name :', cpname
00097      print *, 'Component unit :', cpunit
00098      print *, 'Dtunit :', dtunit
00099      print *, 'Nstep :', nstep
00100      deallocate(cpname,cpunit)
00101 
00102      
00103 
00104      
00105      call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nvals,cret)
00106      if (cret .ne. 0 ) then
00107         print *,'ERROR : Read number of values ...'
00108         call efexit(-1)
00109      endif
00110      print *, 'Number of values :', nvals
00111 
00112      if (nvals .gt. 0) then
00113 
00114         allocate(values(nvals),STAT=cret )
00115         if (cret > 0) then
00116            print *,'Memory allocation'
00117            call efexit(-1)
00118         endif
00119 
00120         call mfdrvr(fid,finame,MED_NO_DT, MED_NO_IT, MED_NODE, MED_NONE,&
00121                     MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,values,cret)
00122         if (cret .ne. 0 ) then
00123            print *,'ERROR : Read fields values defined on vertices ...'
00124            call efexit(-1)
00125         endif
00126         print *, 'Fields values defined on vertices :', values
00127 
00128         deallocate(values)
00129 
00130      endif
00131 
00132      
00133 
00134      do j=1,(MED_N_CELL_FIXED_GEO)
00135 
00136         geotp = geotps(j)
00137 
00138         call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,geotp,nvals,cret)
00139         if (cret .ne. 0 ) then
00140            print *,'ERROR : Read number of values ...'
00141            call efexit(-1)
00142         endif
00143         print *, 'Number of values of type :', geotp, ' :', nvals
00144 
00145         if (nvals .gt. 0) then
00146            allocate(values(nvals),STAT=cret )
00147            if (cret > 0) then
00148               print *,'Memory allocation'
00149               call efexit(-1)
00150            endif
00151 
00152            call mfdrvr(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,geotp,&
00153                        MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,values,cret)
00154            if (cret .ne. 0 ) then
00155               print *,'ERROR : Read fields values for cells ...'
00156               call efexit(-1)
00157            endif
00158            print *, 'Fields values for cells :', values
00159 
00160            deallocate(values)
00161 
00162         endif
00163      enddo
00164   enddo
00165 
00166   
00167   call mficlo(fid,cret)
00168   if (cret .ne. 0 ) then
00169      print *,'ERROR :  close file'
00170      call efexit(-1)
00171   endif
00172 
00173 end program UsesCase_MEDfield_3
00174