2. Программа расчета скорости геострофических течений (в. С. Архипкин)

Расчет проводится по динамическому методу на примере двух станций на языке Фортран 90.

program dinvel

implicit none

!Количество стандартных горизонтов

integer,parameter:: ns=10

real,dimension(500):: p1,t1,s1,p2,t2,s2,v1,v2

real,dimension(ns):: ps,vs1,vs2,d1,d2,vel

real(8):: distos

real:: sh1,dol1,sh2,dol2,dist,fpar,fl,vstp,pcor

integer:: i,j,i1,n1,n2

!Обнуление массивов

vs1=0.; vs2=0.; d1=0.; d2=0.; vel=0.

!Стандартные горизонты

ps=(/0.,10.,20.,30.,50.,75.,100.,150.,200.,300./)

!Открытие файла с исходными данными

open(15,file='dinvel.dat')

!Считывание долготы, широты и количества горизонтов первой станции.

!Примечание: координаты станций должны быть выражены в градусах и долях градуса

read(15,*) sh1,dol1,n1

do i=1,n1

!Считывание давления, температуры и солености

read(15,*) p1(i),t1(i),s1(i)

!Расчет удельного объема

v1(i)=vstp(s1(i),t1(i),p1(i))

end do

!Считывание долготы, широты и количества горизонтов второй станции

read(15,*) sh2,dol2,n2

do i=1,n2

!Считывание давления, температуры и солености

read(15,*) p2(i),t2(i),s2(i)

!Расчет удельного объема

v2(i)=vstp(s2(i),t2(i),p2(i))

end do

!Расчет расстояния между станциями в метрах

dist=distos(sh1,dol1,sh2,dol2)

!Расчет параметра Кориолиса

fpar=pcor((sh1+sh2)/2.)

if(p1(1)/=0.) p1(1)=0.

if(p2(1)/=0.) p2(1)=0.

!Линейная интерполяция удельного объема на стандартные горизонты. Первая станция.

do j=1,ns

do i=1,n1-1

i1=i+1

if(ps(j)>=p1(i).and.ps(j)<p1(i1)) then

vs1(j)=v1(i)+1.e4*(v1(i1)-v1(i))*(ps(j)-p1(i))/(p1(i1)-p1(i))

end if

end do

end do

!Линейная интерполяция удельного объема на стандартные горизонты. Вторая станция.

do j=1,ns

do i=1,n2-1

i1=i+1

if(ps(j)>=p2(i).and.ps(j)<p2(i1)) then

vs2(j)=v2(i)+(v2(i1)-v2(i))*(ps(j)-p2(i))/(p2(i1)-p2(i))

end if

end do

end do

!Расчет динамических высот на станциях (используется метод трапеций). Размерность динамической !высоты - м^2/с^2. Отсчетная поверхность совпадает с последним стандартным горизонтом.

d1(ns)=0.; d2(ns)=0.

do i=ns-1,1,-1

i1=i+1

d1(i)=d1(i1)+(vs1(i1)+vs1(i))*(ps(i1)-ps(i))/2.

d2(i)=d2(i1)+(vs2(i1)+vs2(i))*(ps(i1)-ps(i))/2.

end do

!Расчет скорости геострофических течений на стандартных горизонтах (м/с)

fl=fpar*dist

do i=1,ns

vel(i)=(d2(i)-d1(i))/fl

end do

!Сохранение результатов расчета

open(20,file='dinvel.out')

do i=1,ns

write(20,'(f6.0,f7.2)') ps(i),vel(i)

end do

close(15)

close(20)

end program dinvel

!Подпрограмма расчета удельного объема морской воды. Используется уравнение состояния 1980 года.

real function vstp(s,t,p)

implicit none

real:: s,t,p,rst0,kstp80

rst0=-0.157406+t*(6.793952e-2+t*(-9.095290e-3(1.001685e-4+t*(-1.120083e-6+t*6.536332e-9)))) &

+s*(8.24493e-1+t*(-4.0899e-3+t*(7.6438e-5+t*(-8.2467e-7+t*5.3875e-9)))+(-5.72466e-3+ &

t*(1.0227e-4-1.6546e-6*t))*sqrt(abs(s))+4.8314e-4*s)+1000.

if(p.eq.0.) then

vstp=1./rst0

else

vstp=(1.-(p*0.1)/kstp80(s,t,p))/rst0

end if

return

end function vstp

!Модуль упругости по УС-80

real function kstp80(s,t,p)

implicit none

real:: s,t,p,ss,p0

ss=sqrt(abs(s))

kstp80=19652.21+t*(148.4206+t*(-2.327105+t*(1.360477e-2-5.155288e-5*t)))+ &

s*(54.6746+t*(-0.603459+t*(1.09987e-2- 6.1670e-5*t))+ss*(7.944e-2+t*(1.6483e-2-5.3009e-4*t)))

if(p.eq.0.) return

p0=p*0.1

kstp80=kstp80+p0*(3.239908+t*(1.43713e-3+t*(1.16092e-4-5.77905e-7*t))+s*(2.2838e-3 &

+t*(-1.0981e-5-1.6078e-6*t) +1.91075e-4*ss)+p0*(8.50935e-5+t*(-6.12293e-6+t*5.2787e-8) &

+s*(-9.9348e-7+t*(2.0816e-8+t*9.1697e-10))))

return

end function kstp80

!Расчет расстояния между станциями в метрах. Используется эллипсоид Красовского.

real(8) function distos(lt1,ln1,lt2,ln2)

implicit none

real,parameter:: rad_=0.0174533

real:: lt1,ln1,lt2,ln2,fi

real(8):: c,x,y

x(fi)=1.11321d5*cos(fi)-94.d0*cos(3.*fi)

y(fi)=1.11143d5-562.d0*cos(2.*fi)

c=(lt2-lt1)*y((lt1+lt2)*0.5*rad_)

distos=sqrt(c**2+(ln2-ln1)**2*x(lt1*rad_)*x(lt2*rad_))

return

end function distos

!Расчет параметра Кориолиса

real function pcor(fi)

implicit none

real,parameter:: rad_=0.0174533,w2ear_=1.458422E-4

real:: fi

pcor=w2ear_*sin(fi*rad_)

return

end function pcor