Use NetCDF
Real, Parameter ::    Miss=-99.
!----------------------------------------------------------------------------
! Origin Data:
Real, Allocatable  :: GPI_Org(:,:,:)   ! Lon,Lat,T
Real, Allocatable  :: GPI(:,:)         ! T, Lon*Lat
!----------------------------------------------------------------------------
Character (Len = 255) :: Fname, Fname1, Out_Dir, Out_Dir_Fcs
Integer :: Nlon, Nlat, Nx1, Ny1, Nxy


Real, Allocatable :: Mean(:), Std(:), Lon(:), Lat(:), Xtime(:)


   Fname = "gpi_new_201308.nc"
   Fname1= "gpi_entire_domain.nc"
   Call Read_GPI (Fname, Fname1)

!   Call Read_Extract_GPI (Fname, Fname1)

!-----------------------------------------------------------------------

CONTAINS
!----------------------------------------------------------------------------------!
Subroutine Read_GPI (Fname, Fname1)
   Integer :: ix, iy, iyr, ilon, ilat, it, it0, ilon1, ilon2, ilat1, ilat2
   Character (Len=*) :: Fname, Fname1
   Real, Allocatable :: Xlon(:), Xlat(:), X(:,:,:), Dummy(:)
   Character (Len=255) :: var_ln

   Call rd_ncdf_3d (Fname, lon, lat, xtime, nlon, nlat, ntime, GPI_Org, "gpi")
   Allocate (X(Nlon,Nlat,Ntime),xlat(Nlat))

   it=0
   Do iy=Nlat, 1, -1 !1, Nlat
      it=it+1
      xlat(it)=lat(iy)
      Do ix=1, Nlon  !1, Nlon
         X(ix,it,1:Ntime)=GPI_Org(ix,iy,1:Ntime)
      Enddo
   Enddo

   var_ln="TC Genesis Potential Index"
   Call wr_ncdf_3d (Fname1,lon,xlat,xtime,nlon,nlat,ntime,X,"gpi","hours since 2010-08-01 ", &
                   trim(var_ln), "-", "lon", "lat", "time", Miss)
End Subroutine Read_GPI
!----------------------------------------------------------------------------------!
Subroutine Read_Extract_GPI (Fname, Fname1)
   Integer :: ix, iy, iyr, ilon, ilat, it, it0, ilon1, ilon2, ilat1, ilat2
   Character (Len=*) :: Fname, Fname1
   Real, Allocatable :: Xlon(:), Xlat(:), X(:,:,:), Dummy(:)
   Character (Len=255) :: var_ln

   Call rd_ncdf_3d (Fname, lon, lat, xtime, nlon, nlat, ntime, GPI_Org, "gpi")

   Do ix=1, Nlon
      if (lon(ix)>100.and.lon(ix)<101) ilon1=ix
      if (lon(ix)>179.and.lon(ix)<180) ilon2=ix
   Enddo
   Do iy=1, Nlat
      if (lat(iy)>39.and.lat(iy)<40) ilat1=iy
      if (lat(iy)>0.and.lat(iy)<1)   ilat2=iy
   Enddo
   Nx1=ilon2-ilon1+1; Ny1=ilat2-ilat1+1
   Allocate(Xlon(Nx1),Xlat(Ny1))
   ilon=0
   Do ix=ilon1, ilon2
      ilon=ilon+1; Xlon(ilon)=Lon(ix)
   Enddo
   ilat=0
   Do iy=ilat2, ilat1, -1
      ilat=ilat+1; Xlat(ilat)=Lat(iy)
   Enddo
   Deallocate (Lon, Lat); Allocate (Lon(Nx1),Lat(Ny1))
   Lon(:)=Xlon(:); Lat(:)=Xlat(:)
   Deallocate (XLon, XLat)

   Nxy = Nx1*Ny1 ! Nlon*Nlat
   Nlon=Nx1; Nlat=Ny1
   !print*,Nx1, Ny1,ilon1,ilon2,ilat1, ilat2; pause

   Allocate (GPI(Ntime,Nxy)) !,X(1,Ntime,Nxy)) !, Dummy(1))
   it=0
   Do iy=ilat2, ilat1, -1 !1, Nlat
      Do ix=ilon1, ilon2  !1, Nlon
         it=it+1; GPI(1:Ntime,it)=GPI_Org(ix,iy,1:Ntime)
      Enddo
   Enddo
   !Dummy(1)=1
   !X(1,1:Ntime,1:Nxy)=GPI(1:Ntime,1:Nxy)
   !print*,GPI; pause

   ! Write to New file:
   Allocate (Xlon(Ntime), Xlat(Nxy))
   Do ix=1, Nxy; Xlat(ix)=ix; Enddo     ! Nxy grid points
   Do ix=1, Ntime; Xlon(ix)=ix; Enddo   ! Ntime timeslices
   write (var_ln,"(A,i4,A,i4,A)") "TC Genesis Potential Index at ",nx1," lon grdpoints x ",ny1," lat grdpoint"

   !Call wr_ncdf_3d (Fname1,Dummy,Xlon,Xlat,1,nlon,nlat,X,"gpi","hours since 2010-08-01 ", &
   !                 "PCA_GPI_6hrs", "-", "dummp","lon", "lat", Miss)


   Call wr_ncdf_2d (Fname1,Xlon,Xlat,Ntime,Nxy, GPI, "gpi", trim(var_ln), "-", "time", "grdpoint", Miss)
   !Call wr_ncdf_1d_apd (Fname1,Lon,"lon", nlon, "Longitude of each gridpoint", "deg_E", "time", Miss)
   !Call wr_ncdf_1d_apd (Fname1,Lat,"lat", nlat, "Latitude of each gridpoint", "deg_N","time",Miss)

End Subroutine Read_Extract_GPI
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
Include "/home/tanpv/Mylibs/sub_rd_ncdf_Tan.F90"
Include "/home/tanpv/Mylibs/sub_wr_ncdf_Tan.F90"

END  ! Main Prog
!-----------------------------------------------------------------------