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 C ******************************************************************************* 20 C * - Nom du fichier : test23.f 21 C * 22 C * - Description : ecriture de mailles MED_POLYGONE dans un maillage MED 23 C * 24 C ****************************************************************************** 25 program test23 26 C 27 implicit none 28 include 'med.hf' 29 C 30 integer cret, fid,mdim 31 parameter (mdim = 3) 32 character*32 maa 33 integer ni, n 34 parameter (ni=4, n=3) 35 integer index(ni) 36 character*16 nom(n) 37 integer num(n),fam(n) 38 integer con(16) 39 C 40 data con / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 / 41 data nom / "poly1", "poly2", "poly3"/ 42 data num / 1,2,3 /, fam /0,-1,-2/ 43 data index /1,6,12,17/ 44 data maa /"maa1"/ 45 46 C ** Creation du fichier test23.med ** 47 call efouvr(fid,'test23.med',MED_LECTURE_ECRITURE, cret) 48 print *,cret 49 if (cret .ne. 0 ) then 50 print *,'Erreur creation du fichier' 51 call efexit(-1) 52 endif 53 print *,'Creation du fichier test23.med' 54 55 C ** Creation du maillage ** 56 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 57 & 'un maillage pour test23',cret) 58 print *,cret 59 if (cret .ne. 0 ) then 60 print *,'Erreur creation du maillage' 61 call efexit(-1) 62 endif 63 print *,'Creation du maillage' 64 65 C ** Ecriture de la connectivite des mailles polygones ** 66 call efpgce(fid,maa,index,ni,con,MED_MAILLE,MED_NOD,cret) 67 if (cret .ne. 0 ) then 68 print *,'Erreur ecriture des connectivite polygones' 69 call efexit(-1) 70 endif 71 print *,cret 72 print *,'Ecriture des connectivites des mailles de type 73 & MED_POLYGONE' 74 75 C ** Ecriture des noms des mailles polygones ** 76 call efnome(fid,maa,nom,n,MED_MAILLE,MED_POLYGONE, 77 & cret) 78 print *,cret 79 if (cret .ne. 0 ) then 80 print *,'Erreur ecriture des noms polygones' 81 call efexit(-1) 82 endif 83 print *,'Ecriture des noms des polygones' 84 85 C ** Ecriture des numeros des mailles polygones ** 86 call efnume(fid,maa,num,n,MED_MAILLE,MED_POLYGONE, 87 & cret) 88 if (cret .ne. 0 ) then 89 print *,'Erreur ecriture des numeros polygones' 90 call efexit(-1) 91 endif 92 print *,cret 93 print *,'Ecriture des numeros des polygones' 94 95 C ** Ecriture des numeros des familles des segments ** 96 call effame(fid,maa,fam,n, 97 & MED_MAILLE,MED_POLYGONE,cret) 98 if (cret .ne. 0 ) then 99 print *,'Erreur ecriture des numeros de famille polygones' 100 call efexit(-1) 101 endif 102 print *,cret 103 print *,'Ecriture des numeros de familles des polygones' 104 105 C ** Fermeture du fichier ** 106 call efferm (fid,cret) 107 print *,cret 108 if (cret .ne. 0 ) then 109 print *,'Erreur fermeture du fichier' 110 call efexit(-1) 111 endif 112 print *,'Fermeture du fichier' 113 C 114 end