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 : test19.f 21 C * 22 C * - Description : conversion groupes => familles 23 C * 24 C ***************************************************************************** 25 program test19 26 C 27 implicit none 28 include 'med.hf' 29 C 30 C 31 integer cret 32 integer fid 33 character *32 maa 34 parameter (maa = "maillage_test19") 35 character*200 des 36 parameter (des = "un maillage pour test19") 37 integer mdim 38 parameter (mdim = 2) 39 C Donnees de tests pour MEDgro2FamCr() 40 C Les noeuds/mailles sont numerotes de 1 a 5 et les 41 C groupes de 1 a 3. 42 C Au depart, on a : 43 C - G1 : 1,2 44 C - G2 : 3,4,6 45 C - G3 : 1,4 46 C Au retour, on foit avoir 4 familles de noeuds + 4 familles de mailles 47 C + la famille 0 dans le fichier : 48 C - F0 : 5 - groupes : aucun groupe par defaut (convention habituelle). 49 C - F1 : 1 - groupes : G1,G3 50 C - F2 : 2 - groupes : G1 51 C - F3 : 3,6 - groupes : G2 52 C - F4 : 4 - groupes : G2,G3 53 C 54 integer ngroup 55 parameter (ngroup = 3) 56 integer nent 57 parameter (nent = 6) 58 character*80 nomgro(ngroup) 59 integer ent(7) 60 integer ind(ngroup+1) 61 integer ngeo 62 parameter (ngeo = 3) 63 integer geo(ngeo) 64 integer indgeo(ngeo+1) 65 character*200 attdes,gro 66 integer attval,attide 67 integer typgeo 68 integer indtmp 69 C 70 data nomgro / "GROUPE1","GROUPE2","GROUPE3" / 71 data ent / 1,2, 3,4,6, 1,4 / 72 data ind / 1, 3, 6, 8 / 73 data geo / MED_SEG2, MED_TRIA3, MED_TETRA4 / 74 data indgeo / 1,4,6,7 / 75 C 76 C ** Creation du fichier test19.med 77 call efouvr(fid,'test19.med',MED_LECTURE_ECRITURE, cret) 78 print *,cret 79 if (cret .ne. 0 ) then 80 print *,'Erreur creation du fichier' 81 call efexit(-1) 82 endif 83 print *,'Creation du fichier test19.med' 84 C 85 C ** Creation du maillage 86 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,des,cret) 87 print *,cret 88 if (cret .ne. 0 ) then 89 print *,'Erreur creation du maillage' 90 call efexit(-1) 91 endif 92 print *,'Creation du maillage' 93 C 94 C ** Creation de la famille 0 95 call effamc(fid,maa,'FAMILLE_0',0,attide,attval,attdes,0,gro,0, 96 & cret) 97 print *,cret 98 if (cret .ne. 0 ) then 99 print *,'Erreur creation de la famille 0' 100 call efexit(-1) 101 endif 102 print *,'Creation de la famille 0' 103 C 104 C ** Creation des familles de noeuds 105 call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_NOEUD, 106 & typgeo,indtmp,0,cret) 107 print *,cret 108 if (cret .ne. 0 ) then 109 print *,'Erreur creation des familles de noeud' 110 call efexit(-1) 111 endif 112 print *,'Creation des familles de noeuds dans test19.med' 113 C 114 C ** Creation des familles de mailles 115 call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_MAILLE, 116 & geo,indgeo,ngeo,cret) 117 print *,cret 118 if (cret .ne. 0 ) then 119 print *,'Erreur creation des familles de maille' 120 call efexit(-1) 121 endif 122 print *,'Creation des familles de mailles dans test19.med' 123 C 124 C ** Fermeture du fichier 125 call efferm (fid,cret) 126 print *,cret 127 if (cret .ne. 0 ) then 128 print *,'Erreur fermeture du fichier' 129 call efexit(-1) 130 endif 131 print *,'Fermeture du fichier' 132 C 133 end