c  From: "COMPUTATIONAL PHYSICS, 2nd Ed" 
c  by RH Landau, MJ Paez, and CC Bordeianu 
c  Copyright Wiley-VCH, 2007.
c  Electronic Materials copyright: R Landau, Oregon State Univ, 2007;
c  MJ Paez, Univ Antioquia, 2007; and CC Bordeianu, Univ Bucharest, 2007.
c  Support by National Science Foundation                             
c    	
c  twodsol.f:  Solves the sine-Gordon equation for a 2D soliton 
c
      Program twodsol
			
        Implicit None
        Double Precision u(201, 201, 3)
        Integer nint
				
        Open(9, file = 'twodsol.dat', status = 'new')
        Write(*, *)'   Enter an integer from 1 to 100'
        Write(*, *)' this number is proportional to time'
        Write(*, *)'   time = 0 is for the integer = 1'
        Read(*, *)nint
        Write(*, *)'working with input = ', nint
c                                                      initialization
        Call initial(u)
c                               solution at time proportional to nint
        Call solution(u, nint)
        Stop
      End
      
      Subroutine initial(u)
			
c                          initializes the constants and 2-D soliton
        Implicit None
        Double Precision u(201,201,3), dx, dy, dt, xx, yy, dts, time
        Integer i, j
        Common /values/dx, dy, dt, time, dts    
c                                 initial condition for all xy values
        dx = 14.d0/200.d0
        dy = dx
        dt = dx/dsqrt(2.d0)
        dts = (dt/dx)**2
        yy = -7.d0
        time = 0.d0
        Do 10 i = 1, 201
          xx = -7.d0
          Do 20 j = 1, 201
            u(i, j, 1) = 4.d0*Datan(3.d0-sqrt(xx*xx+yy*yy))
            xx = xx+dx
 20       Continue
          yy = yy+dy
 10     Continue
        Return 
      End

      Subroutine solution(u, nint)
			
c       solves SGE for initial conditions in routine initial.    
        Implicit None  
      Double Precision u(201,201,3), dx, dy, dt, time, a2,zz, dts, a1
        Integer l, m, mm, k, j, i, nint
        Common /values/dx, dy, dt, time, dts
c                              these values passed by routine initial
        time = time+dt
c          2nd iteration using d phi/dt = 0 at t = 0 (G(x, y, 0) = 0)
c                               and d U/dx = 0 at -x0, x0, -y0 and y0
        Do 80 l = 2, 200
          Do 90 m = 2, 200
            a2 = u(m+1, l, 1)+u(m-1, l, 1)+u(m, l+1, 1)+u(m, l-1, 1)
            u(m, l, 2) = 0.5*(dts*a2-dt*dt*Dsin(0.25d0*a2))
 90       Continue
 80     Continue
c                                         borders in second iteration
        Do 130 mm = 2, 200
          u(mm, 1, 2) = u(mm, 2, 2)
          u(mm, 201, 2) = u(mm, 200, 2)
          u(1, mm, 2) = u(2, mm, 2)
          u(201, mm, 2) = u(200, mm, 2)
 130    Continue
c                                               still undefined terms
        u(1, 1, 2) = u(2, 1, 2)
        u(201, 1, 2) = u(200, 1, 2)
        u(1, 201, 2) = u(2, 201, 2)
        u(201, 201, 2) = u(200, 201, 2) 
        Do 100 k = 1, nint
          Do 60 l = 2, 200
            Do 70 m = 2, 200
              a1 = u(m+1, l, 2)+u(m-1, l, 2)+u(m, l+1, 2)+u(m, l-1,2)
              u(m, l, 3) = -u(m, l, 1)+dts*a1-dt*dt*Dsin(0.25d0*a1)
              u(m, 1, 3) = u(m, 2, 3)
              u(m, 201, 3) = u(m, 200, 3) 
 70         Continue
 60       Continue
          Do 140 mm = 2, 200
            u(mm, 1, 3) = u(mm, 2, 3)
            u(mm, 201, 3) = u(mm, 200, 3)
            u(1, mm, 3) = u(2, mm, 3)
            u(201, mm, 3) = u(200, mm, 3)
 140      Continue
          u(1, 1, 3) = u(2, 1, 3)
          u(201, 1, 3) = u(200, 1, 3)
          u(1, 201, 3) = u(2, 201, 3)
          u(201, 201, 3) = u(200, 201, 3)
c                                                         new i-> old
          Do 110 l = 1, 201
            Do 120 m = 1, 201
              u(l, m, 1) = u(l, m, 2)
              u(l, m, 2) = u(l, m, 3)
 120        Continue
 110      Continue
c                                output at times proportional to nint
          IF (k .eq. nint) Then
          Do 30 i = 1, 201, 5
            Do 40 j = 1, 201, 5
              zz = Dsin(u(i, j, 3)/2.d0)
              Write(9, *)zz
 40         Continue
c     the three xxx are to separate spatial rows for 3D plotting,
c     they must be replaced by blank lines (not carriage Returns) 
            Write(9, *)'xxx'
 30       Continue
        EndIF
        time = time+dt
 100    Continue
        Return
      End