! Chuong trinh doc SL ngay dinh dang text tu thu muc T1, tinh trung binh thang va ghi vao thu muc Monthly_from_Daily ! Cac buoc thuc hien: ! 1. Doc SL ngay va luu vao mang Dat(NYto,Nst,Yr1:Yr2,Nmon,NDay) ! 2. Tinh trung binh khi hau cac gia tri ngay cua R, Tx, Tm, T2m va luu vao mang DatDaily(Nvar_R_T,Nst,Nmon,NDay) ! 3. Bo khuyet nhung gia tri ngay co the duoc bang Sub Fill_Up_Daily_T_R ! 4. Tinh gia tri thang va luu vao mang DatMon(Nvar_Mon,Nst,Yr1:Yr2,Nmon) ! 5. Tinh trung binh khi hau cac gia tri thang cua R, Tx, Tm, T2m va luu vao mang DatMonCli(Nvar_R_T,Nst,Nmon) ! 6. Bo khuyet gia tri thang bang Sub Fill_Up_Monthlyly_T_R ! 7. Ghi ra file ! + Cho phep ghi tat ca cac tram vao cung mot file (Call Write_Monthly_Values(Monthly_Dir)) ! Changed in Feb. 2015: ! + Cho phep ghi ra tung file cho tung tram (Call Write_Monthly_Values_Tram(Monthly_Dir)) Implicit None !Integer, Parameter :: Nmon = 12, Yr1 = 1960, Yr2 = 2011, NYto = 8, Nday = 31, NSta = 250 Integer, Parameter :: Nmon = 12, Yr1 = 1958, Yr2 = 2014, NYto = 8, Nday = 31, NSta = 1000 Integer, Parameter :: Nvar_Mon = 8+5 ! 8 yeu to + Rx + TXx, TNn, VXx, Umn Integer, Parameter :: Nvar_R_T = 4 ! 4 yeu to (R, Tx, Tm, T2m) Character (Len=3), Parameter :: YT(NYto) = (/"R", "Tx", "Tm", "T2m", "Um", "U13", "Vx", "BH"/) ! 8 yeu to Character (Len=4), Parameter :: Var_Mon(Nvar_Mon) = & (/"R", "Txtb", "Tmtb","T2m","Umtb","U13","Vxtb","BH","Rx","Tx","Tm","Vx","Um"/) Character (Len=255) :: Fname, Monthly_Dir, StationList Character (Len=80) :: F_name(NSta*8), Txt_Dir Character (Len=21) :: Station(NSta) ! Ten tram , st1, st2, st3, st4,st5 Real :: Lon(NSta), Lat(NSta), H(NSta) ! Kinh, vi do va do cao tram Real :: Dat_3D(Nday, Nmon, Yr1:Yr2), X(Nmon,Nday) Integer :: iunit1, iunit3, Reg(NSta) ! Ky hieu vung (1-4: B1-B4; 5-7: N1-N3) Integer :: ist, Nst, iyt, iyr, Flag, NTram, NYr, imon,iday Integer :: NFname, ifile, ista, iRegion ! iRegion = 0 : All country ! = 1 : B1; = 2: B2; = 3: B3; = 4: B4; = 5: N1; = 6: N2; = 7: N3 Logical :: exists Real, Allocatable :: Dat(:,:,:,:,:) ! (NYto,Nst,Yr1:Yr2,Nmon,NDay) SL ngay Real, Allocatable :: DatMon(:,:,:,:) ! (NYto,Nst,Yr1:Yr2,Nmon) SL thang Real, Allocatable :: DatDaily(:,:,:,:) ! (NYto,Nst,Nmon,NDay) Trung binh ngay nhieu nam Real, Allocatable :: DatMonCli(:,:,:) ! (NYto,Nst,Nmon,NDay) Trung binh thang nhieu nam !--------------------------------------------------------------------- iRegion = 0 ! = 0 for all country StationList="./Danh_Sach_Tram_KT_va_Tram_Do_Mua_2013-Nov_Sort.txt" !StationList="../Danh_Sach_Tram_KT_va_Tram_Do_Mua_2013-Nov_Sort_N2.txt" ! = 1 : B1; = 2: B2; = 3: B3; = 4: B4; = 5: N1; = 6: N2; = 7: N3 Call StationInfo (Station, Lon, Lat, H, Reg, Nst, iRegion, StationList) ! Doc danh sach ten tram va thong tin tram tu 1 file khac !stop Allocate (Dat(NYto,Nst,Yr1:Yr2,Nmon,NDay)) ! NYto = 8 Allocate (DatMon(Nvar_Mon,Nst,Yr1:Yr2,Nmon)) ! Nvar_Mon = 8+5 Allocate (DatDaily(Nvar_R_T,Nst,Nmon,NDay)) ! Nvar_R_T = 4 (R, Tx, Tm, T2m) Allocate (DatMonCli(Nvar_R_T,Nst,Nmon)) ! Nvar_R_T = 4 (R, Tx, Tm, T2m) Trung binh thang nhieu nam Dat(:,:,:,:,:) = -99.; DatMon(:,:,:,:) = -99.; DatDaily(:,:,:,:) = -99.; DatMonCli(:,:,:) = -99. Print*, "Calling Read_Data_Text" Txt_Dir="All_Data" ! Thu muc chua SL daily day du ! Toan quoc !Monthly_Dir="Monthly_from_Daily" ! Thu muc ghi ra SL monthly, bao gom ca Rx, TXx, TNn Monthly_Dir="Daily_Converted" ! Nhu tren nhung cho tung tram ! Cac vung !Monthly_Dir="Monthly_from_Daily_N2" !Txt_Dir="Tmp" Call Read_Data_Text(Txt_Dir) ! Doc SL daily tu thu muc Txt_Dir (T1) - Da cap nhat day du Print*, "Calculating and Updating Daily values" Call Calc_Daily_Values ! Tinh TB khi hau gia tri ngay Call Fill_Up_Daily_T_R ! Bo khuyet SL ngay bang TB khi hau nhieu nam Print*, "Calculating and Updating Monthly values" Call Calc_Monthly_Values Call Calc_Monthly_Cli Call Fill_Up_Monthly_T_R Print*, "Calling Write_to_Monthly_file" !Call Write_Monthly_Values(Monthly_Dir) ! Gop cac tram thanh 1 file Call Write_Monthly_Values_Tram(Monthly_Dir) ! Tach thanh tung tram !Call Write_to_Binary_file ("BIN/Obs_Daily_Bin_175_R_Station_to_2012.dat") Print*, "Done !" CONTAINS !--------------------------------------------------------------------- Subroutine Write_Monthly_Values_Tram(Monthly_Dir) Integer :: iyt, ist, iyr, imon Real :: W(Nvar_Mon) Character (Len=8) :: Str(Nmon) Character (Len=*) :: Monthly_Dir Do iyt=1, Nvar_Mon ! Open (3,file=trim(Monthly_Dir)//"/"//trim(Var_Mon(iyt))//"_Monthly_from_Daily_61-14.txt",Status="Unknown") Do ist=1, Nst if (.not.Empty_Mon_Value (iyt,ist)) then Open (3,file=trim(Monthly_Dir)//"/"//trim(Var_Mon(iyt))//"_"//trim(Station(ist))//".txt",Status="Unknown") write (3, "(A)") trim(Station(ist)) write (3, "(3F8.3,I4)") Lon(ist), Lat(ist), H(ist), Reg(ist) Do iyr=Yr1, Yr2 W(1:Nmon) = DatMon(iyt,ist,iyr,1:Nmon) if (.not.Empty_Arr1 (W, Nmon)) then Do imon=1, Nmon write (Str(imon),"(F7.1)") DatMon(iyt,ist,iyr,imon); Call All_trim(Str(imon)) Enddo write (3,"(I4.4,12(A,A)") iyr, (Char(9),trim(Str(imon)), imon=1,Nmon) endif Enddo Close(3) endif Enddo Enddo End Subroutine Write_Monthly_Values_Tram !--------------------------------------------------------------------- Subroutine Write_Monthly_Values(Monthly_Dir) Integer :: iyt, ist, iyr, imon Real :: W(Nvar_Mon) Character (Len=8) :: Str(Nmon) Character (Len=*) :: Monthly_Dir Do iyt=1, Nvar_Mon Open (3,file=trim(Monthly_Dir)//"/"//trim(Var_Mon(iyt))//"_Monthly_from_Daily_61-14.txt",Status="Unknown") Do ist=1, Nst if (.not.Empty_Mon_Value (iyt,ist)) then write (3, "(A)") trim(Station(ist)) Do iyr=Yr1, Yr2 W(1:Nmon) = DatMon(iyt,ist,iyr,1:Nmon) if (.not.Empty_Arr1 (W, Nmon)) then Do imon=1, Nmon write (Str(imon),"(F7.1)") DatMon(iyt,ist,iyr,imon); Call All_trim(Str(imon)) Enddo write (3,"(I4.4,12(A,A)") iyr, (Char(9),trim(Str(imon)), imon=1,Nmon) endif Enddo endif Enddo Enddo End Subroutine Write_Monthly_Values !--------------------------------------------------------------------- Logical Function Empty_Mon_Value (iyt,ist) Logical :: Empty Integer :: iyr, imon, ist, iyt Empty = .true. Do iyr = Yr1, Yr2 Do imon = 1, Nmon if (DatMon (iyt,ist,iyr,imon) /= -99.) then Empty = .false. exit endif Enddo Enddo Empty_Mon_Value = Empty End Function Empty_Mon_Value !--------------------------------------------------------------------- Subroutine All_trim(Str) Character *(*) :: Str Character (Len=255) :: St1 Integer :: i1, i2 St1 = Str; i2 = Len(trim(St1)); Str = ""; i1=1 Do if (St1(i1:i1) /= " ") exit; i1 = i1+1 Enddo Str = St1(i1:i2) End Subroutine All_trim !--------------------------------------------------------------------- Subroutine Calc_Monthly_Values ! YT(NYto) = (/"R", "Tx", "Tm", "T2m", "Um", "U13", "Vx", "BH"/) ! 8 yeu to Integer :: iyt, ist, iyr, imon, iday, ic, NdayOfMon Integer :: Ops Real :: Tmp, Tmpx, Tmpn Do iyt=1, NYto Do ist=1, Nst if (.not.Empty_Sta (iyt,ist)) then Do iyr=Yr1, Yr2 if (.not.Empty_Year (iyt,ist,iyr)) then Do imon=1, Nmon ic = 0; Tmp = 0; Tmpx = -9999; Tmpn = 9999; NdayOfMon = DayOfMonth (imon, iyr) Do iday=1, NdayOfMon if (Dat(iyt,ist,iyr,imon,iday) /= -99.) then ic=ic+1; Tmp = Tmp + Dat(iyt,ist,iyr,imon,iday) if (Dat(iyt,ist,iyr,imon,iday) > Tmpx) Tmpx = Dat(iyt,ist,iyr,imon,iday) ! TXx, Rx, VXx if (Dat(iyt,ist,iyr,imon,iday) < Tmpn) Tmpn = Dat(iyt,ist,iyr,imon,iday) ! TNn, Umn endif Enddo if (ic>25) then Tmp = Tmp/real(ic) if (iyt==1) then DatMon(iyt,ist,iyr,imon)=Tmp*NdayOfMon ! Tong luong mua thang DatMon(NYto+1,ist,iyr,imon)=Tmpx ! Luong mua ngay cuc dai thang (Rx) else if (iyt==2) then DatMon(iyt,ist,iyr,imon)=Tmp ! Nhiet do cuc dai trung binh thang (Txtb) DatMon(NYto+2,ist,iyr,imon)=Tmpx ! Nhiet do cuc dai ngay lon nhat thang (Tx) else if (iyt==3) then DatMon(iyt,ist,iyr,imon)=Tmp ! Nhiet do cuc tieu trung binh thang (Tmtb) DatMon(NYto+3,ist,iyr,imon)=Tmpn ! Nhiet do cuc tieu ngay nho nhat thang (Tm) else if (iyt==7) then ! So TT cua Vx la 7 DatMon(iyt,ist,iyr,imon)=Tmp ! Toc do gio lon nhat trung binh thang (Vxtb) DatMon(NYto+4,ist,iyr,imon)=Tmpx ! Toc do gio lon nhat tuyet doi thang (VXx) else if (iyt==5) then ! So TT cua Um la 5 DatMon(iyt,ist,iyr,imon)=Tmp ! Do am tuong doi cuc tieu trung binh thang (Umtb) DatMon(NYto+5,ist,iyr,imon)=Tmpn ! Do am tuong doi nho nhat tuyet doi thang (Umn) else DatMon(iyt,ist,iyr,imon)=Tmp ! Gia tri trung binh thang cua cac yeu to khac endif endif Enddo endif Enddo endif Enddo Enddo End Subroutine Calc_Monthly_Values !------------------------------------------------------------------------------------- Subroutine Calc_Daily_Values ! YT(NYto) = (/"R", "Tx", "Tm", "T2m", "Um", "U13", "Vx", "BH"/) ! 8 yeu to ! Allocate (DatDaily(Nvar_R_T,Nst,Nmon,NDay)) ! Nvar_R_T = 4 (R, Tx, Tm, T2m) Integer :: iyt, ist, iyr, imon, iday, ic, NdayOfMon Integer :: Nyrs Real :: Tmp Real, Allocatable :: w(:) Nyrs = Yr2 - Yr1 + 1; Allocate (w(1:Nyrs)) Do iyt=1, Nvar_R_T Do ist=1, Nst if (.not.Empty_Sta (iyt,ist)) then Do imon=1, Nmon NdayOfMon = DayOfMonth_No_leap (imon) ! Khong tinh ngay NHUAN Do iday=1, NdayOfMon w(1:Nyrs) = Dat(iyt,ist,Yr1:Yr2,imon,iday) if (.not.Empty_Arr1 (W, Nyrs)) then ic = 0; Tmp = 0 Do iyr=Yr1, Yr2 if (Dat(iyt,ist,iyr,imon,iday) /= -99.) then ic=ic+1; Tmp = Tmp + Dat(iyt,ist,iyr,imon,iday) endif Enddo if (ic>20) then ! Can co chuoi do dai it nhat 20 nam Tmp = Tmp/real(ic); DatDaily(iyt,ist,imon,iday) = Tmp ! Trung binh ngay nhieu nam endif endif Enddo Enddo endif Enddo Enddo Deallocate (W) End Subroutine Calc_Daily_Values !--------------------------------------------------------------------- Subroutine Calc_Monthly_Cli Integer :: iyt, ist, iyr, imon, iday, ic Integer :: Nyrs Real :: Tmp Real, Allocatable :: w(:) Nyrs = Yr2 - Yr1 + 1; Allocate (w(1:Nyrs)) Do iyt=1, Nvar_R_T ! = 4 (R, Tx, Tm, T2m) Do ist=1, Nst if (.not.Empty_Sta (iyt,ist)) then Do imon=1, Nmon w(1:Nyrs) = DatMon(iyt,ist,Yr1:Yr2,imon) if (.not.Empty_Arr1 (W, Nyrs)) then ic = 0; Tmp = 0 Do iyr=Yr1, Yr2 if (DatMon(iyt,ist,iyr,imon) /= -99.) then ic=ic+1; Tmp = Tmp + DatMon(iyt,ist,iyr,imon) endif Enddo if (ic>20) then ! Can co chuoi do dai it nhat 20 nam Tmp = Tmp/real(ic); DatMonCli(iyt,ist,imon) = Tmp ! Trung binh thang nhieu nam endif endif Enddo endif Enddo Enddo Deallocate (W) End Subroutine Calc_Monthly_Cli !--------------------------------------------------------------------- Subroutine Fill_Up_Daily_T_R Integer :: iyt, ist, iyr, imon, iday, ic, NdayOfMon Real :: w(Nday) Do iyt=1, Nvar_R_T Do ist=1, Nst if (.not.Empty_Sta (iyt,ist)) then Do iyr=Yr1, Yr2 if (.not.Empty_Year (iyt,ist,iyr)) then Do imon=1, Nmon NdayOfMon = DayOfMonth_No_leap (imon); w(1:NdayOfMon) = Dat(iyt,ist,iyr,imon,1:NdayOfMon) if (.not.Empty_Arr1 (W, NdayOfMon)) then Do iday=1, NdayOfMon if (Dat(iyt,ist,iyr,imon,iday) == -99.) Dat(iyt,ist,iyr,imon,iday) = DatDaily(iyt,ist,imon,iday) Enddo endif Enddo endif Enddo endif Enddo Enddo End Subroutine Fill_Up_Daily_T_R !--------------------------------------------------------------------- Subroutine Fill_Up_Monthly_T_R Integer :: iyt, ist, iyr, imon, iday, ic, NdayOfMon Real :: w(Nday) Do iyt=1, Nvar_R_T Do ist=1, Nst if (.not.Empty_Sta (iyt,ist)) then Do iyr=Yr1, Yr2 w(1:Nmon) = DatMon(iyt,ist,iyr,1:Nmon) if (.not.Empty_Arr1 (W,Nmon)) then Do imon=1, Nmon if (DatMon(iyt,ist,iyr,imon) == -99.) DatMon(iyt,ist,iyr,imon) = DatMonCli(iyt,ist,imon) Enddo endif ! if (iyr == 2014) DatMon(iyt,ist,iyr,11:12) = -99. ! Cac thang 10-12/2014 chua co SL Enddo endif Enddo Enddo End Subroutine Fill_Up_Monthly_T_R !--------------------------------------------------------------------- Logical Function Empty_Arr1 (W, N) Integer :: N, i Real :: W(N) Logical :: Empty Empty = .true. Do i=1, N if (W(i) /= -99.) then Empty = .false.; exit endif Enddo Empty_Arr1 = Empty End Function Empty_Arr1 !------------------------------------------------------------------------------------- Integer Function DayOfMonth_No_leap (Mon) Integer :: Mon Select Case (Mon) Case (1,3,5,7,8,10,12) DayOfMonth_No_leap = 31 Case (4,6,9,11) DayOfMonth_No_leap = 30 Case (2) DayOfMonth_No_leap = 28 End Select End Function DayOfMonth_No_leap !------------------------------------------------------------------------------------- Integer Function DayOfMonth (Mon, Year) Integer :: Mon, Year Select Case (Mon) Case (1,3,5,7,8,10,12) DayOfMonth = 31 Case (4,6,9,11) DayOfMonth = 30 Case (2) if ((MOD(Year, 4) == 0).AND.(MOD(Year, 100) /= 0)) then DayOfMonth = 29 else DayOfMonth = 28 endif if (MOD(Year, 400) == 0) DayOfMonth = 29 End Select End Function DayOfMonth !------------------------------------------------------------------------------------- Subroutine Read_Data_Text (Txt_Dir) Character (Len=*) :: Txt_Dir Call Get_Filename (Txt_Dir) do ifile=1,Nfname Do iyt=1,NYto if (trim(Get_SubStr(f_name(ifile),"/","_")) == trim(YT(iyt))) then ! Trich YT tu ten file (VD ../All_1/BH_ALUOI.txt) ! print*,ifile," ",trim(f_name(ifile))," >>> ", Get_SubStr(f_name(ifile),"_",".") ! Trich ten tram tu ten file ista = 0 Call Get_StaInfo (Get_SubStr(f_name(ifile),"_","."), ista) ! Xac dinh chi so thu tu ten tram (ista) trong Station(:) if (ista > 0) then Call Read_One_Sta ! Doc SL cua mot tram (tat ca cac nam) luu vao mang Dat ! print*, Lon(ista), Lat(ista), H(ista), Reg(ista) endif endif Enddo enddo End Subroutine Read_Data_Text !------------------------------------------------------------------------------------- Subroutine Read_One_Sta Integer :: imon, iday, day, IO Real :: w1(Nmon) Open (1,file=f_name(ifile)) IO = 0; Read (1,*); Read (1,*) ! Bo 2 dong dau Do if (IO /= 0) exit read (1,*, IOStat=IO) iyr if (iyr > Yr2) Exit ! Chi lay den Yr2, mac du chuoi SL co the dai hon (2013 chang han) Do iday=1,NDay read (1,*,IOStat=IO) day, (Dat(iyt,ista,iyr,imon,iday), imon=1,Nmon) ! read (1,*,IOStat=IO) day, (w1(imon), imon=1,Nmon) ! Do imon=1,Nmon ! if (w1(imon) /= -99..and.Dat(iyt,ista,iyr,imon,iday) == -99.) Dat(iyt,ista,iyr,imon,iday)=w1(imon) ! Enddo Enddo Enddo Close (1) End Subroutine Read_One_Sta !------------------------------------------------------------------------------------- Subroutine Get_StaInfo (StaName, ista) Character (Len=*) :: StaName Integer :: ist, ista Do ist=1,Nst if (trim(StaName) == trim(Station(ist))) then ista = ist exit endif Enddo End Subroutine Get_StaInfo !------------------------------------------------------------------------------------- Character (Len=21) Function Get_SubStr (St,st1,st2) Character (Len=*) :: St Character (Len=1) :: St1, ST2 Integer :: i1, i2 i1 = index(St,St1,.true.); i2 = index(St,St2,.true.) Get_SubStr = St(i1+1:i2-1) End Function Get_SubStr !------------------------------------------------------------------------------------- Subroutine Get_Filename (Txt_Dir) Character (Len=*) :: Txt_Dir Integer :: IO, iflie, isys, system isys = system ('rm -f File.list') isys = system ('ls '//trim(Txt_Dir)//'/* | cat > File.list') !isys = system ('ls T1/* | cat > File.list') Open (1,file="File.list") IO = 0; ifile = 0 Do ! if (IO /= 0 .OR.) exit ifile = ifile+1 read (1,"(A)",IOStat=IO) F_name(ifile) if (IO /= 0) exit Enddo NFname = ifile-1 End Subroutine Get_Filename !--------------------------------------------------------------------- Logical Function Empty_Sta (iyt,ist) Logical :: Empty Integer :: iyr, imon, iday, ist, iyt Empty = .true. Do iyr = Yr1, Yr2 Do imon = 1,Nmon Do iday = 1,Nday if (Dat (iyt,ist,iyr,imon,iday) /= -99.) then Empty = .false. exit endif Enddo Enddo Enddo Empty_Sta = Empty End Function Empty_Sta !-------------------------------------------------- Logical Function Empty_Year (iyt,ist,iyr) Logical :: Empty Integer :: imon, iday, iyr, iyt, ist Empty = .true. Do imon = 1,Nmon Do iday = 1,Nday if (Dat (iyt,ist,iyr,imon,iday) /= -99.) then Empty = .false. exit endif Enddo Enddo Empty_Year = Empty End Function Empty_Year !--------------------------------------------------------------------- Subroutine Write_test Integer :: iyt, ist, iyr, imon, iday Print*,"Writing test" Do iyt=1, NYto Do ist=1, Nst if (.not.Empty_Sta (iyt,ist)) then write (*,"(I4,A,3F8.3,I4)") ist, Station(ist), Lon(ist), Lat(ist), H(ist), Reg(ist) Do iyr=Yr1, Yr2 if (.not.Empty_Year (iyt,ist,iyr)) then write (*,*) iyr Do iday=1,Nday write (*,"(I2,12F7.1)") iday, (Dat(iyt,ist,iyr,imon,iday), imon=1,Nmon) Enddo endif Enddo endif Enddo End do End Subroutine Write_test !--------------------------------------------------------------------- Subroutine StationInfo (StaName,Lon, Lat, H, Reg, Nst, iRegion, Fname) ! iRegion = 0 : All country ! = 1 : B1; = 2: B2; = 3: B3; = 4: B4; = 5: N1; = 6: N2; = 7: N3 Implicit None Integer, Parameter :: NSta = 1000 Real :: Lon(NSta), Lat(NSta), H(NSta) Real :: Rlon, Rlat, RH Integer :: iRegion, ireg Integer :: i, i1, i2, i3, i4, Reg(NSta), IO, ist, Nst, L Character (Len=21) StaName(NSta), st1, st2, st3, st4,st5 Character :: Str*255 Character (Len=*) :: Fname Open (1,file=Trim(Fname),Status="Old") read (1,"(A)") Str ! Bo dong dau print*,Str IO = 0; ist = 0 Do read (1,'(A)',IOstat = IO) 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) if (iRegion == 0) then 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 else read (st2,*) Rlon read (st3,*) Rlat read (st4,*) RH read (st5,*) ireg if (ireg == iRegion) then ist = ist+1 StaName(ist) = st1; Lon(ist) = Rlon; Lat(ist) = Rlat; H(ist) = RH; Reg(ist) = ireg endif endif 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 END ! Main Program !--------------- END of FILE ----------------