ユーマちゃんのブログ

質問・要望はTwitterもしくはコメントで。返信はTwitterで。

京大地球工学科国際コースについて【3】

 

国際コースに関する記事は移行しました

yuma2012.hateblo.jp

 

 

 

 

 

 

 

DMで質問が来たので回答と共にここに書いときます。3/13の説明会には多分僕も行くのでそこで聞いてもらっていいですし、DMでもどうぞ。

今年の説明会についてはここにある通りです。

https://www.s-ge.t.kyoto-u.ac.jp/int/ja/admission/bunzoku2018

 

Q. 「当日の面接内容は本人の意思確認と英語能力のチェック」とあるが、単に英検とかTOEIC持ってるか聞かれるのか、それとも英語で面接をして英語能力をチェックするってことなのか。

 

A. 主に面接だと思います。僕らの学年は僕も含めて外部の英語試験の結果を持ってる人はほぼいなかったはずです。英語で志望理由とかを聞かれます。僕らの時は4人ずつぐらいに分かれて、生徒4人vs教師4人(外国人教諭3+日本人のコース長教諭1人)でした。

 

希望数が10人より多い場合はそこで当落があります。その考慮の際に外部英語試験の結果も考慮に入れるのでしょう。ただ、殆どの人が持ってないはずなので、やはり主に面接で測られると思います。外部英語試験はあくまで参考程度かな、と。あるにこしたことはないけど。

 

僕らの年は6人しか入らなかったので面接はやったものの全員合格解散帰宅〜って感じでした。10人以上希望者がいた先輩達の面接とかぎどんな感じだったか詳しくは知りません。誰か教えてください。

終わり。

 

先輩より

面接は英語で答えるべきところを日本語で答えても通るしやっぱり熱意が大切なんじゃないかと思う。 英語能力はあんまり関係ないのかもしれない。2/28

→とのことです。

 

 

※余談

僕の英語力は中学生とあまり変わりません(今も昔も)。こんなに偉そうに喋ってるのに...

件の面接で「なぜ君はここに来たの?」と問われ、錯乱した僕は「My god said I should study here!」と答え、教授陣をフリーズさせ、周りの受験生の呆れと失笑を誘いましたが無事通りました。定員割れしてて良かった。

何が言いたいかと言うと、あまり臆せずに来てください。せめて説明会だけでも。僕より英語力ない人はいないのでそこら辺自信持ってこ。英語力なくてもゆーていけるって神様も言ってる。たぶん。

 

京大地球工学科国際コースについて【2】

国際コースに関する記事は移行しました

yuma2012.hateblo.jp

 

 

 

すっかり続きを書かぬまま、受験シーズン真っ盛りになってしまいました。ちなみに僕は明日の自動車免許本免試験に対する恐怖で夜も眠れません。眠れないので書きます。

 

まずはこれ見てください。

https://www.s-ge.t.kyoto-u.ac.jp/int/ja/admission/bunzoku2017

 

 

これは去年の国際コースの案内です。僕はこれ見て「とりま説明会だけ行ってやるか」というつもりで行って、そのまま流されて入りました。今年も受験生は貰ったのかな??よく読んでね。

 

僕もとりあえず読みなおしてみますか。

 

 

...ん?

 

 

あれ??

 

 

おかしいぞ...

 

 

「必要とされる語学力は、TOEFL-iBT 80 点、IELTS 6.0 点程度です。」

 

 

え?

 

 

 

 

 

俺IELTS5.5点だったやん...去年の10月時点で...

 

 

 

 

 

はい、とゆことで、興味を持たれた方はとりあえず説明会に来てくださいね!

 

 

京大のE2授業 難易度・感想etc... まとめ

今年度、というかこれからもずっと僕はE2授業とかいう英語の授業を取って卒業しなきゃいけないのです。せっかくなので、E2授業の感想をだらだらと書いておきたいと思います。というのも、多くの人がE2の単位を取るのに苦労するらしいので。人社と一部、統合について書きます。

 

人社

☆2017 前期☆

Japan's Political Economy 水3 (日本の政経

難易度 4.5/5.0

めんどくささ 4.5/5.0

面白さ 4.0/5.0

