!
!  ###                                   #######
!   #     #    #  #####   #    #   ##### #     #  #    #   #####  #####   #    #   #####
!   #     ##   #  #    #  #    #     #   #     #  #    #     #    #    #  #    #     #  
!   #     # #  #  #    #  #    #     #   #     #  #    #     #    #    #  #    #     #  
!   #     #  # #  #####   #    #     #   #     #  #    #     #    #####   #    #     #  
!   #     #   ##  #       #    #     #   #     #  #    #     #    #       #    #     #  
!  ###    #    #  #        ####      #   #######   ####      #    #        ####      #  
!
!  $Author: pkubota $
!  $Date: 2008/09/23 17:51:54 $
!  $Revision: 1.9 $
!

MODULE InputOutput
  USE Constants, Only: &
       r8,r4,i4,             &
       i8
  USE IOLowLevel, Only: &
       ReadGetSLM       

  USE Utils, Only: &
       AveBoxIJtoIBJB,IJtoIBJB

  USE Options, Only: &
       labelsi,labelsj,monl,yrl
  IMPLICIT NONE

  PUBLIC :: getsbc
    
  INTERFACE getsbc
     MODULE PROCEDURE getsbc_CPL, getsbc_OFFLINE
  END INTERFACE

CONTAINS

  SUBROUTINE InitInputOutput () 


  END SUBROUTINE InitInputOutput
    !
  ! getsbc :read surface/atmosphere boundary conditions.
  !
  SUBROUTINE getsbc_CPL (imax,jmax,kmax,galb ,gsst ,gndvi,gslm,gsnw,gozo,wsib3d,&
       ifday,tod,idate,idatec,&
       ifalb,ifsst,ifndvi,ifslm,ifslmSib2,ifsnw,ifozone,&
       sstlag,intsst,intndvi,fint,tice,&
       yrl ,monl,ibMax,jbMax,ibMaxPerJB)
    IMPLICIT NONE
    !
    ! INPUT/OUTPUT VARIABLES
    !
    ! Real size of the grid
    INTEGER, INTENT(in   ) :: imax
    INTEGER, INTENT(in   ) :: jmax
    INTEGER, INTENT(in   ) :: kmax
    ! Size of block divided grid
    INTEGER, INTENT(in   ) :: ibMax
    INTEGER, INTENT(in   ) :: jbMax
    INTEGER, INTENT(in   ) :: ibMaxPerJB(:)

    ! Boundary fields output
    REAL(KIND=r8), INTENT(out  ) :: galb  (ibMax,jbMax) ! albedo
    REAL(KIND=r8), INTENT(out  ) :: gndvi (ibMax,jbMax) ! ndvi    
    REAL(KIND=r8), INTENT(out  ) :: gsst  (ibMax,jbMax) ! sst
    REAL(KIND=r8), INTENT(out  ) :: gslm  (ibMax,jbMax) ! soil moisture
    REAL(KIND=r8), INTENT(out  ) :: gsnw  (ibMax,jbMax) ! snow
    REAL(KIND=r8), INTENT(out  ) :: wsib3d(ibMax,jbMax,3) ! moisture
    !hmjb o ozonio nao pode ser apenas 'out' pois, no caso de usar a antiga
    !  getoz(), ele sairia daqui com valores indefinidos... Com inout,
    !  ele entra e,  se nao for alterado, sai como entrou
    REAL(KIND=r8), INTENT(inout) :: gozo(ibMax,kMax,jbMax) ! ozone

    ! Options for reading boundary fields
    INTEGER, INTENT(inout) :: ifalb
    INTEGER, INTENT(inout) :: ifsst
    INTEGER, INTENT(inout) :: ifndvi
    INTEGER, INTENT(inout) :: ifslm
    INTEGER, INTENT(inout) :: ifsnw
    INTEGER, INTENT(inout) :: ifslmSib2
    INTEGER, INTENT(inout) :: ifozone

    ! Time
    INTEGER, INTENT(in   ) :: ifday
    REAL(KIND=r8), INTENT(in   ) :: tod
    INTEGER, INTENT(in   ) :: idate(4)
    INTEGER, INTENT(in   ) :: idatec(4)
    REAL(KIND=r8), INTENT(in   ) :: sstlag
    INTEGER, INTENT(in   ) :: intsst
    INTEGER, INTENT(in   ) :: intndvi
    REAL(KIND=r8), INTENT(in   ) :: fint
    REAL(KIND=r8), INTENT(in   ) :: tice
    REAL(KIND=r8), INTENT(in   ) :: yrl
    INTEGER, INTENT(in   ) :: monl(12)
    !
    ! LOCAL VARIABLES
    !
    REAL(KIND=r8)                :: xndvi   (ibMax,jbMax)
    REAL(KIND=r8)                :: xsst    (ibMax,jbMax)
    REAL(KIND=r8)                :: bfr_in  (imax,jmax)
    REAL(KIND=r8)                :: bfrw_in  (imax,jmax,3)
    REAL(KIND=r8)                :: bfrw_out  (ibmax,jbmax,3)
    REAL(KIND=r4)                :: rbrfw3d    (iMax,jMax,3)

    REAL(KIND=r8)                :: bfr_in3 (imax,kmax,jmax)
    REAL(KIND=r8)                :: bfr_out (ibMax,jbMax)
    REAL(KIND=r8)                :: bfr_out3(ibMax,kmax,jbMax)
    REAL(KIND=r4)                :: rbrf    (iMax,jMax)
    REAL(KIND=r4)                :: rbrf3   (iMax,kmax,jMax)

    !
    !
    INTEGER                :: lrecl,LRecIn
    REAL(KIND=r8)          :: fhr
    INTEGER                :: mf
    INTEGER                :: mn
    INTEGER                :: mf_ndvi
    INTEGER                :: mn_ndvi

    INTEGER                :: month
    INTEGER                :: mm
    INTEGER                :: i
    INTEGER                :: j
    INTEGER                :: k
    INTEGER                :: irec
    INTEGER                :: irec_ndvi

    REAL(KIND=r8)                :: f1
    REAL(KIND=r8)                :: f2
    REAL(KIND=r8)                :: f1_ndvi
    REAL(KIND=r8)                :: f2_ndvi
    REAL(KIND=r8)                :: gmax
    REAL(KIND=r8)                :: gmin
    REAL(KIND=r8)                :: fsst
    REAL(KIND=r8)                :: fndvi
    REAL(KIND=r8)                :: fisst
    REAL(KIND=r8)                :: findvi
    REAL(KIND=r8)                :: xx1
    REAL(KIND=r8)                :: xx2
    REAL(KIND=r8)                :: xday
    INTEGER :: ierr
    galb    =0.0_r8
    gndvi   =0.0_r8
    gsst    =0.0_r8
    gslm    =0.0_r8
    gsnw    =0.0_r8
    wsib3d  =0.0_r8
  
  END SUBROUTINE getsbc_CPL
  
  
  SUBROUTINE getsbc_OFFLINE(iMax,jMax,ibMax,jbMax,ibMaxPerJB,idate,idatec,tod,ifday,ifsst,&
                      ifslm,nfslm,nfslmtp,intsst,nfprt,nfctrl,fNameSoilms,fNameSoilmsWkl,reducedGrid,fint,gslm,wsib3d)
    IMPLICIT NONE
    INTEGER       , INTENT(in   ) :: iMax
    INTEGER       , INTENT(in   ) :: jMax
    INTEGER       , INTENT(in   ) :: ibMax
    INTEGER       , INTENT(in   ) :: jbMax
    INTEGER, INTENT(in   ) :: ibMaxPerJB(:)
    INTEGER       , INTENT(in   ) :: idate(:)
    INTEGER       , INTENT(in   ) :: idatec(:)
    REAL(KIND=r8), INTENT(in   ) :: tod
    INTEGER       , INTENT(in   ) :: ifday
    INTEGER       , INTENT(in   ) :: ifsst
    INTEGER       , INTENT(inout) :: ifslm
    INTEGER       , INTENT(in   ) :: intsst
    INTEGER       , INTENT(in   ) :: nfslm
    INTEGER       , INTENT(in   ) :: nfslmtp
    INTEGER       , INTENT(in   ) :: nfprt
    INTEGER       , INTENT(in   ) :: nfctrl(:)
    CHARACTER(LEN=*), INTENT(in   ) :: fNameSoilms
    CHARACTER(LEN=*), INTENT(in   ) :: fNameSoilmsWkl
    LOGICAL       , INTENT(in   ) :: reducedGrid
    REAL(KIND=r8), INTENT(in   ) :: fint    
    REAL(KIND=r8), INTENT(out  ) :: gslm(ibMax,jbMax) ! soil moisture
    REAL(KIND=r8), INTENT(out  ) :: wsib3d(ibMax,jbMax,50) ! moisture

    INTEGER                :: lrecl
    INTEGER                :: LRecIn
    INTEGER                :: ierr
    INTEGER                :: irec
    INTEGER                :: mf
    INTEGER                :: mn
    INTEGER                :: i
    INTEGER                :: j
    REAL(KIND=r8)         :: fhr
    REAL(KIND=r4)         :: rbrf    (iMax,jMax)
    REAL(KIND=r8)                :: bfr_in  (imax,jmax)
    REAL(KIND=r8)                :: bfr_out (ibMax,jbMax)
    REAL(KIND=r8)                :: gmax
    REAL(KIND=r8)                :: gmin
    REAL(KIND=r8)                :: f1
    REAL(KIND=r8)                :: f2

    IF (ifsst == 4 .AND. intsst <= 0) THEN
       CALL GetRecWgtMonthlySST &
            (idate, idatec, tod, labelsi, labelsj, &
            irec, f1, f2, mf, mn,monl)

