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 test13
00026
00027 implicit none
00028 include 'med.hf'
00029
00030
00031 integer ret,cret,fid
00032 character*32 maa
00033 integer mdim,nequ,ncor
00034 integer, allocatable, dimension(:) :: cor
00035 character*32 equ
00036 character*200 des
00037 integer i,j,k
00038 character*255 argc
00039 integer, parameter :: MED_NBR_MAILLE_EQU = 8
00040 integer,parameter :: typmai(MED_NBR_MAILLE_EQU) = (/ MED_POINT1,MED_SEG2,
00041 MED_SEG3,MED_TRIA3, &
00042 MED_TRIA6,MED_QUAD4, &
00043 MED_QUAD8,MED_POLYGONE/)
00044
00045 integer,parameter :: typfac(MED_NBR_GEOMETRIE_FACE+1) = (/MED_TRIA3,MED_TRIA6,
00046 MED_QUAD4,MED_QUAD8, MED_POLYGONE/)
00047 integer,parameter ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,MED_SEG3/)
00048 character*200 desc
00049 integer type
00050
00051 print *,"Indiquez le fichier med a decrire : "
00052
00053 argc = "test12.med"
00054
00055
00056 call efouvr(fid,argc,MED_LECTURE, cret)
00057 print *,cret
00058
00059
00060
00061 if (cret.eq.0) then
00062 call efmaai(fid,1,maa,mdim,type,desc,cret)
00063 print *,"Maillage de nom : ",maa," et de dimension : ", mdim
00064 endif
00065 print *,cret
00066
00067
00068
00069 if (cret.eq.0) then
00070 call efnequ(fid,maa,nequ,cret)
00071 if (cret.eq.0) then
00072 print *,"Nombre d'equivalences : ",nequ
00073 endif
00074 endif
00075
00076
00077 if (cret.eq.0) then
00078 do i=1,nequ
00079 print *,"Equivalence numero : ",i
00080
00081 if (cret.eq.0) then
00082 call efequi(fid,maa,i,equ,des,cret)
00083 endif
00084 print *,cret
00085 if (cret.eq.0) then
00086 print *,"Nom de l'equivalence : ",equ
00087 print *,"Description de l'equivalence : ",des
00088 endif
00089
00090
00091 if (cret.eq.0) then
00092
00093 call efncor(fid,maa,equ,MED_NOEUD,0,ncor,cret)
00094 print *,"Il y a ",ncor," correspondances sur les noeuds "
00095 if (ncor > 0) then
00096 allocate(cor(ncor*2),STAT=ret)
00097 call efequl(fid,maa,equ,cor,ncor,MED_NOEUD,0,cret)
00098 do j=0,(ncor-1)
00099 print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
00100 end do
00101 deallocate(cor)
00102 end if
00103
00104
00105
00106 do j=1,MED_NBR_MAILLE_EQU
00107 call efncor(fid,maa,equ,MED_MAILLE,typmai(j),ncor,cret)
00108 print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
00109 if (ncor > 0 ) then
00110 allocate(cor(2*ncor),STAT=ret)
00111 call efequl(fid,maa,equ,cor,ncor,MED_MAILLE,typmai(j),cret)
00112 do k=0,(ncor-1)
00113 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00114 end do
00115 deallocate(cor)
00116 endif
00117 end do
00118
00119
00120 do j=1,MED_NBR_GEOMETRIE_FACE+1
00121 call efncor(fid,maa,equ,MED_FACE,typfac(j),ncor,cret)
00122 print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
00123 if (ncor > 0 ) then
00124 allocate(cor(2*ncor),STAT=ret)
00125 call efequl(fid,maa,equ,cor,ncor,MED_FACE,typfac(j),cret)
00126 do k=0,(ncor-1)
00127 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00128 end do
00129 deallocate(cor)
00130 endif
00131 end do
00132
00133
00134 do j=1,MED_NBR_GEOMETRIE_ARETE
00135 call efncor(fid,maa,equ,MED_ARETE,typare(j),ncor,cret)
00136 print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
00137 if (ncor > 0 ) then
00138 allocate(cor(2*ncor),STAT=ret)
00139 call efequl(fid,maa,equ,cor,ncor,MED_ARETE,typare(j),cret)
00140 do k=0,(ncor-1)
00141 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00142 end do
00143 deallocate(cor)
00144 endif
00145 end do
00146
00147 end if
00148 end do
00149 end if
00150
00151
00152 call efferm (fid,cret)
00153 print *,cret
00154
00155
00156 call efexit(cret)
00157
00158 end program test13
00159
00160
00161
00162
00163