jsgc2005.for

此程序采用Fortern和AutoCAD中的脚本结合开发而成

       Program qlgcjs2005
       implicit double precision(a-h,o-z,k)
       dimension k0(300),h0(300),r(300),kp(300)
       dimension kx(300),hx(300),p(300),t(300),e(300),s(300)
       dimension kx1(300),kx2(300),kx3(300),kx4(300),kx5(300)
       dimension kx6(300),kx7(300),kx8(300),kx9(300),kx10(300)
	 dimension hx1(300),hx2(300),hx3(300),hx4(300),hx5(300)
       dimension hx6(300),hx7(300),hx8(300),hx9(300),hx10(300)
       dimension hxx1(300),hxx2(300),hxx3(300),hxx4(300),hxx5(300)
       dimension hxx6(300),hxx7(300),hxx8(300),hxx9(300),hxx10(300)
       dimension kd(20000),hd(20000),hdd(20000),hp1(20000)
       dimension hp2(20000),hcpz(20000),hcpy(20000),alfa(20000)
       dimension hf1(20000),hf2(20000),hf3(20000),hf4(20000),kf(20000)
	real,parameter :: pi=3.141592654
       open(1,file='01zdm.dat',status='old')
       open(5,file='02dmx.dat',status='old')
	 open(9,file='03ljhp.dat',status='old')
	 open(11,file='04tkds.dat',status='old')
       open(2,file='00jsgc.dat',status='old')
       open(3,file='09jsgc.out',status='replace')
       open(4,file='05jsgc.scr',status='replace')
       open(8,file='06dmx.scr',status='replace')
	 open(7,file='07zdm.scr',status='replace')
	 open(10,file='08text.scr',status='replace')
	 write(10,*)'osmode'
	 write(10,*)'17441'
       write(*,*)
       write(*,*)
       write(*,*)'  * * * * * * * * * * * * * * * * * * * * * * *'
       write(*,*)'  *            桥梁高程计算程序2005           *'
       write(*,*)'  *                                           *'
       write(*,*)'  *                 writen by:                *'
       write(*,*)'  *                                           *'
       write(*,*)'  *                                           *'
       write(*,*)'  *         xxxxxxxxxxxxxxxxxxxxxxxxxx        *'
       write(*,*)'  * * * * * * * * * * * * * * * * * * * * * * *'
       write(*,*)
       write(3,*)'   * * * * * * * * * * * * * * * * * * * * * 
       write(3,*)'   *          桥梁高程计算程序2005         * 
       write(3,*)'   *               writen by:              *  
       write(3,*)'   *                                       *  
       write(3,*)'   *      xxxxxxxxxxxxxxxxxxxxxxxxxx       *  
       write(3,*)'   * * * * * * * * * * * * * * * * * * * * *
       write(3,*)
       read(11,*)itkds
	 read(9,*) road,x1,x2,x3,x4
	 read(9,*) mm
	 read(9,*) (hf1(i),hf2(i),kf(i),i=1,mm)
       read(5,*)nn
       read(5,*)(kd(i),hd(i),i=1,nn)
	write(8,*)'osmode'
	write(8,*)'17441'
	 write(8,*)'pline'
       write(8,200)(kd(i),hd(i),i=1,nn)
	 write(8,*)
	write(8,*)'osmode'
	write(8,*)'1057'
       read(1,*) n
       read(1,*) (k0(i),h0(i),r(i),i=1,n)
	 write(7,*)'pline'
       write(7,200)(k0(i),h0(i),i=1,n)
	 do 10 i=1,n-1
              p(i)=(h0(i+1)-h0(i))/(k0(i+1)-k0(i))
	        s(i)=p(i)*100.0
10     continue
       write(4,*)'序号  变坡点桩号   高程      R半径       T长       E值
     1      左坡度   右坡度'
	 t(1)=0.0
       kp(1)=k0(1)
       kp(n)=k0(n)
       e(1)=0.0
       do 20 i=2,n-1
             t(i)=abs(p(i)-p(i-1))*r(i)*0.5
             e(i)=t(i)*t(i)/(r(i)*2.0)
             kp(i)=k0(i)+t(i)
	       jkk=int(k0(i)/1000.0)
	       kkk=k0(i)-jkk*1000.0
             write(4,300)i,jkk,kkk,h0(i),r(i),t(i),e(i),s(i-1),s(i)
