*IF DEF,FLUXPROC                                                           FPRDLSMS.2      
C ******************************COPYRIGHT******************************    FPRDLSMS.3      
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved.    FPRDLSMS.4      
C                                                                          FPRDLSMS.5      
C Use, duplication or disclosure of this code is subject to the            FPRDLSMS.6      
C restrictions as set forth in the contract.                               FPRDLSMS.7      
C                                                                          FPRDLSMS.8      
C                Meteorological Office                                     FPRDLSMS.9      
C                London Road                                               FPRDLSMS.10     
C                BRACKNELL                                                 FPRDLSMS.11     
C                Berkshire UK                                              FPRDLSMS.12     
C                RG12 2SZ                                                  FPRDLSMS.13     
C                                                                          FPRDLSMS.14     
C If no contract has been raised with this copy of the code, the use,      FPRDLSMS.15     
C duplication or disclosure of it is strictly prohibited.  Permission      FPRDLSMS.16     
C to do so must first be obtained in writing from the Head of Numerical    FPRDLSMS.17     
C Modelling at the above address.                                          FPRDLSMS.18     
C ******************************COPYRIGHT******************************    FPRDLSMS.19     
C                                                                          FPRDLSMS.20     
C Programming standard: Unified Model Documentation Paper No 3             FPRDLSMS.21     
C                       Version No 1 15/1/90                               FPRDLSMS.22     
C History:                                                                 FPRDLSMS.23     
C version  date         change                                             FPRDLSMS.24     
C 4.5      03/09/98     New code                                           FPRDLSMS.25     
C                                                                          FPRDLSMS.26     
! Author:     M. J. Bell                                                   FPRDLSMS.27     
!----------------------------------------------------------------------    FPRDLSMS.28     
! deck: RDLSMS                                                             FPRDLSMS.29     
!                                                                          FPRDLSMS.30     
! contains routines: read_lsms                                             FPRDLSMS.31     
!                                                                          FPRDLSMS.32     
! Purpose: reads land / sea masks, calculates coefficients for             FPRDLSMS.33     
!          interpolation between grids and indices for "unresolved"        FPRDLSMS.34     
!          seapoints on ocean grid which are not surrounded by seapoints   FPRDLSMS.35     
!          on the atmosphere grid.                                         FPRDLSMS.36     
!          Addition to handle rotated grids (S. Spall)                     FPRDLSMS.37     
!----------------------------------------------------------------------    FPRDLSMS.38     

      subroutine read_lsms(                                                 1,22FPRDLSMS.39     
*CALL AFIELDS                                                              FPRDLSMS.40     
*CALL ARGPPX                                                               FPRDLSMS.41     
     #           icode)                                                    FPRDLSMS.42     
                                                                           FPRDLSMS.43     
      implicit none                                                        FPRDLSMS.44     
                                                                           FPRDLSMS.45     
! declaration of arguments                                                 FPRDLSMS.46     
                                                                           FPRDLSMS.47     
*CALL CFIELDS                                                              FPRDLSMS.48     
                                                                           FPRDLSMS.49     
      integer icode  ! IN/OUT error code ; > 0 => fatal error detected     FPRDLSMS.50     
                                                                           FPRDLSMS.51     
! parameters                                                               FPRDLSMS.52     
*CALL PLOOKUPS                                                             FPRDLSMS.53     
*CALL CSUBMODL                                                             FPRDLSMS.54     
*CALL CPPXREF                                                              FPRDLSMS.55     
*CALL PPXLOOK                                                              FPRDLSMS.56     
                                                                           FPRDLSMS.57     
! Globals                                                                  FPRDLSMS.58     
*CALL CUNITNOS                                                             FPRDLSMS.59     
*CALL CMESS                                                                FPRDLSMS.60     
*CALL CLOOKUPS                                                             FPRDLSMS.61     
*CALL CLOOKADD                                                             FPRDLSMS.62     
                                                                           FPRDLSMS.63     
! declaration of local arrays                                              FPRDLSMS.64     
                                                                           FPRDLSMS.65     
! arrays required as input by h_int_co                                     FPRDLSMS.66     
       real phi_full(ncolsO*nrowstO)      ! { allocated with largest       FPRDLSMS.67     
       real lambda_full(ncolsO*nrowstO)   ! { row dimension                FPRDLSMS.68     
                                                                           FPRDLSMS.69     
! temporary arrays of positions on atmosphere grid required for w_coeff    FPRDLSMS.70     
       real lambda_eqA(ncols*nrowsu) ! Longitude on atmos. eq. grid        FPRDLSMS.71     
       real phi_eqA(ncols*nrowsu)    ! Latitude on atmos. eq. grid         FPRDLSMS.72     
       real lambda_tmp1(ncols*nrowsu) ! Longitude on reg. lat-long grid    FPRDLSMS.73     
       real phi_tmp1(ncols*nrowsu)    ! Latitude on reg. lat-long grid     FPRDLSMS.74     
       real lambda_tmp2(ncols*nrowsu) ! Longitude on ocean eq. grid        FPRDLSMS.75     
       real phi_tmp2(ncols*nrowsu)    ! Latitude on ocean eq. grid         FPRDLSMS.76     
                                                                           FPRDLSMS.77     
! arrays required in the conversion of lat-long for ocean points           FPRDLSMS.78     
       real phi_eq(ncolsO*nrowstO)      ! {                                FPRDLSMS.79     
       real lambda_eq(ncolsO*nrowstO)   ! { allocated with largest         FPRDLSMS.80     
       real phi_ll(ncolsO*nrowstO)      ! { row dimension                  FPRDLSMS.81     
       real lambda_ll(ncolsO*nrowstO)   ! {                                FPRDLSMS.82     
                                                                           FPRDLSMS.83     
! arrays output by coast_aj which are not subsequently used                FPRDLSMS.84     
! they are allocated with largest ocean grid dimensions (i.e. tracer)      FPRDLSMS.85     
       integer index_targ(ncolsO*nrowstO)                                  FPRDLSMS.86     
       integer index_srce(ncols*nrowst)                                    FPRDLSMS.87     
!       integer coastal_points(ncolsO*nrowstO)                             FPRDLSMS.88     
       integer coastal_points                                              FPRDLSMS.89     
       integer index_land_unres(ncolsO*nrowstO)                            FPRDLSMS.90     
                                                                           FPRDLSMS.91     
! declaration of local scalars                                             FPRDLSMS.92     
       logical mask    ! T => land sea mask is provided                    FPRDLSMS.93     
       integer i       ! loop index for columns                            FPRDLSMS.94     
       integer j       ! loop index for rows                               FPRDLSMS.95     
       integer ij      ! loop index for points in 2D field                 FPRDLSMS.96     
                                                                           FPRDLSMS.97     
! scalar output by coast_aj which is not subsequently used                 FPRDLSMS.98     
       integer n_pts_unres_land   ! number of unresolved land points       FPRDLSMS.99     
                                                                           FPRDLSMS.100    
       external read_lsm_anc, set_lsmu, h_int_co,                          FPRDLSMS.101    
     #         coast_aj, set_searches, copy_to_real, eqtoll, lltoeq        FPRDLSMS.102    
                                                                           FPRDLSMS.103    
!----------------------------------------------------------------------    FPRDLSMS.104    
                                                                           FPRDLSMS.105    
! 0. Preliminaries                                                         FPRDLSMS.106    
      CSub = 'read_lsms'  ! subroutine name for error messages             FPRDLSMS.107    
                                                                           FPRDLSMS.108    
!----------------------------------------------------------------------    FPRDLSMS.109    
! 1. Read land / sea masks                                                 FPRDLSMS.110    
!----------------------------------------------------------------------    FPRDLSMS.111    
                                                                           FPRDLSMS.112    
! 1.1 read atmosphere tracer land / sea mask and calculate                 FPRDLSMS.113    
!    grid coordinates                                                      FPRDLSMS.114    
      call read_lsm_anc(UnitNWPlsmt, Len_FixHd, Len1_Lookup, FixHdlsmt,    FPRDLSMS.115    
     #       Lookuplsmt, ncols, nrowst, lsmt, lambda_t, phi_t,             FPRDLSMS.116    
*CALL ARGPPX                                                               FPRDLSMS.117    
     #       icode)                                                        FPRDLSMS.118    
                                                                           FPRDLSMS.119    
! check icode                                                              FPRDLSMS.120    
      if (icode .gt. 0)then                                                FPRDLSMS.121    
        write(UnErr,*)CErr,CSub,                                           FPRDLSMS.122    
     #       ' step 1.1 failed reading NWP tracer land / sea mask'         FPRDLSMS.123    
        go to 9999                                                         FPRDLSMS.124    
      end if                                                               FPRDLSMS.125    
                                                                           FPRDLSMS.126    
! 1.2 set atmosphere velocity land / sea mask from tracer land / sea       FPRDLSMS.127    
!     mask and calculate grid coordinates                                  FPRDLSMS.128    
                                                                           FPRDLSMS.129    
      call set_lsmu ( Len1_Lookup, Lookuplsmu, ncols, nrowst, nrowsu,      FPRDLSMS.130    
     #                LCyclic, lsmt, lsmu, lambda_u, phi_u )               FPRDLSMS.131    
                                                                           FPRDLSMS.132    
                                                                           FPRDLSMS.133    
! 1.3 read ocean tracer land / sea mask and calculate                      FPRDLSMS.134    
!    grid coordinates                                                      FPRDLSMS.135    
      call read_lsm_anc(UnitFOAMlsmt, Len_FixHd, Len1_Lookup,              FPRDLSMS.136    
     #       FixHdlsmtO, LookuplsmtO, ncolsO, nrowstO, lsmtO,              FPRDLSMS.137    
     #       lambda_tO, phi_tO,                                            FPRDLSMS.138    
*CALL ARGPPX                                                               FPRDLSMS.139    
     #       icode)                                                        FPRDLSMS.140    
                                                                           FPRDLSMS.141    
! check icode                                                              FPRDLSMS.142    
      if (icode .gt. 0)then                                                FPRDLSMS.143    
        write(UnErr,*)CErr,CSub,                                           FPRDLSMS.144    
     #       ' step 1.3 failed reading ocean tracer land / sea mask'       FPRDLSMS.145    
        icode = icode + 2000                                               FPRDLSMS.146    
        go to 9999                                                         FPRDLSMS.147    
      end if                                                               FPRDLSMS.148    
                                                                           FPRDLSMS.149    
! 1.4 read ocean velocity land / sea mask and calculate                    FPRDLSMS.150    
!    grid coordinates                                                      FPRDLSMS.151    
      call read_lsm_anc(UnitFOAMlsmu, Len_FixHd, Len1_Lookup,              FPRDLSMS.152    
     #       FixHdlsmuO, LookuplsmuO, ncolsO, nrowsuO, lsmuO,              FPRDLSMS.153    
     #       lambda_uO, phi_uO,                                            FPRDLSMS.154    
*CALL ARGPPX                                                               FPRDLSMS.155    
     #       icode)                                                        FPRDLSMS.156    
                                                                           FPRDLSMS.157    
! check icode                                                              FPRDLSMS.158    
      if (icode .gt. 0)then                                                FPRDLSMS.159    
        write(UnErr,*)CErr,CSub,                                           FPRDLSMS.160    
     #       ' step 1.4 failed reading ocean velocity land / sea mask'     FPRDLSMS.161    
        icode = icode + 2000                                               FPRDLSMS.162    
        go to 9999                                                         FPRDLSMS.163    
      end if                                                               FPRDLSMS.164    
                                                                           FPRDLSMS.165    
!----------------------------------------------------------------------    FPRDLSMS.166    
! 2. Find if the atmosphere grid is rotated                                FPRDLSMS.167    
!---------------------------------------------------------------------     FPRDLSMS.168    
                                                                           FPRDLSMS.169    
! 2.1 Get the position of the poles from the                               FPRDLSMS.170    
!     atmosphere lsm header                                                FPRDLSMS.171    
                                                                           FPRDLSMS.172    
      call copy_to_real ( Lookuplsmt(BPLAT), pole_lat )                    FPRDLSMS.173    
      call copy_to_real ( Lookuplsmt(BPLON), pole_lon )                    FPRDLSMS.174    
                                                                           FPRDLSMS.175    
! 2.2 Find if a rotated grid is being used                                 FPRDLSMS.176    
                                                                           FPRDLSMS.177    
      rotg=.true.                                                          FPRDLSMS.178    
      if ( pole_lat .gt. 89.99 .and. pole_lat .lt. 90.01) then             FPRDLSMS.179    
        rotg=.false.                                                       FPRDLSMS.180    
      end if                                                               FPRDLSMS.181    
                                                                           FPRDLSMS.182    
      if (pole_lat .lt. -1.0e5) then                                       FPRDLSMS.183    
        rotg=.false.                                                       FPRDLSMS.184    
      end if                                                               FPRDLSMS.185    
                                                                           FPRDLSMS.186    
! 2.3 Do error checking on the positions of the poles                      FPRDLSMS.187    
                                                                           FPRDLSMS.188    
      if (rotg) then                                                       FPRDLSMS.189    
                                                                           FPRDLSMS.190    
        if ( pole_lat .gt. 90.0 .or. pole_lat .lt. -90.0 ) then            FPRDLSMS.191    
          write(UnErr,*)CErr,CSub,                                         FPRDLSMS.192    
     #       ' step 2.3 incorrect latitude of pole in atmos lsm header'    FPRDLSMS.193    
          icode = icode + 2000                                             FPRDLSMS.194    
          go to 9999                                                       FPRDLSMS.195    
        end if                                                             FPRDLSMS.196    
                                                                           FPRDLSMS.197    
        if ( pole_lon .gt. 360.0 .or. pole_lon .lt. -360.0 ) then          FPRDLSMS.198    
          write(UnErr,*)CErr,CSub,                                         FPRDLSMS.199    
     #       ' step 2.3 incorrect longitude of pole in atmos lsm header'   FPRDLSMS.200    
          icode = icode + 2000                                             FPRDLSMS.201    
          go to 9999                                                       FPRDLSMS.202    
        end if                                                             FPRDLSMS.203    
                                                                           FPRDLSMS.204    
      end if                                                               FPRDLSMS.205    
                                                                           FPRDLSMS.206    
! 2.4 Write out details of the type of grid                                FPRDLSMS.207    
                                                                           FPRDLSMS.208    
      if (rotg) then                                                       FPRDLSMS.209    
        write(UnStd,*)CStd//CSub//'Atmosphere on a rotated grid;',         FPRDLSMS.210    
     #    ' BPLAT = ', pole_lat, '; BPLON = ', pole_lon                    FPRDLSMS.211    
      else                                                                 FPRDLSMS.212    
        write(UnStd,*)CStd//CSub//'Atmosphere on a non-rotated grid'       FPRDLSMS.213    
      end if                                                               FPRDLSMS.214    
                                                                           FPRDLSMS.215    
!----------------------------------------------------------------------    FPRDLSMS.216    
! 3. Find if the ocean grid is rotated                                     FPRDLSMS.217    
!---------------------------------------------------------------------     FPRDLSMS.218    
                                                                           FPRDLSMS.219    
! 3.1 Get the position of the poles from the                               FPRDLSMS.220    
!     ocean tracer grid lsm header                                         FPRDLSMS.221    
                                                                           FPRDLSMS.222    
      call copy_to_real ( LookuplsmtO(BPLAT), poleO_lat )                  FPRDLSMS.223    
      call copy_to_real ( LookuplsmtO(BPLON), poleO_lon )                  FPRDLSMS.224    
                                                                           FPRDLSMS.225    
! 3.2 Find if a rotated grid is being used                                 FPRDLSMS.226    
                                                                           FPRDLSMS.227    
      rotgO=.true.                                                         FPRDLSMS.228    
      if ( poleO_lat .gt. 89.99 .and. poleO_lat .lt. 90.01) then           FPRDLSMS.229    
        rotgO=.false.                                                      FPRDLSMS.230    
      end if                                                               FPRDLSMS.231    
                                                                           FPRDLSMS.232    
      if (poleO_lat .lt. -1.0e5) then                                      FPRDLSMS.233    
        rotgO=.false.                                                      FPRDLSMS.234    
      end if                                                               FPRDLSMS.235    
                                                                           FPRDLSMS.236    
! 3.3 Do error checking on the positions of the poles                      FPRDLSMS.237    
                                                                           FPRDLSMS.238    
      if (rotgO) then                                                      FPRDLSMS.239    
                                                                           FPRDLSMS.240    
        if ( poleO_lat .gt. 90.0 .or. poleO_lat .lt. -90.0 ) then          FPRDLSMS.241    
          write(UnErr,*)CErr,CSub,                                         FPRDLSMS.242    
     #       ' step 3.3 incorrect latitude of pole in ocean lsm header'    FPRDLSMS.243    
          icode = icode + 2000                                             FPRDLSMS.244    
          go to 9999                                                       FPRDLSMS.245    
        end if                                                             FPRDLSMS.246    
                                                                           FPRDLSMS.247    
        if ( poleO_lon .gt. 360.0 .or. poleO_lon .lt. -360.0 ) then        FPRDLSMS.248    
          write(UnErr,*)CErr,CSub,                                         FPRDLSMS.249    
     #       ' step 3.3 incorrect longitude of pole in ocean lsm header'   FPRDLSMS.250    
          icode = icode + 2000                                             FPRDLSMS.251    
          go to 9999                                                       FPRDLSMS.252    
        end if                                                             FPRDLSMS.253    
                                                                           FPRDLSMS.254    
      end if                                                               FPRDLSMS.255    
                                                                           FPRDLSMS.256    
! 3.4 Write out details of the type of grid                                FPRDLSMS.257    
                                                                           FPRDLSMS.258    
      if (rotgO) then                                                      FPRDLSMS.259    
        write(UnStd,*)CStd//CSub//'Ocean on a rotated grid;',              FPRDLSMS.260    
     #    ' BPLAT = ', poleO_lat, '; BPLON = ', poleO_lon                  FPRDLSMS.261    
      else                                                                 FPRDLSMS.262    
        write(UnStd,*)CStd//CSub//'Ocean on a non-rotated grid'            FPRDLSMS.263    
      end if                                                               FPRDLSMS.264    
                                                                           FPRDLSMS.265    
!----------------------------------------------------------------------    FPRDLSMS.266    
! 4. Calculate interpolation coefficients for interpolation                FPRDLSMS.267    
!    from atmosphere to ocean grids                                        FPRDLSMS.268    
!----------------------------------------------------------------------    FPRDLSMS.269    
                                                                           FPRDLSMS.270    
! 4.1 prepare target grid coordinates required                             FPRDLSMS.271    
!     by h_int_co for tracer grid                                          FPRDLSMS.272    
                                                                           FPRDLSMS.273    
      do j = 1, nrowstO                                                    FPRDLSMS.274    
        do i = 1, ncolsO                                                   FPRDLSMS.275    
          ij = i + (j-1) * ncolsO                                          FPRDLSMS.276    
          phi_eq( ij ) = phi_tO ( j )                                      FPRDLSMS.277    
          lambda_eq( ij ) =  lambda_tO ( i )                               FPRDLSMS.278    
       end do                                                              FPRDLSMS.279    
      end do                                                               FPRDLSMS.280    
                                                                           FPRDLSMS.281    
! 4.2 If the ocean uses a rotated grid, convert the ocean lat-long         FPRDLSMS.282    
!     vector to a standard lat-long grid                                   FPRDLSMS.283    
                                                                           FPRDLSMS.284    
      if (rotgO) then                                                      FPRDLSMS.285    
        call eqtoll(phi_eq, lambda_eq, phi_ll, lambda_ll,                  FPRDLSMS.286    
     #                      poleO_lat, poleO_lon, ncolsO*nrowstO)          FPRDLSMS.287    
      else                                                                 FPRDLSMS.288    
        do i = 1, ncolsO*nrowstO                                           FPRDLSMS.289    
          phi_ll( i ) = phi_eq( i )                                        FPRDLSMS.290    
          lambda_ll( i ) =  lambda_eq ( i )                                FPRDLSMS.291    
        end do                                                             FPRDLSMS.292    
      end if                                                               FPRDLSMS.293    
                                                                           FPRDLSMS.294    
! 4.3 If the atmosphere uses a rotated grid, convert the ocean standard    FPRDLSMS.295    
!     lat-long to the atmosphere rotated grid                              FPRDLSMS.296    
                                                                           FPRDLSMS.297    
      if (rotg) then                                                       FPRDLSMS.298    
        call lltoeq(phi_ll, lambda_ll, phi_full, lambda_full,              FPRDLSMS.299    
     #                      pole_lat, pole_lon, ncolsO*nrowstO)            FPRDLSMS.300    
      else                                                                 FPRDLSMS.301    
        do i = 1, ncolsO*nrowstO                                           FPRDLSMS.302    
          phi_full( i ) = phi_ll( i )                                      FPRDLSMS.303    
          lambda_full( i ) =  lambda_ll ( i )                              FPRDLSMS.304    
        end do                                                             FPRDLSMS.305    
      end if                                                               FPRDLSMS.306    
                                                                           FPRDLSMS.307    
! 4.4 Convert target longitude to correct range                            FPRDLSMS.308    
                                                                           FPRDLSMS.309    
      do i = 1, ncolsO*nrowstO                                             FPRDLSMS.310    
        lambda_full(i)=mod(lambda_full(i)-lambda_t(1)+720.,360.)           FPRDLSMS.311    
     #                         +lambda_t(1)                                FPRDLSMS.312    
      end do                                                               FPRDLSMS.313    
                                                                           FPRDLSMS.314    
! 4.5 Calculate interpolation coefficients for tracer grids                FPRDLSMS.315    
                                                                           FPRDLSMS.316    
      call h_int_co(index_bl_t,index_br_t,                                 FPRDLSMS.317    
     # weight_tr_t,weight_br_t,weight_tl_t,weight_bl_t,                    FPRDLSMS.318    
     # lambda_t, phi_t, lambda_full, phi_full,                             FPRDLSMS.319    
     # ncols,nrowst,ncolsO*nrowstO,LCyclic)                                FPRDLSMS.320    
                                                                           FPRDLSMS.321    
! 4.6 prepare target grid coordinates required                             FPRDLSMS.322    
!     by h_int_co for velocity grid                                        FPRDLSMS.323    
                                                                           FPRDLSMS.324    
      do j = 1, nrowsuO                                                    FPRDLSMS.325    
        do i = 1, ncolsO                                                   FPRDLSMS.326    
          ij = i + (j-1) * ncolsO                                          FPRDLSMS.327    
          phi_eq( ij ) = phi_uO ( j )                                      FPRDLSMS.328    
          lambda_eq (ij ) =  lambda_uO ( i )                               FPRDLSMS.329    
       end do                                                              FPRDLSMS.330    
      end do                                                               FPRDLSMS.331    
                                                                           FPRDLSMS.332    
! 4.7 If the ocean uses a rotated grid, convert the ocean lat-long         FPRDLSMS.333    
!     vector to a standard lat-long grid                                   FPRDLSMS.334    
                                                                           FPRDLSMS.335    
      if (rotgO) then                                                      FPRDLSMS.336    
        call eqtoll(phi_eq, lambda_eq, phi_ll, lambda_ll,                  FPRDLSMS.337    
     #                      poleO_lat, poleO_lon, ncolsO*nrowsuO)          FPRDLSMS.338    
      else                                                                 FPRDLSMS.339    
        do i = 1, ncolsO*nrowsuO                                           FPRDLSMS.340    
          phi_ll( i ) = phi_eq( i )                                        FPRDLSMS.341    
          lambda_ll( i ) =  lambda_eq ( i )                                FPRDLSMS.342    
        end do                                                             FPRDLSMS.343    
      end if                                                               FPRDLSMS.344    
                                                                           FPRDLSMS.345    
! 4.8 If the atmosphere uses a rotated grid, convert the ocean standard    FPRDLSMS.346    
!     lat-long to the atmosphere rotated grid                              FPRDLSMS.347    
                                                                           FPRDLSMS.348    
      if (rotg) then                                                       FPRDLSMS.349    
        call lltoeq(phi_ll, lambda_ll, phi_full, lambda_full,              FPRDLSMS.350    
     #                      pole_lat, pole_lon, ncolsO*nrowsuO)            FPRDLSMS.351    
      else                                                                 FPRDLSMS.352    
        do i = 1, ncolsO*nrowsuO                                           FPRDLSMS.353    
          phi_full( i ) = phi_ll( i )                                      FPRDLSMS.354    
          lambda_full( i ) =  lambda_ll ( i )                              FPRDLSMS.355    
        end do                                                             FPRDLSMS.356    
      end if                                                               FPRDLSMS.357    
                                                                           FPRDLSMS.358    
! 4.9 Convert target longitude to correct range                            FPRDLSMS.359    
                                                                           FPRDLSMS.360    
      do i = 1, ncolsO*nrowsuO                                             FPRDLSMS.361    
        lambda_full(i)=mod(lambda_full(i)-lambda_u(1)+720.,360.)           FPRDLSMS.362    
     #                         +lambda_u(1)                                FPRDLSMS.363    
      end do                                                               FPRDLSMS.364    
                                                                           FPRDLSMS.365    
! 4.10 Calculate interpolation coefficients for velocity grids             FPRDLSMS.366    
      call h_int_co(index_bl_u,index_br_u,                                 FPRDLSMS.367    
     # weight_tr_u,weight_br_u,weight_tl_u,weight_bl_u,                    FPRDLSMS.368    
     # lambda_u, phi_u, lambda_full, phi_full,                             FPRDLSMS.369    
     # ncols,nrowsu,ncolsO*nrowsuO,LCyclic)                                FPRDLSMS.370    
                                                                           FPRDLSMS.371    
!----------------------------------------------------------------------    FPRDLSMS.372    
! 5. Calculate the coefficients for rotating wind vectors to align         FPRDLSMS.373    
!    with the ocean grid                                                   FPRDLSMS.374    
!----------------------------------------------------------------------    FPRDLSMS.375    
                                                                           FPRDLSMS.376    
! 5.1 Set up the coefficients for atmosphere to reg. lat-long              FPRDLSMS.377    
                                                                           FPRDLSMS.378    
      do j = 1, nrowsu                                                     FPRDLSMS.379    
        do i = 1, ncols                                                    FPRDLSMS.380    
          ij = i + (j-1) * ncols                                           FPRDLSMS.381    
          phi_eqA( ij ) = phi_u ( j )                                      FPRDLSMS.382    
          lambda_eqA ( ij ) =  lambda_u ( i )                              FPRDLSMS.383    
       end do                                                              FPRDLSMS.384    
      end do                                                               FPRDLSMS.385    
                                                                           FPRDLSMS.386    
      if (rotg) then                                                       FPRDLSMS.387    
        call eqtoll(phi_eqA, lambda_eqA, phi_tmp1, lambda_tmp1,            FPRDLSMS.388    
     #                      pole_lat, pole_lon, ncols*nrowsu)              FPRDLSMS.389    
        call w_coeff(coef_angle1, coef_angle2, lambda_tmp1,                FPRDLSMS.390    
     #             lambda_eqA, pole_lat, pole_lon, ncols*nrowsu)           FPRDLSMS.391    
      else                                                                 FPRDLSMS.392    
        do ij = 1, ncols*nrowsu                                            FPRDLSMS.393    
          lambda_tmp1(ij)=lambda_eqA(ij)                                   FPRDLSMS.394    
          phi_tmp1(ij)=phi_eqA(ij)                                         FPRDLSMS.395    
        enddo                                                              FPRDLSMS.396    
      endif                                                                FPRDLSMS.397    
                                                                           FPRDLSMS.398    
! 5.2 Set up the coefficients for reg. lat-long to ocean                   FPRDLSMS.399    
                                                                           FPRDLSMS.400    
      if (rotgO) then                                                      FPRDLSMS.401    
        call lltoeq(phi_tmp1, lambda_tmp1, phi_tmp2, lambda_tmp2,          FPRDLSMS.402    
     #                      poleO_lat, poleO_lon, ncols*nrowsu)            FPRDLSMS.403    
        call w_coeff(coef_angle3, coef_angle4, lambda_tmp1,                FPRDLSMS.404    
     #             lambda_tmp2, poleO_lat, poleO_lon, ncols*nrowsu)        FPRDLSMS.405    
      endif                                                                FPRDLSMS.406    
                                                                           FPRDLSMS.407    
!----------------------------------------------------------------------    FPRDLSMS.408    
! 6. Calculate indices for unresolved points i.e. seapoints on ocean       FPRDLSMS.409    
!    grid which are not surrounded by seapoints on the atmosphere grid     FPRDLSMS.410    
!----------------------------------------------------------------------    FPRDLSMS.411    
                                                                           FPRDLSMS.412    
! 6.1 Calculate indices for unresolved points for tracer grids             FPRDLSMS.413    
                                                                           FPRDLSMS.414    
      mask = .true.  ! land / sea mask for target grid is to be used       FPRDLSMS.415    
                                                                           FPRDLSMS.416    
      call coast_aj (index_bl_t,index_br_t,                                FPRDLSMS.417    
     # weight_tr_t,weight_br_t,weight_tl_t,weight_bl_t,                    FPRDLSMS.418    
     # ncols,nrowst,ncolsO*nrowstO,                                        FPRDLSMS.419    
     # lsmt,lsmtO,                                                         FPRDLSMS.420    
     # index_targ,index_srce,coastal_points,mask,                          FPRDLSMS.421    
     # index_unres_t,n_pts_unres_t,                                        FPRDLSMS.422    
     # index_land_unres,n_pts_unres_land)                                  FPRDLSMS.423    
                                                                           FPRDLSMS.424    
! 6.2 Calculate indices for unresolved points for velocity grids           FPRDLSMS.425    
                                                                           FPRDLSMS.426    
      call coast_aj (index_bl_u,index_br_u,                                FPRDLSMS.427    
     # weight_tr_u,weight_br_u,weight_tl_u,weight_bl_u,                    FPRDLSMS.428    
     # ncols,nrowsu,ncolsO*nrowsuO,                                        FPRDLSMS.429    
     # lsmu,lsmuO,                                                         FPRDLSMS.430    
     # index_targ,index_srce,coastal_points,mask,                          FPRDLSMS.431    
     # index_unres_u,n_pts_unres_u,                                        FPRDLSMS.432    
     # index_land_unres,n_pts_unres_land)                                  FPRDLSMS.433    
                                                                           FPRDLSMS.434    
!----------------------------------------------------------------------    FPRDLSMS.435    
! 7. Determine number of searchs needed to fill in unresolved points       FPRDLSMS.436    
!----------------------------------------------------------------------    FPRDLSMS.437    
                                                                           FPRDLSMS.438    
! 7.1 on tracer grid                                                       FPRDLSMS.439    
      call set_searches ( ncolsO, nrowstO, LCyclic, ISeaPt,                FPRDLSMS.440    
     #     lsmtO, n_pts_unres_t, index_unres_t, max_no_searches,           FPRDLSMS.441    
     #     n_calls_spiral_t, n_pts_spiral_t, icode)                        FPRDLSMS.442    
                                                                           FPRDLSMS.443    
      if (icode .gt. 0)then                                                FPRDLSMS.444    
        write(UnErr,*)CErr,CSub,                                           FPRDLSMS.445    
     #       ' step 4.1 unable to fill in all unresolved points '          FPRDLSMS.446    
        icode = icode + 2000                                               FPRDLSMS.447    
        go to 9999                                                         FPRDLSMS.448    
      end if                                                               FPRDLSMS.449    
                                                                           FPRDLSMS.450    
                                                                           FPRDLSMS.451    
! 7.2 on velocity grid                                                     FPRDLSMS.452    
      call set_searches ( ncolsO, nrowsuO, LCyclic, ISeaPt,                FPRDLSMS.453    
     #     lsmuO, n_pts_unres_u, index_unres_u, max_no_searches,           FPRDLSMS.454    
     #     n_calls_spiral_u, n_pts_spiral_u, icode)                        FPRDLSMS.455    
                                                                           FPRDLSMS.456    
      if (icode .gt. 0)then                                                FPRDLSMS.457    
        write(UnErr,*)CErr,CSub,                                           FPRDLSMS.458    
     #       ' step 4.2 unable to fill in all unresolved points '          FPRDLSMS.459    
        icode = icode + 2000                                               FPRDLSMS.460    
        go to 9999                                                         FPRDLSMS.461    
      end if                                                               FPRDLSMS.462    
                                                                           FPRDLSMS.463    
9999  continue                                                             FPRDLSMS.464    
      return                                                               FPRDLSMS.465    
      end                                                                  FPRDLSMS.466    
!----------------------------------------------------------------------    FPRDLSMS.467    
*ENDIF                                                                     FPRDLSMS.468