/exodus_for/test/test_nem.f

C Copyright (c) 2005-2017 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions are
C met:
C
C     * Redistributions of source code must retain the above copyright
C       notice, this list of conditions and the following disclaimer.
C
C     * Redistributions in binary form must reproduce the above
C       copyright notice, this list of conditions and the following
C       disclaimer in the documentation and/or other materials provided
C       with the distribution.
C
C     * Neither the name of NTESS nor the names of its
C       contributors may be used to endorse or promote products derived
C       from this software without specific prior written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
C
C=================================================================
C
C This is just a simple test program to test the fortran interface
C for the NEMESIS I library.
C
C This file was created by translating ne_test.c into fortran.
C
C=================================================================
 
C=================================================================
      PROGRAM netest
C=================================================================
      include 'exodusII.inc'
      include 'test_nem.inc'
 
C local variables
      INTEGER NEID, IO_WS, CPU_WS, T_PASS, T_FAIL, DBG_FLAG, IERR
      CHARACTER FNAME*256, YO*6
      REAL VERSION
 
      yo = 'NETEST'
      io_ws = 0
      cpu_ws = 0
      t_pass = 0
      t_fail = 0
      dbg_flag = 0
 
C now let's get going...
 
C I don't care about input arguments, so the file name will be ne_test.nemI
      fname = 'test_nem.exo'
C and set the debug flag to 0
      dbg_flag = 0
 
      print*, '******************Output Tests*****************'