感想: 日系人の米人教授がスライドを使って授業をします。完全に座学。内容はいたって普通。戦後の日本の経済と政治について時系列的に追っていきます。まじめにやろうとするとくそ大変。まず、毎週大量に予習分のテキストを読まなきゃいけない。しかし、これをさぼってもいけるっちゃいける。が、たまーに小テスト(合計30点分)があるので注意。最終レポートが70点分。かなりきつい。英語2000字以上。ただし、日本語3000以上でもOKという神対応あり。どちらにせよ面倒くさい。ちなみに僕は小テスト24点、最終レポートが63点でしたが、5日遅れて出したので20点減点されました。おっぱい。

 

 

☆2017 後期☆

Introduction to Educational Studies 月1 (教育的な研究・入門?) 

難易度 3.0/5.0

めんどくささ 5.0/5.0

面白さ 3.0/5.0

感想: やったら課題が多い。毎週本読んでまとめノート作らなきゃいけないし、毎週授業のまとめを書いて出さなきゃいけない。期末テスト20点+課題&出席点80点。授業は先生が少し喋った後、配られた議題について考えてまず一人で書く。それを周りの人と話し合う。最後に教授が適当に生徒を指して意見を言わせる。これらの繰り返し。授業難易度は本当にふつう。話し合う内容も本当にふつう。個人的には月曜の1限から何やらくだらんこと話し合わなきゃいけなくてだるかった。朝に強い人。課題を出したら確実に単位は来るので、どうしても確実に取れる単位を選びたい人におすすめ。

 追記: 3回ぐらい授業ブッチ&ポートフォリオ適当だったために78点でした。んー、ビミョい。弛まぬ努力をもってコツコツやる人向けなんで、まぁ僕には向いてません。

 

Natural Disaster Science月2 (自然災害科学) (統合群)

難易度 3.0/5.0

めんどくささ 4.0/5.0

面白さ 4.0/5.0

感想: 課題多い。まず最初の数週間は全員、手書きの英語レポートをやたら書くように言われる。それは先生曰く履修制限の代わりなんだとか。結果、最初は30人以上いた教室も後半は10人弱に。また、この授業は日本人の英語特訓講座と化している面があるので、留学生たちは露骨に暇そうな感じである(実際、英語を喋れない人が喋るのを待つなどの無駄な時間がかなり多かった)。しかし、授業の内容自体はとても面白い。と、個人的には思う。

ストイックな方。英語を鍛えたい方などにおすすめ。

 追記: 少しレポート出さんかった&ブッチしたけど96点いただいた。たぶん、積極的な授業態度(笑)みたいのがかなり重視されてると思う。ローリスクハイリターンお菓子プリーズ。

 

 

Pedagogy 水1(教育学)

難易度 4.0/5.0

めんどくささ 3.0/5.0

面白さ 4.5/5.0

感想: 面白いE2人社として割と有名。内容は教育の話かと思いきや、ほとんどが宗教・歴史・哲学の話。実践的な教育の話はあまりしない。内容は超難しいけど内容はとても面白い。胸張ってお勧めできる人社。ただ、結構人数制限が厳しいので取るのが大変。単位はほぼ確実に取れるし、取れるようにしてくれる。課題もそんな大変じゃない。大変じゃないけど俺は案の定、最終レポートを一日遅れで出したので5点減点。

 追記: 結果は80点。レポートをちゃんと出せば数値上は85点だけど、相対評価によって評価は変わらない可能性が高い。たぶん殆どの人に単位来てるはず。起きれるかどうかが勝負。

 

 

Contemporary Management 水3(現代経営学?)

難易度 1.5/5.0

めんどくささ 2.0/5.0

面白さ 3.0/5.0

感想: まごうことなき楽単。二回に一回のペースででりゃ単位出るしもうこりゃ素晴らしい。内容は現代の経営について、例えば社員の働くMotivationとかの要素や関係性をレクチャーされる。そのあとにグループでその話題について話し合って、代表者が前に出て少し喋る。内容も議題も割と実生活に基づいて考えられるとっつきやすい内容が多いので、取り組みやすい。クラスはとてもでかく、100人くらいいたと思う。履修制限なし。E2単位がほしいなら絶対に取るべき。これより楽な単位は存在しないので、これで無理なら諦めてくださいって感じだ。

 追記: 結果、84点。最後のプレゼンで前日締切のファイルを提出し忘れたための失点によりおそらくA→Bになった。やたら最後だけ締切に厳しかったが、他の小レポート3回は遅れて出しても半分の点数をくれる。まぁ楽なのでさっさと期限通りに出すべき。大して大変じゃない。

 

 

Critical Thinking 水4(批判的思考)

