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_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
00032 character(64) :: finame
00033
00034 integer nstep, nvals, lcmesh, fitype
00035 integer ncompo
00036
00037 integer geotp
00038 integer, dimension(MED_N_CELL_FIXED_GEO):: geotps
00039 character(16) :: dtunit
00040
00041 character(16), dimension(:), allocatable :: cpname
00042
00043 character(16), dimension(:), allocatable :: cpunit
00044 real*8, dimension(:), allocatable :: values
00045
00046 geotps = MED_GET_CELL_GEOMETRY_TYPE
00047
00048
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
00056
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
00066
00067
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
00103
00104
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
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
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