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