*IF DEF,C70_1A GLW1F404.40
C ******************************COPYRIGHT****************************** GTS2F400.5923
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5924
C GTS2F400.5925
C Use, duplication or disclosure of this code is subject to the GTS2F400.5926
C restrictions as set forth in the contract. GTS2F400.5927
C GTS2F400.5928
C Meteorological Office GTS2F400.5929
C London Road GTS2F400.5930
C BRACKNELL GTS2F400.5931
C Berkshire UK GTS2F400.5932
C RG12 2SZ GTS2F400.5933
C GTS2F400.5934
C If no contract has been raised with this copy of the code, the use, GTS2F400.5935
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5936
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5937
C Modelling at the above address. GTS2F400.5938
C ******************************COPYRIGHT****************************** GTS2F400.5939
C GTS2F400.5940
CLL -------------- SUBROUTINE MERGEFLD --------------------------------- MERGFLD1.3
CLL MERGFLD1.4
CLL Purpose: To merge an array held for points in boundary zone of a MERGFLD1.5
CLL rectangular area with an array covering the full area. MERGFLD1.6
CLL Not suitable for single column use MERGFLD1.7
CLL MERGFLD1.8
CLL Model Modification history from model version 3.0: MERGFLD1.9
CLL version date MERGFLD1.10
CLL 3.1 30/03/93 Correct rimweights at corners when J<I et sim. RTHB RB300393.1
CLL MERGFLD1.12
CLL Programing standard: UM Documentation paper No4, MERGFLD1.13
CLL Version No 2, dated 18/01/90 MERGFLD1.14
CLL MERGFLD1.15
CLL System components covered: C72 (part) MERGFLD1.16
CLL MERGFLD1.17
CLL System task: C7 MERGFLD1.18
CLL MERGFLD1.19
CLL Documentation: UM Documentation paper No C7, MERGFLD1.20
CLL draft version No 6, Dated 22/01/90 MERGFLD1.21
CLL UM Documentation paper No 10, MERGFLD1.22
CLL draft version No 7, Dated 05/02/90 MERGFLD1.23
CLL MERGFLD1.24
CLLEND MERGFLD1.25
MERGFLD1.26
C*L Arguments MERGFLD1.27
MERGFLD1.28
SUBROUTINE MERGEFLD (ROW_LENGTH,ROW_SIZE,ROWS,RIMWIDTH, 8MERGFLD1.29
& RIMWEIGHTS,RIM,FIELD) MERGFLD1.30
C* MERGFLD1.31
IMPLICIT NONE MERGFLD1.32
MERGFLD1.33
C*L MERGFLD1.34
INTEGER MERGFLD1.35
& ROW_LENGTH, ! In Row length of input boundary data MERGFLD1.36
& ROW_SIZE, ! In Row length of data field MERGFLD1.37
& ROWS, ! In MERGFLD1.38
& RIMWIDTH ! In Width of boundary zone MERGFLD1.39
MERGFLD1.40
REAL MERGFLD1.41
& RIMWEIGHTS(RIMWIDTH), ! In Weights to be given to RB300393.2
C ! boundary zone values. RB300393.3
& RIM((ROW_LENGTH+ROWS-2)*RIMWIDTH*2), MERGFLD1.44
C ! In Input boundary data. MERGFLD1.45
& FIELD(ROWS*ROW_SIZE) ! In/Out Output field MERGFLD1.46
MERGFLD1.47
C* MERGFLD1.48
C Local variables RB300393.4
MERGFLD1.50
INTEGER MERGFLD1.51
& I, ! Loop over rim gridpoints. RB300393.5
& J, ! Loop over N & S rows or E & W columns. RB300393.6
& IRIM ! Position in RIM data array. RB300393.7
RB300393.8
REAL RB300393.9
& RWT ! Modified rimweight for N & S rows. RB300393.10
MERGFLD1.55
CL Internal Structure MERGFLD1.56
MERGFLD1.57
CL 1.0 Copy N rows into final positions MERGFLD1.58
MERGFLD1.59
IRIM = 1 MERGFLD1.60
DO 10 I=1,RIMWIDTH MERGFLD1.61
DO 11 J=1,ROW_LENGTH MERGFLD1.62
IF (J .LT. I) THEN RB300393.11
RWT = RIMWEIGHTS(J) RB300393.12
ELSE IF (J .GT. ROW_LENGTH+1-I) THEN RB300393.13
RWT = RIMWEIGHTS(ROW_LENGTH+1-J) RB300393.14
ELSE RB300393.15
RWT = RIMWEIGHTS(I) RB300393.16
END IF RB300393.17
FIELD(J+(I-1)*ROW_SIZE) = RIM(IRIM)*RWT RB300393.18
& +FIELD(J+(I-1)*ROW_SIZE)*(1.0-RWT) RB300393.19
IRIM=IRIM+1 MERGFLD1.66
11 CONTINUE MERGFLD1.67
10 CONTINUE MERGFLD1.68
MERGFLD1.69
CL 2.0 Copy E rows into final positions MERGFLD1.70
MERGFLD1.71
DO 20 I=RIMWIDTH+1,ROWS-RIMWIDTH MERGFLD1.72
DO 21 J=ROW_LENGTH-RIMWIDTH+1,ROW_LENGTH MERGFLD1.73
FIELD(J+(I-1)*ROW_SIZE)=RIM(IRIM)*RIMWEIGHTS(ROW_LENGTH+1-J) RB300393.20
& +FIELD(J+(I-1)*ROW_SIZE)*(1.0- RB300393.21
& RIMWEIGHTS(ROW_LENGTH+1-J)) RB300393.22
IRIM=IRIM+1 MERGFLD1.77
21 CONTINUE MERGFLD1.78
20 CONTINUE MERGFLD1.79
MERGFLD1.80
CL 3.0 Copy S rows into final positions MERGFLD1.81
MERGFLD1.82
DO 30 I=ROWS-RIMWIDTH+1,ROWS MERGFLD1.83
DO 31 J=1,ROW_LENGTH MERGFLD1.84
IF (J .LT. ROWS+1-I) THEN RB300393.23
RWT = RIMWEIGHTS(J) RB300393.24
ELSE IF (J .GT. ROW_LENGTH-ROWS+I) THEN RB300393.25
RWT = RIMWEIGHTS(ROW_LENGTH+1-J) RB300393.26
ELSE RB300393.27
RWT = RIMWEIGHTS(ROWS+1-I) RB300393.28
END IF RB300393.29
FIELD(J+(I-1)*ROW_SIZE) = RIM(IRIM)*RWT RB300393.30
& +FIELD(J+(I-1)*ROW_SIZE)*(1.0-RWT) RB300393.31
IRIM=IRIM+1 MERGFLD1.88
31 CONTINUE MERGFLD1.89
30 CONTINUE MERGFLD1.90
MERGFLD1.91
CL 4.0 Copy W rows into final positions MERGFLD1.92
MERGFLD1.93
DO 40 I=RIMWIDTH+1,ROWS-RIMWIDTH MERGFLD1.94
DO 41 J=1,RIMWIDTH MERGFLD1.95
FIELD(J+(I-1)*ROW_SIZE)=RIM(IRIM)*RIMWEIGHTS(J) MERGFLD1.96
& +FIELD(J+(I-1)*ROW_SIZE)*(1.0- RB300393.32
& RIMWEIGHTS(J)) MERGFLD1.98
IRIM=IRIM+1 MERGFLD1.99
41 CONTINUE MERGFLD1.100
40 CONTINUE MERGFLD1.101
MERGFLD1.102
RETURN MERGFLD1.103
END MERGFLD1.104
MERGFLD1.105
MERGFLD1.106
*ENDIF MERGFLD1.107