# Unittest_MEDstructElement_5.f

Aller à la documentation de ce fichier.

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2012  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 MEDstructElement5
    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_4.med")
    00032       character*64  mname2
    00033       parameter (mname2 = "model name 2")
    00034       integer dim2
    00035       parameter (dim2=2)
    00036       character*64  smname2
    00037       parameter (smname2="support mesh name")
    00038       integer setype2
    00039       parameter (setype2=MED_NODE)
    00040       integer sgtype2
    00041       parameter (sgtype2=MED_NO_GEOTYPE)
    00042       integer mtype2
    00043       integer sdim1
    00044       parameter (sdim1=2)
    00045       character*200 description1
    00046       parameter (description1="support mesh1 description")
    00047       character*16 nomcoo2D(2)
    00048       character*16 unicoo2D(2)
    00049       data  nomcoo2D /"x","y"/, unicoo2D /"cm","cm"/
    00050       real*8 coo(2*3)
    00051       data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
    00052       integer nnode
    00053       parameter (nnode=3)
    00054       integer nseg2
    00055       parameter (nseg2=2)
    00056       integer seg2(4)
    00057       data seg2 /1,2, 2,3/
    00058       character*64 aname1, aname2, aname3
    00059       parameter (aname1="integer constant attribute name")
    00060       parameter (aname2="real constant attribute name")
    00061       parameter (aname3="string constant attribute name")
    00062       integer atype1,atype2,atype3
    00063       parameter (atype1=MED_ATT_INT)
    00064       parameter (atype2=MED_ATT_FLOAT64)
    00065       parameter (atype3=MED_ATT_NAME)
    00066       integer anc1,anc2,anc3
    00067       parameter (anc1=2)
    00068       parameter (anc2=1)
    00069       parameter (anc3=1)
    00070       integer aval1(3*2)
    00071       data aval1 /1,2,3,4,5,6/
    00072       real*8 aval2(3)
    00073       data aval2 /1., 2., 3. /
    00074       character*64 aval3(3)
    00075       data aval3 /"VAL1","VAL2","VAL3"/
    00076       integer itsize,ftsize,stsize
    00077       parameter (itsize=4)
    00078       parameter (ftsize=8)
    00079       parameter (stsize=64)
    00080 c
    00081       integer mgtype,mdim,setype,snnode,sncell
    00082       integer sgtype,ncatt,nvatt,profile
    00083       character*64 pname,smname
    00084       integer      atype,anc,psize,tsize
    00085       integer val1(2*3)
    00086       real*8 val2(3)
    00087       character*64 val3(3)
    00088 C
    00089 C
    00090 C     file creation
    00091       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
    00092       print *,'Open file',cret
    00093       if (cret .ne. 0 ) then
    00094          print *,'ERROR : file creation'
    00095          call efexit(-1)
    00096       endif
    00097 C
    00098 C     read information about struct model
    00099 C
    00100       call msesin(fid,mname2,mgtype,mdim,smname,
    00101      &            setype,snnode,sncell,sgtype,
    00102      &            ncatt,profile,nvatt,cret)
    00103       print *,'Read information about struct element (by name)',cret
    00104       if (cret .ne. 0 ) then
    00105          print *,'ERROR : information about struct element (by name) '
    00106          call efexit(-1)
    00107       endif
    00108 C
    00109 C     read constant attribute
    00110 C     with a direct access by name
    00111 C
    00112       call msecni(fid,mname2,aname1,atype,anc,
    00113      &            setype,pname,psize,cret)
    00114       print *,'Read information about constant attribute: ',aname1,cret
    00115       if (cret .ne. 0 ) then
    00116          print *,'ERROR : information about attribute (by name)'
    00117          call efexit(-1)
    00118       endif
    00119       if ( (atype .ne. atype1) .or.
    00120      &     (anc .ne. anc1) .or.
    00121      &     (setype .ne. setype2) .or.
    00122      &     (pname .ne. MED_NO_PROFILE) .or.
    00123      &     (psize .ne. 0)
    00124      &    )  then
    00125          print *,'ERROR : information about struct element (by name) '
    00126          call efexit(-1)
    00127       endif
    00128 c     read size of attribute type
    00129       call mseasz(atype,tsize,cret)
    00130       print *,'Read information type size: ',tsize,cret
    00131       if (cret .ne. 0 ) then
    00132          print *,'ERROR : information about type size'
    00133          call efexit(-1)
    00134       endif
    00135
    00136 c     read values
    00137       call mseiar(fid,mname2,aname1,val1,cret)
    00138       print *,'Read attribute values: ',aname1,cret
    00139       if (cret .ne. 0 ) then
    00140          print *,'ERROR : attribute values'
    00141          call efexit(-1)
    00142       endif
    00143       if ((aval1(1) .ne. val1(1)) .or.
    00144      &    (aval1(2) .ne. val1(2)) .or.
    00145      &    (aval1(3) .ne. val1(3)) .or.
    00146      &    (aval1(4) .ne. val1(4)) .or.
    00147      &    (aval1(5) .ne. val1(5)) .or.
    00148      &    (aval1(6) .ne. val1(6))
    00149      &   ) then
    00150           print *,'ERROR : attribute values'
    00151          call efexit(-1)
    00152       endif
    00153 c
    00154       call msecni(fid,mname2,aname2,atype,anc,
    00155      &            setype,pname,psize,cret)
    00156       print *,'Read information about constant attribute:',aname2,cret
    00157       if (cret .ne. 0 ) then
    00158          print *,'ERROR : information about attribute (by name)'
    00159          call efexit(-1)
    00160       endif
    00161       if ( (atype .ne. atype2) .or.
    00162      &     (anc .ne. anc2) .or.
    00163      &     (setype .ne. setype2) .or.
    00164      &     (pname .ne. MED_NO_PROFILE) .or.
    00165      &     (psize .ne. 0)
    00166      &    )  then
    00167          print *,'ERROR : information about struct element (by name) '
    00168          call efexit(-1)
    00169       endif
    00170 c     read size of attribute type
    00171       call mseasz(atype,tsize,cret)
    00172       print *,'Read information type size: ',tsize,cret
    00173       if (cret .ne. 0 ) then
    00174          print *,'ERROR : information about type size'
    00175          call efexit(-1)
    00176       endif
    00177       if (tsize .ne. ftsize) then
    00178          print *,'ERROR : information about type size'
    00179          call efexit(-1)
    00180       endif
    00181 c     read values
    00182       call mserar(fid,mname2,aname2,val2,cret)
    00183       print *,'Read attribute values: ',aname2,cret
    00184       if (cret .ne. 0 ) then
    00185          print *,'ERROR : attribute values'
    00186          call efexit(-1)
    00187       endif
    00188       if ((aval2(1) .ne. val2(1)) .or.
    00189      &    (aval2(2) .ne. val2(2)) .or.
    00190      &    (aval2(3) .ne. val2(3))
    00191      &   ) then
    00192           print *,'ERROR : attribute values'
    00193          call efexit(-1)
    00194       endif
    00195 c
    00196       call msecni(fid,mname2,aname3,atype,anc,
    00197      &            setype,pname,psize,cret)
    00198       print *,'Read information about constant attribute:',aname3,cret
    00199       if (cret .ne. 0 ) then
    00200          print *,'ERROR : information about attribute (by name)'
    00201          call efexit(-1)
    00202       endif
    00203       if ( (atype .ne. atype3) .or.
    00204      &     (anc .ne. anc3) .or.
    00205      &     (setype .ne. setype2) .or.
    00206      &     (pname .ne. MED_NO_PROFILE) .or.
    00207      &     (psize .ne. 0)
    00208      &    )  then
    00209          print *,'ERROR : information about struct element (by name) '
    00210          call efexit(-1)
    00211       endif
    00212 c     read size of attribute type
    00213       call mseasz(atype,tsize,cret)
    00214       print *,'Read information type size: ',tsize,cret
    00215       if (cret .ne. 0 ) then
    00216          print *,'ERROR : information about type size'
    00217          call efexit(-1)
    00218       endif
    00219       if (tsize .ne. stsize) then
    00220          print *,'ERROR : information about type size'
    00221          call efexit(-1)
    00222       endif
    00223 c     read values
    00224       call msesar(fid,mname2,aname3,val3,cret)
    00225       print *,'Read attribute values: ',aname3,cret
    00226       if (cret .ne. 0 ) then
    00227          print *,'ERROR : attribute values'
    00228          call efexit(-1)
    00229       endif
    00230       if ((aval3(1) .ne. val3(1)) .or.
    00231      &    (aval3(2) .ne. val3(2)) .or.
    00232      &    (aval3(3) .ne. val3(3))
    00233      &   ) then
    00234           print *,'ERROR : attribute values'
    00235          call efexit(-1)
    00236       endif
    00237 C
    00238 C
    00239 C     close file
    00240       call mficlo(fid,cret)
    00241       print *,'Close file',cret
    00242       if (cret .ne. 0 ) then
    00243          print *,'ERROR :  close file'
    00244          call efexit(-1)
    00245       endif
    00246 C
    00247 C
    00248 C
    00249       end
    00250