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