1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2007 EDF R&D, CEA/DEN 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_LECTURE_ECRITURE, cret) 51 print *,cret 52 if (cret .ne. 0 ) then 53 print *,'Erreur creation du fichier' 54 call efexit(-1) 55 endif 56 57 C ** Creation du maillage ** 58 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 59 C 'Un maillage pour test16',cret) 60 print *,cret 61 if (cret .ne. 0 ) then 62 print *,'Erreur creation du maillage' 63 call efexit(-1) 64 endif 65 66 C ** Ecriture des aretes segments MED_SEG2 : 67 C - Connectivite 68 C - Noms (optionnel) 69 C - Numeros (optionnel) 70 C - Numeros des familles ** 71 call efelee(fid,maa,mdim,se2,MED_NO_INTERLACE, 72 C nomse2,MED_VRAI,numse2,MED_VRAI, 73 C nufase2,nse2,MED_ARETE,MED_SEG2,MED_DESC,cret) 74 print *,cret 75 if (cret .ne. 0 ) then 76 print *,'Erreur des elements' 77 call efexit(-1) 78 endif 79 80 C ** Ecriture des mailles MED_TRIA3 : 81 C - Connectivite 82 C - Noms (optionnel) 83 C - Numeros (optionnel) 84 C - Numeros des familles ** 85 call efelee(fid,maa,mdim,tr3,MED_NO_INTERLACE, 86 C nomtr3,MED_VRAI,numtr3,MED_VRAI, 87 C nufatr3,ntr3,MED_MAILLE,MED_TRIA3,MED_DESC,cret) 88 print *,cret 89 if (cret .ne. 0 ) then 90 print *,'Erreur ecriture des elements' 91 call efexit(-1) 92 endif 93 94 C ** Fermeture du fichier ** 95 call efferm (fid,cret) 96 print *,cret 97 if (cret .ne. 0 ) then 98 print *,'Erreur fermeture du fichier' 99 call efexit(-1) 100 endif 101 C 102 end 103