c  UNIV. OF ATHENS - OCEAN GROUP - G.KORRES 07/03/2001
C***********************************************************************
      SUBROUTINE OP_FILES (IU05,IU06,IU07)
C ----------------------------------------------------------------------
C
C**** TAKE NAMES AND OPEN OF INPUT & OUTPUT FILES
C
C
C     -------
C
C
C       *IU05*   - USER INPUT UNIT.
C       *IU06*   - PRINTER OUTPUT.
C       *IU07*   - LOGICAL UNIT FOR INPUT OF GRID ORGANISATION
C                  AND COMPUTED CONSTANTS OUTPUTED BY PREPROC
C                  SEE SUB READPRE   (/coarse/gridcatu)
C
      CHARACTER LINE*80
      CHARACTER USERINP*80
      CHARACTER GRIDORG*80
c     
      character indirname*100
      common /indir/ indirname
C
C ----------------------------------------------------------------------
C
      WRITE (IU06,'(''***   PROGRAM PRESET   ***'')')
C     ------------------------------------------------
C
C
      WRITE (IU06,'(/,''OLD USER INPUT FILE NAME ?:'')')
C
C*    1 READ INPUT AND PRINT.
C
 1000 CONTINUE
      READ (*,'(A80)') LINE
C      write(6,*) 'lll', line
      IF (LINE(1:1).EQ.'C') GOTO 1000
      READ  (LINE,'(A80)') USERINP
      WRITE (IU06,'(''FILE NAME:  '',A)') USERINP
C
C*    1.1 OPEN USER INPUT FILE
C
      OPEN(IU05,FILE=USERINP,STATUS='OLD',FORM='FORMATTED'
     +   ,IOSTAT=IERRCODE)
      IF(IERRCODE.GT.0) THEN
	 WRITE (IU06,*) ' *********************************************'
	 WRITE (IU06,*) ' *                                           *'
	 WRITE (IU06,*) ' *      FATAL  ERROR IN SUB. OP_FILES        *'
	 WRITE (IU06,*) ' *      ===========================          *'
	 WRITE (IU06,*) ' *                                           *'
	 WRITE (IU06,*) ' * CAN NOT OPEN:  ', USERINP
	 WRITE (IU06,*) ' * PROGRAM WILL BE ABORTED                   *'
	 WRITE (IU06,*) ' *********************************************'
	 CALL ABORT
      ENDIF
C
C ----------------------------------------------------------------------
C
C
      WRITE (IU06,'(/,''GRID ORG AND COMPUTED CONSTANTS FILE NAME ?:''
     +     )')
C
C*    2 READ INPUT AND PRINT.
C
 2000 CONTINUE
      READ (*,'(A80)') LINE
      IF (LINE(1:1).EQ.'C') GOTO 2000
      READ  (LINE,'(A80)') GRIDORG
      WRITE (IU06,'(''FILE NAME:  '',A)') GRIDORG
C
C*    2.1 OPEN GRID ORGANISATION AND COMPUTED CONSTANTS FILE
C
      OPEN(IU07,FILE=GRIDORG,STATUS='OLD',
     +     FORM='UNFORMATTED',IOSTAT=IERRCODE)
      IF(IERRCODE.GT.0) THEN
	 WRITE (IU06,*) ' *********************************************'
	 WRITE (IU06,*) ' *                                           *'
	 WRITE (IU06,*) ' *      FATAL  ERROR IN SUB. OP_FILES        *'
	 WRITE (IU06,*) ' *      ===========================          *'
	 WRITE (IU06,*) ' *                                           *'
	 WRITE (IU06,*) ' * CAN NOT OPEN:  ', GRIDORG
	 WRITE (IU06,*) ' * PROGRAM WILL BE ABORTED                   *'
	 WRITE (IU06,*) ' *********************************************'
	 CALL ABORT
      ENDIF
C
C ----------------------------------------------------------------------
C

C Eldad 06/01/97
3000  CONTINUE
      READ (*,'(A80)') LINE
      IF (LINE(1:1).EQ.'C') GOTO 3000
      READ  (LINE,'(A80)') INDIRNAME
      WRITE (IU06,'(''Take Wind files from directory:  '',A)') INDIRNAME
C


      RETURN
      END
C***********************************************************************
      SUBROUTINE AIRSEA (U10, TAUW, US, Z0, IJS, IJL)

C ----------------------------------------------------------------------
C
C**** *AIRSEA* - DETERMINE TOTAL STRESS IN SURFACE LAYER.
C
C     P.A.E.M. JANSSEN    KNMI      AUGUST    1990
C
C*    PURPOSE.
C     --------
C
C       COMPUTE TOTAL STRESS.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *AIRSEA (U10, TAUW, US, Z0, IJS, IJL)*
C          *U10*  - INPUT BLOCK OF WINDSPEEDS U10.
C          *TAUW* - INPUT BLOCK OF WAVE STRESSES.
C          *US*   - OUTPUT BLOCK OF SURFACE STRESSES.
C          *ZO*   - OUTPUT BLOCK OF ROUGHNESS LENGTH.
C          *IJS*  - INDEX OF FIRST GRIDPOINT.
C          *IJL*  - INDEX OF LAST GRIDPOINT.
C
C     METHOD.
C     -------
C
C       USE TABLE TAUT(TAUW,U) AND LINEAR INTERPOLATION.
C
C     EXTERNALS.
C     ----------
C
C       NONE.
C
C     REFERENCE.
C     ---------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *COMMON* *COUPL* - PARAMETERS FOR COUPLING.
C
      COMMON /COUPL/ BETAMAX, ZALP, ALPHA, XKAPPA, XNLEV
C
C*    *COMMON* *TABLE* - TABLE FOR TOTAL STRESS AND HIGH FREQ STRESS.
C
      PARAMETER (ITAUMAX=100, JUMAX=100, IUSTAR=100, IALPHA=100)
C
      COMMON /TABLE/ TAUT(0:ITAUMAX,0:JUMAX), DELTAUW, DELU,
     1               TAUHFT(0:IUSTAR,0:IALPHA), DELUST, DELALP
C
C ----------------------------------------------------------------------
C
      DIMENSION U10(NIBLO), TAUW(NIBLO), US(NIBLO), Z0(NIBLO)
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER* OF GLOBAL CONSTANTS.
C
      PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000.,
     1           ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI,
     2           R = CIRC/ZPI)
C
C ----------------------------------------------------------------------
C
C*    1. DETERMINE TOTAL STRESS FROM TABLE.
C        ----------------------------------
C
 1000 CONTINUE
      DO 1001 IJ=IJS,IJL
         XI      = TAUW(IJ)/DELTAUW
         I       = MIN ( ITAUMAX-1, INT(XI) )
         DELI1   = XI - FLOAT(I)
         DELI2   = 1. - DELI1
         XJ      = U10(IJ)/DELU
         J       = MIN ( JUMAX-1, INT(XJ) )
         DELJ1   = XJ - FLOAT(J)
         DELJ2   = 1. - DELJ1
         DELTOLD = (TAUT(I,J  )*DELI2 + TAUT(I+1,J  )*DELI1)*DELJ2
     1           + (TAUT(I,J+1)*DELI2 + TAUT(I+1,J+1)*DELI1)*DELJ1
         US(IJ) = SQRT(DELTOLD)
 1001 CONTINUE
C
C*    2. DETERMINE ROUGHNESS LENGTH.
C        ---------------------------
C
 2000 CONTINUE
      DO 2001 IJ=IJS,IJL
         UST     = MAX (US(IJ), 0.000001)
         X       = MIN (TAUW(IJ)/UST**2, 0.999)
         Z0(IJ)  = ALPHA*UST**2 / (G*SQRT(1.-X))
 2001 CONTINUE
C
      RETURN
      END
      SUBROUTINE CREWFN (IUNIT, WDATE)

C ----------------------------------------------------------------------
C
C**** *CREWFN* - CREATES A WIND FILE NAME.
C
C     H. GUNTHER       ECMWF      29/5/90.
C
C*    PURPOSE.
C     --------
C
C       TO CREATE A FILE NAME AND ASSIGN IT TO A UNIT.
C
C**   INTERFACE.
C     ----------
C
C        *CALL* CREWFN (IUNIT, WDATE)
C
C         *IUNIT*  - LOCIAL UNIT TO WHICH A FILE NAME HAS
C                    TO BE ASSIGNED.
C         *WDATE*  - DATE TIME GROUP FOR FILE NAME.
C
C     METHOD.
C     -------
C
C       FROM THE DATE TIME GROUP YYMMDDHHMM THE FILE NAME
C       WDDHHMM IS GENERATED AND ASSIGNED TO IUNIT.
C
C     EXTERNALS.
C     ---------
C
C       NONE.
C
C     REFERENCE.
C     ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
      CHARACTER WDATE*12, WFN*9

      WFN(1:1) = 'W'
      WFN(2:7) = WDATE(5:12)
      OPEN (UNIT=IUNIT, FILE=WFN, FORM='UNFORMATTED', STATUS='UNKNOWN')

      RETURN
      END
      SUBROUTINE GETWND (US, DS, IDTWIS, UWND, VWND, NC, NR)

C ----------------------------------------------------------------------
C
C**** *GETWND* - ROUTINE TO READ AND PROCESS ONE WINDFIELD.
C
C*    PURPOSE.
C     --------
C
C        READ A WINDFIELD FROM THE WINDFILE (SEARCH FOR IT)
C        AND CALCULATES THE WIND VELOCITY  AND DIRECTION
C        FOR ALL WAM BLOCKS.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *GETWND (US, DS, IDTWIS, UWND, VWND, NC, NR)*
C         *US*     - MAGNITUDE OF USTAR IN EACH POINT AND BLOCK.
C         *DS*     - DIRECTION OF USTAR IN EACH POINT AND BLOCK.
C         *IDTWIS* - DATE OF WIND FIELD TO BE LOOKED FOR.
C         *UWND*   - INPUT WIND FIELD U COMPONENT.
C         *VWND*   - INPUT WIND FIELD V COMPONENT.
C         *NC*     - DIMENSION OF WIND INPUT ARRAYS NUMBER OF COLUMNES.
C         *NR*     - DIMENSION OF WIND INPUT ARRAYS NUMBER OF ROWS.
C
C     METHOD.
C     -------
C
C       NONE.
C
C     EXTERNALS.
C     ----------
C
C       *ABORT*     - TERMINATES PROCESSING.
C       *READWND*   - READING WINDS.
C       *WAMWND*    - CALCULATE WIND IN WAM POINTS.
C
C     REFERENCE.
C     ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/ IU06, ITEST, ITESTB
C
C ----------------------------------------------------------------------
C
      DIMENSION US(NIBLO,NBLO), DS(NIBLO,NBLO), UWND(NC,NR), VWND(NC,NR)
C
      CHARACTER*12 IDTWIS, IDTWIR
C
      SAVE IDTWIR
C
C ----------------------------------------------------------------------
C
C*    1. WIND DATA ARE READ
C        ------------------
C
 1000 CONTINUE
      CALL READWND (IDTWIR, UWND, VWND, NC, NR)
C
C*    2. CHECK WIND FIELD DATE
C        ----------------------
C
      IF (IDTWIR.LT.IDTWIS) THEN
C
C     2.1 DATE OF INPUT FIELD IS BEFORE REQUESTED DATE
C         TRY AGAIN
C         --------------------------------------------
         GOTO 1000
      ELSE IF (IDTWIR.GT.IDTWIS) THEN
C
C     2.2 DATE OF INPUT FIELD IS LATER THAN REQUESTED DATE
C         ------------------------------------------------
         WRITE (IU06,*) ' ******************************************'
         WRITE (IU06,*) ' *                                        *'
         WRITE (IU06,*) ' *      FATAL ERROR SUB. GETWND           *'
         WRITE (IU06,*) ' *      =======================           *'
         WRITE (IU06,*) ' * WIND DATE READ IS LATER THAN EXPECTED  *'
         WRITE (IU06,*) ' * DATE READ IS     IDTWIR = ', IDTWIR
         WRITE (IU06,*) ' * DATE EXPECTED IS IDTWIS = ', IDTWIS
         WRITE (IU06,*) ' *                                        *'
         WRITE (IU06,*) ' *   PROGRAM ABORTS  PROGRAM ABORTS       *'
         WRITE (IU06,*) ' *                                        *'
         WRITE (IU06,*) ' ******************************************'
         CALL ABORT
      ENDIF
C
C ----------------------------------------------------------------------
C
C*    3. INTERPOLATE AND BLOCK WINDFIELD
C        -------------------------------
C
      CALL WAMWND (US, DS, UWND, VWND, NC, NR)
      print*,'After WAMWND'

      RETURN
      END
      FUNCTION IECF_len(y_char)
c
c  Calculate the 'length' of a character string.
c
c  The 'length' is the character-position of the last character in the
c  string which is neither 'BLANK', nor 'NULL'.
c
      CHARACTER*(*) y_char
      CHARACTER*1   null
c
      null = char(0)
      lgth = len(y_char)
c
      DO 10 i = lgth , 1 , -1
      IF ((y_char(i:i) .NE. ' ') .AND. (y_char(i:i) .NE. null)) goto 20
   10 CONTINUE
      i = 0
c
   20 CONTINUE
      IECF_len = i
c
      RETURN
      END
      SUBROUTINE INCDATE(DATE,ISHIFT)

C ----------------------------------------------------------------------
C
C**** *INCDATE* - TO UPDATE DATE TIME GROUP
C
C     L. BERTOTTI, P.JANSSEN.
C
C     H. GUNTHER   ECMWF  NOVEMBER 1989    NEGATIVE INCREMENTS.
C
C*    PURPOSE.
C     --------
C
C       UPDATING DATE TIME GROUP.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *INCDATE (IDATE,ISHIFT)*
C         *IDATE*  INTEGER - DATE TIME GROUP (YYMMDDHHMM)
C         *ISHIFT* INTEGER - TIME INCREMENT IN SECONDS, WHERE
C                            ABS (ISHIFT) HAS TO BE LESS THEN 1 YEAR
C
C     METHOD.
C     -------
C
C       NONE.
C
C     EXTERNALS.
C     ----------
C
C       NONE.
C
C     REFERENCES.
C     -----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
      CHARACTER*12 DATE
      DIMENSION MON(12)
C
      DATA MON /31,28,31,30,31,30,31,31,30,31,30,31/
C
C ----------------------------------------------------------------------
C
C*    1.0 SPLITE DATE TIME GROUP INTO MINUTE, HOUR, DAY, MONTH, YEAR.
C         -----------------------------------------------------------
C
      READ(DATE,5) IYEAR,MONTH,IDAY,IHOUR,MINUT,ISEC
      IF (MOD(IYEAR,4).EQ.0) THEN
               MON(2)=29
      ELSE
               MON(2)=28
      ENDIF

C
C ----------------------------------------------------------------------
C
C*    2.0 ADD SECONDS AND UPDATE DATE AND TIME.
C         -------------------------------------
      ISEC=ISEC+MOD(ISHIFT,60)
      IF (ISEC.GE.60) THEN
        MINUT = MINUT+ISEC/60
        ISEC = ISEC-(ISEC/60)*60
      ELSE IF (ISEC.LT.0) THEN
        MINUT = MINUT +(ISEC-59)/60
        ISEC = ISEC-((ISEC-59)/60)*60
      END IF     

C
 2000 CONTINUE
      MINUT=MINUT+ISHIFT/60
C
C     2.1 POSITIVE SHIFT GREATER THAN 1 MINUTE.
C
      IF (MINUT.GE.60) THEN
         IHOUR = IHOUR + MINUT/60
         MINUT = MINUT - (MINUT/60)*60
         IF (IHOUR.GE.24) THEN
            IDAY = IDAY + IHOUR/24
            IHOUR = IHOUR - (IHOUR/24)*24
            IF (IDAY.GT.MON(MONTH)) THEN
 1300          CONTINUE
               IDAY=IDAY-MON(MONTH)
               MONTH=MONTH+1
               IF(MONTH.EQ.13) THEN
                  MONTH = 1
                  IYEAR=MOD(IYEAR+1,100)
                  IF (MOD(IYEAR,4).EQ.0) THEN
                     MON(2)=29
                  ELSE
                     MON(2)=28
                  ENDIF
               END IF
               IF(IDAY.GT.MON(MONTH)) GO TO 1300
            END IF
         END IF
      ELSE IF (MINUT.LT.0) THEN
C
C     2.2 NEGATIVE SHIFT.
C
         IHOUR = IHOUR + (MINUT-59)/60
         MINUT = MINUT - ((MINUT-59)/60)*60
         IF (IHOUR.LT.0) THEN
            IDAY = IDAY + (IHOUR-23)/24
            IHOUR = IHOUR - ((IHOUR-23)/24)*24
            IF (IDAY.LT.1) THEN
 1400          CONTINUE
               MONTH=MONTH-1
               IF(MONTH.EQ.0) THEN
                  MONTH = 12
                  IYEAR=MOD(IYEAR+99,100)
                  IF (MOD(IYEAR,4).EQ.0) THEN
                     MON(2)=29
                  ELSE
                     MON(2)=28
                  ENDIF
               END IF
               IDAY=IDAY+MON(MONTH)
               IF(IDAY.LT.1) GO TO 1400
            END IF
         END IF
      END IF
C
C ----------------------------------------------------------------------
C
C*    3.0 COMPOSE NEW DATE TIME GROUP.
C         ----------------------------
C
 3000 CONTINUE
      WRITE(DATE,5) IYEAR,MONTH,IDAY,IHOUR,MINUT
C
    5 FORMAT(6I2.2)
C
      RETURN
      END
      SUBROUTINE LOCINT (IG, IJS, IJL, NC, NR, KCOL, KROW, IGPER,
     1                  DLAM, DPHI, RLONL, RLATS, U, V, US, DS)

C ----------------------------------------------------------------------
C
C**** *LOCINT* - LOCATE WAM POINT IN INPUT GRID AND INTERPOLATE.
C
C     H. GUNTHER    ECMWF/GKSS  DECEMBER 1990  MODIFIED FOR CYCLE_4.
C
C*    PURPOSE.
C     --------
C
C        *LOCINT* - LOCATE AND INTERPOLATE IN INPUT GRID.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *LOCINT (IG, IJS, IJL, NC, NR, KCOL, KROW, IGPER,
C                       DLAM, DPHI, RLONL, RLATS, U, V, US, DS)*
C         *IG*      - BLOCK NUMBER.
C         *IJS*     - FIRST POINT IN BLOCK.
C         *IJL*     - LAST POINT IN BLOCK.
C         *NC*      - DIMENSION OF INPUT ARRAY, NUMBER OF COLUMNES.
C         *NR*      - DIMENSION OF INPUT ARRAY, NUMBER OF ROWS.
C         *KCOL*    - NUMBER OF COLUMNES IN INPUT (USED).
C         *KROW*    - NUMBER OF ROWS     IN INPUT (USED).
C         *IGPER*   - INDICATOR PERIODICAL INPUT GRID OR NOT
C                     1 = PERIODICAL
C                     OTHERWISE NON-PERIODICAL
C         *DLAM*    - STEPSIZE BETWEEN LONGITUDES IN INPUT (DEG).
C         *DPHI*    - STEPSIZE BETWEEN LATITUDES  IN INPUT (DEG).
C         *RLATS*   - MOST SOUTHERN LATITUDE OF INPUT (DEG).
C         *RLONL*   - MOST WESTERN LONGITUDE OF INPUT (DEG).
C         *U(I,J)*  - "HORIZONTAL" COMPONENT (INPUT).
C         *V(I,J)*  - "VERTICAL  " COMPONENT (INPUT).
C         *US*      - SPACE INTERPOLATED "HORIZONTAL" COMPONENT.
C         *DS*      - SPACE INTERPOLATED "VERTICAL  " COMPONENT.
C
C     METHOD.
C     -------
C
C       DOUBLE LINEAR INTERPOLATION WITHIN A MESH FOR U AND V.
C
C     EXTERNALS.
C     ----------
C
C       *ABORT*     - TERMINATES PROCESSING.
C
C     REFERENCE.
C     ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
       PARAMETER (XLAND = 9999.)

C*    *COMMON* *MAP*  LON/LAT INDEX OF EACH SEA POINT.
C
      COMMON /MAP/ IXLG(NIBLO,NBLO), KXLT(NIBLO,NBLO), NX, NY, IPER,
     1             AMOWEP, AMOSOP, AMOEAP, AMONOP, XDELLA, XDELLO
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/ IU06, ITEST, ITESTB
C
C ----------------------------------------------------------------------
C
      DIMENSION U(NC,NR), V(NC,NR), US(NIBLO), DS(NIBLO)