!!$       WRITE (UNIT=nfprt, FMT='(A)') ' GetRecWgtMonthlySST'
!!$       WRITE (UNIT=nfprt, FMT='(/,4(A,I5),/)') &
!!$            ' reci = ', irec, ' recf = ', irec+1, &
!!$            ' mra = ', mf, ' mrb = ', mf+1
!!$       WRITE (UNIT=nfprt, FMT=*) ' fa  (*mra) = ', f1, ' fb  (*mrb) = ', f2
    ELSE
       CALL GetWeightsOld(yrl,monl,idatec, tod, f1, f2,mf)
!!$       WRITE (UNIT=nfprt, FMT=*) ' fa  (*mra) = ', f1, ' fb  (*mrb) = ', f2
    END IF

       !
       ! process soil moisture file
       !
       IF (ifslm /= 0) THEN
          IF (ifslm == 1) THEN
             !     ifxxx=1    xxx is set to month=idatec(2) in the first call,
             !                but not processed from the subsequent calls.
             !                ifxxx is set to zero after interpolation
             INQUIRE (IOLENGTH=LRecIn) rbrf
             !---------------------------
             OPEN (UNIT=nfslm,FILE=TRIM(fNameSoilmsWkl),FORM='UNFORMATTED', ACCESS='DIRECT', &
                  ACTION='read', RECL=LRecIn, STATUS='OLD', IOSTAT=ierr) 
             IF (ierr /= 0) THEN
                   WRITE(UNIT=nfprt,FMT="('**(ERROR)** Open file ',a,' returned iostat=',i4)") &
                  TRIM(fNameSoilmsWkl), ierr
                STOP "**(ERROR)**"
             END IF
             ! irec correspond the record by soil layer
             DO irec=1,8
                CALL ReadGetSLM(nfslm,irec,bfr_in)
                IF (reducedGrid) THEN
                   CALL AveBoxIJtoIBJB(bfr_in,gslm)
                ELSE
                   CALL IJtoIBJB(bfr_in,gslm)
                END IF
                DO j=1,jbMax
                   DO i=1,ibMaxPerJB(j)
                      wsib3d(i,j,8+1-irec)=gslm(i,j)
                   END DO
                END DO
             END DO
             CLOSE(UNIT=nfslm)
             

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

             INQUIRE (IOLENGTH=LRecIn) rbrf
             OPEN (UNIT=nfslm,FILE=TRIM(fNameSoilms),FORM='UNFORMATTED', ACCESS='DIRECT', &
                  ACTION='read', RECL=LRecIn, STATUS='OLD', IOSTAT=ierr) 
             IF (ierr /= 0) THEN
                   WRITE(UNIT=nfprt,FMT="('**(ERROR)** Open file ',a,' returned iostat=',i4)") &
                  TRIM(fNameSoilms), ierr
                STOP "**(ERROR)**"
             END IF
             
	     irec=idate(2)
             CALL ReadGetSLM(nfslm,irec,bfr_in)
             IF (reducedGrid) THEN
                CALL AveBoxIJtoIBJB(bfr_in,gslm)
             ELSE
                CALL IJtoIBJB(bfr_in,gslm)
             END IF
             CLOSE(UNIT=nfslm)
             ifslm=0
          ELSE IF (ifslm == 2.OR. &
               (ifslm == 3.AND.tod == 0.0_r8.AND.ifday == 0)) THEN
	     INQUIRE (IOLENGTH=LRecIn) rbrf
             OPEN (UNIT=nfslm,FILE=TRIM(fNameSoilms),FORM='UNFORMATTED', ACCESS='DIRECT', &
                  ACTION='read', RECL=LRecIn, STATUS='OLD', IOSTAT=ierr) 
             IF (ierr /= 0) THEN
                WRITE(UNIT=nfprt,FMT="('**(ERROR)** Open file ',a,' returned iostat=',i4)") &
                     TRIM(fNameSoilms), ierr
                STOP "**(ERROR)**"
             END IF
             irec=idate(2)
             CALL ReadGetSLM(nfslm,irec,bfr_in)
 
             IF (reducedGrid) THEN
                CALL AveBoxIJtoIBJB(bfr_in,gslm)
             ELSE
                CALL IJtoIBJB(bfr_in,gslm)
             END IF
             IF (irec == 12) THEN
	        irec=1
	     ELSE
	        irec=irec+1    
             END IF
	  
             CALL ReadGetSLM(nfslm,irec,bfr_in)
          
	     IF (reducedGrid) THEN
                CALL AveBoxIJtoIBJB(bfr_in,bfr_out)
             ELSE
                CALL IJtoIBJB(bfr_in,bfr_out)
             END IF
             CLOSE(UNIT=nfslm)
             gmax=-1.0e10_r8
             gmin=+1.0e10_r8
             DO j=1,jbMax
                DO i=1,ibMaxPerJB(j)
                   gslm(i,j)=f2*gslm(i,j)+f1*bfr_out(i,j)
                   gmax=MAX(gmax,gslm(i,j))
                   gmin=MIN(gmin,gslm(i,j))
                END DO
             END DO
             IF (ifslm == 3.AND.tod == 0.0_r8.AND.ifday == 0) THEN
                ifslm=0
             END IF
             IF (nfctrl(23) >= 1) THEN
                WRITE(UNIT=nfprt,FMT=222) mf,f1,f2,gmax,gmin
             END IF
          ELSE
             WRITE(UNIT=nfprt,FMT=333)
             STOP
          END IF
       END IF
