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

Bạn có muốn phản ứng với tin nhắn này? Vui lòng đăng ký diễn đàn trong một vài cú nhấp chuột hoặc đăng nhập để tiếp tục.
Diễn đàn Hải Dương học

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


    Code bài tập Unesco

    tieuminh2510
    tieuminh2510
    tieuminh2510

    *****
    *****


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

    Code bài tập Unesco Empty Code bài tập Unesco

    Bài gửi by tieuminh2510 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
    • Về Đầu Trang
      Hôm nay: Sun Sep 29, 2024 8:34 am