C
C ----------------------------------------------------------------------
C
C*    1. LOOP OVER POINTS IN WAMODEL BLOCKS.
C        -----------------------------------
C
 1000 CONTINUE
      DO 1001 IJ=IJS,IJL
C
C*    1.1 TRANSFORM WAM COORDINATE TO INPUT GRID.
C         ---------------------------------------
C
         XI = AMOWEP + REAL(IXLG(IJ,IG)-1)*XDELLO-RLONL
         XI = MOD(XI+720.,360.)
         XI = XI/DLAM+1.00001
         XJ = AMOSOP + REAL(KXLT(IJ,IG)-1)*XDELLA-RLATS
         XJ = XJ/DPHI+1.00001
C
C*    1.2 COMPUTE CORNER POINT INDICES OF INPUT GRID.
C         -------------------------------------------
C
         I1  = XI
         J1  = XJ
         J2  = MIN(KROW,J1+1)
         I2  = I1+1
C
C*    1.3 DISTANCES OF INTERPOLATION POINT FROM CORNER POINTS.
C         ----------------------------------------------------
C
         DI1 = XI-I1
         DI2 = 1.-DI1
         DJ1 = XJ-J1
         DJ2 = 1.-DJ1
C
C*    1.4. CORRECTIONS FOR FIRST AND LAST GRID LINES
C          PERIODIC OR UNPERIODIC GRIDS ARE CONSIDERED.
C          --------------------------------------------
C
         IF (IGPER.EQ.1) THEN
            IF (I1.EQ.KCOL) I2 = 1
            IF (I1.EQ.0   ) I1 = KCOL
         ELSE
            IF (I1.EQ.KCOL) I2 = KCOL
         ENDIF
C
C*    1.5 CHECK WHETHER POINTS ARE IN GRID.
C         ---------------------------------
C
         IF (I1.LT.1 .OR. I1.GT.KCOL .OR. J1.LT.1 .OR. J1.GT.KROW) THEN
            WRITE(IU06,*) ' *******************************************'
            WRITE(IU06,*) ' *                                         *'
            WRITE(IU06,*) ' *          FATAL ERROR IN LOCINT          *'
            WRITE(IU06,*) ' *          =====================          *'
            WRITE(IU06,*) ' * POINT IS OUTSIDE OF INPUT GRID          *'
            WRITE(IU06,*) ' * DIMENSION OF INPUT GRID IS KCOL = ', KCOL
            WRITE(IU06,*) ' *                            KROW = ', KROW
            WRITE(IU06,*) ' * POINT REQUESTED IS         XI   = ', XI
            WRITE(IU06,*) ' *                            XJ   = ', XJ
            WRITE(IU06,*) ' *                                         *'
            WRITE(IU06,*) ' *  PROGRAM ABORTS     PROGRAM ABORTS      *'
            WRITE(IU06,*) ' *                                         *'
            WRITE(IU06,*) ' *******************************************'
            CALL ABORT
         ENDIF
C
C*    1.6 LINEAR INTERPOLATION.
C         ---------------------

         FF = AMIN1(U(I1,J1),U(I2,J1),U(I1,J2),U(I2,J2))
         FFV = AMIN1(V(I1,J1),V(I2,J1),V(I1,J2),V(I2,J2))
         IF (FF.EQ.XLAND.OR.FFV.EQ.XLAND) THEN
         WRITE(IU06,*) ' *******************************************'
         WRITE(IU06,*) '  SUBROUTINE LOCINT                         '
         WRITE(IU06,*) 'CANNOT FIND VALUE FOR POINT:',I1,J1
         CALL CORRECT(U,V,I1,J1,XM_U,XM_V,NC,NR,KCOL,KROW,XLAND,LRR)
         FF = XM_U
         FFV = XM_V
         WRITE(IU06,*) 'VALUES ASSIGNED',FF,FFV
         WRITE(IU06,*) 'NUMBER OF SCANS:',LRR
         WRITE(IU06,*) ' *******************************************'
         END IF
         IF(U(I1,J1).EQ.XLAND)U(I1,J1)=FF
         IF(U(I2,J1).EQ.XLAND)U(I2,J1)=FF
         IF(U(I1,J2).EQ.XLAND)U(I1,J2)=FF
         IF(U(I2,J2).EQ.XLAND)U(I2,J2)=FF
         IF(V(I1,J1).EQ.XLAND)V(I1,J1)=FFV
         IF(V(I2,J1).EQ.XLAND)V(I2,J1)=FFV
         IF(V(I1,J2).EQ.XLAND)V(I1,J2)=FFV
         IF(V(I2,J2).EQ.XLAND)V(I2,J2)=FFV


C
         U1 = U(I1,J1)*DI2 + U(I2,J1)*DI1
         U2 = U(I1,J2)*DI2 + U(I2,J2)*DI1
         US(IJ) = U1*DJ2 + U2*DJ1
         V1 = V(I1,J1)*DI2 + V(I2,J1)*DI1
         V2 = V(I1,J2)*DI2 + V(I2,J2)*DI1
         DS(IJ) = V1*DJ2 + V2*DJ1
 1001 CONTINUE

      RETURN
      END

      SUBROUTINE CORRECT(U,V,IE,JE,XM_U,XM_V,NC,NR,IM,JM,XLAND,LRR)
      dimension U(nc,nr), V(nc,nr)

      lr = 1

50    continue

      ist = ie -lr
      iend = ie + lr
      jst = je - lr
      jend = je + lr
      if (ist.lt.1) ist = 1
      if (iend.gt.im) iend = im
      if (jst.lt.1) jst = 1
      if (jend.gt.jm) jend = jm

       cc = 0.0
       xm_u = 0.0
       xm_v = 0.0
       do 100 i = ist,iend
       do 100 j = jst,jend
       if (u(i,j).ne.xland) then
       cc = cc + 1.
       xm_u = xm_u + u(i,j)
       xm_v = xm_v + v(i,j)
       end if
100    continue

       if (cc.eq.0.) then
        lr = lr + 1
        goto 50
       end if

       xm_u = xm_u/cc
       xm_v = xm_v/cc

       lrr = lr

       return
       end

      SUBROUTINE  MSTART (IU12, IU14, IU15, IOPTI, FETCH, FRMAX)

C ----------------------------------------------------------------------
C
C**** *MSTART* - MAKES START FIELDS FOR WAMODEL.
C
C      H. GUNTHER    ECMWF    MAY 1990
C      H. GUNTHER    ECMWF    DECEMBER 90  MODIFIED FOR CYCLE_4.
C
C*    PURPOSE.
C     --------
C
C       TO GENERATE WAMODEL START FIELDS.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *MSTART (IU12, IU14, IU15, IOPTI, FETCH, FRMAX)*
C          *IU12*   INTEGER    OUTPUT UNIT BLOCKS OF SPECTRA.
C          *IU14*   INTEGER    OUTPUT UNIT SECOND LAT OF BLOCKS.
C          *IU15*   INTEGER    OUTPUT UNIT LAST WINDFIELDS.
C          *IOPTI*  INTEGER    START FIELD OPTION
C                              = 0 FROM PARAMTERS.
C                              = 1 FROM WINDS CALM ENERGY=0.
C                              = 2 FROM WINDS CALM FROM PARAMETERS.
C          *FETCH*  REAL       FETCH IN METERS.
C          *FRMAX*  REAL       MAXIMUM PEAK FREQUENCY IN HERTZ.
C
C     METHOD.
C     -------
C
C       NONE.
C
C     EXTERNALS.
C     ----------
C
C       *ABORT*     - TERMINATES PROCESSING.
C       *PEAK*      - COMPUTE PARAMETERS FROM WIND FOR A BLOCK.
C       *SPECTRA*   - COMPUTES SPECTRA OF A BLOCK.
C       *SPLITBL*   - STORING OVERLAPPING LATITUDES OF BLOCKS.
C
C    REFERENCE.
C    ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *COMMON* *COUT*  OUTPUT POINTS INDICES AND FLAGS.
C
      LOGICAL FFLAG(14), FFLAG20, FFLAG21, FFLAG25, FFLAG26,
     1        PFLAG(14), PFLAG20, PFLAG21, PFLAG25, PFLAG26
      COMMON /COUT/ NGOUT, IGAR(MOUTP), IJAR(MOUTP),
     1              NOUTT, IOUTT(MOUTT),
     2              FFLAG, FFLAG20, FFLAG21, FFLAG25, FFLAG26,
     3              PFLAG, PFLAG20, PFLAG21, PFLAG25, PFLAG26
C
C*    *COMMON* *FREDIR* - FREQUENCY AND DIRECTION GRID.
C
      COMMON /FREDIR/ FR(NFRE), DFIM(NFRE), GOM(NFRE), C(NFRE),
     1                DELTH, DELTR, TH(NANG), COSTH(NANG), SINTH(NANG)
C
C*    *COMMON* *GRIDPAR*  GENERAL GRID INFORMATION.
C
      COMMON /GRIDPAR/ DELPHI, DELLAM, SINPH(NGY), COSPH(NGY),
     1                 IGL, IJS(NBLO), IJL2(NBLO), IJLS(NBLO),
     2                 IJL(NBLO), IJLT(NBLO)
C
C*    *COMMON*  *JONS* - JONSWAP PARAMETERS.
C
      COMMON /JONS/ FP(NIBLO), ALPHJ(NIBLO), THES(NIBLO),
     1              FM, ALFA, GAMMA, SA, SB, THETAQ
C
C*    *COMMON* *SPE1* - A BLOCK OF SPECTRA.
C
      COMMON /SPE1/ FL1(0:NIBLO,NANG,NFRE)
C
C
C*    *COMMON* *STATUS* - TIME STATUS OF INTEGRATION, WIND INPUT,
C                         OUTPUT OF RESULTS, AND MODEL OPTIONS.
C
      CHARACTER*12 IDATEA, IDATEE, IDTPRO, IDTRES,
     &             IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
      COMMON /STATUS/ IDELPRO, IDELT, IDELWI, IDELWO,
     1                IREST, IDELRES, IDELINT, IDELINS,
     2                IDELSPT, IDELSPS,
     3                ICASE, ISHALLO, IREFRA,
     4                IDATEA, IDATEE, IDTPRO, IDTRES,
     5                IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/ IU06, ITEST, ITESTB
C
C
C*    *COMMON* *TEXT* - FILE NAME INFORMATION.
C
      CHARACTER USERID*3, RUNID*3, PATH*60
      COMMON /TEXT/ USERID, RUNID, PATH
C
C*    *COMMON*  *WIND* - VARIABLES USED FOR WIND COMPUTATIONS.
C
C
      CHARACTER*12 IDA, IDAWIFL, IDATEWO, IDATEFL,IDTSOU
C
      COMMON/ WIND/ U10NEW(NIBLO), U10OLD(NIBLO,NBLO),
     1              THWNEW(NIBLO), THWOLD(NIBLO,NBLO),
     2              USNEW (NIBLO), USOLD (NIBLO,NBLO),
     3              Z0NEW (NIBLO), Z0OLD (NIBLO,NBLO),
     4              TAUW(NIBLO,NBLO), IIG,
     5              IDA, IDATEWO, IDAWIFL, IDATEFL
C
      CHARACTER*100 FNAME
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER* OF GLOBAL CONSTANTS.
C
      PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000.,
     1           ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI,
     2           R = CIRC/ZPI)
C
C ----------------------------------------------------------------------
C
C*    1. DEFINE SPECTRUM FOR LAND POINTS AND WRITE OUTPUT.
C        -------------------------------------------------
C
 1000 CONTINUE
      DO 1001 M=1,NFRE
      DO 1001 K=1,NANG
         FL1(0,K,M) = 0.
 1001 CONTINUE

      WRITE (IU06,'(1X,/,1X,''  PARAMETER AT OUTPUT SIDES:'')')
      WRITE (IU06,'(1X,''  NGOU    IG    IJ     U10    UDIR'',
     1            ''      FP   ALPHA   GAMMA      SA      SB'')')
C
C
C     1.1. OPEN START FILES
C     ---------------------
C
      LIP=IECF_LEN(PATH)
      FNAME=PATH(1:LIP)//'/'//'BLSPANAL'
      ILEN=IECF_LEN(FNAME)
      OPEN (UNIT=IU12, FILE=FNAME(1:ILEN), STATUS='UNKNOWN',
     1      FORM='UNFORMATTED', ERR=4000)
      WRITE (IU06,*) ' FILE [ ', FNAME(1:ILEN),' ] OPENED',
     1               ' AND ASSIGNED TO UNIT ', IU12
      LIP=IECF_LEN(PATH)
      FNAME=PATH(1:LIP)//'/'//'SLATANAL'
      ILEN=IECF_LEN(FNAME)
      OPEN (UNIT=IU14, FILE=FNAME(1:ILEN), STATUS='UNKNOWN',
     1      FORM='UNFORMATTED', ERR=4000)
      WRITE (IU06,*) ' FILE [ ', FNAME(1:ILEN),' ] OPENED',
     1               ' AND ASSIGNED TO UNIT ', IU14
      LIP=IECF_LEN(PATH)
      FNAME=PATH(1:LIP)//'/'//'LAWIANAL'
      ILEN=IECF_LEN(FNAME)
      OPEN (UNIT=IU15, FILE=FNAME(1:ILEN), STATUS='UNKNOWN',
     1      FORM='UNFORMATTED', ERR=4000)
      WRITE (IU06,*) ' FILE [ ', FNAME(1:ILEN),' ] OPENED',
     1               ' AND ASSIGNED TO UNIT ', IU15
C ----------------------------------------------------------------------
C
C*    2. LOOP FOR BLOCKS.
C        ----------------
C
 2000 CONTINUE
      DO 2001 IG=1,IGL
C
C*    2.1 COMPUTE PEAK FREQUENCIES AND ALPHA PARAMETERS.
C         ----------------------------------------------
C
C
C*    2.1.1 INITIAL VALUES DUE TO OPTION.
C           -----------------------------
C
 2110 CONTINUE
         IF (IOPTI.EQ.1) THEN
            DO 2111 IJ = IJS(IG), IJL(IG)
               FP(IJ) = 0.
               ALPHJ(IJ) = 0.
               THES(IJ) = THWOLD(IJ,IG)
 2111       CONTINUE
         ELSE
            DO 2112 IJ = IJS(IG), IJL(IG)
               FP(IJ) = FM
               ALPHJ(IJ) = ALFA
               IF (U10OLD(IJ,IG) .GT. 0.1E-08) THEN
                  THES(IJ) = THWOLD(IJ,IG)
               ELSE
                  THES(IJ) = THES(IJ)
               ENDIF
 2112       CONTINUE
         ENDIF
C
C*    2.1.2 PEAK FREQUENCY AND ALPHA FROM FETCH LAW.
C           ----------------------------------------
C
         IF (IOPTI.NE.0) THEN
            CALL PEAK (IJS(IG), IJL(IG), IG, FETCH, FRMAX)
         ENDIF
         IF (ITEST.GT.1) THEN
            IF (IG.LE.ITESTB) WRITE (IU06,*) '    SUB. PEAK DONE'
         ENDIF
C
C*    2.1.3 PRINT PARAMETERS AT OUTPUT POINTS.
C           ----------------------------------
C
         DO 2131 NGOU = 1, NGOUT
            IF (IG.EQ.IGAR(NGOU)) THEN
               IJ = IJAR(NGOU)
               WRITE (IU06,'(1X,3I6,F8.2,F8.2,5F8.4)')  NGOU, IG, IJ,
     1            U10OLD(IJ,IG), THWOLD(IJ,IG)*DEG, FP(IJ), ALPHJ(IJ),
     2            GAMMA, SA, SB
            ENDIF
 2131    CONTINUE
C
C*    2.2 COMPUTE SPECTRA FROM PARAMETERS.
C         --------------------------------
C
         CALL SPECTRA (IJS(IG), IJL(IG), IG)
         IF (ITEST.GT.1) THEN
            IF (IG.LE.ITESTB) WRITE (IU06,*) '    SUB. SPECTRA DONE'
         ENDIF
C
C*    2.3 OUTPUT OF OVERLAPPING LATITUDES.
C         --------------------------------
C
         IF (IG.GT.1) CALL SPLITBL (FL1, IJS(IG), IJL2(IG), IU14)
         IF (ITEST.GT.1) THEN
            IF (IG.LE.ITESTB) WRITE (IU06,*) '    SUB. SPLITBL DONE'
         ENDIF
C
C*    2.4 OUTPUT OF BLOCK.
C         ----------------
C
      WRITE(IU12)(((FL1(IJ,K,M),IJ=0,NIBLO),K=1,NANG),M=1,NFRE)
C
C
C*    BRANCHING BACK TO 2. FOR NEXT BLOCK.
C
 2001 CONTINUE
C
C ----------------------------------------------------------------------
C
C*    3. OUTPUT OF WIND.
C        ---------------
C
 3000 CONTINUE
      IDTPRO  = '000000000000'
      IDATEWO = '000000000000'
      IDAWIFL = '000000000000'
      IDATEFL = '000000000000'
      IDTSOU  = '000000000000'
      WRITE(IU15) IDTPRO, IDATEWO, IDAWIFL, IDATEFL,IDTSOU
      WRITE(IU15) U10OLD
      WRITE(IU15) THWOLD
      WRITE(IU15) USOLD
      WRITE(IU15) TAUW
      WRITE(IU15) Z0OLD
      IF (ITEST.GT.1) WRITE (IU06,*) '    SUB. MSTART: WIND WRITTEN'

      CLOSE (UNIT=IU12, STATUS='KEEP')
      CLOSE (UNIT=IU14, STATUS='KEEP')
      CLOSE (UNIT=IU15, STATUS='KEEP')
      RETURN
4000  CONTINUE
      WRITE (IU06,*) ' +++++++++++++++++++++++++++++++++++'
      WRITE (IU06,*) ' +                                 +'
      WRITE (IU06,*) ' +    WARNING ERROR SUB. OPENFIL   +'
      WRITE (IU06,*) ' +    ==========================   +'
      WRITE (IU06,*) ' +                                 +'
      WRITE (IU06,*) ' + COULD NOT OPEN FILE             +'
      WRITE (IU06,*) ' + FULL PATH NAME IS : ', FNAME(1:ILEN)
      WRITE (IU06,*) ' +                                 +'
      WRITE (IU06,*) ' +++++++++++++++++++++++++++++++++++'
      CALL ABORT
      END
      SUBROUTINE NOTIM (IDTWIS, IDTWIE)

C ----------------------------------------------------------------------
C
C**** *NOTIM* - STEERING MODULE IF NO TIME INTERPOLATION WANTED.
C
C*    PURPOSE.
C     --------
C
C       NOTIM NO TIME INTERPOLATION: PROCESS WINDFIELDS.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *NOTIM (IDTWIS, IDTWIE, NC, NR)*
C          *IDTWIS* - DATE OF FIRST WIND FIELD.
C          *IDTWIE* - DATE OF LAST FIRST WIND FIELD.
C          *NC*     - FIRST DIMENSION OF INPUT WIND FIELD.
C          *NR*     - SECOND DIMENSION OF INPUT WIND FIELD.
C
C     METHOD.
C     -------
C
C       NO TIME INTERPOLATION:
C       WINDFIELDS ARE PROCESSED EVERY IDELWI SECONDS (U,V),
C       THE WINDS INTERPOLATED IN SPACE ONLY (US,DS)
C
C     EXTERNALS.
C     ----------
C
C       *ABORT*     - TERMINATES PROCESSING.
C       *AIRSEA*    - TOTAL STRESS IN SURFACE LAYER.
C       *CREWFN*    - ASSIGN A FILE NAME.
C       *GETWND*    - READ A WINDFIELD (UWND,VWND) AND COMPUTE WIND
C                     FOR ALL BLOCKS (US,DS).
C       *INCDATE*   - INCREMENT DATE.
C
C     REFERENCE.
C     ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *PARAMETER*  FOR WIND INPUT ARRAY DIMENSIONS.
C
       INCLUDE 'wind.h'
C*    *COMMON* *GRIDPAR*  GENERAL GRID INFORMATION.
C
      COMMON /GRIDPAR/ DELPHI, DELLAM, SINPH(NGY), COSPH(NGY),
     1                 IGL, IJS(NBLO), IJL2(NBLO), IJLS(NBLO),
     2                 IJL(NBLO), IJLT(NBLO)
