Eötvös Quantum Utilities  v4.8.128
Providing the Horsepowers in the Quantum Realm
MatrixIO.F90
Go to the documentation of this file.
1 !#include "fintrf.h"
2 !======================================================================
3 ! Gateway routine to call the zggev.f function from LAPACK package.
4 ! (See: http://www.netlib.org/lapack/explore-html/d9/d52/dggev_8f.html for details)
5 ! Copyright (C) 2009-2015 Peter Rakyta, Ph.D.
6 !
7 ! This program is free software: you can redistribute it and/or modify
8 ! it under the terms of the GNU General Publi! License as published by
9 ! the Free Software Foundation, either version 3 of the License, or
10 ! (at your option) any later version.
11 !
12 ! This program is distributed in the hope that it will be useful,
13 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ! GNU General Public License for more details.
16 !
17 ! You should have received a copy of the GNU General Public License
18 ! along with this program. If not, see http://www.gnu.org/licenses/.
19 !
20 !======================================================================
21 ! Gateway routine
22  PROGRAM matrixio
23 
24  use getpartialinv
25 
26 
27 ! Declarations
28  implicit none
29 
30 
31  integer::narg,cptArg !#of arg & counter of arg
32  character(len=100):: name !Arg name
33  logical LookForFilename, LookForinvDim
34  logical LookForOutput
35  logical fileExist
36  character(len=100) :: filename, output
37 
38 ! Array information:
39  integer*4 nonzerosA !number of nonzeros elements in A
40  integer*4 sizeAm, sizeAn !size of the matrix A (rows, and cols)
41  integer*4 sizeInv !the size of the Schur complement to be calculated
42  character(len=20) sizeInv_string !The size of the Schur complement -- string from the input
43  character(len=8) out_status
44 
45 ! Arguments for computational routine:
46  integer*4, allocatable :: ia(:), ja(:)
47 #ifdef COMP
48  COMPLEX*16, ALLOCATABLE :: a(:)
49 #else
50  REAL*8, ALLOCATABLE :: a(:)
51 #endif
52 
53 #ifdef COMP
54  COMPLEX*16, allocatable :: invA(:,:)
55 #else
56  real*8, allocatable :: invA(:,:)
57 #endif
58 !
59 
60  integer i,j
61 
62 #ifdef DEBUG
63 ! Debug parameters
64  integer*4 tmp
65  character*800 line
66 #endif
67 
68 ! https://genomeek.wordpress.com/2012/02/09/fortran-command-line-arguments/
69  !Check if any arguments are found
70  lookforfilename = .false.
71  lookforinvdim = .false.
72  lookforoutput = .false.
73  filename = ''
74  output = ''
75  sizeinv = 0
76 
77  narg=command_argument_count()
78  !Loop over the arguments
79  if(narg>0)then
80  !loop across options
81  do cptarg=1,narg
82  call get_command_argument(cptarg,name)
83  select case(adjustl(name))
84  case("--help","-h")
85  write(0,*)"This is program calculates the " , &
86  "Schur complement of a sparse matirix. Usage: ./getSchur ", &
87  "--filename FILENAME --invDim INTEGER"
88  stop
89  case("--filename","-F", "--Filename")
90  lookforfilename = .true.
91  case("--output","-o", "--Output")
92  lookforoutput = .true.
93  case("--invDim","-I")
94  lookforinvdim = .true.
95  case default
96  if (lookforfilename) then
97  filename=adjustl(name) !assign a value to pedfile
98  lookforfilename = .false.
99  elseif (lookforoutput) then
100  output=adjustl(name) !assign a value to pedfile
101  lookforoutput = .false.
102  elseif (lookforinvdim) then
103  sizeinv_string = trim(adjustl(name))
104  READ( sizeinv_string, * ) sizeinv
105  lookforinvdim = .false.
106  else
107  write(0,*)"Option ",adjustl(name),"unknown"
108  end if
109  end select
110  end do
111  end if
112 
113  if (output.eq.'') then
114  output = filename
115  end if
116 
117 #ifdef DEBUG
118  write(0,*) 'Input file name:', trim(filename)
119  write(0,*) 'Output file name:', trim(output)
120 #endif
121 
122 ! Testing the existance of the input file containing the sparse matrix A
123  inquire(file=trim(filename),exist=fileexist)!check if it exist
124  if(.not.fileexist)then
125  write(0,*)"file ",trim(filename)," not found!"
126  stop
127  endif
128 
129 ! Opening the file to read in data
130  OPEN(unit=6, file=trim(filename),status='OLD',form='UNFORMATTED')
131 
132  READ(6,end=999,err=1000) sizean
133  READ(6,end=999,err=1000) nonzerosa
134 
135  allocate(ia(sizean+1))
136  allocate(ja(nonzerosa))
137  allocate(a(nonzerosa))
138 
139  READ(6,end=999,err=1000) ia(:)
140  READ(6,end=999,err=1000) ja(:)
141  READ(6,end=999,err=1000) a(:)
142 
143 
144 
145 ! Closing the input file
146  CLOSE(unit=6)
147 
148 #ifdef DEBUG
149  write(0,*) 'Size of the partial inverse:', sizeinv
150  write(0,*) 'The size of the input MATRIX:', sizean
151  write(0,*) 'Nonzeros in the input matrix:', nonzerosa
152  write(0,*) 'The input MATRIX:'
153  i = 0
154  do j = 1, size(a)
155  if (j >= ia(i+1)) then
156  i=i+1
157  end if
158 
159  if (j < ia(i+1)) then
160  !write(0,*) 'row', i, 'col', ja(j), 'element of A = ', a(j)
161  end if
162  end do
163 
164 #endif
165 
166 
167 
168 
169 ! Calculating the partial inverse
170  ALLOCATE(inva(sizeinv, sizeinv))
171 
172  CALL dgetpartialinv(sizean, nonzerosa, a, ia, ja, sizeinv, inva)
173 
174 ! deallocate the fortran matrix A
175  deallocate(ia)
176  deallocate(ja)
177  deallocate(a)
178 #ifdef DEBUG
179  do i=1, sizeinv
180  do j=1, sizeinv
181  write(0,*) 'row', i, 'col', j, ' element of A = ', inva(i,j)
182  end do
183  end do
184 #endif
185 
186 
187 ! Deallocating memory for the partial inverse
188 
189  if ( allocated(inva) ) then
190  DEALLOCATE(inva)
191  endif
192 
193 
194  stop
195 
196  999 write(*,'(/"End-of-file when i = ",I5)') i
197  stop
198 
199  1000 write(*,'(/"ERROR reading when i = ",I5)') i
200  stop
201  end
202 
203 
Module to calculate the partial inverse of a real/complex sparse matrix via the PARDISO libraries...
program matrixio
Definition: MatrixIO.F90:22
subroutine dgetpartialinv(sizeA, nonzerosA, a, ia, ja, sizeInv, invA, error)
Get the partial inverse of double valued real matrices.