SUBROUTINE prspps (iunit, idate, xlong, xlat, name, wahtws, wadiws, wamfws,&
                   wahtsw, wadisw, wamfsw, fr, theta, spec, idd, idf)
! -----------------------------------------------------------------
!**** *PRSPPS* -  PRINTS A SPECTRUM, AND WAVE HEIGHT, WAVE DIRECTION,
!****             WAVE MEAN FREQUENCY OF WIND WAVES AND SWELL.
!         H. GUNTHER       ECMWF     OCTOBER  1990
!*    PURPOSE.
!     --------
!        PRINT A WAVE MODEL SWELL SPECTRUM.
!**   INTERFACE.
!     ----------
!       *CALL* *PRSPPS (IUNIT, IDATE, XLONG, XLAT, NAME,
!                       WAHTWS, WADIWS, WAMFWS, WAHTSW, WADISW, WAMFSW,
!                       FR, THETA, SPEC, IDD, IDF, NANG, NFRE)*
!         *IUNIT*   INTEGER    OUTPUT UNIT.
!         *IDATE*   CHAR*12    DATE OF SPECTRUM (YYMMDDHHMM).
!         *XLONG*   REAL       LONGITUDE OF SPECTRUM (DEGREE).
!         *XLAT*    REAL       LATITUDE OF SPECTRUM (DEGREE).
!         *NAME*    CHARACTER  SIDE NAME.
!         *WAHTWS*  REAL       WINDSEA WAVE HEIGHT (METRES).
!         *WADIWS*  REAL       WINDSEA MEAN WAVE DIRECTION (DEGREE).
!         *WAMFWS*  REAL       WINDSEA MEAN WAVE FREQUENCY (HERTZ).
!         *WAHTSW*  REAL       SWELL WAVE HEIGHT (METRES).
!         *WADISW*  REAL       SWELL MEAN WAVE DIRECTION (DEGREE).
!         *WAMFSW*  REAL       SWELL MEAN WAVE FREQUENCY (HERTZ).
!         *FR*      REAL       FREQUENCY ARRAY IN HERTZ.
!         *THETA*   REAL       DIRECTION ARRAY IN RAD.
!         *SPEC*    REAL       SPECTRUM.
!         *IDD*     INTEGER    DIMENSION OF DIRECTION ARRAYS.
!         *IDF*     INTEGER    DIMENSION OF FREQUENCY ARRAYS.
!         *NANG*    INTEGER    NUMBER OF DIRECTIONS.
!         *NFRE*    INTEGER    NUMBER OF FREQUENCIES.
!     METHOD.
!     -------
!       NONE.
!     EXTERNALS.
!     ----------
!       NONE.
!     REFERENCE.
!     ----------
!       NONE.
! ------------------------------------------------------------------
use params
implicit none

INTEGER  , INTENT(IN):: iunit, idd, idf
CHARACTER, INTENT(IN):: idate * 12, NAME * 20
REAL     , INTENT(IN):: xlong, xlat, wahtws, wadiws, wamfws, wahtsw, wadisw, wamfsw
REAL     , INTENT(IN):: fr(idf), theta(idd), spec(idd,idf)
INCLUDE'globals.h'
REAL      :: ANG(NANG), ODSPEC(NFRE)
INTEGER,PARAMETER :: IPDIR = 12
CHARACTER :: FORM1 * 50, FORM2 * 50, FORM3 * 50
!       *IPDIR*   INTEGER   NUMBER OF DIRECTIONS PRINTED PER LINE.
!       *ANG*     REAL      DIRECTIONS IN DEGREE.
!       *ODSPEC*  REAL      1-D SPECTRUM.  (M*M/HERTZ)
!       *FORM *   CHAR      VARIABLE FORMATS.
INTEGER   :: K, M, IP, IPE, LEN
REAL      :: DELTH
! ------------------------------------------------------------------
!*    1. INITIALISE DIRECTIONS.
!        ----------------------
DELTH = ZPI / REAL (NANG)  
DO K = 1, NANG  
   ANG (K) = THETA (K) * DEG  
END DO  
!*    2. COMPUTE 1-D SPECTRUM.
!        ---------------------
DO M = 1, NFRE  
   ODSPEC (M) = 0.0  
   DO K = 1, NANG  
      ODSPEC (M) = ODSPEC (M) + SPEC (K, M)  
   END DO  
   ODSPEC (M) = ODSPEC (M) * DELTH  
END DO  
!*    3. PRINT SPECTRUM.
!        ---------------
WRITE (IUNIT, 4100) IDATE, NAME, XLONG, XLAT  
 4100 FORMAT(1H1,2X,'SEA AND SWELL INFORMATION. DATE: ',A10, &
&       ' SIDE: ',A20,3X,'LONG.: ',F7.2,' LAT.: ',F6.2)
WRITE (IUNIT, 4200) WAHTWS, WADIWS, WAMFWS, WAHTSW, WADISW, &
 WAMFSW
 4200 FORMAT(1X,'SEA: HS = ',F6.2,'  THETA = ',F6.0,'  FMEAN = ',F6.4, &
&     '   SWELL: HS = ',F6.2,'  THETA = ',F6.0,'  FMEAN = ',F6.4/)
IPE = 0  
IF (NANG.GT.IPDIR) THEN  
FORM1 = '(1X,''DIR (DEG)'',T11,12F8.1,''  DIR (DEG)'')'  
   WRITE (FORM1 (21:22) , '(I2)') IPDIR  
   FORM2 = '(1X,F7.4,2X,12F8.3,F9.4)'  
   WRITE (FORM2 (13:14) , '(I2)') IPDIR  
FORM3 = '(1X,''FREQ (HZ)'',T11, 96X,''  FREQ (HZ)'')'  
   WRITE (FORM3 (21:23) , '(I3)') IPDIR * 8  
   DO IP = 1, NANG - IPDIR, IPDIR  
      IPE = IP + IPDIR - 1  
      WRITE (IUNIT, FORM1) (ANG (K), K = IP, IPE)  
      WRITE (IUNIT, FORM3)  
      WRITE (IUNIT, FORM2) (FR (M), (SPEC (K, M), K = IP, IPE), &
       FR (M), M = 1, NFRE)
      WRITE (IUNIT, FORM1) (ANG (K), K = IP, IPE)  
      WRITE (IUNIT, '(1X)')  
   END DO  
ENDIF  
IP = IPE+1  
IPE = NANG  
LEN = IPE-IP + 1  
FORM1 = '(1X,''DIR (DEG)'',T11,12F8.1,''  DIR (DEG)'')'  
WRITE (FORM1 (21:22) , '(I2)') LEN  
FORM2 = '(1X,F7.4,2X,12F8.3,F9.4,F10.3)'  
WRITE (FORM2 (13:14) , '(I2)') LEN  
FORM3 = '(1X,''FREQ (HZ)'',T11, 96X,''  FREQ (HZ) 1-DSPEC'')'  
WRITE (FORM3 (21:23) , '(I3)') LEN * 8  
WRITE (IUNIT, FORM1) (ANG (K), K = IP, IPE)  
WRITE (IUNIT, FORM3)  
WRITE (IUNIT, FORM2) (FR (M), (SPEC (K, M), K = IP, IPE), FR (M), &
 ODSPEC (M), M = 1, NFRE)
WRITE (IUNIT, FORM1) (ANG (K), K = IP, IPE)  

RETURN  
END SUBROUTINE prspps
