! Program principal pentru General_R
! Problema generalizata:
! MU''+KU =0
!
! M si K =simetrice + pozitiv definite
! Stocare: triunghiul superior - pe COLOANE: [ a11 | a12 a22 | a13 a23 a33| ... ]
! Introducere: triunghiul superior - pe linii
!
! Dec. 2006
! - cu kod_gen pt. M si pt. K: kod de citire a matricii.
! - kod_gen >0: Matricile = citite din fisierul de intrare sau specificat
!	M - triunghiul sup., pe linii (incepand cu elem. diagonal)
!	K - triunghiul sup, pe linii
!   La fisier specificat: Precedate de: 1 linie text
!
! Fisierul de intrare - continut:
!================================
! Daca matricea este citita: se introduce si "factor";
! Daca este generata: nu
!
! 1) Titlul problemei
! 2) ngl, kod_genM, kod_genK	
!	2-1) matricea M - daca kod_genM =1
!	2-2) m_factor (kod_genM >=1)
!
!	2-3) matricea K - daca kod_genK =1
!	2-4) k_factor (kod_genK >=1)
! 3) kod_print
!
! kod_gen  <=0 / >0: M si K =citite/generate
! 	kod_gen <=0:  matrice generata (subrutina)
!	kod_gen =1:  matricea citita din fisierul de intrare
!	kod_gen >=2: matricea citita din fisier specificat (selectat)
!
! kod_print >0: se tiparesc matricile M si K; R si S^-1
!           =0: se tiparesc R si S^-1
!           <0: nu se tipareste nimic
!

Program General_R
use dfwin
use work

use dflib

implicit real(8) (a-h,o-z)

real(8) m_factor, k_factor

character(80) titlu
character(max_path) fname1, fname2, fname3, fname4, fname5, fname6

real(8) norm1
character(80) dummy

 CHARACTER(3)        drive
 CHARACTER(256)      dir
! CHARACTER(260)      name		! in work
 CHARACTER(256)      ext
 CHARACTER(256)      file
 
character(260) lpstrTitle
integer status

lpstrTitle ='Select Input File'C
call GetFile(fname1, status, lpstrTitle)

open(1,file =fname1, status ='old', form ='formatted')

! Read data; title.
read(1,'(a)') title

read(1,*) ngl, kod_genM, kod_genK

! Alocari:
nn =ngl*(ngl+1)/2
allocate(M(nn), K(nn))
allocate(R(ngl,ngl), S_1(ngl, ngl))
M =0.; K =0.; R =0.;
S_1 =0.

! Genereaza matricile M si K
IF(kod_genM <=0) THEN
call gen_M()

ELSE	!read M

	if(kod_genM ==1) then
	do i =1,ngl
	read(1,*) ( M(loca(i,j)), j=i,ngl )
	enddo

	else
	lpstrTitle ='Select MASS File'C
	call GetFile(fname2, status, lpstrTitle)
	open(2, file =fname2, status ='old', form ='formatted')

	read(2,*) dummy
	do i =1,ngl
	read(2,*) ( M(loca(i,j)), j=i,ngl )
	enddo

	close(2)	
	endif

read(1,*) m_factor

if(m_factor /=1._8) then
M =M*m_factor
endif

ENDIF

IF(kod_genK <=0) THEN
call gen_K()

ELSE	!read K

	if(kod_genK ==1) then
	do i =1,ngl
	read(1,*) ( K(loca(i,j)), j=i,ngl )
	enddo

	else
	lpstrTitle ='Select STIFFNESS File'C
	call GetFile(fname3, status, lpstrTitle)
	open(3, file =fname3, status ='old', form ='formatted')

	read(3,*) dummy
	do i =1,ngl
	read(3,*) ( K(loca(i,j)), j=i,ngl )
	enddo

	close(3)	
	endif

read(1,*) k_factor

if(k_factor /=1._8) then
K =K*k_factor
endif

ENDIF

read(1,*) kod_Print

if(kod_Print >0) then		! write matrix (upper triangle)
write(1, '(/, a)') ' M'
do i =1,ngl
write(1,*) (M(loca(i,j)), j=i,ngl)
enddo

write(1, '(/, a)') ' K'
do i =1,ngl
write(1,*) (K(loca(i,j)), j=i,ngl)
enddo
endif

! Genereaza R:
call gen_R(kod_Print)


! Scale R-matrix:
norm1 =maxval(dabs(R))

scal =2_8**(exponent(norm1)-1)

write(*,*) 'R-Scale_Factor :', scal

if(scal /=1._8) then
R =R/scal
endif

! Write R matrix:
	if(kod_Print >=0) then
	write(1,*)
	call Write_R(1, scal)
	endif

result = SPLITPATHQQ (fname1, drive, dir, name, ext)

! Write R matrix to file:
fname4 =trim(name)//'-R.dat'
open(4,file =fname4, status ='unknown', form ='formatted')

call Write_R(4, scal)


! Write S^-1 matrix to file:
fname5 =trim(name)//'-S^-1.dat'
open(5,file =fname5, status ='unknown', form ='formatted')

	if(kod_Print >=0) then
	write(1, '(/, a)') ' Matricea S^(-1):'
	endif

write(5, '(a)') ' Matricea S^(-1):'

do i =1,ngl
	if(kod_Print >=0) then
	write(1,*) S_1(i,i:)
	endif

write(5,*) S_1(i,i:)
enddo

close(1)


! Write Scale factor to file:
fname6 =trim(name)//'-Scal_R.dat'
open(6,file =fname6, status ='unknown', form ='formatted')

write(6,*) 'Factor de scalare pentru R:'
write(6,*) scal


! Rezultate:
write(*, '(/,a)') 'Fisiere de rezultate:'

result = SPLITPATHQQ (fname4, drive, dir, name, ext)
write(*,*) trim(name)//trim(ext)

result = SPLITPATHQQ (fname5, drive, dir, name, ext)
write(*,*) trim(name)//trim(ext)

result = SPLITPATHQQ (fname6, drive, dir, name, ext)
write(*,*) trim(name)//trim(ext)

close(4)
close(5)
close(6)

deallocate(R, S_1)

END Program General_R
