1!$Id:$
2      subroutine peigsv( lct, isw)
3
4!      * * F E A P * * A Finite Element Analysis Program
5
6!....  Copyright (c) 1984-2017: Regents of the University of California
7!                               All rights reserved
8
9!-----[--+---------+---------+---------+---------+---------+---------+-]
10!     Purpose: Save eigen-pairs on disk for use in another problem.
11
12!     Inputs:
13!              lct  - Filename for pairs
14!              isw  - 1 - write eigenpairs to   "filename"
15!                     2 - read  eigenpairs from "filename"
16
17!     Outputs:
18!              Eigen-pairs on file: "filename"
19!-----[--+---------+---------+---------+---------+---------+---------+-]
20
21
22      implicit none
23
24      include  'cdata.h'
25      include  'comblk.h'
26      include  'evdata.h'
27      include  'iofile.h'
28      include  'pointer.h'
29
30      character lct*15
31      logical   exst,palloc
32      integer   neqold,isw,i
33
34!     Write a file
35
36      if(isw.eq.1) then
37        open (unit = 35, file = lct , form = 'unformatted')
38
39        write(35) mf,mq,neq,neqold
40        write(35) (hr(np(76)+ i),i=0,mq-1),(hr(np(77)+i),i=0,mq*neq-1)
41        close(35)
42
43        write(iow,2000) lct
44        if(ior.lt.0) then
45          write(*,2000) lct
46        endif
47
48!     Read a set of eigen pairs
49
50      elseif(isw.eq.2) then
51        inquire(file = lct , exist = exst )
52        if(exst) then
53          open (unit = 35, file = lct , form = 'unformatted')
54
55          read (35) mf,mq,neqold
56          if(neq.ne.neqold) then
57            if(ior.lt.0) then
58              write(*,3000) neq,neqold
59            else
60              write(iow,3000) neq,neqold
61              call plstop(.true.)
62            endif
63          else
64!           Allocate space for eigenpairs if necessary
65            exst = palloc( 76,'EVAL',mq    , 2 )
66            exst = palloc( 77,'EVEC',mq*neq, 2 )
67            read(35) (hr(np(76)+ i),i=0,mq-1),
68     &               (hr(np(77)+i),i=0,mq*neq-1)
69            close(35)
70            write(iow,2001) lct
71            if(ior.lt.0) then
72              write(*,2001) lct
73            endif
74          endif
75        else
76          if(ior.lt.0) then
77            write(*,3001) lct
78          else
79            write(iow,3001) lct
80            call plstop(.true.)
81          endif
82        endif
83      endif
84
85!     Formats
86
872000  format(/5x,'Eigenpairs saved on file:',a/)
88
892001  format(/5x,'Eigenpairs read from file:',a/)
90
913000  format(' *ERROR* Number of equations differs from current problem'
92     &     /,'         Current neq =',i9,': Old neq =',i9)
93
943001  format(' *ERROR* File:',a,' does not exist, respecify')
95
96      end
97