*IF DEF,A14_1A MASSUM1A.2
C ******************************COPYRIGHT****************************** GTS2F400.5779
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5780
C GTS2F400.5781
C Use, duplication or disclosure of this code is subject to the GTS2F400.5782
C restrictions as set forth in the contract. GTS2F400.5783
C GTS2F400.5784
C Meteorological Office GTS2F400.5785
C London Road GTS2F400.5786
C BRACKNELL GTS2F400.5787
C Berkshire UK GTS2F400.5788
C RG12 2SZ GTS2F400.5789
C GTS2F400.5790
C If no contract has been raised with this copy of the code, the use, GTS2F400.5791
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5792
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5793
C Modelling at the above address. GTS2F400.5794
C ******************************COPYRIGHT****************************** GTS2F400.5795
C GTS2F400.5796
CLL SUBROUTINE MASS_SUM----------------------------------------------- MASSUM1A.3
CLL MASSUM1A.4
CLL PURPOSE : PART OF ENERGY CORRECTION SUITE OF ROUTINES MASSUM1A.5
CLL - TO SUM MASS OF ATMOSPHERE GLOBALLY ON A LEVEL MASSUM1A.6
CLL MASSUM1A.7
CLL NOT SUITABLE FOR SINGLE COLUMN MODEL USE MASSUM1A.8
CLL MASSUM1A.9
CLL CODE WRITTEN FOR CRAY Y-MP BY D.GREGORY FEBRUARY 1991 MASSUM1A.10
CLL MASSUM1A.11
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: MASSUM1A.12
CLL VERSION DATE MASSUM1A.13
! 4.1 28/11/95 Changed interface to MASS_SUM to make APB5F401.107
! suitable for MPP use. P.Burton APB5F401.108
CLL MASSUM1A.14
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 MASSUM1A.15
CLL VERSION NO. 1 MASSUM1A.16
CLL MASSUM1A.17
CLL SYSTEM TASK : P## MASSUM1A.18
CLL MASSUM1A.19
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P### MASSUM1A.20
CLL MASSUM1A.21
CLLEND----------------------------------------------------------------- MASSUM1A.22
C MASSUM1A.23
C*L ARGUMENTS--------------------------------------------------------- MASSUM1A.24
C MASSUM1A.25
SUBROUTINE MASS_SUM (MASS,RS,AREA, 2,1APB5F401.109
& START_POINT,END_POINT,FIELD_SIZE, APB5F401.110
& TOT_MASS) APB5F401.111
C MASSUM1A.27
IMPLICIT NONE MASSUM1A.28
C MASSUM1A.29
*CALL C_G 
MASSUM1A.30
C MASSUM1A.31
C---------------------------------------------------------------------- MASSUM1A.32
C VECTOR LENGTHS MASSUM1A.33
C---------------------------------------------------------------------- MASSUM1A.34
C MASSUM1A.35
INTEGER START_POINT, ! IN point to start sum at APB5F401.112
& END_POINT, ! IN point to end sum at APB5F401.113
& FIELD_SIZE ! IN size of field APB5F401.114
C MASSUM1A.37
C MASSUM1A.38
C---------------------------------------------------------------------- MASSUM1A.39
C VARIABLES WHICH ARE INPUT MASSUM1A.40
C---------------------------------------------------------------------- MASSUM1A.41
C MASSUM1A.42
REAL MASS(FIELD_SIZE), ! IN mass to be summed APB5F401.115
& AREA(FIELD_SIZE), ! IN area of grid box APB5F401.116
& RS(FIELD_SIZE) ! IN radius at level of the mass APB5F401.117
C MASSUM1A.49
C---------------------------------------------------------------------- MASSUM1A.50
C VARIABLES WHICH ARE IN AND OUT MASSUM1A.51
C---------------------------------------------------------------------- MASSUM1A.52
C MASSUM1A.53
REAL TOT_MASS ! INOUT TOTAL MASS MASSUM1A.54
C MASSUM1A.55
C---------------------------------------------------------------------- MASSUM1A.56
C VARIABLES WHICH ARE DEFINED LOCALLY - NONE MASSUM1A.57
C---------------------------------------------------------------------- MASSUM1A.58
C MASSUM1A.59
REAL WORK(FIELD_SIZE) ! work array APB5F401.118
C MASSUM1A.61
C MASSUM1A.62
C---------------------------------------------------------------------- MASSUM1A.63
C INTERNAL LOOP COUNTERS MASSUM1A.64
C---------------------------------------------------------------------- MASSUM1A.65
C MASSUM1A.66
INTEGER I ! LOOP COUNTER MASSUM1A.67
C MASSUM1A.68
C MASSUM1A.69
C---------------------------------------------------------------------- MASSUM1A.70
C EXTERNAL SUBROUTINE CALLS - NONE MASSUM1A.71
C---------------------------------------------------------------------- MASSUM1A.72
C MASSUM1A.73
C*--------------------------------------------------------------------- MASSUM1A.74
CL MASSUM1A.75
CL--------------------------------------------------------------------- MASSUM1A.76
CL SUM MASS OVER LAYER MASSUM1A.77
CL--------------------------------------------------------------------- MASSUM1A.78
CL MASSUM1A.79
C MASSUM1A.80
C CALCULATE CONTRIBUTION TO MASS FROM EACH GRID BOX MASSUM1A.81
C MASSUM1A.82
DO I=START_POINT,END_POINT APB5F401.119
WORK(I) = RS(I)*RS(I)*AREA(I)*MASS(I)/G MASSUM1A.84
END DO MASSUM1A.85
C MASSUM1A.86
CALL DO_SUMS(WORK,FIELD_SIZE,START_POINT,END_POINT,1,TOT_MASS) APB5F401.120
C MASSUM1A.90
RETURN MASSUM1A.91
END MASSUM1A.92
*ENDIF MASSUM1A.93