難易度 2.5/5.0

めんどくささ 2.0/5.0

面白さ 2.5/5.0

感想: これも楽単。出席点がほとんど。最後に一時限だけディベートがあるが、全然まともなディベートとは程遠いので、気にしなくても大丈夫。授業は先生が用意した厚い教材のコピーを使って進める。内容は全て「議論の正しさ・確かさ」。たとえば、こういう論理の組み立て方はダメでこうすべき、演繹法の使い方、自分の論理を肯定する実例の挙げ方etc…など。論文やレポートを書く時のベースとなる「前提」みたいのが身につく。毎回、先生がランダムに生徒を指して、該当ページを音読(この時間、暇)。その後、そのテキストについている演習問題を個人でやる。最後に先生が適当に誰か指して答えさせる、という形式。その演習問題はほとんど答えが一意に決まらないものなので、それぞれが思い思いの発言をする。割と面白い。注意点としては、出てくる単語が結構むずかしい(それはそう)ので、ちゃんと調べた方がいい。

ちなみに変な小レポートが毎週のように出た。あまりにもしょーもなかったので気にも留めなかった結果、何度かやり忘れた。

 追記: 結果は96点。レポートは2.3回出さなかったけどA+来た。欠席回数ゼロがでかい。休まず出ればA+が取れるって考えれば楽勝。ゼロリスクハイリターン。今期のベストオブ楽単。

 

以上です。

なんか意外と書く内容薄かった。後半になるほど楽であることは確かだね。

なんにせよE2授業というのは出席点がでかいのがほとんどなので、通える時間に取れる授業を選ぶべきだと個人的には思います。ちなみに、テスト100%って人社はほとんどないです。またなんか質問があれば。人よりはE2授業のことは多少詳しいので。

Programming Example Report 14

program report14
implicit none
real(8)::t,k
real,parameter::TOL=1.0D-6
real(8),dimension(5)::NPV,s
integer::i

s(1)=0.0;s(2)=10.0;s(3)=15.0;s(4)=20.0;s(5)=25.0

do i=1,5
NPV(i)=forming(s(i))
End do

k=0.0
do while(forming(k)>=0)
k=k+TOL
enddo

write(*,'(T5,A,$)') "Rates of interest(%)"
write(*,'(T10,A)') "Net present values($)"
write(*,'(A)') repeat("=",55)

do i=1,5
write(*,'(T12,f5.2,T37,I10)') s(i),nint(NPV(i))
end do
write(*,'(A)') repeat("=",55)
write(*,'(A,F10.4,A)') "The internal rate of return is ", k,"%"

open(1,file="NPV.txt")
write(1,'(T5,A,$)') "Rates of interest(%)"
write(1,'(T10,A)') "Net present values($)"
write(1,'(A)') repeat("=",55)
do i=1,5
write(1,'(T12,f5.2,T37,I10)') s(i),nint(NPV(i))
end do
write(1,'(A)') repeat("=",55)
write(1,'(A,F10.4,A)') "The internal rate of return is ", k,"%"
close(1)

contains
function forming(t)
real(8)::forming,t,x
integer::i
x=t/100
forming=-300000+150000/(1+x)+150000/(1+x)**2+160000/(1+x)**3
end function forming

end program report14

! Result

! Rates of interest(%) Net present values($)
! =======================================================
! 0.00 160000
! 10.00 80541
! 15.00 49059
! 20.00 21759
! 25.00 -2080
! ============================================================
! The internal rate of return is 24.5366%

Programming Example 13

Program Least_squares
implicit none

! Global variables
integer, parameter:: m=4       ! Number of coefficient
real(8):: S(m)                 ! Array of coefficient S
real(8), parameter:: TOL=1D-6  ! Numerical tolerance
real(8), dimension(:), allocatable:: X, Y  ! Arrays of data X and Y

Call Initialization(X, Y, S)  ! read data from file
Call Processing(X, Y, S)      ! perform numerical analysis and display
Call Finalization(X, Y, S)    ! write data to file

contains

!================================================================================
Subroutine Initialization(X, Y, S)
! dummy variables
real(8), dimension(:), allocatable, INTENT(OUT):: X, Y
real(8), INTENT(OUT):: S(m)
! local variables
integer:: i, n, status=0
character(len=50):: filename
real(8):: r

write(*,'(A)') "Enter the title of input data with the file extension"
read(*,*) filename

