*IF DEF,C72_1A,AND,DEF,ATMOS,AND,DEF,OCEAN GLW1F404.9
C ******************************COPYRIGHT****************************** GTS2F400.1423
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1424
C GTS2F400.1425
C Use, duplication or disclosure of this code is subject to the GTS2F400.1426
C restrictions as set forth in the contract. GTS2F400.1427
C GTS2F400.1428
C Meteorological Office GTS2F400.1429
C London Road GTS2F400.1430
C BRACKNELL GTS2F400.1431
C Berkshire UK GTS2F400.1432
C RG12 2SZ GTS2F400.1433
C GTS2F400.1434
C If no contract has been raised with this copy of the code, the use, GTS2F400.1435
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1436
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1437
C Modelling at the above address. GTS2F400.1438
C ******************************COPYRIGHT****************************** GTS2F400.1439
C GTS2F400.1440
SUBROUTINE COPYO2A(IMT,JMAX,ODIN,WANT,OMASK 17COPYO2A1.3
&,ZERO,INVERT,IMAX,ODOUT) COPYO2A1.4
CLL SUBROUTINE COPYO2A -------------------------------------------- COPYO2A1.5
CLL COPYO2A1.6
CLL Purpose: COPYO2A1.7
CLL Auxiliary to TRANSO2A, used for transfer of fields from COPYO2A1.8
CLL ocean to atmosphere when the model grids are congruent, and as a COPYO2A1.9
CLL preliminary step when they are not congruent to remove missing COPYO2A1.10
CLL data and extra columns and invert the rows. COPYO2A1.11
CLL COPYO2A1.12
CLL Transfer field ODIN on the input grid to ODOUT on the output grid COPYO2A1.13
CLL by straight copying, for the case where the grids are congruent. COPYO2A1.14
CLL The matrices may have different first dimension. If (INVERT), the COPYO2A1.15
CLL rows are in oppsite orders. Only those points .EQV.WANT (where COPYO2A1.16
CLL WANT=.FALSE. for sea) in the source mask are copied. If (ZERO), COPYO2A1.17
CLL the rest are set to zero in the output field; otherwise they are COPYO2A1.18
CLL not changed. The mask should be the same way up as ODOUT, opposite COPYO2A1.19
CLL to ODIN if (INVERT). This routine is appropriate where the target COPYO2A1.20
CLL field could define a value everywhere, but the source field does COPYO2A1.21
CLL not supply one everywhere. COPYO2A1.22
CLL COPYO2A1.23
CLL WRITTEN BY J M GREGORY (31.5.91) (Extracted from TRANSO2A) COPYO2A1.24
CLL COPYO2A1.25
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: COPYO2A1.26
CLL VERSION DATE COPYO2A1.27
CLL COPYO2A1.28
CLL PROGRAMMING STANDARD : COPYO2A1.29
CLL FOLLOWS DOCUMENTATION PAPER 3, VERSION 1 FOR STANDARDS. COPYO2A1.30
CLL COPYO2A1.31
CLL LOGICAL COMPONENTS COVERED : COPYO2A1.32
CLL COPYO2A1.33
CLL PROJECT TASK : COPYO2A1.34
CLL COPYO2A1.35
CLL EXTERNAL DOCUMENTATION: UNIFIED MODEL DOCUMENTATION PAPER NO COPYO2A1.36
CLL COPYO2A1.37
CLLEND ----------------------------------------------------------------- COPYO2A1.38
CLL COPYO2A1.39
C*L COPYO2A1.40
INTEGER COPYO2A1.41
& IMT !IN First dimension of ODIN COPYO2A1.42
&,JMAX !IN Second dimension of ODIN,ODOUT COPYO2A1.43
&,IMAX !IN First dimension of ODOUT COPYO2A1.44
C COPYO2A1.45
REAL COPYO2A1.46
& ODIN(IMT,JMAX) !IN Input field COPYO2A1.47
&,RMDI !IN Missing data value in input field COPYO2A1.48
&,ODOUT(IMAX,JMAX) !INOUT Output field COPYO2A1.49
C COPYO2A1.50
LOGICAL COPYO2A1.51
& WANT !IN Mark of required input points COPYO2A1.52
&,OMASK(IMT,JMAX) !IN Input mask COPYO2A1.53
&,ZERO !IN Missing data to be replaced by zero COPYO2A1.54
&,INVERT !IN Row inversion is required COPYO2A1.55
C* COPYO2A1.56
INTEGER COPYO2A1.57
& I,J,JI,JO ! Loop indices COPYO2A1.58
C COPYO2A1.59
IF (INVERT) THEN COPYO2A1.60
DO 50 JI = 1,JMAX COPYO2A1.61
JO=JMAX-JI+1 COPYO2A1.62
DO 45 I = 1,IMAX COPYO2A1.63
IF (OMASK(I,JO).EQV.WANT) THEN COPYO2A1.64
ODOUT(I,JO) = ODIN(I,JI) COPYO2A1.65
ELSEIF (ZERO) THEN COPYO2A1.66
ODOUT(I,JO) = 0.0 COPYO2A1.67
ENDIF COPYO2A1.68
45 CONTINUE COPYO2A1.69
50 CONTINUE COPYO2A1.70
ELSE COPYO2A1.71
DO 60 J = 1,JMAX COPYO2A1.72
DO 55 I = 1,IMAX COPYO2A1.73
IF (OMASK(I,J).EQV.WANT) THEN COPYO2A1.74
ODOUT(I,J) = ODIN(I,J) COPYO2A1.75
ELSEIF (ZERO) THEN COPYO2A1.76
ODOUT(I,J) = 0.0 COPYO2A1.77
ENDIF COPYO2A1.78
55 CONTINUE COPYO2A1.79
60 CONTINUE COPYO2A1.80
ENDIF COPYO2A1.81
C COPYO2A1.82
RETURN COPYO2A1.83
END COPYO2A1.84
*ENDIF COPYO2A1.85