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 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 integer cret,ret 32 integer fid 33 character*200 des 34 35 C ** verifie que le fichier test1.med est au bon format ** 36 call effoco('test1.med',cret) 37 print *,cret 38 if (cret .ne. 0 ) then 39 print *,'Erreur ŕ la vérification du format' 40 call efexit(-1) 41 endif 42 43 C ** Ouverture en mode de lecture du fichier test1.med 44 call efouvr(fid,'test1.med',MED_LECTURE, cret) 45 print *,cret 46 if (cret .ne. 0 ) then 47 print *,'Erreur ouverture du fichier en lecture' 48 call efexit(-1) 49 endif 50 51 C ** Lecture de l'en-tete du fichier 52 call effien (fid, MED_FICH_DES,des,cret) 53 print *,cret 54 if (cret .ne. 0 ) then 55 print *,'Erreur lecture en-tete du fichier' 56 call efexit(-1) 57 endif 58 print *,"DESCRIPTEUR DE FICHIER : ",des 59 60 61 C ** Fermeture du fichier test1.med 62 call efferm (fid,cret) 63 print *,cret 64 if (cret .ne. 0 ) then 65 print *,'Erreur fermeture du fichier' 66 call efexit(-1) 67 endif 68 69 70 C ** Ouverture en mode de creation du fichier test2.med 71 call efouvr(fid,'test2.med',MED_LECTURE_ECRITURE, cret) 72 print *,cret 73 if (cret .ne. 0 ) then 74 print *,'Erreur creation du fichier' 75 call efexit(-1) 76 endif 77 78 C ** Creation du maillage maa1 de type MED_NON_STRUCTURE 79 C ** et de dimension 3 80 call efmaac(fid,'maa1',3, 81 & MED_NON_STRUCTURE, 82 & 'un premier maillage',ret) 83 cret = cret + ret 84 C ** Creation du nom universel 85 call efunvc(fid,'maa1',ret) 86 cret = cret + ret 87 print *,cret 88 if (cret .ne. 0 ) then 89 print *,'Erreur creation du maillage' 90 call efexit(-1) 91 endif 92 93 C ** Creation du maillage maa2 de type MED_NON_STRUCTURE 94 C ** et de dimension 2 95 call efmaac(fid,'maa2',2, 96 & MED_NON_STRUCTURE, 97 & 'un second maillage',ret) 98 cret = cret + ret 99 C ** Ecriture de la dimension de l'espace : maillage 100 C ** de dimension 2 dans un espace de dimension 3 101 call efespc(fid,'maa2',3,ret) 102 cret = cret + ret 103 print *,cret 104 if (cret .ne. 0 ) then 105 print *,'Erreur creation du maillage' 106 call efexit(-1) 107 endif 108 109 C ** Creation du maillage maa3 de type MED_STRUCTURE 110 C ** et de dimension 1 111 call efmaac(fid,'maa3',1, 112 & MED_STRUCTURE, 113 & 'un troisieme maillage',ret) 114 cret = cret + ret 115 print *,cret 116 if (cret .ne. 0 ) then 117 print *,'Erreur creation du maillage' 118 call efexit(-1) 119 endif 120 121 C ** Fermeture du fichier 122 call efferm (fid,cret) 123 print *,cret 124 if (cret .ne. 0 ) then 125 print *,'Erreur fermeture du fichier' 126 call efexit(-1) 127 endif 128 C 129 end 130 131 132 133 134