open(1, file=filename)
n=0
do
  read(1, *, iostat=status) r
  if (status/=0) exit
  n=n+1
end do
allocate(X(n), Y(n))
rewind(1)
do i=1,n
   read(1, *) X(i), Y(i)
end do
close(1)

write(*,'(A)') "The input data"
write(*,'(2A10)') "Data X", "Data Y"
do i=1,n
   write(*,'(2F10.3)') X(i), Y(i)
end do

write(*,*) "The fitting function is Y = exp(-S1*X)*sin(S2*X)*S3+S4"
write(*,*) "In order to determine non-trivial fitting coefficients, intialial values are necessary."
do i = 1, m
 write(*, '(A, I1, A, $)') "Input the guessed value for S", i, " = "
 Read(*,*) S(i)
end do

end subroutine Initialization

!================================================================================
Subroutine Processing(X, Y, S)
! dummy variables
real(8), dimension(:), INTENT(IN):: X, Y
real(8), INTENT(INOUT):: S(m)
! local variables
integer:: i, k, k_max=50 ! iteration number and maximum iteration number
! Norm of errors, vector residuals and Hessian matrix
real(8):: err, R(m), H(m,m)

write(*, '(A)') repeat('-',10*m+30)
write(*,'(A10, $)') "Iteration"
do i=1, m
 write(*,'(A9, I1, $)') "S", i
end do
write(*,'(A20)') "Norm of residuals"
write(*, '(A)') repeat('-',10*m+30)

R=Residual_vector(X, Y, S)
err=sqrt(dot_product(R,R))
k=0
write(*,'(I10, $)') k
do i=1, m
  write(*,'(F10.3, $)') S(i)
  end do
write(*,'(E20.3)') ERR
do while *1
  k=k + 1
  H=Hessian_matrix(X, Y, S) !This caluclates the Hessian wrt X,Y,S
  S=S-matmul(Minverse(H),R) !This remakes S. S=S- [Hessian]**(-1) × RessidualMatrix
  R=Residual_vector(X, Y, S) !Remakes R with new S.
  err=sqrt(dot_product(R,R)) !Remakes ERR with new ResidualVector
  write(*,'(I10, $)') k
  do i=1, m
    write(*,'(F10.3, $)') S(i)
    end do
  write(*,'(E20.3)') ERR
end do
if (k==k_max) then
   write(*,*) "Divergence!"; STOP
end if
write(*, '(A)') repeat('-',10*m+30)

end Subroutine Processing

!================================================================================
Subroutine Finalization(X, Y, S)
! dummy variables
real(8), dimension(:), INTENT(IN):: X, Y
real(8), INTENT(IN):: S(m)
! local variables
Integer:: i, n
character(len=50):: filename

n=size(X) ! rows of vector X
write(*,'(A)') "Enter the title of output data with the file extension"
read(*,*) filename

open(2, file=filename)
write(*,'(A)') "The output data"
write(*,'(2A10)') "Data X", "Fitting Y"
do i=1,n
   write(*,'(2F10.3)') X(i), Fit(X(i),S)
   write(2,'(2F10.3)') X(i), Fit(X(i),S)
end do

write(*, '(A, F10.3)') "Sum square of errors of the converged result is ", SSE(X, Y, S)
write(*,'(A, A, $)') "The output data have been successfully written to the file ", filename
close(2)

end Subroutine Finalization

!--------------------------------------------------------------------------------
Function SSE(X, Y, C) ! Sum Square Errors
real(8), dimension(:):: X, Y
real(8):: SSE, C(m) ! sum square of residual and coefficient array
integer:: i, n

n = size(X)    ! The size of array X
SSE = 0
do i = 1, n
   SSE = SSE + ( fit(X(i),C) - Y(i) )**2
end do

end Function SSE

!--------------------------------------------------------------------------------
Function Fit(z, C)
real(8):: Fit, z, C(m)

Fit = exp(-C(1)*z)*sin(C(2)*z)*C(3)+C(4)

end Function Fit

!--------------------------------------------------------------------------------
Function Residual_vector(X, Y, C)
real(8), dimension(:):: X, Y
real(8):: Residual_vector(m), C(m), C_(m)
integer:: i

do i = 1, m
   C_ = C; C_(i) = C(i) + TOL
   Residual_vector(i) = ( SSE(X, Y, C_) - SSE(X, Y, C) ) / TOL
end do
end Function Residual_vector


