# Unittest_MEDstructElement_2.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 MEDstructElement2
    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_1.med")
    00032       character*64  mname1, mname2, mname3
    00033       parameter (mname1 = "model name 1")
    00034       parameter (mname2 = "model name 2")
    00035       parameter (mname3 = "model name 3")
    00036       integer dim1, dim2, dim3
    00037       parameter (dim1=2)
    00038       parameter (dim2=2)
    00039       parameter (dim3=2)
    00040       character*64  smname1
    00041       parameter (smname1=MED_NO_NAME)
    00042       character*64  smname2
    00043       parameter (smname2="support mesh name")
    00044       integer setype1
    00045       parameter (setype1=MED_NONE)
    00046       integer setype2
    00047       parameter (setype2=MED_NODE)
    00048       integer setype3
    00049       parameter (setype3=MED_CELL)
    00050       integer sgtype1
    00051       parameter (sgtype1=MED_NO_GEOTYPE)
    00052       integer sgtype2
    00053       parameter (sgtype2=MED_NO_GEOTYPE)
    00054       integer sgtype3
    00055       parameter (sgtype3=MED_SEG2)
    00056       integer mtype1,mtype2,mtype3
    00057       parameter (mtype1=601)
    00058       parameter (mtype2=602)
    00059       parameter (mtype3=603)
    00060       integer nnode1,nnode2
    00061       parameter (nnode1=1)
    00062       parameter (nnode2=3)
    00063       integer ncell2
    00064       parameter (ncell2=2)
    00065       integer ncell1
    00066       parameter (ncell1=0)
    00067       integer ncatt1,profile1,nvatt1
    00068       parameter (ncatt1=0)
    00069       parameter (nvatt1=0)
    00070       parameter (profile1=0)
    00071 c
    00072       integer mgtype,mdim,setype,snnode,sncell
    00073       integer sgtype,ncatt,nvatt,profile
    00074       character*64 smname
    00075 C
    00076 C
    00077 C     open file
    00078       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
    00079       print *,'Open file',cret
    00080       if (cret .ne. 0 ) then
    00081          print *,'ERROR : file creation'
    00082          call efexit(-1)
    00083       endif
    00084 C
    00085 C
    00086 C     Read information about a struct element model
    00087 C     Access by name
    00088       call msesin(fid,mname1,mgtype,mdim,smname,
    00089      &            setype,snnode,sncell,sgtype,
    00090      &            ncatt,profile,nvatt,cret)
    00091       print *,'Read information about struct element (by name)',cret
    00092       if (cret .ne. 0 ) then
    00093          print *,'ERROR : information about struct element (by name) '
    00094          call efexit(-1)
    00095       endif
    00096       if ( (mgtype .ne. mtype1) .or.
    00097      &     (mdim .ne. dim1) .or.
    00098      &     (smname .ne. smname1) .or.
    00099      &     (setype .ne. setype1) .or.
    00100      &     (snnode .ne. nnode1) .or.
    00101      &     (sncell .ne. ncell1) .or.
    00102      &     (sgtype .ne. sgtype1) .or.
    00103      &     (ncatt .ne. ncatt1) .or.
    00104      &     (profile .ne. profile1) .or.
    00105      &     (nvatt .ne. nvatt1)
    00106      &    )  then
    00107          print *,'ERROR : information about struct element (by name) '
    00108          call efexit(-1)
    00109       endif
    00110 C
    00111 C
    00112 C
    00113       call msesin(fid,mname2,mgtype,mdim,smname,
    00114      &            setype,snnode,sncell,sgtype,
    00115      &            ncatt,profile,nvatt,cret)
    00116       print *,'Read information about struct element (by name)',cret
    00117       if (cret .ne. 0 ) then
    00118          print *,'ERROR : information about struct element (by name) '
    00119          call efexit(-1)
    00120       endif
    00121       if ( (mgtype .ne. mtype2) .or.
    00122      &     (mdim .ne. dim2) .or.
    00123      &     (smname .ne. smname2) .or.
    00124      &     (setype .ne. setype2) .or.
    00125      &     (snnode .ne. nnode2) .or.
    00126      &     (sncell .ne. ncell1) .or.
    00127      &     (sgtype .ne. sgtype2) .or.
    00128      &     (ncatt .ne. ncatt1) .or.
    00129      &     (profile .ne. profile1) .or.
    00130      &     (nvatt .ne. nvatt1)
    00131      &    )  then
    00132          print *,'ERROR : information about struct element (by name) '
    00133          call efexit(-1)
    00134       endif
    00135 C
    00136 C
    00137 C
    00138       call msesin(fid,mname3,mgtype,mdim,smname,
    00139      &            setype,snnode,sncell,sgtype,
    00140      &            ncatt,profile,nvatt,cret)
    00141       print *,'Read information about struct element (by name)',cret
    00142       if (cret .ne. 0 ) then
    00143          print *,'ERROR : information about struct element (by name) '
    00144          call efexit(-1)
    00145       endif
    00146       if ( (mgtype .ne. mtype3) .or.
    00147      &     (mdim .ne. dim3) .or.
    00148      &     (smname .ne. smname2) .or.
    00149      &     (setype .ne. setype3) .or.
    00150      &     (snnode .ne. nnode2) .or.
    00151      &     (sncell .ne. ncell2) .or.
    00152      &     (sgtype .ne. sgtype3) .or.
    00153      &     (ncatt .ne. ncatt1) .or.
    00154      &     (profile .ne. profile1) .or.
    00155      &     (nvatt .ne. nvatt1)
    00156      &    )  then
    00157          print *,'ERROR : information about struct element (by name) '
    00158          call efexit(-1)
    00159       endif
    00160 C
    00161 C
    00162 C     Read model type from the name
    00163       call msesgt(fid,mname1,mgtype,cret)
    00164       print *,'Read struct element type (by name)',cret
    00165       if (cret .ne. 0 ) then
    00166          print *,'ERROR : struct element type (by name)'
    00167          call efexit(-1)
    00168       endif
    00169       if (mgtype .ne. mtype1) then
    00170          print *,'ERROR : struct element type (by name)'
    00171          call efexit(-1)
    00172       endif
    00173 c
    00174 c
    00175 c     Read model type from the name
    00176       call msesgt(fid,mname2,mgtype,cret)
    00177       print *,'Read struct element type (by name)',cret
    00178       if (cret .ne. 0 ) then
    00179          print *,'ERROR : struct element type (by name)'
    00180          call efexit(-1)
    00181       endif
    00182       if (mgtype .ne. mtype2) then
    00183          print *,'ERROR : struct element type (by name)'
    00184          call efexit(-1)
    00185       endif
    00186 c
    00187 c
    00188 c     Read model type from the name
    00189       call msesgt(fid,mname3,mgtype,cret)
    00190       print *,'Read struct element type (by name)',cret
    00191       if (cret .ne. 0 ) then
    00192          print *,'ERROR : struct element type (by name)'
    00193          call efexit(-1)
    00194       endif
    00195       if (mgtype .ne. mtype3) then
    00196          print *,'ERROR : struct element type (by name)'
    00197          call efexit(-1)
    00198       endif
    00199 C
    00200 C
    00201 C     close file
    00202       call mficlo(fid,cret)
    00203       print *,'Close file',cret
    00204       if (cret .ne. 0 ) then
    00205          print *,'ERROR :  close file'
    00206          call efexit(-1)
    00207       endif
    00208 C
    00209 C
    00210 C
    00211       end
    00212