UsesCase_MEDmesh_6.f

Aller à la documentation de ce fichier.
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 6 : a 2D unstructured mesh with the following features 
00022 C *  computing steps, profiles and nodes coordinates evolution.
00023 C *
00024 C *****************************************************************************
00025       program UsesCase_MEDmesh_6
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     new_coordinates_step1
00049       real*8 nwcos1(6)
00050 C     profile1name
00051       character (MED_NAME_SIZE) prof1n
00052 C     profile1
00053       integer profi1(3)
00054 C     profile1size
00055       integer pro1sz
00056 C     new_coordinates_step2
00057       real*8 nwcos2(6)
00058 C     profile2name
00059       character (MED_NAME_SIZE) prof2n
00060 C     profile2
00061       integer profi2(3)
00062 C     profile2size
00063       integer pro2sz
00064 
00065       parameter (fname = "UsesCase_MEDmesh_6.med")
00066       parameter (cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
00067       parameter (mdesc = "A 2D unstructured mesh")
00068       parameter (mname="2D unstructured mesh")
00069       parameter (sdim=2, mdim=2)
00070       parameter (nnodes=15,ntria3=8,nquad4=4)
00071 
00072       data axname /"x", "y"/
00073       data unname /"cm", "cm"/
00074       data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
00075      &             2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
00076      &             2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
00077       data triacy /1,7,6,   2,7,1,  3,7,2,   8,7,3,
00078      &             13,7,8, 12,7,13, 11,7,12, 6,7,11/
00079       data quadcy /3,4,9,8,    4,5,10,9,
00080      &             15,14,9,10, 13,8,9,14/ 
00081 
00082 C    new coordinates (step 1) for nodes 13, 14 and 15
00083       data nwcos1 /12.,15., 17.,15., 22.,15./
00084       parameter (prof1n="UPPER_QUAD4_PROFILE")
00085       data profi1 /13, 14, 15/
00086       parameter (pro1sz=3)
00087 
00088 C    new coordinates (step 2) for nodes 8, 9 and 10
00089       data nwcos2 /12.,10., 17.,10., 22.,10./
00090       parameter (prof2n="MIDDLE_QUAD4_PROFILE")
00091       data profi2 /8, 9, 10/
00092       parameter (pro2sz=3)
00093 C
00094 C     file creation
00095       call mfiope(fid,fname,MED_ACC_CREAT,cret)
00096       if (cret .ne. 0 ) then
00097          print *,"ERROR : file creation"
00098          call efexit(-1)
00099       endif
00100 C
00101 C     write a comment in the file
00102       call mficow(fid,cmt1,cret)
00103       if (cret .ne. 0 ) then
00104          print *,"ERROR : write file description"
00105          call efexit(-1)
00106       endif
00107 C
00108 C     create the profiles in the file
00109       call mpfprw(fid,prof1n,pro1sz,profi1,cret)
00110       if (cret .ne. 0 ) then
00111          print *,"ERROR : create profile"
00112          call efexit(-1)
00113       endif
00114 C
00115 C     create the profiles in the file
00116       call mpfprw(fid,prof2n,pro2sz,profi2,cret)
00117       if (cret .ne. 0 ) then
00118          print *,"ERROR : create profile"
00119          call efexit(-1)
00120       endif
00121 C
00122 C     mesh creation : a 2D unstructured mesh
00123       call mmhcre(fid, mname, sdim, mdim, MED_UNSTRUCTURED_MESH, mdesc,
00124      &           "", MED_SORT_DTIT, MED_CARTESIAN, axname, unname, cret)
00125       if (cret .ne. 0 ) then
00126          print *,"ERROR : mesh creation"
00127          call efexit(-1)
00128       endif
00129 C
00130 C
00131 C     initial nodes coordinates in a cartesian axis in full interlace mode 
00132 C     (X1,Y1, X2,Y2, X3,Y3, ...)
00133       call mmhcpw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00134      &            MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00135      &            MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00136      &            nnodes, inicoo, cret)
00137       if (cret .ne. 0 ) then
00138          print *,"ERROR : nodes coordinates"
00139          call efexit(-1)
00140       endif
00141 C
00142 C
00143 C     cells connectivity is defined in nodal mode
00144       call mmhypw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00145      &            MED_CELL, MED_TRIA3, MED_NODAL,
00146      &            MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00147      &            MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00148      &            ntria3, triacy, cret)
00149       if (cret .ne. 0 ) then
00150          print *,"ERROR : triangular cells connectivity"
00151          call efexit(-1)
00152       endif
00153 C
00154 C
00155       call mmhypw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00156      &            MED_CELL, MED_QUAD4, MED_NODAL,
00157      &            MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00158      &            MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00159      &            nquad4, quadcy, cret)
00160       if (cret .ne. 0 ) then
00161          print *,"ERROR : quadrangular cells connectivity"
00162          call efexit(-1)
00163       endif
00164 C
00165 C
00166 C     Mesh deformation (nodes coordinates) in 2 steps 
00167 C     The nodes modified are identified by a profile 
00168 C
00169 C     STEP 1 : dt1 = 5.5, it = 1
00170       call mmhcpw(fid, mname, 1, 1, 5.5D0,
00171      &            MED_COMPACT_PFLMODE, prof1n,
00172      &            MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00173      &            nnodes, nwcos1, cret)
00174       if (cret .ne. 0 ) then
00175          print *,"ERROR : nodes coordinates"
00176          call efexit(-1)
00177       endif
00178 C
00179 C
00180 C     STEP 2 : dt2 = 8.9, it = 1
00181       call mmhcpw(fid, mname, 2, 1, 8.9D0,
00182      &            MED_COMPACT_PFLMODE, prof2n,
00183      &            MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00184      &            nnodes, nwcos2, cret)
00185       if (cret .ne. 0 ) then
00186          print *,"ERROR : nodes coordinates"
00187          call efexit(-1)
00188       endif
00189 C
00190 C
00191 C     create family 0 : by default, all mesh entities family number is 0
00192       call mfacre(fid, mname,MED_NO_NAME, 0, 0, MED_NO_GROUP, cret)
00193       if (cret .ne. 0 ) then
00194          print *,"ERROR : create family 0"
00195          call efexit(-1)
00196       endif
00197 C
00198 C
00199 C     close file
00200       call mficlo(fid,cret)
00201       if (cret .ne. 0 ) then
00202          print *,"ERROR :  close file"
00203          call efexit(-1)
00204       endif        
00205 C
00206 C
00207       end
00208 C

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