MODULE YOMCLIE
USE PARKIND1, ONLY: JPIM,JPRB

! Module defining and controling fields update

! Defines the TYPE TYPE_CLIM_FILE that contains the file information
! fields and data 

! Contains:
! UPDFLD : update the fields for a particular model time 
!          reading new fields if necessary
! INIT_CLIM_FILE : Initialize the field structure, open file and 
!                 some sanity checks
! RETIND  : function to retur the index of a particulr field 
!           query by name 
! INIT_GRIB_SNAME : initialize the array associating grib codes with grib short name 


! E. Dutra, Sep 2018. 


IMPLICIT NONE
SAVE

TYPE TYPE_CLIM_FILE
  INTEGER(KIND=JPIM) :: NFIELDS  ! Number of fields that will be read
  INTEGER(KIND=JPIM),ALLOCATABLE :: IFIELDS(:) ! Array with fields ID : grib codes (IFIELDS(NFIELDS))
  
  !! Netcdf file information
  CHARACTER(LEN=500) :: FNAME   ! Netcdf file name 
  INTEGER(KIND=JPIM) :: NCID    ! Netcdf file ID 
  INTEGER(KIND=JPIM),ALLOCATABLE :: NCVARIDS(:) ! Netcdf Variable IDS, as in IFIELDS 
  INTEGER(KIND=JPIM) :: NIDTIM,NIDLAT,NIDLON ! netcdf dimension IDs 
  INTEGER(KIND=JPIM) :: NITIM,NILAT,NILON    ! Lenght of dimensions 
  REAL(KIND=JPRB),ALLOCATABLE    :: FTIME(:) ! Array with time information: days since start of model run
  INTEGER(KIND=JPRB) :: IFYEAR,IFMON,IFDAY,IFHOUR,IFMIN,IFSEC
  REAL(KIND=JPRB)    :: ZDELS,ZTREF
  
  !! Data information 
  INTEGER(KIND=JPIM) :: ISTEP(2) ! Current step1 and step2 from netcdf file 
  REAL(KIND=JPRB),ALLOCATABLE  :: DATA(:,:,:) ! (2,NFIELDS,NPP) with data in step 1 and step 2
END TYPE TYPE_CLIM_FILE 

CHARACTER(LEN=6) :: GRIB_SNAME(128)
TYPE(TYPE_CLIM_FILE) :: TVEG

INTEGER(KIND=JPIM) :: IMISS=-999

CONTAINS

SUBROUTINE UPDFLD(ZT,TF,KDBG)
USE PARKIND1, ONLY: JPIM,JPRB
USE MPL_MODULE
USE YOMLUN1S, ONLY: NULOUT
USE YOMDPHY  , ONLY : NPOI,NLALO,NLON, NLAT
USE YOMGC1S  , ONLY : LMASK
USE RTIME2DATE_MOD
USE NETCDF 
USE NETCDF_UTILS
IMPLICIT NONE

#include "minmax.intfb.h"


REAL(KIND=JPRB),INTENT(IN)         :: ZT ! TIme of Model 
TYPE(TYPE_CLIM_FILE),INTENT(INOUT) :: TF ! fields structure
INTEGER(KIND=JPIM),INTENT(IN) :: KDBG

! Local variables 
LOGICAL :: LFIRST,LSWITCH
INTEGER :: JV,JT,KSTEP(2),IDATE,ISECO
INTEGER :: ISTART(3),ICOUNT(3),NMX,NMY
REAL(KIND=JPRB) :: ZREAL(NLALO)
CHARACTER(LEN=100) :: CVAR
CHARACTER(LEN=100) :: CTIME 

KSTEP(:)=IMISS

LFIRST=.FALSE.
LSWITCH=.FALSE.

IF (TF%ISTEP(1) == IMISS .OR. TF%ISTEP(2) == IMISS ) THEN 
  LFIRST=.TRUE.
ENDIF

IF (LFIRST) THEN
  !* First time, need to find indices 
  DO JV=1,TF%NITIM-1
    !*Loop on time until find indices
    IF (TF%FTIME(JV) <= ZT .AND. TF%FTIME(JV+1) > ZT )THEN
      KSTEP(1)=JV
      KSTEP(2)=JV+1
    ENDIF
  ENDDO
  IF ( KSTEP(1) == IMISS ) THEN
    WRITE(NULOUT,*) "1ST search could not find indices in UPDFLD"
    CALL ABOR1('1st error in UPDFLD')
  ENDIF 
