# Unittest_MEDstructElement_3.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 MEDstructElement3
    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       integer nsm
    00072       parameter (nsm=3)
    00073 c
    00074       integer it,nsmr
    00075       integer mgtype,mdim,setype,snnode,sncell
    00076       integer sgtype,ncatt,nvatt,profile
    00077       character*64 smname,mname
    00078 C
    00079 C
    00080 C     open file
    00081       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
    00082       print *,'Open file',cret
    00083       if (cret .ne. 0 ) then
    00084          print *,'ERROR : file creation'
    00085          call efexit(-1)
    00086       endif
    00087 C
    00088 C
    00089 C     read number of struct model
    00090       call msense(fid,nsmr,cret)
    00091       print *,'Read number of struct model',nsmr,cret
    00092       if (cret .ne. 0 ) then
    00093          print *,'ERROR : number of struct model'
    00094          call efexit(-1)
    00095       endif
    00096       if (nsmr .ne. nsm) then
    00097          print *,'ERROR : number of struct model'
    00098          call efexit(-1)
    00099       endif
    00100 C
    00101 C
    00102 C     Read informations by iteration
    00103       do it=1,nsmr
    00104 c
    00105          call  msesei(fid,it,mname,mgtype,mdim,smname,
    00106      &        setype,snnode,sncell,sgtype,
    00107      &        ncatt,profile,nvatt,cret)
    00108          print *,'Read information about struct element',cret
    00109          if (cret .ne. 0 ) then
    00110             print *,'ERROR : information about struct element'
    00111             call efexit(-1)
    00112          endif
    00113 c
    00114          if (it .eq. 1) then
    00115             if ( (mname .ne. mname1) .or.
    00116      &           (mgtype .ne. mtype1) .or.
    00117      &           (mdim .ne. dim1) .or.
    00118      &           (smname .ne. smname1) .or.
    00119      &           (setype .ne. setype1) .or.
    00120      &           (snnode .ne. nnode1) .or.
    00121      &           (sncell .ne. ncell1) .or.
    00122      &           (sgtype .ne. sgtype1) .or.
    00123      &           (ncatt .ne. ncatt1) .or.
    00124      &           (profile .ne. profile1) .or.
    00125      &           (nvatt .ne. nvatt1)
    00126      &           )  then
    00127                print *,'ERROR : information about struct element'
    00128                call efexit(-1)
    00129             endif
    00130          endif
    00131 c
    00132          if (it .eq. 2) then
    00133             if ( (mname .ne. mname2) .or.
    00134      &           (mgtype .ne. mtype2) .or.
    00135      &           (mdim .ne. dim2) .or.
    00136      &           (smname .ne. smname2) .or.
    00137      &           (setype .ne. setype2) .or.
    00138      &           (snnode .ne. nnode2) .or.
    00139      &           (sncell .ne. ncell1) .or.
    00140      &           (sgtype .ne. sgtype2) .or.
    00141      &           (ncatt .ne. ncatt1) .or.
    00142      &           (profile .ne. profile1) .or.
    00143      &           (nvatt .ne. nvatt1)
    00144      &    )  then
    00145          print *,'ERROR : information about struct element '
    00146          call efexit(-1)
    00147       endif
    00148          endif
    00149 c
    00150          if (it .eq. 3)  then
    00151             if ( (mname .ne. mname3) .or.
    00152      &           (mgtype .ne. mtype3) .or.
    00153      &           (mdim .ne. dim3) .or.
    00154      &           (smname .ne. smname2) .or.
    00155      &           (setype .ne. setype3) .or.
    00156      &           (snnode .ne. nnode2) .or.
    00157      &           (sncell .ne. ncell2) .or.
    00158      &           (sgtype .ne. sgtype3) .or.
    00159      &           (ncatt .ne. ncatt1) .or.
    00160      &           (profile .ne. profile1) .or.
    00161      &           (nvatt .ne. nvatt1)
    00162      &           )  then
    00163                print *,'ERROR : information about struct element'
    00164                call efexit(-1)
    00165             endif
    00166          endif
    00167 c
    00168       enddo
    00169 C
    00170 C
    00171 C     Read struct model name from type
    00172       call msesen(fid,mtype1,mname,cret)
    00173       print *,'Read struct element name from the type',cret
    00174       if (cret .ne. 0 ) then
    00175          print *,'ERROR : struct element name from the type'
    00176          call efexit(-1)
    00177       endif
    00178       if (mname .ne. mname1)  then
    00179          print *,'ERROR : struct element name from the type'
    00180          call efexit(-1)
    00181       endif
    00182 c
    00183       call msesen(fid,mtype2,mname,cret)
    00184       print *,'Read struct element name from the type',cret
    00185       if (cret .ne. 0 ) then
    00186          print *,'ERROR : struct element name from the type'
    00187          call efexit(-1)
    00188       endif
    00189       if (mname .ne. mname2)  then
    00190          print *,'ERROR : struct element name from the type'
    00191          call efexit(-1)
    00192       endif
    00193 c
    00194       call msesen(fid,mtype3,mname,cret)
    00195       print *,'Read struct element name from the type',cret
    00196       if (cret .ne. 0 ) then
    00197          print *,'ERROR : struct element name from the type'
    00198          call efexit(-1)
    00199       endif
    00200       if (mname .ne. mname3)  then
    00201          print *,'ERROR : struct element name from the type'
    00202          call efexit(-1)
    00203       endif
    00204 C
    00205 C
    00206 C     close file
    00207       call mficlo(fid,cret)
    00208       print *,'Close file',cret
    00209       if (cret .ne. 0 ) then
    00210          print *,'ERROR :  close file'
    00211          call efexit(-1)
    00212       endif
    00213 C
    00214 C
    00215 C
    00216       end
    00217