楼主
一个初学者，调试现有的程序，出现很多格式错误，在此向各位学长和老师求助！万分感激！
程序1：
subroutine comqut(level)
common/c1/dm1(2),dx,dt,f,dm2(2),uc,vc,dm3(5),st12
common/c3/u(21,21,5),v(21,21,5),un(21,21,5),vn(21,21,5)
1 ,px(21,21,5),py(21,21,5),vtn(21,21,5),ang(21,21,5)
2 ,lw(21,21,5)
common
$/c4/cdr(100,2,2),uxv(100,2),turn(100,2)
$/c5/flat,pth,dth(2),hh,z0land,ls,vv(100),ux(3),uv(3),
$ duv(3),k35,k2,g,ga,den,vv2,hl,k123,z0,zlog,am,bm,cm,ff
dimension hkl(21,21),drag(2)
data e1,e2/0.5,0.5/
data vonk/0.4/
c sqq is approximation to sqrt of sum of squares
sqq(a,b)=(abs(a)+abs(b))/2.51+(abs(a+b)+abs(a-b))*0.7071/2.51
do 800 nc=1,level
nest=level-nc+1
do 720 i=1,21
do 720 j=1,21
u(i,j,nest)=un(i,j,nest)
v(i,j,nest)=vn(i,j,nest)
720 continue
if (nest.NE.level) go to 721
if (nest.NE.5) call outby2(nest)
go to 722
721 call outby1(nest)
722 continue
dxl=2.0**(nest-1)*dx*1000.0
dxl2=dxl**2
dtl=2.0**(nest-1)*dt
ftl=f*dtl
ftl1=ftl**2+1.0
fcl=2.0*vonk**2*(dxl/2.0)**2
c inner boundary
if (nest.EQ.1) go to 730
do 724 j=1,10
u(7,j+6,nest)=un(3,2*j+1,nest-1)
v(7,j+6,nest)=vn(3,2*j+1,nest-1)
v(15,j+6,nest)=vn(19,2*j+1,nest-1)
u(15,j+6,nest)=un(19,2*j+1,nest-1)
724 continue
do 726 i=1,10
u(i+6,7,nest)=un(2*i+1,3,nest-1)
v(i+6,7,nest)=vn(2*i+1,3,nest-1)
u(i+6,15,nest)=un(2*i+1,19,nest-1)
v(i+6,15,nest)=vn(2*i+1,19,nest-1)
726 continue
c computation of interior point
730 do 734 i=1,20
do 734 j=1,20
if(nest.EQ.1) go to 733
if(i.LE.6.OR.i.GE.15) go to 733
if(j.LE.6.OR.j.GE.15) go to 733
hkl(i,j)=0.0
go to 734
733 d1=0.5*(u(i+1,j,nest)-u(i,j,nest)+u(i+1,j+1,nest)-u(i,j+1,nest)
1 -v(i,j+1,nest)+v(i,j,nest)-v(i+1,j+1,nest)+v(i+1,j,nest))/dxl
d2=0.5*(v(i+1,j,nest)-v(i,j,nest)+v(i+1,j+1,nest)-v(i,j+1,nest)
1 +u(i,j+1,nest)-u(i,j,nest)+u(i+1,j+1,nest)-u(i+1,j,nest))/dxl
hkl(i,j)=fcl*sqq(d1,d2)
734 continue
do 775 i=2,20
do 775 j=2,20
if(nest.EQ.1) go to 736
if(i.LE.6.OR.i.GE.16) go to 736
if(j.LE.6.OR.j.GE.16) go to 736
un(i,j,nest)=u(i,j,nest)
vn(i,j,nest)=v(i,j,nest)
go to 775
736 u1=u(i,j,nest)+uc
v1=v(i,j,nest)+vc
c drag(1) is tangential grad correction term
c drag(2) is normal drag correction term
ls=lw(i,j,nest)
spp=sqq(u1,v1)
spp1=amax1(1.,amin1(99.99,1.25*spp))
kpp=spp1
spp1=spp1-kpp
sph=spp/hh
do 737 ia=1,2
drag(ia)=sph*(cdr(kpp,ls,ia)+
$ spp1*(cdr(kpp+1,ls,ia)-cdr(kpp,ls,ia)))
737 continue
if(nest.NE.5)go to 741
if (i.NE.2.AND.i.NE.20) go to 741
if(i-2) 738,738,740
738 if (u(i,j,nest))739,739,741
739 ukx=0.0
vkx=0.0
go to 742
740 if (u(i,j,nest))741,739,739
741 ukx=0.5*((hkl(i,j-1)+hkl(i,j))*(u(i+1,j,nest)-u(i,j,nest))
1 -(hkl(i-1,j-1)+hkl(i-1,j))*(u(i,j,nest)-u(i-1,j,nest)))/dxl2
vkx=0.5*((hkl(i,j-1)+hkl(i,j))*(v(i+1,j,nest)-v(i,j,nest))
1 -(hkl(i-1,j-1)+hkl(i-1,j))*(v(i,j,nest)-v(i-1,j,nest)))/dxl2
if(nest.NE.5)go to 746
742 if(j.NE.2.AND.j.NE.20)go to 746
if(j-2)743,743,745
743 if(v(i,j,nest))744,744,746
744 uky=0.0
vky=0.0
go to 747
745 if(v(i,j,nest))746,744,744
746 uky=0.5*((hkl(i-1,j)+hkl(i,j))*(u(i,j+1,nest)-u(i,j,nest))
1 -(hkl(i-1,j-1)+hkl(i,j-1))*(u(i,j,nest)-u(i,j-1,nest)))/dxl2
vky=0.5*((hkl(i-1,j)+hkl(i,j))*(v(i,j+1,nest)-v(i,j,nest))
1 -(hkl(i-1,j-1)+hkl(i,j-1))*(v(i,j,nest)-v(i,j-1,nest)))/dxl2
747 if(u(i,j,nest))748,750,750
748 ux=-u(i,j,nest)*(u(i,j,nest)-u(i+1,j,nest))/dxl
vx=-u(i,j,nest)*(v(i,j,nest)-v(i+1,j,nest))/dxl
go to 752
750 ux=u(i,j,nest)*(u(i,j,nest)-u(i-1,j,nest))/dxl
vx=u(i,j,nest)*(v(i,j,nest)-v(i-1,j,nest))/dxl
752 if(v(i,j,nest))754,756,756
754 uy=-v(i,j,nest)*(u(i,j,nest)-u(i,j+1,nest))/dxl
vy=-v(i,j,nest)*(v(i,j,nest)-v(i,j+1,nest))/dxl
go to 758
756 uy=v(i,j,nest)*(u(i,j,nest)-u(i,j-1,nest))/dxl
vy=v(i,j,nest)*(v(i,j,nest)-v(i,j-1,nest))/dxl
758 ur=0.5*(u(i,j,nest)+v(i,j,nest))
vr=0.5*(-u(i,j,nest)+v(i,j,nest))
if(ur)760,762,762
760 ux1=-ur*(u(i,j,nest)-u(i+1,j+1,nest))/dxl
vx1=-ur*(v(i,j,nest)-v(i+1,j+1,nest))/dxl
go to 764
762 ux1=ur*(u(i,j,nest)-u(i-1,j-1,nest))/dxl
vx1=ur*(v(i,j,nest)-v(i-1,j-1,nest))/dxl
764 if(vr)766,768,768
766 uy1=-vr*(u(i,j,nest)-u(i-1,j+1,nest))/dxl
vy1=-vr*(v(i,j,nest)-v(i-1,j+1,nest))/dxl
go to 770
768 uy1=vr*(u(i,j,nest)-u(i+1,j-1,nest))/dxl
vy1=vr*(v(i,j,nest)-v(i+1,j-1,nest))/dxl
770 uxy=e1*(ux+uy)+e2*(ux1+uy1)
vxy=e1*(vx+vy)+e2*(vx1+vy1)
b1=u(i,j,nest)+dtl*
$ (ukx+uky-px(i,j,nest)-uxy+u1*drag(1)+v1*drag(2))
b2=v(i,j,nest)+dtl*
$ (vkx+vky-py(i,j,nest)-vxy+v1*drag(1)-u1*drag(2))
un(i,j,nest)=(b1+ftl*b2)/ftl1
vn(i,j,nest)=(b2-ftl*b1)/ftl1
775 continue
800 continue
return
end
出错：comqut.f(133) : Error: The shapes of the array expressions do not conform. [UXY]
程序1：
subroutine comqut(level)
common/c1/dm1(2),dx,dt,f,dm2(2),uc,vc,dm3(5),st12
common/c3/u(21,21,5),v(21,21,5),un(21,21,5),vn(21,21,5)
1 ,px(21,21,5),py(21,21,5),vtn(21,21,5),ang(21,21,5)
2 ,lw(21,21,5)
common
$/c4/cdr(100,2,2),uxv(100,2),turn(100,2)
$/c5/flat,pth,dth(2),hh,z0land,ls,vv(100),ux(3),uv(3),
$ duv(3),k35,k2,g,ga,den,vv2,hl,k123,z0,zlog,am,bm,cm,ff
dimension hkl(21,21),drag(2)
data e1,e2/0.5,0.5/
data vonk/0.4/
c sqq is approximation to sqrt of sum of squares
sqq(a,b)=(abs(a)+abs(b))/2.51+(abs(a+b)+abs(a-b))*0.7071/2.51
do 800 nc=1,level
nest=level-nc+1
do 720 i=1,21
do 720 j=1,21
u(i,j,nest)=un(i,j,nest)
v(i,j,nest)=vn(i,j,nest)
720 continue
if (nest.NE.level) go to 721
if (nest.NE.5) call outby2(nest)
go to 722
721 call outby1(nest)
722 continue
dxl=2.0**(nest-1)*dx*1000.0
dxl2=dxl**2
dtl=2.0**(nest-1)*dt
ftl=f*dtl
ftl1=ftl**2+1.0
fcl=2.0*vonk**2*(dxl/2.0)**2
c inner boundary
if (nest.EQ.1) go to 730
do 724 j=1,10
u(7,j+6,nest)=un(3,2*j+1,nest-1)
v(7,j+6,nest)=vn(3,2*j+1,nest-1)
v(15,j+6,nest)=vn(19,2*j+1,nest-1)
u(15,j+6,nest)=un(19,2*j+1,nest-1)
724 continue
do 726 i=1,10
u(i+6,7,nest)=un(2*i+1,3,nest-1)
v(i+6,7,nest)=vn(2*i+1,3,nest-1)
u(i+6,15,nest)=un(2*i+1,19,nest-1)
v(i+6,15,nest)=vn(2*i+1,19,nest-1)
726 continue
c computation of interior point
730 do 734 i=1,20
do 734 j=1,20
if(nest.EQ.1) go to 733
if(i.LE.6.OR.i.GE.15) go to 733
if(j.LE.6.OR.j.GE.15) go to 733
hkl(i,j)=0.0
go to 734
733 d1=0.5*(u(i+1,j,nest)-u(i,j,nest)+u(i+1,j+1,nest)-u(i,j+1,nest)
1 -v(i,j+1,nest)+v(i,j,nest)-v(i+1,j+1,nest)+v(i+1,j,nest))/dxl
d2=0.5*(v(i+1,j,nest)-v(i,j,nest)+v(i+1,j+1,nest)-v(i,j+1,nest)
1 +u(i,j+1,nest)-u(i,j,nest)+u(i+1,j+1,nest)-u(i+1,j,nest))/dxl
hkl(i,j)=fcl*sqq(d1,d2)
734 continue
do 775 i=2,20
do 775 j=2,20
if(nest.EQ.1) go to 736
if(i.LE.6.OR.i.GE.16) go to 736
if(j.LE.6.OR.j.GE.16) go to 736
un(i,j,nest)=u(i,j,nest)
vn(i,j,nest)=v(i,j,nest)
go to 775
736 u1=u(i,j,nest)+uc
v1=v(i,j,nest)+vc
c drag(1) is tangential grad correction term
c drag(2) is normal drag correction term
ls=lw(i,j,nest)
spp=sqq(u1,v1)
spp1=amax1(1.,amin1(99.99,1.25*spp))
kpp=spp1
spp1=spp1-kpp
sph=spp/hh
do 737 ia=1,2
drag(ia)=sph*(cdr(kpp,ls,ia)+
$ spp1*(cdr(kpp+1,ls,ia)-cdr(kpp,ls,ia)))
737 continue
if(nest.NE.5)go to 741
if (i.NE.2.AND.i.NE.20) go to 741
if(i-2) 738,738,740
738 if (u(i,j,nest))739,739,741
739 ukx=0.0
vkx=0.0
go to 742
740 if (u(i,j,nest))741,739,739
741 ukx=0.5*((hkl(i,j-1)+hkl(i,j))*(u(i+1,j,nest)-u(i,j,nest))
1 -(hkl(i-1,j-1)+hkl(i-1,j))*(u(i,j,nest)-u(i-1,j,nest)))/dxl2
vkx=0.5*((hkl(i,j-1)+hkl(i,j))*(v(i+1,j,nest)-v(i,j,nest))
1 -(hkl(i-1,j-1)+hkl(i-1,j))*(v(i,j,nest)-v(i-1,j,nest)))/dxl2
if(nest.NE.5)go to 746
742 if(j.NE.2.AND.j.NE.20)go to 746
if(j-2)743,743,745
743 if(v(i,j,nest))744,744,746
744 uky=0.0
vky=0.0
go to 747
745 if(v(i,j,nest))746,744,744
746 uky=0.5*((hkl(i-1,j)+hkl(i,j))*(u(i,j+1,nest)-u(i,j,nest))
1 -(hkl(i-1,j-1)+hkl(i,j-1))*(u(i,j,nest)-u(i,j-1,nest)))/dxl2
vky=0.5*((hkl(i-1,j)+hkl(i,j))*(v(i,j+1,nest)-v(i,j,nest))
1 -(hkl(i-1,j-1)+hkl(i,j-1))*(v(i,j,nest)-v(i,j-1,nest)))/dxl2
747 if(u(i,j,nest))748,750,750
748 ux=-u(i,j,nest)*(u(i,j,nest)-u(i+1,j,nest))/dxl
vx=-u(i,j,nest)*(v(i,j,nest)-v(i+1,j,nest))/dxl
go to 752
750 ux=u(i,j,nest)*(u(i,j,nest)-u(i-1,j,nest))/dxl
vx=u(i,j,nest)*(v(i,j,nest)-v(i-1,j,nest))/dxl
752 if(v(i,j,nest))754,756,756
754 uy=-v(i,j,nest)*(u(i,j,nest)-u(i,j+1,nest))/dxl
vy=-v(i,j,nest)*(v(i,j,nest)-v(i,j+1,nest))/dxl
go to 758
756 uy=v(i,j,nest)*(u(i,j,nest)-u(i,j-1,nest))/dxl
vy=v(i,j,nest)*(v(i,j,nest)-v(i,j-1,nest))/dxl
758 ur=0.5*(u(i,j,nest)+v(i,j,nest))
vr=0.5*(-u(i,j,nest)+v(i,j,nest))
if(ur)760,762,762
760 ux1=-ur*(u(i,j,nest)-u(i+1,j+1,nest))/dxl
vx1=-ur*(v(i,j,nest)-v(i+1,j+1,nest))/dxl
go to 764
762 ux1=ur*(u(i,j,nest)-u(i-1,j-1,nest))/dxl
vx1=ur*(v(i,j,nest)-v(i-1,j-1,nest))/dxl
764 if(vr)766,768,768
766 uy1=-vr*(u(i,j,nest)-u(i-1,j+1,nest))/dxl
vy1=-vr*(v(i,j,nest)-v(i-1,j+1,nest))/dxl
go to 770
768 uy1=vr*(u(i,j,nest)-u(i+1,j-1,nest))/dxl
vy1=vr*(v(i,j,nest)-v(i+1,j-1,nest))/dxl
770 uxy=e1*(ux+uy)+e2*(ux1+uy1)
vxy=e1*(vx+vy)+e2*(vx1+vy1)
b1=u(i,j,nest)+dtl*
$ (ukx+uky-px(i,j,nest)-uxy+u1*drag(1)+v1*drag(2))
b2=v(i,j,nest)+dtl*
$ (vkx+vky-py(i,j,nest)-vxy+v1*drag(1)-u1*drag(2))
un(i,j,nest)=(b1+ftl*b2)/ftl1
vn(i,j,nest)=(b2-ftl*b1)/ftl1
775 continue
800 continue
return
end
出错：comqut.f(133) : Error: The shapes of the array expressions do not conform. [UXY]