ELSE
  !* Others, check if indices need to be updates 
  IF ( ZT > TF%FTIME(TF%ISTEP(2)) ) THEN
    ! Need to update indices
    KSTEP(1)=TF%ISTEP(2)
    KSTEP(2)=TF%ISTEP(2)+1
    IF ( KSTEP(2) > TF%NITIM ) THEN
      WRITE(NULOUT,*) "KSTEP2 above time upper bound in UPDFLD"
      CALL ABOR1("KSTEP2 above time upper bound in UPDFLD")
    ENDIF 
    LSWITCH=.TRUE.
  ELSE
    ! * No need to update fields
    LSWITCH=.FALSE.
    KSTEP(1)=TF%ISTEP(1)
    KSTEP(2)=TF%ISTEP(2)
  ENDIF
ENDIF
!* Satinty check 
IF ( .NOT. (TF%FTIME(KSTEP(1)) <= ZT .AND. TF%FTIME(KSTEP(2)) >= ZT ) ) THEN
  WRITE(NULOUT,*) "Someting went wrong in the indices"
  WRITE(NULOUT,*) "KSTPE1,KSTEP2",KSTEP(1),KSTEP(2)
  WRITE(NULOUT,*) "TIME1,ZT,TIME2",TF%FTIME(KSTEP(1)),ZT,TF%FTIME(KSTEP(2))
  CALL ABOR1("UPDFLD: Something went wrong in the indices")
ENDIF 

