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_6
00024
00025 implicit none
00026 include 'med.hf90'
00027
00028 integer cret
00029 integer fid
00030 integer nfield, i, j
00031 character(64) :: mname
00032
00033 character(64) :: finame
00034
00035 integer nstep, nvals, lcmesh, fitype
00036 integer ncompo
00037
00038 integer geotp
00039 integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
00040
00041 integer mnumdt, mnumit
00042 integer csit, numit, numdt, it
00043 real*8 dt
00044 character(16) :: dtunit
00045
00046 character(16), dimension(:), allocatable :: cpname
00047
00048 character(16), dimension(:), allocatable :: cpunit
00049 real*8, dimension(:), allocatable :: values
00050
00051 geotps = MED_GET_CELL_GEOMETRY_TYPE
00052
00053
00054 call mfiope(fid,'UsesCase_MEDfield_4.med',MED_ACC_RDONLY, cret)
00055 if (cret .ne. 0 ) then
00056 print *,'ERROR : open file'
00057 call efexit(-1)
00058 endif
00059
00060
00061
00062 call mfdnfd(fid,nfield,cret)
00063 if (cret .ne. 0 ) then
00064 print *,'ERROR : How many fields in the file ...'
00065 call efexit(-1)
00066 endif
00067 print *, 'Number of field(s) in the file :', nfield
00068
00069
00070 do i=1,nfield
00071 call mfdnfc(fid,i,ncompo,cret)
00072 if (cret .ne. 0 ) then
00073 print *,'ERROR : number of field components ...'
00074 call efexit(-1)
00075 endif
00076 print *, 'Field number :', nfield
00077 print *, 'Number of field(s) component(s) in the file :', ncompo
00078
00079 allocate(cpname(ncompo),STAT=cret )
00080 if (cret > 0) then
00081 print *,'Memory allocation'
00082 call efexit(-1)
00083 endif
00084
00085 allocate(cpunit(ncompo),STAT=cret )
00086 if (cret > 0) then
00087 print *,'Memory allocation'
00088 call efexit(-1)
00089 endif
00090
00091 call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
00092 if (cret .ne. 0 ) then
00093 print *,'ERROR : Reading field infos ...'
00094 call efexit(-1)
00095 endif
00096 print *, 'Field name :', finame
00097 print *, 'Mesh name :', mname
00098 print *, 'Local mesh :', lcmesh
00099 print *, 'Field type :', fitype
00100 print *, 'Component name :', cpname
00101 print *, 'Component unit :', cpunit
00102 print *, 'Dtunit :', dtunit
00103 print *, 'Nstep :', nstep
00104 deallocate(cpname,cpunit)
00105
00106
00107 do csit=1, nstep
00108 call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
00109 if (cret .ne. 0 ) then
00110 print *,'ERROR : Computing step info ...'
00111 call efexit(-1)
00112 endif
00113 print *, 'Computing step :',csit
00114 print *, 'Numdt :', numdt
00115 print *, 'Numit :', numit
00116 print *, 'Dt :', dt
00117 print *, 'mnumdt :', mnumdt
00118 print *, 'mnumit :', mnumit
00119
00120
00121 do it=1,(MED_N_CELL_FIXED_GEO)
00122
00123 geotp = geotps(it)
00124
00125 call mfdnva(fid,finame,numdt,numit,MED_CELL,geotp,nvals,cret)
00126 if (cret .ne. 0 ) then
00127 print *,'ERROR : Read number of values ...'
00128 call efexit(-1)
00129 endif
00130 print *, 'Number of values of type :', geotp, ' :', nvals
00131
00132 if (nvals .gt. 0) then
00133 allocate(values(nvals),STAT=cret )
00134 if (cret > 0) then
00135 print *,'Memory allocation'
00136 call efexit(-1)
00137 endif
00138
00139 call mfdrvr(fid,finame,numdt,numit,MED_CELL,geotp,&
00140 MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,values,cret)
00141 if (cret .ne. 0 ) then
00142 print *,'ERROR : Read fields values for cells ...'
00143 call efexit(-1)
00144 endif
00145 print *, 'Fields values for cells :', values
00146
00147 deallocate(values)
00148 endif
00149 enddo
00150 enddo
00151 enddo
00152
00153
00154 call mficlo(fid,cret)
00155 if (cret .ne. 0 ) then
00156 print *,'ERROR : close file'
00157 call efexit(-1)
00158 endif
00159
00160 end program UsesCase_MEDfield_6
00161