Diễn đàn Hải Dương học

Giương buồm ra biển lớn !


Code bài tập Unesco

Share
avatar
tieuminh2510

*****
*****

Tổng số bài gửi : 350
Danh dự : 5
Join date : 15/01/2008
Age : 33

Code bài tập Unesco

Bài gửi by tieuminh2510 on Tue Jan 15, 2008 6:26 pm

Code:
program Unesco
   !Khai bao
      !Hang
         parameter(n=65535,p_khong_khi=1009.666,Vi_do=10.39)
      !Nhap         
         allocatable::R(n),t(n),p(n)
      !Xuat
         allocatable::S(n),Ro(n),H(n) 
   !Nhap
      !Nhap tu ban phim
         write(*,*)'So lieu se duoc ghi ra tai file: "CTD Xuat.Dat"         
      !Load du lieu fu file
         open(0,file='CTD.dat',status='old') 
         do i=1,n
            read(0,*) t(i),p(i),R(i)         
         enddo
   !Xu ly      
      !Tinh do muoi S, khoi luong rieng Ro, do cao song H
         do i=1,n                
            S(i)=Tinh_do_muoi(R(i),t(i),p(i))
            Ro(i)=Tinh_khoi_luong_rieng(S(i),t(i),p(i))
            H(i)=Tinh_do_cao_song(p(i),p_khong_khi,Vi_do)
         enddo                  
   !Xuat
      !Xuat ra file CTD Xuat.dat
         open(1,file='CTD Xuat.dat',status='unknown')
         write(1,*) '     s   ','     Ro   ','    H'
         do i=1,n
            write(1,*) s(i),Ro(i),H(i) 
         enddo
read(*,*)
end program Unesco   
!------------------------------------------------------------------------------------
!Ham Tinh Do muoi
real function Tinh_do_muoi(R,t,p)
   !Khai bao
      !Hang
         parameter(k=0.0162)      
      !Nhap
         real a(0:5),b(0:5),c(0:4),e(3),d(0:4)      
      !Xuat         
         real rt,Rp,Rt_,delta_S,s    
   !Nhap         
      data c/0.6766097, 2.00564e-2, 1.104259e-4, -6.9698e-7, 1.0031e-9/
       data e/2.070e-5, -6.370e-10, 3.989e-15/
      data d/1., 3.426e-2, 4.464e-4, 4.215e-1, -3.107e-3/
      data a/0.0080, -0.1692, 25.3851, 14.0941, -7.0261, 2.7081/
      data b/0.0005, -0.0056, -0.0066, -0.0375, 0.0636, -0.0144/      
   !Xu ly
      !Chuan R
         R=R/(42.914*1000)         
      !Tinh rt
         rt=Tong(c,t,0,4,1)
      !Tinh Rp
         Rp=1.+(Tong(e,p,1,3,1)/(Tong(d,t,0,2,1)+(d(3)+d(4)*t)*R))
      !Tinh Rt_xuat
         Rt_=R/(Rp*rt)      
      !Tinh delta_s      
         delta_s=(t-15)*Tong(b,Rt_,0,5,2)/(1.+k*(t-15))
      !Tinh S
         s=Tong(a,Rt_,0,5,2)+delta_s
Tinh_do_muoi=s                                 
end function
!------------------------------------------------------------------------------------
!Tinh khoi luong rieng
real function Tinh_khoi_luong_rieng(S,t,p) 
   !Khai bao
      !Hang
         parameter(d0=4.8314e-4,j0=1.91075e-4)
      !Nhap
         real a(0:5),b(0:4),c(0:2),e(0:4),f(0:3),g(0:2),i(0:2),h(0:3),k(0:2),m(0:2)
      !Xuat
         real ro_0,ro,K_0,K_,A_,B_
   !Nhap
      data a/999.842594, 6.793952e-2, -9.095290e-3, 1.001685e-4, -1.120083e-6, 6.536332e-9/
      data b/8.24493e-1, -4.0899e-3, 7.6438e-5, -8.2467e-7, 5.3875e-9/
      data c/-5.72466e-3, 1.0227e-4, -1.6546e-6/
      data e/19652.21, 148.4206, -2.327105, 1.360477e-2, -5.155288e-5/
      data f/54.6746, -0.603459, 1.09987e-2, -6.1670e-5/
      data g/7.944e-2, 1.6483e-2, -5.3009e-4/
      data h/3.239908, 1.43713e-3, 1.16092e-4, -5.77905e-7/   
      data i/2.2838e-3, -1.0981e-5, -1.6078e-6/   
      data k/8.50935e-5, -6.12293e-6, 5.2787e-8/    
      data m/-9.9348e-7, 2.0816e-8, 9.1697e-10/   
   !Xu ly
      !Tinh Ro_0
         ro_0=Tong(a,t,0,5,1)+Tong(b,t,0,4,1)*S+Tong(c,t,0,2,1)*S**(3./2)+d0*s**2 
      !Tinh K_0
         K_0=Tong(e,t,0,4,1)+Tong(f,t,0,3,1)*S+Tong(g,t,0,2,1)*S**(3./2)
      !Tinh A
         A_=Tong(h,t,0,3,1)+Tong(i,t,0,2,1)*S+j0*S**(3./2)
      !Tinh B
         B_=Tong(k,t,0,2,1)+Tong(m,t,0,2,1)*S
      !Tinh K_
         K_=K_0+A_*p+B_*p**2
      !Tinh ro
         ro=ro_0/(1.-p/K_)   
Tinh_khoi_luong_rieng=ro      
end function
!------------------------------------------------------------------------------------
!Ham tinh do cao song
real function Tinh_do_cao_song(p_nuoc,p_khong_khi,Vi_do)
   !Khai bao   
      !Hang
         parameter(pi=3.141592654)
      !Nhap
         real c(4),gama
      !Xuat
         real p,h,g
   !Nhap
      gama=2.184e-6
      data c/9.72659, -2.2512e-5, 2.279e-10, -1.82e-15/
   !Xu ly
      !Tinh ap suat thuc p
         p=p_nuoc-p_khong_khi
      !Loc cac gia p<0
         if(p<0) then
            p=0
         endif
      !Doi don vi tu mbars -> dbars
         p=p/100.        
      !Tinh g(phi)
         Vi_do=Vi_do/180*pi !Doi do ra radian
         g=9.780318*(1.+5.2788e-3*(sin(Vi_do))**2+2.36e-5*(sin(Vi_do))**4)
      !Tinh do sau z
         h=Tong(c,p,1,4,1)/(g+0.5*gama*p)      
Tinh_do_cao_song=h         
end function   
!------------------------------------------------------------------------------------
!Ham tinh tong
real function Tong(He_so,Gia_tri,Bat_dau,Ket_thuc,Chuan)
   !Khai bao      
      integer Bat_dau,Ket_thuc,Chuan
      real He_so(Bat_dau:Ket_thuc),Gia_tri 
   !Xu ly
      Tong=0.
      do i=Bat_dau,Ket_thuc
         Tong=Tong+He_so(i)*Gia_tri**(1.*i/Chuan)
      enddo
end function

    Hôm nay: Sun Dec 16, 2018 5:02 am