Use NetCDF Real, Parameter :: Miss=-99.0 Integer, Parameter :: Nreg=3, Nmon=12, Yr1=1962 Integer :: Nst, Ntime, Nyrs, Nday Character (Len=20), Allocatable :: Stname(:) Real, Allocatable :: Dat(:,:,:), Year(:), Mon(:), Lon(:), Lat(:), H(:), Reg(:) Integer :: ist, iyr, imon, iday, ilon, ilat, ireg Integer, Parameter :: NScale=4, Scales(NScale)=(/1,3,6,12/) ! 1,3,6,12 mon Real, Parameter :: Thres=-1.0 Character (Len=100) :: DirOut, Fname1,Fname2,Fname3 !--------------------------------------------------------------------- !Real, Allocatable :: SPI(:,:,:) ! (Nst,Ntime,NScale) Real, Allocatable :: Event(:,:,:) ! (Nst,Ntime,NScale) =0/1 Real, Allocatable :: Freq(:,:) ! (Nst,NScale) - So thang han trung binh nam Real, Allocatable :: Fr_mon(:,:,:) ! (Nst,Nmon,NScale) - Tan suat han trung binh thang Real, Allocatable :: NSpells(:,:) ! (Nst,NScale) - Cac dot Real, Allocatable :: Dur(:,:,:) ! (Nst,NSpells(:,:),NScale) Do dai cua tung dot Real, Allocatable :: Dur_M(:,:) ! (Nst,NScale) - Do dai trung binh Real, Allocatable :: Dur_X(:,:) ! (Nst,NScale) - Do dai Max Real, Allocatable :: Sev(:,:,:) ! (Nst,NSpells(:,:),NScale) Sev cua tung dot Real, Allocatable :: Sev_M(:,:) ! (Nst,NScale) - Sev trung binh Real, Allocatable :: Sev_X(:,:) ! (Nst,NScale) - Sev Max Real, Allocatable :: Geo(:,:,:) ! (Nreg,Ntime,NScale) Character (Len=255) :: Fname !--------------------------------------------------------------------- !Fname="/home/tanpv/Progs/Dr_OBS/SPI_RES/SPI_Stn_B1-3.nc" Fname="/home/tanpv/Progs/Dr_OBS/SPI_RES/SPEI_Stn_B1-3.nc" Call Read_Dr_IDX (Fname) Nyrs=Ntime/Nmon ! So nam co so lieu print*,Nst,Nyrs,Ntime Call Calc_Event Call Calc_Chars Fname="/home/tanpv/Progs/Dr_OBS/Dr_SPEI_Stn_B1-3.txt" Call Write_Char_to_TXT (Fname) CONTAINS !--------------------------------------------------------------------- Subroutine Write_Char_to_TXT (Fname) Character (Len=*) :: Fname Integer :: iidx, ist, it, imon Open (3,file=Fname,status="Unknown") write (3,*) "Cac dac trung han han khu vuc Bac Bo (B1-B3) theo chi so SPI" write (3,*) "Ghi chu: " write (3,*) "Dur: Do keo dai; Sev: Do khac nghiet; Freq: Tan so; M: Trung binh; X: Cuc dai" Do iidx=1,NScale write (3,*) "Quy mo thoi gian: ", Scales(iidx)," thang" write (3,"(A3,A20,10A10)") "STT", "Tram", "lon", "lat", "Freq", "Dur_M", "Dur_X", "Sev_M", "Sev_X","Spell" Do ist=1,Nst write (3,"(I3,1x,A19,2F10.3,5F10.2,F10.1)") ist,trim(Stname(ist)),Lon(ist),Lat(ist),Freq(ist,iidx),Dur_M(ist,iidx),Dur_X(ist,iidx), & Sev_M(ist,iidx), Sev_X(ist,iidx), NSpells(ist,iidx)/Nyrs Enddo Enddo write (3,*) "-------------------------------" write (3,*) "Tan suat xuat hien han trong tung thang" Do iidx=1,NScale write (3,*) "Quy mo thoi gian: ", Scales(iidx)," thang" write (3,"(A3,A20,2A10,12I7)") "STT", "Tram", "lon", "lat", (imon,imon=1,Nmon) Do ist=1,Nst write (3,"(I3,1x,A19,2F10.3,12F7.2)") ist,trim(Stname(ist)),Lon(ist),Lat(ist),(Fr_mon(ist,imon,iidx),imon=1,Nmon) Enddo Enddo write (3,*) "-------------------------------" write (3,*) "Dien tich bi han (phan tram so tram co han)" Do iidx=1,NScale write (3,*) "Quy mo thoi gian: ", Scales(iidx)," thang" write (3,"(A4,1x,4A7)") "Nam","B1","B2","B3","B1-B3" Do it=1,Nyrs write (3,"(I4,1x,4F7.2)") it+Yr1-1, (Geo(ireg,it,iidx),ireg=1,Nreg+1) Enddo Enddo Close(3) End Subroutine Write_Char_to_TXT !--------------------------------------------------------------------- Subroutine Write_Char_to_NC(Fname) Character (Len=*) :: Fname Real, allocatable :: StnID(:), XScale(:), year(:), mon(:) Allocate (StnID(Nst),XScale(NScale),year(Nyrs),mon(Nmon)) Do ist=1,Nst; StnID(ist)=ist; Enddo ! StnID XScale(:)=Scales(:) ! Drought Scales Do iyr=1,Nyrs; year(iyr)=iyr+Yr1-1; Enddo ! Years Do imon=1,Nmon; mon(inom)=imon; Enddo ! Months End Subroutine Write_Char_to_NC !--------------------------------------------------------------------- Subroutine Calc_Chars Integer :: iidx, ireg, ist, iyr, it, ispl, n1,n2,n3,n4,n5,n6,n7,n8,n9 Real, Allocatable :: Spells(:), X(:), SDate(:), EDate(:) Real :: tmp, tmpx, N_Spell, Imax, tmp1, tmp2 Integer :: imon,imon1 Allocate (X(Ntime),Spells(Ntime),SDate(Ntime),EDate(Ntime)) Allocate (NSpells(Nst,NScale),Freq(Nst,NScale),Dur(Nst,Ntime,NScale),Sev(Nst,Ntime,NScale)) Allocate (Dur_M(Nst,NScale),Dur_X(Nst,NScale),Sev_M(Nst,NScale),Sev_X(Nst,NScale)) Allocate (Geo(Nreg+1,Ntime,NScale),Fr_mon(Nst,Nmon,NScale)) NSpells(:,:)=Miss; Dur(:,:,:)=Miss; Sev(:,:,:)=Miss Dur_M=Miss; Dur_X=Miss; Sev_M=Miss; Sev_X=Miss; Geo=Miss; Fr_mon=Miss Do iidx=1,NScale Do ist=1,Nst X(1:Ntime)=Event(ist,1:Ntime,iidx) tmp=0 Do it=1,Ntime; if (X(it)/=Miss.AND.X(it)==1) tmp=tmp+1; Enddo Freq(ist,iidx)=tmp/Nyrs ! So thang han trong nam Call ESpells (X, Ntime, Imax, Spells, N_Spell, SDate, EDate, Miss) NSpells(ist,iidx)=N_Spell ! So dot han tmp=0; tmpx=Miss Do ispl=1,Int(N_Spell) Dur(ist,ispl,iidx)=Spells(ispl) ! Do dai tung dot tmp=tmp+Spells(ispl) ! Tong do dai if (Spells(ispl)>tmpx) tmpx=Spells(ispl) ! Do dai Max Enddo Dur_M(ist,iidx)=tmp/N_Spell ! Do dai trung binh Dur_X(ist,iidx)=tmpx ! Do dai Max tmp1=0; tmp2=0 Do ispl=1,Int(N_Spell) tmp=0; Do it=Int(SDate(ispl)), Int(Edate(ispl)) if (Dat(ist,it,iidx)/=Miss.AND.Dat(ist,it,iidx)<=Thres) then tmp=tmp+Dat(ist,it,iidx) endif Enddo Sev(ist,ispl,iidx)=tmp ! Severity of each spell tmp1=tmp1+tmp ! Tong cac dot if (tmpThres) then Event(ist,it,iidx)=0 endif Enddo Enddo Enddo End Subroutine Calc_Event !--------------------------------------------------------------------- Subroutine Read_Dr_IDX (Fname) Character (Len=*) :: Fname Real, Allocatable :: X(:,:), StnID(:), xtime(:), xlon(:), xlat(:), xreg(:) Integer :: Nt Call rd_ncdf_2d (Fname,StnID,xtime,Nst,Nt,X,"SPI_01") Ntime=Nt-12 ! Chuoi SL thang da tru di nam dau tien Allocate (Dat(Nst,Nt,NScale)) Dat(:,1:Ntime,1) = X(:,Nmon+1:Nt) ! SPI_01 Deallocate (StnID,xtime,X) Call rd_ncdf_2d (Fname,StnID,xtime,Nst,Nt,X,"SPI_03") Dat(:,1:Ntime,2) = X(:,Nmon+1:Nt) ! SPI_03 Deallocate (StnID,xtime,X) Call rd_ncdf_2d (Fname,StnID,xtime,Nst,Nt,X,"SPI_06") Dat(:,1:Ntime,3) = X(:,Nmon+1:Nt) ! SPI_06 Deallocate (StnID,xtime,X) Call rd_ncdf_2d (Fname,StnID,xtime,Nst,Nt,X,"SPI_12") Dat(:,1:Ntime,4) = X(:,Nmon+1:Nt) ! SPI_12 Deallocate (StnID,xtime,X) Call rd_ncdf_1d (Fname,StnID,Nst,lon,"lon") Deallocate (StnID) Call rd_ncdf_1d (Fname,StnID,Nst,lat,"lat") Deallocate (StnID) Call rd_ncdf_1d (Fname,StnID,Nst,reg,"reg") Deallocate (StnID) Call rd_ncdf_1d_Char (Fname, StnID, Nst, Stname, "stname") End Subroutine Read_Dr_IDX !----------------------------------------------------------------------- Include "/home/tanpv/Mylibs/sub_rd_ncdf_Tan.F90" Include "/home/tanpv/Mylibs/sub_wr_ncdf_Tan.F90" Include "/home/tanpv/Mylibs/DayOfMon.f90" Include "/home/tanpv/Mylibs/Sub_Spells.f90" !Include "/home/tanpv/Mylibs/Sub_Percentile.f90" Include "/home/tanpv/Mylibs/Sub_Trend_MK_Linear.f90" !----------------------------------------------------------------------- END