00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 
00024       program test7
00025     
00026       implicit none
00027       include 'med.hf90'
00028 
00029 
00030       integer cret, ret, fid
00031 
00032       integer nse2
00033       integer,     allocatable, dimension (:) :: se2,se21
00034       character*16, allocatable, dimension (:) :: nomse2
00035       integer,     allocatable, dimension (:) :: numse2,nufase2
00036  
00037       integer ntr3
00038       integer,     allocatable, dimension (:) :: tr3
00039       character*16, allocatable, dimension (:) :: nomtr3
00040       integer,     allocatable, dimension (:) :: numtr3,nufatr3
00041    
00042 
00043       character*64  :: maa
00044       character*200 :: desc
00045       integer       :: mdim,edim,nstep,stype,atype
00046       logical inoele,inuele
00047       integer, parameter :: profil (2) = (/ 2,3 /) 
00048       integer type
00049       integer tse2,ttr3, i
00050       character*16 nomcoo(2)
00051       character*16 unicoo(2)
00052       character*16 dtunit
00053       integer :: chgt,tsf
00054       integer flta(1)
00055       integer*8 flt(1)
00056 
00057 
00058       call mfiope(fid,'test6.med',MED_ACC_RDONLY, cret)     
00059       print *,cret
00060 
00061 
00062       if (cret.eq.0) then
00063          call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00064          print *,"Maillage de nom : ",maa," et de dimension :", mdim
00065       endif
00066       if (cret.ne.0) then
00067          call efexit(-1)
00068       endif
00069 
00070       if (cret.eq.0) then
00071          nse2 = 0
00072          call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_CONNECTIVITY,MED_DESCENDING,chgt,tsf,nse2,cret)   
00073       endif
00074       if (cret.ne.0) then
00075          call efexit(-1)
00076       endif
00077 
00078       if (cret.eq.0) then
00079          ntr3 = 0
00080          call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_CONNECTIVITY,MED_DESCENDING,chgt,tsf,ntr3,cret)  
00081       endif
00082       if (cret.ne.0) then
00083          call efexit(-1)
00084       endif
00085 
00086       if (cret.eq.0) then
00087          print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3 
00088       endif
00089 
00090 
00091       tse2 = 2
00092       allocate (se2(tse2*nse2),se21(tse2*nse2),nomse2(nse2),numse2(nse2), nufase2(nse2),STAT=ret )
00093       se2(:)=0; se21(:)=0
00094 
00095 
00096       ttr3 = 3
00097       allocate (tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),STAT=ret )
00098       tr3(:)=0
00099 
00100 
00101 
00102 
00103       if (cret.eq.0) then
00104         call mmhcyr(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING,MED_FULL_INTERLACE,se2,cret)
00105       endif
00106       if (cret.ne.0) then
00107          call efexit(-1)
00108       endif
00109       print *,se2
00110 
00111 
00112 
00113      if (cret .eq. 0) then
00114         call mfrall(1,flt,cret)
00115      endif
00116      if (cret.ne.0) then
00117         call efexit(-1)
00118      endif
00119 
00120 
00121      if (cret .eq. 0) then
00122         call mfrcre(fid,nse2,1,edim,2,MED_FULL_INTERLACE,MED_GLOBAL_PFLMODE, &
00123                     MED_NO_PROFILE,MED_UNDEF_SIZE,flta,flt(1),cret)
00124      endif
00125      if (cret.ne.0) then
00126         call efexit(-1)
00127      endif
00128 
00129 
00130      if (cret.eq.0) then
00131         call mmhyar(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING, &
00132                     flt(1),se21,cret)
00133      endif
00134      if (cret.ne.0) then
00135         call efexit(-1)
00136      endif
00137      print *,se21
00138 
00139 
00140      if (cret .eq. 0) then
00141         call mfrdea(1,flt,cret)
00142      endif
00143      if (cret.ne.0) then
00144         call efexit(-1)
00145      endif
00146 
00147 
00148       if (cret.eq.0) then
00149          call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,nomse2,cret) 
00150       endif
00151     
00152       if (ret <0) then
00153          inoele = .FALSE.
00154       else
00155          inoele = .TRUE.
00156       endif
00157 
00158 
00159       if (cret.eq.0) then
00160          call mmhenr(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,numse2,cret)
00161      endif
00162 
00163      if (ret <0) then
00164         inuele = .FALSE.
00165      else
00166         inuele = .TRUE.
00167      endif
00168 
00169 
00170      if (cret.eq.0) then
00171         call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,nufase2,cret)
00172       endif
00173      if (cret.ne.0) then
00174         call efexit(-1)
00175      endif
00176 
00177 
00178       if (cret.eq.0) then
00179         call mmhcyr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_DESCENDING,MED_NO_INTERLACE,tr3,cret)
00180       endif
00181      if (cret.ne.0) then
00182         call efexit(-1)
00183      endif
00184 
00185 
00186       if (cret.eq.0) then
00187          call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,nomtr3,cret) 
00188       endif
00189     
00190       if (ret <0) then
00191          inoele = .FALSE.
00192       else
00193          inoele = .TRUE.
00194       endif
00195       print *,cret
00196 
00197 
00198       if (cret.eq.0) then
00199         call mmhenr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,numtr3,cret)
00200      endif
00201 
00202      if (ret <0) then
00203         inuele = .FALSE.
00204      else
00205         inuele = .TRUE.
00206      endif
00207      print *,cret
00208 
00209 
00210      if (cret.eq.0) then
00211         call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,nufatr3,cret)
00212       endif
00213       print *,cret
00214 
00215 
00216      call mficlo(fid,cret)
00217      if (cret.ne.0) then
00218         call efexit(-1)
00219      endif
00220  
00221 
00222      if (cret.eq.0) then
00223         
00224         print *,"Connectivite des segments : "
00225         print *, se2
00226         
00227         if (inoele) then
00228            print *,"Noms des segments :"
00229            print *,nomse2
00230         endif
00231         
00232         if (inuele) then
00233            print *,"Numeros des segments :"
00234            print *,numse2
00235         endif
00236         
00237         print *,"Numeros des familles des segments :"
00238         print *,nufase2
00239         
00240         print *,"Connectivite des triangles :"
00241         print *,tr3
00242         
00243         if (inoele) then
00244            print *,"Noms des triangles :"
00245            print *,nomtr3
00246         endif
00247         
00248         if (inuele) then
00249            print *,"Numeros des triangles :"
00250            print *,numtr3
00251         endif
00252         
00253         print *,"Numeros des familles des triangles :"
00254         print *,nufatr3
00255         
00256      endif
00257 
00258 
00259       deallocate (se2,se21,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
00260 
00261 
00262       call efexit(cret)
00263 
00264     end program test7
00265