*IF DEF,C72_1A,AND,DEF,ATMOS,AND,DEF,OCEAN GLW1F404.8
C ******************************COPYRIGHT****************************** GTS2F400.1405
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1406
C GTS2F400.1407
C Use, duplication or disclosure of this code is subject to the GTS2F400.1408
C restrictions as set forth in the contract. GTS2F400.1409
C GTS2F400.1410
C Meteorological Office GTS2F400.1411
C London Road GTS2F400.1412
C BRACKNELL GTS2F400.1413
C Berkshire UK GTS2F400.1414
C RG12 2SZ GTS2F400.1415
C GTS2F400.1416
C If no contract has been raised with this copy of the code, the use, GTS2F400.1417
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1418
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1419
C Modelling at the above address. GTS2F400.1420
C ******************************COPYRIGHT****************************** GTS2F400.1421
C GTS2F400.1422
SUBROUTINE COPYA2O(IMAX,JMAX,ODIN,INVERT,IMT,WANT,OMASK,ODOUT) 21COPYA2O1.3
CLL COPYA2O1.4
CLL SUBROUTINE COPYA2O ---------------------------------------------- COPYA2O1.5
CLL COPYA2O1.6
CLL Auxiliary to TRANSA2O, used for transfer of fields from COPYA2O1.7
CLL atmosphere to ocean when the model grids are congruent, and as a COPYA2O1.8
CLL preliminary step when they are not congruent to remove missing COPYA2O1.9
CLL data and invert the rows. COPYA2O1.10
CLL COPYA2O1.11
CLL Transfer field ODIN on the input grid to ODOUT on the output grid COPYA2O1.12
CLL by straight copying, for the case where the fields arecongruent. COPYA2O1.13
CLL The matrices may have different first dimension. If (INVERT), the COPYA2O1.14
CLL rows are in opposite orders. Only those points .EQV.WANT (where COPYA2O1.15
CLL WANT=.F. for sea) in the output mask are copied. Thus, this COPYA2O1.16
CLL routine is appropriate when the source field defines values every- COPYA2O1.17
CLL where, but the output field does not require a value everywhere. COPYA2O1.18
CLL COPYA2O1.19
CLL WRITTEN BY J M GREGORY (1.7.91) (Extracted from TRANSA2O) COPYA2O1.20
CLL COPYA2O1.21
CLL Model Modification history from model version 3.0: COPYA2O1.22
CLL version Date COPYA2O1.23
CLL COPYA2O1.24
CLL Programming standard : COPYA2O1.25
CLL Follows documentation paper 3, version 1 for standards. COPYA2O1.26
CLL COPYA2O1.27
CLL Logical components covered : COPYA2O1.28
CLL COPYA2O1.29
CLL Project task : COPYA2O1.30
CLL COPYA2O1.31
CLL Documentation: COPYA2O1.32
CLL COPYA2O1.33
CLLEND ------------------------------------------------------------- COPYA2O1.34
C*L COPYA2O1.35
INTEGER COPYA2O1.36
& IMAX !IN First dimension of ODIN COPYA2O1.37
&,JMAX !IN Second dimension of ODIN,ODOUT COPYA2O1.38
&,IMT !IN First dimension of ODOUT COPYA2O1.39
C COPYA2O1.40
REAL COPYA2O1.41
& ODIN(IMAX,JMAX) !IN Input field COPYA2O1.42
&,ODOUT(IMT,JMAX) !INOUT Output field COPYA2O1.43
C COPYA2O1.44
LOGICAL COPYA2O1.45
& INVERT !IN Row inversion is required COPYA2O1.46
&,WANT !IN Logical value of selected points COPYA2O1.47
&,OMASK(IMT,JMAX) !IN Output mask COPYA2O1.48
C* COPYA2O1.49
INTEGER COPYA2O1.50
& I,J,JI,JO ! Loop indices COPYA2O1.51
C COPYA2O1.52
IF (INVERT) THEN COPYA2O1.53
DO 50 JI = 1,JMAX COPYA2O1.54
JO=JMAX-JI+1 COPYA2O1.55
DO 45 I = 1,IMAX COPYA2O1.56
IF (OMASK(I,JO).EQV.WANT) ODOUT(I,JO)=ODIN(I,JI) COPYA2O1.57
45 CONTINUE COPYA2O1.58
50 CONTINUE COPYA2O1.59
ELSE COPYA2O1.60
DO 60 J = 1,JMAX COPYA2O1.61
DO 55 I = 1,IMAX COPYA2O1.62
IF (OMASK(I,J).EQV.WANT) ODOUT(I,J) = ODIN(I,J) COPYA2O1.63
55 CONTINUE COPYA2O1.64
60 CONTINUE COPYA2O1.65
ENDIF COPYA2O1.66
C COPYA2O1.67
RETURN COPYA2O1.68
END COPYA2O1.69
*ENDIF COPYA2O1.70