C
C*    *COMMON* *STATUS* - TIME STATUS OF INTEGRATION, WIND INPUT,
C                         OUTPUT OF RESULTS, AND MODEL OPTIONS.
C
      CHARACTER*12 IDATEA, IDATEE, IDTPRO, IDTRES,
     &             IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
      COMMON /STATUS/ IDELPRO, IDELT, IDELWI, IDELWO,
     1                IREST, IDELRES, IDELINT, IDELINS,
     2                IDELSPT, IDELSPS,
     3                ICASE, ISHALLO, IREFRA,
     4                IDATEA, IDATEE, IDTPRO, IDTRES,
     5                IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/ IU06, ITEST, ITESTB
C
C*    *COMMON*  *UNITS* - INPUT / OUTPUT UNITS.
C
      COMMON /UNITS/ IU02, IU08, IU11, IU12, IU13, IU14, IU15, IU16,
     1               IU17, IU18, IU19, IU20, IU21, IU25, IU26, IUVELO,
     2               IUSCR(NBLO)
C
C*    *COMMON*  *WIND* - VARIABLES USED FOR WIND COMPUTATIONS.
C
C
      CHARACTER*12 IDA, IDAWIFL, IDATEWO, IDATEFL
C
      COMMON/ WIND/ U10NEW(NIBLO), U10OLD(NIBLO,NBLO),
     1              THWNEW(NIBLO), THWOLD(NIBLO,NBLO),
     2              USNEW (NIBLO), USOLD (NIBLO,NBLO),
     3              Z0NEW (NIBLO), Z0OLD (NIBLO,NBLO),
     4              TAUW(NIBLO,NBLO), IIG,
     5              IDA, IDATEWO, IDAWIFL, IDATEFL
C
C ----------------------------------------------------------------------
C
      DIMENSION  UWND(NC,NR), VWND(NC,NR)
      DIMENSION  US(NIBLO,NBLO), DS(NIBLO,NBLO)
C
C        *UWND*    REAL   INPUT WIND FIELD ARRAY (U COMPONENT).
C        *VWND*    REAL   INPUT WIND FIELD ARRAY (V COMPONENT).
C        *US*      REAL   OUTPUT WIND FIELD ARRAY (FRICTION VELOCITY).
C        *DS*      REAL   OUTPUT WIND FIELD ARRAY (DIRECTION).
C
C
      CHARACTER*12 IDTWIE, IDTWIH, IDTWIS
C
C ----------------------------------------------------------------------
C
C*    1. INITIALISE WIND REQUEST DATE AND PROCESS FIRST WINDFIELD
C*       IF COLD START.
C        --------------------------------------------------------
C
 1000 CONTINUE
      IDTWIH = IDTWIS
      IF (IDA.EQ.'000000000000') THEN
         IDA = IDTWIS
         CALL GETWND (U10OLD, THWOLD, IDA, UWND, VWND, NC, NR)
         DO 1001 IG = 1,IGL
            CALL AIRSEA (U10OLD(1,IG), TAUW(1,IG),
     1                   USOLD(1,IG), Z0OLD(1,IG), IJS(IG), IJL(IG))
 1001    CONTINUE
         IF (ITEST.GE.3) THEN
            WRITE(IU06,'(''       SUB. NOTIM: FIRST WIND FIELD '',
     1                ''SAVED IN COMMON WIND'')')
         ENDIF
         IF (IDA.EQ.IDTWIE) RETURN
         CALL INCDATE (IDTWIH,IDELWO)
      ENDIF
C
C ----------------------------------------------------------------------
C
C*    2. CREATE WIND FILE NAME FROM END DATE.
C        ------------------------------------
C
 2000 CONTINUE
      CALL CREWFN (IUVELO, IDTWIE)
      IF (ITEST.GE.3) THEN
         WRITE(IU06,*) '       SUB. NOTIM: NEW WIND FILE '
         WRITE(IU06,*) '       UNIT IS IUVELO = ', IUVELO,
     1                 ' WIND FILE DATE IS IDTWIE = ', IDTWIE
      ENDIF
      REWIND (UNIT=IUVELO)
      MP = 0
C
C ----------------------------------------------------------------------
C
C*    3. LOOP OVER OUTPUT WIND TIMES.
C        ----------------------------
C
 3000 CONTINUE
C
C*    3.1 READ ONE WIND FIELD AND TRANSFORM TO BLOCKS.
C         --------------------------------------------
C
 3100 CONTINUE
      CALL GETWND (US, DS, IDTWIH, UWND, VWND, NC, NR)
      MP = MP + 1
C
C*    3.2 SAVE BLOCKED WIND FIELD.
C         ------------------------
C
      IF (IDELPRO.GT.IDELWO) THEN
C
C*        MORE THAN ONE FIELD PER PROPAGATION TIME STEP.
C*        SAVE ON SCRATCH UNITS:
C
         DO 3201 IG=1,IGL
            IUNIT =IUSCR(IG)
            WRITE (IUNIT,ERR=6100,IOSTAT=IOS)
     1            IDTWIH, IG, (US(I,IG),I=1,NIBLO), (DS(I,IG),I=1,NIBLO)
 3201    CONTINUE
         IF (ITEST.GE.3) THEN
            WRITE(IU06,*) '       SUB. NOTIM: NEW WIND FILES AT ',
     1                    'IDTWIH = ', IDTWIH,' WRITTEN TO SCRATCH UNIT'
            WRITE(IU06,'(1H+,A8)') IUNIT
         ENDIF
C
C*        UPDATE WIND FIELD REQUEST TIME.
C
         CALL INCDATE (IDTWIH,IDELWO)
C
C*        IF TIME LEFT BRANCH BACK TO 3.0 FOR NEXT FIELD.
C
         IF (IDTWIH.LE.IDTWIE) GOTO 3000
      ELSE
C
C*        WIND FIELD IS CONSTANT FOR ONE PROPAGATION TIME STEP:
C*        WRITE TO OUTPUT.
C         -----------------------------------------------------
C
         DO 3202 IG=1,IGL
            WRITE (IUVELO,ERR=6400,IOSTAT=IOS)
     1      IDTWIH, IG, (US(I,IG),I=1,NIBLO), (DS(I,IG),I=1,NIBLO)
 3202    CONTINUE
C
C*        UPDATE WIND FIELD REQUEST TIME.
C         -------------------------------
C
         CALL INCDATE (IDTWIH,IDELWO)
C
C*        IF TIME LEFT BRANCH BACK TO 3.0 FOR NEXT FIELD.
C
         IF (IDTWIH.LE.IDTWIE) GOTO 3000
         IF (ITEST.GE.3) THEN
            WRITE(IU06,*) '       SUB. NOTIM: NEW WIND FILE GENERATED '
         ENDIF

         CLOSE (UNIT=IUVELO, STATUS='KEEP')
         RETURN

      ENDIF
C
C ----------------------------------------------------------------------
C
C*    4. RE-ARRANGE THE BLOCKS.
C        ----------------------
C
 4000 CONTINUE
      DO 4001 IG=1,IGL
         REWIND (UNIT=IUSCR(IG))
 4001 CONTINUE

      MSTEP = IDELPRO/IDELWO
      DO 4002 M=1,MP,MSTEP
         DO 4003 IG=1,IGL
            IUNIT = IUSCR(IG)
            DO 4004 MM=1,MSTEP
               READ (IUNIT,ERR=6200,IOSTAT=IOS)
     1            IDT,IGG, (US(I,IG),I=1,NIBLO),(DS(I,IG),I=1,NIBLO)
C
               WRITE (IUVELO,ERR=6300,IOSTAT=IOS)
     1            IDT, IGG, (US(I,IG),I=1,NIBLO), (DS(I,IG),I=1,NIBLO)
 4004       CONTINUE
 4003    CONTINUE
 4002 CONTINUE
      REWIND (UNIT=IUVELO)
      DO 4005 IG=1,IGL
         CLOSE (UNIT=IUSCR(IG), STATUS='DELETE')
 4005 CONTINUE
      CLOSE (UNIT=IUVELO, STATUS='KEEP')
      IF (ITEST.GE.3) THEN
         WRITE(IU06,*) '       SUB. NOTIM: NEW WIND FILE ',
     1                 'GENERATED AS COPY FROM  SCRATCH UNITS'
      ENDIF

      RETURN
C
C ----------------------------------------------------------------------
C
C*    6. ERROR MESSAGES
C
 6100 CONTINUE
         WRITE (IU06,*) ' '
         WRITE (IU06,*) ' ********************************************'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' *       FATAL ERROR IN SUB. NOTIM:         *'
         WRITE (IU06,*) ' *       ==========================         *'
         WRITE (IU06,*) ' * ERROR WHEN WRITTING ON SCRATCH UNIT      *'
         WRITE (IU06,*) ' * FOR BLOCK NUMBER          IG = ', IG
         WRITE (IU06,*) ' * NUMBER OF WIND FIELD IS   MP = ', MP
         WRITE (IU06,*) ' * DATE OF WIND FIELD IS IDTWIH = ', IDTWIH
         WRITE (IU06,*) ' * MESSAGE IS               IOS = ', IOS
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' * PROGRAM ABORTS    PROGRAM ABORTS         *'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' ********************************************'
         CALL ABORT
 6200    CONTINUE
         WRITE (IU06,*) ' '
         WRITE (IU06,*) ' ********************************************'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' *       FATAL ERROR IN SUB. NOTIM:         *'
         WRITE (IU06,*) ' *       ==========================         *'
         WRITE (IU06,*) ' * ERROR WHEN READING FROM SCRATCH UNIT     *'
         WRITE (IU06,*) ' * FOR BLOCK NUMBER       IG = ', IG
         WRITE (IU06,*) ' * DATE OF WIND FIELD IS IDT = ', IDT
         WRITE (IU06,*) ' * MESSAGE IS            IOS = ', IOS
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' * PROGRAM ABORTS    PROGRAM ABORTS         *'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' ********************************************'
         CALL ABORT
 6300 CONTINUE
         WRITE (IU06,*) ' '
         WRITE (IU06,*) ' ********************************************'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' *       FATAL ERROR IN SUB. NOTIM:         *'
         WRITE (IU06,*) ' *       ==========================         *'
         WRITE (IU06,*) ' * ERROR WHEN WRITTING ON WIND OUTPUT FILE  *'
         WRITE (IU06,*) ' * AFTER READING FROM SCRATCH UNIT          *'
         WRITE (IU06,*) ' * FOR BLOCK NUMBER       IG = ', IG
         WRITE (IU06,*) ' * DATE OF WIND FIELD IS IDT = ', IDT
         WRITE (IU06,*) ' * MESSAGE IS            IOS = ', IOS
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' * PROGRAM ABORTS    PROGRAM ABORTS         *'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' ********************************************'
         CALL ABORT
 6400 CONTINUE
         WRITE (IU06,*) ' '
         WRITE (IU06,*) ' ********************************************'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' *       FATAL ERROR IN SUB. NOTIM:         *'
         WRITE (IU06,*) ' *       ==========================         *'
         WRITE (IU06,*) ' * ERROR WHEN WRITTING ON WIND OUTPUT FILE  *'
         WRITE (IU06,*) ' * SCRATCH UNITS ARE NOT USED               *'
         WRITE (IU06,*) ' * FOR BLOCK NUMBER          IG = ', IG
         WRITE (IU06,*) ' * DATE OF WIND FIELD IS IDTWIH = ',IDTWIH
         WRITE (IU06,*) ' * MESSAGE IS               IOS = ', IOS
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' * PROGRAM ABORTS    PROGRAM ABORTS         *'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' ********************************************'
         CALL ABORT

      END
      SUBROUTINE PEAK (IJS, IJL, IG, FETCH, FPMAX)

C ----------------------------------------------------------------------
C
C**** *PEAK* - COMPUTE JONSWAP PARAMETERS FROM WINDSPEED.
C
C     S. HASSELMANN  - JULY 1990
C     H. GUNTHER     - DECEMBER 1990   MODIFIED FOR CYCLE_4.
C
C*    PURPOSE.
C     --------
C
C       COMPUTES FOR EACH GRID POINT OF A BLOCK THE PEAK FREQUENCY
C       FROM A FETCH LAW AND THE JONSWAP ALPHA FROM THE ALPHA NY
C       RELATION.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *PEAK (IJL, IJS, IG, FETCH, FPMAX)*
C          *IJS*     INTEGER  FIRST POINT IN BLOCK.
C          *IJL*     INTEGER  LAST  POINT IN BLOCK.
C          *IG*      INTEGER  BLOCK NUMBER.
C          *FETCH*   REAL     FETCH TO BE USED (METRES).
C          *FPMAX*   REAL     MAXIMUM PEAK FREQUENCY (HERTZ).
C
C     METHOD.
C     -------
C
C       FP = A * (G*FETCH/U_10**2)**D    A = 2.84
C       FP = MAX [FP, 0.13]              D = -3./10.
C       FP = MIN [FP, FRMAX*U_10/G]      b = 0.033
C       ALPHJ = B * FP-**2/3             B = 0.033
C       ALPHJ = MAX [ALPHJ, 0.0081]
C       FP = G/U_10*FP
C
C     EXTERNALS.
C     ----------
C
C       NONE.
C
C     REFERENCES.
C     -----------
C
C       K.HASSELMAN,D.B.ROOS,P.MUELLER AND W.SWELL
C          A PARAMETRIC WAVE PREDICTION MODEL
C          JOURNAL OF PHSICAL OCEANOGRAPHY, VOL. 6, NO. 2, MARCH 1976.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *COMMON*  *WIND* - VARIABLES USED FOR WIND COMPUTATIONS.
C
C
      CHARACTER*12 IDA, IDAWIFL, IDATEWO, IDATEFL
C
      COMMON/ WIND/ U10NEW(NIBLO), U10OLD(NIBLO,NBLO),
     1              THWNEW(NIBLO), THWOLD(NIBLO,NBLO),
     2              USNEW (NIBLO), USOLD (NIBLO,NBLO),
     3              Z0NEW (NIBLO), Z0OLD (NIBLO,NBLO),
     4              TAUW(NIBLO,NBLO), IIG,
     5              IDA, IDATEWO, IDAWIFL, IDATEFL
C
C*    *COMMON*  *JONS* - JONSWAP PARAMETERS.
C
      COMMON /JONS/ FP(NIBLO), ALPHJ(NIBLO), THES(NIBLO),
     1              FM, ALFA, GAMMA, SA, SB, THETAQ
C
C ----------------------------------------------------------------------
C
      PARAMETER  (G = 9.806)
      PARAMETER  (A = 2.84, B = 0.033, D = -(3./10.), E = 2./3.)
C
C           FETCH LAW CONSTANTS.
C
C ----------------------------------------------------------------------
C
C*    1. COMPUTE VALUES FROM FETCH LAWS.
C        -------------------------------
C
 1000 CONTINUE
      GX = G * FETCH
      DO 1001 IJ = IJS, IJL
         IF (U10OLD(IJ,IG) .GT. 0.1E-08) THEN
            U10 = U10OLD(IJ,IG)
            GXU = GX/(U10*U10)
            UG = G/U10
            FP(IJ) = A * GXU ** D
            FP(IJ) = MAX(0.13, FP(IJ))
            FP(IJ) = MIN(FP(IJ), FPMAX/UG)
            ALPHJ(IJ) = B * FP(IJ)** E
            ALPHJ(IJ) = MAX(ALPHJ(IJ), 0.0081)
            FP(IJ) = FP(IJ)*UG
         ENDIF
 1001 CONTINUE

      RETURN
      END
      PROGRAM PRESET

