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 : test12.f 22 C * 23 C * - Description : ecriture d'une equivalence dans un maillage MED 24 C * 25 C ****************************************************************************** 26 program test12 27 C 28 implicit none 29 include 'med.hf' 30 C 31 C 32 integer cret,fid 33 character*32 maa , equ 34 character*200 des 35 integer mdim ,ncor 36 integer cor(6) 37 38 parameter (maa ="maa1",mdim = 3,ncor = 3 ) 39 data cor /1,2,3,4,5,6/, equ / "equivalence"/ 40 data des / "equivalence sur les mailles MED_TRIA3" / 41 42 C ** Creation du fichier test12.med ** 43 call efouvr(fid,'test12.med',MED_LECTURE_ECRITURE, cret) 44 print *,cret 45 if (cret .ne. 0 ) then 46 print *,'Erreur creation du fichier' 47 call efexit(-1) 48 endif 49 50 51 C ** Creation du maillage ** 52 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 53 & 'Un maillage pour test12',cret) 54 print *,cret 55 if (cret .ne. 0 ) then 56 print *,'Erreur creation du maillage' 57 call efexit(-1) 58 endif 59 60 C ** Creation de l'equivalence ** 61 call efequc(fid,maa,equ,des,cret) 62 print *,cret 63 if (cret .ne. 0 ) then 64 print *,'Erreur creation equivalence' 65 call efexit(-1) 66 endif 67 68 C ** Ecriture des correspondances sur les mailles MED_TRIA3 ** 69 call efeque(fid,maa,equ,cor,ncor, 70 & MED_MAILLE,MED_TRIA3,cret) 71 print *,cret 72 if (cret .ne. 0 ) then 73 print *,'Erreur ecriture de correspondances' 74 call efexit(-1) 75 endif 76 77 C ** Fermeture du fichier ** 78 call efferm (fid,cret) 79 print *,cret 80 if (cret .ne. 0 ) then 81 print *,'Erreur fermeture du fichier' 82 call efexit(-1) 83 endif 84 C 85 end