! EUC-jp
! 文字コードはEUC-jp
! 自由形式のfortranで書いています。
! g77でコンパイルする場合は、
!g77 -ffree-form -o smv smv.f
! のようにコンパイルしてください。
! gfortran でコンパイルする場合は文字コードをutf-8にしてください。
!program daiya
implicit real*8 (a-h, o-z)
pi=2.d0*asin(1.d0)
r=1.d0/2.d0/pi !半径
h=0.5d0 !高さ
!波は点対称に出力される。l=0のときは1つ、l=1のときは2つとなる。
l=2 
m=12 !周方向分割数
n=8!高さ方向分割数 通常は偶数
nset=2*l*((n+1)*(m/4+1)-(n+1))+2*(n+1)*(m/4+1)-(n+1) !節点数
!nset=2*(l+1)*((n+1)*(m/4+1)-(n+1))+(n+1)*(m/4+1)-2*((n+1)*(m/4+1)-(n+1)) !節点数
nyou=(m*n)+(m*n/2)*(2*l-1)+(m*n/2) !周方向(偶数のとき)
       open(7,file='yousosuu.txt')
       write(7,*) nyou
       write(7,*) m,n,l
       close(7)
th=2.d0*pi/m !ダイヤ1つぶんの中心角
dh=h/n !ダイヤ三角1段ぶんの高さ(斜めになってるから三角形の高さではない)
!--------------------------------------------------------------------------------------
open(8,file='daiyahan16.obj')
write(8,'("3DG1")')
write(8,*) nset
!
!--------------------------------------------------------------------------------------
!ここから節点の出力
!端のダイヤカット
!1個目は節点を全て出力させるので別に出す。
do j=0,n   !高さ方向に
 do i=0,m/4 !円周方向に半回りずつ
!xyz座標を出力
zure=th/4.-(-1.d0)**j*th/4.
 write(8,*) r*cos(i*th+zure),r*sin(i*th+zure),j*dh
 end do
end do
!----------------------------------------------------------------------------------------
!1個目(前半)のダイヤカット
do k=0,l-1
 do j=0,n   !高さ方向に
  do i=0,m/4-1 !円周方向に半回りずつ
!xyz座標を出力
zure=th/4.-(-1.d0)**j*th/4.
write(8,*) r*cos(i*th+zure)*cos(pi/2)-r*sin(i*th+zure)*sin(pi/2)+2*r+2*r*k,&
&-r*cos(i*th+zure)*sin(pi/2)-r*sin(i*th+zure)*cos(pi/2)-2*r*k,j*dh
  end do
 end do
!----------------------------------------------------------------------------------------
!1個目(後半)のダイヤカット
 do j=0,n   !高さ方向に
  do i=0,m/4-1 !円周方向に半回りずつ
zure=th/4.-(-1.d0)**j*th/4.
write(8,*) r*cos(i*th+zure)+2*r*(k+1),r*sin(i*th+zure)-2*r*(k+1),j*dh
!xyz座標を出力
  end do
 end do
end do
!----------------------------------------------------------------------------------------
!
!点対称にするために1/4ダイヤカットを1つ分多く出力
!点対称にしたくないときは、ここをコメントにする。
do j=0,n
do i=0,m/4-1
zure=th/4.-(-1.d0)**j*th/4.
write(8,*) r*cos(i*th+zure)*cos(pi/2)-r*sin(i*th+zure)*sin(pi/2)+2*r+2*r*l,&
&-r*cos(i*th+zure)*sin(pi/2)-r*sin(i*th+zure)*cos(pi/2)-2*r*l,j*dh
end do
end do
!
!
!--------------------------------------------------------------------------------------
!ここから要素の出力
!1個目のダイヤカットの要素
!半周ずつ逆三角形と順三角形の頂点の節点を交互に外から見て左回りに出力
do j=0,n/2-1 !高さ方向
 do i=0,m/4-1 !周方向に
  !逆三角形の右上頂点、左上頂点、下頂点
  write(8,*) 3,(m/2+2)*j+i+1,(m/2+2)*j+i,(m/2+2)*j+i+m/4+1,' ','0xcccccc'
  !三角形の左下頂点、右下頂点、上
  write(8,*) 3,(m/2+2)*j+i+m/4+1,(m/2+2)*j+i+m/4+2,(m/2+2)*j+i+1,' ','0xcccccc'
 end do
 do i=0,m/4-1
  !三角形の左下頂点、右下頂点、上
  write(8,*) 3,(m/2+2)*j+(m/4-1)+i+m/4+3,(m/2+2)*j+(m/4-1)+i+m/4+4,(m/2+2)*j+i+m/4+1,' ','0xcccccc'
  !逆三角形の右上頂点、左上頂点、下頂点
  write(8,*) 3,(m/2+2)*j+i+m/4+2,(m/2+2)*j+i+m/4+1,(m/2+2)*j+(m/4-1)+i+m/4+4,' ','0xcccccc'
 end do 
end do
!
!----------------------------------------------------------------------------------------------------
!
!
!2個目以降の最初のダイヤカットの要素
!半周ずつ逆三角形と順三角形の頂点の節点を交互に外から見て左回りに出力
 do j=0,n/2-1 !高さ方向
  do i=0,m/4-2 !周方向に