C ----------------------------------------------------------------------
C
C**** *PRESET* - GENERATES ALL FILES REQUIRED FOR A WAMODEL COLD START.
C
C     SUSANNE HASSELMANN  MPI     JULY 1986.
C
C     ANNEGRET SPEIDEL    MPI      MAY 1988 PARAMETER STATEMENTS.
C
C     ANNEGRET SPEIDEL    MPI NOVEMBER 1988 CRAY-2 VERSION.
C
C     CYCLE_3 MODICIFATIONS:
C     ----------------------
C
C     RENATE PORTZ       MPI      JUNE 1990 COMPUTATION OF INITIAL
C                                           JONSWAP SPECTRA FROM
C                                           INITIAL WIND FIELD.
C
C     CYCLE_4 MODICIFATIONS:
C     ----------------------
C
C     H. GUNTHER  GKSS/ECMWF  DECEMBER 1990
C
C*    PURPOSE.
C     --------
C
C       TO INITIALISE ALL FILES REQUESTED BY THE WAMODEL.
C
C**   INTERFACE.
C     ----------
C
C       *IU01*   INTEGER    INPUT  UNIT UNBLOCKED WIND FILE.
C                           (SEE SUB READWND).
C       *IU05*   INTEGER    USER INPUT UNIT.
C       *IU06*   INTEGER    PRINTER OUTPUT.
C       *IU07*   INTEGER    INPUT  UNIT PREPROC GRID OUTPUT.
C       *IU12*   INTEGER    OUTPUT UNIT BLOCKS OF SPECTRA.
C       *IU14*   INTEGER    OUTPUT UNIT SECOND LAT OF BLOCKS.
C       *IU15*   INTEGER    OUTPUT UNIT LAST WINDFIELDS.
C
C     METHOD.
C     -------
C
C       JONSWAP PARAMETERS ARE DEFINED EITHER BY USER INPUT OR
C       BY FETCH LAWS. THE 2-D SPECTRA ARE COMPUTED FOR EACH
C       POINT IN A BLOCK, THE WAMODEL BLOCKS ARE INITIALISED BY THESE
C       SPECTRA AND ALL BLOCKS AND OVERLAPPING LATITUDES ARE SAVED.
C       IF FETCH LAWS ARE USED TO DEFINE PARAMETERS THE FIRST WIND
C       FIELD IS GENERATED OTHERWISE THE WIND FIELD IS INITIALISED
C       WITH ZEROS. THE MAIN MODEL WILL RECONSTRUCT THE WIND ANY HOW.
C
C       THE FILE HANDLING OF THE RESTART FILES IS COMPUTER DEPENDENT.
C       SUB GSFILE HAS TO BE MODIFIED, TO COPY THE UNIT ALIAS FILES
C       (UNITS IU12,IU14, AND IU15) TO PERMANENT FILES.
C
C     EXTERNALS.
C     ----------
C
C       *ABORT*     - TERMINATES PROCESSING.
C       *AIRSEA*    - TOTAL STRESS IN SURFACE LAYER.
C       *CREWFN*    - CREATES A WIND FILE NAME.
C       *GETWND*    - GETS A WIND FIELD.
C       *GSFILE*    - GETS OR SAVES FILES (COMPUTER DEPENDENT).
C       *iecf_len*  - LENGTH OF A CHARACTER ARRAY.
C       *INCDATE*   - UPDATES A DATE TINE GROUP.
C       *LOCINT*    - INTERPOLATES TO MODEL GRID.
C       *MSTART*    - GENERATES THE RESTART FILES.
C       *NOTIM*     - CONTROLS WIND GENERATION (NO TIME INTERPOLATION).
C       *OPENFIL*   - OPENS A FILE.
C       *PEAK*      - COMPUTES PARAMETERS BY FETCH LAWS.
C       *PREWIND*   - PREPARES WINDS.
C       *SAVREST*   - SAVES THE RESTART FILES.
C       *SPECTRA*   - COMPUTES SPECTRA FROM PARAMETERS.
C       *SPLITBL*   - SAVES SECOND TO LAST LATITUDES.
C       *SPR*       - DIRECTIONAL DISTRIBUTION.
C       *READPRE*   - READS PREPROC OUTPUT.
C       *READWND*   - READS A WIND FIELD.
C       *TIMIN*     - CONTROLS WIND GENERATION (TIME INTERPOLATION).
C       *WAMWND*    - CONVERTS INPUT WIND TO WAM WINDS.
C
C     REFERENCES
C     ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *NANG*      INTEGER   NUMBER OF ANGLES.
C      *NFRE*      INTEGER   NUMBER OF FREQUENCIES.
C      *NGX*       INTEGER   NUMBER OF LONGITUDES IN GRID.
C      *NGY*       INTEGER   NUMBER OF LATITUDES IN GRID.
C      *NBLO*      INTEGER   NUMBER OF BLOCKS.
C      *NIBLO*     INTEGER   NUMBER OF POINTS IN BLOCK.
C      *NOVER*     INTEGER   MAXIMUM NUUMBER POINTS IN FIRST LATITUDE
C                            OF BLOCKS.
C      *MOUTP*     INTEGER   MAXIMUM NUMBER OF OUTPUT POINTS.
C      *MOUTT*     INTEGER   MAXIMUM NUMBER OF OUTPUT TIMES.
C
C      *NMAXC*     INTEGER   NUMBER OF BOUNDARY OUTPUT POINTS, IF
C                            THIS IS A COARSE GRID; ELSE = 1.
C      *NMAXF*     INTEGER   NUMBER OF BOUNDARY POINTS, IF THIS IS
C                            A FINE GRID RUN; ELSE = 1.
C      *NBINP*     INTEGER   NUMBER OF BOUNDARY INPUT POINTS FROM A
C                            PREVIOUS COARSE GRID RUN, IF THIS IS A
C                            A FINE GRID RUN; ELSE = 1.
C      *NIBL1*     INTEGER   = NIBLO IF MULTI BLOCK VERSION.
C                            =     1 IF ONE BLOCK VERSION.
C      *NIBLD*     INTEGER   = NIBLO IF DEPTH OR CURRENT REFRACTION.
C                            = 1     ELSE.
C      *NBLD*      INTEGER   = NIBO  IF DEPTH OR CURRENT REFRACTION.
C                            = 1     ELSE.
C      *NIBLC*     INTEGER   = NIBLO IF CURRENT REFRACTION.
C                            = 1     ELSE.
C      *NBLC*      INTEGER   = NIBO  IF CURRENT REFRACTION.
C                            = 1     ELSE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR WIND INPUT ARRAY DIMENSIONS.
C
       INCLUDE 'wind.h'
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *NC*        INTEGER   COLUMNES IN WIND INPUT GRID (DIMENSION)
C      *NR*        INTEGER   ROWS     IN WIND INPUT GRID (DIMENSION).
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *COUPL* - PARAMETERS FOR COUPLING.
C
      COMMON /COUPL/ BETAMAX, ZALP, ALPHA, XKAPPA, XNLEV
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *BETAMAX*   REAL      PARAMETER FOR WIND INPUT.
C      *ZALP*      REAL      SHIFTS GROWTH CURVE.
C      *ALPHA*     REAL      CHARNOCK CONSTANT.
C      *XKAPPA*    REAL      VON KARMAN CONSTANT.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *COUT*  OUTPUT POINTS INDICES AND FLAGS.
C
      LOGICAL FFLAG(14), FFLAG20, FFLAG21, FFLAG25, FFLAG26,
     1        PFLAG(14), PFLAG20, PFLAG21, PFLAG25, PFLAG26
      COMMON /COUT/ NGOUT, IGAR(MOUTP), IJAR(MOUTP),
     1              NOUTT, IOUTT(MOUTT),
     2              FFLAG, FFLAG20, FFLAG21, FFLAG25, FFLAG26,
     3              PFLAG, PFLAG20, PFLAG21, PFLAG25, PFLAG26
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *NGOUT*     INTEGER   NUMBER OF OUTPUT POINTS.
C      *IGAR*      INTEGER   BLOCK NUMBER OF OUTPUT POINTS.
C      *IJAR*      INTEGER   GRIDPOINT NUMBER OF OUTPUT POINT.
C      *NOUTT*     INTEGER   NUMBER OF OUTPUT TIMES.
C      *IOUTT*     INTEGER   OUTPUT TIMES.
C      *FFLAG*     LOGICAL   FILE  OUTPUT FLAG FOR EACH OUTPUT TYPE.
C      *FFLAG20*   LOGICAL   .TRUE. IF OUTPUT IS WRITTEN TO UNIT IU20.
C      *FFLAG21*   LOGICAL   .TRUE. IF OUTPUT IS WRITTEN TO UNIT IU21.
C      *FFLAG25*   LOGICAL   .TRUE. IF OUTPUT IS WRITTEN TO UNIT IU25.
C      *FFLAG26*   LOGICAL   .TRUE. IF OUTPUT IS WRITTEN TO UNIT IU26.
C      *PFLAG*     LOGICAL   PRINT OUTPUT FLAG FOR EACH OUTPUT TYPE.
C      *PFLAG20*   LOGICAL   .TRUE. IF PRINT OUTPUT OF FIELDS.
C      *PFLAG21*   LOGICAL   .TRUE. IF PRINT OUTPUT OF SWELL FIELDS.
C      *PFLAG25*   LOGICAL   .TRUE. IF PRINT OUTPUT OF SPECTRA.
C      *PFLAG26*   LOGICAL   .TRUE. IF PRINT OUTPUT OF SWELL SPECTRA.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *CURRENT* - CURRENT FIELD.
C
      COMMON /CURRENT/ U(0:NIBLC,NBLC), V(0:NIBLC,NBLC)
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -----     --------
C      *U*         REAL      U - COMPONENT OF CURRENT (M/S).
C      *V*         REAL      V - COMPONENT OF CURRENT (M/S).
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *FREDIR* - FREQUENCY AND DIRECTION GRID.
C
      COMMON /FREDIR/ FR(NFRE), DFIM(NFRE), GOM(NFRE), C(NFRE),
     1                DELTH, DELTR, TH(NANG), COSTH(NANG), SINTH(NANG)
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *FR*        REAL      FREQUENCIES IN HERTZ.
C      *DFIM*      REAL      FREQUENCY INTERVAL*DIRECTION INTERVAL.
C      *GOM*       REAL      DEEP WATER GROUP VELOCITIES (M/S).
C      *C*         REAL      DEEP WATER PHASE VELOCITIES (M/S).
C      *DELTH*     REAL      ANGULAR INCREMENT OF SPECTRUM (RADIANS).
C      *DELTR*     REAL      DELTH TIMES RADIUS OF EARTH (METRES).
C      *TH*        REAL      DIRECTIONS IN RADIANS.
C      *COSTH*     REAL      COS OF DIRECTION.
C      *SINTH*     REAL      SIN OF DIRECTION.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *GRIDPAR*  GENERAL GRID INFORMATION.
C
      COMMON /GRIDPAR/ DELPHI, DELLAM, SINPH(NGY), COSPH(NGY),
     1                 IGL, IJS(NBLO), IJL2(NBLO), IJLS(NBLO),
     2                 IJL(NBLO), IJLT(NBLO)
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *DELPHI*    REAL      GRID INCREMENT FOR LATITUDE (METRES).
C      *DELLAM*    REAL      GRID INCREMENT FOR LONGITUDE AT EQUATOR
C                            IN METRES.
C      *SINPH*     REAL      SIN OF LATITUDE.
C      *COSPH*     REAL      COS OF LATITUDE.
C      *IGL*       INTEGER   NO OF BLOCKS.
C      *IJS*       INTEGER   INDEX OF FIRST POINT OF SECOND LAT.
C      *IJS*       INTEGER   INDEX OF FIRST POINT OF SECOND LAT.
C      *IJL2*      INTEGER   INDEX OF LAST POINT OF SECOND LAT.
C      *IJLS*      INTEGER   INDEX OF FIRST POINT OF LAT BEFORE LAST.
C      *IJL*       INTEGER   INDEX OF LAST POINT OF LAT BEFORE LAST.
C      *IJLT*      INTEGER   TOTAL NUMBER OF GRIDPOINTS IN A BLOCK.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *INDNL* - INDICES AND WEIGHTS USED IN THE COMPUTATION
C                        OF THE NONLINEAR TRANSFER RATE.
C
      COMMON /INDNL/ IKP(NFRE+4), IKP1(NFRE+4),
     1               IKM(NFRE+4), IKM1(NFRE+4),
     2               K1W(NANG,2), K2W(NANG,2), K11W(NANG,2),
     3               K21W(NANG,2), AF11(NFRE+4), FKLAP(NFRE+4),
     4               FKLAP1(NFRE+4), FKLAM(NFRE+4), FKLAM1(NFRE+4),
     5               ACL1, ACL2,  CL11, CL21, DAL1, DAL2, FRH(30)
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   -------
C      *IKP*       INTEGER   FREQUENCY INDEX ARRAY FOR STORING ENERGY
C                            TRANSFER INCREMENTS INTO BINS, WAVE NO. 3.
C      *IKP1*      INTEGER   IKP+1.
C      *IKM*       INTEGER   FREQUENCY INDEX ARRAY FOR STORING ENERGY
C                            TRANSFER INCREMENTS INTO BINS, WAVE NO. 4.
C      *IKM1*      INTEGER   IKM+1
C      *K1W*       INTEGER   ANGULAR INDEX ARRAY FOR STORING ENERGY
C                            TRANSFER INCREMENTS INTO BINS, WAVE NO. 3.
C      *K11W*      INTEGER   K1W(.,1)-1, K1W(.,2)+1.
C      *K2W*       INTEGER   ANGULAR INDEX ARRAY FOR STORING ENERGY
C                            TRANSFER INCREMENTS INTO BINS, WAVE NO. 4.
C      *K21W*      INTEGER   K2W(.,1)+1, K2W(.,2)-1.
C      *AF11*      REAL      WEIGHTS FOR DISCRETE APPROXIMATION OF NONL
C                            TRANSFER (AT PRESENT ONE TERM ONLY SET TO
C                            3000). MULTIPLIED BY FREQUENCIES **11.
C      *FKLAP*     REAL      WEIGHT IN FREQUENCY GRID FOR INTERPOLATION,
C                            WAVE NO. 3 ("1+LAMBDA" TERM).
C      *FKLAP1*    REAL      1-FKLAP.
C      *FKLAM*     REAL      WEIGHT IN FREQUENCY GRID FOR INTERPOLATION,
C                            WAVE NO. 4 ("1-LAMBDA" TERM).
C      *ACL1*      REAL      WEIGHT IN ANGULAR GRID FOR INTERPOLATION,
C                            WAVE NO. 3 ("1+LAMBDA" TERM).
C      *ACL2*      REAL      WEIGHT IN ANGULAR GRID FOR INTERPOLATION,
C                            WAVE NO. 4 ("1-LAMBDA" TERM).
C      *CL11*      REAL      1.-ACL1.
C      *CL21*      REAL      1.-ACL2.
C      *DAL1*      REAL      1./ACL1.
C      *DAL2*      REAL      1./ACL2.
C      *FRH*       REAL      TAIL FREQUENCY RATION **5
C
C ----------------------------------------------------------------------
C
C*    *COMMON*  *JONS* - JONSWAP PARAMETERS.
C
      COMMON /JONS/ FP(NIBLO), ALPHJ(NIBLO), THES(NIBLO),
     1              FM, ALFA, GAMMA, SA, SB, THETAQ
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *FP*        REAL      PEAK FREQUENCY OF SPECTRA IN A BLOCK (HZ).
C      *ALPHJ*     REAL      ALPHA PARAMETER OF SPECTRA IN A BLOCK.
C      *THES*      REAL      MEAN DIRECTION OF SPECTRA IN A BLOCK (RAD).
C      *FM*        REAL      PEAK FREQUENCY AS DEFINED BY INPUT (HZ).
C      *ALFA*      REAL      ALPHA PARAMETER AS DEFINED BY INPUT.
C      *GAMMA*     REAL      OVERSHOOT FACTOR.
C      *SA*        REAL      LEFT PEAK WIDTH.
C      *SB*        REAL      RIGHT PEAK WIDTH.
C      *THETAQ*    REAL      MEAN DIRECTION AS DEFINED BY INPUT (RAD).
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *MAP*  LON/LAT INDEX OF EACH SEA POINT.
C
      COMMON /MAP/ IXLG(NIBLO,NBLO), KXLT(NIBLO,NBLO), NX, NY, IPER,
     1             AMOWEP, AMOSOP, AMOEAP, AMONOP, XDELLA, XDELLO
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *IXLG*      INTEGER   LONG. GRID INDEX.
C      *KXLT*      INTEGER   LAT. GRID INDEX.
C      *NX*        INTEGER   NUMBER OF LONGITUDES IN GRID.
C      *NY*        INTEGER   NUMBER OF LATITUDES  IN GRID.
C      *IPER*      INTEGER   = 1 IF GRID IS PERIODIC.
C      *AMOWEP*    REAL      MOST WESTERN LONGITUDE IN GRID (DEGREE).
C      *AMOSOP*    REAL      MOST SOUTHERN LATITUDE IN GRID (DEGREE).
C      *AMOEAP*    REAL      MOST EASTERN LONGITUDE IN GRID (DEGREE).
C      *AMONOP*    REAL      MOST NORTHERN LATITUDE IN GRID (DEGREE).
C      *XDELLA*    REAL      GRID INCREMENT FOR LATITUDE (DEGREE).
C      *XDELLO*    REAL      GRID INCREMENT FOR LONGITUDE (DEGREE).
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *SHALLOW*   SHALLOW WATER TABLES.
C
      PARAMETER (NDEPTH = 63)
C
      COMMON /SHALLOW/ DEPTH(NIBLO, NBLO), DEPTHA, DEPTHD,
     1                 TCGOND(NDEPTH,NFRE), TFAK(NDEPTH,NFRE),
     2                 TSIHKD(NDEPTH,NFRE), INDEP(NIBLO)
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *NDEPTH*    INTEGER   LENGTH OF SHALLOW WATER TABLES.
C      *DEPTH*     REAL      WATER DEPTH IN METRES.
C      *DEPTHA*    REAL      MINIMUM DEPTH FOR TABLES (METRES).
C      *DEPTHD*    REAL      DEPTH INCREMENT (METRES).
C      *TCGOND*    REAL      SHALLOW WATER GROUP VELOCITY TABLE.
C      *TFAK*      REAL      WAVE NUMBER TABLE.
C      *TSIHKD*    REAL      TABLE FOR OMEGA/SINH(2KD).
C      *INDEP*     INTEGER   DEPTH INDEX FOR A BLOCK.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *SPE1* - A BLOCK OF SPECTRA.
C
      COMMON /SPE1/ FL1(0:NIBLO,NANG,NFRE)
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *FL1*       REAL      2-D SPECTRA AT EACH GRID POINT OF A BLOCK.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *STATUS* - TIME STATUS OF INTEGRATION, WIND INPUT,
C                         OUTPUT OF RESULTS, AND MODEL OPTIONS.
C
      CHARACTER*12 IDATEA, IDATEE, IDTPRO, IDTRES,
     &             IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
      COMMON /STATUS/ IDELPRO, IDELT, IDELWI, IDELWO,
     1                IREST, IDELRES, IDELINT, IDELINS,
     2                IDELSPT, IDELSPS,
     3                ICASE, ISHALLO, IREFRA,
     4                IDATEA, IDATEE, IDTPRO, IDTRES,
     5                IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *IDATEA*    CHAR*12   START DATE OF RUN  (YYMMDDHHMM).
C      *IDATEE*    CHAR*12   END DATE OF RUN (YYMMDDHHMM).
C      *IDTPRO*    CHAR*12   END DATE OF PROPAGATION.
C      *IDELPRO*   INTEGER   TIMESTEP WAM PROPAGATION IN SECONDS.
C      *IDELT*     INTEGER   TIMESTEP SOURCE FUNCTION IN SECONDS.
C      *IDELWI*    INTEGER   INPUT WIND TIMESTEP PREWIND IN SECONDS.
C      *IDELWO*    INTEGER   OUTPUT WIND TIMESTEP IN SECONDS
C                            EQUAL TO INPUT WIND TIMESTEP INTO WAMODEL.
C      *IREST*     INTEGER   RESTART FILE SAVE OPTION.
C                            = 1  RESTART FILES ARE SAVED
C                            OTHERWISE RESTART FILES ARE NOT SAVED.
C      *IDELRES*   INTEGER   OUTPUT AND RESTART FILE DISPOSE TIMESTEP.
C      *IDTRES*    CHAR*12   NEXT DATE TO SAVE OUTPUT AND RESTART FILES.
C      *IDELINT*   INTEGER   INTEG. PARAMETER (TOTAL SEA)  OUTPUT
C                            TIMESTEP IN SECONDS.
C      *IDTINTT*   CHAR*12   NEXT DATE TO WRITE INTEG. PARA. (TOTAL)
C      *IDELINS*   INTEGER   INTEG. PARAMETER (SEA + SWELL) OUTPUT
C                            TIMESTEP IN SECONDS.
C      *IDTINTS*   CHAR*12   NEXT DATE TO WRITE INTEG PAR (SEA + SWELL).
C      *IDELSPT*   INTEGER   SPECTRA (TOTAL) OUTPUT TIMESTEP IN SECONDS.
C      *IDTSPT*    CHAR*12   NEXT DATE TO WRITE SPECTRA (TOTAL).
C      *IDELSPS*   INTEGER   SPECTRA (SEA + SWELL) OUTPUT
C                            TIMESTEP IN SECONDS.
C      *IDTSPS*    CHAR*12   NEXT DATE TO WRITE SPECTRA  (SEA + SWELL).
C      *ICASE*     INTEGER   PROPAGATION FLAG
C                            = 1  SPHERICAL COORDINATES
C                            OTHERWISE CARTESIAN COORDINATES.
C      *ISHALLO*   INTEGER   SHALLOW WATER MODEL FLAG
C                            = 1  DEEP WATER MODEL
C                            OTHERWISE  SHALLOW WATER MODEL.
C      *IREFRA*    INTEGER   REFRACTION OPTION..
C                            = 0  NO REFRACTION.
C                            = 1 DEPTH REFRACTION.
C                            = 2 DEPTH AND CURRENT REFRACTION.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *TABLE* - TABLE FOR TOTAL STRESS AND HIGH FREQ STRESS.
C
      PARAMETER (ITAUMAX=100, JUMAX=100, IUSTAR=100, IALPHA=100)
C
      COMMON /TABLE/ TAUT(0:ITAUMAX,0:JUMAX), DELTAUW, DELU,
     1               TAUHFT(0:IUSTAR,0:IALPHA), DELUST, DELALP
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *ITAUMAX*   INTEGER   TABLE DIMENSION.
C      *JUMAX*     INTEGER   TABLE DIMENSION.
C      *IUSTAR*    INTEGER   TABLE DIMENSION.
C      *IALPHA*    INTEGER   TABLE DIMENSION.
C      *TAUT*      REAL      STRESS TABLE.
C      *DELTAUW*   REAL      WAVE STRESS INCREMENT.
C      *DELU*      REAL      WIND INCREMENT.
C      *TAUHFT*    REAL      HIGH FREQUENCY STRESS TABLE.
C      *DELUST*    REAL      USTAR INCREMENT.
C      *DELALP*    REAL      ALPHA INCREMENT.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/ IU06, ITEST, ITESTB
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *IU06*      INTEGER   UNIT FOR PRINTER OUTPUT.
C      *ITEST*     INTEGER   TEST OUTPUT LEVEL:
C                             .LE. 0  NO OUTPUT
C                             .GE. I  OUTPUT TO SUB. LEVEL I
C      *ITESTB*    INTEGER   MAX BLOCK NUMBER FOR OUTPUT IN BLOCK LOOPS
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *TEXT* - FILE NAME INFORMATION.
C
      CHARACTER USERID*3, RUNID*3, PATH*60
      COMMON /TEXT/ USERID, RUNID, PATH
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *USERID*    CHARACTER USERID FOR FILE NAMES.
C      *RUNID*     CHARACTER RUN IDENTIFIER FOR FILE NAMES.
C      *PATH*      CHARACTER PATH NAME FOR FILES.
C
C ----------------------------------------------------------------------
C
C*    *COMMON*  *UNITS* - INPUT / OUTPUT UNITS.
C
      COMMON /UNITS/ IU02, IU08, IU11, IU12, IU13, IU14, IU15, IU16,
     1               IU17, IU18, IU19, IU20, IU21, IU25, IU26, IUVELO,
     2               IUSCR(NBLO)
