SMS模型格网转换为MIKE21的格网源代码

    program main !sms网格转换成mike21网格
    DIMENSION X(),Y(),H(),NDNN(,),ncbd()
    dimension NBS(),NOBD(,),NSED(,),id0(),nbi()
    dimension x0(),y0(),h0()
    character* a*,b*,gnn*,demo*

    open(,file='./2013.8.30(after).grd',status='old')
    read(,*)
    read(,*)nel,nde
    do i=,nde
    read(,*)num,x(i),y(i),h(i)
    h(i)=h(i)+2.2
    enddo
    do i=,nel
    read(,*)num,nd,(ndnn(i,j),j=,)
    enddo

    do i=, !
    read(,*)
    enddo
    read(,*)kb
    read(,*)
    do k=,kb
    read(,*)nbs(k)
    do i=,nbs(k)
    read(,*)nobd(i,k)
    enddo
    enddo
    close()
c-----------------------------------------------------------
      open(,file='滑道1.grd',status='old')
    read(,*)
    read(,*)nel0,nde0
    do i=,nde0
    read(,*)num,x0(i),y0(i),h0(i)
    enddo
    close()

    do  i=,nde
    do j=,nde0
    dis=sqrt((x(i)-x0(j))**+(y(i)-y0(j))**)
    if(dis.le.)then
    h(i)=2.2-h0(j)
    goto
    endif
    enddo
    continue    

      open(,file='滑道2.grd',status='old')
    read(,*)
    read(,*)nel0,nde0
    do i=,nde0
    read(,*)num,x0(i),y0(i),h0(i)
    enddo
    close()

    do  i=,nde
    do j=,nde0
    dis=sqrt((x(i)-x0(j))**+(y(i)-y0(j))**)
    if(dis.le.)then
    h(i)=2.2-h0(j)
    goto
    endif
    enddo
    continue
c----------------------------------------------------------
    id0=

    open(,file='closebd.txt',status='old')
    do nn=,
    read(,*,end=)nk
    write(*,*)nk
    read(,*)(ncbd(n),n=,nk)
    do i=,nk
    id0(ncbd(i))= !+nn
    enddo
    enddo
    continue
    close()
    do k=,kb

    do i=,nbs(k)
    id0(nobd(i,k))=k+
    enddo
    enddo

    write(*,*)

    demo=' PROJCS["Beijing_1954_3_Degree_GK_CM_111E",GEOGCS
     *["GCS_Beijing_1954",DATUM["D_Beijing_1954",SPHEROID["Krasovsky
     *_1940",6378245.0,298.3]],PRIMEM["Greenwich",0.0],UNIT["Degree",
     *0.0174532925199433]],PROJECTION["Gauss_Kruger"],PARAMETER["False
     *_Easting",500000.0],PARAMETER["False_Northing",0.0],PARAMETER
     *["Central_Meridian",120.0],PARAMETER["Scale_Factor",1.0],
     *PARAMETER["Latitude_Of_Origin",0.0],UNIT["Meter",1.0]]'

    open(,file='2013.8.30(after).mesh')
    write(,'(I8,a)')nde,demo
    d0=
    do i=,nde
    write(,'(i8,2f12.2,f10.4,I4)')i,x(i),y(i),h(i)*-,id0(i)  !
    enddo
    write(,*)nel,'  3  21'
    do i=,nel
    write(,'(5I6)')i,(ndnn(i,j),j=,),d0
    enddo

    close()

    end