# UsesCase_MEDfield_5.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2011  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 5 : read a field with following with computing steps
    00021 !*
    00022
    00023 program UsesCase_MEDfield_5
    00024
    00025   implicit none
    00026   include 'med.hf90'
    00027
    00028   integer cret
    00029   integer fid
    00030   character(64) :: mname
    00031   ! field name
    00032   character(64) :: finame  = 'TEMPERATURE_FIELD'
    00033   ! nvalues, local mesh, field type
    00034   integer nstep, nvals, lcmesh, fitype
    00035   integer ncompo
    00036   !geotype
    00037   integer geotp
    00038   integer, dimension(22) :: geotps
    00039   ! mesh num dt, mesh num it
    00040   integer mnumdt, mnumit
    00041   integer csit, numit, numdt, it
    00042   real*8 dt
    00043   character(16) :: dtunit
    00044   ! component name
    00045   character(16) :: cpname
    00046   ! component unit
    00047   character(16) :: cpunit
    00048   real*8, dimension(:), allocatable :: values
    00049
    00050   geotps = MED_GET_CELL_GEOMETRY_TYPE
    00051
    00052   ! open MED file
    00053   call mfiope(fid,'UsesCase_MEDfield_4.med',MED_ACC_RDONLY, cret)
    00054   if (cret .ne. 0 ) then
    00055      print *,'ERROR : open file'
    00056      call efexit(-1)
    00057   endif
    00058
    00059   ! ... we know that the MED file has only one field with one component ,
    00060   ! a real code working would check ...
    00061   !
    00062   ! if you know the field name, direct access to field informations
    00063   call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
    00064   if (cret .ne. 0 ) then
    00065      print *,'ERROR :  Field info by name ...'
    00066      call efexit(-1)
    00067   endif
    00068   print *, 'Mesh name :', mname
    00069   print *, 'Local mesh :', lcmesh
    00070   print *, 'Field type :', fitype
    00071   print *, 'Component name :', cpname
    00072   print *, 'Component unit :', cpunit
    00073   print *, 'Dtunit :', dtunit
    00074   print *, 'Nstep :', nstep
    00075
    00076   ! Read field values for each computing step
    00077   do csit=1,nstep
    00078      call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
    00079      if (cret .ne. 0 ) then
    00080         print *,'ERROR :  Computing step info ...'
    00081         call efexit(-1)
    00082      endif
    00083      print *, 'csit :', csit
    00084      print *, 'numdt :', numdt
    00085      print *, 'numit :', numit
    00086      print *, 'dt :', dt
    00087      print *, 'mnumdt :', mnumdt
    00088      print *, 'mnumit :', mnumit
    00089
    00090      ! ... In our case, we suppose that the field values are only defined on cells ...
    00091
    00092      do it=1,(MED_N_CELL_FIXED_GEO)
    00093
    00094         geotp = geotps(it)
    00095
    00096         call mfdnva(fid,finame,numdt,numit,MED_CELL,geotp,nvals,cret)
    00097         if (cret .ne. 0 ) then
    00098            print *,'ERROR : Read number of values ...'
    00099            call efexit(-1)
    00100         endif
    00101         print *, 'Number of values of type :', geotp, ' :', nvals
    00102
    00103         if (nvals .gt. 0) then
    00104            allocate(values(nvals),STAT=cret )
    00105            if (cret > 0) then
    00106               print *,'Memory allocation'
    00107               call efexit(-1)
    00108            endif
    00109
    00110            call mfdrvr(fid,finame,numdt,numit,MED_CELL,geotp,&
    00111                        MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,values,cret)
    00112            if (cret .ne. 0 ) then
    00113               print *,'ERROR : Read fields values for cells ...'
    00114               call efexit(-1)
    00115            endif
    00116            print *, 'Fields values for cells :', values
    00117
    00118            deallocate(values)
    00119
    00120         endif
    00121      enddo
    00122   enddo
    00123
    00124   ! close file
    00125   call mficlo(fid,cret)
    00126   if (cret .ne. 0 ) then
    00127      print *,'ERROR :  close file'
    00128      call efexit(-1)
    00129   endif
    00130
    00131 end program UsesCase_MEDfield_5
    00132