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 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 i 62 integer ngeo 63 parameter (ngeo = 3) 64 integer geo(ngeo) 65 integer indgeo(ngeo+1) 66 character*200 attdes,gro 67 integer attval,attide 68 integer typgeo 69 integer indtmp 70 C 71 data nomgro / "GROUPE1","GROUPE2","GROUPE3" / 72 data ent / 1,2, 3,4,6, 1,4 / 73 data ind / 1, 3, 6, 8 / 74 data geo / MED_SEG2, MED_TRIA3, MED_TETRA4 / 75 data indgeo / 1,4,6,7 / 76 C 77 C ** Creation du fichier test19.med 78 call efouvr(fid,'test19.med',MED_CREATION, cret) 79 print *,cret 80 print *,'Creation du fichier test19.med' 81 C 82 C ** Creation du maillage 83 if (cret .eq. 0) then 84 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,des,cret) 85 print *,cret 86 print *,'Creation du maillage' 87 endif 88 C 89 C ** Creation de la famille 0 90 if (cret .eq. 0) then 91 call effamc(fid,maa,'FAMILLE_0',0,attide,attval,attdes,0,gro,0, 92 & cret) 93 print *,cret 94 print *,'Creation de la famille 0' 95 endif 96 C 97 C ** Creation des familles de noeuds 98 if (cret .eq. 0) then 99 call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_NOEUD, 100 & typgeo,indtmp,0,cret) 101 print *,cret 102 print *,'Creation des familles de noeuds dans test19.med' 103 endif 104 C 105 C ** Creation des familles de mailles 106 if (cret .eq. 0) then 107 call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_MAILLE, 108 & geo,indgeo,ngeo,cret) 109 print *,cret 110 print *,'Creation des familles de mailles dans test19.med' 111 endif 112 C 113 C ** Fermeture du fichier 114 call efferm (fid,cret) 115 print *,cret 116 print *,'Fermeture du fichier' 117 C 118 end