! EUC-jp ! 文字コードはEUC-jp ! 自由形式のfortranで書いています。 ! g77でコンパイルする場合は、 !g77 -ffree-form -o smv smv.f ! のようにコンパイルしてください。 ! gfortran でコンパイルする場合は文字コードをutf-8にしてください。 !折り畳み4段のプログラムを高さ方向分割数を変えれるようにした。(08/11/19) implicit real*8 (a-h, o-z) pi=2.d0*asin(1.d0) syu=1.8d-1 !円周 r=syu/2.d0/pi !半径。円周が36cmということ zure=0.5 !高さ方向のずれ m=8!周方向分割数 n=8!高さ方向分割数 h=6.d-2 !高さ dh=5.9d-2/n !ダイヤ三角1段ぶんの高さ(斜めになってるから三角形の高さではない) psi=asin(dh/(h/n)) !!! orih=h/n*cos(psi) !orih=sqrt((h/n)**2-(dh)**2) nset=3*m+3*m/2*(n-1) !節点数 nyou=3*m*n !要素数 open(7,file='yousosuu.txt') write(7,*) nyou write(7,*) m,n close(7) th=2.d0*pi/m !ダイヤ1つぶんの中心角 ph=(pi-th)/2. !多角形の1辺と中心を結ぶ三角形の底角 oh=pi/2.-th !多角形の1辺と中心を結ぶ三角形の底角 !ccccccccccccccccccccc sita=orih/cos(oh)*2 ue=orih*tan(oh)*2 b=((ue-sita)/2)+(syu/m) !ensyu=((b+sita)*m/2.)+((b-ue)*m/2.) hank=b/(2*sin(th/2)) !cccccccccccccccccccccc open(8,file='tubusub.obj') write(8,'("3DG1")') write(8,*) nset x1=hank*cos(ph)+orih/sin(th) y1=hank*sin(ph) x2=hank*cos(ph)-orih/tan(th) y2=hank*sin(ph)+orih uegawa=1. !同じ段で上側を向いているか下側を向いているかを正負で区別 do i=0,m-1 !円周方向に1回りずつ !xyz座標を出力 !上側右三角形の左下頂点、上、右下頂点を出して、 !thずつ座標変換で回転させる thi=th*real(i) j=1 !1段め if(uegawa>0) then !上側を向いている場合、右三角形の上頂点だけz座標をdh下げる write(8,*) sin(thi)*y1, cos(thi)*y1, (j-1)*dh call zahen(thi,th1,orih,x1,y1,x2,y2,x1d,y1d,x2d,y2d,x3d,y3d) write(8,*) x1d,y1d,(j-1)*dh write(8,*) x2d,y2d,j*dh else !下側を向いている場合、右三角形の左右下頂点をdh下げる。上頂点は下げない。 write(8,*) sin(thi)*y1, cos(thi)*y1, j*dh call zahen(thi,th1,orih,x1,y1,x2,y2,x1d,y1d,x2d,y2d,x3d,y3d) write(8,*) x1d,y1d,j*dh write(8,*) x2d,y2d,(j-1)*dh endif uegawa=uegawa*(-1.) end do ! ! 2段め j=2 do i=0,m-2,2 !円周方向に1回りずつだけど1段めと節点を共有しないのは、 !下側右三角形の左下頂点とそれからth回転した上側中三角形の左右上頂点。 !この3頂点をthずつm/2回回転させればいいんでステップが2になってる。 thi=th*real(i) th1=th*real(i+1) !下側右三角形からth回転した上側中三角形の頂点用 write(8,*) sin(thi)*y1, cos(thi)*y1, j*dh call zahen(thi,th1,orih,x1,y1,x2,y2,x1d,y1d,x2d,y2d,x3d,y3d) write(8,*) x1d,y1d,j*dh write(8,*) x3d,y3d,j*dh end do ! ! dansuu=1. !同じ段で上側を向いているか下側を向いているかを正負で区別 do j=3,n !円周方向に1回りずつ if(dansuu>0) then !上側を向いている場合、右三角形の上頂点だけz座標をdh下げる ! ! 3段め do i=0,m-2,2 !円周方向に1回りずつだけど2段めと節点を共有しないのは、 thi=th*real(i) th1=th*real(i+1) ! call zahen(thi,th1,orih,x1,y1,x2,y2,x1d,y1d,x2d,y2d,x3d,y3d) write(8,*) x2d,y2d,j*dh write(8,*) sin(th1)*y1, cos(th1)*y1, j*dh write(8,*) cos(th1)*x1+sin(th1)*y1,-sin(th1)*x1+cos(th1)*y1, j*dh end do ! else ! 4段め do i=0,m-2,2 !円周方向に1回りずつだけど3段めと節点を共有しないのは、 thi=th*real(i) th1=th*real(i+1) ! write(8,*) sin(thi)*y1, cos(thi)*y1, j*dh call zahen(thi,th1,orih,x1,y1,x2,y2,x1d,y1d,x2d,y2d,x3d,y3d) write(8,*) x1d,y1d,j*dh write(8,*) x3d,y3d,j*dh end do ! endif dansuu=dansuu*(-1.) end do ! ! !1周ずつ上側三形と下側三角形の頂点の節点を外から見て左回りに出力 !do j=0,n-1 !高さ方向 !1段め do i=0,m-2,2 !周方向に if(i/=m-2) then !周の開始から一つ前まで !上側右三角形の左下頂点、右下頂点、上頂点 write(8,*) 3,i*3,i*3+1,i*3+2,' ','0xcccccc' !下側左三角形の左下頂点、上頂点、右下頂点(下から見て左回り) write(8,*) 3,i*3+2,i*3+1,i*3+3,' ','0xaaaccc' !下側中三角形の左上頂点、右上頂点、下(下から見て左回り) write(8,*) 3,i*3+1,i*3+5,i*3+3,' ','0xaaaccc' !下側右三角形の左下頂点、上、右下頂点(下から見て左回り) write(8,*) 3,i*3+3,i*3+5,i*3+4,' ','0xaaaccc' !上側左三角形の左下頂点、右下頂点、上 write(8,*) 3,i*3+5,i*3+6,i*3+4,' ','0xcccccc' !上側中三角形の左上頂点、下、右上頂点 write(8,*) 3,i*3+4,i*3+6,i*3+8,' ','0xcccccc' else !周の一番最後は、開始点の頂点とくっつくように !上側右三角形の左下頂点、右下頂点、上頂点 write(8,*) 3,i*3,i*3+1,i*3+2,' ','0xcccccc' !下側左三角形の左下頂点、上頂点、右下頂点(下から見て左回り) write(8,*) 3,i*3+2,i*3+1,i*3+3,' ','0xaaaccc' !下側中三角形の左上頂点、右上頂点、下(下から見て左回り) write(8,*) 3,i*3+1,i*3+5,i*3+3,' ','0xaaaccc' !下側右三角形の左下頂点、上、右下頂点(下から見て左回り) write(8,*) 3,i*3+3,i*3+5,i*3+4,' ','0xaaaccc' !上側左三角形の左下頂点、右下頂点、上 write(8,*) 3,i*3+5,0,i*3+4,' ','0xcccccc' !上側中三角形の左上頂点、下、右上頂点 write(8,*) 3,i*3+4,0,2,' ','0xcccccc' end if end do !end do ! ! !2段め do i=0,m-2,2 !周方向に i2=i/2 if(i/=m-2) then !周の開始から一つ前まで !上側左三角形の左下頂点、右下頂点、上 write(8,*) 3,i*3+2,i*3+3,m*3+i2*3+1,' ','0xcccccc' !上側中三角形の左上頂点、下、右上頂点 write(8,*) 3,m*3+i2*3+1,i*3+3,m*3+i2*3+2,' ','0xcccccc' !上側右三角形の左下頂点、右下頂点、上頂点 write(8,*) 3,i*3+3,i*3+4,m*3+i2*3+2,' ','0xcccccc' !下側左三角形の左下頂点、上頂点、右下頂点(下から見て左回り) write(8,*) 3,m*3+i2*3+2,i*3+4,m*3+i2*3+3,' ','0xaaaccc' !下側中三角形の左上頂点、右上頂点、下(下から見て左回り) write(8,*) 3,i*3+4,i*3+8,m*3+i2*3+3,' ','0xaaaccc' !下側右三角形の左下頂点、上、右下頂点(下から見て左回り) write(8,*) 3,m*3+i2*3+3,i*3+8,m*3+i2*3+4,' ','0xaaaccc' else !周の一番最後は、開始点の頂点とくっつくように !上側左三角形の左下頂点、右下頂点、上 write(8,*) 3,i*3+2,i*3+3,m*3+i2*3+1,' ','0xcccccc' !上側中三角形の左上頂点、下、右上頂点 write(8,*) 3,m*3+i2*3+1,i*3+3,m*3+i2*3+2,' ','0xcccccc' !上側右三角形の左下頂点、右下頂点、上頂点 write(8,*) 3,i*3+3,i*3+4,m*3+i2*3+2,' ','0xcccccc' !下側左三角形の左下頂点、上頂点、右下頂点(下から見て左回り) write(8,*) 3,m*3+i2*3+2,i*3+4,m*3,' ','0xaaaccc' !下側中三角形の左上頂点、右上頂点、下(下から見て左回り) write(8,*) 3,i*3+4,2,m*3,' ','0xaaaccc' !下側右三角形の左下頂点、上、右下頂点(下から見て左回り) write(8,*) 3,m*3,2,m*3+1,' ','0xaaaccc' end if end do ! dansuu=1. do j=0,n-3 if(dansuu>0) then ! !3段め do i=0,m-2,2 !周方向に i2=i/2 nh1=m*3*j/2 if(i/=m-2) then !周の開始から一つ前まで !下側中三角形の左上頂点、右上頂点、下(下から見て左回り) write(8,*) 3,nh1+m*3+i2*3+1,nh1+m*3+i2*3+2,nh1+m*4+m/2+i2*3+1,' ','0xaaaccc' !下側右三角形の左下頂点、上、右下頂点(下から見て左回り) write(8,*) 3,nh1+m*4+m/2+i2*3+1,nh1+m*3+i2*3+2,nh1+m*4+m/2+i2*3+2,' ','0xaaaccc' !上側左三角形の左下頂点、右下頂点、上 write(8,*) 3,nh1+m*3+i2*3+2,nh1+m*3+i2*3+3,nh1+m*4+m/2+i2*3+2,' ','0xcccccc' !上側中三角形の左上頂点、下、右上頂点 write(8,*) 3,nh1+m*4+m/2+i2*3+2,nh1+m*3+i2*3+3,nh1+m*4+m/2+i2*3+3,' ','0xcccccc' !上側右三角形の左下頂点、右下頂点、上頂点 write(8,*) 3,nh1+m*3+i2*3+3,nh1+m*3+i2*3+4,nh1+m*4+m/2+i2*3+3,' ','0xcccccc' !下側左三角形の左下頂点、上頂点、右下頂点(下から見て左回り) write(8,*) 3,nh1+m*4+m/2+i2*3+3,nh1+m*3+i2*3+4,nh1+m*4+m/2+i2*3+4,' ','0xaaaccc' else !周の一番最後は、開始点の頂点とくっつくように !下側中三角形の左上頂点、右上頂点、下(下から見て左回り) write(8,*) 3,nh1+m*3+i2*3+1,nh1+m*3+i2*3+2,nh1+m*4+m/2+i2*3+1,' ','0xaaaccc' !下側右三角形の左下頂点、上、右下頂点(下から見て左回り) write(8,*) 3,nh1+m*4+m/2+i2*3+1,nh1+m*3+i2*3+2,nh1+m*4+m/2+i2*3+2,' ','0xaaaccc' !上側左三角形の左下頂点、右下頂点、上 write(8,*) 3,nh1+m*3+i2*3+2,nh1+m*3,nh1+m*4+m/2+i2*3+2,' ','0xcccccc' !上側中三角形の左上頂点、下、右上頂点 write(8,*) 3,nh1+m*4+m/2+i2*3+2,nh1+m*3,nh1+m*4+m/2,' ','0xcccccc' !上側右三角形の左下頂点、右下頂点、上頂点 write(8,*) 3,nh1+m*3,nh1+m*3+1,nh1+m*4+m/2,' ','0xcccccc' !下側左三角形の左下頂点、上頂点、右下頂点(下から見て左回り) write(8,*) 3,nh1+m*4+m/2,nh1+m*3+1,nh1+m*4+m/2+1,' ','0xaaaccc' end if end do ! else ! !4段め do i=0,m-2,2 !周方向に i2=i/2 nh1=m*3*(j-1)/2 if(i/=m-2) then !周の開始から一つ前まで !上側右三角形の左下頂点、右下頂点、上頂点 write(8,*) 3,nh1+m*4+m/2+i2*3+1,nh1+m*4+m/2+i2*3+2,nh1+m*5+m+i2*3+2,' ','0xcccccc' !下側左三角形の左下頂点、上頂点、右下頂点(下から見て左回り) write(8,*) 3,nh1+m*5+m+i2*3+2,nh1+m*4+m/2+i2*3+2,nh1+m*5+m+i2*3+3,' ','0xaaaccc' !下側中三角形の左上頂点、右上頂点、下(下から見て左回り) write(8,*) 3,nh1+m*4+m/2+i2*3+2,nh1+m*4+m/2+i2*3+3,nh1+m*5+m+i2*3+3,' ','0xaaaccc' !下側右三角形の左下頂点、上、右下頂点(下から見て左回り) write(8,*) 3,nh1+m*5+m+i2*3+3,nh1+m*4+m/2+i2*3+3,nh1+m*5+m+i2*3+4,' ','0xaaaccc' !上側左三角形の左下頂点、右下頂点、上 write(8,*) 3,nh1+m*4+m/2+i2*3+3,nh1+m*4+m/2+i2*3+4,nh1+m*5+m+i2*3+4,' ','0xcccccc' !上側中三角形の左上頂点、下、右上頂点 write(8,*) 3,nh1+m*5+m+i2*3+4,nh1+m*4+m/2+i2*3+4,nh1+m*5+m+i2*3+5,' ','0xcccccc' else !周の一番最後は、開始点の頂点とくっつくように !上側右三角形の左下頂点、右下頂点、上頂点 write(8,*) 3,nh1+m*4+m/2+i2*3+1,nh1+m*4+m/2+i2*3+2,nh1+m*5+m+i2*3+2,' ','0xcccccc' !下側左三角形の左下頂点、上頂点、右下頂点(下から見て左回り) write(8,*) 3,nh1+m*5+m+i2*3+2,nh1+m*4+m/2+i2*3+2,nh1+m*6,' ','0xaaaccc' !下側中三角形の左上頂点、右上頂点、下(下から見て左回り) write(8,*) 3,nh1+m*4+m/2+i2*3+2,nh1+m*3+i2*3+3,nh1+m*6,' ','0xaaaccc' !下側右三角形の左下頂点、上、右下頂点(下から見て左回り) write(8,*) 3,nh1+m*6,nh1+m*3+i2*3+3,nh1+m*6+1,' ','0xaaaccc' !上側左三角形の左下頂点、右下頂点、上 write(8,*) 3,nh1+m*3+i2*3+3,nh1+m*3+i2*3+4,nh1+m*6+1,' ','0xcccccc' !上側中三角形の左上頂点、下、右上頂点 write(8,*) 3,nh1+m*6+1,nh1+m*3+i2*3+4,nh1+m*6+2,' ','0xcccccc' end if end do ! endif dansuu=dansuu*(-1.) end do ! write(8,'("#")') !daiya.objファイルから要素数を読み取るとき用 close(8) ! end ! ! ! subroutine zahen(thi,th1,orih,x1,y1,x2,y2,x1d,y1d,x2d,y2d,x3d,y3d) implicit real*8 (a-h, o-z) x1d=cos(thi)*x1+sin(thi)*y1 y1d=-sin(thi)*x1+cos(thi)*y1 x2d=cos(thi)*x2+sin(thi)*y2 y2d=-sin(thi)*x2+cos(thi)*y2 x3d=cos(th1)*x2+sin(th1)*y2 y3d=-sin(th1)*x2+cos(th1)*y2 return end