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 :: 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 :: XStn(:), Xidx(:), Lat(:), Lon(:), Reg(:) Real, Allocatable :: X(:,:) Integer :: Nst, Nmon, Nidx, Nidx_1, Nidx_3, Nidx_18 Integer :: ist, idx, imon Real :: Rmiss Logical :: status Character (Len=30) :: FName !================================================================================== !Call Write_GrADS_Stn (SenSlp, "Sen_Slop", "./4Grads/","S") ! Phan bo KG cua xu the (Sen's slope) !Call Write_GrADS_Stn (Prob, "Prob", "./4Grads/","P") Call Read_data_NC !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") 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) 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 Call rd_ncdf_1d ("/home/tanpv/SEACLID/RES/SPI_Res/SPI_Stn.nc", XStn, Nst, Lon, "lon") Deallocate (XStn) Call rd_ncdf_1d ("/home/tanpv/SEACLID/RES/SPI_Res/SPI_Stn.nc", XStn, Nst, Lat, "lat") Deallocate (XStn) Call rd_ncdf_1d ("/home/tanpv/SEACLID/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 !---------------------------------------------------------------------! Include "../Libs/sub_rd_ncdf_Tan.F90" END