UsesCase_MEDfield_3.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 3 : read a field (generic approach)
00020 !*
00021 
00022 program UsesCase_MEDfield_3
00023 
00024   implicit none
00025   include 'med.hf90'
00026 
00027   integer cret
00028   integer fid
00029   integer nfield, i, j
00030   character(64) :: mname
00031   ! field name
00032   character(64) :: finame
00033   ! nvalues, local mesh, field type
00034   integer nstep, nvals, lcmesh, fitype
00035   integer ncompo
00036   !geotype
00037   integer geotp
00038   integer, dimension(MED_N_CELL_FIXED_GEO):: geotps
00039   character(16) :: dtunit
00040   ! component name
00041   character(16), dimension(:), allocatable :: cpname
00042   ! component unit
00043   character(16), dimension(:), allocatable :: cpunit
00044   real*8, dimension(:), allocatable :: values
00045 
00046   geotps = MED_GET_CELL_GEOMETRY_TYPE
00047 
00048   ! open file
00049   call mfiope(fid,'UsesCase_MEDfield_1.med',MED_ACC_RDONLY, cret)
00050   if (cret .ne. 0 ) then
00051      print *,'ERROR : opening file'
00052      call efexit(-1)
00053   endif
00054 
00055   ! generic approach : how many fields in the file and identification
00056   ! of each field.
00057   call mfdnfd(fid,nfield,cret)
00058   if (cret .ne. 0 ) then
00059      print *,'ERROR : How many fields in the file ...'
00060      call efexit(-1)
00061   endif
00062   print *, 'Number of field(s) in the file :', nfield
00063 
00064   do i=1,nfield
00065      ! field information
00066      ! ... we know that the field has no computation step
00067      ! and that the field values type is real*8, a real code working would check ...
00068      call mfdnfc(fid,i,ncompo,cret)
00069      if (cret .ne. 0 ) then
00070         print *,'ERROR : number of field components ...'
00071         call efexit(-1)
00072      endif
00073      print *, 'Number of field(s) component(s) in the file :', ncompo
00074 
00075      allocate(cpname(ncompo),STAT=cret )
00076      if (cret > 0) then
00077         print *,'Memory allocation'
00078         call efexit(-1)
00079      endif
00080 
00081      allocate(cpunit(ncompo),STAT=cret )
00082      if (cret > 0) then
00083         print *,'Memory allocation'
00084         call efexit(-1)
00085      endif
00086 
00087      call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
00088      if (cret .ne. 0 ) then
00089         print *,'ERROR : Reading field infos ...'
00090         call efexit(-1)
00091      endif
00092      print *, 'Field name :', finame
00093      print *, 'Mesh name :', mname
00094      print *, 'Local mesh :', lcmesh
00095      print *, 'Field type :', fitype
00096      print *, 'Component name :', cpname
00097      print *, 'Component unit :', cpunit
00098      print *, 'Dtunit :', dtunit
00099      print *, 'Nstep :', nstep
00100      deallocate(cpname,cpunit)
00101 
00102      ! read field values for nodes and cells
00103 
00104      ! MED_NODE
00105      call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nvals,cret)
00106      if (cret .ne. 0 ) then
00107         print *,'ERROR : Read number of values ...'
00108         call efexit(-1)
00109      endif
00110      print *, 'Number of values :', nvals
00111 
00112      if (nvals .gt. 0) then
00113 
00114         allocate(values(nvals),STAT=cret )
00115         if (cret > 0) then
00116            print *,'Memory allocation'
00117            call efexit(-1)
00118         endif
00119 
00120         call mfdrvr(fid,finame,MED_NO_DT, MED_NO_IT, MED_NODE, MED_NONE,&
00121                     MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,values,cret)
00122         if (cret .ne. 0 ) then
00123            print *,'ERROR : Read fields values defined on vertices ...'
00124            call efexit(-1)
00125         endif
00126         print *, 'Fields values defined on vertices :', values
00127 
00128         deallocate(values)
00129 
00130      endif
00131 
00132      ! MED_CELL
00133 
00134      do j=1,(MED_N_CELL_FIXED_GEO)
00135 
00136         geotp = geotps(j)
00137 
00138         call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,geotp,nvals,cret)
00139         if (cret .ne. 0 ) then
00140            print *,'ERROR : Read number of values ...'
00141            call efexit(-1)
00142         endif
00143         print *, 'Number of values of type :', geotp, ' :', nvals
00144 
00145         if (nvals .gt. 0) then
00146            allocate(values(nvals),STAT=cret )
00147            if (cret > 0) then
00148               print *,'Memory allocation'
00149               call efexit(-1)
00150            endif
00151 
00152            call mfdrvr(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,geotp,&
00153                        MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,values,cret)
00154            if (cret .ne. 0 ) then
00155               print *,'ERROR : Read fields values for cells ...'
00156               call efexit(-1)
00157            endif
00158            print *, 'Fields values for cells :', values
00159 
00160            deallocate(values)
00161 
00162         endif
00163      enddo
00164   enddo
00165 
00166   ! close file **
00167   call mficlo(fid,cret)
00168   if (cret .ne. 0 ) then
00169      print *,'ERROR :  close file'
00170      call efexit(-1)
00171   endif
00172 
00173 end program UsesCase_MEDfield_3
00174 

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