!--------------------------------------------------------------------------------
Function Hessian_matrix(X, Y, C)
real(8), dimension(:):: X, Y
real(8):: Hessian_matrix(m,m), C(m), C_(m), v(m), v_(m)
integer:: i,j

do i = 1, m
   do j = 1, m
      C_ = C; C_(j) = C(j) + TOL
      v_ = Residual_vector(X, Y, C_)
      v  = Residual_vector(X, Y, C)
      Hessian_matrix(i,j) = ( v_(i) - v(i) ) / TOL
   end do
end do

end Function Hessian_matrix

!--------------------------------------------------------------------------------
Function Minverse(A)
real(8), dimension(:,:):: A ! Allow both static/dynamic memory allocation
real(8), dimension(:,:), allocatable:: Minverse, B, V
real(8), dimension(:), allocatable:: temp
real(8), parameter:: TOL=1D-6
real(8):: pivot
integer:: i, j, jmax, k, n

n=size(A)**0.5
allocate(Minverse(n,n), B(n,n), V(n,n), temp(n))
B=A
V(:,:)=0.
do i=1, n; V(i,i)=1.; end do

do i=1, n
   jmax=i

!===== Maximum pivoting technique =====

   do j=i+1, n
      if (abs(B(j,i))>abs(B(jmax,i))) then
         jmax=j
         temp=B(i,:); B(i,:)=B(jmax,:); B(jmax,:)=temp
         temp=V(i,:); V(i,:)=V(jmax,:); V(jmax,:)=temp
       end if
   end do

!===== Gauss-Jordan elimination =====

   pivot=B(i,i)
   if (abs(pivot)<TOL) then
      print *, "The matrix is singular!"
      stop
   end if
   B(i,:)=B(i,:)/pivot; V(i,:)=V(i,:)/pivot

   do k=1, n
      pivot=B(k,i)
      if (k/=i) then
         B(k,:)=B(k,:)-pivot*B(i,:)
         V(k,:)=V(k,:)-pivot*V(i,:)
      end if
   end do

end do

Minverse=V

end function Minverse

End Program

