MakeIni.f90 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117
  1. program makeinit
  2. implicit none
  3. integer :: nout = 20
  4. integer :: kcode = 138
  5. integer :: jx
  6. integer :: jy
  7. integer :: nx
  8. integer :: ny
  9. integer :: j1 = 20
  10. integer :: j2 = 24
  11. integer :: j3 = 39
  12. integer :: j4 = 43
  13. integer :: rr = 1
  14. real(8) :: pi
  15. real(8) :: dx
  16. real(8) :: dy
  17. real(8) :: amp = 16.0d0
  18. real(8), allocatable :: z(:,:)
  19. character( 80) :: arg
  20. character(256) :: fname
  21. call get_command_argument(1,arg)
  22. read(arg,*) nx
  23. ny = nx
  24. write (*,'("Allocate z(",i4,",",i4,")")') nx,ny
  25. allocate(z(nx,ny))
  26. pi = 4.0 * atan(1.0d0)
  27. dx = 2.0d0 * pi / nx
  28. dy = dx * 2.0d0
  29. rr = nx/64
  30. do jy = 1 , ny
  31. do jx = 1 , nx
  32. ! z(jx,jy) = &
  33. ! + 1.1 * cos((jx-1) * dx) &
  34. ! + 0.1 * sin((jy-1) * dx)
  35. ! z(jx,jy) = 0.0d0
  36. !
  37. ! z(jx,jy) = cos((jx-1) * dx +(jy-1) * dx)
  38. ! z(jx,jy) = 1.0 * cos((jx-1)*dx) + 3.0 * cos((jx-1)*dx*2.0) &
  39. ! + 10.0 * sin((jy-1) * dy) + 20.0 * sin((jy-1) * dy * 2.0)
  40. ! z(jx,jy) = 0.0d0
  41. ! if (jx > rr*j1-(rr-1) .and. jx < rr*j2-(rr-1)) then
  42. ! z(jx,jy) = amp
  43. ! endif
  44. ! if (jx > rr*j3-(rr-1) .and. jx < rr*j4-(rr-1)) then
  45. ! z(jx,jy) = -amp
  46. ! endif
  47. ! z(jx,jy) = z(jx,jy)*(1 + 0.1*sin((jy-1)*dx))
  48. z(jx,jy) = 0.0d0
  49. if (jy > rr*j1-(rr-1) .and. jy < rr*j2-(rr-1)) then
  50. z(jx,jy) = -amp
  51. endif
  52. if (jy > rr*j3-(rr-1) .and. jy < rr*j4-(rr-1)) then
  53. z(jx,jy) = amp
  54. endif
  55. z(jx,jy) = z(jx,jy)*(1 + 0.1*sin((jx-1)*dx))
  56. enddo
  57. enddo
  58. ! z(nx/2,ny/2) = 2.0
  59. call mk_fname(nx,kcode,fname,"GP")
  60. open(nout,file=fname,form='unformatted')
  61. write(nout) kcode,0,10101,0,nx,ny,0,0
  62. write(nout) z
  63. close(nout)
  64. stop
  65. end
  66. ! *###########################*
  67. ! * Functions and Subroutines *
  68. ! *###########################*
  69. ! ***********************
  70. ! * SUBROUTINE MK_FNAME *
  71. ! ***********************
  72. subroutine mk_fname(kgx,kcode,fname,gtp)
  73. character(2) :: gtp
  74. character(256) :: fname
  75. integer :: kcode,kgx
  76. if (kgx < 100) then
  77. write(fname,'(A2,I2.2,"_var",I4.4,".srv")') gtp,kgx,kcode
  78. elseif (kgx < 1000) then
  79. write(fname,'(A2,I3.3,"_var",I4.4,".srv")') gtp,kgx,kcode
  80. else
  81. write(fname,'(A2,I4.4,"_var",I4.4,".srv")') gtp,kgx,kcode
  82. endif
  83. fname = trim(fname)
  84. return
  85. end subroutine mk_fname