UsesCase_MEDfield_2.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 !*  Field use case 2 : read the field of use case 1
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   ! field name
00031   character(64) :: finame = 'TEMPERATURE_FIELD'
00032   ! nvalues, local mesh, field type
00033   integer nstep, nvals, lcmesh, fitype
00034   ! component name
00035   character(16) :: cpname
00036   ! component unit
00037   character(16) :: cpunit
00038   character(16) :: dtunit
00039 
00040   ! vertices values      
00041   real*8, dimension(:), allocatable :: verval
00042   real*8, dimension(:), allocatable :: tria3v
00043   real*8, dimension(:), allocatable :: quad4v
00044 
00045   ! open MED file with READ ONLY access mode **
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   ! ... we know that the MED file has only one field with one component , 
00053   ! a real code working would check ... 
00054 
00055   ! if you know the field name, direct access to field informations
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   ! ... we know that the field values are defined on vertices and MED_TRIA3
00071   ! and MED_QUAD4 cells, a real code working would check ...
00072 
00073   ! MED_NODE
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   ! MED_TRIA3
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   ! MED_QUAD4
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   ! close file **
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 

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