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 test8
00025
00026 implicit none
00027 include 'med.hf'
00028
00029 integer cret, fid
00030
00031 character*64 maa
00032 integer mdim, sdim
00033 character*64 nomfam
00034 integer numfam
00035 integer ngro
00036 character*80 gro
00037 integer nfamn
00038 character*16 str
00039 character*16 nomcoo(2)
00040 character*16 unicoo(2)
00041
00042 parameter ( mdim = 2, nfamn = 2 , sdim = 2)
00043 data maa /"maa1"/
00044 data nomcoo /"x","y"/, unicoo /"cm","cm"/
00045
00046
00047 call mfiope(fid,'test8.med',MED_ACC_RDWR, cret)
00048 print *,cret
00049 if (cret .ne. 0 ) then
00050 print *,'Erreur creation du fichier'
00051 call efexit(-1)
00052 endif
00053
00054
00055 call mmhcre(fid,maa,mdim,sdim,MED_UNSTRUCTURED_MESH,
00056 & 'un maillage pour test8',"",MED_SORT_DTIT,
00057 & MED_CARTESIAN,nomcoo,unicoo,cret)
00058 print *,cret
00059 if (cret .ne. 0 ) then
00060 print *,'Erreur creation du maillage'
00061 call efexit(-1)
00062 endif
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075 numfam = 0
00076 nomfam="FAMILLE_0"
00077 ngro = 0
00078 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
00079 print *,cret
00080 if (cret .ne. 0 ) then
00081 print *,'Erreur creation de la famille 0'
00082 call efexit(-1)
00083 endif
00084
00085
00086
00087 do numfam=-1,-3,-1
00088 write(str,'(I1.0)') (-numfam)
00089 nomfam = "FAMILLE_ELEMENT_"//str
00090 gro="groupe1"
00091 ngro = 1
00092 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
00093 print *,cret
00094 if (cret .ne. 0 ) then
00095 print *,'Erreur creation de famille'
00096 call efexit(-1)
00097 endif
00098 end do
00099
00100 do numfam=1,nfamn
00101 write(str,'(I1.0)') numfam
00102 nomfam = "FAMILLE_NOEUD_"//str
00103 gro="groupe1"
00104 ngro = 1
00105 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
00106 print *,cret
00107 if (cret .ne. 0 ) then
00108 print *,'Erreur creation de famille'
00109 call efexit(-1)
00110 endif
00111 end do
00112
00113
00114
00115 call mficlo(fid,cret)
00116 print *,cret
00117 if (cret .ne. 0 ) then
00118 print *,'Erreur fermeture du fichier'
00119 call efexit(-1)
00120 endif
00121
00122 end
00123
00124
00125
00126
00127
00128