# UsesCase_MEDfield_2.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2012  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