Exodus  7.21
/exodus_for/test/test_nem.f
1 C Copyright (c) 2005-2017 National Technology & Engineering Solutions
2 C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
3 C NTESS, the U.S. Government retains certain rights in this software.
4 C
5 C Redistribution and use in source and binary forms, with or without
6 C modification, are permitted provided that the following conditions are
7 C met:
8 C
9 C * Redistributions of source code must retain the above copyright
10 C notice, this list of conditions and the following disclaimer.
11 C
12 C * Redistributions in binary form must reproduce the above
13 C copyright notice, this list of conditions and the following
14 C disclaimer in the documentation and/or other materials provided
15 C with the distribution.
16 C
17 C * Neither the name of NTESS nor the names of its
18 C contributors may be used to endorse or promote products derived
19 C from this software without specific prior written permission.
20 C
21 C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
27 C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
31 C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 C
33 C=================================================================
34 C
35 C This is just a simple test program to test the fortran interface
36 C for the NEMESIS I library.
37 C
38 C This file was created by translating ne_test.c into fortran.
39 C
40 C=================================================================
41 
42 C=================================================================
43  PROGRAM netest
44 C=================================================================
45  include 'exodusII.inc'
46  include 'test_nem.inc'
47 
48 C local variables
49  INTEGER NEID, IO_WS, CPU_WS, T_PASS, T_FAIL, DBG_FLAG, IERR
50  CHARACTER FNAME*256, YO*6
51  REAL VERSION
52 
53  yo = 'NETEST'
54  io_ws = 0
55  cpu_ws = 0
56  t_pass = 0
57  t_fail = 0
58  dbg_flag = 0
59 
60 C now let's get going...
61 
62 C I don't care about input arguments, so the file name will be ne_test.nemI
63  fname = 'test_nem.exo'
64 C and set the debug flag to 0
65  dbg_flag = 0
66 
67  print*, '******************Output Tests*****************'
68 C create the exodus II file
69  print*, 'creating ExodusII file...'
70  neid = excre(fname, exclob, cpu_ws, io_ws, ierr)
71  IF (ierr.NE.0) THEN
72  print*, '...FAILED'
73  t_fail = t_fail + 1
74  print*, yo, ': ERROR, unable to create test file', fname, '!'
75  GOTO 100
76  ELSE
77  print*, '...successful'
78  t_pass = t_pass + 1
79  END IF
80 
81 C Test the output of initial information
82  print*, 'testing init info output...'
83  CALL expii(neid, nproc, nprocf, 'S', ierr)
84  IF (ierr.NE.0) THEN
85  print*, '...FAILED'
86  t_fail = t_fail + 1
87  IF (dbg_flag.EQ.1) THEN
88  GOTO 100
89  END IF
90  ELSE
91  print*, '...successful'
92  t_pass = t_pass + 1
93  END IF
94 
95 C Test the output of initial global information
96  print*, 'testing global init info output...'
97  CALL expig(neid, nng, neg, nebg, nnsg, nssg, ierr)
98  IF (ierr.NE.0) THEN
99  print*, '...FAILED'
100  t_fail = t_fail + 1
101  IF (dbg_flag.EQ.1) THEN
102  GOTO 100
103  END IF
104  ELSE
105  print*, '...successful'
106  t_pass = t_pass + 1
107  END IF
108 
109 C Test the output of the global element block IDs
110  print*, 'testing global element block ID output...'
111  CALL extpebi(neid, ierr)
112  IF (ierr.NE.0) THEN
113  print*, '...FAILED'
114  t_fail = t_fail + 1
115  IF (dbg_flag.EQ.1) THEN
116  GOTO 100
117  END IF
118  ELSE
119  print*, '...successful'
120  t_pass = t_pass + 1
121  END IF
122 
123 C Test the output of the global node-set info
124  print*, 'testing global node-set params output...'
125  CALL extpnsp(neid, ierr)
126  IF (ierr.NE.0) THEN
127  print*, '...FAILED'
128  t_fail = t_fail + 1
129  IF (dbg_flag.EQ.1) THEN
130  GOTO 100
131  END IF
132  ELSE
133  print*, '...successful'
134  t_pass = t_pass + 1
135  END IF
136 
137 C Test the output of the global side-set info
138  print*, 'testing global side-set params output...'
139  CALL extpssp(neid, ierr)
140  IF (ierr.NE.0) THEN
141  print*, '...FAILED'
142  t_fail = t_fail + 1
143  IF (dbg_flag.EQ.1) THEN
144  GOTO 100
145  END IF
146  ELSE
147  print*, '...successful'
148  t_pass = t_pass + 1
149  END IF
150 
151 C Test the output of the concatenated load-balance parameters
152  print*, 'testing concatenated load balance info output...'
153  CALL extplbpc(neid, ierr)
154  IF (ierr.NE.0) THEN
155  print*, '...FAILED'
156  t_fail = t_fail + 1
157  IF (dbg_flag.EQ.1) THEN
158  GOTO 100
159  END IF
160  ELSE
161  print*, '...successful'
162  t_pass = t_pass + 1
163  END IF
164 
165 C Test the output of the node map
166  print*, 'testing node map output...'
167  CALL extpnm(neid, ierr)
168  IF (ierr.NE.0) THEN
169  print*, '...FAILED'
170  t_fail = t_fail + 1
171  IF (dbg_flag.EQ.1) THEN
172  GOTO 100
173  END IF
174  ELSE
175  print*, '...successful'
176  t_pass = t_pass + 1
177  END IF
178 
179 C Test the output of the element map
180  print*, 'testing element map output...'
181  CALL extpem(neid, ierr)
182  IF (ierr.NE.0) THEN
183  print*, '...FAILED'
184  t_fail = t_fail + 1
185  IF (dbg_flag.EQ.1) THEN
186  GOTO 100
187  END IF
188  ELSE
189  print*, '...successful'
190  t_pass = t_pass + 1
191  END IF
192 
193 C Test the output of the concatenated communication map params
194  print*, 'testing concatenated communication map params output...'
195  CALL extpcmpc(neid, ierr)
196  IF (ierr.NE.0) THEN
197  print*, '...FAILED'
198  t_fail = t_fail + 1
199  IF (dbg_flag.EQ.1) THEN
200  GOTO 100
201  END IF
202  ELSE
203  print*, '...successful'
204  t_pass = t_pass + 1
205  END IF
206 
207 C Test nodal communication map output
208  print*, 'testing nodal communication map output...'
209  CALL extpncm(neid, ierr)
210  IF (ierr.NE.0) THEN
211  print*, '...FAILED'
212  t_fail = t_fail + 1
213  IF (dbg_flag.EQ.1) THEN
214  GOTO 100
215  END IF
216  ELSE
217  print*, '...successful'
218  t_pass = t_pass + 1
219  END IF
220 
221 C Test elemental communication map output
222  print*, 'testing elemental communication map output...'
223  CALL extpecm(neid, ierr)
224  IF (ierr.NE.0) THEN
225  print*, '...FAILED'
226  t_fail = t_fail + 1
227  IF (dbg_flag.EQ.1) THEN
228  GOTO 100
229  END IF
230  ELSE
231  print*, '...successful'
232  t_pass = t_pass + 1
233  END IF
234 
235 C Close the ExodusII/Nemesis test file
236  print*, 'closing ExodusII file...'
237  CALL exclos(neid, ierr)
238  IF (ierr.NE.0) THEN
239  print*, '...FAILED'
240  t_fail = t_fail + 1
241  print*, yo, ': ERROR, unable to close test file', fname, '!'
242  GOTO 100
243  ELSE
244  print*, '...successful'
245  t_pass = t_pass + 1
246  END IF
247 
248 C=================================================================
249 C INPUT TEST SECTION
250 C=================================================================
251 
252  print*, '******************Input Tests******************'
253 
254 C Re-open the ExodusII/NemesisI file
255  print*, 'reopening ExodusII file...'
256  neid = exopen(fname, exread, cpu_ws, io_ws, version, ierr)
257  IF (ierr.NE.0) THEN
258  print*, '...FAILED'
259  t_fail = t_fail + 1
260  print*, yo, ': ERROR, unable to open test file', fname, '!'
261  GOTO 100
262  ELSE
263  print*, '...successful'
264  t_pass = t_pass + 1
265  END IF
266 
267 C Test read of of the initial information
268  print*, 'testing init info input...'
269  CALL extgii(neid, ierr)
270  IF (ierr.NE.0) THEN
271  print*, '...FAILED'
272  t_fail = t_fail + 1
273  IF (dbg_flag.EQ.1) THEN
274  GOTO 100
275  END IF
276  ELSE
277  print*, '...successful'
278  t_pass = t_pass + 1
279  END IF
280 
281 C Test read of initial global information
282  print*, 'testing global init info input...'
283  CALL extgig(neid, ierr)
284  IF (ierr.NE.0) THEN
285  print*, '...FAILED'
286  t_fail = t_fail + 1
287  IF (dbg_flag.EQ.1) THEN
288  GOTO 100
289  END IF
290  ELSE
291  print*, '...successful'
292  t_pass = t_pass + 1
293  END IF
294 
295 C Test read of global element block IDs
296  print*, 'testing global element block IDs input...'
297  CALL extgebi(neid, ierr)
298  IF (ierr.NE.0) THEN
299  print*, '...FAILED'
300  t_fail = t_fail + 1
301  IF (dbg_flag.EQ.1) THEN
302  GOTO 100
303  END IF
304  ELSE
305  print*, '...successful'
306  t_pass = t_pass + 1
307  END IF
308 
309 C Test read of global node-set params
310  print*, 'testing global node-set params input...'
311  CALL extgnsp(neid, ierr)
312  IF (ierr.NE.0) THEN
313  print*, '...FAILED'
314  t_fail = t_fail + 1
315  IF (dbg_flag.EQ.1) THEN
316  GOTO 100
317  END IF
318  ELSE
319  print*, '...successful'
320  t_pass = t_pass + 1
321  END IF
322 
323 C Test read of global side-set params
324  print*, 'testing global side-set params input...'
325  CALL extgssp(neid, ierr)
326  IF (ierr.NE.0) THEN
327  print*, '...FAILED'
328  t_fail = t_fail + 1
329  IF (dbg_flag.EQ.1) THEN
330  GOTO 100
331  END IF
332  ELSE
333  print*, '...successful'
334  t_pass = t_pass + 1
335  END IF
336 
337 C Test read of load-balance params
338  print*, 'testing load-balance params input...'
339  CALL extglbp(neid, ierr)
340  IF (ierr.NE.0) THEN
341  print*, '...FAILED'
342  t_fail = t_fail + 1
343  IF (dbg_flag.EQ.1) THEN
344  GOTO 100
345  END IF
346  ELSE
347  print*, '...successful'
348  t_pass = t_pass + 1
349  END IF
350 
351 C Test read of the node map
352  print*, 'testing node map input...'
353  CALL extgnm(neid, ierr)
354  IF (ierr.NE.0) THEN
355  print*, '...FAILED'
356  t_fail = t_fail + 1
357  IF (dbg_flag.EQ.1) THEN
358  GOTO 100
359  END IF
360  ELSE
361  print*, '...successful'
362  t_pass = t_pass + 1
363  END IF
364 
365 C Test read of the element map
366  print*, 'testing element map input...'
367  CALL extgem(neid, ierr)
368  IF (ierr.NE.0) THEN
369  print*, '...FAILED'
370  t_fail = t_fail + 1
371  IF (dbg_flag.EQ.1) THEN
372  GOTO 100
373  END IF
374  ELSE
375  print*, '...successful'
376  t_pass = t_pass + 1
377  END IF
378 
379 C Test read of nodal communication maps
380  print*, 'testing nodal communication map input...'
381  CALL extgncm(neid, ierr)
382  IF (ierr.NE.0) THEN
383  print*, '...FAILED'
384  t_fail = t_fail + 1
385  IF (dbg_flag.EQ.1) THEN
386  GOTO 100
387  END IF
388  ELSE
389  print*, '...successful'
390  t_pass = t_pass + 1
391  END IF
392 
393 C Test read of elemental communication maps
394  print*, 'testing elemental communication map input...'
395  CALL extgecm(neid, ierr)
396  IF (ierr.NE.0) THEN
397  print*, '...FAILED'
398  t_fail = t_fail + 1
399  IF (dbg_flag.EQ.1) THEN
400  GOTO 100
401  END IF
402  ELSE
403  print*, '...successful'
404  t_pass = t_pass + 1
405  END IF
406 
407 C Close the ExodusII/Nemesis test file
408  print*, 'closing ExodusII file...'
409  CALL exclos(neid, ierr)
410  IF (ierr.NE.0) THEN
411  print*, '...FAILED'
412  t_fail = t_fail + 1
413  print*, yo, ': ERROR, unable to close test file', fname, '!'
414  GOTO 100
415  ELSE
416  print*, '...successful'
417  t_pass = t_pass + 1
418  END IF
419 
420  print*, 'Tests Passed: ', t_pass
421  print*, 'Tests Failed: ', t_fail
422 
423  100 CONTINUE
424  END
425 
426 C=================================================================
427  SUBROUTINE extpebi(NEID, IERR)
428 C=================================================================
429 
430  include 'test_nem.inc'
431 
432  INTEGER I, EBLK_IDS(NEBG)
433  INTEGER EBLK_CNTS(NEBG)
434 
435  DO 110 i=1,nebg
436  eblk_ids(i) = i
437  eblk_cnts(i) = 10
438  110 CONTINUE
439 
440  CALL expebig(neid, eblk_ids, eblk_cnts, ierr)
441 
442  END
443 
444 C=================================================================
445  SUBROUTINE extpnsp(NEID, IERR)
446 C=================================================================
447 
448  include 'test_nem.inc'
449 
450  INTEGER I, GLBL_IDS(NNSG), GLBL_NC(NNSG), GLBL_DFC(NNSG)
451 
452  DO 120 i = 1,nnsg
453  glbl_ids(i) = 2 * i
454  glbl_nc(i) = 3 * i
455  glbl_dfc(i) = 1
456  120 CONTINUE
457 
458  CALL expnspg(neid, glbl_ids, glbl_nc, glbl_dfc, ierr)
459 
460  END
461 
462 C=================================================================
463  SUBROUTINE extpssp(NEID, IERR)
464 C=================================================================
465 
466  include 'test_nem.inc'
467 
468  INTEGER I, GLBL_IDS(NSSG), GLBL_ELC(NSSG), GLBL_DFC(NSSG)
469 
470  DO 130 i = 1,nssg
471  glbl_ids(i) = 3 * i
472  glbl_elc(i) = 2 * i
473  glbl_dfc(i) = 1
474  130 CONTINUE
475 
476  CALL expsspg(neid, glbl_ids, glbl_elc, glbl_dfc, ierr)
477 
478  END
479 
480 C=================================================================
481  SUBROUTINE extplbpc(NEID, IERR)
482 C=================================================================
483 
484  include 'test_nem.inc'
485 
486  INTEGER IPROC, NUM_IN(NPROCF), NUM_BN(NPROCF), NUM_EN(NPROCF),
487  1 NUM_IE(NPROCF), NUM_BE(NPROCF), NUM_NCM(NPROCF), NUM_ECM(NPROCF)
488 
489  DO 140 iproc = 1,nprocf
490  num_in(iproc) = nintn
491  num_bn(iproc) = nborn
492  num_en(iproc) = nextn
493 
494  num_ie(iproc) = ninte
495  num_be(iproc) = nbore
496 
497  num_ncm(iproc) = nncmap
498  num_ecm(iproc) = necmap
499  140 CONTINUE
500 
501  CALL explbpc(neid, num_in, num_bn, num_en, num_ie, num_be,
502  1 num_ncm, num_ecm, ierr)
503 
504  END
505 
506 C=================================================================
507  SUBROUTINE extpnm(NEID, IERR)
508 C=================================================================
509 
510  include 'test_nem.inc'
511 
512  INTEGER IPROC, I, J, NMAPI(NINTN), NMAPB(NBORN), NMAPE(NEXTN)
513 
514  i = 0
515  DO 200 iproc = 0,(nprocf-1)
516  DO 150 j = 1,nintn
517  nmapi(j) = i
518  i = i + 1
519  150 CONTINUE
520  DO 160 j = 1,nborn
521  nmapb(j) = i
522  i = i + 1
523  160 CONTINUE
524  DO 170 j = 1,nextn
525  nmape(j) = i
526  i = i + 1
527  170 CONTINUE
528 
529  i = 0
530 
531  CALL expnmp(neid, nmapi, nmapb, nmape, iproc, ierr)
532  IF (ierr.NE.0) GOTO 210
533 
534  200 CONTINUE
535 
536  210 CONTINUE
537  END
538 
539 C=================================================================
540  SUBROUTINE extpem(NEID, IERR)
541 C=================================================================
542 
543  include 'test_nem.inc'
544 
545  INTEGER IPROC, I, J, EMAPI(NINTE), EMAPB(NBORE)
546 
547  i = 0
548  DO 200 iproc = 0,(nprocf-1)
549  DO 150 j = 1,ninte
550  emapi(j) = i
551  i = i + 1
552  150 CONTINUE
553  DO 160 j = 1,nbore
554  emapb(j) = i
555  i = i + 1
556  160 CONTINUE
557 
558  i = 0
559 
560  CALL expemp(neid, emapi, emapb, iproc, ierr)
561  IF (ierr.NE.0) GOTO 210
562 
563  200 CONTINUE
564 
565  210 CONTINUE
566  END
567 
568 C=================================================================
569  SUBROUTINE extpcmpc(NEID, IERR)
570 C=================================================================
571 
572  include 'test_nem.inc'
573 
574  INTEGER IPROC, I, NCNTR, ECNTR, NMAPIDS(NNCXNPF),
575  1 NMAPCNT(NNCXNPF), NMAPPROC(NPROCF+1), EMAPIDS(NECXNPF),
576  1 EMAPCNT(NECXNPF), EMAPPROC(NPROCF+1)
577 
578  nmapproc(1) = 0
579  emapproc(1) = 0
580  ncntr = 1
581  ecntr = 1
582  DO 200 iproc = 1,nprocf
583  DO 150 i = 1,nncmap
584  nmapids(ncntr) = i
585  nmapcnt(ncntr) = ncntcm
586  ncntr = ncntr + 1
587  150 CONTINUE
588  DO 160 i = 1,necmap
589  emapids(ecntr) = 2*i
590  emapcnt(ecntr) = ecntcm
591  ecntr = ecntr + 1
592  160 CONTINUE
593 
594  nmapproc(iproc+1) = nmapproc(iproc) + nncmap
595  emapproc(iproc+1) = emapproc(iproc) + necmap
596 
597  200 CONTINUE
598 
599  CALL expcmpc(neid, nmapids, nmapcnt, nmapproc, emapids, emapcnt,
600  1 emapproc, ierr)
601 
602  END
603 
604 C=================================================================
605  SUBROUTINE extpncm(NEID, IERR)
606 C=================================================================
607 
608  include 'test_nem.inc'
609 
610  INTEGER IPROC, I, NMAPIDS(NNCMAP), NIDS(NCNTCM), PIDS(NCNTCM)
611 
612  DO 200 iproc = 0,(nprocf-1)
613  DO 150 i = 1,nncmap
614  nmapids(i) = i
615  150 CONTINUE
616  DO 160 i = 1,ncntcm
617  nids(i) = 2*i
618  pids(i) = 3*i
619  160 CONTINUE
620 
621  DO 170 i=1,nncmap
622  CALL expncm(neid, nmapids(i), nids, pids, iproc, ierr)
623  IF (ierr.NE.0) GOTO 210
624  170 CONTINUE
625 
626  200 CONTINUE
627 
628  210 CONTINUE
629  END
630 
631 C=================================================================
632  SUBROUTINE extpecm(NEID, IERR)
633 C=================================================================
634 
635  include 'test_nem.inc'
636 
637  INTEGER IPROC, I, EMAPIDS(NECMAP), EIDS(ECNTCM), PIDS(ECNTCM),
638  1 SIDS(ECNTCM)
639 
640  DO 200 iproc = 0,(nprocf-1)
641  DO 150 i = 1,necmap
642  emapids(i) = 2*i
643  150 CONTINUE
644  DO 160 i = 1,ecntcm
645  eids(i) = 2*i
646  sids(i) = 3*i
647  pids(i) = 4*i
648  160 CONTINUE
649 
650  DO 170 i=1,necmap
651  CALL expecm(neid, emapids(i), eids, sids, pids, iproc, ierr)
652  IF (ierr.NE.0) GOTO 210
653  170 CONTINUE
654 
655  200 CONTINUE
656 
657  210 CONTINUE
658  END
659 
660 C=================================================================
661  SUBROUTINE extgii(NEID, IERR)
662 C=================================================================
663 
664  include 'test_nem.inc'
665 
666  INTEGER NP, NPF
667  CHARACTER FTYPE*2
668 
669  CALL exgii(neid, np, npf, ftype, ierr)
670 
671  IF (ierr.NE.0) GOTO 210
672 
673  IF (np.NE.nproc) ierr = -1
674  IF (npf.NE.nprocf) ierr = -1
675  IF (np.NE.nproc) ierr = -1
676 
677  210 CONTINUE
678  END
679 
680 C=================================================================
681  SUBROUTINE extgig(NEID, IERR)
682 C=================================================================
683 
684  include 'test_nem.inc'
685 
686  INTEGER NUMNG, NUMEG, NUMEBG, NUMNSG, NUMSSG
687 
688  CALL exgig(neid, numng, numeg, numebg, numnsg, numssg, ierr)
689 
690  IF (ierr.NE.0) GOTO 210
691 
692  IF (numng.NE.nng) ierr = -1
693  IF (numeg.NE.neg) ierr = -1
694  IF (numebg.NE.nebg) ierr = -1
695  IF (numnsg.NE.nnsg) ierr = -1
696  IF (numssg.NE.nssg) ierr = -1
697 
698  210 CONTINUE
699  END
700 
701 C=================================================================
702  SUBROUTINE extgebi(NEID, IERR)
703 C=================================================================
704 
705  include 'test_nem.inc'
706 
707  INTEGER I, EBLK_IDS(NEBG)
708  INTEGER EBLK_CNTS(NEBG)
709 
710  CALL exgebig(neid, eblk_ids, eblk_cnts, ierr)
711 
712  IF (ierr.NE.0) GOTO 210
713 
714  DO 150 i=1,nebg
715  IF (eblk_ids(i).NE.i) ierr = -1
716  IF (eblk_cnts(i) .NE. 10) ierr = -1
717  150 CONTINUE
718 
719  210 CONTINUE
720  END
721 
722 C=================================================================
723  SUBROUTINE extgnsp(NEID, IERR)
724 C=================================================================
725 
726  include 'test_nem.inc'
727 
728  INTEGER I, GLBL_IDS(NNSG), GLBL_NC(NNSG), GLBL_DFC(NNSG)
729 
730  CALL exgnspg(neid, glbl_ids, glbl_nc, glbl_dfc, ierr)
731 
732  IF (ierr.NE.0) GOTO 210
733 
734  DO 150 i=1,nnsg
735  IF (glbl_ids(i).NE.(2*i)) ierr = -1
736  IF (glbl_nc(i).NE.(3*i)) ierr = -1
737  IF (glbl_dfc(i).NE.1) ierr = -1
738  150 CONTINUE
739 
740  210 CONTINUE
741  END
742 
743 C=================================================================
744  SUBROUTINE extgssp(NEID, IERR)
745 C=================================================================
746 
747  include 'test_nem.inc'
748 
749  INTEGER I, GLBL_IDS(NSSG), GLBL_EC(NSSG), GLBL_DFC(NSSG)
750 
751  CALL exgsspg(neid, glbl_ids, glbl_ec, glbl_dfc, ierr)
752 
753  IF (ierr.NE.0) GOTO 210
754 
755  DO 150 i=1,nnsg
756  IF (glbl_ids(i).NE.(3*i)) ierr = -1
757  IF (glbl_ec(i).NE.(2*i)) ierr = -1
758  IF (glbl_dfc(i).NE.1) ierr = -1
759  150 CONTINUE
760 
761  210 CONTINUE
762  END
763 
764 C=================================================================
765  SUBROUTINE extglbp(NEID, IERR)
766 C=================================================================
767 
768  include 'test_nem.inc'
769 
770  INTEGER IPROC, NUM_IN, NUM_BN, NUM_EN, NUM_IE, NUM_BE,
771  * NUM_NCM, NUM_ECM
772 
773  DO 150 iproc = 0,(nprocf-1)
774  CALL exglbp(neid, num_in, num_bn, num_en, num_ie, num_be,
775  1 num_ncm, num_ecm, iproc, ierr)
776 
777  IF (ierr.NE.0) GOTO 210
778 
779  IF(num_in.NE.nintn) ierr = -1
780  IF(num_bn.NE.nborn) ierr = -1
781  IF(num_en.NE.nextn) ierr = -1
782  IF(num_ie.NE.ninte) ierr = -1
783  IF(num_be.NE.nbore) ierr = -1
784  IF(num_ncm.NE.nncmap) ierr = -1
785  IF(num_ecm.NE.necmap) ierr = -1
786  150 CONTINUE
787 
788  210 CONTINUE
789  END
790 
791 C=================================================================
792  SUBROUTINE extgnm(NEID, IERR)
793 C=================================================================
794 
795  include 'test_nem.inc'
796 
797  INTEGER IPROC, I, J, NMAPI(NINTN), NMAPB(NBORN), NMAPE(NEXTN)
798 
799  i = 0
800  DO 200 iproc = 0,(nprocf-1)
801 
802  CALL exgnmp(neid, nmapi, nmapb, nmape, iproc, ierr)
803 
804  IF (ierr.NE.0) GOTO 210
805 
806  DO 150 j = 1,nintn
807  IF (nmapi(j).NE.i) err = -1
808  i = i + 1
809  150 CONTINUE
810  DO 160 j = 1,nborn
811  IF (nmapb(j).NE.i) err = -1
812  i = i + 1
813  160 CONTINUE
814  DO 170 j = 1,nextn
815  IF (nmape(j).NE.i) err = -1
816  i = i + 1
817  170 CONTINUE
818 
819  i = 0
820 
821  IF (ierr.NE.0) GOTO 210
822 
823  200 CONTINUE
824 
825  210 CONTINUE
826  END
827 
828 C=================================================================
829  SUBROUTINE extgem(NEID, IERR)
830 C=================================================================
831 
832  include 'test_nem.inc'
833 
834  INTEGER IPROC, I, J, EMAPI(NINTE), EMAPB(NBORE)
835 
836  i = 0
837  DO 200 iproc = 0,(nprocf-1)
838  CALL exgemp(neid, emapi, emapb, iproc, ierr)
839 
840  IF (ierr.NE.0) GOTO 210
841 
842  DO 150 j = 1,ninte
843  IF (emapi(j).NE.i) err = -1
844  i = i + 1
845  150 CONTINUE
846  DO 160 j = 1,nbore
847  IF (emapb(j).NE.i) err = -1
848  i = i + 1
849  160 CONTINUE
850 
851  i = 0
852 
853  IF (ierr.NE.0) GOTO 210
854 
855  200 CONTINUE
856 
857  210 CONTINUE
858  END
859 
860 C=================================================================
861  SUBROUTINE extgncm(NEID, IERR)
862 C=================================================================
863 
864  include 'test_nem.inc'
865 
866  INTEGER IPROC, I, J, NMAPIDS(NNCMAP), NMAPCNT(NNCMAP),
867  1 NIDS(NCNTCM), PIDS(NCNTCM), EMAPIDS(NECMAP), EMAPCNT(NECMAP)
868 
869  DO 200 iproc = 0,(nprocf-1)
870  CALL exgcmp(neid, nmapids, nmapcnt, emapids, emapcnt,
871  1 iproc, ierr)
872 
873  IF (ierr.NE.0) GOTO 210
874 
875  DO 170 i = 1,nncmap
876  CALL exgncm(neid, nmapids(i), nids, pids, iproc, ierr)
877 
878  IF (ierr.NE.0) GOTO 210
879 
880  IF (nmapids(i).NE.i) ierr = -1
881  DO 160 j = 1,ncntcm
882  IF (nids(j).NE.2*j) ierr = -1
883  IF (pids(j).NE.3*j) ierr = -1
884  160 CONTINUE
885 
886  IF (ierr.NE.0) GOTO 210
887  170 CONTINUE
888 
889  200 CONTINUE
890 
891  210 CONTINUE
892  END
893 
894 C=================================================================
895  SUBROUTINE extgecm(NEID, IERR)
896 C=================================================================
897 
898  include 'test_nem.inc'
899 
900  INTEGER IPROC, I, EMAPIDS(NECMAP), EMAPCNT(NECMAP), EIDS(ECNTCM),
901  1 PIDS(ECNTCM), SIDS(ECNTCM), NMAPIDS(NNCMAP), NMAPCNT(NNCMAP)
902 
903  DO 200 iproc = 0,(nprocf-1)
904  CALL exgcmp(neid, nmapids, nmapcnt, emapids, emapcnt,
905  1 iproc, ierr)
906 
907  IF (ierr.NE.0) GOTO 210
908 
909  DO 170 i = 1,necmap
910  CALL exgecm(neid, emapids(i), eids, sids, pids, iproc, ierr)
911 
912  IF (ierr.NE.0) GOTO 210
913 
914  IF (emapids(i).NE.(2*i)) ierr = -1
915  DO 160 j = 1,ecntcm
916  IF (eids(j).NE.2*j) ierr = -1
917  IF (sids(j).NE.3*j) ierr = -1
918  IF (pids(j).NE.4*j) ierr = -1
919  160 CONTINUE
920 
921  IF (ierr.NE.0) GOTO 210
922  170 CONTINUE
923 
924  200 CONTINUE
925 
926  210 CONTINUE
927  END
928