*IF DEF,C93_1A,OR,DEF,C93_2A GNF0F402.2
C ******************************COPYRIGHT****************************** GTS2F400.1045
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1046
C GTS2F400.1047
C Use, duplication or disclosure of this code is subject to the GTS2F400.1048
C restrictions as set forth in the contract. GTS2F400.1049
C GTS2F400.1050
C Meteorological Office GTS2F400.1051
C London Road GTS2F400.1052
C BRACKNELL GTS2F400.1053
C Berkshire UK GTS2F400.1054
C RG12 2SZ GTS2F400.1055
C GTS2F400.1056
C If no contract has been raised with this copy of the code, the use, GTS2F400.1057
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1058
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1059
C Modelling at the above address. GTS2F400.1060
C ******************************COPYRIGHT****************************** GTS2F400.1061
C GTS2F400.1062
CLL Routine: COLM ---------------------------------------------------- COLM1A.3
CLL COLM1A.4
CLL Purpose: Service routine to calculate weighted column mean of a COLM1A.5
CLL 3D field, as required in zonal mean subroutine. COLM1A.6
CLL COLM1A.7
CLL Tested under compiler: cf77 COLM1A.8
CLL Tested under OS version: UNICOS 5.1 COLM1A.9
CLL COLM1A.10
CLL Author: T.C.Johns COLM1A.11
CLL COLM1A.12
CLL Model Modification history from model version 3.0: COLM1A.13
CLL version Date COLM1A.14
CLL vn4.2 07/11/96:Allow this routine to be used in C93_2A (Farnon) GNF0F402.1
CLL COLM1A.15
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) COLM1A.16
CLL COLM1A.17
CLL Logical components covered: D61 COLM1A.18
CLL COLM1A.19
CLL Project task: C61 COLM1A.20
CLL COLM1A.21
CLL External documentation: COLM1A.22
CLL Unified Model Doc Paper C61 - Printed diagnostics COLM1A.23
CLL COLM1A.24
CLL ------------------------------------------------------------------- COLM1A.25
C*L Interface and arguments: ------------------------------------------ COLM1A.26
C COLM1A.27
SUBROUTINE COLM(VAR,COLMN,P_MASS,NX,NY,NZ) 15COLM1A.28
C COLM1A.29
IMPLICIT NONE COLM1A.30
C COLM1A.31
INTEGER COLM1A.32
1 NX, ! - Longitude: p,u-rows COLM1A.33
2 NY, ! - Latitude: rowlength COLM1A.34
3 NZ, ! - Level:p,u-level COLM1A.35
4 I, COLM1A.36
5 J, COLM1A.37
6 K COLM1A.38
REAL COLM1A.39
1 VAR(NY,NX,NZ), ! IN - Variable for calculation COLM1A.40
2 COLMN(NY,NX), ! OUT - Column mean of variable COLM1A.41
3 P_MASS(NY,NX,NZ) ! IN - Mass weighting (p,u-grid) COLM1A.42
CL COLM1A.43
C--- COLM1A.44
C Subroutines called COLM1A.45
C NONE COLM1A.46
C--- COLM1A.47
C COLM1A.48
C Local Variables COLM1A.49
C COLM1A.50
REAL COLM1A.51
1 SUMCBOT(NY,NX) COLM1A.52
C COLM1A.53
CL The calculation is self-explanatory COLM1A.54
C COLM1A.55
DO 100 I=1,NX COLM1A.56
DO 110 J=1,NY COLM1A.57
SUMCBOT(J,I)=0.0 COLM1A.58
COLMN(J,I) =0.0 COLM1A.59
110 CONTINUE COLM1A.60
100 CONTINUE COLM1A.61
C COLM1A.62
DO 200 K=1,NZ COLM1A.63
DO 210 I=1,NX COLM1A.64
DO 220 J=1,NY COLM1A.65
COLMN(J,I) = COLMN(J,I) + P_MASS(J,I,K)*VAR(J,I,K) COLM1A.66
SUMCBOT(J,I) = SUMCBOT(J,I) + P_MASS(J,I,K) COLM1A.67
220 CONTINUE COLM1A.68
210 CONTINUE COLM1A.69
200 CONTINUE COLM1A.70
C COLM1A.71
DO 300 I=1,NX COLM1A.72
DO 310 J=1,NY COLM1A.73
COLMN(J,I) = COLMN(J,I)/SUMCBOT(J,I) COLM1A.74
310 CONTINUE COLM1A.75
300 CONTINUE COLM1A.76
C COLM1A.77
RETURN COLM1A.78
END COLM1A.79
*ENDIF COLM1A.80