*IF DEF,A03_7A SCREEN7A.2
C *****************************COPYRIGHT****************************** SCREEN7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SCREEN7A.4
C SCREEN7A.5
C Use, duplication or disclosure of this code is subject to the SCREEN7A.6
C restrictions as set forth in the contract. SCREEN7A.7
C SCREEN7A.8
C Meteorological Office SCREEN7A.9
C London Road SCREEN7A.10
C BRACKNELL SCREEN7A.11
C Berkshire UK SCREEN7A.12
C RG12 2SZ SCREEN7A.13
C SCREEN7A.14
C If no contract has been raised with this copy of the code, the use, SCREEN7A.15
C duplication or disclosure of it is strictly prohibited. Permission SCREEN7A.16
C to do so must first be obtained in writing from the Head of Numerical SCREEN7A.17
C Modelling at the above address. SCREEN7A.18
C ******************************COPYRIGHT****************************** SCREEN7A.19
!!! SUBROUTINE SCREEN_TQ---------------------------------------------- SCREEN7A.20
!!! SCREEN7A.21
!!! Purpose: Diagnose temperature and/or specific humidity at screen SCREEN7A.22
!!! height (1.5 metres), as requested via the STASH flags. SCREEN7A.23
!!! This version outputs gridbox-average diagnostics over SCREEN7A.24
!!! land surface tiles, but diagnostics for individual tiles SCREEN7A.25
!!! could be made available as well. SCREEN7A.26
!!! SCREEN7A.27
!!! SCREEN7A.28
!!! Model Modification history: SCREEN7A.29
!!! version Date SCREEN7A.30
!!! SCREEN7A.31
!!! 4.4 8/97 New deck for MOSES II (R. Essery) SCREEN7A.32
!!! SCREEN7A.33
!!!--------------------------------------------------------------------- SCREEN7A.34
SUBROUTINE SCREEN_TQ ( 1,2SCREEN7A.35
& P_POINTS,P_FIELD,P1,LAND1,LAND_PTS,LAND_FIELD,NTYPE, SCREEN7A.36
& LAND_INDEX,TILE_INDEX,TILE_PTS,LAND_MASK, SCREEN7A.37
& SQ1P5,ST1P5,CHR1P5M,CHR1P5M_SICE,PSTAR,QW_1,RESFT, SCREEN7A.38
& TILE_FRAC,TL_1,TSTAR,TSTAR_TILE, SCREEN7A.39
& Z0H,Z0H_TILE,Z0M,Z0M_TILE,Z1, SCREEN7A.40
& Q1P5M,T1P5M SCREEN7A.41
& ) SCREEN7A.42
SCREEN7A.43
IMPLICIT NONE SCREEN7A.44
SCREEN7A.45
INTEGER SCREEN7A.46
& P_POINTS ! IN Number of P-grid points to be SCREEN7A.47
! ! processed. SCREEN7A.48
&,P_FIELD ! IN Total number of P-grid points. SCREEN7A.49
&,P1 ! IN First P-point to be processed. SCREEN7A.50
&,LAND1 ! IN First land point to be processed. SCREEN7A.51
&,LAND_PTS ! IN Number of land points to be processed. SCREEN7A.52
&,LAND_FIELD ! IN Total number of land points. SCREEN7A.53
&,NTYPE ! IN Number of tiles per land point. SCREEN7A.54
&,LAND_INDEX(P_FIELD) ! IN Index of land points. SCREEN7A.55
&,TILE_INDEX(LAND_FIELD,NTYPE) SCREEN7A.56
! ! IN Index of tile points. SCREEN7A.57
&,TILE_PTS(NTYPE) ! IN Number of tile points. SCREEN7A.58
SCREEN7A.59
LOGICAL SCREEN7A.60
& LAND_MASK(P_FIELD) ! IN T for land points, F otherwise. SCREEN7A.61
&,SQ1P5 ! IN STASH flag for 1.5-metre sp humidity. SCREEN7A.62
&,ST1P5 ! IN STASH flag for 1.5-metre temperature. SCREEN7A.63
SCREEN7A.64
REAL SCREEN7A.65
& CHR1P5M(LAND_FIELD,NTYPE) SCREEN7A.66
! ! IN Ratio of coefficients for SCREEN7A.67
! ! calculation of 1.5 m T. SCREEN7A.68
&,CHR1P5M_SICE(P_FIELD)! IN Ratio of coefficients for SCREEN7A.69
! ! calculation of 1.5 m T. SCREEN7A.70
&,PSTAR(P_FIELD) ! IN Surface pressure (Pa). SCREEN7A.71
&,QW_1(P_FIELD) ! IN Total water content of lowest SCREEN7A.72
! atmospheric layer (kg per kg air). SCREEN7A.73
&,RESFT(LAND_FIELD,NTYPE) SCREEN7A.74
! ! IN Surface resistance factor. SCREEN7A.75
&,TILE_FRAC(LAND_FIELD,NTYPE) SCREEN7A.76
! ! IN Tile fractions. SCREEN7A.77
&,TL_1(P_FIELD) ! IN Liquid/frozen water temperature for SCREEN7A.78
! lowest atmospheric layer (K). SCREEN7A.79
&,TSTAR(P_FIELD) ! IN Gridbox mean surface temperature (K). SCREEN7A.80
&,TSTAR_TILE(LAND_FIELD,NTYPE) SCREEN7A.81
! ! IN Tile surface temperatures (K). SCREEN7A.82
&,Z0H(P_FIELD) ! IN Roughness length for heat and SCREEN7A.83
! ! moisture (m). SCREEN7A.84
&,Z0H_TILE(LAND_FIELD,NTYPE) SCREEN7A.85
! ! IN Tile roughness lengths for heat and SCREEN7A.86
! ! moisture (m). SCREEN7A.87
&,Z0M(P_FIELD) ! IN Roughness length for momentum (m). SCREEN7A.88
&,Z0M_TILE(LAND_FIELD,NTYPE) SCREEN7A.89
! ! IN Tile roughness lengths for momentum (m) SCREEN7A.90
&,Z1(P_FIELD) ! IN Height of lowest atmospheric level (m). SCREEN7A.91
SCREEN7A.92
REAL SCREEN7A.93
& Q1P5M(P_FIELD) ! OUT Specific humidity at screen height of SCREEN7A.94
! ! 1.5 metres (kg water per kg air). SCREEN7A.95
&,T1P5M(P_FIELD) ! OUT Temperature at screen height of SCREEN7A.96
! ! 1.5 metres (K). SCREEN7A.97
SCREEN7A.98
REAL SCREEN7A.99
& CER1P5M ! Ratio of coefficients reqd for SCREEN7A.100
! ! calculation of 1.5 m Q. SCREEN7A.101
&,PSTAR_LAND(LAND_FIELD)! Surface pressure for land points. SCREEN7A.102
&,QS(P_FIELD) ! Surface saturated sp humidity. SCREEN7A.103
&,QS_TILE(LAND_FIELD) ! Surface saturated sp humidity. SCREEN7A.104
&,Q ! Local Q at 1.5 m. SCREEN7A.105
&,T ! Local T at 1.5 m. SCREEN7A.106
SCREEN7A.107
INTEGER SCREEN7A.108
& I ! Loop counter (horizontal field index). SCREEN7A.109
&,J ! Loop counter (tile point index). SCREEN7A.110
&,L ! Loop counter (land point field index). SCREEN7A.111
&,N ! Loop counter (tile index). SCREEN7A.112
SCREEN7A.113
! Local and other symbolic constants used :- SCREEN7A.114
SCREEN7A.115
*CALL C_G 
SCREEN7A.116
*CALL C_HT_M SCREEN7A.117
*CALL C_R_CP SCREEN7A.118
REAL GRCP SCREEN7A.119
PARAMETER ( GRCP = G / CP ) SCREEN7A.120
SCREEN7A.121
!----------------------------------------------------------------------- SCREEN7A.122
! Diagnose local and GBM temperatures at 1.5 m if requested via ST1P5 SCREEN7A.123
!----------------------------------------------------------------------- SCREEN7A.124
IF (ST1P5) THEN SCREEN7A.125
SCREEN7A.126
DO I=P1,P1+P_POINTS-1 SCREEN7A.127
T1P5M(I) = 0. SCREEN7A.128
IF ( .NOT.LAND_MASK(I) ) THEN SCREEN7A.129
T1P5M(I) = TSTAR(I) - GRCP*Z1P5M + CHR1P5M_SICE(I) * SCREEN7A.130
& (TL_1(I) - TSTAR(I) + GRCP*(Z1(I)+Z0M(I)-Z0H(I))) SCREEN7A.131
ENDIF SCREEN7A.132
ENDDO SCREEN7A.133
SCREEN7A.134
DO N=1,NTYPE SCREEN7A.135
DO J=1,TILE_PTS(N) SCREEN7A.136
L = TILE_INDEX(J,N) SCREEN7A.137
I = LAND_INDEX(L) SCREEN7A.138
T = TSTAR_TILE(L,N) - GRCP*Z1P5M + CHR1P5M(L,N) * SCREEN7A.139
& ( TL_1(I) - TSTAR_TILE(L,N) + SCREEN7A.140
& GRCP*(Z1(I)+Z0M_TILE(L,N)-Z0H_TILE(L,N)) ) SCREEN7A.141
T1P5M(I) = T1P5M(I) + TILE_FRAC(L,N)*T SCREEN7A.142
ENDDO SCREEN7A.143
ENDDO SCREEN7A.144
SCREEN7A.145
ENDIF SCREEN7A.146
SCREEN7A.147
!----------------------------------------------------------------------- SCREEN7A.148
! Diagnose local and GBM humidities at 1.5 m if requested via SQ1P5 SCREEN7A.149
!----------------------------------------------------------------------- SCREEN7A.150
IF (SQ1P5) THEN SCREEN7A.151
SCREEN7A.152
CALL QSAT(QS(P1),TSTAR(P1),PSTAR(P1),P_POINTS) SCREEN7A.153
DO I=P1,P1+P_POINTS-1 SCREEN7A.154
Q1P5M(I) = 0. SCREEN7A.155
IF ( .NOT.LAND_MASK(I) ) THEN SCREEN7A.156
CER1P5M = CHR1P5M_SICE(I) - 1. SCREEN7A.157
Q1P5M(I) = QW_1(I) + CER1P5M*( QW_1(I) - QS(I) ) SCREEN7A.158
ENDIF SCREEN7A.159
ENDDO SCREEN7A.160
SCREEN7A.161
DO L=LAND1,LAND1+LAND_PTS-1 SCREEN7A.162
I = LAND_INDEX(L) SCREEN7A.163
PSTAR_LAND(L) = PSTAR(I) SCREEN7A.164
ENDDO SCREEN7A.165
SCREEN7A.166
DO N=1,NTYPE SCREEN7A.167
CALL QSAT(QS_TILE(LAND1),TSTAR_TILE(LAND1,N), SCREEN7A.168
& PSTAR_LAND(LAND1),LAND_PTS) SCREEN7A.169
DO J=1,TILE_PTS(N) SCREEN7A.170
L = TILE_INDEX(J,N) SCREEN7A.171
I = LAND_INDEX(L) SCREEN7A.172
CER1P5M = RESFT(L,N)*(CHR1P5M(L,N) - 1.) SCREEN7A.173
Q = QW_1(I) + CER1P5M*( QW_1(I) - QS_TILE(L) ) SCREEN7A.174
Q1P5M(I) = Q1P5M(I) + TILE_FRAC(L,N)*Q SCREEN7A.175
ENDDO SCREEN7A.176
ENDDO SCREEN7A.177
SCREEN7A.178
ENDIF SCREEN7A.179
SCREEN7A.180
RETURN SCREEN7A.181
END SCREEN7A.182
*ENDIF SCREEN7A.183