
Use NetCDF
Implicit None
Real, Parameter :: Miss=-99.0
Character (Len=20), Allocatable   :: Station(:)

Real, Allocatable, Dimension(:)   :: Lon, Lat, Reg, H
Real, Allocatable, Dimension(:,:) :: Var

Integer :: Nst, ist, Nidx
Character (Len=255) :: In_Dir, Fname, Grads_File, Out_Dir, Field
Logical :: status
!----------------------------------------------------------------------------------

Call Read_Stn_Info

Nidx=1; Allocate (Var(Nst,Nidx))   ! Dummy variable
Do ist=1, Nst; Var(ist,Nidx)=ist; Enddo
Out_Dir="/home/tanpv/SEACLID_New/Libs/"
Call Write_GrADS_Stn (Var, Lon, Lat, Nst, Nidx, "Stn_List_488", trim(Out_Dir), "Stn")
Call Write_Stn_info_to_NC

CONTAINS
!----------------------------------------------------------------------------------
Subroutine Read_Stn_Info
Fname="/home/tanpv/SEACLID_New/Libs/Station_list_VN_Mainland.txt"
Open (1, file=trim(Fname), status="old")
read (1, *) Nst
Allocate (Lon(Nst), Lat(Nst), Reg(Nst), H(Nst),Station(Nst))
Do ist=1, Nst
   read (1, "(A16,F7.3,F8.3,F6.0,F3.0)") Station(ist), Lon(ist), Lat(ist), H(ist), Reg(ist)
   print "(A16,F7.3,F8.3,F6.0,F3.0)", Station(ist), Lon(ist), Lat(ist), H(ist), Reg(ist)
Enddo
End Subroutine Read_Stn_Info
!----------------------------------------------------------------------------------
Subroutine Write_Stn_info_to_NC
   Real, allocatable :: StnID(:)
   Integer :: ist
   Allocate (StnID(Nst))
   Do ist=1, Nst; StnID(ist)=ist; Enddo
   Fname="VnGP_Stn_Info.nc"
   
   Call wr_ncdf_1d_char(Trim(Fname), StnID, Nst, Station, "Stname", "Station's Name","-", "Stn", Miss)
   Call wr_ncdf_1d_apd (Trim(Fname), Lon, "lon", Nst,"Station's longitude in deg.E","deg_E","Stn", Miss)
   Call wr_ncdf_1d_apd (Trim(Fname), Lat, "lat", Nst,"Station's latitude in deg. N","deg_N","Stn", Miss)
   Call wr_ncdf_1d_apd (Trim(Fname), H,   "h",   Nst,"Station's elevation in m",    "m",    "Stn",   Miss)
   Call wr_ncdf_1d_apd (Trim(Fname), Reg, "reg", Nst,"Station's climatic sub-region","-",   "Stn", Miss)  
End Subroutine Write_Stn_info_to_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)
!       print "(I4,10F7.2)", ist, Var
       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   ',Miss
   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 "/home/tanpv/Mylibs/sub_wr_ncdf_Tan.F90"
END
