SUBROUTINE bouinpt (fl3, ig, iu02)
! ----------------------------------------------------------------------
!**** *BOUINPT* - BOUNDARY VALUE INPUT INTO A BLOCK.
!     H. GUNTHER    GKSS/ECMWF         JANUARY 1991
!*    PURPOSE.
!     --------
!       INPUT AND SPACE INTERPOLATION OF BOUNDARY SPECTRA.
!**   INTERFACE.
!     ----------
!       *CALL* *BOUINPT (FL3, IG, IU02)*
!          *FL3*     REAL         BLOCK OF SPECTRA.
!          *IG*      INTEGER      BLOCK NUMBER.
!          *IU02*    INTEGER      UNIT FOR INPUT OF BOUNDARY VALUES.
!     EXTERNALS.
!     ----------
!       *ABORT*     - TERMINATES PROCESSING.
!       *GSFILE*    - GETS OR SAVES A FILE.
!       *INTSPEC*   - INTERPOLATE A SPECTRUM.
!     METHOD.
!     -------
!       IN THE FIRST CALL OF THE SUB. THE FILE HEADER IS READ
!       AND THE CONSISTENCY IS CHECKED. THE SUB. READS A COMPLETE
!       SET OF BOUNDARY VALUES EACH PROPAGATION TIMESTEP WHEN
!       IT IS CALLED FOR THE FIRST BLOCK. THE SPECTRA REQUIRED FOR
!       THE ACTUAL BLOCK ARE INTERPOLATED AND STORED IN THE BLOCK.
!       INDICES AND WEIGHTS NECESSARY FOR THE INTERPOLATION AND
!       STORAGE ARE PRECOMPUTED IN PROG. PREPROC.
!     REFERENCE.
!     ----------
!       NONE.
! ----------------------------------------------------------------------
use params
use fbound
use fredir
use stat
use testo
implicit none

REAL   , INTENT(OUT):: fl3(0:niblo,nang,nfre)
INTEGER, INTENT(IN) :: ig, iu02

REAL   ,SAVE:: F1(NANG,NFRE,0:NBINP),FMEAN1(0:NBINP),EMEAN1(0:NBINP),THQ1(0:NBINP)
REAL        :: FL(NANG,NFRE)
INTEGER,SAVE:: NBOINP
!NIKOS SAVE F1, FMEAN1, EMEAN1, THQ1, NBOINP  
!*     VARIABLE.   TYPE.     PURPOSE.
!      ---------   -------   --------
!      *F1*        REAL      SPECTRA FROM COARSE GRID.
!      *FMEAN1*    REAL      MEAN FREQUENCIES FROM COARSE GRID.
!      *EMEAN1*    REAL      TOTAL ENERGIES FROM COARSE GRID.
!      *THQ1*      REAL      MEAN DIRECTIONS FROM COARSE GRID (RAD).
!      *NBOINP*    REAL      NUMBER OF INPUT SPECTRA.
!      *FL*        REAL      INTERPOLATED SPECTRUM.
CHARACTER (LEN=12) :: IDTLAST, IDATE1
INTEGER :: IJAF
!*     VARIABLE.   TYPE.     PURPOSE.
!      ---------   -------   --------
!      *IJFA*      REAL      NUMBER OF FIRST INPUT POINT IN BLOCK.
!      *IDTLAST*   CHAR*12      DATE OF LAST FETCH FILE.
INTEGER :: M, K, IJ, IGF, IJF, IBCL, IBCR, KL, ML, IDELINP
REAL    :: XANG, XFRE, TH0, FR1, CO, XNBO, XDELIN, DUM1, DUM2, DUM3, DUM4, DEL12
REAL    :: DEL1L, FMEAN, EMEAN, THQ
! ----------------------------------------------------------------------
DATA IJAF, IDTLAST / 0, '000000000000' /
!*    1. INITIALIZATION.
!        ---------------
! 1000 CONTINUE  
!*    1.1 FIRST CALL OF SUB?
!         ------------------
IF (IDTLAST.EQ.'000000000000') THEN  
!*    1.1.1 INITIALISE FOR LANDPOINTS.
!           --------------------------
   DO M = 1, NFRE  
      DO K = 1, NANG  
         F1 (K, M, 0) = 0.  
      END DO  
   END DO  
   FMEAN1 (0) = 0.  
   EMEAN1 (0) = 0.  
   THQ1 (0) = 0.  
