implicit real*8(a-h,o-z)
dimension h99(9,9),h9(9),rgbk(9),h33(3,3)
rc=10.    !写真のスケールのシアンのR値
gc=240.   !写真のスケールのシアンのG値
bc=230.   !写真のスケールのシアンのB値
rm=240    !写真のスケールのマゼンタのR値
gm=20.    !写真のスケールのマゼンタのG値
bm=230.   !写真のスケールのマゼンタのB値
ry=240.   !写真のスケールのマゼンタのR値
gy=230.   !写真のスケールのマゼンタのG値
by=30.    !写真のスケールのマゼンタのB値
!シアンの基準RGB
rgbk(1)=0.
rgbk(2)=255.
rgbk(3)=255.
!マゼンタの基準RGB
rgbk(4)=255.
rgbk(5)=0.
rgbk(6)=255.
!イエローの基準RGB
rgbk(7)=255.
rgbk(8)=255.
rgbk(9)=0.
!
do i=1,9
do j=1,9
h99(i,j)=0.
end do
end do
!
h99(1,1)=rc
h99(2,2)=rc
h99(3,3)=rc
h99(1,4)=gc
h99(2,5)=gc
h99(3,6)=gc
h99(1,7)=bc
h99(2,8)=bc
h99(3,9)=bc
!
h99(4,1)=rm
h99(5,2)=rm
h99(6,3)=rm
h99(4,4)=gm
h99(5,5)=gm
h99(6,6)=gm
h99(4,7)=bm
h99(5,8)=bm
h99(6,9)=bm
!
h99(7,1)=ry
h99(8,2)=ry
h99(9,3)=ry
h99(7,4)=gy
h99(8,5)=gy
h99(9,6)=gy
h99(7,7)=by
h99(8,8)=by
h99(9,9)=by
!
!
!print*, "h99"
!do i=1,9
!print*, (h99(i,j),j=1,9)
!end do
!
n=9
call gausu(n,h99,h9,rgbk)
!print*, "h9"
!print*, (h9(j),j=1,9)
!print*, "h33"
do j=1,3
h33(j,1)=h9(j)
h33(j,2)=h9(3+j)
h33(j,3)=h9(6+j)
end do
!
open(7,file='henkanm')
do i=1,3
write(7,*) (h33(i,j),j=1,3)
end do
close(7)
!
end
!
!以下はサブルーチン、プログラムの末尾の方に入れておく。
subroutine gausu(n,a,x,b)
implicit real*8(a-h,o-z)
dimension a(9,9),x(9),b(9)
!
!print*,"a"
!do i=1,9
!print*, (a(i,j),j=1,9)
!end do
!
!print*,"b"
!print*, (b(j),j=1,9)
!real::akjxj
!integer::i,j,k,n
!
!ガウスの消去法の参考としたのは、
!名取亮「すうがくぶっくす12 線形計算」(朝倉書店)p.10-15
!
do k=1,n-1  !a(k,k)を消去
do i=k+1,n  !k+1行からn行まで
do j=k+1,n    !k+1列からn列まで
   a(i,j)=a(i,j)-a(k,j)*a(i,k)/a(k,k)
end do
   b(i)=b(i)-b(k)*a(i,k)/a(k,k)
end do
end do
!
! 後退代入
x(n)=b(n)/a(n,n)
do k=n,1,-1
   akjxj=0.d0
do j=k+1,n
   akjxj=akjxj+a(k,j)*x(j)
end do
   x(k)=(b(k)-akjxj)/a(k,k)
end do
!
return
end
!
