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 test27
00026
00027 implicit none
00028 include 'med.hf'
00029
00030
00031 integer cret, fid
00032
00033 integer mdim,sdim
00034
00035 character*64 maa
00036
00037 integer nnoe
00038
00039 real*8 coo(8)
00040 character*16 nomcoo(2), unicoo(2)
00041 character*200 desc
00042 integer strgri(2)
00043
00044 integer axe,nind
00045 real*8 indice(4)
00046
00047
00048
00049 data coo /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/
00050 data nomcoo /"x","y"/, unicoo /"cm","cm"/
00051
00052
00053 call mfiope(fid,'test27.med',MED_ACC_RDWR, cret)
00054 print *,cret
00055 if (cret .ne. 0 ) then
00056 print *,'Erreur creation du fichier'
00057 call efexit(-1)
00058 endif
00059 print *,'Creation du fichier test27.med'
00060
00061
00062 mdim = 2
00063 sdim = 2
00064 maa = 'maillage vide'
00065 desc = 'un maillage vide'
00066 call mmhcre(fid,maa,mdim,sdim,MED_UNSTRUCTURED_MESH,
00067 & desc,"",MED_SORT_DTIT,MED_CARTESIAN,
00068 & nomcoo,unicoo,cret)
00069 print *,cret
00070 if (cret .ne. 0 ) then
00071 print *,'Erreur creation du maillage'
00072 call efexit(-1)
00073 endif
00074
00075
00076 mdim = 2
00077 maa = 'grille cartesienne'
00078 desc = 'un exemple de grille cartesienne'
00079 call mmhcre(fid,maa,mdim,sdim,MED_STRUCTURED_MESH,
00080 & desc,"",MED_SORT_DTIT,MED_CARTESIAN,
00081 & nomcoo,unicoo,cret)
00082 print *,cret
00083 if (cret .ne. 0 ) then
00084 print *,'Erreur creation du maillage'
00085 call efexit(-1)
00086 endif
00087 print *,'Creation d un maillage MED_STRUCTURE'
00088
00089
00090
00091 call mmhgtw(fid,maa,MED_CARTESIAN_GRID,cret)
00092 print *,cret
00093 print *,
00094 'On definit la nature de la grille : & MED_GRILLE_CARTESIENNE'
00095 if (cret .ne. 0 ) then
00096 print *,'Erreur ecriture de la nature de la grille'
00097 call efexit(-1)
00098 endif
00099
00100
00101 indice(1) = 1.1D0
00102 indice(2) = 1.2D0
00103 indice(3) = 1.3D0
00104 indice(4) = 1.4D0
00105 nind = 4
00106 axe = 1
00107 call mmhgcw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
00108 & axe,nind,indice,cret)
00109 print *,cret
00110 if (cret .ne. 0 ) then
00111 print *,'Erreur ecriture des indices'
00112 call efexit(-1)
00113 endif
00114 print *,'Ecriture des indices des coordonnees selon axe X'
00115
00116 indice(1) = 2.1D0
00117 indice(2) = 2.2D0
00118 indice(3) = 2.3D0
00119 indice(4) = 2.4D0
00120 nind = 4
00121 axe = 2
00122 call mmhgcw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
00123 & axe,nind,indice,cret)
00124 print *,cret
00125 if (cret .ne. 0 ) then
00126 print *,'Erreur ecriture des indices'
00127 call efexit(-1)
00128 endif
00129 print *,'Ecriture des indices des coordonnees selon axe Y'
00130
00131
00132 maa = 'grille curviligne'
00133 mdim = 2
00134 desc = 'un exemple de grille curviligne'
00135 call mmhcre(fid,maa,mdim,sdim,MED_STRUCTURED_MESH,
00136 & desc,"",MED_SORT_DTIT,MED_CARTESIAN,
00137 & nomcoo,unicoo,cret)
00138 print *,cret
00139 if (cret .ne. 0 ) then
00140 print *,'Erreur creation de maillage'
00141 call efexit(-1)
00142 endif
00143 print *,'Nouveau maillage MED_STRUCTURE'
00144
00145 call mmhgtw(fid,maa,MED_CURVILINEAR_GRID,cret)
00146 print *,cret
00147 if (cret .ne. 0 ) then
00148 print *,'Erreur ecriture de la nature de la grille'
00149 call efexit(-1)
00150 endif
00151 print *,'On definit la nature du maillage : MED_GRILLE_STANDARD'
00152
00153
00154 nnoe = 4
00155 call mmhcow(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
00156 & MED_FULL_INTERLACE,nnoe,coo,cret)
00157 print *,cret
00158 if (cret .ne. 0 ) then
00159 print *,'Erreur ecriture des coordonnees des noeuds'
00160 call efexit(-1)
00161 endif
00162 print *,'Ecriture des coordonnees de la grille'
00163
00164
00165 strgri(1) = 2
00166 strgri(2) = 2
00167 call mmhgsw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
00168 & strgri,cret)
00169 print *,cret
00170 if (cret .ne. 0 ) then
00171 print *,'Erreur ecriture de la structure'
00172 call efexit(-1)
00173 endif
00174 print *,'Ecriture de la structure de la grille : / 2,2 /'
00175
00176
00177 call mficlo(fid,cret)
00178 print *,cret
00179 if (cret .ne. 0 ) then
00180 print *,'Erreur fermeture du fichier'
00181 call efexit(-1)
00182 endif
00183 print *,'Fermeture du fichier'
00184
00185 end
00186
00187
00188
00189
00190
00191