!*************************************************************************
!*                                                                       *
!*     LMBNNR - Nonsmooth Optimization based NN Software for Regression  *
!*              using LMBM (version 1.1)                                 *
!*                                                                       *
!*     by Napsu Karmitsa 2020 (last modified 11.11.2021).                *
!*                                                                       *
!*     The code is partly based on preliminary work made by Kaisa Joki   *
!*     and Pauliina Mäkinen.                                             *
!*                                                                       *
!*     The software is free for academic teaching and research           *
!*     purposes but I ask you to refer the appropriate references        *
!*     given below, if you use it.                                       *
!*                                                                       *
!*************************************************************************
!*
!*
!*     Codes included:
!*
!*     lmbnnr.f03            - Mainprogram for the NNR software
!*                             (this file).
!*     parameters.f03        - Parameters. Inludes modules:
!*                               - r_precision - Precision for reals,
!*                               - param - Parameters,
!*                               - exe_time - Execution time.
!*     initlmbnnr.f03        - initialization of NN parameters and LMBM.
!*                             Includes modules:
!*                               - initnn    - Initialization of parameters for NN.
!*                               - initlmbm  - Initialization of LMBM.
!*     lmbm.f03              - LMBM - limited memory bundle method.
!*     objfun.f03            - Computation of the function and subgradients values.
!*     subpro.f03            - subprograms for LMBM.
!*
!*     Makefile              - makefile.
!*
!*
!*     Calling sequence:
!*
!*       ./lmbnnr infile nrecord ntrain nft [nH_max noutcom]
!*
!*     with the following arguments:
!*
!*     infile                - the data set;
!*     nrecord               - number of records in the data set;
!*     ntrain                - size of the training set, ntrain <= nrecord;
!*     nft                   - number of features in the data set (excluding output);
!*     nH_max                - maximum number of nodes in hidden layer, optional, 50 by default;
!*     noutcom               - number of output column, optional, nft+1 by default.
!*
!*     There is usually no need to tune other parameters. However, if you want to do that, modify initlmbnnr.f03.
!* 
!*     As default the results are written in
!*        
!*     results1.txt           - Evaluation criteria (e.g. RMSE, MAE,...) with training and predictions;
!*     results2.txt           - Final predictions.
!*
!*
!*     References:
!*
!*     for LMBNNR:
!*       http://napsu.karmitsa/lmbnnr
!*
!*       N. Karmitsa, S. Taheri, K. Joki, P. Mäkinen, A. Bagirov, M.M. Mäkelä, "Hyperparameter free 
!*       NN algorithm for large-scale regression problems", TUCS Technical Report, No. 1213, 
!*       Turku Centre for Computer Science, Turku, 2020.
!*
!*
!*     for LMBM:
!*       N. Haarala, K. Miettinen, M.M. Mäkelä, "Globally Convergent Limited Memory Bundle Method  
!*       for Large-Scale Nonsmooth Optimization", Mathematical Programming, Vol. 109, No. 1,
!*       pp. 181-205, 2007. DOI 10.1007/s10107-006-0728-2.
!*
!*       M. Haarala, K. Miettinen, M.M. Mäkelä, "New Limited Memory Bundle Method for Large-Scale 
!*       Nonsmooth Optimization", Optimization Methods and Software, Vol. 19, No. 6, pp. 673-692, 2004. 
!*       DOI 10.1080/10556780410001689225.
!*
!*
!*     Acknowledgements:
!*
!*     The work was financially supported by the Academy of Finland (Project No. 289500).
!*
!*************************************************************************
!*
!*     * PROGRAM lmbnnr *
!*
!*     Main program for nonsmooth NN regression software with LMBM.
!*
!*************************************************************************