20     continue
       write(4,*)'pline'
c------------计算全幅中心线设计高、及桥面5点标高-------------------------------
c------------1   全幅中心线设计高----------------------------------------------
       read(2,*) m
       do 30 j=1,m
             read(2,*) kx(j),alfa(j)
	       kx1(j)=kx(j)+tan(alfa(j)*pi/180)*(road/2)
	       kx2(j)=kx(j)+tan(alfa(j)*pi/180)*(road/2-x4)
             kx3(j)=kx(j)+tan(alfa(j)*pi/180)*(x3)
             kx4(j)=kx(j)+tan(alfa(j)*pi/180)*(x1)
	       kx5(j)=kx(j)+tan(alfa(j)*pi/180)*(x2)
             kx6(j)=kx(j)-tan(alfa(j)*pi/180)*(x2)
             kx7(j)=kx(j)-tan(alfa(j)*pi/180)*(x1)
	       kx8(j)=kx(j)-tan(alfa(j)*pi/180)*(x3)
             kx9(j)=kx(j)-tan(alfa(j)*pi/180)*(road/2-x4)
	       kx10(j)=kx(j)-tan(alfa(j)*pi/180)*(road/2)
		   if(kx(j).le.kp(n-1)) then
             do 40 i=2,n-1
                 a=kx(j)-kp(i-1)
                 b=kx(j)-kp(i)
                 if(a.ge.0.0.and.b.lt.0.0) then
                     a1=k0(i)-t(i)
                     a2=kp(i)
                     if(kx(j).le.a1) then
                       hx(j)=h0(i)+(kx(j)-k0(i))*p(i-1)
                     endif
                     if(kx(j).gt.a1) then
                         if(p(i).le.p(i-1)) then
                          if(kx(j).eq.k0(i)) then
                            hx(j)=h0(i)-e(i)
                          endif
                          if(kx(j).lt.k0(i)) then
                            h1=(kx(j)-a1)*(kx(j)-a1)/(r(i)*2.0)
                            hx(j)=h0(i)+(kx(j)-k0(i))*p(i-1)-h1
                           endif
                          if(kx(j).gt.k0(i)) then
                            h1=(a2-kx(j))*(a2-kx(j))/(r(i)*2.0)
                            hx(j)=h0(i)+(kx(j)-k0(i))*p(i)-h1
                          endif
                         endif
                         if(p(i).gt.p(i-1)) then
                          if(kx(j).eq.k0(i)) then
                            hx(j)=h0(i)+e(i)
                          endif
                          if(kx(j).lt.k0(i)) then
                            h1=(kx(j)-a1)*(kx(j)-a1)/(r(i)*2.0)
                            hx(j)=h0(i)+(kx(j)-k0(i))*p(i-1)+h1
                           endif
                          if(kx(j).gt.k0(i)) then
                            h1=(a2-kx(j))*(a2-kx(j))/(r(i)*2.0)
                            hx(j)=h0(i)+(kx(j)-k0(i))*p(i)+h1
                          endif
                         endif
                     endif
                 endif
40             continue
             endif
             if(kx(j).gt.kp(n-1)) then
               hx(j)=h0(n)+(kx(j)-k0(n))*p(n-1)
             endif
c------------计算超高值----------------------------------------------------
             do 22 i=2,mm
		   if(kx(j).ge.kf(i-1).and.kx(j).lt.kf(i)) then
	hp1(j)=hf1(i-1)+(kx(j)-kf(i-1))*(hf1(i)-hf1(i-1))/(kf(i)-kf(i-1))
	hp2(j)=hf2(i-1)+(kx(j)-kf(i-1))*(hf2(i)-hf2(i-1))/(kf(i)-kf(i-1))
	       endif