ENDIF  
!
!*    1.2 HAS A NEW BOUNDARY VALUE INPUT FILE TO BE FETCH?
!         ------------------------------------------------
IF (IDTLAST.LT.IDTRES) THEN  
!*    1.2.1 FETCH INPUT FILE.
!           -----------------
   IDTLAST = IDTRES  
   CALL GSFILE (IU06, IU02, 1, IDTRES, 'FBI', 'G')  
!*    1.2.2 READ BOUNDARY FILE HEADER.
!           --------------------------
   READ (IU02, ERR = 5000, END = 5000) XANG, XFRE, TH0, FR1, CO, XNBO, XDELIN
   KL = NINT (XANG)  
   ML = NINT (XFRE)  
   NBOINP = NINT (XNBO)  
   IDELINP = NINT (XDELIN)  
   IF (ITEST.GT.3) THEN  
      WRITE (IU06, * ) ' '  
      WRITE (IU06, * ) ' BOUNDARY VALUE INPUT FILE HEADER IS:'  
      WRITE (IU06, * ) ' NO. OF DIRECTIONS IS    KL     = ', KL  
      WRITE (IU06, * ) ' NO. OF FREQUENCIES IS   ML     = ', ML  
      WRITE (IU06, * ) ' FIRST DIRECTION IS      TH0    = ', TH0  
      WRITE (IU06, * ) ' FIRST FREQUENCY IS      FR1    = ', FR1  
      WRITE (IU06, * ) ' FREQUENCY RATIO IS      CO     = ', CO  
      WRITE (IU06, * ) ' NO. OF BOUNDRAY POINTS  NBOINP = ', NBOINP  
      WRITE (IU06, * ) ' TIME STEP OF DATA IS    IDELINP= ', IDELINP  
   ENDIF  
!*    1.2.3 CHECK CONSISTENCY.
!           ------------------
   IF (KL.NE.NANG.OR.ML.NE.NFRE.OR.NBOINP.GT.NBINP.OR.FR1.NE.FR ( &
    1) .OR.TH0.NE.TH (1) .OR.IDELINP.NE.IDELPRO) THEN
      WRITE (IU06, * ) '****************************************'  
      WRITE (IU06, * ) '*                                      *'  
      WRITE (IU06, * ) '*    FATAL ERROR SUB. BOUINP           *'  
      WRITE (IU06, * ) '*    =======================           *'  
      WRITE (IU06, * ) '* VALUES IN BOUNDARY FILE HEADER ARE   *'  
      WRITE (IU06, * ) '* INCONSISTENT WITH MODEL SET-UP.      *'  
      WRITE (IU06, * ) '* MODEL VALUES ARE:                    *'  
      WRITE (IU06, * ) '* NO. OF DIRECTIONS     NANG   = ', NANG  
      WRITE (IU06, * ) '* NO. OF FREQUENCIES    NFRE   = ', NFRE  
      WRITE (IU06, * ) '* FIRST DIRECTION       TH0    = ', TH0  
      WRITE (IU06, * ) '* FIRST FREQUENCY       FR(1)  = ', FR (1)  
      WRITE (IU06, * ) '* DIMENSION             NBINP  = ', NBINP  
      WRITE (IU06, * ) '* PROPAGATION TIMESTEP  IDELPRO= ', IDELPRO  
      WRITE (IU06, * ) '*                                      *'  
      WRITE (IU06, * ) '* PROGRAM ABORTS.   PROGRAM ABORTS.    *'  
      WRITE (IU06, * ) '*                                      *'  
      WRITE (IU06, * ) '****************************************'  
      CALL ABORT  
   ENDIF  
