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_MEDmesh_11
00024
00025 implicit none
00026 include 'med.hf90'
00027
00028 integer cret
00029 integer fid
00030
00031 integer sdim, mdim
00032
00033 character*16 axname(2), unname(2)
00034
00035 character*16 dtunit
00036
00037 character*64 mname, fyname, finame
00038
00039 integer mtype, stype, atype
00040
00041 integer nfam, ngro, fnum
00042
00043 integer nstep
00044
00045 integer coocha, geotra
00046
00047 real*8, dimension(:), allocatable :: coords
00048 integer nnodes, ntria3, nquad4
00049
00050
00051 integer, dimension(:), allocatable :: tricon, quacon
00052 integer n
00053
00054
00055 integer, dimension (:), allocatable :: fanbrs
00056
00057 character*200 cmt1, mdesc
00058
00059 character*80, dimension (:), allocatable :: gname
00060
00061 parameter (mname = "2D unstructured mesh")
00062 parameter (finame = "UsesCase_MEDmesh_10.med")
00063
00064
00065 call mfiope(fid, finame, MED_ACC_RDONLY, cret)
00066 if (cret .ne. 0 ) then
00067 print *,'ERROR : open file'
00068 call efexit(-1)
00069 endif
00070
00071
00072
00073
00074
00075 call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, axname, unname, cret)
00076 if (cret .ne. 0 ) then
00077 print *,'Read mesh informations'
00078 call efexit(-1)
00079 endif
00080 print *,"mesh name =", mname
00081 print *,"space dim =", sdim
00082 print *,"mesh dim =", mdim
00083 print *,"mesh type =", mtype
00084 print *,"mesh description =", mdesc
00085 print *,"dt unit = ", dtunit
00086 print *,"sorting type =", stype
00087 print *,"number of computing step =", nstep
00088 print *,"coordinates axis type =", atype
00089 print *,"coordinates axis name =", axname
00090 print *,"coordinates axis units =", unname
00091
00092
00093 call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NO_GEOTYPE,MED_COORDINATE,MED_NO_CMODE,coocha,geotra,nnodes,cret)
00094 if (cret .ne. 0 ) then
00095 print *,'Read number of nodes ...'
00096 call efexit(-1)
00097 endif
00098 print *,"Number of nodes =", nnodes
00099
00100
00101
00102
00103
00104 call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_CONNECTIVITY,MED_NODAL,coocha,geotra,ntria3,cret)
00105 if (cret .ne. 0 ) then
00106 print *,'Read number of MED_TRIA3 ...'
00107 call efexit(-1)
00108 endif
00109 print *,"Number of MED_TRIA3 =", ntria3
00110
00111
00112 call mmhnme(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,MED_CONNECTIVITY,MED_NODAL,coocha,geotra,nquad4,cret)
00113 if (cret .ne. 0 ) then
00114 print *,'Read number of MED_QUAD4 ...'
00115 call efexit(-1)
00116 endif
00117 print *,"Number of MED_QUAD4 =", nquad4
00118
00119
00120 allocate ( coords(nnodes*sdim),STAT=cret )
00121 if (cret .ne. 0) then
00122 print *,'Memory allocation'
00123 call efexit(-1)
00124 endif
00125
00126 call mmhcor(fid,mname,MED_NO_DT,MED_NO_IT,MED_FULL_INTERLACE,coords,cret)
00127 print *,cret
00128 if (cret .ne. 0 ) then
00129 print *,'Read nodes coordinates'
00130 call efexit(-1)
00131 endif
00132 print *,"Nodes coordinates =", coords
00133 deallocate(coords)
00134
00135
00136 allocate ( tricon(ntria3*3),STAT=cret )
00137 if (cret .ne. 0) then
00138 print *,'Memory allocation'
00139 call efexit(-1)
00140 endif
00141
00142 call mmhcyr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_NODAL,MED_FULL_INTERLACE,tricon,cret)
00143 if (cret .ne. 0 ) then
00144 print *,'Read MED_TRIA3 connectivity'
00145 call efexit(-1)
00146 endif
00147 print *,"MED_TRIA3 connectivity =", tricon
00148 deallocate(tricon)
00149
00150
00151 allocate ( quacon(nquad4*4),STAT=cret )
00152 if (cret .ne. 0) then
00153 print *,'Memory allocation'
00154 call efexit(-1)
00155 endif
00156
00157 call mmhcyr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,MED_NODAL,MED_FULL_INTERLACE,quacon,cret)
00158 if (cret .ne. 0 ) then
00159 print *,'Read MED_QUAD4 connectivity'
00160 call efexit(-1)
00161 endif
00162 print *,"MED_QUAD4 connectivity =", quacon
00163 deallocate(quacon)
00164
00165
00166 call mfanfa(fid,mname,nfam,cret)
00167 if (cret .ne. 0 ) then
00168 print *,'Read number of family'
00169 call efexit(-1)
00170 endif
00171 print *,"Number of family =", nfam
00172
00173 do n=1,nfam
00174
00175 call mfanfg(fid,mname,n,ngro,cret)
00176 if (cret .ne. 0 ) then
00177 print *,'Read number of group in a family'
00178 call efexit(-1)
00179 endif
00180 print *,"Number of group in family =", ngro
00181
00182 if (ngro .gt. 0) then
00183 allocate ( gname((ngro)),STAT=cret )
00184 if (cret .ne. 0) then
00185 print *,'Memory allocation'
00186 call efexit(-1)
00187 endif
00188 call mfafai(fid,mname,n,fyname,fnum,gname,cret)
00189 if (cret .ne. 0) then
00190 print *,'Read group names'
00191 call efexit(-1)
00192 endif
00193 print *,"Group name =", gname
00194 deallocate(gname)
00195 endif
00196
00197 enddo
00198
00199
00200
00201
00202 allocate ( fanbrs(nnodes),STAT=cret )
00203 if (cret .ne. 0) then
00204 print *,'Memory allocation'
00205 call efexit(-1)
00206 endif
00207 call mmhfnr(fid,mname,MED_NO_DT,MED_NO_IT,MED_NODE, MED_NONE,fanbrs,cret)
00208 if (cret .ne. 0) then
00209 do n=1,nnodes
00210 fanbrs(n) = 0
00211 enddo
00212 endif
00213 print *, 'Family numbers for nodes :', fanbrs
00214 deallocate(fanbrs)
00215
00216
00217 allocate ( fanbrs(ntria3),STAT=cret )
00218 if (cret .ne. 0) then
00219 print *,'Memory allocation'
00220 call efexit(-1)
00221 endif
00222
00223 do n=1,ntria3
00224 fanbrs(n) = 0
00225 enddo
00226 call mmhfnr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,fanbrs,cret)
00227 if (cret .ne. 0) then
00228 do n=1,ntria3
00229 fanbrs(n) = 0
00230 enddo
00231 endif
00232 print *, 'Family numbers for tria cells :', fanbrs
00233 deallocate(fanbrs)
00234
00235 allocate ( fanbrs(nquad4),STAT=cret )
00236 if (cret .ne. 0) then
00237 print *,'Memory allocation'
00238 call efexit(-1)
00239 endif
00240 do n=1,nquad4
00241 fanbrs(n) = 0
00242 enddo
00243 call mmhfnr(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,fanbrs,cret)
00244 if (cret .ne. 0) then
00245 do n=1,nquad4
00246 fanbrs(n) = 0
00247 enddo
00248 endif
00249 print *, 'Family numbers for quad cells :', fanbrs
00250 deallocate(fanbrs)
00251
00252
00253 call mficlo(fid,cret)
00254 if (cret .ne. 0 ) then
00255 print *,'ERROR : close file'
00256 call efexit(-1)
00257 endif
00258
00259 end program UsesCase_MEDmesh_11
00260