f/test6.f

00001 C*  This file is part of MED.
00002 C*
00003 C*  COPYRIGHT (C) 1999 - 2015  EDF R&D, CEA/DEN
00004 C*  MED is free software: you can redistribute it and/or modify
00005 C*  it under the terms of the GNU Lesser General Public License as published by
00006 C*  the Free Software Foundation, either version 3 of the License, or
00007 C*  (at your option) any later version.
00008 C*
00009 C*  MED is distributed in the hope that it will be useful,
00010 C*  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 C*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012 C*  GNU Lesser General Public License for more details.
00013 C*
00014 C*  You should have received a copy of the GNU Lesser General Public License
00015 C*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
00016 C*
00017 
00018 C       *******************************************************************************
00019 C       * - Nom du fichier : test6.f
00020 C       *
00021 C       * - Description : exemples d'ecriture d'elements dans un maillage MED
00022 C       *
00023 C       ******************************************************************************
00024         program test6
00025 C       
00026         implicit none
00027         include 'med.hf'
00028 C
00029 C       
00030         integer cret, fid
00031         
00032         integer     mdim,nse2,ntr3,sdim
00033         parameter  (nse2=5, ntr3=2, mdim=2, sdim=2)
00034         integer     se2 (2*nse2)
00035         character*16 nomse2(nse2)
00036         integer     numse2(nse2),nufase2(nse2)
00037 
00038         character*16 nomcoo(2)
00039         character*16 unicoo(2)
00040 
00041 
00042         integer     tr3 (3*ntr3)
00043         character*16 nomtr3(ntr3)
00044         integer     numtr3(ntr3), nufatr3(ntr3) 
00045         character*64 maa 
00046         real*8 dt
00047         parameter (dt = 0.0)
00048     
00049         data  nomcoo /"x","y"/, unicoo /"cm","cm"/
00050         data se2     / 1,2,1,3,2,4,3,4,2,3 /    
00051         data nomse2  /"se1","se2","se3","se4","se5" / 
00052         data numse2  / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/
00053         data tr3     /1,2,-5,-5,3,-4 /, nomtr3 /"tr1","tr2"/,
00054      &                                  numtr3 /4,5/
00055         data nufatr3 /0,-1/,  maa /"maa1"/
00056 
00057 C       ** Ouverture du fichier   
00058         call mfiope(fid,'test6.med',MED_ACC_RDWR, cret) 
00059         print *,cret
00060         if (cret .ne. 0 ) then
00061            print *,'Erreur creation du fichier'
00062            call efexit(-1)
00063         endif      
00064 
00065 C       ** Creation du maillage maa de dimension 2         **
00066         call mmhcre(fid,maa,mdim,sdim,
00067      &     MED_UNSTRUCTURED_MESH,'un maillage pour test6', 
00068      &     "",MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,cret)
00069         print *,cret
00070         if (cret .ne. 0 ) then
00071            print *,'Erreur creation du maillage'
00072            call efexit(-1)
00073         endif      
00074 
00075 C       ** Ecriture des connectivites des segments         **
00076         call mmhcyw(fid,maa,MED_NO_DT,MED_NO_IT,dt,
00077      &              MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING,
00078      &              MED_NO_INTERLACE,nse2,se2,cret)
00079         print *,cret
00080         if (cret .ne. 0 ) then
00081            print *,'Erreur ecriture de la connectivite'
00082            call efexit(-1)
00083         endif      
00084 
00085 C       ** Ecriture (optionnelle) des noms des segments    **
00086         call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00087      &              MED_SEG2,nse2,nomse2,cret)
00088         print *,cret
00089         if (cret .ne. 0 ) then
00090            print *,'Erreur ecriture des noms'
00091            call efexit(-1)
00092         endif      
00093 
00094 C       ** Ecriture (optionnelle) des numeros des segments **
00095         call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00096      &              MED_SEG2,nse2,numse2,cret)
00097         print *,cret
00098         if (cret .ne. 0 ) then
00099            print *,'Erreur ecriture des numeros'
00100            call efexit(-1)
00101         endif      
00102 
00103 C       ** Ecriture des numeros des familles des segments  **
00104         call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00105      &              MED_SEG2,nse2,nufase2,cret)     
00106         print *,cret
00107         if (cret .ne. 0 ) then
00108            print *,'Erreur ecriture des numéros de famille'
00109            call efexit(-1)
00110         endif      
00111 
00112 C       ** Ecriture des connectivites des triangles        **
00113         call mmhcyw(fid,maa,MED_NO_DT,MED_NO_IT,dt,
00114      &              MED_CELL,MED_TRIA3,MED_DESCENDING,
00115      &              MED_NO_INTERLACE,ntr3,tr3,cret)
00116         print *,cret
00117         if (cret .ne. 0 ) then
00118            print *,'Erreur ecriture de la connectivite'
00119            call efexit(-1)
00120         endif      
00121 
00122 C       ** Ecriture (optionnelle) des noms des triangles   **
00123         call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00124      &              MED_TRIA3,ntr3,nomtr3,cret)
00125         print *,cret
00126         if (cret .ne. 0 ) then
00127            print *,'Erreur ecriture des noms'
00128            call efexit(-1)
00129         endif      
00130 
00131 C       ** Ecriture (optionnelle) des numeros des triangles **
00132         call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00133      &              MED_TRIA3,ntr3,numtr3,cret)
00134         print *,cret
00135         if (cret .ne. 0 ) then
00136            print *,'Erreur ecriture des numeros'
00137            call efexit(-1)
00138         endif      
00139 
00140 C      ** Ecriture des numeros des familles des triangles  **
00141         call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00142      &              MED_TRIA3,ntr3,nufatr3,cret)          
00143         print *,cret
00144         if (cret .ne. 0 ) then
00145            print *,'Erreur ecriture des numeros de famille'
00146            call efexit(-1)
00147         endif      
00148 
00149 C       ** Fermeture du fichier   **
00150         call mficlo(fid,cret)
00151         print *,cret
00152         if (cret .ne. 0 ) then
00153            print *,'Erreur a la fermeture du fichier'
00154            call efexit(-1)
00155         endif      
00156 C
00157         end

Généré le Thu Oct 8 14:26:16 2015 pour MED fichier par  doxygen 1.6.1