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 20 C ****************************************************************************** 21 C * - Nom du fichier : test16.f 22 C * 23 C * - Description : ecriture d'elements d'un maillage MED 24 C * via les routines de niveau 2 25 C * - equivalent a test6.f 26 C * 27 C ****************************************************************************** 28 program test16 29 C 30 implicit none 31 include 'med.hf' 32 C 33 C 34 integer cret, fid, mdim, nse2, ntr3 35 character*32 maa 36 parameter (mdim = 2,nse2 = 5,maa = "maa1", ntr3 = 2) 37 integer se2 (2*nse2) 38 character*16 nomse2(nse2) 39 integer numse2(nse2),nufase2(nse2) 40 integer tr3 (3*ntr3) 41 character*16 nomtr3(ntr3) 42 integer numtr3(ntr3), nufatr3(ntr3) 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/ 47 data nomtr3 /"tr1","tr2"/,numtr3/4,5/,nufatr3/0,-1/ 48 49 C ** Creation du fichier test16.med ** 50 call efouvr(fid,'test16.med',MED_CREATION, cret) 51 print *,cret 52 53 C ** Creation du maillage ** 54 if (cret .eq. 0) then 55 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 56 C 'Un maillage pour test16',cret) 57 endif 58 print *,cret 59 60 C ** Ecriture des aretes segments MED_SEG2 : 61 C - Connectivite 62 C - Noms (optionnel) 63 C - Numeros (optionnel) 64 C - Numeros des familles ** 65 if (cret .eq. 0) then 66 call efelee(fid,maa,mdim,se2,MED_NO_INTERLACE, 67 C nomse2,MED_VRAI,numse2,MED_VRAI, 68 C nufase2,nse2,MED_ARETE,MED_SEG2,MED_DESC,cret) 69 endif 70 print *,cret 71 72 C ** Ecriture des mailles MED_TRIA3 : 73 C - Connectivite 74 C - Noms (optionnel) 75 C - Numeros (optionnel) 76 C - Numeros des familles ** 77 if (cret .eq. 0) then 78 call efelee(fid,maa,mdim,tr3,MED_NO_INTERLACE, 79 C nomtr3,MED_VRAI,numtr3,MED_VRAI, 80 C nufatr3,ntr3,MED_MAILLE,MED_TRIA3,MED_DESC,cret) 81 endif 82 print *,cret 83 84 C ** Fermeture du fichier ** 85 call efferm (fid,cret) 86 print *,cret 87 88 end 89