*IF DEF,A14_1A,OR,DEF,A14_1B APB5F401.122
C ******************************COPYRIGHT****************************** GTS2F400.793
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.794
C GTS2F400.795
C Use, duplication or disclosure of this code is subject to the GTS2F400.796
C restrictions as set forth in the contract. GTS2F400.797
C GTS2F400.798
C Meteorological Office GTS2F400.799
C London Road GTS2F400.800
C BRACKNELL GTS2F400.801
C Berkshire UK GTS2F400.802
C RG12 2SZ GTS2F400.803
C GTS2F400.804
C If no contract has been raised with this copy of the code, the use, GTS2F400.805
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.806
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.807
C Modelling at the above address. GTS2F400.808
C ******************************COPYRIGHT****************************** GTS2F400.809
C GTS2F400.810
CLL SUBROUTINE CAL_ENG_MASS_CORR-------------------------------------- CEMCOR1A.3
CLL CEMCOR1A.4
CLL PURPOSE : PART OF ENERGY CORRECTION SUITE OF ROUTINES CEMCOR1A.5
CLL - TO CALCUATE THE NECESSARY CORRECTION TO CEMCOR1A.6
CLL TEMPERATURE TO CONSERVE TOTAL ENERGY CEMCOR1A.7
CLL CEMCOR1A.8
CLL NOT SUITABLE FOR SINGLE COLUMN MODEL USE CEMCOR1A.9
CLL CODE WRITTEN FOR CRAY Y-MP BY D.GREGORY FEBRUARY 1991 CEMCOR1A.10
CLL CEMCOR1A.11
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: CEMCOR1A.12
CLL VERSION DATE CEMCOR1A.13
!LL 4.1 23/04/96 MPP code : Only 1 processor to write diagnostic APB5F401.123
!LL information. P.Burton APB5F401.124
!LL 4.3 29/04/97 Correct Write Statement. D. Robinson GDR1F403.3
CLL CEMCOR1A.14
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 CEMCOR1A.15
CLL VERSION NO. 1 CEMCOR1A.16
CLL CEMCOR1A.17
CLL LOGICAL TASK : CEMCOR1A.18
CLL CEMCOR1A.19
CLL PROJECT TASK : CEMCOR1A.20
CLL CEMCOR1A.21
CLL DOCUMENTATION : CEMCOR1A.22
CLL CEMCOR1A.23
CLLEND----------------------------------------------------------------- CEMCOR1A.24
C CEMCOR1A.25
C*L ARGUMENTS--------------------------------------------------------- CEMCOR1A.26
C CEMCOR1A.27
SUBROUTINE CAL_ENG_MASS_CORR (TOT_FLUXES,TOT_ENERGY_INIT, 1CEMCOR1A.28
1 TOT_ENERGY_FINAL,TOT_MASS_INIT, CEMCOR1A.29
2 TOT_MASS_FINAL,PART_TOT_MASS, CEMCOR1A.30
3 P_FIELD,NPNTS,ENERGY_CORR,PSTAR, CEMCOR1A.31
*CALL ARGFLDPT 
APB5F401.125
4 DX,DY) CEMCOR1A.32
C CEMCOR1A.33
C CEMCOR1A.34
IMPLICIT NONE CEMCOR1A.35
C CEMCOR1A.36
*CALL C_R_CP CEMCOR1A.37
*CALL C_A CEMCOR1A.38
*CALL C_PI CEMCOR1A.39
C---------------------------------------------------------------------- CEMCOR1A.40
C VECTOR LENGTHS CEMCOR1A.41
C---------------------------------------------------------------------- CEMCOR1A.42
C CEMCOR1A.43
INTEGER P_FIELD ! IN VECTOR LENGTH OF P GRID CEMCOR1A.44
C CEMCOR1A.45
INTEGER NPNTS ! IN VECTOR LENGTH OF CALCULATIONS CEMCOR1A.46
C CEMCOR1A.47
! All TYPFLDPT arguments are intent IN APB5F401.126
*CALL TYPFLDPT APB5F401.127
APB5F401.128
C---------------------------------------------------------------------- CEMCOR1A.48
C VARIABLES WHICH ARE INPUT CEMCOR1A.49
C---------------------------------------------------------------------- CEMCOR1A.50
C CEMCOR1A.51
C CEMCOR1A.52
REAL TOT_FLUXES ! IN TOTAL OF FLUXES THROUGH ATMOSPHERE CEMCOR1A.53
C CEMCOR1A.54
REAL TOT_ENERGY_INIT ! IN TOTAL ENERGY OF ATMOSPHERE CEMCOR1A.55
! AT START OF MODEL CEMCOR1A.56
C CEMCOR1A.57
REAL TOT_MASS_INIT ! IN TOTAL MASS OF ATMOSPHERE CEMCOR1A.58
! AT START OF MODEL CEMCOR1A.59
C CEMCOR1A.60
REAL TOT_ENERGY_FINAL ! IN TOTAL ENERGY OF ATMOSPHERE CEMCOR1A.61
! AT END OF ONE DAY CEMCOR1A.62
C CEMCOR1A.63
REAL TOT_MASS_FINAL ! IN TOTAL MASS OF ATMOSPHERE CEMCOR1A.64
! AT END OF ONE DAY CEMCOR1A.65
C CEMCOR1A.66
REAL PART_TOT_MASS ! IN FACTOR TO CALCULATE PSTAR CEMCOR1A.67
! CORRECTION CEMCOR1A.68
C CEMCOR1A.69
REAL DX ! EW GRID SPACING IN DEGREES CEMCOR1A.70
C CEMCOR1A.71
REAL DY ! NS GRID SPACING IN DEGREES CEMCOR1A.72
C CEMCOR1A.73
C CEMCOR1A.74
C---------------------------------------------------------------------- CEMCOR1A.75
C VARIABLES WHICH ARE IN AND OUT CEMCOR1A.76
C---------------------------------------------------------------------- CEMCOR1A.77
C CEMCOR1A.78
REAL PSTAR(P_FIELD) ! INOUT PRESSURE CEMCOR1A.79
C CEMCOR1A.80
REAL ENERGY_CORR ! INOUT ENERGY CORRECTION FACTOR CEMCOR1A.81
C CEMCOR1A.82
C CEMCOR1A.83
C---------------------------------------------------------------------- CEMCOR1A.84
C VARIABLES WHICH ARE DEFINED LOCALLY CEMCOR1A.85
C---------------------------------------------------------------------- CEMCOR1A.86
C CEMCOR1A.87
REAL CHG_ENERGY ! CHANGE IN ENERGY CEMCOR1A.88
C CEMCOR1A.89
REAL ERROR_ENERGY ! ERROR IN ENERGY CALCULATION CEMCOR1A.90
C CEMCOR1A.91
REAL PSTAR_CORR ! CORRECTION FACTOR TO PSTAR CEMCOR1A.92
C CEMCOR1A.93
C---------------------------------------------------------------------- CEMCOR1A.94
C INTERNAL LOOP COUNTERS CEMCOR1A.95
C---------------------------------------------------------------------- CEMCOR1A.96
C CEMCOR1A.97
INTEGER I ! LOOP COUNTER CEMCOR1A.98
C CEMCOR1A.99
C CEMCOR1A.100
C---------------------------------------------------------------------- CEMCOR1A.101
C EXTERNAL SUBROUTINE CALLS - NONE CEMCOR1A.102
C---------------------------------------------------------------------- CEMCOR1A.103
C CEMCOR1A.104
C*--------------------------------------------------------------------- CEMCOR1A.105
C CEMCOR1A.106
C====================================================================== CEMCOR1A.107
C CALCULATION OF TEMPERATURE CHANGE TO BE ADDED OVER THE NEXT DAY CEMCOR1A.108
C TO CORRECT FOR ERROR IN ENERGY BUDGET DURING PRESENT DAY CEMCOR1A.109
C====================================================================== CEMCOR1A.110
C CEMCOR1A.111
C CEMCOR1A.112
C---------------------------------------------------------------------- CEMCOR1A.113
C CALCULATE ENERGY CHANGE DURING THE DAY CEMCOR1A.114
C---------------------------------------------------------------------- CEMCOR1A.115
C CEMCOR1A.116
CHG_ENERGY = TOT_ENERGY_FINAL - TOT_ENERGY_INIT CEMCOR1A.117
C CEMCOR1A.118
C CEMCOR1A.119
C---------------------------------------------------------------------- CEMCOR1A.120
C CALCULATE ERROR = DIFFERENCE BETWEEN CHANGE IN TOTAL ENERGY CEMCOR1A.121
C DURING THE DAY AND THAT EXPECTED DUE TO THE FLUXES OF ENERGY INTO CEMCOR1A.122
C THE ATMOSPHERE CEMCOR1A.123
C----------------------------------------------------------------------- CEMCOR1A.124
C CEMCOR1A.125
ERROR_ENERGY = TOT_FLUXES - CHG_ENERGY CEMCOR1A.126
C CEMCOR1A.127
C CEMCOR1A.128
C----------------------------------------------------------------------- CEMCOR1A.129
C CALCULATE TEMPERATURE CHANGE TO BE APPLIED OVER THE CEMCOR1A.130
C NEXT DAY TO CORRECT FOR THE ERROR CEMCOR1A.131
C----------------------------------------------------------------------- CEMCOR1A.132
C CEMCOR1A.133
ENERGY_CORR = ERROR_ENERGY / (CP*TOT_MASS_INIT) CEMCOR1A.134
C CEMCOR1A.135
C CEMCOR1A.136
C---------------------------------------------------------------------- CEMCOR1A.137
C CALCULATE RATE OF TEMPERATURE CHANGE WHICH NEEDE TO BE CEMCOR1A.138
C APPLIED OVER NEXT DAY TO CORRECT FOR ERROR CEMCOR1A.139
C---------------------------------------------------------------------- CEMCOR1A.140
C CEMCOR1A.141
ENERGY_CORR = ENERGY_CORR / 86400.0 CEMCOR1A.142
C CEMCOR1A.143
C CEMCOR1A.144
C---------------------------------------------------------------------- CEMCOR1A.145
C DIAGNOSTICS CEMCOR1A.146
C---------------------------------------------------------------------- CEMCOR1A.147
C CEMCOR1A.148
*IF DEF,MPP APB5F401.129
IF (MY_PROC_ID .EQ. 0) THEN APB5F401.130
*ENDIF APB5F401.131
WRITE(6,100) TOT_ENERGY_FINAL,TOT_ENERGY_INIT, CEMCOR1A.149
1 CHG_ENERGY,TOT_FLUXES,ERROR_ENERGY, CEMCOR1A.150
2 ENERGY_CORR*86400.0,ENERGY_CORR, CEMCOR1A.151
3 (PI*ERROR_ENERGY*DX*DY)/(A*A*360.0*360.0*86400.0) CEMCOR1A.152
C CEMCOR1A.153
100 FORMAT (1X,'FINAL TOTAL ENERGY = ',E13.5,' J/ '/ CEMCOR1A.154
1 1X,'INITIAL TOTAL ENERGY = ',E13.5,' J/ '/ CEMCOR1A.155
2 1X,'CHG IN TOTAL ENERGY OVER DAY = ',E13.5,' J/ '/ CEMCOR1A.156
3 1X,'FLUXES INTO ATM OVER DAY = ',E13.5,' J/ '/ CEMCOR1A.157
4 1X,'ERROR IN ENERGY BUDGET = ',E13.5,' J/ '/ CEMCOR1A.158
5 1X,'TEMP CORRECTION OVER DAY = ',E13.5,' K '/ CEMCOR1A.159
6 1X,'TEMPERATURE CORRECTION RATE = ',E13.5,' K/S '/ CEMCOR1A.160
7 1X,'FLUX CORRECTION (ATM) = ',E13.5,' W/M2 ') CEMCOR1A.161
*IF DEF,MPP APB5F401.132
ENDIF APB5F401.133
*ENDIF APB5F401.134
C CEMCOR1A.162
C CEMCOR1A.163
C====================================================================== CEMCOR1A.164
C CORRECTION OF PSTAR TO ENSURE MASS CONSERVATION CEMCOR1A.165
C====================================================================== CEMCOR1A.166
C CEMCOR1A.167
C CEMCOR1A.168
C---------------------------------------------------------------------- CEMCOR1A.169
C CALCULATE CORRECTION TO BE APPLIED TO PSTAR CEMCOR1A.170
C---------------------------------------------------------------------- CEMCOR1A.171
C CEMCOR1A.172
PSTAR_CORR = 1.0 + (TOT_MASS_INIT - TOT_MASS_FINAL) / CEMCOR1A.173
1 PART_TOT_MASS CEMCOR1A.174
C CEMCOR1A.175
WRITE(6,200) TOT_MASS_FINAL,TOT_MASS_INIT, GDR1F403.4
1 PSTAR_CORR CEMCOR1A.177
C CEMCOR1A.178
200 FORMAT (1X,'FINAL ATM MASS = ',E13.5,' KG '/ CEMCOR1A.179
1 1X,'INITIAL ATM MASS = ',E13.5,' KG '/ CEMCOR1A.180
2 1X,'CORRECTION FACTOR FOR PSTAR = ',E13.5) CEMCOR1A.181
C CEMCOR1A.182
C CEMCOR1A.183
C---------------------------------------------------------------------- CEMCOR1A.184
C CORRECT PSTAR TO CONSERVE GLOBAL MASS OF ATMOSPHERE CEMCOR1A.185
C---------------------------------------------------------------------- CEMCOR1A.186
C CEMCOR1A.187
DO I=1,NPNTS CEMCOR1A.188
PSTAR(I) = PSTAR(I) * PSTAR_CORR CEMCOR1A.189
END DO CEMCOR1A.190
C CEMCOR1A.191
RETURN CEMCOR1A.192
END CEMCOR1A.193
*ENDIF CEMCOR1A.194