ENDIF  
! ----------------------------------------------------------------------
!*    2. CALL OF SUB FOR FIRST BLOCK?
!        ----------------------------
2000 CONTINUE  
IF (IG.EQ.1) THEN  
   IJAF = 1  
!*    2.1 READ BOUNDARY SPECTRA.
!         ----------------------
!
   2100    CONTINUE  
   DO IJ = 1, NBOINP  
      READ (IU02, ERR = 5001, END = 5001) DUM1, DUM2, IDATE1, &
       EMEAN1 (IJ), THQ1 (IJ), FMEAN1 (IJ), DUM3, DUM4
      READ (IU02, ERR = 5002, END = 5002) ( (F1 (K, M, IJ), &
       K = 1, NANG), M = 1, NFRE)
   END DO  
   IF (ITEST.GT.3) THEN  
      WRITE (IU06, * ) ' '  
      WRITE (IU06, * ) ' BOUNDARY VALUES READ IDATE1 = ', IDATE1  
   ENDIF  
!*    2.2 CHECK DATES.
!         ------------
   IF (IDATE1.LT.IDTPRO) THEN  
      WRITE (IU06, * ) '****************************************'  
      WRITE (IU06,  * ) '*                                      *'  
      WRITE (IU06,  * ) '*    WARNING ERROR SUB. BOUINP         *'  
      WRITE (IU06,  * ) '*    =========================         *'  
      WRITE (IU06,  * ) '* BOUNDARY VALUE INPUT DATE IS BEFORE  *'  
      WRITE (IU06,  * ) '* MODEL DATE.                          *'  
      WRITE (IU06,  * ) '* MODEL DATE IS          IDTPRO = ', IDTPRO  
      WRITE (IU06, * ) '* BOUNDARY VALUE DATE IS IDATE1 = ', IDATE1
      WRITE (IU06,  * ) '*                                      *'  
      WRITE (IU06,  * ) '* PROGRAM WILL TRY NEXT INPUT.         *'  
      WRITE (IU06,  * ) '*                                      *'  
      WRITE (IU06, * ) '****************************************'  
      GOTO 2100  
   ELSEIF (IDATE1.GT.IDTPRO) THEN  
      WRITE (IU06, * ) '****************************************'  
      WRITE (IU06,  * ) '*                                      *'  
      WRITE (IU06,  * ) '*    FATAL ERROR SUB. BOUINP           *'  
      WRITE (IU06,  * ) '*    =======================           *'  
      WRITE (IU06,  * ) '* DATES DO NOT MATCH.                  *'  
      WRITE (IU06,  * ) '* MODEL DATE IS          IDTPRO = ', IDTPRO  
      WRITE (IU06, * ) '* BOUNDARY VALUE DATE IS IDATE1 = ', IDATE1
      WRITE (IU06,  * ) '*                                      *'  
      WRITE (IU06,  * ) '* PROGRAM ABORTS.   PROGRAM ABORTS.    *'  
      WRITE (IU06,  * ) '*                                      *'  
      WRITE (IU06, * ) '****************************************'  
      CALL ABORT  
   ENDIF  
ENDIF  
! ----------------------------------------------------------------------
!*    3. LOOP OVER BOUNDARY POINTS.
!        --------------------------
3000 CONTINUE  
DEL12 = 1.  
DO IJ = IJAF, NBOUNF  
!*    3.1 GET INDICES.
!         ------------
   IGF = IGARF (IJ)  
   IF (IGF.EQ.IG) THEN  
      IJF = IJARF (IJ)  
      IBCL = IBFL (IJ)  
      IBCR = IBFR (IJ)  
      DEL1L = BFW (IJ)  