!逆三角形の右上頂点、左上頂点、下頂点
   write(8,*) 3,(n+1)*(m/4+1)+(m/2)*j+i+1,(n+1)*(m/4+1)+(m/2)*j+i,&
   &(n+1)*(m/4+1)+(m/2)*j+i+m/4,' ','0xcccccc'
!三角形の左下頂点、右下頂点、上
   write(8,*) 3,(n+1)*(m/4+1)+(m/2)*j+i+m/4,(n+1)*(m/4+1)+(m/2)*j+i+m/4+1,&
   &(n+1)*(m/4+1)+(m/2)*j+i+1,' ','0xcccccc'
end do
!最後のエレメントはつながるので
!逆三角形の右上頂点、左上頂点、下頂点
   write(8,*) 3,(m/2+2)*j,(n+1)*(m/4+1)+(m/2)*j+i,&
   &(n+1)*(m/4+1)+(m/2)*j+i+m/4,' ','0xcccccc'
!三角形の左下頂点、右下頂点、上
   write(8,*) 3,(n+1)*(m/4+1)+(m/2)*j+i+m/4,(m/2+2)*j+m/4+1,&
   &(m/2+2)*j,' ','0xcccccc'
!---------------------------------------------------------------------------------------------
   do i=0,m/4-2
!三角形の左下頂点、右下頂点、上
   write(8,*)3,(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+i+m/4+1,(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+i+m/4+2,&
   &(n+1)*(m/4+1)+(m/2)*j+i+m/4,' ','0xcccccc'
!逆三角形の右上頂点、左上頂点、下頂点
   write(8,*)3,(n+1)*(m/4+1)+(m/2)*j+i+m/4+1,(n+1)*(m/4+1)+(m/2)*j+i+m/4,&
   &(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+i+m/4+2,' ','0xcccccc'
  end do
!最後のエレメントはつながるので
!三角形の左下頂点、右下頂点、上
  write(8,*)3,(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+i+m/4+1,(m/2+2)*j+(m/4-1)+m/4+3,&
  &(n+1)*(m/4+1)+(m/2)*j+i+m/4,' ','0xcccccc'
!逆三角形の右上頂点、左上頂点、下頂点
  write(8,*) 3,(m/2+2)*j+m/4+1,(n+1)*(m/4+1)+(m/2)*j+i+m/4,&  
  &(m/2+2)*j+(m/4-1)+m/4+3,' ','0xcccccc'
end do
!
!----------------------------------------------------------------------------------------------
!
!2個以降目のダイヤカットの要素
!半周ずつ逆三角形と順三角形の頂点の節点を交互に外から見て左回りに出力
do k=0,2*l-1
do j=0,n/2-1 !高さ方向
do i=0,m/4-2 !周方向に
!逆三角形の右上頂点、左上頂点、下頂点
  write(8,*)3,(n+1)*(m/4+1)+(m/2)*j+i+1+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+i+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+i+m/4+(k+1)*(n+1)*m/4,' ','0xcccccc'
!三角形の左下頂点、右下頂点、上
  write(8,*) 3,(n+1)*(m/4+1)+(m/2)*j+i+m/4+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+i+m/4+1+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+i+1+(k+1)*(n+1)*m/4,' ','0xcccccc'
end do
!最後のエレメントはつながるので
!逆三角形の右上頂点、左上頂点、下頂点
   write(8,*)3,(n+1)*(m/4+1)+(m/2)*j+k*(n+1)*m/4,&
   &(n+1)*(m/4+1)+(m/2)*j+i+(k+1)*(n+1)*m/4,&
   &(n+1)*(m/4+1)+(m/2)*j+i+m/4+(k+1)*(n+1)*m/4,' ','0xcccccc'
!三角形の左下頂点、右下頂点、上
   write(8,*)3,(n+1)*(m/4+1)+(m/2)*j+i+m/4+(k+1)*(n+1)*m/4,&
   &(n+1)*(m/4+1)+(m/2)*j+m/4+k*(n+1)*m/4,&
   &(n+1)*(m/4+1)+(m/2)*j+k*(n+1)*m/4,' ','0xcccccc'
!----------------------------------------------------------------------------------------
do i=0,m/4-2
  !三角形の左下頂点、右下頂点、上
  write(8,*)3,(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+i+m/4+1+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+i+m/4+2+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+i+m/4+(k+1)*(n+1)*m/4,' ','0xcccccc'
  !逆三角形の右上頂点、左上頂点、下頂点
  write(8,*) 3,(n+1)*(m/4+1)+(m/2)*j+i+m/4+1+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+i+m/4+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+i+m/4+2+(k+1)*(n+1)*m/4,' ','0xcccccc'
end do
!最後のエレメントはつながるので
!三角形の左下頂点、右下頂点、上
  write(8,*)3,(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+i+m/4+1+(k+1)*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+m/4+1+k*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+i+m/4+(k+1)*(n+1)*m/4,' ','0xcccccc'
!逆三角形の右上頂点、左上頂点、下頂点
  write(8,*) 3,(n+1)*(m/4+1)+(m/2)*j+m/4+k*(n+1)*m/4,&
  &(n+1)*(m/4+1)+(m/2)*j+i+m/4+(k+1)*(n+1)*m/4,&  
  &(n+1)*(m/4+1)+(m/2)*j+(m/4-1)+m/4+1+k*(n+1)*m/4,' ','0xcccccc'
!------------------------------------------------------------------------------------------
end do
end do
write(8,'("#")') !daiya.objファイルから要素数を読み取るとき用
close(8)
!
!
end