22	continue
c------------2    左幅桥外边缘P1设计高------------------------------
		   if(kx1(j).le.kp(n-1)) then
             do 41 i=2,n-1
                 a=kx1(j)-kp(i-1)
                 b=kx1(j)-kp(i)
                 if(a.ge.0.0.and.b.lt.0.0) then
                     a1=k0(i)-t(i)
                     a2=kp(i)
                     if(kx1(j).le.a1) then
                       hx1(j)=h0(i)+(kx1(j)-k0(i))*p(i-1)
                     endif
                     if(kx1(j).gt.a1) then
                         if(p(i).le.p(i-1)) then
                          if(kx1(j).eq.k0(i)) then
                            hx1(j)=h0(i)-e(i)
                          endif
                          if(kx1(j).lt.k0(i)) then
                            h1=(kx1(j)-a1)*(kx1(j)-a1)/(r(i)*2.0)
                            hx1(j)=h0(i)+(kx1(j)-k0(i))*p(i-1)-h1
                           endif
                          if(kx1(j).gt.k0(i)) then
                            h1=(a2-kx1(j))*(a2-kx1(j))/(r(i)*2.0)
                            hx1(j)=h0(i)+(kx1(j)-k0(i))*p(i)-h1
                          endif
                         endif
                         if(p(i).gt.p(i-1)) then
                          if(kx1(j).eq.k0(i)) then
                            hx1(j)=h0(i)+e(i)
                          endif
                          if(kx1(j).lt.k0(i)) then
                            h1=(kx1(j)-a1)*(kx1(j)-a1)/(r(i)*2.0)
                            hx1(j)=h0(i)+(kx1(j)-k0(i))*p(i-1)+h1
                           endif
                          if(kx1(j).gt.k0(i)) then
                            h1=(a2-kx1(j))*(a2-kx1(j))/(r(i)*2.0)
                            hx1(j)=h0(i)+(kx1(j)-k0(i))*p(i)+h1
                          endif
                         endif
                     endif
                 endif
41             continue
		   endif
             if(kx1(j).gt.kp(n-1)) then
               hx1(j)=h0(n)+(kx1(j)-k0(n))*p(n-1)
             endif
	hxx1(j)=hx1(j)-hp1(j)/100*(road/2-x1)
c------------3    左幅桥外边缘防撞墙处P2设计高------------------------------
		   if(kx2(j).le.kp(n-1)) then
             do 42 i=2,n-1
                 a=kx2(j)-kp(i-1)
                 b=kx2(j)-kp(i)
                 if(a.ge.0.0.and.b.lt.0.0) then
                     a1=k0(i)-t(i)
                     a2=kp(i)
                     if(kx2(j).le.a1) then
                       hx2(j)=h0(i)+(kx2(j)-k0(i))*p(i-1)
                     endif
                     if(kx2(j).gt.a1) then
                         if(p(i).le.p(i-1)) then
                          if(kx2(j).eq.k0(i)) then
                            hx2(j)=h0(i)-e(i)
                          endif
                          if(kx2(j).lt.k0(i)) then
                            h1=(kx2(j)-a1)*(kx2(j)-a1)/(r(i)*2.0)
                            hx2(j)=h0(i)+(kx2(j)-k0(i))*p(i-1)-h1
                           endif
                          if(kx2(j).gt.k0(i)) then
                            h1=(a2-kx2(j))*(a2-kx2(j))/(r(i)*2.0)
                            hx2(j)=h0(i)+(kx2(j)-k0(i))*p(i)-h1
                          endif
                         endif
                         if(p(i).gt.p(i-1)) then
                          if(kx2(j).eq.k0(i)) then
                            hx2(j)=h0(i)+e(i)
                          endif
                          if(kx2(j).lt.k0(i)) then
                            h1=(kx2(j)-a1)*(kx2(j)-a1)/(r(i)*2.0)
                            hx2(j)=h0(i)+(kx2(j)-k0(i))*p(i-1)+h1
                           endif
                          if(kx2(j).gt.k0(i)) then
                            h1=(a2-kx2(j))*(a2-kx2(j))/(r(i)*2.0)
                            hx2(j)=h0(i)+(kx2(j)-k0(i))*p(i)+h1
                          endif
                         endif
                     endif
                 endif
42             continue
		   endif
             if(kx2(j).gt.kp(n-1)) then
               hx2(j)=h0(n)+(kx2(j)-k0(n))*p(n-1)
             endif
	hxx2(j)=hx2(j)-hp1(j)/100*(road/2-x1-x4)
