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