Program Dr_IDXs_SEACLID ! Calculating PDSI, SPI, SPEI use netcdf !------------------------------------------------------------------------------ Real, parameter :: amssng = -99., Miss=amssng !Real, parameter :: Dr_Thres = -1.0 Integer, Parameter :: NMonth = 12, Nmon=NMonth Integer, Parameter :: Nreg = 7, Nmem = 7, Nlead = 6 !Integer, Parameter :: Ncase = 2 ! obs,mod,cli,ann !Character (Len=3), Parameter :: Cases(Ncase)=(/"mod","cli","ann"/) !(/"obs","mod","cli","ann"/) !Character (Len=3), Parameter :: Cases(Ncase)=(/"ann"/) !Character (Len=5), Parameter :: Modeln(Nmods)=(/"RegCM","clWRF"/) !Character (Len=5) :: Modeln(Nmods) Real, Allocatable :: Regs(:,:), Lon(:), Lat(:), xlon(:), xlat(:) Real, Allocatable :: Dr_All_1(:,:,:,:,:,:,:) ! Nlon,Nlat,Ncase,Nmem,Ntime,Nmods,Nlead) Real, Allocatable :: Dr_All_3(:,:,:,:,:,:,:) Real, Allocatable :: Dr_All_6(:,:,:,:,:,:,:) Real, Allocatable, Dimension (:,:,:,:,:) :: IDX_1, IDX_3, IDX_6 ! Nlon,Nlat,Ntime,Nlead,Ncase*Nmem*Nmods) Real, Allocatable, Dimension (:,:,:,:) :: Dr_1, Dr_3, Dr_6 ! Nlon,Nlat,Ntime,Nlead Real, Allocatable, Dimension (:,:,:,:) :: PC_1, PC_3, PC_6 ! proportion score (Nlon,Nlat,Ntime,Nlead) Real, Allocatable, Dimension (:,:,:) :: PC_All_1,PC_All_3,PC_All_6 ! proportion score (Nlon,Nlat,Nlead) Real, Allocatable :: IDX_Obs_1(:,:,:,:) ! Nlon,Nlat,Ntime,Nlead Real, Allocatable :: IDX_Obs_3(:,:,:,:) Real, Allocatable :: IDX_Obs_6(:,:,:,:) Real, Allocatable :: xmem(:), xlead(:), xtime(:) Real, Allocatable :: SPEI_All(:,:,:,:,:,:) ! Nlon,Nlat,Nmem,Ntime,Ncase,Nlen !------------------------------------------------------------------------------ ! ANN: character (len=250) :: input_file, output_file, save_file character (len=250) :: Dir, Dir_ANN_Out, Dir_Cli, Dir_ANN_Save, Dir_Veri, Dir_4Dr logical :: training_mode ! Use for calculating scaling factors Integer :: Nsample, Nepoc, Nsample1 Real,allocatable, Dimension(:,:) :: Inputs, Outputs, Inputs_X, Outputs_Y Real,allocatable, Dimension(:) :: min_in, max_in, min_out, max_out Real :: mean_error, mean_error_check Real, Allocatable :: X_inp(:,:), Y_inp(:), Yest(:,:), Yhq(:,:) integer :: Nin, Nhidden, Nout, iin, ihid, iout integer :: i,j,k Real,allocatable, Dimension(:,:) :: weight_ih, weight_ho, moment_ih, moment_ho Real,allocatable, Dimension(:) :: fin, fhid, fout, ftarget, delta_o, delta_h ! Training Real :: learning_rate0, learning_rate, momentum, error, tmp, mintmp logical :: debug, Run_Cli !------------------------------------------------------------------------------ Character (Len=255) :: Fname, BL_Dir, R_Fname, T_Fname, Out_Dr_Fname Character (Len=255) :: Inp_Dir, Out_Dir, Mask_File Character (Len=3) :: TVar, RVar Character (Len=10) :: Model_nm, Dr_type Logical :: status, Empty Integer :: Yr1, Yr2, NYear, maxyrs, Nmods, Ncase Integer :: NLen, Nst, Nlon, Nlat, IO, Ntime, Nt, it, Landpoint Integer :: imod, ist, iyr, imw, ivar, isys, system, ilon, ilat Integer :: Nt1 Character (Len=3), Allocatable :: Cases(:) Character (Len=5), Allocatable :: Modeln(:) !------------------------------------------------------------------------------ ! For writing to NC file: Real, allocatable, Dimension (:,:,:,:) :: X4d Real, allocatable, Dimension (:) :: X1d,Xt !------------------------------------------------------------------------------ Namelist /File_Dir_Names/ Inp_Dir, Mask_File, Out_Dir !, TVar, RVar Namelist /Data_Info/ Yr1, Yr2, Dr_Thres, Dr_type, Nmods, Ncase Namelist /Model_Info/ Modeln, Cases ! Names of Model and Cases Namelist /ann_info/ Nhidden,learning_rate,momentum,training_mode,Nepoc,debug !------------------------------------------------------------------------------ Open (1, file="Namelist_Dr_Chars.txt", Status="Old") ! Tinh voi APH 1961-2015 Read (1, File_Dir_Names) Read (1, Data_Info) Allocate (Modeln(Nmods),Cases(Ncase)) Read (1, Model_Info) Read (1, ann_info) Close (1) learning_rate0 = learning_rate Nyear = (Yr2 - Yr1 + 1); Ntime = Nyear*NMonth; maxyrs = NYear Nspl = Ncase*Nmem*Nmods Call Read_Regs print*,"Parameters: Nlat,Nlon,Nst,Nlen,Ntime=",Nlat,Nlon,Nst,Nlen,Ntime ! Call Read_all_data ! print*,"Reading data done ..." Dir_ANN_Save="/home/tanpv/Data/562_VNU/0.25_VN/ANN_Save_grd/" !------------------------------------------------------------------------------ print*,"Beginning: Ntime, Nst=",Ntime, Nst print*,"Parameters: Nlat,Nlon,Nst,Nlen,Ntime=",Nlat,Nlon,Nst,Nlen,Ntime Call Reinit Call Read_all_data print*,"Reading data done ..." Call Data_organization Call Calc_ANN !Call Calc_prob (thres) !Call Calc_PC_PC_All (thres) write (Fname,"(A,I2.2,A)") trim(Out_Dir)//"Dr_Fcs_ANN.nc" !//trim(Dr_type)//".nc" Call Write_Dr_IDXs_to_file (Fname) CONTAINS !------------------------------------------------------------------------------ Subroutine Reinit Allocate (Dr_All_1(Nlon,Nlat,Ncase,Nmem,Ntime,Nmods,Nlead)) ! Nlon,Nlat,Ncase,Nmem,Ntime,Nmods,Nlead) Allocate (Dr_All_3(Nlon,Nlat,Ncase,Nmem,Ntime,Nmods,Nlead)) Allocate (Dr_All_6(Nlon,Nlat,Ncase,Nmem,Ntime,Nmods,Nlead)) Allocate (IDX_Obs_1(Nlon,Nlat,Nlead,Ntime)) ! Nlon,Nlat,Ntime,Nlead Allocate (IDX_Obs_3(Nlon,Nlat,Nlead,Ntime)) Allocate (IDX_Obs_6(Nlon,Nlat,Nlead,Ntime)) Allocate (IDX_1(Nlon,Nlat,Ntime,Nlead,Nspl)) !, IDX_3, IDX_6 ! Nlon,Nlat,Ntime,Nlead,Ncase*Nmem*Nmods) Allocate (IDX_3(Nlon,Nlat,Ntime,Nlead,Nspl)) Allocate (IDX_6(Nlon,Nlat,Ntime,Nlead,Nspl)) Allocate (Dr_1(Nlon,Nlat,Nlead,Ntime)) ! , Dr_3, Dr_6 ! Nlon,Nlat,Ntime,Nlead --> moderate drought probability (IDX<-1) Allocate (Dr_3(Nlon,Nlat,Nlead,Ntime)) Allocate (Dr_6(Nlon,Nlat,Nlead,Ntime)) Allocate (PC_1(Nlon,Nlat,Nlead,Ntime), PC_All_1(Nlon,Nlat,Nlead)) Allocate (PC_3(Nlon,Nlat,Nlead,Ntime), PC_All_3(Nlon,Nlat,Nlead)) Allocate (PC_6(Nlon,Nlat,Nlead,Ntime), PC_All_6(Nlon,Nlat,Nlead)) ! For ANN: !Allocate (Y_inp(Ntime),X_inp(Ntime,Nspl)) Allocate (Inputs_X(Nspl,Ntime), Outputs_Y(1,Ntime)) End Subroutine Reinit !------------------------------------------------------------------------------ Subroutine Calc_ANN Integer :: ilon,ilat,ilead,imod,icas,it,imem,i,j Real :: X(Nspl),thres ! Nlon,Nlat,Ntime,Nlead Dr_1=Miss; Dr_3=Miss; Dr_6=Miss Do ilead=1,Nlead Do ilon=1,Nlon Do ilat=1,Nlat if (Regs(ilon,ilat)>0) then !print*,ilead,ilon,ilat Do it=1,Ntime Outputs_Y(1,it)=IDX_Obs_1(ilon,ilat,ilead,it) Inputs_X(1:Nspl,it)=IDX_1(ilon,ilat,it,ilead,1:Nspl) Enddo write (save_file,"(A,3(I2.2,A))") trim(Dir_ANN_Save)//"Sav_Dr1_lon_",ilon,"_lat_",ilat,"_lead_",ilead,".dat" learning_rate = learning_rate0 !print*,"Dr_1" Call ANN_2023(Inputs_X,Outputs_Y,Ntime,Nspl,1,Miss) Dr_1(ilon,ilat,ilead,1:Ntime)=Yest(1:Ntime,1) Do it=1,Ntime Outputs_Y(1,it)=IDX_Obs_3(ilon,ilat,ilead,it) Inputs_X(1:Nspl,it)=IDX_3(ilon,ilat,it,ilead,1:Nspl) Enddo write (save_file,"(A,3(I2.2,A))") trim(Dir_ANN_Save)//"Sav_Dr3_lon_",ilon,"_lat_",ilat,"_lead_",ilead,".dat" learning_rate = learning_rate0 Call ANN_2023(Inputs_X,Outputs_Y,Ntime,Nspl,1,Miss) Dr_3(ilon,ilat,ilead,1:Ntime)=Yest(1:Ntime,1) Do it=1,Ntime Outputs_Y(1,it)=IDX_Obs_6(ilon,ilat,ilead,it) Inputs_X(1:Nspl,it)=IDX_6(ilon,ilat,it,ilead,1:Nspl) Enddo write (save_file,"(A,3(I2.2,A))") trim(Dir_ANN_Save)//"Sav_Dr6_lon_",ilon,"_lat_",ilat,"_lead_",ilead,".dat" learning_rate = learning_rate0 Call ANN_2023(Inputs_X,Outputs_Y,Ntime,Nspl,1,Miss) Dr_6(ilon,ilat,ilead,1:Ntime)=Yest(1:Ntime,1) endif Enddo Enddo Enddo End Subroutine Calc_ANN !------------------------------------------------------------------------------ Subroutine Calc_PC_PC_All (thres) Integer :: ilon,ilat,ilead,imod,icas,it,imem,i,j Real :: X1(Nspl),X3(Nspl),X6(Nspl), Y1(Ntime), thres Real :: xobs, xmod, ao1, am1, ao3, am3, ao6, am6 Real :: c1,c3,c6,p1,p3,p6, b1,b3,b6,q1,q3,q6 PC_1=Miss; PC_All_1=Miss PC_3=Miss; PC_All_3=Miss PC_6=Miss; PC_All_6=Miss Do ilead=1,Nlead Do ilon=1,Nlon Do ilat=1,Nlat if (Regs(ilon,ilat)>0) then b1=0; b3=0; b6=0; q1=0; q3=0; q6=0; Do it=1,Ntime ao1=IDX_Obs_1(ilon,ilat,ilead,it) ao3=IDX_Obs_3(ilon,ilat,ilead,it) ao6=IDX_Obs_6(ilon,ilat,ilead,it) X1(1:Nspl)=IDX_1(ilon,ilat,it,ilead,1:Nspl) X3(1:Nspl)=IDX_3(ilon,ilat,it,ilead,1:Nspl) X6(1:Nspl)=IDX_6(ilon,ilat,it,ilead,1:Nspl) c1=0; c3=0; c6=0; p1=0; p3=0; p6=0 Do i=1,Nspl if (ao1/=Miss.AND.X1(i)/=Miss) then c1=c1+1; b1=b1+1; if (ao1<=thres.AND.X1(i)<=thres) then; p1=p1+1; q1=q1+1; endif ! if (ao1<=thres) then; c1=c1+1; b1=b1+1; if (ao1<=thres.AND.X1(i)<=thres) then; p1=p1+1; q1=q1+1; endif; endif endif if (a03/=Miss.AND.X3(i)/=Miss) then c3=c3+1; b3=b3+1; if (ao3<=thres.AND.X3(i)<=thres) then; p3=p3+1; q3=q3+1; endif ! if (ao3<=thres) then; c3=c3+1; b3=b3+1; if (ao3<=thres.AND.X3(i)<=thres) then; p3=p3+1; q3=q3+1; endif; endif endif if (ao6/=Miss.AND.X6(i)/=Miss) then c6=c6+1; b6=b6+1; if (ao6<=thres.AND.X6(i)<=thres) then; p6=p6+1; q6=q6+1; endif ! if (ao6<=thres) then; c6=c6+1; b6=b6+1; if (ao6<=thres.AND.X6(i)<=thres) then; p6=p6+1; q6=q6+1; endif; endif endif Enddo if (c1>0) PC_1(ilon,ilat,ilead,it)=p1/c1 ! Otherwise has been assigned by Miss if (c3>0) PC_3(ilon,ilat,ilead,it)=p3/c3 if (c6>0) PC_6(ilon,ilat,ilead,it)=p6/c6 Enddo if (b1>0) PC_All_1(ilon,ilat,ilead)=q1/b1 if (b3>0) PC_All_3(ilon,ilat,ilead)=q3/b3 if (b6>0) PC_All_6(ilon,ilat,ilead)=q6/b6 endif Enddo Enddo Enddo End Subroutine Calc_PC_PC_All !------------------------------------------------------------------------------ !Subroutine Calc_prob (thres) ! Integer :: ilon,ilat,ilead,imod,icas,it,imem,i,j ! Real :: X(Nspl),thres ! Nlon,Nlat,Ntime,Nlead ! Dr_1=Miss; Dr_3=Miss; Dr_6=Miss ! Do ilead=1,Nlead ! Do ilon=1,Nlon ! Do ilat=1,Nlat ! if (Regs(ilon,ilat)>0) then ! Do it=1,Ntime ! X(1:Nspl)=IDX_1(ilon,ilat,it,ilead,1:Nspl) !print*,"Lon,Lat,Time: ",xlon(ilon),xlat(ilat),it !print"(18F7.2)",X(1:Nspl) ! Dr_1(ilon,ilat,ilead,it)=Probbability(X,Nspl,thres,Miss) ! X(1:Nspl)=IDX_3(ilon,ilat,it,ilead,1:Nspl) !print"(18F7.2)",X(1:Nspl) ! Dr_3(ilon,ilat,ilead,it)=Probbability(X,Nspl,thres,Miss) ! X(1:Nspl)=IDX_6(ilon,ilat,it,ilead,1:Nspl) !print"(18F7.2)",X(1:Nspl) ! Dr_6(ilon,ilat,ilead,it)=Probbability(X,Nspl,thres,Miss) ! Enddo !pause ! endif ! Enddo ! Enddo ! Enddo !End Subroutine Calc_prob !------------------------------------------------------------------------------ Real Function Probbability (X,N,thres,Miss) Integer :: N,i,ic1,ic2 Real :: X(N), Miss, tmp ic1=0; ic2=0 Do i=1,N if (X(i)/=Miss) then ic1=ic1+1 if (X(i)<=thres) ic2=ic2+1 endif Enddo if (ic1>0) then tmp=real(ic2)/real(ic1) else tmp=Miss endif !print*,"ic1,ic2,Prob: ",ic1,ic2,tmp Probbability=tmp End Function Probbability !------------------------------------------------------------------------------ Subroutine Write_Dr_IDXs_to_file (Fname) Character (Len=*) :: Fname Character (Len=250) :: t_unit, Var_nm, Var_ln, var_unit, lon_nm, lat_nm, z_nm, t_nm Integer :: it, imem, ilead, ireg, icas, ilen Real :: xlead(Nlead),xtime(Ntime) t_unit="months since 1983-01-01 "; var_unit="-"; lon_nm="lon"; lat_nm="lat"; z_nm="lead"; t_nm="mon" Do ilead=1,Nlead; xlead(ilead)=ilead; Enddo Do it=1,Ntime; xtime(it)=it-1; Enddo !Var_ln="Probability of 1-month drought occurrence" Var_ln="The 1-month ANN model drought SPEI index" Call wr_ncdf_4d (Fname, xlon,xlat,xlead,xtime,Nlon,Nlat,Nlead,Ntime,Dr_1,"dr1", & t_unit,Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) !Var_ln="Probability of 3-month drought occurrence" Var_ln="The 3-month ANN model drought SPEI index" Call wr_ncdf_4d_apd (Fname,Dr_3,"dr3",Nlon,Nlat,Nlead,Ntime, & Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) !Var_ln="Probability of 6-month drought occurrence" Var_ln="The 6-month ANN model drought SPEI index" Call wr_ncdf_4d_apd (Fname,Dr_6,"dr6",Nlon,Nlat,Nlead,Ntime, & Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) Var_ln="The 1-month observed drought SPEI index" Call wr_ncdf_4d_apd (Fname,IDX_Obs_1,"ob1",Nlon,Nlat,Nlead,Ntime, & Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) Var_ln="The 3-month observed drought SPEI index" Call wr_ncdf_4d_apd (Fname,IDX_Obs_3,"ob3",Nlon,Nlat,Nlead,Ntime, & Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) Var_ln="The 6-month observed drought SPEI index" Call wr_ncdf_4d_apd (Fname,IDX_Obs_6,"ob6",Nlon,Nlat,Nlead,Ntime, & Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) !Var_ln="Timeseries of Prob. validation of 1-month drought occurrence" !Call wr_ncdf_4d_apd (Fname,PC_1,"pc1",Nlon,Nlat,Nlead,Ntime, & ! Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) !Var_ln="Timeseries of Prob. validation of 3-month drought occurrence" !Call wr_ncdf_4d_apd (Fname,PC_3,"pc3",Nlon,Nlat,Nlead,Ntime, & ! Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) !Var_ln="Timeseries of Prob. validation of 6-month drought occurrence" !Call wr_ncdf_4d_apd (Fname,PC_6,"pc6",Nlon,Nlat,Nlead,Ntime, & ! Var_ln,var_unit,lon_nm, lat_nm, z_nm, t_nm,Miss) !Var_ln="Prob. validation of 1-month drought occurrence" !Call wr_ncdf_3d_apd (Fname,PC_All_1,"pca1",Nlon,Nlat,Nlead,Var_ln,var_unit,lon_nm,lat_nm,t_nm, Miss) !Var_ln="Prob. validation of 3-month drought occurrence" !Call wr_ncdf_3d_apd (Fname,PC_All_3,"pca3",Nlon,Nlat,Nlead,Var_ln,var_unit,lon_nm,lat_nm,t_nm, Miss) !Var_ln="Prob. validation of 6-month drought occurrence" !Call wr_ncdf_3d_apd (Fname,PC_All_6,"pca6",Nlon,Nlat,Nlead,Var_ln,var_unit,lon_nm,lat_nm,t_nm, Miss) End Subroutine Write_Dr_IDXs_to_file !------------------------------------------------------------------------------ Subroutine Read_Regs Integer :: ilon,ilat, ireg, ic,j Real :: tmp Call rd_ncdf_2d (Mask_File,xlon,xlat,Nlon,Nlat,Regs,"reg") Nst=0; Do ilon=1,Nlon Do ilat=1,Nlat if (Int(Regs(ilon,ilat))>0) then Nst=Nst+1 endif Enddo Enddo !print*,"Nst=",Nst; pause End Subroutine Read_Regs !------------------------------------------------------------------------------ Subroutine Data_organization Integer :: ilon,ilat,ilead,imod,icas,it,imem,i,j ! Dimension (:,:,:,:,:) :: IDX_1, IDX_2, IDX_3 ! Nlon,Nlat,Ntime,Nlead,Ncase*Nmem*Nmods) IDX_1=Miss; IDX_3=Miss; IDX_6=Miss Do ilead=1,Nlead Do ilon=1,Nlon Do ilat=1,Nlat if (Regs(ilon,ilat)>0) then i=0 Do imod=1,Nmods Do icas=1,Ncase Do imem=1,Nmem i=i+1 IDX_1(ilon,ilat,1:Ntime,ilead,i)=Dr_All_1(ilon,ilat,icas,imem,1:Ntime,imod,ilead) IDX_3(ilon,ilat,1:Ntime,ilead,i)=Dr_All_3(ilon,ilat,icas,imem,1:Ntime,imod,ilead) IDX_6(ilon,ilat,1:Ntime,ilead,i)=Dr_All_6(ilon,ilat,icas,imem,1:Ntime,imod,ilead) Enddo Enddo Enddo !print*,i endif Enddo Enddo Enddo End Subroutine Data_organization !------------------------------------------------------------------------------ Subroutine Read_all_data Integer :: ist,ilon,ilat,ilead,Nlo,Nla,Nme,Nt,icas, it1, it2 Character (Len=255) :: Fname Real, Allocatable :: X4d(:,:,:,:), time(:), xlon(:),xlat(:),xmem(:) !,xtime(:) ! Dr_Obs_1(:,:,:,:) ! Nlon,Nlat,Ntime,Nlead ! Dr_All_1(:,:,:,:,:,:,:) ! Nlon,Nlat,Ncase,Nmem,Ntime,Nmods,Nlead) Do imod=1,Nmods Do ilead=1,Nlead write (Fname,"(A,I1,A)") trim(Inp_Dir)//"SPEI_"//trim(Modeln(imod))//"_lead_",ilead,".nc" print*,"Reading ",trim(Fname) if (imod==1) then ! .AND.ilead==1) then Call rd_ncdf_4d (Fname,xlon,xlat,xmem,xtime,Nlo,Nla,Nme,Nt,X4d,"obs_01") Do it=1,Nt; IDX_Obs_1(:,:,ilead,it)=X4d(:,:,1,it); Enddo Deallocate (xlon,xlat,xmem,xtime,X4d) Call rd_ncdf_4d (Fname,xlon,xlat,xmem,xtime,Nlo,Nla,Nme,Nt,X4d,"obs_03") Do it=1,Nt; IDX_Obs_3(:,:,ilead,it)=X4d(:,:,1,it); Enddo Deallocate (xlon,xlat,xmem,xtime,X4d) Call rd_ncdf_4d (Fname,xlon,xlat,xmem,xtime,Nlo,Nla,Nme,Nt,X4d,"obs_06") Do it=1,Nt; IDX_Obs_6(:,:,ilead,it)=X4d(:,:,1,it); Enddo Deallocate (xlon,xlat,xmem,xtime,X4d) endif Do icas=1,Ncase Call rd_ncdf_4d (Fname,xlon,xlat,xmem,xtime,Nlo,Nla,Nme,Nt,X4d,trim(Cases(icas))//"_01") Do imem=1,Nmem Do it=1,Nt; Dr_All_1(:,:,icas,imem,it,imod,ilead)=X4d(:,:,imem,it); Enddo Enddo Deallocate (xlon,xlat,xmem,xtime,X4d) Call rd_ncdf_4d (Fname,xlon,xlat,xmem,xtime,Nlo,Nla,Nme,Nt,X4d,trim(Cases(icas))//"_03") Do imem=1,Nmem Do it=1,Nt; Dr_All_3(:,:,icas,imem,it,imod,ilead)=X4d(:,:,imem,it); Enddo Enddo Deallocate (xlon,xlat,xmem,xtime,X4d) Call rd_ncdf_4d (Fname,xlon,xlat,xmem,xtime,Nlo,Nla,Nme,Nt,X4d,trim(Cases(icas))//"_06") Do imem=1,Nmem Do it=1,Nt; Dr_All_6(:,:,icas,imem,it,imod,ilead)=X4d(:,:,imem,it); Enddo Enddo Deallocate (xlon,xlat,xmem,xtime,X4d) Enddo Enddo Enddo Print*,"Reading data ... Done" End Subroutine Read_all_data !------------------------------------------------------------------------------ Include "/home/tanpv/Mylibs/sub_wr_ncdf_Tan.F90" Include "/home/tanpv/Mylibs/sub_rd_ncdf_Tan.F90" Include "/home/tanpv/Mylibs/Sub_neural_2023.f90" !Include "/home/tanpv/Mylibs/Sub_SPI.f90" ! Chuong trinh tinh chi so han SPI !Include "/home/tanpv/Mylibs/Sub_SPEI.f90" ! Chuong trinh tinh chi so han SPEI !-------------------------------------------------------------------- END ! Program