C
C
C        *IU02*  - LOGICAL UNIT FOR INPUT OF BOUDARY VALUES FROM A
C                  PREVIOUS COARSE GRID IF THIS A FINE GRID RUN.
C        *IU08*  - LOGICAL UNIT FOR INPUT OF COMMON UBUF
C                  (OUTPUT OF PREPROC).
C        *IU11*  - LOGICAL UNIT FOR INPUT OF SPECTRA AT ALL GRID
C                  POINTS. EACH PROPAGATION TIMESTEP THE FILES
C                  CONNECTED TO IU11 AND IU12 ARE INTERCHANGED.
C        *IU12*  - LOGICAL UNIT FOR OUTPUT (SEE IU11).
C        *IU13*  - LOGICAL UNIT FOR INPUT OF SPECTRA ON LAST LATUTUDE
C                  OF A BLOCK. SPECTRA ARE SAVED FROM THE SECOND
C                  LATITUDE OF THE NEXT BLOCK.
C                  EACH PROPAGATION TIMESTEP THE FILES CONNECTED TO
C                  IU14 AND IU13 ARE INTERCHANGED.
C        *IU14*  - LOGICAL UNIT FOR OUTPUT (SEE IU13).
C        *IU15*  - LOGICAL UNIT FOR OUTPUT OF LAST WINDFIELDS FOR
C                  RESTART.
C        *IU16*  - LOGICAL UNIT FOR INPUT/OUTPUT OF COMMON REFDOT
C                  (SEE SUBS PROPDOT AND DOTDC)
C        *IU17*  - LOGICAL UNIT FOR BLOCK WINDINPUT (SEE SUB. IMPLSCH)
C        *IU18*  - LOGICAL UNIT FOR BLOCK WINDINPUT (SEE SUB. IMPLSCH)
C        *IU19*  - LOGICAL UNIT FOR OUTPUT OF OF BOUNDARY VALUES IF
C                  THIS IS A FINE GRID RUN.
C        *IU20*  - LOGICAL UNIT FOR OUTPUT OF INTEGRATED PARAMETERS
C                  OF THE TOTAL SPECTRUM.
C        *IU21*  - LOGICAL UNIT FOR OUTPUT OF INTEGRATED PARAMETERS
C                  OF SWELL AND WIND WAVES.
C        *IU25*  - LOGICAL UNIT FOR OUTPUT OF SPECTRA AT CERTAIN
C                  GRID POINTS.
C        *IU26*  - LOGICAL UNIT FOR OUTPUT OF SWELL SPECTRA AT
C                  CERTAIN GRID POINTS.
C        *IUVELO*- OUTPUT UNIT FOR BLOCKED WIND FIELDS.
C        *IUSCR* - SCRATCH UNITS FOR WIND PROCESSING.
C
C ----------------------------------------------------------------------
C
C*    *COMMON*  *WIND* - VARIABLES USED FOR WIND COMPUTATIONS.
C
C
      CHARACTER*12 IDA, IDAWIFL, IDATEWO, IDATEFL
C
      COMMON/ WIND/ U10NEW(NIBLO), U10OLD(NIBLO,NBLO),
     1              THWNEW(NIBLO), THWOLD(NIBLO,NBLO),
     2              USNEW (NIBLO), USOLD (NIBLO,NBLO),
     3              Z0NEW (NIBLO), Z0OLD (NIBLO,NBLO),
     4              TAUW(NIBLO,NBLO), IIG,
     5              IDA, IDATEWO, IDAWIFL, IDATEFL
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *IDA*       CHAR*12   DATE OF LAST WINDFIELD READ IN.
C      *IDATEWO*   CHAR*12   DATE OF NEXT WIND FIELD TO BE READ.
C      *IDAWIFL*   CHAR*12   DATE OF NEXT WIND FILE NAME.
C      *IDATEFL*   CHAR*12   DATE OF NEXT WIND FILE TO BE ACCESSED.
C      *IIG*       INTEGER   BLOCK NUMBER OF LAST WIND FIELD READ IN
C      *U10NEW*    REAL      NEW WIND SPEED IN M/S.
C      *U10OLD*    REAL      INTERMEDIATE STORAGE OF MODULUS OF WIND
C                            VELOCITY.
C      *THWNEW*    REAL      WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC
C                            NOTATION (POINTING ANGLE OF WIND VECTOR,
C                            CLOCKWISE FROM NORTH).
C      *THWOLD*    REAL      INTERMEDIATE STORAGE OF ANGLE (RADIANS) OF
C                            WIND VELOCITY.
C      *USNEW*     REAL      NEW FRICTION VELOCITY IN M/S.
C      *USOLD*     REAL      INTERMEDIATE STORAGE OF MODULUS OF FRICTION
C                            VELOCITY.
C      *Z0NEW*     REAL      ROUGHNESS LENGTH IN M.
C      *Z0OLD*     REAL      INTERMEDIATE STORAGE OF ROUGHNESS LENGTH IN
C                            M.
C      *TAUW*      REAL      WAVE STRESS IN (M/S)**2
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *WNDGRD* -  INPUT WIND GRID SPECIFICATIONS.
C
      COMMON /WNDGRD/ DLAM, DPHI, RLATS, RLATN, RLONL, RLONR,
     1                KCOL, KROW, IWPER, ICODE, ICOORD
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *DLAM*      REAL      STEPSIZE BETWEEN LONGITUDES IN DEG.
C      *DPHI*      REAL      STEPSIZE BETWEEN LATITUDES  IN DEG.
C      *RLATS*     REAL      LATITUDE  AT (., 1) = SOUTHERN LATITUDE.
C      *RLATN*     REAL      LATITUDE  AT (.,NR) = NORTHERN LATITUDE.
C      *RLONL*     REAL      LONGITUDE AT ( 1,.) = WEST MOST LONGITUDE.
C      *RLONR*     REAL      LONGITUDE AT (NC,.) = EAST MOST LONGITUDE.
C      *KCOL*      INTEGER   NUMBER OF COLUMNES IN WIND INPUT (USED).
C      *KROW*      INTEGER   NUMBER OF ROWS     IN WIND INPUT (USED).
C      *ICODE*     INTEGER   WIND CODE 1 = USTAR;  2 = USTRESS; 3 = U10
C      *IWPER*     INTEGER   INDICATOR PERIODICAL GRID.
C                            0= NON-PERIODICAL;   1= PERIODICAL.
C      *ICOORD*    INTEGER   CODE FOR COORDINATE SYSTEM USED
C                            1= RECTANGULAR,EQUIDISTANT LON/LAT GRID.
C                            2= .......NOT IMPLEMENTED.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER* OF GLOBAL CONSTANTS.
C
      PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000.,
     1           ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI,
     2           R = CIRC/ZPI)
C
      CHARACTER LINE*80, HEADER*70
C
C ----------------------------------------------------------------------
C
C*    1. DEFINE UNIT NAMES.
C        ------------------
C
 1000 CONTINUE
      IU05 = 95
      IU06 = 6
      IU07 = 7
      IU12 = 12
      IU14 = 14
      IU15 = 15
C ---------------------------------------------------------------------
C*    1.1 OPEN USER INPUT FILE AND GRID ORGANISATION FILE
C     ----------------------------------
      CALL OP_FILES (IU05,IU06,IU07)
C
C ----------------------------------------------------------------------
C
C*    2. READ USER INPUT.
C        ----------------
C
      ICOUNT = 0
 2000 CONTINUE
      READ (IU05, '(A72)',ERR=9200,END=9200,IOSTAT=IOS) LINE
      IF (LINE(1:1).EQ.'C') GOTO 2000
      ICOUNT = ICOUNT + 1
      IF (ICOUNT.EQ.1) THEN
	 HEADER = LINE(1:70)
	 GOTO 2000
      ELSE IF (ICOUNT.EQ.2) THEN
	 READ (LINE,'(I8,2I9)',ERR=9100,IOSTAT=IOS)
     1        IOPTI, ITEST, ITESTB
	 GOTO 2000
      ELSE IF (ICOUNT.EQ.3) THEN
	 READ (LINE,'(F11.5,5F12.5)',ERR=9100,IOSTAT=IOS)
     1        ALFA, FM, GAMMA, SA, SB, THETA
	 GOTO 2000
      ELSE IF (ICOUNT.EQ.4) THEN
	 READ (LINE,'(F11.1)',ERR=9100,IOSTAT=IOS) FETCH
	 GOTO 2000
      ELSE IF (ICOUNT.EQ.5) THEN
	 USERID = LINE(2:4)
	 RUNID  = LINE(7:9)
	 PATH   = LINE(12:71)
	 GOTO 2000
      ELSE IF (ICOUNT.EQ.6) THEN
C        we changed I9 to I7  19.3.98 isaac and kariel
	 READ (LINE(14:20),'(I7)',ERR=9100,IOSTAT=IOS) IDELWI
	 IF (LINE(22:22).EQ.'H') IDELWI = IDELWI*3600
	 IDATEA(1:10)=LINE(2:11)
         IDATEA(11:12)='00'
	 IF (LINE(22:22).EQ.'H') IDELWI = IDELWI*3600
      ENDIF
C
C ----------------------------------------------------------------------
C
C*    3. READ PREPROC OUTPUT.
C        --------------------
C
 3000 CONTINUE

      CALL READPRE (IU07, 0)
C
C ----------------------------------------------------------------------
C
C*    4. PRINTER PROTOCOL OF INPUT.
C        --------------------------
C
 4000 CONTINUE
      WRITE (IU06,'(1H1,'' PROGRAM PRESET:'',//,'' USER INPUT:'')')
      WRITE (IU06,'(1H0,A70)') HEADER
      WRITE (IU06,'(''0MODEL OPTIONS  :'',/)')
      IF (IOPTI.EQ.0) THEN
         WRITE (IU06,'('' INITIAL VALUES ARE COMPUTED FROM'',
     1                 '' INPUT PARAMETERS.'')')
      ELSE IF (IOPTI.EQ.1) THEN
         WRITE (IU06,'('' INITIAL VALUES ARE COMPUTED FROM'',
     1                 '' LOCAL WIND.'')')
         WRITE (IU06,'('' WAVE ENERGY IS ZERO IN CALM WIND AREAS.'')')
      ELSE IF (IOPTI.EQ.2) THEN
         WRITE (IU06,'('' INITIAL VALUES ARE COMPUTED FROM'',
     1                 '' LOCAL WIND.'')')
         WRITE (IU06,'('' PARAMETERS USED IN CALM WIND AREAS.'')')
      END IF

      WRITE (IU06,*) ' TEST OUTPUT LEVEL IS .......... ITEST = ', ITEST
      WRITE (IU06,*) ' TEST OUTPUT IN BLOCK LOOP UPTO ITESTB = ', ITESTB

      WRITE (IU06,'(''0JONSWAP PARAMETERS  :'',/)')
      WRITE (IU06,'('' ALFA : '',F10.5,'' FM : '',F10.5,'' GAMMA : '',
     1          F10.5,'' SA : '',F10.5,'' SB : '',F10.5)')
     2          ALFA, FM, GAMMA, SA, SB
      WRITE (IU06,'('' MEAN WAVE DIRECTION :  THETA = '',F10.5,
     1           '' DEGREE'')')  THETA
      WRITE (IU06,*) '  '
      WRITE (IU06,*) ' MODEL FILE NAMES:'
      WRITE (IU06,*) ' USERID IS ........: ', USERID
      WRITE (IU06,*) ' RUN IDENTIFIER IS : ', RUNID
      WRITE (IU06,*) ' PATH NAME IS .....: ', PATH
      WRITE (IU06,*) '  '
      WRITE (IU06,*) ' WIND INPUT TIMESTEP (SECONDS)      : ',IDELWI
      WRITE (IU06,*) '  '
      WRITE (IU06,*) ' END OF USER INPUT PROTOCOLL'
      WRITE (IU06,'(''0NUMBER OF DIRECTION BINS  NANG = '',I4)') NANG
      WRITE (IU06,'('' NUMBER OF FREQUENCY BINS  NFRE = '',I4)') NFRE
C
C ----------------------------------------------------------------------
C
C*    5. PREPARE WINDFIELD.
C        ------------------
C
 5000 CONTINUE
      IDA = '000000000000'
      IDATEE  = IDATEA
      IDAWIFL = IDATEA
      IDELPRO = IDELWI
      IDELWO  = IDELWI
      DO 5001 IG=1,NBLO
         DO 5002 IJ=1,NIBLO
            U10OLD(IJ,IG) = 0.
            THWOLD(IJ,IG) = 0.
            USOLD(IJ,IG) = 0.
            TAUW(IJ,IG) = 0.
            Z0OLD(IJ,IG) = 0.
 5002    CONTINUE
 5001 CONTINUE
      DO 5003 IJ=1,NIBLO
         Z0NEW(IJ) = 0.
 5003 CONTINUE
      IF (IOPTI.GT.0) THEN
         CALL PREWIND
         IF (ITEST.GT.0) WRITE (IU06,*) ' SUB. PREWIND DONE'
      ELSE
         IF (ITEST.GT.0) WRITE (IU06,*) ' WIND SET TO ZERO'
      END IF
C
C ----------------------------------------------------------------------
C
C*    6. DEFINE FETCH AND MAXIMUM PEAK FREQUENCY.
C        ----------------------------------------
C
 6000 CONTINUE
C
      IF (FETCH.LT.0.1E-5) FETCH = 0.5*DELPHI
      FRMAX = FM
      IF (IOPTI.NE.0) THEN
         WRITE (IU06,*) ' FETCH USED (METRES)       : ', FETCH
         WRITE (IU06,*) ' MAXIMUM PEAK FREQUENCY IS : ', FRMAX
      ENDIF
C
C ----------------------------------------------------------------------
C
C*    7. GENERATE AND WRITE START FILES.
C        -------------------------------
C
 7000 CONTINUE
      THETAQ = THETA * RAD
      CALL MSTART (IU12, IU14, IU15, IOPTI, FETCH, FRMAX)
      IF (ITEST.GT.0) WRITE (IU06,*) ' SUB. MSTART DONE'
C
C ----------------------------------------------------------------------
C
C
C     8. END OF JOB
C     -------------
C
      WRITE (IU06,*) ' '
      WRITE (IU06,*) ' PROGRAM PRESET: ALL DONE'

      STOP

 9100 CONTINUE
         WRITE(IU06,*) ' ********************************************'
         WRITE(IU06,*) ' *                                          *'
         WRITE(IU06,*) ' *     FATAL ERROR IN PRESET                *'
         WRITE(IU06,*) ' *     =====================                *'
         WRITE(IU06,*) ' * READ ERROR ON CHARACTER STRING           *'
         WRITE(IU06,*) ' * ERROR IS IN DATA LINE ICOUNT = ', ICOUNT
         WRITE(IU06,*) ' * CHARACTER STRING IS   LINE = ', LINE
         WRITE(IU06,*) ' *                                          *'
         WRITE(IU06,*) ' *   PROGRAM ABORTS  PROGRAM ABORTS         *'
         WRITE(IU06,*) ' *                                          *'
         WRITE(IU06,*) ' ********************************************'
         CALL ABORT
 9200 CONTINUE
         WRITE(IU06,*) ' ********************************************'
         WRITE(IU06,*) ' *                                          *'
         WRITE(IU06,*) ' *     FATAL ERROR IN PRESET                *'
         WRITE(IU06,*) ' *     =====================                *'
         WRITE(IU06,*) ' * READ ERROR ON INPUT FILE:                *'
         WRITE(IU06,*) ' * ERROR IS LATER THAN ICOUNT = ', ICOUNT
         WRITE(IU06,*) ' * LAST LINE READ IS     LINE = ', LINE
         WRITE(IU06,*) ' *                                          *'
         WRITE(IU06,*) ' *   PROGRAM ABORTS  PROGRAM ABORTS         *'
         WRITE(IU06,*) ' *                                          *'
         WRITE(IU06,*) ' ********************************************'
         CALL ABORT

      END
      SUBROUTINE PREWIND

C ----------------------------------------------------------------------
C
C**** *PREWIND* - PREPARES WIND DATA FOR WAVE MODEL.
C
C     P.GROENWOUD     DELFT HYDRAULICS LABORATORY  OKTOBER 1986
C
C     E. BAUER        MPI       FEB 1987   VERSION FOR CDC 205 HAMBURG.
C
C     S. HASSELMANN   MPI       MAY 1987   COMBINED CDC 205 AND CRAY
C                                          VERSIONS.
C     W. BRUEGGEMANN  MPI    AUGUST 1988   SIMPLIFIED PROGRAM.
C
C     L. ZAMBRESKY    ECMWF    JUNE 1988   MODIFIED EXTENSIVELY FOR
C                                          COUPLING TO SPECTRAL MODEL.
C
C     H. GUNTHER      ECMWF    JUNE 1990   MODIFIED FOR CYCLE_4.
C
C*    PURPOSE.
C     --------
C
C       EVALUATE WIND SPEED AND DIRECTION AT WAVE MODEL GRID POINTS.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *PREWIND (NC, NR)*
C          *NC*    FIRST  DIMENSION OF INPUT WIND FIELD.
C          *NR*    SECOND DIMENSION OF INPUT WIND FIELD.
C
C       *UNIT* *DESCRIPTION*
C
C          IU01    INPUT WIND DATA (SUB READWND).
C          IU06    PRINTER OUTPUT (SUB INITMDL).
C          IUVELO  OUTPUT OF BLOCKED WIND FIELDS. (SUB CREWFN).
C          IUSCR   SCRATCH UNITS FOR ALL BLOCKS (INTERMEDIATE STORAGE,
C                  INPUT/OUTPUT) (SUB INITMDL).
C
C     METHOD.
C     -------
C
C       INPUT WIND FIELDS WHICH CAN BE COMPONENTS OF
C                USTAR, U10, USTRESS
C       ARE TRANSFORMED TO FRICTION VELOCITIES.
C       THE INPUT FIELDS HAVE TO BE ON A LAT /LONG GRID.
C       SEE SUB READWND FOR FORMATS AND HEADER INFORMATION,
C       WHICH HAVE TO BE GIVEN TO THE PROGRAM.
C
C       A DOUBLE LINEAR INTERPOLATION IN SPACE IS PERFORMED
C       ONTO THE MODEL BLOCKS.
C       IF THE WIND OUTPUT TIMSTEP IS LESS THAN THE INPUT TIMESTEP
C       A LINEAR INTERPOLATION IN TIME IS PERFORMED.
C
C       THERE ARE TWO POSSIBILITIES WITH RESPECT TO THE WIND
C       OUTPUT FILES:
C
C           1. PROPAGATION TIMESTEP >= WIND INPUT STEP
C              ONE OUTPUT FILE CONTAINS IDELPRO/IDELWO WINDFIELDS
C              I.E. INFORMATION FOR ONE PROPAGATION TIMESTEP.
C              TIME FILE(I+1)= TIME FILE(I)+ IDELPRO
C
C           2. PROPAGATION TIMESTEP < INPUT WIND TIMESTEP
C              ONE OUTPUT FILE CONTAINS IDELWI/IDELWO WINDFIELDS
C              I.E. INFORMATION FOR ONE WIND INPUT TIMESTEP.
C              TIME FILE(I+1)= TIME FILE(I) + IDELWI
C
C     EXTERNALS.
C     ----------
C
C       *ABORT*     - TERMINATES PROCESSING.
C       *AIRSEA*    - SURFACE LAYER STRESS.
C       *CREWFN*    - CREATES A WIND FILE NAME.
C       *GETWND*    - PROCESSES ONE WIND FIELD.
C       *INCDAT*    - INCREMENTS DATE TIME GROUP.
C       *LOCINT*    - INTERPOLATES IN SPACE.
C       *NOTIM*     - STEERING SUB FOR INTERPOLATION IN SPACE ONLY.
C       *READWND*   - READS A WIND FIELD.
C       *TIMIN*     - STEERING SUB FOR INTERPOLATION IN SPACE AND TIME.
C       *WAMWND*    - BLOCKS A WIND FIELD AND CONVERTS TO USTAR.
C
C     REFERENCE.
C     -----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'

C*    *PARAMETER*  FOR WIND INPUT ARRAY DIMENSIONS.
C
       INCLUDE 'wind.h'
C*    *COMMON* *GRIDPAR*  GENERAL GRID INFORMATION.
C
      COMMON /GRIDPAR/ DELPHI, DELLAM, SINPH(NGY), COSPH(NGY),
     1                 IGL, IJS(NBLO), IJL2(NBLO), IJLS(NBLO),
     2                 IJL(NBLO), IJLT(NBLO)
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *DELPHI*    REAL      GRID INCREMENT FOR LATITUDE (METRES).
C      *DELLAM*    REAL      GRID INCREMENT FOR LONGITUDE AT EQUATOR
C                            IN METRES.
C      *SINPH*     REAL      SIN OF LATITUDE.
C      *COSPH*     REAL      COS OF LATITUDE.
C      *IGL*       INTEGER   NO OF BLOCKS.
C      *IJS*       INTEGER   INDEX OF FIRST POINT OF SECOND LAT.
C      *IJS*       INTEGER   INDEX OF FIRST POINT OF SECOND LAT.
C      *IJL2*      INTEGER   INDEX OF LAST POINT OF SECOND LAT.
C      *IJLS*      INTEGER   INDEX OF FIRST POINT OF LAT BEFORE LAST.
C      *IJL*       INTEGER   INDEX OF LAST POINT OF LAT BEFORE LAST.
C      *IJLT*      INTEGER   TOTAL NUMBER OF GRIDPOINTS IN A BLOCK.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *STATUS* - TIME STATUS OF INTEGRATION, WIND INPUT,
C                         OUTPUT OF RESULTS, AND MODEL OPTIONS.
C
      CHARACTER*12 IDATEA, IDATEE, IDTPRO, IDTRES,
     &             IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
      COMMON /STATUS/ IDELPRO, IDELT, IDELWI, IDELWO,
     1                IREST, IDELRES, IDELINT, IDELINS,
     2                IDELSPT, IDELSPS,
     3                ICASE, ISHALLO, IREFRA,
     4                IDATEA, IDATEE, IDTPRO, IDTRES,
     5                IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *IDATEA*    CHAR*12   START DATE OF RUN  (YYMMDDHHMM).