222 FORMAT(' SOILM   START MONTH=',i2,'  F1,F2=',2f6.3,'  MAX,MIN=',2e12.5)
223 FORMAT(' OZONE   START MONTH=',i2,'  F1,F2=',2f6.3,'  MAX,MIN=',2e12.5)
333 FORMAT(' ABNORMAL END IN SUBR.GETSBC AT SOILM  INTERPOLATION')

  END SUBROUTINE getsbc_OFFLINE 
  SUBROUTINE GetRecWgtMonthlySST &
       (idate, idatec, tod, labelsi, labelsj, &
       irec, f1, f2, mra, mrb,monl)

    IMPLICIT NONE

    ! Computes the Corresponding Records to do Linear
    ! Time Interpolation and the Respectives Weights.

    INTEGER, INTENT (IN) :: idate(4), idatec(4),monl(12)
    REAL (KIND=r8), INTENT (IN) :: tod
    CHARACTER (LEN=10), INTENT (IN) :: labelsi, labelsj

    INTEGER, INTENT (OUT) :: irec, mra, mrb
    REAL (KIND=r8), INTENT (OUT) :: f1, f2

    ! Local Constants
    INTEGER :: ysi, msi, dsi, ysj, msj, dsj, ndij, nd, &
         tmca, tmcb, tmcf
    REAL (KIND=r8) :: xday, zdayf, zdaya, zdayb, tc

    ! Get Year, Month and Day of the Initial and Second Medium Date
    ! for SST Direct Access File Data

    READ (labelsi(1:4), '(I4)') ysi
    READ (labelsi(5:6), '(I2)') msi
    READ (labelsi(7:8), '(I2)') dsi
    READ (labelsj(1:4), '(I4)') ysj
    READ (labelsj(5:6), '(I2)') msj
    READ (labelsj(7:8), '(I2)') dsj

    ! Lag of Days for SST Data:
    ! Just for Checking if the Scale is a Month
    ndij=0
    IF (msi+1 <= msj-1) THEN
       DO nd=msi+1,msj-1
          ndij=ndij+monl(nd)
       END DO
    ELSE
       DO nd=msi+1,12
          ndij=ndij+monl(nd)
       END DO
       DO nd=1,msj-1
          ndij=ndij+monl(nd)
       END DO
    END IF
    ndij=ndij+monl(msi)-dsi+dsj+365*(ysj-ysi-1)

    ! Check for Monthly Scale SST Data
    IF (ABS(ndij) <= 27 .OR. ABS(ndij) >= 32) THEN
       WRITE (UNIT=0, FMT='(/,A)') ' *** Error: The SST Data Is Not On Monthly Scale   ***'
       WRITE (UNIT=0, FMT='(/,A,I8,12X,A,/)') ' *** Lag Of Days For SST Data: ', ndij, '***'
       WRITE (UNIT=0, FMT='(A,/)') ' *** Program STOP: SUBROUTINE GetRecWgtMonthlySST  ***'
       STOP
    END IF

    ! Length in Days of the Date of Forecasting
    tmcf=monl(idatec(2))
    IF (idatec(2) == 2 .AND. MOD(idatec(4),4) == 0) tmcf=29
    ! Medium Day of the Month of Forecasting
    zdayf=0.5_r8*REAL(tmcf,r8)+1.0_r8
    ! Fractional Day of Forecasting
    tc=REAL(idate(1),r8)/24.0_r8+tod/86400.0_r8
    ! Correcting Factor if Necessary (tc is in Days)
    IF (tc >= 1.0_r8) tc=tc-1.0_r8
    xday=REAL(idatec(3),r8)+tc
    ! Getting the Corresponding Record in SST Data
    irec=12-msi+idatec(2)+12*(idatec(4)-ysi-1)+2
    IF (xday >= zdayf) irec=irec+1

    ! Months for the Linear Time Interpolation Related to the Records
    mra=MOD(irec-3+msi,12)
    IF (mra == 0) mra=12
    mrb=mra+1
    IF (mrb > 12) mrb=1

    ! Length in Days for the First Month of Interpolation
    tmca=monl(mra)
    IF (mra == 2 .AND. MOD(ysi,4) == 0) tmca=29
    ! Medium Fracitonal Day for the First Month of Interpolation
    zdaya=0.5_r8*REAL(tmca,r8)+1.0_r8-REAL(tmca,r8)
    ! Length in Days for the Second Month of Interpolation
    tmcb=monl(mrb)
    IF (mrb == 2 .AND. MOD(ysj,4) == 0) tmcb=29
    ! Medium Fracitonal Day for the Second Month of Interpolation
    zdayb=0.5_r8*REAL(tmcb,r8)+1.0_r8
    ! Scaling Fractional Day of Forecasting, if Necessary
    IF (xday >= zdayf) xday=xday-REAL(tmca,r8)
    ! Interpolation Factors
    f1=(xday-zdaya)/(zdayb-zdaya)
    f2=1.0_r8-f1

  END SUBROUTINE GetRecWgtMonthlySST

  SUBROUTINE GetWeightsOld (yrl,monl,idatec, tod, f1, f2,mf)

    IMPLICIT NONE

    ! Computes Weights as in getsbc:

    INTEGER, PARAMETER :: r8 = SELECTED_REAL_KIND(15)
    INTEGER, INTENT (IN) :: idatec(4)
    INTEGER, INTENT (IN) :: monl(12)
    REAL (KIND=r8), INTENT (IN) :: tod
    REAL (KIND=r8), INTENT (IN) :: yrl
    REAL (KIND=r8), INTENT (OUT) :: f1, f2
    INTEGER,  INTENT (OUT):: mf
    INTEGER :: mon, mnl, mn, mnlf, mnln
    REAL (KIND=r8) :: yday, add
    LOGICAL :: ly

    mon=idatec(2)
    yday=REAL(idatec(3),r8)+REAL(idatec(1),r8)/24.0_r8+MOD(tod,3600.0_r8)/86400.0_r8
    mf=mon-1
    ly= yrl == 365.25_r8 .AND. MOD(idatec(4),4) == 0
    mnl=monl(mon)
    IF (ly .AND. mon == 2) mnl=29
    ! Em getsbc seria apenas >
    ! As consideracoes de interpolacao leva a >=
    IF (yday >= 1.0_r8+0.5_r8*REAL(mnl,r8)) mf=mon
    mn=mf+1
    IF (mf < 1) mf=12
    IF (mn > 12) mn=1
    mnlf=monl(mf)
    IF (ly .AND. mf == 2) mnlf=29
    add=0.5_r8*REAL(mnlf,r8)-1.0_r8
    IF (mf == mon) add=-add-2.0_r8
    mnln=monl(mn)
    IF (ly .AND. mn == 2) mnln=29
    f1=2.0_r8*(yday+add)/REAL(mnlf+mnln,r8)
    f2=1.0_r8-f1

  END SUBROUTINE GetWeightsOld


END MODULE InputOutput