c------------4    左幅桥单幅桥面中线处P3设计高------------------------------
		   if(kx3(j).le.kp(n-1)) then
             do 43 i=2,n-1
                 a=kx3(j)-kp(i-1)
                 b=kx3(j)-kp(i)
                 if(a.ge.0.0.and.b.lt.0.0) then
                     a1=k0(i)-t(i)
                     a2=kp(i)
                     if(kx3(j).le.a1) then
                       hx3(j)=h0(i)+(kx3(j)-k0(i))*p(i-1)
                     endif
                     if(kx3(j).gt.a1) then
                         if(p(i).le.p(i-1)) then
                          if(kx3(j).eq.k0(i)) then
                            hx3(j)=h0(i)-e(i)
                          endif
                          if(kx3(j).lt.k0(i)) then
                            h1=(kx3(j)-a1)*(kx3(j)-a1)/(r(i)*2.0)
                            hx3(j)=h0(i)+(kx3(j)-k0(i))*p(i-1)-h1
                           endif
                          if(kx3(j).gt.k0(i)) then
                            h1=(a2-kx3(j))*(a2-kx3(j))/(r(i)*2.0)
                            hx3(j)=h0(i)+(kx3(j)-k0(i))*p(i)-h1
                          endif
                         endif
                         if(p(i).gt.p(i-1)) then
                          if(kx3(j).eq.k0(i)) then
                            hx3(j)=h0(i)+e(i)
                          endif
                          if(kx3(j).lt.k0(i)) then
                            h1=(kx3(j)-a1)*(kx3(j)-a1)/(r(i)*2.0)
                            hx3(j)=h0(i)+(kx3(j)-k0(i))*p(i-1)+h1
                           endif
                          if(kx3(j).gt.k0(i)) then
                            h1=(a2-kx3(j))*(a2-kx3(j))/(r(i)*2.0)
                            hx3(j)=h0(i)+(kx3(j)-k0(i))*p(i)+h1
                          endif
                         endif
                     endif
                 endif
43             continue
		   endif
             if(kx3(j).gt.kp(n-1)) then
               hx3(j)=h0(n)+(kx3(j)-k0(n))*p(n-1)
             endif
	hxx3(j)=hx3(j)-hp1(j)/100*(x3-x1)
c------------5   左幅桥内缘防撞墙处P4设计高------------------------------
		   if(kx4(j).le.kp(n-1)) then
             do 44 i=2,n-1
                 a=kx4(j)-kp(i-1)
                 b=kx4(j)-kp(i)
                 if(a.ge.0.0.and.b.lt.0.0) then
                     a1=k0(i)-t(i)
                     a2=kp(i)
                     if(kx4(j).le.a1) then
                       hx4(j)=h0(i)+(kx4(j)-k0(i))*p(i-1)
                     endif
                     if(kx4(j).gt.a1) then
                         if(p(i).le.p(i-1)) then
                          if(kx4(j).eq.k0(i)) then
                            hx4(j)=h0(i)-e(i)
                          endif
                          if(kx4(j).lt.k0(i)) then
                            h1=(kx4(j)-a1)*(kx4(j)-a1)/(r(i)*2.0)
                            hx4(j)=h0(i)+(kx4(j)-k0(i))*p(i-1)-h1
                           endif
                          if(kx4(j).gt.k0(i)) then
                            h1=(a2-kx4(j))*(a2-kx4(j))/(r(i)*2.0)
                            hx4(j)=h0(i)+(kx4(j)-k0(i))*p(i)-h1
                          endif
                         endif
                         if(p(i).gt.p(i-1)) then
                          if(kx4(j).eq.k0(i)) then
                            hx4(j)=h0(i)+e(i)
                          endif
                          if(kx4(j).lt.k0(i)) then
                            h1=(kx4(j)-a1)*(kx4(j)-a1)/(r(i)*2.0)
                            hx4(j)=h0(i)+(kx4(j)-k0(i))*p(i-1)+h1
                           endif
                          if(kx4(j).gt.k0(i)) then
                            h1=(a2-kx4(j))*(a2-kx4(j))/(r(i)*2.0)
                            hx4(j)=h0(i)+(kx4(j)-k0(i))*p(i)+h1
                          endif
                         endif
                     endif
                 endif