00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025 program UsesCase_MEDmesh_6
00026
00027 implicit none
00028 include 'med.hf77'
00029
00030
00031 integer cret
00032 integer fid
00033
00034 character (MED_NAME_SIZE) mname
00035 character (MED_NAME_SIZE) fname
00036 character (MED_COMMENT_SIZE) cmt1,mdesc
00037 integer sdim, mdim
00038
00039 character (MED_SNAME_SIZE) axname(2)
00040
00041 character (MED_SNAME_SIZE) unname(2)
00042 real*8 inicoo(30)
00043 integer nnodes, ntria3, nquad4
00044
00045 integer triacy(24)
00046
00047 integer quadcy(16)
00048
00049 real*8 nwcos1(6)
00050
00051 character (MED_NAME_SIZE) prof1n
00052
00053 integer profi1(3)
00054
00055 integer pro1sz
00056
00057 real*8 nwcos2(6)
00058
00059 character (MED_NAME_SIZE) prof2n
00060
00061 integer profi2(3)
00062
00063 integer pro2sz
00064
00065 parameter (fname = "UsesCase_MEDmesh_6.med")
00066 parameter (cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
00067 parameter (mdesc = "A 2D unstructured mesh")
00068 parameter (mname="2D unstructured mesh")
00069 parameter (sdim=2, mdim=2)
00070 parameter (nnodes=15,ntria3=8,nquad4=4)
00071
00072 data axname /"x", "y"/
00073 data unname /"cm", "cm"/
00074 data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
00075 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
00076 & 2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
00077 data triacy /1,7,6, 2,7,1, 3,7,2, 8,7,3,
00078 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
00079 data quadcy /3,4,9,8, 4,5,10,9,
00080 & 15,14,9,10, 13,8,9,14/
00081
00082
00083 data nwcos1 /12.,15., 17.,15., 22.,15./
00084 parameter (prof1n="UPPER_QUAD4_PROFILE")
00085 data profi1 /13, 14, 15/
00086 parameter (pro1sz=3)
00087
00088
00089 data nwcos2 /12.,10., 17.,10., 22.,10./
00090 parameter (prof2n="MIDDLE_QUAD4_PROFILE")
00091 data profi2 /8, 9, 10/
00092 parameter (pro2sz=3)
00093
00094
00095 call mfiope(fid,fname,MED_ACC_CREAT,cret)
00096 if (cret .ne. 0 ) then
00097 print *,"ERROR : file creation"
00098 call efexit(-1)
00099 endif
00100
00101
00102 call mficow(fid,cmt1,cret)
00103 if (cret .ne. 0 ) then
00104 print *,"ERROR : write file description"
00105 call efexit(-1)
00106 endif
00107
00108
00109 call mpfprw(fid,prof1n,pro1sz,profi1,cret)
00110 if (cret .ne. 0 ) then
00111 print *,"ERROR : create profile"
00112 call efexit(-1)
00113 endif
00114
00115
00116 call mpfprw(fid,prof2n,pro2sz,profi2,cret)
00117 if (cret .ne. 0 ) then
00118 print *,"ERROR : create profile"
00119 call efexit(-1)
00120 endif
00121
00122
00123 call mmhcre(fid, mname, sdim, mdim, MED_UNSTRUCTURED_MESH, mdesc,
00124 & "", MED_SORT_DTIT, MED_CARTESIAN, axname, unname, cret)
00125 if (cret .ne. 0 ) then
00126 print *,"ERROR : mesh creation"
00127 call efexit(-1)
00128 endif
00129
00130
00131
00132
00133 call mmhcpw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00134 & MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00135 & MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00136 & nnodes, inicoo, cret)
00137 if (cret .ne. 0 ) then
00138 print *,"ERROR : nodes coordinates"
00139 call efexit(-1)
00140 endif
00141
00142
00143
00144 call mmhypw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00145 & MED_CELL, MED_TRIA3, MED_NODAL,
00146 & MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00147 & MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00148 & ntria3, triacy, cret)
00149 if (cret .ne. 0 ) then
00150 print *,"ERROR : triangular cells connectivity"
00151 call efexit(-1)
00152 endif
00153
00154
00155 call mmhypw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00156 & MED_CELL, MED_QUAD4, MED_NODAL,
00157 & MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00158 & MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00159 & nquad4, quadcy, cret)
00160 if (cret .ne. 0 ) then
00161 print *,"ERROR : quadrangular cells connectivity"
00162 call efexit(-1)
00163 endif
00164
00165
00166
00167
00168
00169
00170 call mmhcpw(fid, mname, 1, 1, 5.5D0,
00171 & MED_COMPACT_PFLMODE, prof1n,
00172 & MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00173 & nnodes, nwcos1, cret)
00174 if (cret .ne. 0 ) then
00175 print *,"ERROR : nodes coordinates"
00176 call efexit(-1)
00177 endif
00178
00179
00180
00181 call mmhcpw(fid, mname, 2, 1, 8.9D0,
00182 & MED_COMPACT_PFLMODE, prof2n,
00183 & MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00184 & nnodes, nwcos2, cret)
00185 if (cret .ne. 0 ) then
00186 print *,"ERROR : nodes coordinates"
00187 call efexit(-1)
00188 endif
00189
00190
00191
00192 call mfacre(fid, mname,MED_NO_NAME, 0, 0, MED_NO_GROUP, cret)
00193 if (cret .ne. 0 ) then
00194 print *,"ERROR : create family 0"
00195 call efexit(-1)
00196 endif
00197
00198
00199
00200 call mficlo(fid,cret)
00201 if (cret .ne. 0 ) then
00202 print *,"ERROR : close file"
00203 call efexit(-1)
00204 endif
00205
00206
00207 end
00208