UsesCase_MEDfield_2.f90
Aller à la documentation de ce fichier.
!* This file is part of MED.
!*
!* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
!* MED is free software: you can redistribute it and/or modify
!* it under the terms of the GNU Lesser General Public License as published by
!* the Free Software Foundation, either version 3 of the License, or
!* (at your option) any later version.
!*
!* MED is distributed in the hope that it will be useful,
!* but WITHOUT ANY WARRANTY; without even the implied warranty of
!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!* GNU Lesser General Public License for more details.
!*
!* You should have received a copy of the GNU Lesser General Public License
!* along with MED. If not, see <http://www.gnu.org/licenses/>.
!*
!*
!* Field use case 2 : read the field of use case 1
!*
program usescase_medfield_2
implicit none
include 'med.hf90'
integer cret
integer*8 fid
character(64) :: mname
! field name
character(64) :: finame = 'TEMPERATURE_FIELD'
! nvalues, local mesh, field type
integer nstep, nvals, lcmesh, fitype
! component name
character(16) :: cpname
! component unit
character(16) :: cpunit
character(16) :: dtunit
! vertices values
real*8, dimension(:), allocatable :: verval
real*8, dimension(:), allocatable :: tria3v
real*8, dimension(:), allocatable :: quad4v
! open MED file with READ ONLY access mode **
call mfiope(fid,'UsesCase_MEDfield_1.med',med_acc_rdonly,cret)
if (cret .ne. 0 ) then
print *,'ERROR : opening file'
call efexit(-1)
endif
! ... we know that the MED file has only one field with one component ,
! a real code working would check ...
! if you know the field name, direct access to field informations
call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'ERROR : field info by name'
call efexit(-1)
endif
print *, 'Mesh name :', mname
print *, 'Local mesh :', lcmesh
print *, 'Field type :', fitype
print *, 'Component name :', cpname
print *, 'Component unit :', cpunit
print *, 'dtunit :', dtunit
print *, 'nstep :', nstep
! ... we know that the field values are defined on vertices and MED_TRIA3
! and MED_QUAD4 cells, a real code working would check ...
! MED_NODE
call mfdnva(fid,finame,med_no_dt,med_no_it,med_node,med_none,nvals,cret)
if (cret .ne. 0 ) then
print *,'ERROR : read number of values ...'
call efexit(-1)
endif
print *, 'Node number :', nvals
allocate ( verval(nvals),stat=cret )
if (cret > 0) then
print *,'Memory allocation'
call efexit(-1)
endif
call mfdrvr(fid,finame,med_no_dt,med_no_it,med_node,med_none,med_full_interlace,med_all_constituent,verval,cret)
if (cret .ne. 0 ) then
print *,'ERROR : read fields values on vertices ...'
call efexit(-1)
endif
print *, 'Fields values on vertices :', verval
deallocate(verval)
! MED_TRIA3
call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,nvals,cret)
if (cret .ne. 0 ) then
print *,'ERROR : read number of values ...'
call efexit(-1)
endif
print *, 'Triangulars cells number :', nvals
allocate ( tria3v(nvals),stat=cret )
if (cret > 0) then
print *,'Memory allocation'
call efexit(-1)
endif
call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,med_full_interlace,med_all_constituent,tria3v,cret)
if (cret .ne. 0 ) then
print *,'ERROR : read fields values for MED_TRIA3 cells ...'
call efexit(-1)
endif
print *, 'Fiels values for MED_TRIA3 cells :', tria3v
deallocate(tria3v)
! MED_QUAD4
call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,nvals,cret)
if (cret .ne. 0 ) then
print *,'ERROR : read number of values ...'
call efexit(-1)
endif
print *, 'Quadrangulars cells number :', nvals
allocate ( quad4v(nvals),stat=cret )
if (cret > 0) then
print *,'Memory allocation'
call efexit(-1)
endif
call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,med_full_interlace,med_all_constituent,quad4v,cret)
if (cret .ne. 0 ) then
print *,'ERROR : read fields values for MED_QUAD4 cells ...'
call efexit(-1)
endif
print *, 'Fiels values for MED_QUAD4 cells :', quad4v
deallocate(quad4v)
! close file **
call mficlo(fid,cret)
if (cret .ne. 0 ) then
print *,'ERROR : close file'
call efexit(-1)
endif
end program usescase_medfield_2
usescase_medfield_2
program usescase_medfield_2
Definition UsesCase_MEDfield_2.f90:22
mfdfin
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Definition medfield.f:270
mfdrvr
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
Definition medfield.f:461
mfdnva
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
Definition medfield.f:380
mfiope
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Definition medfile.f:82