UsesCase_MEDfield_4.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 *
00020 C * Field use case 4 : write a field with computing steps
00021 C *
00022 C *****************************************************************************
00023       program UsesCase_MEDfield_4
00024 C     
00025       implicit none
00026       include 'med.hf77'
00027 C
00028 C     
00029       integer cret
00030       integer fid
00031 C     component number, node number
00032       integer ncompo
00033 C     triangular elements number, quadrangular elements number
00034       integer ntria3, nquad4
00035 C     med file name,  link file name
00036       character*64  fname, lfname
00037 C     mesh name, field name, component name, commponent unit
00038       character*64  mname, finame, cpname, cpunit
00039       character*16 dtunit
00040       real*8 dt
00041       integer ndt, nit
00042 C     mesh num dt, mesh num it
00043       integer mnumdt, mnumit
00044 C
00045       real*8 t3vs1(8)
00046       real*8 t3vs2(8)
00047       real*8 q4vs1(4)
00048       real*8 q4vs2(4)
00049 C
00050       parameter (fname = "UsesCase_MEDfield_4.med")
00051       parameter (lfname = "./UsesCase_MEDmesh_1.med")
00052       parameter (mname = "2D unstructured mesh")
00053       parameter (finame = "TEMPERATURE_FIELD")
00054       parameter (cpname ="TEMPERATURE", cpunit = "C")
00055       parameter (dtunit = "ms")
00056       parameter (ncompo = 1 )
00057       parameter (ntria3 =  8, nquad4 = 4)
00058 
00059       data t3vs1 / 1000., 2000., 3000., 4000., 
00060      &             5000., 6000., 7000., 8000. /
00061       data q4vs1 / 10000., 20000., 30000., 4000. /
00062       data t3vs2 / 1500., 2500., 3500., 4500., 
00063      &             5500., 6500., 7500., 8500. /
00064       data q4vs2 / 15000., 25000., 35000., 45000. /
00065 C 
00066 C
00067 C     file creation
00068       call mfiope(fid,fname,MED_ACC_CREAT,cret)
00069       if (cret .ne. 0 ) then
00070          print *,'ERROR : file creation'
00071          call efexit(-1)
00072       endif  
00073 C
00074 C
00075 C     create mesh link
00076       call mlnliw(fid,mname,lfname,cret)
00077       if (cret .ne. 0 ) then
00078          print *,'ERROR : create mesh link ...'
00079          call efexit(-1)
00080       endif
00081 C
00082 C
00083 C     field creation : temperature field  : 1 component in celsius degree
00084 C                      the mesh is the 2D unstructured mesh of
00085 C                      UsecaseMEDmesh_1.f use case. Computation step unit in 'ms'
00086       call mfdcre(fid,finame,MED_FLOAT64,ncompo,cpname,cpunit,dtunit,
00087      &            mname,cret)
00088       if (cret .ne. 0 ) then
00089          print *,'ERROR : create field ...'
00090          call efexit(-1)
00091       endif
00092 C
00093 C
00094 C     two computation steps :
00095 C      - first  on meshname MED_NO_DT,MED_NO_IT mesh computation step
00096 C      - second on meshname 1,3 mesh computation step
00097 C     write values at cell centers : 8 MED_TRIA3 and 4 MED_QUAD4
00098 C
00099 C
00100 C     STEP 1 : dt1 = 5.5, it = 1
00101 C
00102 C
00103 C     MED_TRIA3
00104       dt = 5.5d0
00105       ndt = 1
00106       nit = 1
00107       call mfdrvw(fid,finame,ndt,nit,dt,MED_CELL,MED_TRIA3,
00108      &            MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00109      &            ntria3,t3vs1,cret)
00110       if (cret .ne. 0 ) then
00111          print *,'ERROR : write field values on MED_TRIA3'
00112          call efexit(-1)
00113       endif
00114 C
00115 C
00116 C     MED_QUAD4
00117       call mfdrvw(fid,finame,ndt,nit,dt,MED_CELL,MED_QUAD4,
00118      &            MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00119      &            nquad4,q4vs1,cret)
00120       if (cret .ne. 0 ) then
00121          print *,'ERROR : write field values on MED_TRIA3'
00122          call efexit(-1)
00123       endif
00124 C
00125 C
00126 C     STEP 2 : dt2 = 8.9, it = 1
00127 C
00128 C     MED_TRIA3
00129       dt = 8.9d0
00130       ndt = 2
00131       nit = 1
00132       call mfdrvw(fid,finame,ndt,nit,dt,MED_CELL,MED_TRIA3,
00133      &            MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00134      &            ntria3,t3vs2,cret)
00135       if (cret .ne. 0 ) then
00136          print *,'ERROR : write field values on MED_TRIA3'
00137          call efexit(-1)
00138       endif
00139 C
00140 C
00141 C     MED_QUAD4
00142       call mfdrvw(fid,finame,ndt,nit,dt,MED_CELL,MED_QUAD4,
00143      &            MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00144      &            nquad4,q4vs2,cret)
00145       if (cret .ne. 0 ) then
00146          print *,'ERROR : write field values on MED_TRIA3'
00147          call efexit(-1)
00148       endif
00149 C
00150 C
00151 C     Write associated mesh computation step
00152       mnumdt = 1
00153       mnumit = 3
00154       call mfdcmw(fid,finame,ndt,nit,mnumdt,mnumit,cret)
00155       if (cret .ne. 0 ) then
00156          print *,'ERROR : write field mesh computation step error '
00157          call efexit(-1)
00158       endif
00159 C
00160 C
00161 C     close file
00162       call mficlo(fid,cret)
00163       if (cret .ne. 0 ) then
00164          print *,'ERROR :  close file'
00165          call efexit(-1)
00166       endif        
00167 C
00168 C
00169 C
00170       end
00171 C

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