usecases/f/UsesCase_MEDmesh_9.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 *  How to create an unstructured mesh 
00020 C *
00021 C *  Use case 9 : 2D unstructured mesh with moving grid transformation 
00022 C *  
00023 C *
00024 C *****************************************************************************
00025       program UsesCase_MEDmesh_9
00026 C     
00027       implicit none
00028       include 'med.hf77'
00029 C
00030 C     
00031       integer cret
00032       integer fid
00033 C
00034       character (MED_NAME_SIZE) mname
00035       character (MED_NAME_SIZE) fname
00036       character (MED_COMMENT_SIZE) cmt1,mdesc
00037       integer sdim, mdim
00038 C     axis name
00039       character (MED_SNAME_SIZE) axname(2)
00040 C     unit name
00041       character (MED_SNAME_SIZE)  unname(2)
00042       real*8 inicoo(30)
00043       integer nnodes, ntria3, nquad4
00044 C     tria connectivity
00045       integer triacy(24)
00046 C     quad connectivity
00047       integer quadcy(16)
00048 C     transformation matrix step 1
00049       real*8 trama1(7)
00050 C     transformation matrix step 2
00051       real*8 trama2(7)
00052 
00053       parameter (fname = "UsesCase_MEDmesh_9.med")
00054       parameter (cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
00055       parameter (mdesc = "A 2D unstructured mesh")
00056       parameter (mname="2D unstructured mesh")
00057       parameter (sdim=2, mdim=2)
00058       parameter (nnodes=15,ntria3=8,nquad4=4)
00059 
00060       data axname /"x", "y"/
00061       data unname /"cm", "cm"/
00062       data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
00063      &             2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
00064      &             2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
00065       data triacy /1,7,6,   2,7,1,  3,7,2,   8,7,3,
00066      &             13,7,8, 12,7,13, 11,7,12, 6,7,11/
00067       data quadcy /3,4,9,8,    4,5,10,9,
00068      &             15,14,9,10, 13,8,9,14/ 
00069 C     transformation matrix (step 1) : rotation about the Y-axis : 45 degrees
00070       data trama1 /0.0, 0.0, 0.0, 0.92388, 0.0, 0.38268, 0.0/
00071 C     transformation matrix (step 2) : rotation about the Y-axis : 90 degrees
00072       data trama2 /0.0, 0.0, 0.0, 0.707,   0.0, 0.707,   0.0/
00073 C
00074 C     file creation
00075       call mfiope(fid,fname,MED_ACC_CREAT,cret)
00076       if (cret .ne. 0 ) then
00077          print *,"ERROR : file creation"
00078          call efexit(-1)
00079       endif
00080 C
00081 C     write a comment in the file
00082       call mficow(fid,cmt1,cret)
00083       if (cret .ne. 0 ) then
00084          print *,"ERROR : write file description"
00085          call efexit(-1)
00086       endif
00087 C
00088 C     mesh creation : a 2D unstructured mesh
00089       call mmhcre(fid, mname, sdim, mdim, MED_UNSTRUCTURED_MESH, mdesc,
00090      &           "", MED_SORT_DTIT, MED_CARTESIAN, axname, unname, cret)
00091       if (cret .ne. 0 ) then
00092          print *,"ERROR : mesh creation"
00093          call efexit(-1)
00094       endif
00095 C
00096 C
00097 C     initial nodes coordinates in a cartesian axis in full interlace mode 
00098 C     (X1,Y1, X2,Y2, X3,Y3, ...) with no iteration and computation step
00099       call mmhcpw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00100      &            MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00101      &            MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00102      &            nnodes, inicoo, cret)
00103       if (cret .ne. 0 ) then
00104          print *,"ERROR : nodes coordinates"
00105          call efexit(-1)
00106       endif
00107 C
00108 C
00109 C     cells connectivity is defined in nodal mode
00110       call mmhypw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00111      &            MED_CELL, MED_TRIA3, MED_NODAL,
00112      &            MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00113      &            MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00114      &            ntria3, triacy, cret)
00115       if (cret .ne. 0 ) then
00116          print *,"ERROR : triangular cells connectivity"
00117          call efexit(-1)
00118       endif
00119 C
00120 C
00121       call mmhypw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00122      &            MED_CELL, MED_QUAD4, MED_NODAL,
00123      &            MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00124      &            MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00125      &            nquad4, quadcy, cret)
00126       if (cret .ne. 0 ) then
00127          print *,"ERROR : quadrangular cells connectivity"
00128          call efexit(-1)
00129       endif
00130 C
00131 C
00132 C     Mesh deformation (nodes coordinates) in 2 steps 
00133 C     A rotation by step for each node
00134 C
00135 C     STEP 1 : dt1 = 5.5, it = 1
00136       call mmhtfw(fid, mname, 1, 1, 5.5D0, trama1, cret)
00137 C
00138 C
00139 C     STEP 2 : dt2 = 8.9, it = 1
00140       call mmhtfw(fid, mname, 2, 1, 8.9D0, trama2, cret)
00141 C
00142 C
00143 C     create family 0 : by default, all mesh entities family number is 0
00144       call mfacre(fid, mname,MED_NO_NAME, 0, 0, MED_NO_GROUP, cret)
00145       if (cret .ne. 0 ) then
00146          print *,"ERROR : create family 0"
00147          call efexit(-1)
00148       endif
00149 C
00150 C
00151 C     close file
00152       call mficlo(fid,cret)
00153       if (cret .ne. 0 ) then
00154          print *,"ERROR :  close file"
00155          call efexit(-1)
00156       endif        
00157 C
00158 C
00159       end
00160 C

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