*1:err>TOL).and.(k<k_max

Programming Example 12 日本語解説版(未完)

Program nonlinear_system
! Global variables
integer, parameter:: m=3      ! Maximum number of variables
real(8):: S(m), H(m,m)    ! Unknown variable vector S
real(8), parameter:: TOL=1D-6 ! Numerical tolerance

Call Guess(S)
Call Solve(S)

contains

Function Residual(x) !ここでは計算したい方程式を設定します。
  real(8):: Residual(m), x(m)
  Residual(1)=-x(1)+2*x(2)+x(3)-2
  Residual(2)=2*( (x(1)+3)**2) + 5*x(2)**2- (x(3)+1)**2
  Residual(3)=(x(1)-5)*(x(2)+2) + 3
  !以降、Residual(x)を使ったときはその時点でのx(1),x(2),x(3)が
  !それぞれ代入されて、新しいResiudal(1),(2),(3)が作られます。
  !目標はこの方程式を解くこと。つまり、Residual=0になるx(1),(2),(3)を
  !見つけることです。以降の操作で少しづつResidualは0に近づくはずです。
end Function Residual

Function Hessian(x)  !ここでは偏微分を計算します。
  real(8):: Hessian(m,m), x(m), x_(m), v(m), v_(m)
  integer:: i,j
  do i = 1, m
     do j = 1, m

        x_=x

        x_(j) = x(j) + TOL ! 1
        v_ = Residual(x_)   ! 2
        v = Residual(x)     ! 3
        Hessian(i,j) = ( v_(i) - v(i) ) / TOL ! 4
        !ここに書かれていることはいたってシンプルで簡単。
        !f' = (f(x+TOL)-f(x))/TOL を計算するだけ
        !1. x_(1)~x_(3)はx(1)~x(3)に1D-6を足す。
        !2. それぞれResidualに入れる。
        !3. vとv_を作る
        !4. (v_(i)-v(i))/TOL = 微分結果
        ! 上の微分結果をHessian行列に格納。
     end do
  end do
end Function Hessian

Subroutine Guess(x) !ここはインプットを行うセクション。
  real(8), INTENT(OUT):: x(m) ! dummy variables
  Integer:: i 

  Write(*,*) "Nonlinear system of", m, "equations"
  do i = 1, m
    write(*, '(A, I2, A)', advance="no") "Input the guessed value no.", i, " = "
    Read(*,*) x(i)
  end do
  ! 繰り返し作業において、初期値は自分で用意しなきゃいけないので、ここで
  ! x(1)~(3)の初期値を読み込みます。
End Subroutine Guess

Subroutine Solve(x) !ここはコアの計算部分
  real(8), INTENT(INOUT):: x(m) ! dummy variables
  Integer, parameter:: k_max=50 ! Maximum iteration number
  Integer:: k, n
  real(8):: err, R(m), H(m,m),Minv(m,m)

  !ここはディスプレイに文字を表示するだけのゾーン。
  write(*,'(A10, $)') "Iteration"
  do i=1, m
    write(*,'(A9, I1,$)') "x", i
  end do
  write(*,'(A20)') "Norm of errors"
  write(*, '(A)') repeat('-',60) 

  !ここからが大事なゾーン
  !ここは最初の作業。一項目をループ外に行ってるだけ。
  !もちろん後のループの中にも同じ内容があります。
  R = Residual(x) !一項目を最初の方程式に入れ、Rに代入。
  err=sqrt(dot_product(R,R))
  k=0
  write(*,'(I10, $)') k
  do i=1, m
    write(*,'(F10.3, $)') x(i)
  end do
  write(*,'(E20.3)') ERR

  do while ( (err>TOL).and.(k<k_max))
     k= k + 1 !カウンター
     H=Hessian(x) !1. Get Hessian matrix as H using Hessian Function
     Minv=Minverse(H) !2. Get inverse of Hessian matrix using Minverse Function
     x=x-matmul(Minv,R) !3. Update x
     R = Residual(x) !4. Set Residual matrix as R again.
     err=sqrt(dot_product(R,R)) !5.Set error.
     write(*,'(I10, $)') k !6. あとは書くだけ
     do i=1, m
       write(*,'(F10.3, $)') x(i)
     end do
     write(*,'(E20.3)') err
  end do
  if (k==k_max) then
    print*, "Divergence!";stop
  end if
  write(*, '(A)') repeat('-',60)
End Subroutine Solve

function Minverse(A)
  real(8), dimension(:,:):: A
  real(8), dimension(:,:), allocatable:: Minverse, B, V
  real(8), dimension(:), allocatable:: temp
  real(8), parameter:: TOL=1D-6
  real(8):: pivot
  integer:: i, j, jmax, k, n,l
  n=size(A)**0.5
  allocate(Minverse(n,n),B(n,n),V(n,n),temp(n))
  B=A
  V(:,:)=0.0
  do i=1, n
    V(i,i)=1.0
  end do
  do i=1, n
    jmax=i
    do j=i+1, n
      if (abs(B(j,i))>abs(B(jmax,i))) then
        jmax=j
        temp=B(i,:);B(i,:)=B(jmax,:);B(jmax,:)=temp
        temp=V(i,:);V(i,:)=V(jmax,:);V(jmax,:)=temp
      end if
    end do
    pivot=B(i,i)
    if (abs(pivot)<TOL) then
      print *, "The matrix is singular!"
    end if
    B(i,:)=B(i,:)/pivot
    V(i,:)=V(i,:)/pivot
    do k =1,n
      if (i .ne. k) then
        pivot=B(k,i)
        do l=1,n
          B(k,l)=B(k,l)-B(i,l)*pivot
          V(k,l)=V(k,l)-V(i,l)*pivot
        end do
      end if
    enddo
  end do
  Minverse=V
end function Minverse
end Program nonlinear_system

Programming Example 12

Red characters are codes I wrote by myself today. 2018/01/05

But these can be changed like below using "matmul".

 

---------------------------------------------------------------------

  do while ( (err>TOL).and.(k<k_max) )
     k= k + 1
     H=Hessian(x) !Get Hessian matrix as H using Hessian Function
     Minv=Minverse(H) !Get inverse of Hessian matrix using Minverse Function
     x=x-matmul(Minv,R) ! Update x
     R = Residual(x) !Set Residual matrix as R.

     err=sqrt(dot_product(R,R))
     write(*,'(I10, $)') k
     do i=1, m
       write(*,'(F10.3, $)') x(i)
     end do
     write(*,'(E20.3)') err
  end do

---------------------------------------------------------------------

This is the main code.

------------------------------------------------------------------------

 

Program nonlinear_system
! Global variables
integer, parameter:: m=3      ! Maximum number of variables
real(8):: S(m), H(m,m)    ! Unknown variable vector S
real(8), parameter:: TOL=1D-6 ! Numerical tolerance

Call Guess(S)
Call Solve(S)

contains

Function Residual(x)
  real(8):: Residual(m), x(m)
  Residual(1)=-x(1)+2*x(2)+x(3)-2
  Residual(2)=2*( (x(1)+3)**2) + 5*x(2)**2- (x(3)+1)**2
  Residual(3)=(x(1)-5)*(x(2)+2) + 3
end Function Residual

Function Hessian(x)
  real(8):: Hessian(m,m), x(m), x_(m), v(m), v_(m)
  integer:: i,j
  do i = 1, m
     do j = 1, m
        x_ = x; x_(j) = x(j) + TOL ! Perturb x
        v_ = Residual(x_)
        v = Residual(x)
        Hessian(i,j) = ( v_(i) - v(i) ) / TOL
     end do
  end do
end Function Hessian

Subroutine Guess(x)
  real(8), INTENT(OUT):: x(m) ! dummy variables
  Integer:: i

  Write(*,*) "Nonlinear system of", m, "equations"
  do i = 1, m
    write(*, '(A, I2, A)', advance="no") "Input the guessed value no.", i, " = "
    Read(*,*) x(i)
  end do
End Subroutine Guess

Subroutine Solve(x)
  real(8), INTENT(INOUT):: x(m) ! dummy variables
  ! local variables
  Integer, parameter:: k_max=50 ! Maximum iteration number
  Integer:: k, n
  real(8):: err, R(m), H(m,m),Minv(m,m),rs(m)

  write(*,'(A10, $)') "Iteration"
  do i=1, m
    write(*,'(A9, I1,$)') "x", i
  end do
  write(*,'(A20)') "Norm of errors"
  write(*, '(A)') repeat('-',60)

  R = Residual(x)
  err=sqrt(dot_product(R,R))
  k=0
  write(*,'(I10, $)') k
  do i=1, m
    write(*,'(F10.3, $)') x(i)
  end do
  write(*,'(E20.3)') ERR

  do while ( (err>TOL).and.(k<k_max) )
     k= k + 1
     H=Hessian(x) !Get Hessian matrix as H using Hessian Function
     Minv=Minverse(H) !Get inverse of Hessian matrix using Minverse Function
     R = Residual(x) !Set Residual matrix as R.
     rs=0.0
     do i =1,m
       do j =1,m
         rs(i)=rs(i)+Minv(i,j)*R(j) !Get H(x_k)[-1]*r(x_k)
       end do
       x(i)=x(i)-rs(i) !Set New x
     end do

     R = Residual(x) !Set Residual matrix as R again.
     err=sqrt(dot_product(R,R))
     write(*,'(I10, $)') k
     do i=1, m
       write(*,'(F10.3, $)') x(i)
     end do
     write(*,'(E20.3)') err
  end do
  if (k==k_max) then
    print*, "Divergence!"
  end if
  write(*, '(A)') repeat('-',60)
End Subroutine Solve

function Minverse(A)
  real(8), dimension(:,:):: A
  real(8), dimension(:,:), allocatable:: Minverse, B, V
  real(8), dimension(:), allocatable:: temp
  real(8), parameter:: TOL=1D-6
  real(8):: pivot
  integer:: i, j, jmax, k, n,l
  n=size(A)**0.5
  allocate(Minverse(n,n),B(n,n),V(n,n),temp(n))
  B=A
  V(:,:)=0.0
  do i=1, n
    V(i,i)=1.0
  end do
  do i=1, n
    jmax=i
    do j=i+1, n
      if (abs(B(j,i))>abs(B(jmax,i))) then
        jmax=j
        temp=B(i,:);B(i,:)=B(jmax,:);B(jmax,:)=temp
        temp=V(i,:);V(i,:)=V(jmax,:);V(jmax,:)=temp
      end if
    end do
    pivot=B(i,i)
    if (abs(pivot)<TOL) then
      print *, "The matrix is singular!"
    end if
    B(i,:)=B(i,:)/pivot
    V(i,:)=V(i,:)/pivot
    do k =1,n
      if (i .ne. k) then
        pivot=B(k,i)
        do l=1,n
          B(k,l)=B(k,l)-B(i,l)*pivot
          V(k,l)=V(k,l)-V(i,l)*pivot
        end do
      end if
    enddo
  end do
  Minverse=V
end function Minverse
end Program nonlinear_system