C      *IDATEE*    CHAR*12   END DATE OF RUN (YYMMDDHHMM).
C      *IDTPRO*    CHAR*12   END DATE OF PROPAGATION.
C      *IDELPRO*   INTEGER   TIMESTEP WAM PROPAGATION IN SECONDS.
C      *IDELT*     INTEGER   TIMESTEP SOURCE FUNCTION IN SECONDS.
C      *IDELWI*    INTEGER   INPUT WIND TIMESTEP PREWIND IN SECONDS.
C      *IDELWO*    INTEGER   OUTPUT WIND TIMESTEP IN SECONDS
C                            EQUAL TO INPUT WIND TIMESTEP INTO WAMODEL.
C      *IREST*     INTEGER   RESTART FILE SAVE OPTION.
C                            = 1  RESTART FILES ARE SAVED
C                            OTHERWISE RESTART FILES ARE NOT SAVED.
C      *IDELRES*   INTEGER   OUTPUT AND RESTART FILE DISPOSE TIMESTEP.
C      *IDTRES*    CHAR*12   NEXT DATE TO SAVE OUTPUT AND RESTART FILES.
C      *IDELINT*   INTEGER   INTEG. PARAMETER (TOTAL SEA)  OUTPUT
C                            TIMESTEP IN SECONDS.
C      *IDTINTT*   CHAR*12   NEXT DATE TO WRITE INTEG. PARA. (TOTAL)
C      *IDELINS*   INTEGER   INTEG. PARAMETER (SEA + SWELL) OUTPUT
C                            TIMESTEP IN SECONDS.
C      *IDTINTS*   CHAR*12   NEXT DATE TO WRITE INTEG PAR (SEA + SWELL).
C      *IDELSPT*   INTEGER   SPECTRA (TOTAL) OUTPUT TIMESTEP IN SECONDS.
C      *IDTSPT*    CHAR*12   NEXT DATE TO WRITE SPECTRA (TOTAL).
C      *IDELSPS*   INTEGER   SPECTRA (SEA + SWELL) OUTPUT
C                            TIMESTEP IN SECONDS.
C      *IDTSPS*    CHAR*12   NEXT DATE TO WRITE SPECTRA  (SEA + SWELL).
C      *ICASE*     INTEGER   PROPAGATION FLAG
C                            = 1  SPHERICAL COORDINATES
C                            OTHERWISE CARTESIAN COORDINATES.
C      *ISHALLO*   INTEGER   SHALLOW WATER MODEL FLAG
C                            = 1  DEEP WATER MODEL
C                            OTHERWISE  SHALLOW WATER MODEL.
C      *IREFRA*    INTEGER   REFRACTION OPTION..
C                            = 0  NO REFRACTION.
C                            = 1 DEPTH REFRACTION.
C                            = 2 DEPTH AND CURRENT REFRACTION.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/ IU06, ITEST, ITESTB
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *IU06*      INTEGER   UNIT FOR PRINTER OUTPUT.
C      *ITEST*     INTEGER   TEST OUTPUT LEVEL:
C                             .LE. 0  NO OUTPUT
C                             .GE. I  OUTPUT TO SUB. LEVEL I
C      *ITESTB*    INTEGER   MAX BLOCK NUMBER FOR OUTPUT IN BLOCK LOOPS
C
C ----------------------------------------------------------------------
C
C*    *COMMON*  *UNITS* - INPUT / OUTPUT UNITS.
C
      COMMON /UNITS/ IU02, IU08, IU11, IU12, IU13, IU14, IU15, IU16,
     1               IU17, IU18, IU19, IU20, IU21, IU25, IU26, IUVELO,
     2               IUSCR(NBLO)
C
C
C        *IU02*  - LOGICAL UNIT FOR INPUT OF BOUDARY VALUES FROM A
C                  PREVIOUS COARSE GRID IF THIS A FINE GRID RUN.
C        *IU08*  - LOGICAL UNIT FOR INPUT OF COMMON UBUF
C                  (OUTPUT OF PREPROC).
C        *IU11*  - LOGICAL UNIT FOR INPUT OF SPECTRA AT ALL GRID
C                  POINTS. EACH PROPAGATION TIMESTEP THE FILES
C                  CONNECTED TO IU11 AND IU12 ARE INTERCHANGED.
C        *IU12*  - LOGICAL UNIT FOR OUTPUT (SEE IU11).
C        *IU13*  - LOGICAL UNIT FOR INPUT OF SPECTRA ON LAST LATUTUDE
C                  OF A BLOCK. SPECTRA ARE SAVED FROM THE SECOND
C                  LATITUDE OF THE NEXT BLOCK.
C                  EACH PROPAGATION TIMESTEP THE FILES CONNECTED TO
C                  IU14 AND IU13 ARE INTERCHANGED.
C        *IU14*  - LOGICAL UNIT FOR OUTPUT (SEE IU13).
C        *IU15*  - LOGICAL UNIT FOR OUTPUT OF LAST WINDFIELDS FOR
C                  RESTART.
C        *IU16*  - LOGICAL UNIT FOR INPUT/OUTPUT OF COMMON REFDOT
C                  (SEE SUBS PROPDOT AND DOTDC)
C        *IU17*  - LOGICAL UNIT FOR BLOCK WINDINPUT (SEE SUB. IMPLSCH)
C        *IU18*  - LOGICAL UNIT FOR BLOCK WINDINPUT (SEE SUB. IMPLSCH)
C        *IU19*  - LOGICAL UNIT FOR OUTPUT OF OF BOUNDARY VALUES IF
C                  THIS IS A FINE GRID RUN.
C        *IU20*  - LOGICAL UNIT FOR OUTPUT OF INTEGRATED PARAMETERS
C                  OF THE TOTAL SPECTRUM.
C        *IU21*  - LOGICAL UNIT FOR OUTPUT OF INTEGRATED PARAMETERS
C                  OF SWELL AND WIND WAVES.
C        *IU25*  - LOGICAL UNIT FOR OUTPUT OF SPECTRA AT CERTAIN
C                  GRID POINTS.
C        *IU26*  - LOGICAL UNIT FOR OUTPUT OF SWELL SPECTRA AT
C                  CERTAIN GRID POINTS.
C        *IUVELO*- OUTPUT UNIT FOR BLOCKED WIND FIELDS.
C        *IUSCR* - SCRATCH UNITS FOR WIND PROCESSING.
C
C ----------------------------------------------------------------------
C
C*    *COMMON*  *WIND* - VARIABLES USED FOR WIND COMPUTATIONS.
C
C
      CHARACTER*12 IDA, IDAWIFL, IDATEWO, IDATEFL
C
      COMMON/ WIND/ U10NEW(NIBLO), U10OLD(NIBLO,NBLO),
     1              THWNEW(NIBLO), THWOLD(NIBLO,NBLO),
     2              USNEW (NIBLO), USOLD (NIBLO,NBLO),
     3              Z0NEW (NIBLO), Z0OLD (NIBLO,NBLO),
     4              TAUW(NIBLO,NBLO), IIG,
     5              IDA, IDATEWO, IDAWIFL, IDATEFL
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *IDA*       CHAR*12   DATE OF LAST WINDFIELD READ IN.
C      *IDATEWO*   CHAR*12   DATE OF NEXT WIND FIELD TO BE READ.
C      *IDAWIFL*   CHAR*12   DATE OF NEXT WIND FILE NAME.
C      *IDATEFL*   CHAR*12   DATE OF NEXT WIND FILE TO BE ACCESSED.
C      *IIG*       INTEGER   BLOCK NUMBER OF LAST WIND FIELD READ IN
C      *U10NEW*    REAL      NEW WIND SPEED IN M/S.
C      *U10OLD*    REAL      INTERMEDIATE STORAGE OF MODULUS OF WIND
C                            VELOCITY.
C      *THWNEW*    REAL      WIND DIRECTION IN RADIANS IN OCEANOGRAPHIC
C                            NOTATION (POINTING ANGLE OF WIND VECTOR,
C                            CLOCKWISE FROM NORTH).
C      *THWOLD*    REAL      INTERMEDIATE STORAGE OF ANGLE (RADIANS) OF
C                            WIND VELOCITY.
C      *USNEW*     REAL      NEW FRICTION VELOCITY IN M/S.
C      *USOLD*     REAL      INTERMEDIATE STORAGE OF MODULUS OF FRICTION
C                            VELOCITY.
C      *Z0NEW*     REAL      ROUGHNESS LENGTH IN M.
C      *Z0OLD*     REAL      INTERMEDIATE STORAGE OF ROUGHNESS LENGTH IN
C                            M.
C      *TAUW*      REAL      WAVE STRESS IN (M/S)**2
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *WNDGRD* -  INPUT WIND GRID SPECIFICATIONS.
C
      COMMON /WNDGRD/ DLAM, DPHI, RLATS, RLATN, RLONL, RLONR,
     1                KCOL, KROW, IWPER, ICODE, ICOORD
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *DLAM*      REAL      STEPSIZE BETWEEN LONGITUDES IN DEG.
C      *DPHI*      REAL      STEPSIZE BETWEEN LATITUDES  IN DEG.
C      *RLATS*     REAL      LATITUDE  AT (., 1) = SOUTHERN LATITUDE.
C      *RLATN*     REAL      LATITUDE  AT (.,NR) = NORTHERN LATITUDE.
C      *RLONL*     REAL      LONGITUDE AT ( 1,.) = WEST MOST LONGITUDE.
C      *RLONR*     REAL      LONGITUDE AT (NC,.) = EAST MOST LONGITUDE.
C      *KCOL*      INTEGER   NUMBER OF COLUMNES IN WIND INPUT (USED).
C      *KROW*      INTEGER   NUMBER OF ROWS     IN WIND INPUT (USED).
C      *ICODE*     INTEGER   WIND CODE 1 = USTAR;  2 = USTRESS; 3 = U10
C      *IWPER*     INTEGER   INDICATOR PERIODICAL GRID.
C                            0= NON-PERIODICAL;   1= PERIODICAL.
C      *ICOORD*    INTEGER   CODE FOR COORDINATE SYSTEM USED
C                            1= RECTANGULAR,EQUIDISTANT LON/LAT GRID.
C                            2= .......NOT IMPLEMENTED.
C
C ----------------------------------------------------------------------
C
C
      CHARACTER*12 IDTWIE, IDTWIS
C
C*    1. BEGIN AND END DATES OF WIND FIELDS TO BE PROCESSED.
C        ---------------------------------------------------
C
      IF (IDA.EQ.'000000000000') THEN
C
C        IF START FROM PRESET FIELDS DO FIRST FIELD IN ADDITION.
C
         IDTWIS = IDATEA
      ELSE
         IDTWIS = IDAWIFL
         IDELWH = -MAX(IDELPRO,IDELWI)+IDELWO
         CALL INCDATE (IDTWIS,IDELWH)
      ENDIF
      IF(IDAWIFL.LT.IDATEE)THEN
        IDTWIE = IDAWIFL
      ELSE
        IDTWIE = IDATEE
      ENDIF
C
C ----------------------------------------------------------------------
C
C*    2. PROCESS WIND FIELDS.
C        --------------------
C
 2000 CONTINUE
      IF (IDELWO.GE.IDELWI) THEN
C
C*    2.1 NO TIME INTERPOLATION.
C         ----------------------
C
         IF (ITEST.GE.2) THEN
            WRITE (IU06,*) '   SUB. PREWIND: WIND REQUEST'
            WRITE (IU06,*) '     NO TIME INTERPOLATION'
            WRITE (IU06,*) '     START OF PERIOD IS    IDTWIS = ',IDTWIS
            WRITE (IU06,*) '     END   OF PERIOD IS    IDTWIE = ',IDTWIE
            WRITE (IU06,*) '     WIND INPUT TIME STEP  IDELWI = ',IDELWI
            WRITE (IU06,*) '     WIND OUTPUT TIME STEP IDELWO = ',IDELWO
         ENDIF
         CALL NOTIM (IDTWIS, IDTWIE)
      ELSE
C
C*    2.2 TIME INTERPOLATION.
C         -------------------
C
         IF (ITEST.GE.2) THEN
            WRITE (IU06,*) '   SUB. PREWIND: WIND REQUEST'
            WRITE (IU06,*) '     TIME INTERPOLATION'
            WRITE (IU06,*) '     START OF PERIOD IS    IDTWIS = ',IDTWIS
            WRITE (IU06,*) '     END   OF PERIOD IS    IDTWIE = ',IDTWIE
            WRITE (IU06,*) '     WIND INPUT TIME STEP  IDELWI = ',IDELWI
            WRITE (IU06,*) '     WIND OUTPUT TIME STEP IDELWO = ',IDELWO
         ENDIF
         CALL TIMIN (IDTWIS, IDTWIE)
      ENDIF

      RETURN
      END
      SUBROUTINE READPRE (IU07, IREFRA)

C ----------------------------------------------------------------------
C
C**** *READPRE*  READ GRID OUTPUT FROM PREPROC.
C
C     H. GUNTHER      GKSS/ECMWF     MAY 1990
C
C*    PURPOSE.
C     --------
C
C       INPUT OF PREPROC GRID OUTPUT.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *READPRE (IU07, IREFRA)*
C          *IU07 *  - INPUT UNIT OF PREPROC GRID FILE.
C          *IREFRA *- REFRACTION OPTION.
C
C     METHOD.
C     -------
C
C       UNFORMATED READ FROM UNIT.
C
C     EXTERNALS.
C     ----------
C
C       NONE.
C
C     REFERENCE.
C     ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *COMMON* *COUPL* - PARAMETERS FOR COUPLING.
C
      COMMON /COUPL/ BETAMAX, ZALP, ALPHA, XKAPPA, XNLEV
C
C*    *COMMON* *CURRENT* - CURRENT FIELD.
C
      COMMON /CURRENT/ U(0:NIBLC,NBLC), V(0:NIBLC,NBLC)
C
C*    *COMMON* *FREDIR* - FREQUENCY AND DIRECTION GRID.
C
      COMMON /FREDIR/ FR(NFRE), DFIM(NFRE), GOM(NFRE), C(NFRE),
     1                DELTH, DELTR, TH(NANG), COSTH(NANG), SINTH(NANG)
C
C*    *COMMON* *GRIDPAR*  GENERAL GRID INFORMATION.
C
      COMMON /GRIDPAR/ DELPHI, DELLAM, SINPH(NGY), COSPH(NGY),
     1                 IGL, IJS(NBLO), IJL2(NBLO), IJLS(NBLO),
     2                 IJL(NBLO), IJLT(NBLO)
C
C*    *COMMON* *INDNL* - INDICES AND WEIGHTS USED IN THE COMPUTATION
C                        OF THE NONLINEAR TRANSFER RATE.
C
      COMMON /INDNL/ IKP(NFRE+4), IKP1(NFRE+4),
     1               IKM(NFRE+4), IKM1(NFRE+4),
     2               K1W(NANG,2), K2W(NANG,2), K11W(NANG,2),
     3               K21W(NANG,2), AF11(NFRE+4), FKLAP(NFRE+4),
     4               FKLAP1(NFRE+4), FKLAM(NFRE+4), FKLAM1(NFRE+4),
     5               ACL1, ACL2,  CL11, CL21, DAL1, DAL2, FRH(30)
C
C*    *COMMON* *MAP*  LON/LAT INDEX OF EACH SEA POINT.
C
      COMMON /MAP/ IXLG(NIBLO,NBLO), KXLT(NIBLO,NBLO), NX, NY, IPER,
     1             AMOWEP, AMOSOP, AMOEAP, AMONOP, XDELLA, XDELLO
C
C*    *COMMON* *COUT*  OUTPUT POINTS INDICES AND FLAGS.
C
      LOGICAL FFLAG(14), FFLAG20, FFLAG21, FFLAG25, FFLAG26,
     1        PFLAG(14), PFLAG20, PFLAG21, PFLAG25, PFLAG26
      COMMON /COUT/ NGOUT, IGAR(MOUTP), IJAR(MOUTP),
     1              NOUTT, IOUTT(MOUTT),
     2              FFLAG, FFLAG20, FFLAG21, FFLAG25, FFLAG26,
     3              PFLAG, PFLAG20, PFLAG21, PFLAG25, PFLAG26
C
C*    *COMMON* *SHALLOW*   SHALLOW WATER TABLES.
C
      PARAMETER (NDEPTH = 63)
C
      COMMON /SHALLOW/ DEPTH(NIBLO, NBLO), DEPTHA, DEPTHD,
     1                 TCGOND(NDEPTH,NFRE), TFAK(NDEPTH,NFRE),
     2                 TSIHKD(NDEPTH,NFRE), INDEP(NIBLO)
C
C*    *COMMON* *TABLE* - TABLE FOR TOTAL STRESS AND HIGH FREQ STRESS.
C
      PARAMETER (ITAUMAX=100, JUMAX=100, IUSTAR=100, IALPHA=100)
C
      COMMON /TABLE/ TAUT(0:ITAUMAX,0:JUMAX), DELTAUW, DELU,
     1               TAUHFT(0:IUSTAR,0:IALPHA), DELUST, DELALP
C
C ----------------------------------------------------------------------
C
C*    1. READ COMMON FREDIR (FREQUENCY DIRECTION GRID).
C        ----------------------------------------------
C
 1000 CONTINUE
      READ(IU07) FR, DFIM, GOM, C,
     1           DELTH, DELTR, TH, COSTH, SINTH
C
C*    2. READ COMMON GRIDPAR (GENERAL GRID ORGANISATION).
C        ------------------------------------------------
C
 2000 CONTINUE
      READ(IU07) DELPHI, DELLAM, SINPH, COSPH,
     1           IGL, IJS, IJL2, IJLS, IJL, IJLT
C
C*    3. READ COMMON MAP (LONG. AND LAT. INDICES OF GRID POINTS).
C        --------------------------------------------------------
C
 3000 CONTINUE
      READ(IU07) IXLG, KXLT, NX, NY, IPER,
     1           AMOWEP, AMOSOP, AMOEAP, AMONOP, XDELLA, XDELLO
C
C*    4. READ COMMON INDNL (NON-LINEAR INTERACTION).
C       --------------------------------------------
C
 4000 CONTINUE
      READ(IU07) IKP, IKP1, IKM, IKM1, K1W, K2W, K11W, K21W,
     1           AF11, FKLAP, FKLAP1, FKLAM, FKLAM1,
     2           ACL1, ACL2,  CL11, CL21, DAL1, DAL2, FRH
C
C*    5. READ COMMON COUPLE.
C        -------------------
C
 5000 CONTINUE
      READ(IU07) BETAMAX, ZALP, ALPHA, XKAPPA, XNLEV
C
C*    6. READ COMMON TABLE (INDICES OF OUTPUT POINTS).
C        ---------------------------------------------
C
 6000 CONTINUE
      READ(IU07) TAUT, DELTAUW, DELU, TAUHFT, DELUST, DELALP
C
C*    7. READ COMMON COUT (INDICES OF OUTPUT POINTS).
C        --------------------------------------------
C
 7000 CONTINUE
      READ(IU07)  NGOUT, IGAR, IJAR
C
C*    8. READ COMMON SHALLO (DEPTH AND SHALLOW WATER TABLES).
C        ----------------------------------------------------
C
 8000 CONTINUE
      READ(IU07)  DEPTH, DEPTHA, DEPTHD, TCGOND, TFAK, TSIHKD
C
C*    9. READ COMMON CURRENT.
C        --------------------
C
 9000 CONTINUE
      IF (IREFRA.EQ.2) READ(IU07)  U, V

      RETURN
      END

      SUBROUTINE READWND (IDTWIR, UWND, VWND, NC, NR)
