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 : test29.f 22 C * 23 C * - Description : ecriture d'un joint dans un maillage MED 24 C * 25 C ****************************************************************************** 26 program test29 27 C 28 implicit none 29 include 'med.hf' 30 C 31 C 32 integer cret,fid, domdst 33 character*32 maa , jnt, maadst 34 character*200 des 35 integer mdim ,ncor 36 integer cor(6) 37 38 parameter (maa ="maa1",maadst="maa1", domdst=2, 39 & mdim = 3,ncor = 3 ) 40 data cor /1,2,3,4,5,6/, jnt / "joint"/ 41 data des / "joint avec le sous-domaine 2" / 42 43 44 45 C ** Creation du fichier test29.med ** 46 call efouvr(fid,'test29.med',MED_LECTURE_ECRITURE, cret) 47 print *,cret 48 if (cret .ne. 0 ) then 49 print *,'Erreur creation du fichier' 50 call efexit(-1) 51 endif 52 53 54 C ** Creation du maillage ** 55 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 56 & 'Un maillage pour test29',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 ** Creation du joint ** 64 call efjntc(fid,maa,jnt,des,domdst,maadst,cret) 65 print *,cret 66 if (cret .ne. 0 ) then 67 print *,'Erreur creation joint' 68 call efexit(-1) 69 endif 70 71 72 C ** Ecriture de la correspondance Noeud, Noeud ** 73 call efjnte(fid,maa,jnt,cor,ncor, 74 & MED_NOEUD,0,MED_NOEUD,0, 75 & cret) 76 print *,cret 77 if (cret .ne. 0 ) then 78 print *,'Erreur ecriture correspondance (Noeud,Noeud)' 79 call efexit(-1) 80 endif 81 82 83 C ** Ecriture de la correspondance Noeud, TRIA3 ** 84 call efjnte(fid,maa,jnt,cor,ncor, 85 & MED_NOEUD,0,MED_MAILLE,MED_TRIA3, 86 & cret) 87 print *,cret 88 if (cret .ne. 0 ) then 89 print *,'Erreur ecriture correspondance (Noeud,Tria3)' 90 call efexit(-1) 91 endif 92 93 C ** Fermeture du fichier ** 94 call efferm (fid,cret) 95 print *,cret 96 if (cret .ne. 0 ) then 97 print *,'Erreur fermeture du fichier' 98 call efexit(-1) 99 endif 100 C 101 end