# usecases/f/UsesCase_MEDfield_4.f

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2011  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