C create the exodus II file
      print*, 'creating ExodusII file...'
      neid = excre(fname, exclob, cpu_ws, io_ws, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        print*, yo, ': ERROR, unable to create test file', fname, '!'
        GOTO 100
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of initial information
      print*, 'testing init info output...'
      CALL expii(neid, nproc, nprocf, 'S', ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of initial global information
      print*, 'testing global init info output...'
      CALL expig(neid, nng, neg, nebg, nnsg, nssg, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of the global element block IDs
      print*, 'testing global element block ID output...'
      CALL extpebi(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of the global node-set info
      print*, 'testing global node-set params output...'
      CALL extpnsp(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of the global side-set info
      print*, 'testing global side-set params output...'
      CALL extpssp(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of the concatenated load-balance parameters
      print*, 'testing concatenated load balance info output...'
      CALL extplbpc(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of the node map
      print*, 'testing node map output...'
      CALL extpnm(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of the element map
      print*, 'testing element map output...'
      CALL extpem(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test the output of the concatenated communication map params
      print*, 'testing concatenated communication map params output...'
      CALL extpcmpc(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test nodal communication map output
      print*, 'testing nodal communication map output...'
      CALL extpncm(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test elemental communication map output
      print*, 'testing elemental communication map output...'
      CALL extpecm(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Close the ExodusII/Nemesis test file
      print*, 'closing ExodusII file...'
      CALL exclos(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        print*, yo, ': ERROR, unable to close test file', fname, '!'
          GOTO 100
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C=================================================================
C                       INPUT TEST SECTION
C=================================================================
 
      print*, '******************Input Tests******************'
 
C Re-open the ExodusII/NemesisI file
      print*, 'reopening ExodusII file...'
      neid =  exopen(fname, exread, cpu_ws, io_ws, version, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        print*, yo, ': ERROR, unable to open test file', fname, '!'
          GOTO 100
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of of the initial information
      print*, 'testing init info input...'
      CALL extgii(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of initial global information
      print*, 'testing global init info input...'
      CALL extgig(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of global element block IDs
      print*, 'testing global element block IDs input...'
      CALL extgebi(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of global node-set params
      print*, 'testing global node-set params input...'
      CALL extgnsp(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of global side-set params
      print*, 'testing global side-set params input...'
      CALL extgssp(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of load-balance params
      print*, 'testing load-balance params input...'
      CALL extglbp(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of the node map
      print*, 'testing node map input...'
      CALL extgnm(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of the element map
      print*, 'testing element map input...'
      CALL extgem(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of nodal communication maps
      print*, 'testing nodal communication map input...'
      CALL extgncm(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Test read of elemental communication maps
      print*, 'testing elemental communication map input...'
      CALL extgecm(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        IF (dbg_flag.EQ.1) THEN
          GOTO 100
        END IF
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
C Close the ExodusII/Nemesis test file
      print*, 'closing ExodusII file...'
      CALL exclos(neid, ierr)
      IF (ierr.NE.0) THEN
        print*, '...FAILED'
        t_fail = t_fail + 1
        print*, yo, ': ERROR, unable to close test file', fname, '!'
          GOTO 100
      ELSE
        print*, '...successful'
        t_pass = t_pass + 1
      END IF
 
      print*, 'Tests Passed: ', t_pass
      print*, 'Tests Failed: ', t_fail
 
  100 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extpebi(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER I, EBLK_IDS(NEBG)
      INTEGER EBLK_CNTS(NEBG)
 
      DO 110 i=1,nebg
        eblk_ids(i) = i
        eblk_cnts(i) = 10
  110 CONTINUE
 
      CALL expebig(neid, eblk_ids, eblk_cnts, ierr)
 
      END
 
C=================================================================
      SUBROUTINE extpnsp(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER I, GLBL_IDS(NNSG), GLBL_NC(NNSG), GLBL_DFC(NNSG)
 
      DO 120 i = 1,nnsg
        glbl_ids(i) = 2 * i
        glbl_nc(i) = 3 * i
        glbl_dfc(i) = 1
  120 CONTINUE
 
      CALL expnspg(neid, glbl_ids, glbl_nc, glbl_dfc, ierr)
 
      END
 
C=================================================================
      SUBROUTINE extpssp(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER I, GLBL_IDS(NSSG), GLBL_ELC(NSSG), GLBL_DFC(NSSG)
 
      DO 130 i = 1,nssg
        glbl_ids(i) = 3 * i
        glbl_elc(i) = 2 * i
        glbl_dfc(i) = 1
  130 CONTINUE
 
      CALL expsspg(neid, glbl_ids, glbl_elc, glbl_dfc, ierr)
 
      END
 
C=================================================================
      SUBROUTINE extplbpc(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, NUM_IN(NPROCF), NUM_BN(NPROCF), NUM_EN(NPROCF),
     1 NUM_IE(NPROCF), NUM_BE(NPROCF), NUM_NCM(NPROCF), NUM_ECM(NPROCF)
 
      DO 140 iproc = 1,nprocf
        num_in(iproc) = nintn
        num_bn(iproc) = nborn
        num_en(iproc) = nextn
 
        num_ie(iproc) = ninte
        num_be(iproc) = nbore
 
        num_ncm(iproc) = nncmap
        num_ecm(iproc) = necmap
  140 CONTINUE
 
      CALL explbpc(neid, num_in, num_bn, num_en, num_ie, num_be,
     1 num_ncm, num_ecm, ierr)
 
      END
 
C=================================================================
      SUBROUTINE extpnm(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, J, NMAPI(NINTN), NMAPB(NBORN), NMAPE(NEXTN)
 
      i = 0
      DO 200 iproc = 0,(nprocf-1)
        DO 150 j = 1,nintn
          nmapi(j) = i
          i = i + 1
  150   CONTINUE
        DO 160 j = 1,nborn
          nmapb(j) = i
          i = i + 1
  160   CONTINUE
        DO 170 j = 1,nextn
          nmape(j) = i
          i = i + 1
  170   CONTINUE
 
        i = 0
 
        CALL expnmp(neid, nmapi, nmapb, nmape, iproc, ierr)
        IF (ierr.NE.0) GOTO 210
 
  200 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extpem(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, J, EMAPI(NINTE), EMAPB(NBORE)
 
      i = 0
      DO 200 iproc = 0,(nprocf-1)
        DO 150 j = 1,ninte
          emapi(j) = i
          i = i + 1
  150   CONTINUE
        DO 160 j = 1,nbore
          emapb(j) = i
          i = i + 1
  160   CONTINUE
 
        i = 0
 
        CALL expemp(neid, emapi, emapb, iproc, ierr)
        IF (ierr.NE.0) GOTO 210
 
  200 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extpcmpc(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, NCNTR, ECNTR, NMAPIDS(NNCXNPF),
     1 NMAPCNT(NNCXNPF), NMAPPROC(NPROCF+1), EMAPIDS(NECXNPF),
     1 EMAPCNT(NECXNPF), EMAPPROC(NPROCF+1)
 
      nmapproc(1) = 0
      emapproc(1) = 0
      ncntr = 1
      ecntr = 1
      DO 200 iproc = 1,nprocf
        DO 150 i = 1,nncmap
          nmapids(ncntr) = i
          nmapcnt(ncntr) = ncntcm
          ncntr = ncntr + 1
  150   CONTINUE
        DO 160 i = 1,necmap
          emapids(ecntr) = 2*i
          emapcnt(ecntr) = ecntcm
          ecntr = ecntr + 1
  160   CONTINUE
 
      nmapproc(iproc+1) = nmapproc(iproc) + nncmap
      emapproc(iproc+1) = emapproc(iproc) + necmap
 
  200 CONTINUE
 
      CALL expcmpc(neid, nmapids, nmapcnt, nmapproc, emapids, emapcnt,
     1 emapproc, ierr)
 
      END
 
C=================================================================
      SUBROUTINE extpncm(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, NMAPIDS(NNCMAP), NIDS(NCNTCM), PIDS(NCNTCM)
 
      DO 200 iproc = 0,(nprocf-1)
        DO 150 i = 1,nncmap
          nmapids(i) = i
  150   CONTINUE
        DO 160 i = 1,ncntcm
          nids(i) = 2*i
          pids(i) = 3*i
  160   CONTINUE
 
        DO 170 i=1,nncmap
          CALL expncm(neid, nmapids(i), nids, pids, iproc, ierr)
          IF (ierr.NE.0) GOTO 210
  170   CONTINUE
 
  200 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extpecm(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, EMAPIDS(NECMAP), EIDS(ECNTCM), PIDS(ECNTCM),
     1 SIDS(ECNTCM)
 
      DO 200 iproc = 0,(nprocf-1)
        DO 150 i = 1,necmap
          emapids(i) = 2*i
  150   CONTINUE
        DO 160 i = 1,ecntcm
          eids(i) = 2*i
          sids(i) = 3*i
          pids(i) = 4*i
  160   CONTINUE
 
        DO 170 i=1,necmap
          CALL expecm(neid, emapids(i), eids, sids, pids, iproc, ierr)
          IF (ierr.NE.0) GOTO 210
  170   CONTINUE
 
  200 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgii(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER NP, NPF
      CHARACTER FTYPE*2
 
      CALL exgii(neid, np, npf, ftype, ierr)
 
      IF (ierr.NE.0) GOTO 210
 
      IF (np.NE.nproc) ierr = -1
      IF (npf.NE.nprocf) ierr = -1
      IF (np.NE.nproc) ierr = -1
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgig(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER NUMNG, NUMEG, NUMEBG, NUMNSG, NUMSSG
 
      CALL exgig(neid, numng, numeg, numebg, numnsg, numssg, ierr)
 
      IF (ierr.NE.0) GOTO 210
 
      IF (numng.NE.nng) ierr = -1
      IF (numeg.NE.neg) ierr = -1
      IF (numebg.NE.nebg) ierr = -1
      IF (numnsg.NE.nnsg) ierr = -1
      IF (numssg.NE.nssg) ierr = -1
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgebi(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER I, EBLK_IDS(NEBG)
      INTEGER EBLK_CNTS(NEBG)
 
      CALL exgebig(neid, eblk_ids, eblk_cnts, ierr)
 
      IF (ierr.NE.0) GOTO 210
 
      DO 150 i=1,nebg
        IF (eblk_ids(i).NE.i) ierr = -1
        IF (eblk_cnts(i) .NE. 10) ierr = -1
  150 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgnsp(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER I, GLBL_IDS(NNSG), GLBL_NC(NNSG), GLBL_DFC(NNSG)
 
      CALL exgnspg(neid, glbl_ids, glbl_nc, glbl_dfc, ierr)
 
      IF (ierr.NE.0) GOTO 210
 
      DO 150 i=1,nnsg
        IF (glbl_ids(i).NE.(2*i)) ierr = -1
        IF (glbl_nc(i).NE.(3*i)) ierr = -1
        IF (glbl_dfc(i).NE.1) ierr = -1
  150 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgssp(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER I, GLBL_IDS(NSSG), GLBL_EC(NSSG), GLBL_DFC(NSSG)
 
      CALL exgsspg(neid, glbl_ids, glbl_ec, glbl_dfc, ierr)
 
      IF (ierr.NE.0) GOTO 210
 
      DO 150 i=1,nnsg
        IF (glbl_ids(i).NE.(3*i)) ierr = -1
        IF (glbl_ec(i).NE.(2*i)) ierr = -1
        IF (glbl_dfc(i).NE.1) ierr = -1
  150 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extglbp(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, NUM_IN, NUM_BN, NUM_EN, NUM_IE, NUM_BE,
     *  NUM_NCM, NUM_ECM
 
      DO 150 iproc = 0,(nprocf-1)
        CALL exglbp(neid, num_in, num_bn, num_en, num_ie, num_be,
     1   num_ncm, num_ecm, iproc, ierr)
 
      IF (ierr.NE.0) GOTO 210
 
        IF(num_in.NE.nintn) ierr = -1
        IF(num_bn.NE.nborn) ierr = -1
        IF(num_en.NE.nextn) ierr = -1
        IF(num_ie.NE.ninte) ierr = -1
        IF(num_be.NE.nbore) ierr = -1
        IF(num_ncm.NE.nncmap) ierr = -1
        IF(num_ecm.NE.necmap) ierr = -1
  150 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgnm(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, J, NMAPI(NINTN), NMAPB(NBORN), NMAPE(NEXTN)
 
      i = 0
      DO 200 iproc = 0,(nprocf-1)
 
        CALL exgnmp(neid, nmapi, nmapb, nmape, iproc, ierr)
 
        IF (ierr.NE.0) GOTO 210
 
        DO 150 j = 1,nintn
          IF (nmapi(j).NE.i) err = -1
          i = i + 1
  150   CONTINUE
        DO 160 j = 1,nborn
          IF (nmapb(j).NE.i) err = -1
          i = i + 1
  160   CONTINUE
        DO 170 j = 1,nextn
          IF (nmape(j).NE.i) err = -1
          i = i + 1
  170   CONTINUE
 
        i = 0
 
        IF (ierr.NE.0) GOTO 210
 
  200 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgem(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, J, EMAPI(NINTE), EMAPB(NBORE)
 
      i = 0
      DO 200 iproc = 0,(nprocf-1)
        CALL exgemp(neid, emapi, emapb, iproc, ierr)
 
        IF (ierr.NE.0) GOTO 210
 
        DO 150 j = 1,ninte
          IF (emapi(j).NE.i) err = -1
          i = i + 1
  150   CONTINUE
        DO 160 j = 1,nbore
          IF (emapb(j).NE.i) err = -1
          i = i + 1
  160   CONTINUE
 
        i = 0
 
        IF (ierr.NE.0) GOTO 210
 
  200 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgncm(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, J, NMAPIDS(NNCMAP), NMAPCNT(NNCMAP),
     1 NIDS(NCNTCM), PIDS(NCNTCM), EMAPIDS(NECMAP), EMAPCNT(NECMAP)
 
      DO 200 iproc = 0,(nprocf-1)
        CALL exgcmp(neid, nmapids, nmapcnt, emapids, emapcnt,
     1   iproc, ierr)
 
        IF (ierr.NE.0) GOTO 210
 
        DO 170 i = 1,nncmap
          CALL exgncm(neid, nmapids(i), nids, pids, iproc, ierr)
 
          IF (ierr.NE.0) GOTO 210
 
          IF (nmapids(i).NE.i) ierr = -1
          DO 160 j = 1,ncntcm
            IF (nids(j).NE.2*j) ierr = -1
            IF (pids(j).NE.3*j) ierr = -1
  160     CONTINUE
 
          IF (ierr.NE.0) GOTO 210
  170   CONTINUE
 
  200 CONTINUE
 
  210 CONTINUE
      END
 
C=================================================================
      SUBROUTINE extgecm(NEID, IERR)
C=================================================================
 
      include 'test_nem.inc'
 
      INTEGER IPROC, I, EMAPIDS(NECMAP), EMAPCNT(NECMAP), EIDS(ECNTCM),
     1 PIDS(ECNTCM), SIDS(ECNTCM), NMAPIDS(NNCMAP), NMAPCNT(NNCMAP)
 
      DO 200 iproc = 0,(nprocf-1)
        CALL exgcmp(neid, nmapids, nmapcnt, emapids, emapcnt,
     1   iproc, ierr)
 
        IF (ierr.NE.0) GOTO 210
 
        DO 170 i = 1,necmap
          CALL exgecm(neid, emapids(i), eids, sids, pids, iproc, ierr)
 
          IF (ierr.NE.0) GOTO 210
 
          IF (emapids(i).NE.(2*i)) ierr = -1
          DO 160 j = 1,ecntcm
            IF (eids(j).NE.2*j) ierr = -1
            IF (sids(j).NE.3*j) ierr = -1
            IF (pids(j).NE.4*j) ierr = -1
  160     CONTINUE
 
          IF (ierr.NE.0) GOTO 210
  170   CONTINUE
 
  200 CONTINUE
 
  210 CONTINUE
      END