C ----------------------------------------------------------------------
C
C**** *READWND* - PROGRAM TO GENERATE SWAMP WINDFIELDS.
C
C     HEINZ GUNTHER    ECMWF   OCTOBER 1989
C
C*    PURPOSE.
C     --------
C
C       TO GENERATE SWAMP WINDFIELDS.
C
C**   INTERFACE.
C     ----------
C
C       *CALL READWND (IDTWIR, UWND, VWND, NC, NR)*
C         *IDTWIR* - DATE/TIME OF THE DATA READ.
C         *UWND*  - HORIZONTAL WIND COMPONENTS.
C         *VWND*  - VERTICAL WIND COMPONENTS.
C         *NC*    - NUMBER OF COLUMNS IN INPUT WIND ARRAYS (DIMENSION).
C         *NR*    - NUMBER OF ROWS    IN INPUT WIND ARRAYS (DIMENSION).
C
C     METHOD.
C     -------
C
C       NONE.
C
C     EXTERNALS.
C     ----------
C
C       *INCDATE*   - INCREMENT DATE/TIME GROUP.
C
C ----------------------------------------------------------------------
C
C*    *COMMON* *STATUS* - TIME STATUS OF INTEGRATION, WIND INPUT,
C                         OUTPUT OF RESULTS, AND MODEL OPTIONS.
C
      CHARACTER*100 INDIRNAME
      CHARACTER*150 INWINDNAME
      COMMON /INDIR/  INDIRNAME
      CHARACTER*12 IDATEA, IDATEE, IDTPRO, IDTRES,
     &             IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
      COMMON /STATUS/ IDELPRO, IDELT, IDELWI, IDELWO,
     1                IREST, IDELRES, IDELINT, IDELINS,
     2                IDELSPT, IDELSPS,
     3                ICASE, ISHALLO, IREFRA,
     4                IDATEA, IDATEE, IDTPRO, IDTRES,
     5                IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/  IU06, ITEST, ITESTB
C
C*    *COMMON* *WNDGRD* -  INPUT WIND GRID SPECIFICATIONS.
C
      COMMON /WNDGRD/ DLAM, DPHI, RLATS, RLATN, RLONL, RLONR,
     1                KCOL, KROW, IWPER, ICODE, ICOORD
C
C*     VARIABLE.   TYPE.     PURPOSE.
C      ---------   -------   --------
C      *DLAM*      REAL      STEPSIZE BETWEEN LONGITUDES IN DEG.
C      *DPHI*      REAL      STEPSIZE BETWEEN LATITUDES  IN DEG.
C      *RLATS*     REAL      LATITUDE  AT (., 1) = SOUTHERN LATITUDE.
C      *RLATN*     REAL      LATITUDE  AT (.,NR) = NORTHERN LATITUDE.
C      *RLONL*     REAL      LONGITUDE AT ( 1,.) = WEST MOST LONGITUDE.
C      *RLONR*     REAL      LONGITUDE AT (NC,.) = EAST MOST LONGITUDE.
C      *KCOL*      INTEGER   NUMBER OF COLUMNES IN WIND INPUT (USED).
C      *KROW*      INTEGER   NUMBER OF ROWS     IN WIND INPUT (USED).
C      *ICODE*     INTEGER   WIND CODE 1 = USTAR;  2 = USTRESS; 3 = U10
C      *IWPER*     INTEGER   INDICATOR PERIODICAL GRID.
C                            0= NON-PERIODICAL;   1= PERIODICAL.
C      *ICOORD*    INTEGER   CODE FOR COORDINATE SYSTEM USED
C                            1= RECTANGULAR,EQUIDISTANT LON/LAT GRID.
C                            2= .......NOT IMPLEMENTED.
C
C ----------------------------------------------------------------------
C
      LOGICAL  FRSTIME
      DIMENSION UWND(NC,NR), VWND(NC,NR)
      DATA IU01 /3/
      DATA FRSTIME /.TRUE./
C
      CHARACTER * 12 IDTWIR
      CHARACTER LINE*150
C
C
C ----------------------------------------------------------------------
C
      INCLUDE 'windlatlon.h'

C*    0. OPEN CURRENT WIND FIELD
C
      IF (FRSTIME) THEN 
         IDTWIR = IDATEA
      ELSE
         CALL INCDATE(IDTWIR,IDELWI)
      ENDIF

      I = IECF_LEN(INDIRNAME)
      INWINDNAME=INDIRNAME(1:I)//'/'//IDTWIR(1:8)//'.dat'
      OPEN(IU01,FILE=INWINDNAME,STATUS='OLD',FORM='UNFORMATTED',
     +      IOSTAT=IERRCODE)
      IF(IERRCODE.GT.0) THEN
	 WRITE (IU06,*) ' *********************************************'
	 WRITE (IU06,*) ' *                                           *'
         WRITE (IU06,*) ' *      FATAL  ERROR IN SUB. READWND         *'
         WRITE (IU06,*) ' *      ============================         *'
	 WRITE (IU06,*) ' *                                           *'
         WRITE (IU06,*) ' * CAN NOT OPEN:  ', INWINDNAME
	 WRITE (IU06,*) ' * PROGRAM WILL BE ABORTED                   *'
	 WRITE (IU06,*) ' *********************************************'
	 CALL ABORT
      ENDIF
C
C ----------------------------------------------------------------------
C
C
C*    1. FOR FIRST CALL, DETERMINE DATES.
C        --------------------------------
C
      IF (FRSTIME) THEN
C
         ICODE = 3
         IDTWIR = IDATEA
         KCOL = NC
         KROW = NR
         IWPER = 0
         ICOORD = 1
         DLAM  = (RLONR-RLONL)/REAL(KCOL-1)
         DPHI  = (RLATN-RLATS)/REAL(KROW-1)
         FRSTIME = .FALSE.
         WRITE (IU06,*) '  '
         WRITE (IU06,*) ' SUB. READWND: WIND FILE HEADER READ'
         WRITE (IU06,*) ' WIND GRID SPECIFICATION ARE:'
         WRITE (IU06,*) ' NUMBER OF COLUMNS IN GRID KCOL = ', KCOL
         WRITE (IU06,*) ' NUMBER OF ROWS    IN GRID KROL = ', KROW
         WRITE (IU06,*) ' SOUTHERN MOST LATITUDE   RLATS = ', RLATS
         WRITE (IU06,*) ' NORTHERN MOST LATITUDE   RLATN = ', RLATN
         WRITE (IU06,*) ' WESTERN MOST LONGITUDE   RLONL = ', RLONL
         WRITE (IU06,*) ' EASTERN MOST LONGITUDE   RLONR = ', RLONR
         WRITE (IU06,*) ' COORDINATE SYSTEM CODE  ICOORD = ', ICOORD
         WRITE (IU06,*) ' PERIODIC GRID INDICATOR  IWPER = ', IWPER
         WRITE (IU06,*) ' LATITUDE  STEP IS         DPHI = ', DPHI
         WRITE (IU06,*) ' LONGITUDE STEP IS         DLAM = ', DLAM
C
C*    1.1 CHECK DIMENSIONS.
C         -----------------
C
         IF (KCOL*KROW.GT.NC*NR) THEN
            WRITE (IU06,*) ' *****************************************'
            WRITE (IU06,*) ' *                                       *'
            WRITE (IU06,*) ' *       FATAL ERROR IN SUB. READWND     *'
            WRITE (IU06,*) ' *       ===========================     *'
            WRITE (IU06,*) ' * DIMENSION OF WIND ARRAY IS TO SMALL   *'
            WRITE (IU06,*) ' * DIMENSION WIND ARRAY IS     NC*NR = ',
     1                     NC*NR
            WRITE (IU06,*) ' * DIMENSION REQUESTED IS KCOL*KROW = ',
     1                     KCOL*KROW
            WRITE (IU06,*) ' * CHANGE PARAMETER STATEMENT IN WAVMDL  *'
            WRITE (IU06,*) ' * VALUES HAVE TO BE:                    *'
            WRITE (IU06,*) ' *      NC = ', KCOL
            WRITE (IU06,*) ' *      NR = ', KROW
            WRITE (IU06,*) ' *                                       *'
            WRITE (IU06,*) ' *   PROGRAM ABORTS  PROGRAM ABORTS      *'
            WRITE (IU06,*) ' *                                       *'
            WRITE (IU06,*) ' *****************************************'
            CALL ABORT
         ENDIF
         IF (KROW.LT.2 .OR. KCOL.LT.2) THEN
            WRITE (IU06,*) ' *****************************************'
            WRITE (IU06,*) ' *                                       *'
            WRITE (IU06,*) ' *       FATAL ERROR IN SUB. READWND     *'
            WRITE (IU06,*) ' *       ===========================     *'
            WRITE (IU06,*) ' * DIMENSIONS OF WIND INPUT GRID ARE     *'
            WRITE (IU06,*) ' * LESS THAN 2.                          *'
            WRITE (IU06,*) ' * NUMBER OF COLUMNS   KCOL = ', KCOL
            WRITE (IU06,*) ' * NUMBER OF ROWS      KROW = ', KROW
            WRITE (IU06,*) ' * CHECK WIND INPUT AND MAKE SURE, THAT  *'
            WRITE (IU06,*) ' * PARAMETER STATEMENT IN WAVMDL IS OK   *'
            WRITE (IU06,*) ' *                                       *'
            WRITE (IU06,*) ' *   PROGRAM ABORTS  PROGRAM ABORTS      *'
            WRITE (IU06,*) ' *                                       *'
            WRITE (IU06,*) ' *****************************************'
            CALL ABORT
         ENDIF
      ENDIF
C     
      READ  (IU01,ERR=3300, END=3300, IOSTAT=IOS) UWND,VWND

      CLOSE (UNIT=IU01, STATUS='KEEP')
C
C ----------------------------------------------------------------------
C
C*    4. WRITE TEST OUTPUT.
C        ------------------
C
         WRITE(IU06,*) ' READWND -  WIND FIELD FOR THE IDTWIR = ',
     1                  IDTWIR
         WRITE(IU06,*)  '~~~ U Component From West to East ~~~'
         DO 3250 J=NR,1,-1
         WRITE(*,*) 'J=',J
         WRITE(IU06,66) (UWND(I,J),I=1,NC)
 3250    CONTINUE
         WRITE(IU06,*)  '~~~ V Component From South to North ~~~'
         DO 3260 J=NR,1,-1
         WRITE(*,*) 'J=',J
         WRITE(IU06,66) (VWND(I,J),I=1,NC)
 3260    CONTINUE
 66      FORMAT(1X,20F5.1)

      RETURN

 3300 CONTINUE
         WRITE (IU06,*) ' *****************************************'
         WRITE (IU06,*) ' *                                       *'
         WRITE (IU06,*) ' *       FATAL ERROR IN SUB. READWND     *'
         WRITE (IU06,*) ' *       ===========================     *'
         WRITE (IU06,*) ' * READ ERROR OR EOF ON WIND FILE:       *'
         WRITE (IU06,*) ' * DATE OF WIND INPUT IS IDTWIR = ', IDTWIR
         WRITE (IU06,*) ' * PROGRAM TRIES TO READ STRING [ ', 
     +   LINE,' ] IOS=',IOS
         WRITE (IU06,*) ' *                                       *'
         WRITE (IU06,*) ' *   PROGRAM ABORTS  PROGRAM ABORTS      *'
         WRITE (IU06,*) ' *                                       *'
         WRITE (IU06,*) ' *****************************************'
         CALL ABORT

      END

      SUBROUTINE SPECTRA (IJS, IJL, IG)

C ----------------------------------------------------------------------
C
C**** *SPECTRA*  - COMPUTATION OF 2-D SPECTRA FOR ONE BLOCK.
C
C     S. HASSELMANN  - JULY 1990
C     H. GUNTHER     - DECEMBER 1990   MODIFIED FOR CYCLE_4.
C
C*    PURPOSE.
C     --------
C
C       INITIALISATION OF A BLOCK BY 2-D SPECTRA.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *SPECTRA (IJS, IJL, IG)*
C          *IJS*     INTEGER  FIRST POINT IN BLOCK.
C          *IJL*     INTEGER  LAST  POINT IN BLOCK.
C          *IG*      INTEGER  BLOCK NUMBER.
C
C     METHOD.
C     -------
C       1-D JONSWAP SPECTRA AND COSINE**2 SPREADING FUNCTIONS ARE
C       COMPUTED FROM GIVEN WINDS AND PARAMETERS AT EACH GRID POINT.
C       THE 1-D SPECTRA ARE SPREAD OVER THE DIRECTIONS BY MULTIPLICATION
C       WITH THE SPREADING FUNCTION.
C
C     EXTERNALS.
C     ----------
C
C       *SPT*       - COMPUTATION OF COS**2 SPREADING FUNCTION.
C
C
C     REFERENCES.
C     -----------
C
C       K.HASSELMAN,D.B.ROSS,P.MUELLER AND W.SWELL
C          A PARAMETRIC WAVE PREDICTION MODEL
C          JOURNAL OF PHYSICAL OCEANOGRAPHY, VOL. 6, NO. 2, MARCH 1976
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *COMMON* *FREDIR* - FREQUENCY AND DIRECTION GRID.
C
      COMMON /FREDIR/ FR(NFRE), DFIM(NFRE), GOM(NFRE), C(NFRE),
     1                DELTH, DELTR, TH(NANG), COSTH(NANG), SINTH(NANG)
C
C*    *COMMON*  *JONS* - JONSWAP PARAMETERS.
C
      COMMON /JONS/ FP(NIBLO), ALPHJ(NIBLO), THES(NIBLO),
     1              FM, ALFA, GAMMA, SA, SB, THETAQ
C
C*    *COMMON*  *WIND* - VARIABLES USED FOR WIND COMPUTATIONS.
C
C
      CHARACTER*12 IDA, IDAWIFL, IDATEWO, IDATEFL
C
      COMMON/ WIND/ U10NEW(NIBLO), U10OLD(NIBLO,NBLO),
     1              THWNEW(NIBLO), THWOLD(NIBLO,NBLO),
     2              USNEW (NIBLO), USOLD (NIBLO,NBLO),
     3              Z0NEW (NIBLO), Z0OLD (NIBLO,NBLO),
     4              TAUW(NIBLO,NBLO), IIG,
     5              IDA, IDATEWO, IDAWIFL, IDATEFL
C
C*    *COMMON* *SPE1* - A BLOCK OF SPECTRA.
C
      COMMON /SPE1/ FL1(0:NIBLO,NANG,NFRE)
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER* OF GLOBAL CONSTANTS.
C
      PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000.,
     1           ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI,
     2           R = CIRC/ZPI)
C
      DIMENSION ST(NIBLO,NANG), ET(NIBLO,NFRE), STH(NANG)
C
      PIRHF(F,ALF)=ALF*G**2/(ZPI**4*F**5)
C
C ----------------------------------------------------------------------
C
C*    1. COMPUTE JONSWAP SPECTRUM.
C        -------------------------
C
 1000 CONTINUE
C
      DO 1001 M=1,NFRE
         DO 1002 IJ=IJS,IJL
            IF (FP(IJ).NE.0.) THEN
               FRH = FR(M)
               SIGMA = SA
               IF (FRH.GT.FP(IJ)) SIGMA = SB
               EARG = .5*((FRH-FP(IJ)) / (SIGMA*FP(IJ)))**2
               FJON = 1
               IF (EARG.LT.99.) FJON = GAMMA**EXP(-EARG)
               FMPF = 1.25*(FP(IJ)/FRH)**4
               FJONH = 0.
               IF (FMPF.LT.99.) FJONH = EXP(-FMPF)
               ET(IJ,M) = PIRHF(FRH,ALPHJ(IJ))*FJONH*FJON
            ELSE
               ET(IJ,M) = 0.
            ENDIF
 1002    CONTINUE
 1001 CONTINUE
C
C ----------------------------------------------------------------------
C
C*    2. COMPUTATION OF SPREADING FUNCTION.
C        ----------------------------------
C
 2000 CONTINUE
C
      DO 2001 IJ=IJS,IJL
         CALL SPR (NANG, NANG, THES(IJ), TH, STH)
         DO 2002 K=1,NANG
            ST(IJ,K) = STH(K)
 2002    CONTINUE
 2001 CONTINUE
C
C ----------------------------------------------------------------------
C
C*    3. COMPUTATION OF 2-D SPECTRUM.
C        ----------------------------
C
 3000 CONTINUE
C
      DO 3001 M=1,NFRE
         DO 3002 K=1,NANG
            DO 3003 IJ=IJS,IJL
               FL1(IJ,K,M) = ET(IJ,M)*ST(IJ,K)
 3003       CONTINUE
 3002    CONTINUE
 3001 CONTINUE
C
      RETURN
      END
      SUBROUTINE SPLITBL (FL, IJA, IJE, IU14)

C ----------------------------------------------------------------------
C
C**** *SPLITBL*   SAVES SECOND LATITUDE OF BLOCK IG
C****             FOR BLOCK IG-1 FOR COMPUTATION OF NEXT TIME STEP.
C
C     H. GUNTHER       GKSS/ECMWF         SEPTEMBER 1989
C
C*    PURPOSE.
C     --------
C
C       INTERMEDIATE STORAGE OF WAVE INFORMATION FOR USE
C       AT NEXT TIME STEP (SEE SUB FILLBL).
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *SPLITBL (FL, IJA, IJE, IU14)*
C          *FL*      REAL ARRAY   BLOCK OF SPECTRA
C          *IJA*     INTEGER      FIRST GRID POINT TO BE SAVED.
C          *IJE*     INTEGER      LAST  GRID POINT TO BE SAVED.
C          *IU14*    INTEGER      UNIT FOR OUTPUT OF SECOND LATITUDE.
C
C     EXTERNALS.
C     ----------
C
C       NONE.
C
C     METHOD.
C     -------
C
C       UNFORMATED WRITE TO SPECIFIED UNIT.
C
C     REFERENCE.
C     ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C ----------------------------------------------------------------------
C
      DIMENSION FL(0:NIBLO,NANG,NFRE)
C
C ----------------------------------------------------------------------
C
C*    1. OUTPUT OF SECOND LATITUDE OF BLOCK FOR LAST
C        LATITUDE OF PREVIOUS BLOCK.
C        ---------------------------------------------
C
 1000 CONTINUE
      WRITE(IU14) (((FL(IJ,K,M),IJ=IJA,IJE),K=1,NANG),M=1,NFRE)

      RETURN
      END
      SUBROUTINE SPR (KL, NANG, THETAQ, THETA, ST)

C ----------------------------------------------------------------------
C
C**** *SPR* - ROUTINE TO COMPUTE SPREADING FACTOR.
C
C     SUSANNE HASSELMANN  JULY 1986.
C
C*    PURPOSE.
C     --------
C
C       COMPUTATION OF COS**2 SPREADING FUNCTION.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *SPR (KL, NANG, THETAQ, THETA, ST)*
C          *KL*      INTEGER  NUMBER OF ANGULAR INTERVALS
C          *NANG*    INTEGER  DIMENSION FOR ANGULAR INTERVALS
C          *THETAQ*  REAL     MEAN WAVE DIRECTION
C          *THETA*   REAL     ANGULAR DIRECTIONS
C          *ST*      REAL     SPREADING FUNCTION
C
C     METHOD.
C     -------
C
C       NONE.
C
C     EXTERNALS.
C     ----------
C
C       NONE.
C
C
C     REFERENCES.
C     -----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
      DIMENSION THETA(NANG), ST(NANG)
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER* OF GLOBAL CONSTANTS.
C
      PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000.,
     1           ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI,
     2           R = CIRC/ZPI)
C
      PARAMETER (PIH = PI/2., PIH3=3.*PI/2., ZDP=2./PI)
C
C     SPREAD FCT. WITH COS**2.
C
      DO 250 K=1,KL
         THE = COS(THETA(K)-THETAQ)
         IF (THE.GT.0.) THEN
            ST(K) = ZDP*THE**2
            IF(ST(K).LT.0.1E-08) ST(K)=0.
         ELSE
            ST(K) = 0.
         ENDIF
  250 CONTINUE

      RETURN
      END
      SUBROUTINE TIMIN (IDTWIS, IDTWIE)

C ----------------------------------------------------------------------
C
C**** *TIMIN* - STEERING MODULE IF TIME INTERPOLATION IS WANTED.
C
C     H. GUNTHER    ECMWF    MAY 1990     MODIFIED FOR SUB VERSION.
C     H. GUNTHER    ECMWF    DECEMBER 90  MODIFIED FOR CYCLE_4.
C
C*    PURPOSE.
C     --------
C
C       TIME INTERPOLATION: PROCESS WINDFIELDS.
C
C**   INTERFACE.
C     ----------
C
C       *CALL* *TIMIN (IDTWIS, IDTWIE, NC, NR)*
C          *IDTWIS* - DATE OF FIRST WIND FIELD
C          *IDTWIE* - DATE OF LAST FIRST WIND FIELD
C          *NC*     - NUMBER OF COLUMNES IN INPUT WIND
C          *NR*     - NUMBER OF ROWS     IN INPUT WIND
C
C     METHOD.
C     -------
C
C       WINDFIELDS ARE READ IN EVERY IDELWI SECONDS (U,V),
C       INTERPOLATED IN SPACE, BLOCKED AND SAVED ON SCRATCH UNITS.
C       MAGNITUDE AND DIRECTION ARE INTERPOLATED LINEARLY IN TIME AND
C       WRITTEN TO THE OUTPUT FILES.
C
C     EXTERNALS.
C     ----------
C
C       *ABORT*     - TERMINATES PROCESSING.
C       *AIRSEA*    - TOTAL STRESS IN SURFACE LAYER.
C       *CREWFN*    - ASSIGN A FILE NAME.
C       *GETWND*    - READ A WINDFIELD (UWND,VWND) AND COMPUTE WIND
C                     FOR ALL BLOCKS (US,DS).
C       *INCDATE*   - INCREMENT DATE.
C       *LOCINT*    - SPACE INTERPOLATION.
C
C     REFERENCE.
C     ----------
C
C       NONE.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *PARAMETER*  FOR WIND INPUT ARRAY DIMENSIONS.
C
       INCLUDE 'wind.h'