PROGRAM lmbnnr

    USE r_precision, ONLY : prec        ! Precision for reals.
    USE param, ONLY : zero, one, large  ! Parameters.

    USE initnn, ONLY : &                ! Initialization of NN parameters.
        infile, &                       ! Dataset file.
        outfile0, &                     ! Result file with indices, function values, and cpu-time.
        outfile1, &                     ! Result file with predictions.
        nft, &                          ! Number of input features in data, from user.
        nrecord, &                      ! Number of instances in data, from user.
        ntrain, &                       ! Size of the training set, from user.
        a, &                            ! Data matrix a(nrecord,nft+1), from input file.
        ascaled, &                      ! Scaled data matrix.             
        mX, &                           ! Input variables.
        mY, &                           ! Output variables.
        noutcom, &                      ! Column number of output variable in original data.
        rho, &                          ! Penalty parameter.
        istop, &                        ! Automated stopping procedure is
                                        !   0 - not used,
                                        !   1 - used (recommended).
        asp, &                          ! Termination tolerance.                                
        isetx, &                        ! Updating method for weights, isetx = 4 by default.                                
        iscale, &                       ! Scaling is
                                        !   0 - not used,
                                        !   1 - used.
        ipredi, &                       ! Prediction is computed
                                        !   0 - only at the termination with complite model,
                                        !   1 - at every step.                                
        pred, &                         ! the values of predicted outputs
        tlimit, &                       ! Time limit, from user.
        nH_max, &                       ! Maximum number of nodes. from user.
        nH, &                           ! Current number of hidden nodes, loops from 1 to nH_max.
        maxdim, &                       ! Maximum dimension of the problem.
        fplain, &                       ! Function value without penalization.
        clin, &                         ! For scaling.
        dlin, &                         ! For scaling.
        init_nnpar, &                   ! Furher initialization of parameters.
        init_x, &                       ! Initialization of x.
        set_x, &                        ! Updating x for next round of incremental NN.
        scaling
    
    USE initlmbm, ONLY : &
        n, &                            ! Size of the optimization problem.
        forig, &                        ! f at x0.
        x                               ! Current x.
    
    USE lmbm_mod, ONLY : optim2         ! LMBM method for optimization.
    USE exe_time, ONLY : getime         ! Execution time.
    
    IMPLICIT NONE

    ! Local
    REAL(KIND=prec), DIMENSION(3) :: &
        fstop
            
    REAL(KIND=prec) :: &
        rmse1,rmse2,mae1,mae2,ce1,ce2,r1,r2, & ! Validy indices.
        f, fpen, &                      ! Function values.
        atmp                            ! Auxiliary value.       
    
    REAL :: &
        time1, &
        time3, &
        time4
        
    INTEGER :: &
        count, &                        ! Number of commandline arguments
        ntest, &                        ! Size of the test set.
        i,j,k,iterm
    
    CHARACTER(len=500) :: arg

    ! Intrinsic Functions
    INTRINSIC ABS,MAX

    count = command_argument_count()
    IF (count < 1) THEN
        PRINT*
        PRINT*,'LMBNNR - Nonsmooth Optimization based NN Software for Regression using LMBM'
        PRINT*
        PRINT*,'Calling sequence:'
        PRINT*
        PRINT*,'     ./lmbnnr infile nrecord ntrain nft [nH_max noutcom]'
        PRINT*
        PRINT*,'with the following arguments:'
        PRINT*
        PRINT*,'     infile                - the data set;'
        PRINT*,'     nrecord               - number of records in the data set;'
        PRINT*,'     ntrain                - size of the training set, ntrain <= nrecord;'
        PRINT*,'     nft                   - number of features in the data set (excluding output);'
        PRINT*,'     nH_max                - maximum number of nodes in hidden layer, optional, 10 by default;'
        PRINT*,'     noutcom               - number of output column, optional, nft+1 by default.'
        PRINT*
        PRINT*,'If you want to tune other parameters, modify initlmbnnr.f03.'
        PRINT*
        PRINT*,'As default the results are written in'
        PRINT*
        PRINT*,'     results1.txt           - Evaluation criteria (e.g. RMSE, MAE,...) with training and predictions;'
        PRINT*,'     results2.txt           - final predictions.'
        PRINT*
        STOP
    END IF

    IF (count < 4) STOP '  Too few commandline arguments. Type ./lmbnnr for help.'

    CALL get_command_argument(2, arg)
    READ (arg,*) nrecord
    CALL get_command_argument(3, arg)
    READ (arg,*) ntrain
    CALL get_command_argument(4, arg)
    READ (arg,*) nft
    
    
    IF (count >= 5) THEN
        CALL get_command_argument(5, arg)
        READ (arg,*) nH_max
    ELSE
        IF (nrecord*nft <= 1000000) THEN
            nH_max=200
        ELSE
            nH_max=50
        END IF  
    END IF
    IF (count >= 6) THEN
        CALL get_command_argument(6, arg)
        READ (arg,*) noutcom
    ELSE
        noutcom=nft+1     
    END IF
    

    CALL get_command_argument(1, infile)
    
    PRINT*,' Input file: ',infile
    PRINT*,' Number of records = ',nrecord
    PRINT*,' Size of the training set = ',ntrain
    PRINT*,' Number of features = ',nft
    PRINT*,' Maximum number of nodes = ',nH_max

    CALL init_nnpar() ! sets maximum dimension for optimization problem etc.    

    allocate(a(nrecord,nft+1),ascaled(nrecord,nft+1),mX(nft,nrecord))
    allocate(x(maxdim),mY(nrecord),pred(nrecord),clin(nft+1),dlin(nft+1)) 
    
    n = nft+3  ! Size of the first optimization problem
    CALL init_x(x,n)
    fstop = -large
    
    OPEN(42,file=outfile0)
    OPEN(40,file=outfile1)
    
    
    WRITE(42,*) 'LMBNNR: indices, function values and CPU time.'
    WRITE(42,*)
    WRITE(42,*) 'Data set: ',infile
    WRITE(40,*) 'LMBNNR: final predictions.'
    WRITE(40,*)
    WRITE(40,*) 'Data set: ',infile
    WRITE(42,*)
    WRITE(42,*) 'Number of records: ',nrecord
    WRITE(42,*) 'Size of the training set: ',ntrain
    WRITE(42,*) 'Number of features: ',nft
    WRITE(42,*) 'Weight updating scheme: ',isetx
    WRITE(42,*) 'Regularization parameter: ',rho
    WRITE(42,*)
    IF(iscale == 1) WRITE(42,*) 'Scaling is used. '
    IF(iscale == 0) WRITE(42,*) 'No scaling. '
    WRITE(42,*)        
    WRITE(42, *) ' nH |', ' rmse train |','  rmse test |','  mae train |','   mae test |', &
        ' ce train |','  ce test |','  r train |','   r test |', &
        '          f_orig |','               f |','           f_pen |','  CPU-time '

    
    !==================================================================
    !Read data and arrange it to input and output matrices
    !==================================================================
    OPEN(78,file=infile,status='old',form='formatted')
    DO i=1,nrecord
        READ(78,*) (a(i,k),k=1,nft+1)  !nft is the number of input parameters, in original data we have also the output
    END DO
    CLOSE(78)
    
    
    ! Trial scaled matrix
    ascaled=a

    IF (noutcom < nft+1) THEN ! swap features

        DO i = 1,nrecord
            atmp = ascaled(i,noutcom)
            ascaled(i,noutcom) = ascaled(i,nft+1)
            ascaled(i,nft+1) = atmp
        END DO
    END IF
    
    IF (iscale == 1) CALL scaling !
    
    ! Output values
    DO i=1,nrecord 
        mY(i) = ascaled(i,nft+1)
    END DO
               
    ! Input values
    DO i = 1, nrecord
        DO k = 1, nft
            mX(k,i) = ascaled(i,k)
        END DO
    END DO        
    
    CALL getime(time1)
    
    
    !================================================================
    outerloop: DO nH=1,nH_max  ! number of hidden nodes

        PRINT*,'Node No.:',nH
        fplain=large

        CALL optim2(f) ! Call for LMBM
        PRINT*,'f final    =',f
        
        
        CALL getime(time3)
        time4=time3-time1
        IF(time4 > tlimit) EXIT outerloop
            
        ntest=nrecord-ntrain
        
        IF (nrecord > ntrain .AND. ipredi == 1) THEN ! there are training and test sets
  
            IF (iscale == 1) THEN
                CALL sccheckfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2)
            ELSE
                CALL checkfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2)
            END IF
        
            ! Print the solution    
            WRITE(40,*)
            WRITE(40,*) 'Number of hidden nodes: ',nH
            WRITE(40,*)
            WRITE(40,*) 'Predictions for training: ',pred(1:ntrain) !
            WRITE(40,*)
            WRITE(40,*) 'Predictions for test set: ',pred(ntrain+1:nrecord) !
            
            fpen=zero
            DO i=1,n
                fpen=fpen+ABS(x(i))
            END DO
            fplain=f-rho*fpen
        
            WRITE(42,603) nH,rmse1,rmse2,mae1,mae2,ce1,ce2,r1,r2,forig,fplain,f,time4
