*IF DEF,A14_1B EMCALC1B.2
C *****************************COPYRIGHT****************************** EMCALC1B.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. EMCALC1B.4
C EMCALC1B.5
C Use, duplication or disclosure of this code is subject to the EMCALC1B.6
C restrictions as set forth in the contract. EMCALC1B.7
C EMCALC1B.8
C Meteorological Office EMCALC1B.9
C London Road EMCALC1B.10
C BRACKNELL EMCALC1B.11
C Berkshire UK EMCALC1B.12
C RG12 2SZ EMCALC1B.13
C EMCALC1B.14
C If no contract has been raised with this copy of the code, the use, EMCALC1B.15
C duplication or disclosure of it is strictly prohibited. Permission EMCALC1B.16
C to do so must first be obtained in writing from the Head of Numerical EMCALC1B.17
C Modelling at the above address. EMCALC1B.18
C ******************************COPYRIGHT****************************** EMCALC1B.19
!+ Contains subroutines CALC_ENERGY_SUM_ARRAY and CALC_MASS_SUM_ARRAY EMCALC1B.20
! called from deck EMDIAG1B EMCALC1B.21
! These routines calculate the numbers that must eventually be EMCALC1B.22
! globally summed. EMCALC1B.23
! EMCALC1B.24
! EMCALC1B.25
! Subroutine Interface: EMCALC1B.26
SUBROUTINE CALC_ENERGY_SUM_ARRAY(VAR,AREA,MASS,RS,CONV_FACT, 3EMCALC1B.27
& FIELD_SIZE,START_POINT,END_POINT, EMCALC1B.28
& SUM_ARRAY) EMCALC1B.29
IMPLICIT NONE EMCALC1B.30
! EMCALC1B.31
! Description: EMCALC1B.32
! Part of the energy correction suite of routines: EMCALC1B.33
! Calculates the energy of each grid box based on field VAR, between the EMCALC1B.34
! points START_POINT and END_POINT and adds this in to the corresponding EMCALC1B.35
! grid box on SUM_ARRAY EMCALC1B.36
! EMCALC1B.37
! Method: EMCALC1B.38
! Look at the code! EMCALC1B.39
! EMCALC1B.40
! Current code owner : Paul Burton EMCALC1B.41
! EMCALC1B.42
! History EMCALC1B.43
! Model Date Modification history from model version 4.1 EMCALC1B.44
! version EMCALC1B.45
! 4.1 7/11/95 New DECK created to make EMDIAG suitable for EMCALC1B.46
! MPP use. P.Burton EMCALC1B.47
! EMCALC1B.48
! Subroutine Arguments: EMCALC1B.49
EMCALC1B.50
INTEGER FIELD_SIZE, ! IN size of filed VAR and SUM_ARRAY EMCALC1B.51
& START_POINT, ! IN point to start at EMCALC1B.52
& END_POINT ! IN point to end at EMCALC1B.53
EMCALC1B.54
REAL VAR(FIELD_SIZE), ! IN energy variable EMCALC1B.55
& AREA(FIELD_SIZE), ! IN area of each grid box EMCALC1B.56
& MASS(FIELD_SIZE), ! IN mass of each grid box EMCALC1B.57
& RS(FIELD_SIZE), ! IN radius at this level EMCALC1B.58
& SUM_ARRAY(FIELD_SIZE) ! INOUT contains array which will be EMCALC1B.59
! ! globally summed EMCALC1B.60
EMCALC1B.61
REAL CONV_FACT ! IN conversion factor to translate EMCALC1B.62
! ! flux into energy units EMCALC1B.63
EMCALC1B.64
! Parameters EMCALC1B.65
*CALL C_G 
EMCALC1B.66
EMCALC1B.67
! Local variables EMCALC1B.68
EMCALC1B.69
INTEGER I ! loop variable EMCALC1B.70
EMCALC1B.71
! loop from START_POINT to END_POINT and add energy at grid box EMCALC1B.72
! to the SUM_ARRAY EMCALC1B.73
EMCALC1B.74
DO I=START_POINT,END_POINT EMCALC1B.75
SUM_ARRAY(I)=SUM_ARRAY(I)+ EMCALC1B.76
& RS(I)*RS(I)*AREA(I)*MASS(I)*VAR(I)*CONV_FACT/G EMCALC1B.77
ENDDO EMCALC1B.78
EMCALC1B.79
RETURN EMCALC1B.80
END EMCALC1B.81
EMCALC1B.82
EMCALC1B.83
! Subroutine Interface: EMCALC1B.84
SUBROUTINE CALC_MASS_SUM_ARRAY(VAR,AREA,RS, 2EMCALC1B.85
& FIELD_SIZE,START_POINT,END_POINT, EMCALC1B.86
& SUM_ARRAY) EMCALC1B.87
IMPLICIT NONE EMCALC1B.88
! EMCALC1B.89
! Description: EMCALC1B.90
! Part of the energy correction suite of routines: EMCALC1B.91
! Calculates the mass of each grid box based on field VAR, between the EMCALC1B.92
! points START_POINT and END_POINT and adds this in to the corresponding EMCALC1B.93
! grid box on SUM_ARRAY EMCALC1B.94
! EMCALC1B.95
! Method: EMCALC1B.96
! Look at the code! EMCALC1B.97
! EMCALC1B.98
! Current code owner : Paul Burton EMCALC1B.99
! EMCALC1B.100
! History EMCALC1B.101
! Model Date Modification history from model version 4.1 EMCALC1B.102
! version EMCALC1B.103
! 4.1 7/11/95 New DECK created to make EMDIAG suitable for EMCALC1B.104
! MPP use. P.Burton EMCALC1B.105
! EMCALC1B.106
! Subroutine Arguments: EMCALC1B.107
EMCALC1B.108
INTEGER FIELD_SIZE, ! IN size of filed VAR and SUM_ARRAY EMCALC1B.109
& START_POINT, ! IN point to start at EMCALC1B.110
& END_POINT ! IN point to end at EMCALC1B.111
EMCALC1B.112
REAL VAR(FIELD_SIZE), ! IN energy variable EMCALC1B.113
& AREA(FIELD_SIZE), ! IN area of each grid box EMCALC1B.114
& RS(FIELD_SIZE), ! IN radius at this level EMCALC1B.115
& SUM_ARRAY(FIELD_SIZE) ! INOUT contains array which will be EMCALC1B.116
! ! globally summed EMCALC1B.117
EMCALC1B.118
! Parameters EMCALC1B.119
*CALL C_G EMCALC1B.120
EMCALC1B.121
! Local variables EMCALC1B.122
EMCALC1B.123
INTEGER I ! loop variable EMCALC1B.124
EMCALC1B.125
! loop from START_POINT to END_POINT and add energy at grid box EMCALC1B.126
! to the SUM_ARRAY EMCALC1B.127
EMCALC1B.128
DO I=START_POINT,END_POINT EMCALC1B.129
SUM_ARRAY(I)=SUM_ARRAY(I)+ EMCALC1B.130
& RS(I)*RS(I)*AREA(I)*VAR(I)/G EMCALC1B.131
ENDDO EMCALC1B.132
EMCALC1B.133
RETURN EMCALC1B.134
END EMCALC1B.135
*ENDIF EMCALC1B.136