UsesCase_MEDfield_6.f90

Aller à la documentation de ce fichier.
00001 !*  This file is part of MED.
00002 !*
00003 !*  COPYRIGHT (C) 1999 - 2015  EDF R&D, CEA/DEN
00004 !*  MED is free software: you can redistribute it and/or modify
00005 !*  it under the terms of the GNU Lesser General Public License as published by
00006 !*  the Free Software Foundation, either version 3 of the License, or
00007 !*  (at your option) any later version.
00008 !*
00009 !*  MED is distributed in the hope that it will be useful,
00010 !*  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 !*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012 !*  GNU Lesser General Public License for more details.
00013 !*
00014 !*  You should have received a copy of the GNU Lesser General Public License
00015 !*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
00016 !*
00017 
00018 !*
00019 !*
00020 !*  Field use case 6 : read a field (generic approach) with computing steps
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   ! field name
00033   character(64) :: finame
00034   ! nvalues, local mesh, field type
00035   integer nstep, nvals, lcmesh, fitype
00036   integer ncompo
00037   !geotype
00038   integer geotp
00039   integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
00040   ! mesh num dt, mesh num it
00041   integer mnumdt, mnumit
00042   integer csit, numit, numdt, it
00043   real*8 dt
00044   character(16) :: dtunit
00045   ! component name
00046   character(16), dimension(:), allocatable :: cpname
00047   ! component unit
00048   character(16), dimension(:), allocatable :: cpunit  
00049   real*8, dimension(:), allocatable :: values
00050 
00051   geotps = MED_GET_CELL_GEOMETRY_TYPE
00052 
00053   ! open MED file
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   ! generic approach : how many fields in the file and identification
00061   ! of each field.
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   ! read values for each field
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      ! Read field values for each computing step
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         ! ... In our case, we suppose that the field values are only defined on cells ...
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   ! close file
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 

Généré le Thu Oct 8 14:26:17 2015 pour MED fichier par  doxygen 1.6.1