IF (LSWITCH .OR. LFIRST) THEN
  ! *Read netcdf fiels
  DO JT=1,2 ! loop on the Two indices 
    !* Check if needs to read index
    IF (LSWITCH .AND. JT == 1 ) THEN
      !* Copy index 2 to index 1
      TF%DATA(JT,:,:) = TF%DATA(2,:,:)
      TF%ISTEP(JT) = TF%ISTEP(2)
      WRITE(NULOUT,*) "UPDFLD: copy of ISTEP2 to ISTEP1"
      CYCLE
    ENDIF 
    ! * Setup start&count for netcdf read 
    IF (TF%NIDLAT==IMISS) THEN
      ISTART=(/1,KSTEP(JT),1/)
      ICOUNT=(/TF%NILON,1,1/)
      NMX=NLALO
      NMY=1
    ELSE
      ISTART=(/1,1,KSTEP(JT)/)
      ICOUNT=(/TF%NILON,TF%NILAT,1/)
      NMX=NLON
      NMY=NLAT
    ENDIF
    !* Loop on variables to read
    CALL RTIME2DATE(TF%FTIME(KSTEP(JT)),IDATE,ISECO)
    WRITE(CTIME,'(I8,1x,I6)')IDATE,ISECO
    DO JV=1,TF%NFIELDS
      CVAR=TRIM(GRIB_SNAME(TF%IFIELDS(JV)))
      WRITE(NULOUT,*)"UPDFLD: Reading ",TRIM(CVAR),' ',TRIM(CTIME)
      CALL NCERROR(NF90_GET_VAR(TF%NCID,TF%NCVARIDS(JV),ZREAL,&
      & ISTART,ICOUNT),"Reading"//CVAR)
      IF (KDBG > 1) CALL MINMAX(TRIM(CVAR),ZREAL,NMX,NMY,LMASK,NULOUT)
      TF%DATA(JT,:,JV)=PACK(ZREAL,LMASK)
      TF%ISTEP(JT)=KSTEP(JT)
!       WRITE(*,*)JT,JV,TRIM(CVAR),TF%DATA(JT,1829,JV),ZREAL(1829)
    ENDDO
  ENDDO  ! Loop on JT 
ENDIF ! Read fields 

END SUBROUTINE UPDFLD

SUBROUTINE INIT_CLIM_FILE(FNAME,IFIELDS,TF)
USE PARKIND1, ONLY: JPIM
USE NETCDF
USE NETCDF_UTILS, ONLY: NCERROR
USE YOMLUN1S , ONLY : NULOUT 
USE YOMDPHY  , ONLY : NPOI,    NLON      ,NLAT     
USE MPL_MODULE
USE YOMCST   , ONLY : RDAY 
IMPLICIT NONE
TYPE(TYPE_CLIM_FILE),INTENT(OUT) :: TF ! Created structure 
INTEGER(KIND=JPIM),INTENT(IN)    :: IFIELDS(:) ! Array with fields
CHARACTER(LEN=*),INTENT(IN)      :: FNAME      ! Netcd file name with data 

! Local variables 
INTEGER(KIND=JPIM) :: JV
CHARACTER(LEN=20)  :: CVAR 
INTEGER(KIND=JPIM) :: VNDIMS,VDIMIDS(NF90_MAX_VAR_DIMS)
INTEGER(KIND=JPIM) :: TVARID,IFSS
CHARACTER(LEN=100) :: CTUNITS

#include "fcttim.h"

! Assign & missing 
TF%NFIELDS=SIZE(IFIELDS)
TF%FNAME=FNAME
TF%ISTEP(1)=IMISS
TF%ISTEP(2)=IMISS

!! Allocate arrays
ALLOCATE(TF%IFIELDS(TF%NFIELDS))
ALLOCATE(TF%NCVARIDS(TF%NFIELDS))
ALLOCATE(TF%DATA(2,NPOI,TF%NFIELDS))


TF%IFIELDS(:) = IFIELDS(:)
TF%NCVARIDS(:) = IMISS 

!! Open file 
CALL NCERROR( NF90_OPEN(TRIM(TF%FNAME),NF90_NOWRITE,TF%NCID),&
                       & 'Opening '//TRIM(TF%FNAME))
WRITE(NULOUT,*)'NETCDF-FILE ',TF%FNAME(1:LEN_TRIM(TF%FNAME)),&
                       & ' OPENED ON UNIT ',TF%NCID

!! Get variable IDs
DO JV=1,TF%NFIELDS
  CVAR=TRIM(GRIB_SNAME(TF%IFIELDS(JV)))
  CALL NCERROR( NF90_INQ_VARID(TF%NCID,CVAR,TF%NCVARIDS(JV)),&
                             & 'getting varid '//TRIM(CVAR) )
ENDDO

!* Find Variable Dimensions: Takes it from the last variable in the list
!! Assuming all others are the same... 
CALL NCERROR( NF90_INQUIRE_VARIABLE(TF%NCID,TF%NCVARIDS(1) &
                                  &,ndims=VNDIMS,dimids=VDIMIDS), &
                                  &'getting var info '//TRIM(GRIB_SNAME(TF%IFIELDS(1))) )

TF%NIDTIM=VDIMIDS(VNDIMS)
TF%NIDLAT=IMISS
IF( VNDIMS == 2 ) THEN
  TF%NIDLON=VDIMIDS(1)
ELSEIF (VNDIMS == 3 .OR. VNDIMS == 4 ) THEN
  TF%NIDLON=VDIMIDS(1)
  TF%NIDLAT=VDIMIDS(2)
ELSE
  WRITE(NULOUT,*) 'WRONG NUMBER OF VARIABLE DIMENSIONS',TRIM(TF%FNAME),CVAR,VNDIMS
  CALL ABOR1('INIT_CLIM_FILE')
ENDIF

!* get dimension lengths 
CALL NCERROR( NF90_INQUIRE_DIMENSION(TF%NCID,TF%NIDTIM,len=TF%NITIM),'getting time len '//TRIM(CVAR) )
CALL NCERROR( NF90_INQUIRE_DIMENSION(TF%NCID,TF%NIDLON,len=TF%NILON),'getting lon len '//TRIM(CVAR) )
IF (TF%NIDLAT /= IMISS ) THEN
  CALL NCERROR( NF90_INQUIRE_DIMENSION(TF%NCID,TF%NIDLAT,len=TF%NILAT),'getting lat len '//TRIM(CVAR) )
ELSE
  TF%NILAT = 0
ENDIF
IF(TF%NILON.NE.NLON .OR. TF%NILAT.NE.NLAT) THEN
  WRITE(NULOUT,*)'NLON OR NLAT NOT SPECIFIED CORRECTLY:'
  WRITE(NULOUT,*)'NLON IN NAMELIST AND FORCING: ',NLON,TF%NILON
  WRITE(NULOUT,*)'NLAT IN NAMELIST AND FORCING: ',NLAT,TF%NILAT
  CALL ABOR1('INIT_CLIM_FILE')
ENDIF

!*  Read time 
CALL NCERROR( NF90_INQ_VARID(TF%NCID, 'time', TVARID),'getting varid '//'TIME')
CALL NCERROR( NF90_GET_ATT(TF%NCID, TVARID, 'units', CTUNITS),'getting time units')
WRITE(NULOUT,*) "INIT_CLIM_FILE: TIME UNITS", TRIM(CTUNITS)
IF ( CTUNITS(1:14) == "seconds since ") THEN
  READ(CTUNITS,'(14x,1i4,1x,1i2.2,1x,1i2.2,1x,1i2.2,1x,1i2.2,1x,1i2.2)')&
  & TF%IFYEAR,TF%IFMON,TF%IFDAY,TF%IFHOUR,TF%IFMIN,TF%IFSEC
  TF%ZDELS=1._JPRB
ELSEIF ( CTUNITS(1:14) == "minutes since ") THEN
  READ(CTUNITS,'(14x,1i4,1x,1i2.2,1x,1i2.2,1x,1i2.2,1x,1i2.2,1x,1i2.2)')&
  & TF%IFYEAR,TF%IFMON,TF%IFDAY,TF%IFHOUR,TF%IFMIN,TF%IFSEC
  TF%ZDELS=60._JPRB
ELSEIF ( CTUNITS(1:12) == "hours since ") THEN
  READ(CTUNITS,'(12x,1i4,1x,1i2.2,1x,1i2.2,1x,1i2.2,1x,1i2.2,1x,1i2.2)')&
  & TF%IFYEAR,TF%IFMON,TF%IFDAY,TF%IFHOUR,TF%IFMIN,TF%IFSEC
  TF%ZDELS=3600._JPRB
ELSEIF ( CTUNITS(1:11) == "days since ") THEN
  READ(CTUNITS,'(11x,1i4,1x,1i2.2,1x,1i2.2,1x,1i2.2,1x,1i2.2,1x,1i2.2)')&
  & TF%IFYEAR,TF%IFMON,TF%IFDAY,TF%IFHOUR,TF%IFMIN,TF%IFSEC
  TF%ZDELS=86400._JPRB
ELSE
  WRITE(NULOUT,*) "Time units in netcdf not supported"
  WRITE(NULOUT,*)
  CALL ABOR1('in INIT_CLIM_FILE')
ENDIF
ALLOCATE(TF%FTIME(TF%NITIM))
CALL NCERROR( NF90_GET_VAR(TF%NCID,TVARID,TF%FTIME),'Reading Time')


!! TIme calculations 
IFSS=3600*TF%IFHOUR+60*TF%IFMIN+TF%IFSEC
TF%ZTREF = RTIME(TF%IFYEAR,TF%IFMON,TF%IFDAY,IFSS)
TF%FTIME(:) = TF%FTIME(:)*TF%ZDELS + TF%ZTREF 

!* final write
WRITE(NULOUT,*) "INIT_CLIM_FILE INFO"
WRITE(NULOUT,*) "NFIELDS,IFIELDS",TF%NFIELDS,TF%IFIELDS
WRITE(NULOUT,*) 'FNAME,NCID',TRIM(TF%FNAME),TF%NCID
WRITE(NULOUT,*) "NCVARIDS",TF%NCVARIDS
WRITE(NULOUT,*) "NIDTIM,NIDLAT,NIDLON",TF%NIDTIM,TF%NIDLAT,TF%NIDLON 
WRITE(NULOUT,*) "NITIM,NILAT,NILON",TF%NITIM,TF%NILAT,TF%NILON
WRITE(NULOUT,*) "IFYEAR,IFMON,IFDAY,IFHOUR,IFMIN,IFSEC,ZDELS",&
  &TF%IFYEAR,TF%IFMON,TF%IFDAY,TF%IFHOUR,TF%IFMIN,TF%IFSEC,TF%ZDELS
WRITE(NULOUT,*) "INIT_CLIM_FILE FINISHED"
WRITE(NULOUT,*) ' '
END SUBROUTINE INIT_CLIM_FILE
                            
  

FUNCTION RETIND(CVAR,IFIELDS)
USE PARKIND1, ONLY: JPIM
USE YOMLUN1S , ONLY : NULOUT 
USE MPL_MODULE 

IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN)   :: CVAR ! variable name to identify
INTEGER(KIND=JPIM),INTENT(IN) :: IFIELDS(:) ! Array with field IDS
INTEGER(KIND=JPIM)            :: RETIND ! Index in the IFIELDS array 

! Local variables 
INTEGER(KIND=JPIM):: JV,ICODE

ICODE=IMISS
DO JV=1,SIZE(GRIB_SNAME)
  IF (GRIB_SNAME(JV) == CVAR ) THEN
    ICODE=JV
    EXIT
  ENDIF
ENDDO
IF ( ICODE == IMISS) THEN
  WRITE(NULOUT,*) "RETIND:CVAR not associated with any code: ",CVAR
  CALL ABOR1('RETIND:CVAR not coded')
ENDIF 

RETIND=IMISS
DO JV=1,SIZE(IFIELDS)
  IF (IFIELDS(JV) == ICODE ) THEN
    RETIND=JV
    EXIT
  ENDIF
ENDDO
IF ( RETIND == IMISS ) THEN
  WRITE(NULOUT,*) "REIND could not find index"
  WRITE(NULOUT,*) "CVAR: ",CVAR
  WRITE(NULOUT,*) "IFIELDS: ",IFIELDS
  CALL ABOR1("RETIND could not find index")
ENDIF    

END FUNCTION RETIND

SUBROUTINE INIT_GRIB_SNAME
IMPLICIT NONE 

INTEGER(KIND=JPIM) :: JV
DO JV=1,SIZE(GRIB_SNAME)
  GRIB_SNAME(JV)='-'
ENDDO

GRIB_SNAME(27)='cvl'
GRIB_SNAME(28)='cvh'
GRIB_SNAME(29)='tvl'
GRIB_SNAME(30)='tvh'
GRIB_SNAME(66)='lai_lv'
GRIB_SNAME(67)='lai_hv'

END SUBROUTINE INIT_GRIB_SNAME 

END MODULE YOMCLIE
