00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program UsesCase_MEDfield_2
00023
00024 implicit none
00025 include 'med.hf90'
00026
00027 integer cret
00028 integer fid
00029 character(64) :: mname
00030
00031 character(64) :: finame = 'TEMPERATURE_FIELD'
00032
00033 integer nstep, nvals, lcmesh, fitype
00034
00035 character(16) :: cpname
00036
00037 character(16) :: cpunit
00038 character(16) :: dtunit
00039
00040
00041 real*8, dimension(:), allocatable :: verval
00042 real*8, dimension(:), allocatable :: tria3v
00043 real*8, dimension(:), allocatable :: quad4v
00044
00045
00046 call mfiope(fid,'UsesCase_MEDfield_1.med',MED_ACC_RDONLY,cret)
00047 if (cret .ne. 0 ) then
00048 print *,'ERROR : opening file'
00049 call efexit(-1)
00050 endif
00051
00052
00053
00054
00055
00056 call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
00057 print *,cret
00058 if (cret .ne. 0 ) then
00059 print *,'ERROR : field info by name'
00060 call efexit(-1)
00061 endif
00062 print *, 'Mesh name :', mname
00063 print *, 'Local mesh :', lcmesh
00064 print *, 'Field type :', fitype
00065 print *, 'Component name :', cpname
00066 print *, 'Component unit :', cpunit
00067 print *, 'dtunit :', dtunit
00068 print *, 'nstep :', nstep
00069
00070
00071
00072
00073
00074 call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nvals,cret)
00075 if (cret .ne. 0 ) then
00076 print *,'ERROR : read number of values ...'
00077 call efexit(-1)
00078 endif
00079
00080 print *, 'Node number :', nvals
00081
00082 allocate ( verval(nvals),STAT=cret )
00083 if (cret > 0) then
00084 print *,'Memory allocation'
00085 call efexit(-1)
00086 endif
00087
00088 call mfdrvr(fid,finame,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,verval,cret)
00089 if (cret .ne. 0 ) then
00090 print *,'ERROR : read fields values on vertices ...'
00091 call efexit(-1)
00092 endif
00093
00094 print *, 'Fields values on vertices :', verval
00095
00096 deallocate(verval)
00097
00098
00099 call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,nvals,cret)
00100 if (cret .ne. 0 ) then
00101 print *,'ERROR : read number of values ...'
00102 call efexit(-1)
00103 endif
00104
00105 print *, 'Triangulars cells number :', nvals
00106
00107 allocate ( tria3v(nvals),STAT=cret )
00108 if (cret > 0) then
00109 print *,'Memory allocation'
00110 call efexit(-1)
00111 endif
00112
00113 call mfdrvr(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,tria3v,cret)
00114 if (cret .ne. 0 ) then
00115 print *,'ERROR : read fields values for MED_TRIA3 cells ...'
00116 call efexit(-1)
00117 endif
00118
00119 print *, 'Fiels values for MED_TRIA3 cells :', tria3v
00120
00121 deallocate(tria3v)
00122
00123
00124 call mfdnva(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,nvals,cret)
00125 if (cret .ne. 0 ) then
00126 print *,'ERROR : read number of values ...'
00127 call efexit(-1)
00128 endif
00129
00130 print *, 'Quadrangulars cells number :', nvals
00131
00132 allocate ( quad4v(nvals),STAT=cret )
00133 if (cret > 0) then
00134 print *,'Memory allocation'
00135 call efexit(-1)
00136 endif
00137
00138 call mfdrvr(fid,finame,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,quad4v,cret)
00139 if (cret .ne. 0 ) then
00140 print *,'ERROR : read fields values for MED_QUAD4 cells ...'
00141 call efexit(-1)
00142 endif
00143
00144 print *, 'Fiels values for MED_QUAD4 cells :', quad4v
00145
00146 deallocate(quad4v)
00147
00148
00149 call mficlo(fid,cret)
00150 if (cret .ne. 0 ) then
00151 print *,'ERROR : close file'
00152 call efexit(-1)
00153 endif
00154
00155 end program UsesCase_MEDfield_2
00156