603         FORMAT(i4,f13.4,f13.4,f13.4,f13.4,f13.4,f13.4,f13.4,f13.4,f18.4,f18.4,f18.4,f12.4)
        END IF
        
        IF (istop == 1) THEN ! Save three previous objective function values.
            
           fstop(3)=fstop(2)
           fstop(2)=fstop(1)
           fstop(1)=f
           
           IF (fstop(3)-fstop(1) <= asp*nft .AND. nH >= 3) THEN
                PRINT*,' Automated termination with nH = ',nH
                EXIT outerloop
            END IF
        END IF
            
        IF(nH<nH_max) THEN ! Not the perfect way of doing this.
            n = (nH+1)*(nft+2)+1
            CALL set_x(x,n)
            
            rho = rho*(fpen)/(fpen + ABS(x(n))) ! This works only with isetx=4 (default).
            if(rho<0.1_prec) rho=0.1_prec
            
        END IF
        
    END DO outerloop

    IF (nrecord > ntrain .AND. ipredi == 0) THEN ! there are training and test sets and only the final results are wanted
  
        IF (iscale == 1) THEN
            CALL sccheckfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2)
        ELSE
            CALL checkfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2)
        END IF
            
    
        ! Print the solution    
        WRITE(40,*)
        WRITE(40,*) 'Number of hidden nodes: ',nH-1
        WRITE(40,*)
        WRITE(40,*)
        WRITE(40,*) 'Predictions for training: ',pred(1:ntrain) !
        WRITE(40,*)
        WRITE(40,*) 'Predictions for test set: ',pred(ntrain+1:nrecord) !
        
        WRITE(42,603) nH-1,rmse1,rmse2,mae1,mae2,ce1,ce2,r1,r2,fplain,f,time4
    END IF
        

    CLOSE(40)
    CLOSE(42)
    
    deallocate(a,ascaled,mX)
    deallocate(x,mY) 
    
    STOP

