# UsesCase_MEDfield_6.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 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(22) :: 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