Program Statictics Use NetCDF Integer, Parameter :: Yr1=1981, Yr2=2015, Nmon=12, Nday=31 Integer, Parameter :: Nyear=Yr2-Yr1+1, NStx=300, Nvar=4 Real, Parameter :: Miss=-99.0 Character (Len=3), Parameter :: Varn(Nvar)=(/"R","T2m","Tx","Tm"/) Real, Allocatable :: R(:,:,:,:), T2m(:,:,:,:), Tx(:,:,:,:), Tm(:,:,:,:), xtmp(:,:,:,:) Real, Allocatable :: Rtb(:,:), t2mtb(:,:), txtb(:,:), tmtb(:,:) ! Trung binh ngay cac thang Real, Allocatable :: rstd(:,:), t2mstd(:,:), txstd(:,:), tmstd(:,:) ! Do lech chuan ngay cac thang Real, Allocatable :: x1d(:), xtb(:,:), std(:,:) Character (Len=20), Allocatable :: Stname(:) Character (Len=20) :: Station(NStx) Real :: Lon(NStx), Lat(NStx), H(NStx) Integer :: Reg(NStx) Character (Len=255) :: Data_Dir, Fname_Station, Fname Integer :: ist, Nst !-------------------------------------------------- Data_Dir="./" Fname_Station="Danh_Sach_63_Tinh_Thanh.txt" Call StationInfo (Station, Lon, Lat, H, Reg, Nst, Fname_Station, Data_Dir) Allocate (Stname(Nst),R(Nst,Nyear,Nmon,Nday),T2m(Nst,Nyear,Nmon,Nday)) Allocate (Tx(Nst,Nyear,Nmon,Nday),Tm(Nst,Nyear,Nmon,Nday),xtmp(Nst,Nyear,Nmon,Nday)) Ntime=Nyear*Nday Allocate (x1d(Ntime), xtb(Nst,Nmon), std(Nst,Nmon)) Allocate (Rtb(Nst,Nmon), t2mtb(Nst,Nmon), txtb(Nst,Nmon), tmtb(Nst,Nmon)) Allocate (rstd(Nst,Nmon), t2mstd(Nst,Nmon), txstd(Nst,Nmon), tmstd(Nst,Nmon)) Stname(1:Nst)=Station(1:Nst) print*,Stname Data_Dir="/home/tanpv/OBS_Stn/Daily/NC/" Do ivar=1,Nvar xtmp=Miss Fname=trim(Data_Dir)//trim(Varn(ivar))//"_Daily.nc" Call Read_Data(Fname,varn(ivar)) Call Calc_Mean_Std if (ivar==1) then Rtb=xtb; rstd=std elseif (ivar==2) then t2mtb=xtb; t2mstd=std elseif (ivar==3) then txtb=xtb; txstd=std else tmtb=xtb; tmstd=std endif Enddo Call Write_to_TXT ("R_daily_mean.txt",Rtb,"Luong mua trung binh ngay cac thang") Call Write_to_TXT ("T2m_daily_mean.txt",t2mtb,"Nhiet do trung binh ngay cac thang") Call Write_to_TXT ("Tx_daily_mean.txt",txtb,"Nhiet do Toi cao trung binh ngay cac thang") Call Write_to_TXT ("Tm_daily_mean.txt",tmtb,"Nhiet do Toi thap trung binh ngay cac thang") Call Write_to_TXT ("R_daily_std.txt",Rstd,"DLC Luong mua trung binh ngay cac thang") Call Write_to_TXT ("T2m_daily_std.txt",t2mstd,"DLC Nhiet do trung binh ngay cac thang") Call Write_to_TXT ("Tx_daily_std.txt",txstd,"DLC Nhiet do Toi cao trung binh ngay cac thang") Call Write_to_TXT ("Tm_daily_std.txt",tmstd,"DLC Nhiet do Toi thap trung binh ngay cac thang") CONTAINS !-------------------------------------------------- Subroutine Write_to_TXT (Fname,Var, Title) Character (Len=*) :: Title,Fname Integer :: ivar, ist, imon Real :: Var(Nst,Nmon) Open (3, file=trim(Fname),status="unknown") write (3,*)" "//trim(Title) !Luong mua trung binh ngay cac thang " write (3,"(A3,1x,A15,12(3x,A2,I2.2))") "STT","Ten Tram", (("T_",imon), imon=1,Nmon) Do ist=1, Nst write (3,"(I3,1x,A15,12F7.1)") ist, Stname(ist), (Var(ist,imon),imon=1,Nmon) Enddo End Subroutine Write_to_TXT !-------------------------------------------------- Subroutine Calc_Mean_Std Integer :: ist, iyr, imon, iday, ic xtb=Miss; std=Miss Do ist=1,Nst Do imon=1,Nmon ic=0 Do iyr=1,Nyear Do iday=1,Nday if (xtmp(ist,iyr,imon,iday)/=Miss) then ic=ic+1 x1d(ic)=xtmp(ist,iyr,imon,iday) endif Enddo Enddo xtb(ist,imon)=Ave(x1d, ic, Miss) std(ist,imon)=Stdev(x1d, ic, Miss) Enddo Enddo End Subroutine Calc_Mean_Std !-------------------------------------------------- Subroutine Read_Data(Fname,varn) Character (Len=*) :: Fname,varn Integer :: ist, ist1, iyr, iyr1, imon, iday Integer :: Nstn, Nyrs, Nmn, Ndys Real, Allocatable :: X(:,:,:,:), Stn(:), year(:), mon(:), days(:) Character (Len=20), Allocatable :: Stnam(:) Call rd_ncdf_4d (Fname,Stn,year,mon,days,Nstn,Nyrs,Nmn,Ndys,X,trim(varn)) Deallocate (Stn) Call rd_ncdf_1d_Char (Fname,Stn,Nstn,Stnam,"Stname") Loop1: Do ist=1,Nst Do ist1=1,Nstn if (trim(Stnam(ist1))==trim(Stname(ist))) then Do iyr=1,Nyear Do iyr1=1,Nyrs if (year(iyr1)==iyr+Yr1-1) then xtmp(ist,iyr,:,:)=X(ist1,iyr1,:,:) endif Enddo Enddo Cycle Loop1 endif Enddo Enddo Loop1 Deallocate (X,Stnam,Stn,year,mon,days) End Subroutine Read_Data !-------------------------------------------------- Subroutine StationInfo (StaName,Lon, Lat, H, Reg, Nst, Fname_Station, Data_Dir) Implicit None !Integer, Parameter :: NSta = 1000 Real :: Lon(NStx), Lat(NStx), H(NStx) Real :: Rlon, Rlat, RH Integer :: ireg Integer :: i, i1, i2, i3, i4, Reg(NStx), IO, ist, Nst, L Character (Len=20) StaName(NStx), st1, st2, st3, st4,st5 Character :: Str*100 Character (Len=*) :: Fname_Station, Data_Dir Open (1,file=Trim(Data_Dir)//trim(Fname_Station)) read (1,'(A)') Str ! Bo dong dau IO = 0; ist = 0 Do read (1,'(A)',IOstat = IO) Str; print*,trim(Str) if (io /= 0.or.trim(Str)=="") exit L = Len(trim(Str)) st1=""; st2=""; st3=""; st4=""; st5="" i1=0; i2=0; i3=0; i4=0; i=0 do while (i < L) ! Danh dau so thu tu cua dau TAB trong xau i=i+1 if (i1==0.and.Str(i:i)==Char(9)) then i1=i else if (i2==0.and.Str(i:i)==Char(9)) then i2=i else if (i3==0.and.Str(i:i)==Char(9)) then i3=i else if (i4==0.and.Str(i:i)==Char(9)) then i4=i endif enddo st1=Str(1:i1-1); st2=Str(i1+1:i2-1); st3=Str(i2+1:i3-1); st4=Str(i3+1:i4-1); st5=Str(i4+1:L) ist = ist+1 ! So thu tu trong danh sach tram StaName(ist) = st1 ! Tem tram read (st2,*) Lon(ist) ! Kinh do read (st3,*) Lat(ist) ! Vi do read (st4,*) H(ist) ! Do cao read (st5,*) Reg(ist) ! Ky hieu vung Enddo Nst = ist ! Tong so tram trong danh sach tram Close (1) Do ist=1, Nst print '(I3,A,3F8.3,I3)',ist, StaName(ist),Lon(ist), Lat(ist), H(ist), Reg(ist) Enddo End Subroutine StationInfo !--------------------------------------------------------------------- Include "/home/tanpv/Mylibs/sub_rd_ncdf_Tan.F90" Include "/home/tanpv/Mylibs/Stdev.f90" Include "/home/tanpv/Mylibs/Ave.f90" !--------------------------------------------------------------------- END