1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2003 EDF R&D 3 C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY 4 C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 5 C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 6 C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. 7 C 8 C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT 9 C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF 10 C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU 11 C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. 12 C 13 C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE 14 C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION, 15 C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA 16 C 17 C************************************************************************** 18 19 C ******************************************************************************* 20 C * - Nom du fichier : test6.f 21 C * 22 C * - Description : exemples d'ecriture d'elements dans un maillage MED 23 C * 24 C ****************************************************************************** 25 program test6 26 C 27 implicit none 28 include 'med.hf' 29 C 30 C 31 integer cret, fid 32 integer mdim,nse2,ntr3 33 parameter (nse2 = 5, ntr3 = 2, mdim = 2) 34 integer se2 (2*nse2) 35 character*16 nomse2(nse2) 36 integer numse2(nse2),nufase2(nse2) 37 38 integer tr3 (3*ntr3) 39 character*16 nomtr3(ntr3) 40 integer numtr3(ntr3), nufatr3(ntr3) 41 character*32 maa 42 43 data se2 / 1,2,1,3,2,4,3,4,2,3 / 44 data nomse2 /"se1","se2","se3","se4","se5" / 45 data numse2 / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/ 46 data tr3 /1,2,-5,-5,3,-4 /, nomtr3 /"tr1","tr2"/, numtr3 /4,5/ 47 data nufatr3 /0,-1/, maa /"maa1"/ 48 49 C ** Ouverture du fichier ** 50 call efouvr(fid,'test6.med',MED_CREATION, cret) 51 print *,cret 52 53 C ** Creation du maillage maa de dimension 2 ** 54 if (cret .eq. 0) then 55 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 56 & 'un maillage pour test6',cret) 57 endif 58 print *,cret 59 60 C ** Ecriture des connectivites des segments ** 61 if (cret .eq. 0) then 62 call efcone(fid,maa,mdim,se2,MED_NO_INTERLACE, 63 & nse2,MED_ARETE, 64 & MED_SEG2,MED_DESC,cret ) 65 endif 66 print *,cret 67 68 C ** Ecriture (optionnelle) des noms des segments ** 69 if (cret .eq. 0) then 70 call efnome(fid,maa,nomse2,nse2,MED_ARETE, 71 & MED_SEG2 ,cret) 72 endif 73 print *,cret 74 C ** Ecriture (optionnelle) des numeros des segments ** 75 if (cret .eq. 0) then 76 call efnume(fid,maa,numse2,nse2, 77 & MED_ARETE ,MED_SEG2,cret) 78 endif 79 print *,cret 80 81 C ** Ecriture des numeros des familles des segments ** 82 if (cret .eq. 0) then 83 call effame(fid,maa,nufase2,nse2, 84 & MED_ARETE,MED_SEG2,cret) 85 endif 86 print *,cret 87 88 C ** Ecriture des connectivites des triangles ** 89 if (cret .eq. 0) then 90 call efcone(fid,maa,mdim,tr3,MED_NO_INTERLACE, 91 & ntr3,MED_MAILLE, 92 & MED_TRIA3,MED_DESC,cret ) 93 endif 94 print *,cret 95 C ** Ecriture (optionnelle) des noms des triangles ** 96 if (cret .eq. 0) then 97 call efnome(fid,maa,nomtr3,ntr3,MED_MAILLE, 98 & MED_TRIA3,cret) 99 endif 100 C ** Ecriture (optionnelle) des numeros des triangles ** 101 if (cret .eq. 0) then 102 call efnume(fid,maa,numtr3,ntr3,MED_MAILLE, 103 & MED_TRIA3,cret) 104 endif 105 print *,cret 106 107 C ** Ecriture des numeros des familles des triangles ** 108 if (cret .eq. 0) then 109 call effame(fid,maa,nufatr3,ntr3,MED_MAILLE, 110 & MED_TRIA3,cret) 111 endif 112 print *,cret 113 114 C ** Fermeture du fichier ** 115 call efferm (fid,cret) 116 print *,cret 117 118 end