00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023 program UsesCase_MEDfield_5
00024
00025 implicit none
00026 include 'med.hf90'
00027
00028 integer cret
00029 integer fid
00030 character(64) :: mname
00031
00032 character(64) :: finame = 'TEMPERATURE_FIELD'
00033
00034 integer nstep, nvals, lcmesh, fitype
00035 integer ncompo
00036
00037 integer geotp
00038 integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
00039
00040 integer mnumdt, mnumit
00041 integer csit, numit, numdt, it
00042 real*8 dt
00043 character(16) :: dtunit
00044
00045 character(16) :: cpname
00046
00047 character(16) :: cpunit
00048 real*8, dimension(:), allocatable :: values
00049
00050 geotps = MED_GET_CELL_GEOMETRY_TYPE
00051
00052
00053 call mfiope(fid,'UsesCase_MEDfield_4.med',MED_ACC_RDONLY, cret)
00054 if (cret .ne. 0 ) then
00055 print *,'ERROR : open file'
00056 call efexit(-1)
00057 endif
00058
00059
00060
00061
00062
00063 call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
00064 if (cret .ne. 0 ) then
00065 print *,'ERROR : Field info by name ...'
00066 call efexit(-1)
00067 endif
00068 print *, 'Mesh name :', mname
00069 print *, 'Local mesh :', lcmesh
00070 print *, 'Field type :', fitype
00071 print *, 'Component name :', cpname
00072 print *, 'Component unit :', cpunit
00073 print *, 'Dtunit :', dtunit
00074 print *, 'Nstep :', nstep
00075
00076
00077 do csit=1,nstep
00078 call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
00079 if (cret .ne. 0 ) then
00080 print *,'ERROR : Computing step info ...'
00081 call efexit(-1)
00082 endif
00083 print *, 'csit :', csit
00084 print *, 'numdt :', numdt
00085 print *, 'numit :', numit
00086 print *, 'dt :', dt
00087 print *, 'mnumdt :', mnumdt
00088 print *, 'mnumit :', mnumit
00089
00090
00091
00092 do it=1,(MED_N_CELL_FIXED_GEO)
00093
00094 geotp = geotps(it)
00095
00096 call mfdnva(fid,finame,numdt,numit,MED_CELL,geotp,nvals,cret)
00097 if (cret .ne. 0 ) then
00098 print *,'ERROR : Read number of values ...'
00099 call efexit(-1)
00100 endif
00101 print *, 'Number of values of type :', geotp, ' :', nvals
00102
00103 if (nvals .gt. 0) then
00104 allocate(values(nvals),STAT=cret )
00105 if (cret > 0) then
00106 print *,'Memory allocation'
00107 call efexit(-1)
00108 endif
00109
00110 call mfdrvr(fid,finame,numdt,numit,MED_CELL,geotp,&
00111 MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,values,cret)
00112 if (cret .ne. 0 ) then
00113 print *,'ERROR : Read fields values for cells ...'
00114 call efexit(-1)
00115 endif
00116 print *, 'Fields values for cells :', values
00117
00118 deallocate(values)
00119
00120 endif
00121 enddo
00122 enddo
00123
00124
00125 call mficlo(fid,cret)
00126 if (cret .ne. 0 ) then
00127 print *,'ERROR : close file'
00128 call efexit(-1)
00129 endif
00130
00131 end program UsesCase_MEDfield_5
00132