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 : test2.f 21 C * 22 C * - Description : exemples de creations de maillage MED 23 C * 24 C ****************************************************************************** 25 program test2 26 C 27 implicit none 28 include 'med.hf' 29 C 30 C 31 32 integer cret,ret 33 integer fid 34 character*200 des 35 36 C ** verifie que le fichier test1.med est utilisable par MED2.2 ** 37 call effoco('test1.med',cret) 38 print *,cret 39 40 C ** Ouverture en mode de lecture du fichier test1.med 41 if (cret .eq. 0) then 42 call efouvr(fid,'test1.med',MED_LECTURE, cret) 43 endif 44 print *,cret 45 46 C ** Lecture de l'en-tete du fichier 47 if (cret .eq. 0) then 48 call effien (fid, MED_FICH_DES,des,cret) 49 endif 50 if (cret .eq. 0) then 51 print *,"DESCRIPTEUR DE FICHIER : ",des 52 endif 53 print *,cret 54 55 56 C ** Fermeture du fichier test1.med 57 call efferm (fid,cret) 58 print *,cret 59 60 61 C ** Ouverture en mode de creation du fichier test2.med 62 if (cret .eq. 0) then 63 call efouvr(fid,'test2.med',MED_CREATION, cret) 64 print *,cret 65 endif 66 67 C ** Creation du maillage maa1 de type MED_NON_STRUCTURE 68 C ** et de dimension 3 69 if (cret .eq. 0) then 70 call efmaac(fid,'maa1',3, 71 & MED_NON_STRUCTURE, 72 & 'un premier maillage',ret) 73 cret = cret + ret 74 C ** Creation du nom universel 75 call efunvc(fid,'maa1',ret) 76 cret = cret + ret 77 endif 78 print *,cret 79 80 C ** Creation du maillage maa2 de type MED_NON_STRUCTURE 81 C ** et de dimension 2 82 if (cret .eq. 0) then 83 call efmaac(fid,'maa2',2, 84 & MED_NON_STRUCTURE, 85 & 'un second maillage',ret) 86 cret = cret + ret 87 C ** Ecriture de la dimension de l'espace : maillage 88 C ** de dimension 2 dans un espace de dimension 3 89 call efespc(fid,'maa2',3,ret) 90 cret = cret + ret 91 endif 92 print *,cret 93 94 C ** Creation du maillage maa3 de type MED_STRUCTURE 95 C ** et de dimension 1 96 if (cret .eq. 0) then 97 call efmaac(fid,'maa3',1, 98 & MED_STRUCTURE, 99 & 'un troisieme maillage',ret) 100 cret = cret + ret 101 endif 102 print *,cret 103 104 C ** Fermeture du fichier 105 call efferm (fid,cret) 106 print *,cret 107 108 end 109 110 111 112 113