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_4
00024
00025 implicit none
00026 include 'med.hf77'
00027
00028
00029 integer cret
00030 integer fid
00031
00032 integer ncompo
00033
00034 integer ntria3, nquad4
00035
00036 character*64 fname, lfname
00037
00038 character*64 mname, finame, cpname, cpunit
00039 character*16 dtunit
00040 real*8 dt
00041 integer ndt, nit
00042
00043 integer mnumdt, mnumit
00044
00045 real*8 t3vs1(8)
00046 real*8 t3vs2(8)
00047 real*8 q4vs1(4)
00048 real*8 q4vs2(4)
00049
00050 parameter (fname = "UsesCase_MEDfield_4.med")
00051 parameter (lfname = "./UsesCase_MEDmesh_1.med")
00052 parameter (mname = "2D unstructured mesh")
00053 parameter (finame = "TEMPERATURE_FIELD")
00054 parameter (cpname ="TEMPERATURE", cpunit = "C")
00055 parameter (dtunit = "ms")
00056 parameter (ncompo = 1 )
00057 parameter (ntria3 = 8, nquad4 = 4)
00058
00059 data t3vs1 / 1000., 2000., 3000., 4000.,
00060 & 5000., 6000., 7000., 8000. /
00061 data q4vs1 / 10000., 20000., 30000., 4000. /
00062 data t3vs2 / 1500., 2500., 3500., 4500.,
00063 & 5500., 6500., 7500., 8500. /
00064 data q4vs2 / 15000., 25000., 35000., 45000. /
00065
00066
00067
00068 call mfiope(fid,fname,MED_ACC_CREAT,cret)
00069 if (cret .ne. 0 ) then
00070 print *,'ERROR : file creation'
00071 call efexit(-1)
00072 endif
00073
00074
00075
00076 call mlnliw(fid,mname,lfname,cret)
00077 if (cret .ne. 0 ) then
00078 print *,'ERROR : create mesh link ...'
00079 call efexit(-1)
00080 endif
00081
00082
00083
00084
00085
00086 call mfdcre(fid,finame,MED_FLOAT64,ncompo,cpname,cpunit,dtunit,
00087 & mname,cret)
00088 if (cret .ne. 0 ) then
00089 print *,'ERROR : create field ...'
00090 call efexit(-1)
00091 endif
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104 dt = 5.5d0
00105 ndt = 1
00106 nit = 1
00107 call mfdrvw(fid,finame,ndt,nit,dt,MED_CELL,MED_TRIA3,
00108 & MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00109 & ntria3,t3vs1,cret)
00110 if (cret .ne. 0 ) then
00111 print *,'ERROR : write field values on MED_TRIA3'
00112 call efexit(-1)
00113 endif
00114
00115
00116
00117 call mfdrvw(fid,finame,ndt,nit,dt,MED_CELL,MED_QUAD4,
00118 & MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00119 & nquad4,q4vs1,cret)
00120 if (cret .ne. 0 ) then
00121 print *,'ERROR : write field values on MED_TRIA3'
00122 call efexit(-1)
00123 endif
00124
00125
00126
00127
00128
00129 dt = 8.9d0
00130 ndt = 2
00131 nit = 1
00132 call mfdrvw(fid,finame,ndt,nit,dt,MED_CELL,MED_TRIA3,
00133 & MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00134 & ntria3,t3vs2,cret)
00135 if (cret .ne. 0 ) then
00136 print *,'ERROR : write field values on MED_TRIA3'
00137 call efexit(-1)
00138 endif
00139
00140
00141
00142 call mfdrvw(fid,finame,ndt,nit,dt,MED_CELL,MED_QUAD4,
00143 & MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00144 & nquad4,q4vs2,cret)
00145 if (cret .ne. 0 ) then
00146 print *,'ERROR : write field values on MED_TRIA3'
00147 call efexit(-1)
00148 endif
00149
00150
00151
00152 mnumdt = 1
00153 mnumit = 3
00154 call mfdcmw(fid,finame,ndt,nit,mnumdt,mnumit,cret)
00155 if (cret .ne. 0 ) then
00156 print *,'ERROR : write field mesh computation step error '
00157 call efexit(-1)
00158 endif
00159
00160
00161
00162 call mficlo(fid,cret)
00163 if (cret .ne. 0 ) then
00164 print *,'ERROR : close file'
00165 call efexit(-1)
00166 endif
00167
00168
00169
00170 end
00171