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.hf'
00028
00029
00030 integer cret, ret, fid
00031
00032 integer nse2
00033 integer, allocatable, dimension (:) :: se2
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*32 :: maa = "maa1"
00044 character*200 :: desc
00045 integer :: mdim
00046 logical inoele,inuele
00047 integer, parameter :: profil (2) = (/ 2,3 /)
00048 integer type
00049 integer tse2,ttr3, i
00050
00051
00052 call efouvr(fid,'test6.med',MED_LECTURE, cret)
00053 print *,cret
00054
00055
00056 if (cret.eq.0) then
00057 call efmaai(fid,1,maa,mdim,type,desc,cret)
00058 print *,"Maillage de nom : ",maa," et de dimension :", mdim
00059 endif
00060 print *,cret
00061
00062
00063 if (cret.eq.0) then
00064 nse2 = 0
00065 call efnema(fid,maa,MED_CONN,MED_ARETE,MED_SEG2,MED_DESC, &
00066 & nse2,cret)
00067 endif
00068 print *,cret
00069
00070 if (cret.eq.0) then
00071 ntr3 = 0
00072 call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_TRIA3,MED_DESC, &
00073 & ntr3,cret)
00074 endif
00075 print *,cret
00076
00077 if (cret.eq.0) then
00078 print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
00079 endif
00080
00081
00082 tse2 = 2
00083 allocate ( se2(tse2*nse2), nomse2(nse2),numse2(nse2), nufase2(nse2),STAT=ret )
00084
00085
00086 ttr3 = 3
00087 allocate ( tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),STAT=ret )
00088
00089
00090
00091
00092 if (cret.eq.0) then
00093 call efconl(fid,maa,mdim,se2,MED_NO_INTERLACE,profil,2,MED_ARETE, &
00094 & MED_SEG2,MED_DESC,cret)
00095 endif
00096 print *,cret
00097 print *,se2
00098
00099
00100 if (cret.eq.0) then
00101 call efnoml(fid,maa,nomse2,nse2,MED_ARETE, &
00102 & MED_SEG2,ret)
00103 endif
00104
00105 if (ret <0) then
00106 inoele = .FALSE.
00107 else
00108 inoele = .TRUE.
00109 endif
00110
00111
00112 if (cret.eq.0) then
00113 call efnuml(fid,maa,numse2,nse2,MED_ARETE,MED_SEG2,ret)
00114 endif
00115
00116 if (ret <0) then
00117 inuele = .FALSE.
00118 else
00119 inuele = .TRUE.
00120 endif
00121
00122
00123 if (cret.eq.0) then
00124 call effaml(fid,maa,nufase2,nse2,MED_ARETE,MED_SEG2,cret)
00125 endif
00126 print *,cret
00127
00128
00129 if (cret.eq.0) then
00130 call efconl(fid,maa,mdim,tr3,MED_NO_INTERLACE,profil,0,MED_MAILLE, &
00131 & MED_TRIA3,MED_DESC,cret)
00132 endif
00133 print *,cret
00134
00135
00136 if (cret.eq.0) then
00137 call efnoml(fid,maa,nomtr3,ntr3,MED_MAILLE, &
00138 & MED_TRIA3,ret)
00139 endif
00140
00141 if (ret <0) then
00142 inoele = .FALSE.
00143 else
00144 inoele = .TRUE.
00145 endif
00146 print *,cret
00147
00148
00149 if (cret.eq.0) then
00150 call efnuml(fid,maa,numtr3,ntr3,MED_MAILLE,MED_TRIA3,ret)
00151 endif
00152
00153 if (ret <0) then
00154 inuele = .FALSE.
00155 else
00156 inuele = .TRUE.
00157 endif
00158 print *,cret
00159
00160
00161 if (cret.eq.0) then
00162 call effaml(fid,maa,nufatr3,ntr3,MED_MAILLE,MED_TRIA3,cret)
00163 endif
00164 print *,cret
00165
00166
00167 call efferm (fid,cret)
00168 print *,cret
00169
00170
00171 if (cret.eq.0) then
00172
00173 print *,"Connectivite des segments : "
00174 print *, se2
00175
00176 if (inoele) then
00177 print *,"Noms des segments :"
00178 print *,nomse2
00179 endif
00180
00181 if (inuele) then
00182 print *,"Numeros des segments :"
00183 print *,numse2
00184 endif
00185
00186 print *,"Numeros des familles des segments :"
00187 print *,nufase2
00188
00189 print *,"Connectivite des triangles :"
00190 print *,tr3
00191
00192 if (inoele) then
00193 print *,"Noms des triangles :"
00194 print *,nomtr3
00195 endif
00196
00197 if (inuele) then
00198 print *,"Numeros des triangles :"
00199 print *,numtr3
00200 endif
00201
00202 print *,"Numeros des familles des triangles :"
00203 print *,nufatr3
00204
00205 endif
00206
00207
00208 deallocate (se2,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
00209
00210
00211 call efexit(cret)
00212
00213 end program test7
00214