Program Read_NC_Result_Write_to_GrADS_Stn Use Netcdf Implicit None Character (Len=21), Allocatable :: Station(:) Real, Allocatable :: Num_Dr_Mon(:,:) ! So thang han theo cac chi so cua cac tram Real, Allocatable :: Fre(:,:,:) ! Tan suat han theo cac chi so cua cac tram cua cac thang (12 thang) Real, Allocatable :: Mag(:,:,:) ! Cuong do han theo cac chi so cua cac tram cua cac thang (12 thang) Real, Allocatable :: Fre_all(:,:) ! Tan suat han theo cac chi so cua cac tram cua toan chuoi Real, Allocatable :: Mag_all(:,:) ! Cuong do han theo cac chi so cua cac tram cua toan chuoi Real, Allocatable :: Sensl(:,:), Prob(:,:) ! Sen's slope va Probability theo cac chi so cua cac tram Real, Allocatable :: Spell_Ave(:,:), Spell_Max(:,:), Time_Arr_Ave(:,:), Time_Arr_Max(:,:) ! Spell & Time arrival Real, Allocatable :: TQ(:,:), Prob1(:,:) ! Correlation Coefficients (PDSI - SPEI, SPI, scPDSI - SPEI, SPI, SPEI - SPI (12 cap) Real, Allocatable :: XStn(:), Xidx(:), Lat(:), Lon(:), Reg(:), Cor(:) Real, Allocatable :: X(:,:) Integer :: Nst, Nmon, Nidx, Nidx_1, Nidx_3, Nidx_18, Ntq_12 Integer :: ist, idx, imon Real :: Rmiss Logical :: status Character (Len=30) :: FName Character (Len=100) :: Title !----------------------------------------------------------------------------------- Integer, Parameter :: Nvars=18, Nidx_6=6, NCor=12 Character (Len=15), Parameter :: Varn(Nvars)=(/"pdsi_mod","scpdsi_mod","spei06_mod","spei12_mod","spi06_mod","spi12_mod", & "pdsi_sev","scpdsi_sev","spei06_sev","spei12_sev","spi06_sev","spi12_sev", & "pdsi_ext","scpdsi_ext","spei06_ext","spei12_ext","spi06_ext","spi12_ext"/) Character (Len=15), Parameter :: IDX_Name(Nidx_6)=(/"pdsi","scpdsi","spei06","spei12","spi06","spi12"/) Character (Len=15), Parameter :: Cor_Name(NCor)=(/"pdsi-spei06","pdsi-spei12","pdsi-spi06","pdsi-spi12", & "scpdsi-spei06","scpdsi-spei12","scpdsi-spi06","scpdsi-spi12", & "spei06-spi06","spei12-spi12","spei06-spi06","spei12-spi12"/) !================================================================================== !Varn(1)="pdsi_mod"; Varn(2)="scpdsi_mod"; Varn(3)="spei06_mod"; Varn(4)="spei12_mod"; Varn(5)="spi06_mod"; Varn(6)="spi12_mod" !Varn(7)="pdsi_sev"; Varn(8)="scpdsi_sev"; Varn(9)="spei06_sev"; Varn(10)="spei12_sev"; Varn(11)="spi06_sev"; Varn(12)="spi12_sev" !Varn(13)="pdsi_ext"; Varn(14)="scpdsi_ext"; Varn(15)="spei06_ext"; Varn(16)="spei12_ext"; Varn(17)="spi06_ext"; Varn(18)="spi12_ext" !----------------------------------------------------------------------------------- Call Read_data_NC Title="So thang han trong toan chuoi SL theo cac chi so cua cac tram" Call Write_To_TEXT (Num_Dr_Mon, Nst, Nvars, Lon, Lat, Reg, Varn, Title, "Num_Dr_Mon.txt") Title="Tan suat han theo cac chi so cua cac tram cua toan chuoi" Call Write_To_TEXT (Fre_all, Nst, Nvars, Lon, Lat, Reg, Varn, Title, "Fre_all.txt") Title="Cuong do han theo cac chi so cua cac tram cua toan chuoi" Call Write_To_TEXT (Mag_all, Nst, Nvars, Lon, Lat, Reg, Varn, Title, "Mag_all.txt") Title="Sen's slopes theo cac chi so cua cac tram" Call Write_To_TEXT (Sensl, Nst, Nidx_6, Lon, Lat, Reg, IDX_Name, Title, "Sensl.txt") Title="P-values cua Sen's slopes theo cac chi so cua cac tram" Call Write_To_TEXT (Prob, Nst, Nidx_6, Lon, Lat, Reg, IDX_Name, Title, "Prob_Sensl.txt") Title="Do dai Trung binh cac dot han" Call Write_To_TEXT (Spell_Ave, Nst, Nvars, Lon, Lat, Reg, Varn, Title, "Spell_Ave.txt") Title="Do dai Cuc dai cac dot han" Call Write_To_TEXT (Spell_Max, Nst, Nvars, Lon, Lat, Reg, Varn, Title, "Spell_Max.txt") Title="Khoang thoi gian Trung binh giua hai dot han lien tiep" Call Write_To_TEXT (Time_Arr_Ave, Nst, Nvars, Lon, Lat, Reg, Varn, Title, "Time_Interval_Ave.txt") Title="Khoang thoi gian Cuc dai giua hai dot han lien tiep" Call Write_To_TEXT (Time_Arr_Max, Nst, Nvars, Lon, Lat, Reg, Varn, Title, "Time_Interval_Max.txt") Title="He so tuong quan giua cac chi so han (pdsi, scpdsi, spei06, spei12, spi06, spi12)" Call Write_To_TEXT (TQ, Nst, NCor, Lon, Lat, Reg, Cor_Name, Title, "Corre_IDX.txt") Title="P-values cua cac He so tuong quan giua cac chi so han (pdsi, scpdsi, spei06, spei12, spi06, spi12)" Call Write_To_TEXT (Prob1, Nst, NCor, Lon, Lat, Reg, Cor_Name, Title, "Prob_Corre_IDX.txt") !Do idx=1, Nidx_18 ! print*, Mag(idx,:,:) !Enddo !print*, Lon; print*, Lat; print*, Reg ; pause Call Write_GrADS_Stn (Num_Dr_Mon, Lon, Lat, Nst, Nidx_3, "Num_Dr_Mon", "./", "Dr_Mon") print*,"Write to Grads Num_Dr_Mon Done" Call Write_GrADS_Stn (Sensl, Lon, Lat, Nst, Nidx_1, "Sensl", "./", "Sensl" ) Call Write_GrADS_Stn (Prob, Lon, Lat, Nst, Nidx_1, "Prob", "./", "Prob" ) Call Write_GrADS_Stn (Spell_Ave, Lon, Lat, Nst, Nidx_18,"Spell_Ave", "./", "Spell_Ave") Call Write_GrADS_Stn (Spell_Max, Lon, Lat, Nst, Nidx_18,"Spell_Max", "./", "Spell_Max") Call Write_GrADS_Stn (Time_Arr_Ave, Lon, Lat, Nst, Nidx_18,"Time_Arr_Ave", "./", "Time_Arr_Ave") Call Write_GrADS_Stn (Time_Arr_Max, Lon, Lat, Nst, Nidx_18,"Time_Arr_Max", "./", "Time_Arr_Max") Call Write_GrADS_Stn (Fre_all, Lon, Lat, Nst, Nidx_18,"Fre_all", "./", "Fre_all") Call Write_GrADS_Stn (Mag_all, Lon, Lat, Nst, Nidx_18,"Mag_all", "./", "Mag_all") Call Write_GrADS_Stn (TQ, Lon, Lat, Nst, Ntq_12, "Corre", "./", "Corre") Call Write_GrADS_Stn (Prob1, Lon, Lat, Nst, Ntq_12, "Prob1", "./", "Prob1") Allocate(X(Nst,Nidx_18)) Do imon=1, Nmon X(:,:) = Fre(:,:,imon); write(Fname,"(A,I2.2)") "Fre_", imon Call Write_GrADS_Stn (X, Lon, Lat, Nst, Nidx_18, trim(FName), "./", "Fre") X(:,:) = Mag(:,:,imon); write(Fname,"(A,I2.2)") "Mag_", imon Call Write_GrADS_Stn (X, Lon, Lat, Nst, Nidx_18, trim(FName), "./", "Mag") Enddo CONTAINS !================================================================================== Subroutine Read_data_NC Integer :: ist, isev, idx, id Character (Len=6), Parameter :: IdxStr(6)=(/"pdsi","scpdsi","spi01","spi03","spi06","spi12"/) Character (Len=3), Parameter :: SevStr(3)=(/"mod","sev","ext"/) Character (Len=15) :: VarName Real, Allocatable :: X(:,:) Call rd_ncdf_2d ("Num_Drou_Mon_Stn.nc", XStn, Xidx, Nst, Nidx_3, Num_Dr_Mon, "N_Drou_mon") Deallocate (XStn, Xidx) Call rd_ncdf_2d ("Sen_Prob_idx_Stn.nc", XStn, Xidx, Nst, Nidx_1, Sensl, "SenSL") Deallocate (XStn, Xidx) Call rd_ncdf_2d ("Sen_Prob_idx_Stn.nc", XStn, Xidx, Nst, Nidx_1, Prob, "Prob") Deallocate (XStn, Xidx) Call rd_ncdf_2d ("Spell_Time_Arr_Stn.nc", XStn, Xidx, Nst, Nidx_18, Spell_Ave, "Spell_Ave") Deallocate (XStn, Xidx) Call rd_ncdf_2d ("Spell_Time_Arr_Stn.nc", XStn, Xidx, Nst, Nidx_18, Spell_Max, "Spell_Max") Deallocate (XStn, Xidx) Call rd_ncdf_2d ("Spell_Time_Arr_Stn.nc", XStn, Xidx, Nst, Nidx_18, Time_Arr_Ave, "Time_Arr_Ave") Deallocate (XStn, Xidx) Call rd_ncdf_2d ("Spell_Time_Arr_Stn.nc", XStn, Xidx, Nst, Nidx_18, Time_Arr_Max, "Time_Arr_Max") Deallocate (XStn, Xidx) Call rd_ncdf_2d ("Fre_Mag_Stn_all_period.nc", XStn, Xidx, Nst, Nidx_18, Fre_all, "Freq") Deallocate (XStn, Xidx) Call rd_ncdf_2d ("Fre_Mag_Stn_all_period.nc", XStn, Xidx, Nst, Nidx_18, Mag_all, "Mag") Deallocate (XStn, Xidx) Nidx_18=18; Nmon=12; Allocate (Fre(Nidx_18,Nst,Nmon), Mag(Nidx_18,Nst,Nmon)) id=0 Do isev=1, 3 Do idx=1, 6 id=id+1 VarName="Fre_"//trim(IdxStr(idx))//"_"//trim(SevStr(isev)) Call rd_ncdf_2d ("Fre_Mag_Stn.nc", XStn, Xidx, Nst, Nmon, X, trim(VarName)) Fre(id,:,:) = X(:,:) Deallocate (XStn, Xidx, X) VarName="Mag_"//trim(IdxStr(idx))//"_"//trim(SevStr(isev)) Call rd_ncdf_2d ("Fre_Mag_Stn.nc", XStn, Xidx, Nst, Nmon, X, trim(VarName)) Mag(id,:,:) = X(:,:) Deallocate (XStn, Xidx, X) Enddo Enddo !Reading CORR Ntq_12 = 12; Allocate (TQ(Nst, Ntq_12), Prob1(Nst, Ntq_12)) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "pdsi_spi01"); TQ(:,1) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "pdsi_spi03"); TQ(:,2) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "pdsi_spi06"); TQ(:,3) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "pdsi_spi12"); TQ(:,4) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "scpdsi_spi01"); TQ(:,5) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "scpdsi_spi03"); TQ(:,6) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "scpdsi_spi06"); TQ(:,7) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "scpdsi_spi12"); TQ(:,8) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "spei06_spi06"); TQ(:,9) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "spei06_spi12"); TQ(:,10) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "spei12_spi06"); TQ(:,11) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "spei12_spi12"); TQ(:,12) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "pdsi_spi01"); Prob1(:,1) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "pdsi_spi03"); Prob1(:,2) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "pdsi_spi06"); Prob1(:,3) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "pdsi_spi12"); Prob1(:,4) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "scpdsi_spi01"); Prob1(:,5) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "scpdsi_spi03"); Prob1(:,6) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "scpdsi_spi06"); Prob1(:,7) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "scpdsi_spi12"); Prob1(:,8) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "spei06_spi06"); Prob1(:,9) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "spei06_spi12"); Prob1(:,10) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "spei12_spi06"); Prob1(:,11) = Cor(:); Deallocate (XStn, Cor) Call rd_ncdf_1d ("Prob_Tq_pdsi_spi_Stn.nc", XStn, Nst, Cor, "spei12_spi12"); Prob1(:,12) = Cor(:); Deallocate (XStn, Cor) !-------------------------- Call rd_ncdf_1d ("/home/tanpv/SEACLID_New/RES/SPI_Res/SPI_Stn.nc", XStn, Nst, Lon, "lon") Deallocate (XStn) Call rd_ncdf_1d ("/home/tanpv/SEACLID_New/RES/SPI_Res/SPI_Stn.nc", XStn, Nst, Lat, "lat") Deallocate (XStn) Call rd_ncdf_1d ("/home/tanpv/SEACLID_New/RES/SPI_Res/SPI_Stn.nc", XStn, Nst, Reg, "reg") ! Tao danh muc ten tram gia: Allocate(Station(Nst)); Do ist=1, Nst; write(Station(ist),"(A,I3.3)") "Station_",ist ; Enddo End Subroutine Read_data_NC !---------------------------------------------------------------------------------- Subroutine Write_GrADS_Stn (X,Lon, Lat, Nst, Nidx, Grads_File, Out_Dir, Field) Integer :: ivar, ist, ic, Nst, Nidx Character (Len=8) :: STID Character *(*) :: Grads_File, Out_Dir, Field Real :: X(Nst, Nidx), Lon(Nst), Lat(Nst) Real :: RLAT, RLON, TIM, tmp, Var Integer :: NLEV,NFLAG !---------------------------------------------------------------------------------- OPEN (10,file=trim(Out_Dir)//trim(Grads_File)//'.dat',FORM='UNFORMATTED',RECORDTYPE='STREAM') TIM = 0.0 ! Co the bien doi tu -0.5 .. +0.5; thuong dat bang 0. NFLAG = 1 ! Khong doi ! STID: character(len=8) ==> Station name ! Do ivar = 1,Nidx ! Nvar chi so, moi chi so duoc xem nhu 1 timeslice NLEV = 1 ! =0 o ban ghi cuoi cung cua 1 timeslice; =1 cho tat ca cac timeslice khac ic = 0 Do ist=1, Nst ic = ic+1 STID = Station(ist)(1:8) ! Chi lay 8 ky tu dau tien RLAT = Lat(ist); RLON = Lon(ist) WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Var = X(ist,ivar) WRITE (10) Var ! Gia tri cua bien Enddo ! before new time: NLEV = 0 WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG ! print*,"Grasd=", ic Enddo ! ivar Close(10) !---------------------------------------------------------------------! ! Write control file Station data ! !---------------------------------------------------------------------! open (2001,file=trim(Out_Dir)//trim(Grads_File)//'.ctl') write (2001,'(2A)') 'dset ','^'//trim(Grads_File)//'.dat' write (2001,'(A)') 'dtype station' write (2001,'(2A)') 'stnmap ','^'//trim(Grads_File)//'.dat'//'.map' write (2001,'(A,F8.1)') 'undef ',RMiss write (2001,'(A)') 'title Factor Analysis' write (2001,'(A,I3,1x,A)') 'tdef ',Nidx,'linear jan1980 1mo' ! write (2001,'(A,I3,1x,A)') 'tdef ',1,'linear jan1980 1mo' write (2001,'(A)') 'vars 1' write (2001,'(A)') trim(Field)//' 0 99 Factor' write (2001,'(A)') 'endvars' close (2001) !Enddo ! ivar End Subroutine Write_GrADS_Stn !---------------------------------------------------------------------! Subroutine Write_To_TEXT (X, Nst, Mvar, Lon, Lat, Reg, Varname, Title, Fname) Integer :: Nst, Mvar, ist, ivar, ireg Character (Len=*) :: Varname(Mvar), Title, Fname Character (Len=50) :: Fmt Real :: X(Nst, Mvar), Lon(Nst), Lat(Nst), Reg(Nst) Open (3, file=trim(Fname), status="Unknown") write (Fmt, "(A,I3,A)") "(I4,2F8.3,",Mvar,"F12.3)" write (3,"(A)") Title write (3, "(A3,1x,2(A6,2x),100A12)") "Reg","Lon","Lat", (trim(Varname(ivar)), ivar=1, Mvar) Do ist=1, Nst write (3,Fmt) Int(Reg(ist)), Lon(ist), Lat(ist), (X(ist, ivar), ivar=1, Mvar) Enddo Close(3) End Subroutine Write_To_TEXT !---------------------------------------------------------------------! Include "../Libs/sub_rd_ncdf_Tan.F90" END