# UsesCase_MEDfield_3.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 !*  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(22):: 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