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 : test8.f 21 C * 22 C * - Description : exemple d'ecriture des familles d'un maillage MED 23 C * 24 C ***************************************************************************** 25 program test8 26 C 27 implicit none 28 include 'med.hf' 29 C 30 integer cret, fid 31 32 character*32 maa 33 integer mdim 34 character*32 nomfam 35 integer numfam 36 character*200 attdes 37 integer natt, attide, attval 38 integer ngro 39 character*80 gro 40 integer nfamn 41 character*16 str 42 43 parameter ( mdim = 2, nfamn = 2 ) 44 data maa /"maa1"/ 45 46 C ** Creation du fichier test8.med ** 47 call efouvr(fid,'test8.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 54 C ** Creation du maillage maa de dimension 2 ** 55 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 56 & 'un maillage pour test8',cret) 57 print *,cret 58 if (cret .ne. 0 ) then 59 print *,'Erreur creation du maillage' 60 call efexit(-1) 61 endif 62 63 C ** Ecriture des familles ** 64 C * Conventions : 65 C - Toujours creer une famille de numero 0 ne comportant aucun attribut 66 C ni groupe (famille de reference pour les noeuds ou les elements 67 C qui ne sont rattaches a aucun groupe ni attribut) 68 C - Les numeros de familles de noeuds sont > 0 69 C - Les numeros de familles des elements sont < 0 70 C - Rien d'imposer sur les noms de familles 71 C ** ** 72 73 C * Creation de la famille 0 ** 74 numfam = 0 75 nomfam="FAMILLE_0" 76 call effamc(fid,maa,nomfam,numfam,attide,attval,attdes, 77 & 0,gro,0,cret) 78 print *,cret 79 if (cret .ne. 0 ) then 80 print *,'Erreur creation de la famille 0' 81 call efexit(-1) 82 endif 83 84 C * Creation pour correspondre aux cas tests precedents, 3 familles * 85 C * d'elements (-1,-2,-3) et deux familles de noeuds (1,2) * 86 do numfam=-1,-3,-1 87 write(str,'(I1.0)') (-numfam) 88 nomfam = "FAMILLE_ELEMENT_"//str 89 attide = 1 90 attval = numfam*100 91 natt = 1 92 attdes="description attribut" 93 gro="groupe1" 94 ngro = 1 95 print *, nomfam," - ",numfam," - ",attide," - ", 96 & attval," - ",ngro 97 98 call effamc(fid,maa,nomfam,numfam,attide,attval,attdes, 99 & natt,gro,ngro,cret) 100 print *,cret 101 if (cret .ne. 0 ) then 102 print *,'Erreur creation de famille' 103 call efexit(-1) 104 endif 105 end do 106 107 do numfam=1,nfamn 108 write(str,'(I1.0)') numfam 109 nomfam = "FAMILLE_NOEUD_"//str 110 attide = 1 111 attval = numfam*100 112 natt = 1 113 attdes="description attribut" 114 gro="groupe1" 115 ngro = 1 116 print *, nomfam," - ",numfam," - ",attide," - ", 117 & attval," - ",ngro 118 call effamc(fid,maa,nomfam,numfam,attide,attval,attdes, 119 & natt,gro,ngro,cret) 120 print *,cret 121 if (cret .ne. 0 ) then 122 print *,'Erreur creation de famille' 123 call efexit(-1) 124 endif 125 end do 126 127 128 C * Fermeture du fichier * 129 call efferm (fid,cret) 130 print *,cret 131 if (cret .ne. 0 ) then 132 print *,'Erreur fermeture du fichier' 133 call efexit(-1) 134 endif 135 C 136 end 137 138 139 140 141 142