*IF DEF,W08_1A                                                             GLW1F404.6      
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.15541  
C                                                                          GTS2F400.15542  
C Use, duplication or disclosure of this code is subject to the            GTS2F400.15543  
C restrictions as set forth in the contract.                               GTS2F400.15544  
C                                                                          GTS2F400.15545  
C                Meteorological Office                                     GTS2F400.15546  
C                London Road                                               GTS2F400.15547  
C                BRACKNELL                                                 GTS2F400.15548  
C                Berkshire UK                                              GTS2F400.15549  
C                RG12 2SZ                                                  GTS2F400.15550  
C                                                                          GTS2F400.15551  
C If no contract has been raised with this copy of the code, the use,      GTS2F400.15552  
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.15553  
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.15554  
C Modelling at the above address.                                          GTS2F400.15555  
C ******************************COPYRIGHT******************************    GTS2F400.15556  
C                                                                          GTS2F400.15557  
                                                                           BLOKFLD.3      
!+  subroutine to convert fields from full grid to blocks                  BLOKFLD.4      
!                                                                          BLOKFLD.5      
! Subroutine Interface:                                                    BLOKFLD.6      

      subroutine blokfld(field,blkfld,mdata,                                3BLOKFLD.7      
*CALL ARGWVAL                                                              BLOKFLD.8      
*CALL ARGWVGD                                                              BLOKFLD.9      
     & icode)                                                              BLOKFLD.10     
                                                                           BLOKFLD.11     
      IMPLICIT NONE                                                        BLOKFLD.12     
!                                                                          BLOKFLD.13     
! Description:                                                             BLOKFLD.14     
! This subroutine converts the input array of data on the full grid        BLOKFLD.15     
! (mdata points) to blocked data for use by WAM : fldout(niblo,nblo)       BLOKFLD.16     
!                                                                          BLOKFLD.17     
! Method:                                                                  BLOKFLD.18     
!   The WAM model grid and block indexing arrays are used                  BLOKFLD.19     
!                                                                          BLOKFLD.20     
! Current Code Owner: Martin Holt                                          BLOKFLD.21     
!                                                                          BLOKFLD.22     
! History:                                                                 BLOKFLD.23     
! Version   Date     Comment                                               BLOKFLD.24     
! -------   ----     -------                                               BLOKFLD.25     
! <1.0>    July 1995 Original code.    M Holt                              BLOKFLD.26     
!                                                                          BLOKFLD.27     
! Code Description:                                                        BLOKFLD.28     
!   Language: FORTRAN 77 + common extensions.                              BLOKFLD.29     
!   This code is written to UMDP3 v6 programming standards.                BLOKFLD.30     
!                                                                          BLOKFLD.31     
! System component covered: <UM wave model>                                BLOKFLD.32     
! System Task:              <UM wave model>                                BLOKFLD.33     
!                                                                          BLOKFLD.34     
!- End of header                                                           BLOKFLD.35     
                                                                           BLOKFLD.36     
*CALL TYPWVAL                                                              BLOKFLD.38     
*CALL TYPWVGD                                                              PXORDER.3      
                                                                           BLOKFLD.39     
                                                                           BLOKFLD.41     
       real blkfld(niblo,nblo) ! out - field arranged by blocks            BLOKFLD.42     
       integer icode           ! out - return code                         BLOKFLD.43     
                                                                           BLOKFLD.44     
       integer nstart ! index on full grid of first point in block         BLOKFLD.45     
       integer nend   ! index on full grid of last  point in block         BLOKFLD.46     
       integer mdata  ! array size - max number of datapoints              BLOKFLD.47     
                                                                           BLOKFLD.48     
       integer ig       ! index to loop over block number                  BLOKFLD.49     
       integer ii,i     ! index looping over points in block               BLOKFLD.50     
       integer ifill    ! counting index to fill blocks                    BLOKFLD.51     
       real field(mdata)       !in field of values at data points          PXORDER.4      
                                                                           BLOKFLD.52     
C      initialise output array with zeros                                  BLOKFLD.53     
                                                                           BLOKFLD.54     
       do ig=1,nblo                                                        BLOKFLD.55     
        do ii=1,niblo                                                      BLOKFLD.56     
         blkfld(ii,ig)=0.                                                  BLOKFLD.57     
        enddo                                                              BLOKFLD.58     
       enddo                                                               BLOKFLD.59     
                                                                           BLOKFLD.60     
       nstart=1                                                            BLOKFLD.61     
       do ig=1,igl                                                         BLOKFLD.62     
        nend  = nstart + ijlt(ig) - 1                                      BLOKFLD.63     
                                                                           BLOKFLD.64     
        ifill=1                                                            BLOKFLD.65     
        do i=nstart,nend                                                   BLOKFLD.66     
         blkfld(ifill,ig)=field(i)                                         BLOKFLD.67     
         ifill=ifill+1                                                     BLOKFLD.68     
        enddo                                                              BLOKFLD.69     
        nstart = nend - (ijlt(ig)-ijls(ig))                                BLOKFLD.70     
                                                                           BLOKFLD.71     
       enddo                                                               BLOKFLD.72     
                                                                           BLOKFLD.73     
                                                                           BLOKFLD.74     
       return                                                              BLOKFLD.75     
      end                                                                  GJC0F405.45     
*ENDIF                                                                     BLOKFLD.77