*IF DEF,C94_1A,OR,DEF,RECON UIE3F404.10
C ******************************COPYRIGHT****************************** GTS2F400.3187
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3188
C GTS2F400.3189
C Use, duplication or disclosure of this code is subject to the GTS2F400.3190
C restrictions as set forth in the contract. GTS2F400.3191
C GTS2F400.3192
C Meteorological Office GTS2F400.3193
C London Road GTS2F400.3194
C BRACKNELL GTS2F400.3195
C Berkshire UK GTS2F400.3196
C RG12 2SZ GTS2F400.3197
C GTS2F400.3198
C If no contract has been raised with this copy of the code, the use, GTS2F400.3199
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3200
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3201
C Modelling at the above address. GTS2F400.3202
C ******************************COPYRIGHT****************************** GTS2F400.3203
C GTS2F400.3204
CLL Subroutine FROM_LAND_POINTS--------------------------------------- FROMLA1A.3
CLL FROMLA1A.4
CLL Written by A. Dickinson FROMLA1A.5
CLL FROMLA1A.6
CLL Purpose: Selects successive values from input array FROMLA1A.7
CLL DATA_LAND_POINTS and writes them to land points FROMLA1A.8
CLL in horizontal field array DATA. FROMLA1A.9
CLL FROMLA1A.10
CLL Model Modification history from model version 3.0: FROMLA1A.11
CLL version date FROMLA1A.12
CLL FROMLA1A.13
CLL Documentation: None FROMLA1A.14
CLL FROMLA1A.15
CLL ------------------------------------------------------------------ FROMLA1A.16
C FROMLA1A.17
C*L Arguments:-------------------------------------------------------- FROMLA1A.18
FROMLA1A.19
SUBROUTINE FROM_LAND_POINTS 65FROMLA1A.20
* (DATA,DATA_LAND_POINTS,LAND_SEA_MASK,POINTS,LAND_POINTS) FROMLA1A.21
FROMLA1A.22
IMPLICIT NONE FROMLA1A.23
FROMLA1A.24
INTEGER FROMLA1A.25
* POINTS !IN Total no of both land and sea points to be processed FROMLA1A.26
*,LAND_POINTS !OUT No of land points FROMLA1A.27
FROMLA1A.28
LOGICAL FROMLA1A.29
* LAND_SEA_MASK(POINTS) !IN Land-sea mask FROMLA1A.30
FROMLA1A.31
REAL FROMLA1A.32
* DATA_LAND_POINTS(POINTS) !IN Data on land points only FROMLA1A.33
*,DATA(POINTS) !OUT Data on land and sea points FROMLA1A.34
FROMLA1A.35
C Workspace usage:----------------------------------------------------- FROMLA1A.36
INTEGER INDEX_LAND_POINTS(POINTS) !Scatter index for land points FROMLA1A.37
C---------------------------------------------------------------------- FROMLA1A.38
C External subroutines called:----------------------------------------- FROMLA1A.39
C*--------------------------------------------------------------------- FROMLA1A.45
C Local varables:------------------------------------------------------ FROMLA1A.46
INTEGER I ! Integer index FROMLA1A.47
C---------------------------------------------------------------------- FROMLA1A.48
C Constants from comdecks:--------------------------------------------- FROMLA1A.49
*CALL C_MDI 
FROMLA1A.50
C---------------------------------------------------------------------- FROMLA1A.51
FROMLA1A.52
CL Initialise sea points to MDI FROMLA1A.53
FROMLA1A.54
DO I=1,POINTS FROMLA1A.55
DATA(I)=RMDI FROMLA1A.56
ENDDO FROMLA1A.57
FROMLA1A.58
CL Calculate scatter index for land points FROMLA1A.59
FROMLA1A.60
LAND_POINTS = 0 GSS9F402.45
DO I=1,POINTS GSS9F402.46
IF(LAND_SEA_MASK(I))THEN GSS9F402.47
LAND_POINTS=LAND_POINTS + 1 GSS9F402.48
INDEX_LAND_POINTS(LAND_POINTS) = I GSS9F402.49
END IF GSS9F402.50
END DO GSS9F402.51
FROMLA1A.68
CL Scatter land points to array DATA FROMLA1A.69
CDIR$ IVDEP FROMLA1A.70
! Fujitsu vectorization directive GRB0F405.315
!OCL NOVREC GRB0F405.316
DO I=1,LAND_POINTS FROMLA1A.71
DATA(INDEX_LAND_POINTS(I))=DATA_LAND_POINTS(I) FROMLA1A.72
ENDDO FROMLA1A.73
FROMLA1A.74
RETURN FROMLA1A.75
END FROMLA1A.76
*ENDIF FROMLA1A.77