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.hf90'
00029
00030
00031 integer ret,cret,fid
00032 character*64 maa
00033 integer mdim,nequ,ncor,sdim
00034 integer, allocatable, dimension(:) :: cor
00035 character*64 equ
00036 character*200 desc,des
00037 integer i,j,k
00038 character*255 argc
00039 integer,parameter :: MY_NOF_DESCENDING_FACE_TYPE = 5
00040 integer,parameter :: MY_NOF_DESCENDING_EDGE_TYPE = 2
00041
00042
00043 integer, parameter :: MED_NBR_MAILLE_EQU = 8
00044 integer,parameter :: typmai(MED_NBR_MAILLE_EQU) = (/ MED_POINT1,MED_SEG2,
00045 MED_SEG3,MED_TRIA3, &
00046 MED_TRIA6,MED_QUAD4, &
00047 MED_QUAD8,MED_POLYGON/)
00048
00049 integer,parameter :: typfac(MY_NOF_DESCENDING_FACE_TYPE) = (/MED_TRIA3,MED_TRIA6,
00050 MED_QUAD4,MED_QUAD8, MED_POLYGON/)
00051 integer,parameter ::typare(MY_NOF_DESCENDING_EDGE_TYPE) = (/MED_SEG2,MED_SEG3/)
00052 integer type
00053 character(16) :: dtunit
00054 integer nstep, stype, atype
00055 character*16 nomcoo(3)
00056 character*16 unicoo(3)
00057 integer nctcor,nstepc
00058
00059
00060
00061 call mfiope(fid,'test12.med',MED_ACC_RDONLY, cret)
00062 print *,cret
00063
00064
00065
00066 if (cret.eq.0) then
00067 call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00068 print *,"Maillage de nom : ",maa," et de dimension : ", mdim
00069 endif
00070 print *,cret
00071
00072
00073
00074 if (cret.eq.0) then
00075 call meqneq(fid,maa,nequ,cret)
00076 if (cret.eq.0) then
00077 print *,"Nombre d'equivalence : ",nequ
00078 endif
00079 endif
00080
00081
00082
00083 if (cret.eq.0) then
00084 do i=1,nequ
00085 print *,"Equivalence numero : ",i
00086
00087 if (cret.eq.0) then
00088 call meqeqi(fid,maa,i,equ,des,nstepc,nctcor,cret)
00089 endif
00090 print *,cret
00091 if (cret.eq.0) then
00092 print *,"Nom de l'equivalence : ",equ
00093 print *,"Description de l'equivalence : ",des
00094 print *,"Nombre de pas de temps sur l'equivalence : ",nstepc
00095 print *,"Nombre de correspondance sur MED_NO_IT, MED_NO_DT : ", nctcor
00096 endif
00097
00098
00099 if (cret.eq.0) then
00100
00101 call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,ncor,cret)
00102 print *,cret
00103 print *,"Il y a ",ncor," correspondances sur les noeuds "
00104 if (ncor > 0) then
00105 allocate(cor(ncor*2),STAT=ret)
00106 call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,cor,cret)
00107 do j=0,(ncor-1)
00108 print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
00109 end do
00110 deallocate(cor)
00111 end if
00112
00113
00114
00115 do j=1,MED_NBR_MAILLE_EQU
00116 call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_CELL,typmai(j),ncor,cret)
00117 print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
00118 if (ncor > 0 ) then
00119 allocate(cor(2*ncor),STAT=ret)
00120 call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_CELL,typmai(j),cor,cret)
00121 do k=0,(ncor-1)
00122 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00123 end do
00124 deallocate(cor)
00125 endif
00126 end do
00127
00128
00129 do j=1,MY_NOF_DESCENDING_FACE_TYPE
00130 call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_FACE,typmai(j),ncor,cret)
00131 print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
00132 if (ncor > 0 ) then
00133 allocate(cor(2*ncor),STAT=ret)
00134 call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_FACE,typfac(j),cor,cret)
00135 do k=0,(ncor-1)
00136 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00137 end do
00138 deallocate(cor)
00139 endif
00140 end do
00141
00142
00143 do j=1,MY_NOF_DESCENDING_EDGE_TYPE
00144 call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,typare(j),ncor,cret)
00145 print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
00146 if (ncor > 0 ) then
00147 allocate(cor(2*ncor),STAT=ret)
00148 call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,typare(j),cor,cret)
00149 do k=0,(ncor-1)
00150 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00151 end do
00152 deallocate(cor)
00153 endif
00154 end do
00155
00156 end if
00157 end do
00158 end if
00159
00160
00161 call mficlo(fid,cret)
00162 print *,cret
00163
00164
00165 call efexit(cret)
00166
00167 end program test13
00168
00169
00170
00171
00172