# Unittest_MEDstructElement_10.f

Aller à la documentation de ce fichier.

    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 * Tests for struct element module
    00020 C *
    00021 C *****************************************************************************
    00022       program MEDstructElement10
    00023 C
    00024       implicit none
    00025       include 'med.hf'
    00026 C
    00027 C
    00028       integer cret
    00029       integer fid
    00030       character*64  fname
    00031       parameter (fname = "Unittest_MEDstructElement_9.med")
    00032       character*64  mname2
    00033       parameter (mname2 = "model name 2")
    00034       integer mtype2
    00035       character*64 aname1, aname2, aname3
    00036       parameter (aname1="integer attribute name")
    00037       parameter (aname2="real attribute name")
    00038       parameter (aname3="string attribute name")
    00039       integer atype1,atype2,atype3
    00040       parameter (atype1=MED_ATT_INT)
    00041       parameter (atype2=MED_ATT_FLOAT64)
    00042       parameter (atype3=MED_ATT_NAME)
    00043       integer anc1,anc2,anc3
    00044       parameter (anc1=2)
    00045       parameter (anc2=1)
    00046       parameter (anc3=2)
    00047       integer aval1(2)
    00048       data aval1 /1,2/
    00049       real*8 aval2(1)
    00050       data aval2 /1./
    00051       character*64 aval3(2)
    00052       data aval3 /"VAL1","VAL2"/
    00053       character*64 pname,cname
    00054       parameter (cname="computation mesh")
    00055       integer nentity
    00056       parameter (nentity=1)
    00057 c
    00058       integer atype,anc
    00059       integer rval1(2)
    00060       real*8 rval2(1)
    00061       character*64 rval3(2)
    00062 C
    00063 C
    00064 C     open file
    00065       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
    00066       print *,'Open file',cret
    00067       if (cret .ne. 0 ) then
    00068          print *,'ERROR : file creation'
    00069          call efexit(-1)
    00070       endif
    00071 C
    00072 C     informations about attributes
    00073 C
    00074       call msevni(fid,mname2,aname1,atype,anc,cret)
    00075       print *,'Read information about attribute',aname1, cret
    00076       if (cret .ne. 0) then
    00077          print *,'ERROR : attribute infromation'
    00078          call efexit(-1)
    00079       endif
    00080       if ( (atype .ne. atype1) .or.
    00081      &     (anc .ne. anc1)
    00082      &   ) then
    00083          print *,'ERROR : attribute information'
    00084          call efexit(-1)
    00085       endif
    00086 c
    00087       call msevni(fid,mname2,aname2,atype,anc,cret)
    00088       print *,'Read information about attribute',aname2, cret
    00089       if (cret .ne. 0) then
    00090          print *,'ERROR : attribute infromation'
    00091          call efexit(-1)
    00092       endif
    00093       if ( (atype .ne. atype2) .or.
    00094      &     (anc .ne. anc2)
    00095      &   ) then
    00096          print *,'ERROR : attribute information'
    00097          call efexit(-1)
    00098       endif
    00099 c
    00100       call msevni(fid,mname2,aname3,atype,anc,cret)
    00101       print *,'Read information about attribute',aname3, cret
    00102       if (cret .ne. 0) then
    00103          print *,'ERROR : attribute information'
    00104          call efexit(-1)
    00105       endif
    00106       if ( (atype .ne. atype3) .or.
    00107      &     (anc .ne. anc3)
    00108      &   ) then
    00109          print *,'ERROR : attribute information'
    00110          call efexit(-1)
    00111       endif
    00112
    00113 C
    00114 C     read attributes values
    00115 C
    00116       call msesgt(fid,mname2,mtype2,cret)
    00117       print *,'Read struct element type (by name) : ',mtype2, cret
    00118       if (cret .ne. 0 ) then
    00119          print *,'ERROR : struct element type (by name)'
    00120          call efexit(-1)
    00121       endif
    00122 c
    00123       call mmhiar(fid,cname,MED_NO_DT,MED_NO_IT,
    00124      &            mtype2,aname1,rval1,cret)
    00125       print *,'Read attribute values',cret
    00126       if (cret .ne. 0) then
    00127          print *,'ERROR : read attribute values'
    00128          call efexit(-1)
    00129       endif
    00130       if ( (aval1(1) .ne. rval1(1)) .or.
    00131      &     (aval1(2) .ne. rval1(2))
    00132      &   ) then
    00133          print *,'ERROR : attribute information'
    00134          call efexit(-1)
    00135       endif
    00136 c
    00137       call mmhrar(fid,cname,MED_NO_DT,MED_NO_IT,
    00138      &            mtype2,aname2,rval2,cret)
    00139       print *,'Read attribute values',cret
    00140       if (cret .ne. 0) then
    00141          print *,'ERROR : read attribute values'
    00142          call efexit(-1)
    00143       endif
    00144       if ( (aval2(1) .ne. rval2(1))
    00145      &   ) then
    00146          print *,'ERROR : attribute information'
    00147          call efexit(-1)
    00148       endif
    00149 c
    00150       call mmhsar(fid,cname,MED_NO_DT,MED_NO_IT,
    00151      &            mtype2,aname3,rval3,cret)
    00152       print *,'Read attribute values',cret
    00153       if (cret .ne. 0) then
    00154          print *,'ERROR : read attribute values'
    00155          call efexit(-1)
    00156       endif
    00157       if ( (aval3(1) .ne. rval3(1)) .or.
    00158      &     (aval3(2) .ne. rval3(2))
    00159      &   ) then
    00160          print *,'ERROR : attribute information'
    00161          call efexit(-1)
    00162       endif
    00163 C
    00164 C
    00165 C     close file
    00166       call mficlo(fid,cret)
    00167       print *,'Close file',cret
    00168       if (cret .ne. 0 ) then
    00169          print *,'ERROR :  close file'
    00170          call efexit(-1)
    00171       endif
    00172 C
    00173 C
    00174 C
    00175       end
    00176