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 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_CREATION, cret) 44 print *,cret 45 46 47 C ** Creation du maillage ** 48 if (cret .eq. 0) then 49 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 50 & 'Un maillage pour test12',cret) 51 endif 52 print *,cret 53 54 C ** Creation de l'equivalence ** 55 if (cret .eq. 0) then 56 call efequc(fid,maa,equ,des,cret) 57 endif 58 print *,cret 59 60 C ** Ecriture des correspondances sur les mailles MED_TRIA3 ** 61 if (cret .eq. 0) then 62 call efeque(fid,maa,equ,cor,ncor, 63 & MED_MAILLE,MED_TRIA3,cret) 64 endif 65 print *,cret 66 67 C ** Fermeture du fichier ** 68 call efferm (fid,cret) 69 print *,cret 70 71 end