CONTAINS

    SUBROUTINE checkfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2)
        !
        ! Calculates the predictions, RMSE, MAE, CE and r values for the solution x with UNscaled data.        
        !
        IMPLICIT NONE
        
        REAL(KIND=prec), DIMENSION(:), INTENT(IN) :: x       ! final weights
        REAL(KIND=prec), DIMENSION(:), INTENT(OUT) :: pred   ! predictions
        REAL(KIND=prec), INTENT(OUT) :: rmse1                ! RMSE value in training set
        REAL(KIND=prec), INTENT(OUT) :: mae1                 ! MAE value in training set  
        REAL(KIND=prec), INTENT(OUT) :: ce1                  ! CE value in training set   
        REAL(KIND=prec), INTENT(OUT) :: r1                   ! r value in training set     
        REAL(KIND=prec), INTENT(OUT) :: rmse2                ! RMSE value in test set
        REAL(KIND=prec), INTENT(OUT) :: mae2                 ! MAE value in test set  
        REAL(KIND=prec), INTENT(OUT) :: ce2                  ! CE value in test set   
        REAL(KIND=prec), INTENT(OUT) :: r2                   ! r value in test set    
        
        REAL(KIND=prec) :: e0_obs1         ! Mean of observed values in training data i.e e_0
        REAL(KIND=prec) :: e0_pre1         ! Mean of predicted values in training data i.e. bar(e)_0
        REAL(KIND=prec) :: fe1             ! Sum of values (e_i-e0_pre1) in training data 
        REAL(KIND=prec) :: e0_obs2         ! Mean of observed values in test data i.e e_0
        REAL(KIND=prec) :: e0_pre2         ! Mean of predicted values in test data i.e. bar(e)_0
        REAL(KIND=prec) :: fe2             ! Sum of values (e_i-e0_pre1) in test data               
               
        REAL(KIND=prec) :: y_pre           ! Predicted value for data point i                               
        REAL(KIND=prec) :: s_ij            ! Predicted value for data point i                               
                
        REAL(KIND=prec) :: sum_pre         ! Sum of predicted values                                    
        REAL(KIND=prec) :: f_quad,f_abs                      
                
        REAL(KIND=prec) :: rsumo1             
        REAL(KIND=prec) :: rsumn1 
        REAL(KIND=prec) :: rsumo2             
        REAL(KIND=prec) :: rsumn2            
                
        INTEGER :: i_w1jP, i_w0Bj, i_w0kj  ! Auxiliary variables
               
        INTEGER :: i, j, k 
        INTEGER :: i1 
               
               
        rmse1 = zero
        mae1 = zero
        r1 = zero
        ce1 = zero
               
        rmse2 = zero
        mae2 = zero
        r2 = zero
        ce2 = zero                     
               
        ! The mean of observed values in training data
        e0_obs1 = zero
        DO i = 1,ntrain                  
            e0_obs1 = e0_obs1 + mY(i)
        END DO
        e0_obs1 = e0_obs1 / REAL(ntrain,prec) 
               
        ! The mean of observed values in test data              
        e0_obs2 = zero
        IF (ntest > 0) THEN              
            DO i=1,ntest
                i1=ntrain+i
                e0_obs2 = e0_obs2 + mY(i1)
            END DO    
            e0_obs2 = e0_obs2/REAL(ntest,prec)  
        END IF
               
        fe1 = zero
        DO i=1,ntrain                   ! sum_i (e_i-e_0)^2   training set                  
            fe1=fe1+(mY(i)-e0_obs1)**2
        END DO            
                       
        fe2 = zero
        IF (ntest > 0) THEN
            DO i=1,ntest                  ! sum_i (e_i-e_0)^2   test set
                i1=ntrain+i
                fe2=fe2+(mY(i1)-e0_obs2)**2
            END DO    
        END IF                 
       
        sum_pre = zero
        f_quad = zero
        f_abs = zero
        e0_pre1 = zero
        
        !------------------------------
        !        TRAINING SET
        !------------------------------
        loop3: DO i=1,ntrain
                   
            ! Predicted values for data point
            y_pre = x(1)                             ! w_1BP is initialized as the value of y_pre
            DO j = 1, nH                             ! Each hidden node is looked through
                i_w1jP = 1 + j*(nft+2)               ! Index for w_1jP
                i_w0Bj = 1 + j*(nft+2) - 1           ! Index for w_0Bj
                s_ij = x(i_w0Bj)                     ! w_0Bj
                i_w0kj = 1 + (j-1)*(nft+2)                     
                DO k = 1, nft                        ! Inputs of data point i are looked through
                    i_w0kj =  i_w0kj + 1             ! Index for w_0kj
                    s_ij = s_ij + x(i_w0kj)*mX(k,i)  ! Update of s_ij
                END DO
                       
                IF (s_ij >= zero) THEN 
                    y_pre = y_pre + x(i_w1jP)*s_ij
                END IF
            END DO         
            pred(i)=y_pre         

            sum_pre = sum_pre + y_pre                ! The sum of predicted values
            f_quad = f_quad + (mY(i)-y_pre)**2   
            f_abs = f_abs + ABS(mY(i)-y_pre)
            
        END DO loop3
        
        e0_pre1 = sum_pre/REAL(ntrain,prec)          ! The mean of predicted values

        rsumn1 = zero
        rsumo1 = zero
          
        loop33: DO i=1,ntrain
                  
            ! Predicted values for data points are in pred(i)
            rsumo1 = rsumo1 + (mY(i)-e0_obs1)*(pred(i)-e0_pre1) 
            rsumn1 = rsumn1 + (pred(i)-e0_pre1)**2
            
        END DO loop33        
              
        rmse1 = SQRT(f_quad/REAL(ntrain,prec))       ! RMSE for training set
        mae1 = f_abs/REAL(ntrain,prec)               ! MAE for training set
        ce1 = one-f_quad/fe1                         ! CE for training set
        r1 = rsumo1/(SQRT(rsumn1*fe1))               ! r for training set
                              
        sum_pre = zero
        f_quad = zero
        f_abs = zero
        e0_pre1 = zero
        
        !------------------------------
        !            TEST SET
        !------------------------------              
        loop3test: DO i1=1,ntest
            i = ntrain+i1                            ! The index of the test set data point                  
                   
            ! Predicted values for data point
            y_pre = x(1)                             ! w_1BP is initialized as the value of y_pre
            DO j = 1, nH                             ! Each hidden node is looked through
                i_w1jP = 1 + j*(nft+2)               ! Index for w_1jP
                i_w0Bj = 1 + j*(nft+2) - 1           ! Index for w_0Bj
                s_ij = x(i_w0Bj)                     ! w_0Bj
                i_w0kj = 1 + (j-1)*(nft+2)                     
                DO k = 1, nft                        ! Inputs of data point i are looked through
                    i_w0kj =  i_w0kj + 1             ! Index for w_0kj
                    s_ij = s_ij + x(i_w0kj)*mX(k,i)  ! Update of s_ij
                END DO
                       
                IF (s_ij >= 0.0_prec) THEN 
                    y_pre = y_pre + x(i_w1jP)*s_ij
                END IF
            END DO                  
            pred(i) = y_pre
            sum_pre = sum_pre + y_pre                ! The sum of predicted values
            f_quad = f_quad + (mY(i)-y_pre)**2   
            f_abs = f_abs + ABS(mY(i)-y_pre)
            
        END DO loop3test
        
        e0_pre2 = sum_pre/REAL(ntest,prec)           ! The mean of predicted values in test set

        rsumn2 = zero
        rsumo2 = zero
               
        loop33test: DO i1=1,ntest
            i = ntrain+i1
            
            ! Predicted values for data points are in pred
            
            rsumo2 = rsumo2 + (mY(i)-e0_obs2)*(pred(i)-e0_pre2)    
            rsumn2 = rsumn2 + (pred(i)-e0_pre2)**2
            
        END DO loop33test       
              
        rmse2 = SQRT(f_quad/REAL(ntest,prec))       ! RMSE for test set
        mae2 = f_abs/REAL(ntest,prec)               ! MAE for test set
        ce2 = one-f_quad/fe2                        ! CE for test set
        r2 = rsumo2/(SQRT(rsumn2*fe2))              ! r for test set
                                  
               
    END SUBROUTINE checkfinal           

    
    
    SUBROUTINE sccheckfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2)
        !
        ! Calculates the predictions, RMSE, MAE, CE and r values for the solution x with SCALED data.        
        !
        IMPLICIT NONE
    
        REAL(KIND=prec), DIMENSION(:), INTENT(IN) :: x       ! final weights (scaled).
        REAL(KIND=prec), DIMENSION(:), INTENT(OUT) :: pred   ! predictions (with no scaling).
        REAL(KIND=prec), INTENT(OUT) :: rmse1                ! RMSE value in training set
        REAL(KIND=prec), INTENT(OUT) :: mae1                 ! MAE value in training set  
        REAL(KIND=prec), INTENT(OUT) :: ce1                  ! CE value in training set   
        REAL(KIND=prec), INTENT(OUT) :: r1                   ! r value in training set     
        REAL(KIND=prec), INTENT(OUT) :: rmse2                ! RMSE value in test set
        REAL(KIND=prec), INTENT(OUT) :: mae2                 ! MAE value in test set  
        REAL(KIND=prec), INTENT(OUT) :: ce2                  ! CE value in test set   
        REAL(KIND=prec), INTENT(OUT) :: r2                   ! r value in test set    
    
        REAL(KIND=prec) :: e0_obs1                  ! Mean of observed values in training data i.e e_0
        REAL(KIND=prec) :: e0_pre1                  ! Mean of predicted values in training data i.e. bar(e)_0
        REAL(KIND=prec) :: fe1                      ! Sum of values (e_i-e0_pre1) in training data 
        REAL(KIND=prec) :: e0_obs2                  ! Mean of observed values in test data i.e e_0
        REAL(KIND=prec) :: e0_pre2                  ! Mean of predicted values in test data i.e. bar(e)_0
        REAL(KIND=prec) :: fe2                      ! Sum of values (e_i-e0_pre1) in test data               
               
        REAL(KIND=prec) :: y_pre                    ! Predicted value for data point i                               
        REAL(KIND=prec) :: s_ij                     ! Predicted value for data point i                               
                
        REAL(KIND=prec) :: sum_pre                  ! Sum of predicted values                                    
        REAL(KIND=prec) :: f_quad,f_abs                      
                
        REAL(KIND=prec) :: rsumo1             
        REAL(KIND=prec) :: rsumn1 
        REAL(KIND=prec) :: rsumo2             
        REAL(KIND=prec) :: rsumn2            
                
        INTEGER :: i_w1jP, i_w0Bj, i_w0kj           ! Auxiliary variables
               
        INTEGER :: i, j, k 
        INTEGER :: i1 
               
               
        rmse1 = zero
        mae1 = zero
        r1 = zero
        ce1 = zero
               
        rmse2 = zero
        mae2 = zero
        r2 = zero
        ce2 = zero                     
               
        ! The mean of observed values in training data (unscaled data)
        e0_obs1 = zero
        DO i = 1,ntrain                  
            e0_obs1 = e0_obs1 + a(i,noutcom) !
        END DO
        e0_obs1 = e0_obs1 / REAL(ntrain,prec) 
               
        ! The mean of observed values in test data (unscaled data)             
        e0_obs2 = zero
        IF (ntest > 0) THEN              
            DO i=1,ntest
                i1=ntrain+i
                e0_obs2 = e0_obs2 + a(i1,noutcom) !
            END DO    
            e0_obs2 = e0_obs2/REAL(ntest,prec)  
        END IF
               
        fe1 = zero
        DO i=1,ntrain                               ! sum_i (e_i-e_0)^2   training set                  
            fe1=fe1+(a(i,noutcom)-e0_obs1)**2 
        END DO            
                       
        fe2 = zero
        IF (ntest > 0) THEN
            DO i=1,ntest                            ! sum_i (e_i-e_0)^2   test set
                i1=ntrain+i
                fe2=fe2+(a(i1,noutcom)-e0_obs2)**2
            END DO    
        END IF                 
       
        sum_pre = zero
        f_quad = zero
        f_abs = zero
        e0_pre1 = zero
        
        !------------------------------
        !        TRAINING SET
        !------------------------------
        ! The scaled predictions are first computed
        loop3: DO i=1,ntrain
                   
            ! Scaled predicted values for data point
            y_pre = x(1)                             ! w_1BP is initialized as the value of y_pre
            DO j = 1, nH                             ! Each hidden node is looked through
                i_w1jP = 1 + j*(nft+2)               ! Index for w_1jP
                i_w0Bj = 1 + j*(nft+2) - 1           ! Index for w_0Bj
                s_ij = x(i_w0Bj)                     ! w_0Bj
                i_w0kj = 1 + (j-1)*(nft+2)                     
                DO k = 1, nft                        ! Inputs of data point i are looked through
                    i_w0kj =  i_w0kj + 1             ! Index for w_0kj
                    s_ij = s_ij + x(i_w0kj)*mX(k,i)  ! Update of s_ij
                END DO
                       
                IF (s_ij >= zero) THEN 
                    y_pre = y_pre + x(i_w1jP)*s_ij
                END IF
            END DO         
            pred(i)=(y_pre-dlin(nft+1))/clin(nft+1)  ! Unscaled prediction      
            
            sum_pre = sum_pre + pred(i)              ! The sum of predicted values (unscaled)
            f_quad = f_quad + (a(i,noutcom)-pred(i))**2  
            f_abs = f_abs + ABS(a(i,noutcom)-pred(i)) !
            
        END DO loop3
        
        e0_pre1 = sum_pre/REAL(ntrain,prec)          ! The mean of predicted values

        rsumn1 = zero
        rsumo1 = zero
          
        loop33: DO i=1,ntrain
                  
            ! Predicted values for data points are in pred(i)
            rsumo1 = rsumo1 + (a(i,noutcom)-e0_obs1)*(pred(i)-e0_pre1)    ! y_pre=pred(i)
            rsumn1 = rsumn1 + (pred(i)-e0_pre1)**2
            
        END DO loop33        
              
        rmse1 = SQRT(f_quad/REAL(ntrain,prec))      ! RMSE for training set
        mae1 = f_abs/REAL(ntrain,prec)              ! MAE for training set
        ce1 = one-f_quad/fe1                        ! CE for training set
        r1 = rsumo1/(SQRT(rsumn1*fe1))              ! r for training set
                              
        sum_pre = zero
        f_quad = zero
        f_abs = zero
        e0_pre1 = zero
        
        !------------------------------
        !            TEST SET
        !------------------------------              
        loop3test: DO i1=1,ntest
            i = ntrain+i1                           ! The index of the test set data point                  
                   
            ! Scaled predicted values for data point
            y_pre = x(1)                            ! w_1BP is initialized as the value of y_pre
            DO j = 1, nH                            ! Each hidden node is looked through
                i_w1jP = 1 + j*(nft+2)              ! Index for w_1jP
                i_w0Bj = 1 + j*(nft+2) - 1          ! Index for w_0Bj
                s_ij = x(i_w0Bj)                    ! w_0Bj
                i_w0kj = 1 + (j-1)*(nft+2)                     
                DO k = 1, nft                       ! Inputs of data point i are looked through
                    i_w0kj =  i_w0kj + 1            ! Index for w_0kj
                    s_ij = s_ij + x(i_w0kj)*mX(k,i) ! Update of s_ij
                END DO
                       
                IF (s_ij >= 0.0_prec) THEN 
                    y_pre = y_pre + x(i_w1jP)*s_ij
                END IF
            END DO                  
            pred(i)=(y_pre-dlin(nft+1))/clin(nft+1) ! Unscaled prediction      
            
            sum_pre = sum_pre + pred(i)             ! The sum of predicted values (unscaled)
            f_quad = f_quad + (a(i,noutcom)-pred(i))**2  
            f_abs = f_abs + ABS(a(i,noutcom)-pred(i)) !
            
        END DO loop3test
        
        e0_pre2 = sum_pre/REAL(ntest,prec)          ! The mean of predicted values in test set

        rsumn2 = zero
        rsumo2 = zero
               
        loop33test: DO i1=1,ntest
            i = ntrain+i1
            
            ! Predicted values for data points are in pred
            
            rsumo2 = rsumo2 + (a(i,noutcom)-e0_obs2)*(pred(i)-e0_pre2)    
            rsumn2 = rsumn2 + (pred(i)-e0_pre2)**2
            
        END DO loop33test       
              
        rmse2 = SQRT(f_quad/REAL(ntest,prec))      ! RMSE for test set
        mae2 = f_abs/REAL(ntest,prec)              ! MAE for test set
        ce2 = one-f_quad/fe2                       ! CE for test set
        r2 = rsumo2/(SQRT(rsumn2*fe2))             ! r for test set
                                  
               
    END SUBROUTINE sccheckfinal           

    

END PROGRAM lmbnnr