C*    *COMMON* *GRIDPAR*  GENERAL GRID INFORMATION.
C
      COMMON /GRIDPAR/ DELPHI, DELLAM, SINPH(NGY), COSPH(NGY),
     1                 IGL, IJS(NBLO), IJL2(NBLO), IJLS(NBLO),
     2                 IJL(NBLO), IJLT(NBLO)
C
C*    *COMMON* *STATUS* - TIME STATUS OF INTEGRATION, WIND INPUT,
C                         OUTPUT OF RESULTS, AND MODEL OPTIONS.
C
      CHARACTER*12 IDATEA, IDATEE, IDTPRO, IDTRES,
     &             IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
      COMMON /STATUS/ IDELPRO, IDELT, IDELWI, IDELWO,
     1                IREST, IDELRES, IDELINT, IDELINS,
     2                IDELSPT, IDELSPS,
     3                ICASE, ISHALLO, IREFRA,
     4                IDATEA, IDATEE, IDTPRO, IDTRES,
     5                IDTINTT, IDTINTS, IDTSPT, IDTSPS
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/ IU06, ITEST, ITESTB
C
C*    *COMMON*  *UNITS* - INPUT / OUTPUT UNITS.
C
      COMMON /UNITS/ IU02, IU08, IU11, IU12, IU13, IU14, IU15, IU16,
     1               IU17, IU18, IU19, IU20, IU21, IU25, IU26, IUVELO,
     2               IUSCR(NBLO)
C
C*    *COMMON*  *WIND* - VARIABLES USED FOR WIND COMPUTATIONS.
C
C
      CHARACTER*12 IDA, IDAWIFL, IDATEWO, IDATEFL
C
      COMMON/ WIND/ U10NEW(NIBLO), U10OLD(NIBLO,NBLO),
     1              THWNEW(NIBLO), THWOLD(NIBLO,NBLO),
     2              USNEW (NIBLO), USOLD (NIBLO,NBLO),
     3              Z0NEW (NIBLO), Z0OLD (NIBLO,NBLO),
     4              TAUW(NIBLO,NBLO), IIG,
     5              IDA, IDATEWO, IDAWIFL, IDATEFL
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER* OF GLOBAL CONSTANTS.
C
      PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000.,
     1           ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI,
     2           R = CIRC/ZPI)
C
      DIMENSION  UWND(NC,NR), VWND(NC,NR)
C
      CHARACTER*12 IDTWIE, IDTH, IDT1, IDT2, IDTWIS
C
      DIMENSION  US(NIBLO,NBLO), DS(NIBLO,NBLO)
      DIMENSION  US2(NIBLO,NBLO), DS2(NIBLO,NBLO)
      DIMENSION  US3(NIBLO), DS3(NIBLO)
C
C        *UWND*   REAL   INPUT WIND FIELD ARRAY (U COMPONENT)
C        *VWND    REAL   INPUT WIND FIELD ARRAY (V COMPONENT)
C        *US*     REAL   OUTPUT WIND FIELD (FRICTION VELOCITIES).
C        *DS*     REAL   OUTPUT WIND FIELD (DIRECTIONS).
C
C ----------------------------------------------------------------------
C
C*    1. INITIALIZE TIMECOUNTER.
C        -----------------------
C
 1000 CONTINUE
      IF (IDA.EQ.'000000000000') THEN
         IDT1 = IDTWIS
         CALL GETWND (US, DS, IDT1, UWND, VWND, NC, NR)
         DO 1001 IG=1,IGL
         DO 1001 IJ=IJS(IG),IJL(IG)
            U10OLD(IJ,IG) = US(IJ,IG)
            THWOLD(IJ,IG) = DS(IJ,IG)
 1001    CONTINUE
         DO 1002 IG = 1,IGL
            CALL AIRSEA (U10OLD(1,IG), TAUW(1,IG),
     1                   USOLD(1,IG), Z0OLD(1,IG), IJS(IG), IJL(IG))
 1002    CONTINUE
         IF (ITEST.GE.3) THEN
            WRITE(IU06,'(''       SUB. TIMIN: FIRST WIND FIELD '',
     1                ''SAVED IN COMMON WIND'')')
         ENDIF
      ELSE
         IDT1 = IDA
         DO 1003 IG=1,IGL
         DO 1003 IJ=IJS(IG),IJL(IG)
            US(IJ,IG) = U10OLD(IJ,IG)
            DS(IJ,IG) = THWOLD(IJ,IG)
 1003    CONTINUE
         IDTH = IDT1
         CALL INCDATE (IDTH,IDELWO)
         IF (IDTWIS.NE.IDTH) THEN
            WRITE(IU06,*) ' *******************************************'
            WRITE(IU06,*) ' *                                         *'
            WRITE(IU06,*) ' *        FATAL ERROR IN --TIMIN--         *'
            WRITE(IU06,*) ' *        =========================        *'
            WRITE(IU06,*) ' * DATES DO NOT MATCH.                     *'
            WRITE(IU06,*) ' * START DATE FOR WIND IS       IDTWIS = ',
     1                        IDTWIS
            WRITE(IU06,*) ' * LAST DATE SAVED IN COM WIND IS IDT1 = ',
     1                       IDT1
            WRITE(IU06,*) ' * PROCESSING WILL BE ABORTED              *'
            WRITE(IU06,*) ' *                                         *'
            WRITE(IU06,*) ' *******************************************'
            CALL ABORT
         ENDIF
      ENDIF
      IDT2 = IDT1
      CALL INCDATE(IDT2,IDELWI)

      NTS = IDELWI/IDELWO
      DEL = REAL(IDELWO)/REAL(IDELWI)
      CALL CREWFN (IUVELO, IDTWIE)
      IF (ITEST.GE.3) THEN
         WRITE(IU06,*) '       SUB. TIMIN: NEW WIND FILE '
         WRITE(IU06,*) '       UNIT IS IUVELO = ', IUVELO,
     1                 ' WIND FILE DATE IS IDTWIE = ', IDTWIE
      ENDIF
      REWIND (UNIT=IUVELO)
C
C*    2. LOOP OVER INPUT WINDFIELDS.
C        ---------------------------
C
 2000 CONTINUE
C
C*    2.1 READ ONE WINDFIELD AND TRANSFORM ALL BLOCKS.
C         -------------------------------------------
C
      IDT2 = IDT1
      CALL INCDATE(IDT2,IDELWI)
      CALL GETWND (US2, DS2, IDT2, UWND, VWND, NC, NR)
C
C*    2.2 SAVE BLOCKED WIND FIELD ON SCRATCH UNITS.
C         -----------------------------------------
C
      DO 2201 IG=1,IGL
         IUNIT =IUSCR(IG)
         IDTH = IDT1
         DO 2202 N=1,NTS
            CALL INCDATE(IDTH,IDELWO)
            DO 2203 IJ=IJS(IG),IJL(IG)
               US3(IJ) = US(IJ,IG)+REAL(N)*DEL*(US2(IJ,IG)-US(IJ,IG))
               D = DS2(IJ,IG)-DS(IJ,IG)
               IF (ABS(D).GT.PI) D = D-ZPI*SIGN(1.,D)
               D = DS(IJ,IG)+REAL(N)*DEL*D
               DS3(IJ) = MOD(D+ZPI,ZPI)
 2203       CONTINUE
            WRITE (IUNIT,ERR=6100,IOSTAT=IOS)
     1             IDTH, IG, (US3(I),I=1,NIBLO), (DS3(I),I=1,NIBLO)
 2202    CONTINUE
         DO 2204 IJ=IJS(IG),IJL(IG)
            US(IJ,IG) = US2(IJ,IG)
            DS(IJ,IG) = DS2(IJ,IG)
 2204    CONTINUE
 2201 CONTINUE
      IDT1 = IDT2
      IF (ITEST.GE.3) THEN
         WRITE(IU06,*) '       SUB. TIMIN: LAST WIND FIELD AT ',
     1                 'IDTH = ', IDTH,' WRITTEN TO SCRATCH UNITS'
      ENDIF
C
C*    2.3 UPDATE WIND FIELD REQUEST TIME AND READ NEXT IF REQUESTED.
C         ----------------------------------------------------------
C
         CALL INCDATE (IDTH,IDELWI)
         IF (IDTH.LE.IDTWIE) GOTO 2000
C
C ----------------------------------------------------------------------
C
C*    3. REWIND SCRATCH UNITS.
C        ---------------------
C
 3000 CONTINUE
      DO 3001 IG=1,IGL
         IUNIT = IUSCR(IG)
         REWIND (UNIT=IUNIT)
 3001 CONTINUE
C
C ----------------------------------------------------------------------
C
C*    4. RE-ARRANG THE BLOCKS.
C        ---------------------
C
 4000 CONTINUE
      MP = MAX(IDELWI,IDELPRO)/IDELWO
      MSTEP = MAX(1,IDELPRO/IDELWO)
C
C*    4.1 LOOP OVER WIND FILES.
C         ---------------------
C
      DO 4101 M=1,MP,MSTEP
C
C*    4.1.1 LOOP OVER BLOCKS.
C           -----------------
C
         DO 4102 IG=1,IGL
            IUNIT = IUSCR(IG)
C
C*    4.1.1.1 LOOP OVER WIND FIELDS.
C             ----------------------
C
            DO 4103 MM=1,MSTEP
               READ (IUNIT,END=6200,IOSTAT=IOS)
     1            IDTH, IGG, (US(I,IG),I=1,NIBLO), (DS(I,IG),I=1,NIBLO)
               IF (IDTH.GE.IDTWIS)
     1            WRITE (IUVELO,ERR=6300,IOSTAT=IOS)
     2            IDTH, IGG, (US(I,IG),I=1,NIBLO), (DS(I,IG),I=1,NIBLO)
 4103       CONTINUE
 4102    CONTINUE
 4101 CONTINUE
      DO 4104 IG=1,IGL
         CLOSE (UNIT=IUSCR(IG) , STATUS='DELETE')
 4104 CONTINUE
      CLOSE (UNIT=IUVELO, STATUS='KEEP')
      IF (ITEST.GE.3) THEN
         WRITE(IU06,*) '       SUB. TIMIN: LAST WIND FIELD AT ',
     1                 'IDTH = ', IDTH,' WRITTEN TO OUTPUT UNIT'
      ENDIF

      RETURN
C
C ----------------------------------------------------------------------
C
C*    6. ERROR MESSAGES
C
 6100 CONTINUE
         WRITE (IU06,*) ' '
         WRITE (IU06,*) ' ********************************************'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' *       FATAL ERROR IN SUB. TIMIN:         *'
         WRITE (IU06,*) ' *       ==========================         *'
         WRITE (IU06,*) ' * ERROR WHEN WRITTING ON SCRATCH UNIT      *'
         WRITE (IU06,*) ' * FOR BLOCK NUMBER        IG = ', IG
         WRITE (IU06,*) ' * NUMBER OF WIND FIELD IS  N = ', N
         WRITE (IU06,*) ' * DATE OF WIND FIELD IS IDTH = ', IDTH
         WRITE (IU06,*) ' * MESSAGE IS             IOS = ', IOS
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' * PROGRAM ABORTS    PROGRAM ABORTS         *'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' ********************************************'
         CALL ABORT
 6200    CONTINUE
         WRITE (IU06,*) ' '
         WRITE (IU06,*) ' ********************************************'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' *       FATAL ERROR IN SUB. TIMIN:         *'
         WRITE (IU06,*) ' *       ==========================         *'
         WRITE (IU06,*) ' * ERROR WHEN READING FROM SCRATCH UNIT     *'
         WRITE (IU06,*) ' * FOR BLOCK NUMBER        IG = ', IG
         WRITE (IU06,*) ' * DATE OF WIND FIELD IS IDTH = ', IDTH
         WRITE (IU06,*) ' * MESSAGE IS             IOS = ', IOS
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' * PROGRAM ABORTS    PROGRAM ABORTS         *'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' ********************************************'
         CALL ABORT
 6300 CONTINUE
         WRITE (IU06,*) ' '
         WRITE (IU06,*) ' ********************************************'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' *       FATAL ERROR IN SUB. TIMIN:         *'
         WRITE (IU06,*) ' *       ==========================         *'
         WRITE (IU06,*) ' * ERROR WHEN WRITTING ON WIND OUTPUT FILE  *'
         WRITE (IU06,*) ' * FOR BLOCK NUMBER       IG  = ', IG
         WRITE (IU06,*) ' * DATE OF WIND FIELD IS IDTH = ', IDTH
         WRITE (IU06,*) ' * MESSAGE IS            IOS  = ', IOS
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' * PROGRAM ABORTS    PROGRAM ABORTS         *'
         WRITE (IU06,*) ' *                                          *'
         WRITE (IU06,*) ' ********************************************'
         CALL ABORT

      END
      SUBROUTINE WAMWND (US, DS, UWND, VWND, NC, NR)

C ----------------------------------------------------------------------
C
C**** *WAMWND* - TRANSFORMS INPUT WINDS TO BLOCKED WAM POINTS.
C
C
C*    PURPOSE.
C     --------
C
C       INTERPOLATE AND CONVERT INPUT WINDS TO WAM WINDS FOR ALL
C       POINTS IN THE GRID.
C
C**   INTERFACE.
C     ----------
C
C       *CALL WAMWND (US, DS, UWND, VWND, NC, NR)*
C          *US*   - INTERPOLATED WINDS IN ALL POINTS AND BLOCKS.
C          *DS*   - INTERPOLATED WIND DIRECTION IN ALL POINTS.
C          *UWND* - INPUT WIND : U COMPONENT.
C          *VWND* - INPUT WIND : V COMPONENT.
C          *NC*   - DIMENSION OF IN INPUT WIND ARRAYS (COLUMNS).
C          *NR*   - DIMENSION OF IN INPUT WIND ARRAYS (ROWS).
C
C
C     METHOD.
C     -------
C
C       THE INPUT WINDS ARE INTERPOLATED TO THE WAVE MODEL GRID POINTS
C       IN BLOCKED FORMAT. THE INTERPOLATED VALUES ARE TRANSFORMED TO
C       MAGNITUDE AND DIRECTION. INPUT MAY BE WIND IN 10M HEIGHT ,
C       SURFACE WINDS OR FRICTION VELOCETIES. THE INPUT GRID HAS TO BE
C       A LATITUDE/LONGITUDE GRID EITHER PERIODIC OR NON PERIODIC.
C
C     EXTERNALS.
C     ----------
C
C       *LOCINT*    - LOCATES WAM POINT IN INPUT GRID AND INTERPOLATES.
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER*  FOR ARRAY DIMENSIONS.
C
      INCLUDE 'presetwk.h'
C
C*    *COMMON* *GRIDPAR*  GENERAL GRID INFORMATION.
C
      COMMON /GRIDPAR/ DELPHI, DELLAM, SINPH(NGY), COSPH(NGY),
     1                 IGL, IJS(NBLO), IJL2(NBLO), IJLS(NBLO),
     2                 IJL(NBLO), IJLT(NBLO)
C
C*    *COMMON* *TESTO* - PRINTER OUTPUT UNIT AND TEST FLAGS.
C
      COMMON /TESTO/ IU06, ITEST, ITESTB
C
C*    *COMMON* *WNDGRD* -  INPUT WIND GRID SPECIFICATIONS.
C
      COMMON /WNDGRD/ DLAM, DPHI, RLATS, RLATN, RLONL, RLONR,
     1                KCOL, KROW, IWPER, ICODE, ICOORD
C
C ----------------------------------------------------------------------
C
C*    *PARAMETER* OF GLOBAL CONSTANTS.
C
      PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000.,
     1           ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI,
     2           R = CIRC/ZPI)
C
      PARAMETER (ROAIR = 1.225)
      PARAMETER (XKAPPA = 0.41, ALPHACH = 0.0185)
C
      DIMENSION US(NIBLO,NBLO), DS(NIBLO,NBLO)
      DIMENSION UWND(NC,NR), VWND(NC,NR)
C
CDIR$ VFUNCTION ALOGHF
C
C ----------------------------------------------------------------------
C
C*    1. INITIALISE WIND ARRAYS WITH ZERO
C        --------------------------------
C
 1000 CONTINUE
      DO 1001 IG=1,NBLO
         DO 1001 IJ = 1,NIBLO
            US(IJ,IG) = 0.
            DS(IJ,IG) = 0.
 1001 CONTINUE
      print*,'WAMWND ',NIBLO,NBLO,NC,NR
C
C ----------------------------------------------------------------------
C
C*    2. INTERPOLATE INPUT WINDS TO WAVEMODEL GRID.
C        ------------------------------------------
C
 2000 CONTINUE
      DO 2001 IG=1,IGL
C
C*    2.1 INTERPOLATE ONE BLOCK IN SPACE.
C         ------------------------------
C
         CALL LOCINT (IG, IJS(IG), IJL(IG), NC, NR, KCOL, KROW, IWPER,
     1         DLAM, DPHI, RLONL, RLATS, UWND, VWND, US(1,IG), DS(1,IG))
 2001 CONTINUE
C
C ----------------------------------------------------------------------
C
C*    3. PROCESS WINDS ACCORDING TO TYPE
C        NOTHING TO DO FOR WIND SPEED U10 (ICODE = 3).
C        ---------------------------------------------
C
 3000 CONTINUE
C
C*    3.1 TRANSFORM TO MAGNITUDE AND DIRECTION.
C         -------------------------------------
C
      DO 3101 IG = 1,IGL
         DO 3102 IJ = IJS(IG),IJL(IG)
            UU = US(IJ,IG)
            VV = DS(IJ,IG)
            US(IJ,IG) = SQRT(UU**2 + VV**2)
            IF (US(IJ,IG).NE.0.) DS(IJ,IG) = ATAN2(UU,VV)
            IF (DS(IJ,IG).LT.0.) DS(IJ,IG) = DS(IJ,IG) + ZPI
 3102    CONTINUE
 3101 CONTINUE
C
      IF (ICODE.EQ.1) THEN
C
C*    3.2  INPUT IS FRICTION VELOCITY.
C          ---------------------------
C
         DO 3201 IG = 1,IGL
            DO 3202 IJ = IJS(IG),IJL(IG)
               USTAR = MAX(0.01,US(IJ,IG))
               Z0  = ALPHACH/G*USTAR**2
               CD  = XKAPPA/ALOG(10./Z0)
               US(IJ,IG) = USTAR/CD
 3202       CONTINUE
 3201    CONTINUE
C
      ELSE IF (ICODE.EQ.2) THEN
C
C*    3.3 INPUT WINDS ARE SURFACE STRESSES.
C         ---------------------------------
C
         DO 3301 IG = 1,IGL
            DO 3302 IJ = IJS(IG),IJL(IG)
               USTAR = MAX (0.01, SQRT(US(IJ,IG)/ROAIR))
               Z0  = ALPHACH/G*USTAR**2
               CD  = XKAPPA/ALOG(10./Z0)
               US(IJ,IG) = USTAR/CD
 3302       CONTINUE
 3301    CONTINUE
      ENDIF
C
C*    4. TEST OUTPUT OF WAVE MODEL BLOCKS
C        ---------------------------------
C
 4000 CONTINUE
      IF (ITEST.GE.3) THEN
          WRITE (IU06,*) ' '
          WRITE (IU06,*) '      SUB. WAMWND:',
     1                   ' WINDFIELDS CONVERTED TO BLOCKS'
          WRITE (IU06,*) ' '
          DO 4001 IG = 1,ITESTB
             IJA = IJS(IG)
             IJE = IJS(IG)+4
             WRITE (IU06,*) ' BLOCK= ',IG
             WRITE (IU06,*) ' '
             WRITE (IU06,*) ' US(IJS - IJS+4): ',(US(I,IG),I=IJA,IJE)
             WRITE (IU06,*) ' DS(IJS - IJS+4): ',(DS(I,IG),I=IJA,IJE)
 4001    CONTINUE
      ENDIF

      RETURN
      END