!*    3.2 CHECK INTERPOLATION WEIGHT.
!         ---------------------------
      IF (DEL1L.GT.0.) THEN  
!*    3.2.1. WEIGHT IS GT ZERO INTERPOLATE.
!            ------------------------------
         CALL INTSPEC (NFRE, NANG, FR, DEL12, DEL1L, F1 (1, 1, &
          IBCL), FMEAN1 (IBCL), EMEAN1 (IBCL), THQ1 (IBCL), &
          F1 (1, 1, IBCR), FMEAN1 (IBCR), EMEAN1 (IBCR), THQ1 ( &
          IBCR), FL, FMEAN, EMEAN, THQ)
         DO M = 1, NFRE  
            DO K = 1, NANG  
               FL3 (IJF, K, M) = FL (K, M)  
            END DO  
         END DO  
      ELSE  
!*    3.2.2. WEIGHT IS ZERO COPY LEFT POINT.
!            -------------------------------
         DO M = 1, NFRE  
            DO K = 1, NANG  
               FL3 (IJF, K, M) = F1 (K, M, IBCL)  
            END DO  
         END DO  
      ENDIF  
   ELSEIF (IGF.GT.IG) THEN  
      IJAF = IJ  
      GOTO 4000  
   ENDIF  
END DO  
! ----------------------------------------------------------------------
!*    4. RETURN TO CALLING PROG.
!        -----------------------
4000 CONTINUE  
RETURN  
! ----------------------------------------------------------------------
!*    5. ERROR MESSAGES.
!        ---------------
5000 CONTINUE  
WRITE (IU06, * ) '*******************************************'  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '*      FATAL ERROR SUB. BOUNINP.          *'  
WRITE (IU06, * ) '*      =========================          *'  
WRITE (IU06, * ) '* END OF FILE OR READ ERROR.              *'  
WRITE (IU06, * ) '* PROGRAM TRIES TO READ                   *'  
WRITE (IU06, * ) '* HEADER OF BOUNDARY VALUES               *'  
WRITE (IU06, * ) '* UNIT IS IU02 = ', IU02  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '* PROGRAM ABORTS.   PROGRAM ABORTS.       *'  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '*******************************************'  
CALL ABORT  
5001 CONTINUE  
WRITE (IU06, * ) '*******************************************'  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '*      FATAL ERROR SUB. BOUNINP.          *'  
WRITE (IU06, * ) '*      =========================          *'  
WRITE (IU06, * ) '* END OF FILE OR READ ERROR.              *'  
WRITE (IU06, * ) '* PROGRAM TRIES TO READ                   *'  
WRITE (IU06, * ) '* A SPECTRUM HEADER                       *'  
WRITE (IU06, * ) '* SPECTRA COUNTER IS IJ = ', IJ  
WRITE (IU06, * ) '* UNIT IS          IU02 = ', IU02  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '* PROGRAM ABORTS.   PROGRAM ABORTS.       *'  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '*******************************************'  
CALL ABORT  
5002 CONTINUE  
WRITE (IU06, * ) '*******************************************'  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '*      FATAL ERROR SUB. BOUNINP.          *'  
WRITE (IU06, * ) '*      =========================          *'  
WRITE (IU06, * ) '* END OF FILE OR READ ERROR.              *'  
WRITE (IU06, * ) '* PROGRAM TRIES TO READ A SPECTRUM        *'  
WRITE (IU06, * ) '* DATE IS        IDATE1 = ', IDATE1  
WRITE (IU06, * ) '* SPECTRA COUNTER IS IJ = ', IJ  
WRITE (IU06, * ) '* UNIT IS          IU02 = ', IU02  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '* PROGRAM ABORTS.   PROGRAM ABORTS.       *'  
WRITE (IU06, * ) '*                                         *'  
WRITE (IU06, * ) '*******************************************'  

CALL ABORT  
END SUBROUTINE bouinpt
