*IF DEF,A03_7A VSHRZ7A.2
C *****************************COPYRIGHT****************************** VSHRZ7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. VSHRZ7A.4
C VSHRZ7A.5
C Use, duplication or disclosure of this code is subject to the VSHRZ7A.6
C restrictions as set forth in the contract. VSHRZ7A.7
C VSHRZ7A.8
C Meteorological Office VSHRZ7A.9
C London Road VSHRZ7A.10
C BRACKNELL VSHRZ7A.11
C Berkshire UK VSHRZ7A.12
C RG12 2SZ VSHRZ7A.13
C VSHRZ7A.14
C If no contract has been raised with this copy of the code, the use, VSHRZ7A.15
C duplication or disclosure of it is strictly prohibited. Permission VSHRZ7A.16
C to do so must first be obtained in writing from the Head of Numerical VSHRZ7A.17
C Modelling at the above address. VSHRZ7A.18
C ******************************COPYRIGHT****************************** VSHRZ7A.19
!!! SUBROUTINE VSHR_Z1------------------------------------------------ VSHRZ7A.20
!!! VSHRZ7A.21
!!! Purpose: Calculate level 1 height and windshear for use in routine VSHRZ7A.22
!!! PHYSIOL. VSHRZ7A.23
!!! VSHRZ7A.24
!!! Model Modification history: VSHRZ7A.25
!!! version Date VSHRZ7A.26
!!! 4.4 7/97 New deck for MOSES II (R. Essery) VSHRZ7A.27
!!! 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.76
!!! VSHRZ7A.28
!!!--------------------------------------------------------------------- VSHRZ7A.29
SUBROUTINE VSHR_Z1 ( 1,5VSHRZ7A.30
& P_FIELD,U_FIELD,LTIMER, VSHRZ7A.31
& N_ROWS,FIRST_ROW,ROW_LENGTH, VSHRZ7A.33
& AKH,BKH,EXNER,PSTAR,Q,QCF,QCL,T,U_1,V_1,U_0,V_0, VSHRZ7A.35
& VSHR,Z1 VSHRZ7A.36
& ) VSHRZ7A.37
VSHRZ7A.38
IMPLICIT NONE VSHRZ7A.39
VSHRZ7A.40
INTEGER VSHRZ7A.41
& P_FIELD ! IN No. of P-points in whole grid. VSHRZ7A.42
&,U_FIELD ! IN No. of UV-points in whole grid. VSHRZ7A.43
&,N_ROWS ! IN No. of rows to be treated. VSHRZ7A.45
&,FIRST_ROW ! IN First row of data to be treated. VSHRZ7A.46
&,ROW_LENGTH ! IN No. of points in one row. VSHRZ7A.47
VSHRZ7A.49
LOGICAL VSHRZ7A.50
& LTIMER ! IN Logical switch for TIMER diags VSHRZ7A.51
VSHRZ7A.52
REAL VSHRZ7A.53
& AKH(2) ! IN Hybrid 'A' for layer 1. ABX1F405.836
&,BKH(2) ! IN Hybrid 'B' for layer 1. ABX1F405.837
&,EXNER(P_FIELD,2) ! IN Exner function. VSHRZ7A.56
&,PSTAR(P_FIELD) ! IN Surface pressure (Pascals). VSHRZ7A.57
&,Q(P_FIELD) ! IN Specific humidity (kg/kg air). VSHRZ7A.58
&,QCF(P_FIELD) ! IN Cloud ice (kg/kg air). VSHRZ7A.59
&,QCL(P_FIELD) ! IN Cloud liquid water (kg/kg air). VSHRZ7A.60
&,T(P_FIELD) ! IN Atmospheric temperature (K). VSHRZ7A.61
&,U_1(U_FIELD) ! IN W'ly wind component (m/s) VSHRZ7A.62
&,V_1(U_FIELD) ! IN S'ly wind component (m/s) VSHRZ7A.63
&,U_0(U_FIELD) ! IN W'ly component of surface VSHRZ7A.64
! ! current (m/s). VSHRZ7A.65
&,V_0(U_FIELD) ! IN S'ly component of surface VSHRZ7A.66
! ! current (m/s). VSHRZ7A.67
VSHRZ7A.68
VSHRZ7A.69
REAL VSHRZ7A.70
& VSHR(P_FIELD) ! OUT Magnitude of surface-to-lowest VSHRZ7A.71
! ! atm level wind shear (m/s). VSHRZ7A.72
&,Z1(P_FIELD) ! OUT Height of lowest level (m). VSHRZ7A.73
VSHRZ7A.74
REAL VSHRZ7A.75
& DZL(P_FIELD) ! Depth of layer 1 (m). VSHRZ7A.76
&,RDZ(P_FIELD) ! Reciprocal of the height of level 1 VSHRZ7A.77
&,TV(P_FIELD) ! Virtual temperature. VSHRZ7A.78
&,U_1_P(P_FIELD) ! U_1 on P-grid. VSHRZ7A.79
&,U_0_P(P_FIELD) ! U_0 on P-grid. VSHRZ7A.80
&,V_1_P(P_FIELD) ! V_1 on P-grid. VSHRZ7A.81
&,V_0_P(P_FIELD) ! V_0 on P-grid. VSHRZ7A.82
&,ZLB(P_FIELD,0:1) ! ZLB(,K) is the height of the upper VSHRZ7A.83
! ! boundary of layer K ( = 0 for K=0). VSHRZ7A.84
VSHRZ7A.85
REAL VSHRZ7A.86
& USHEAR ! U-component of surface-to-lowest-level wind shear. VSHRZ7A.87
&,VSHEAR ! V-component of surface-to-lowest-level wind shear. VSHRZ7A.88
&,VSHR2 ! Square of magnitude of surface-to-lowest-level VSHRZ7A.89
! ! wind shear. VSHRZ7A.90
VSHRZ7A.91
INTEGER VSHRZ7A.92
& I ! Loop counter (horizontal field index). VSHRZ7A.93
&,P1 ! First P-point to be processed. VSHRZ7A.94
&,P_POINTS ! No. of P-points being processed. VSHRZ7A.95
&,U1 ! First UV-point to be processed. VSHRZ7A.96
&,N_P_ROWS ! No. of P-rows being processed. VSHRZ7A.98
&,N_U_ROWS ! No. of UV-rows being processed. VSHRZ7A.99
&,U_POINTS ! No. of UV-points being processed. VSHRZ7A.100
VSHRZ7A.101
*IF DEF,SCMA AJC1F405.77
EXTERNAL UV_TO_P VSHRZ7A.102
*ENDIF VSHRZ7A.103
VSHRZ7A.104
EXTERNAL Z VSHRZ7A.105
VSHRZ7A.106
*IF -DEF,SCMA AJC1F405.78
N_P_ROWS = N_ROWS VSHRZ7A.108
N_U_ROWS = N_ROWS + 1 VSHRZ7A.109
P_POINTS = N_P_ROWS * ROW_LENGTH VSHRZ7A.110
U_POINTS = N_U_ROWS * ROW_LENGTH VSHRZ7A.111
P1 = 1 + (FIRST_ROW-1)*ROW_LENGTH VSHRZ7A.112
U1 = 1 + (FIRST_ROW-2)*ROW_LENGTH VSHRZ7A.113
*ELSE VSHRZ7A.114
N_P_ROWS = N_ROWS AJC1F405.79
N_U_ROWS = N_ROWS AJC1F405.80
P_POINTS = N_P_ROWS * ROW_LENGTH AJC1F405.81
U_POINTS = N_U_ROWS * ROW_LENGTH AJC1F405.82
P1 = 1 VSHRZ7A.116
U1 = 1 VSHRZ7A.117
*ENDIF VSHRZ7A.118
VSHRZ7A.119
DO I=P1,P1+P_POINTS-1 VSHRZ7A.120
ZLB(I,0)=0.0 VSHRZ7A.121
ENDDO VSHRZ7A.122
VSHRZ7A.123
CALL Z
(P_POINTS,EXNER(P1,1),EXNER(P1,2),PSTAR(P1), VSHRZ7A.124
& AKH,BKH,Q(P1),QCF(P1), VSHRZ7A.125
& QCL(P1),T(P1),ZLB(P1,0),TV(P1), VSHRZ7A.126
& ZLB(P1,1),DZL(P1),RDZ(P1),LTIMER) VSHRZ7A.127
VSHRZ7A.128
DO I=P1,P1+P_POINTS-1 VSHRZ7A.129
Z1(I)=RDZ(I) VSHRZ7A.130
ENDDO VSHRZ7A.131
VSHRZ7A.132
*IF -DEF,SCMA AJC1F405.83
CALL UV_TO_P(U_1(U1),U_1_P(P1), VSHRZ7A.134
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) VSHRZ7A.135
CALL UV_TO_P(V_1(U1),V_1_P(P1), VSHRZ7A.136
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) VSHRZ7A.137
CALL UV_TO_P(U_0(U1),U_0_P(P1), VSHRZ7A.138
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) VSHRZ7A.139
CALL UV_TO_P(V_0(U1),V_0_P(P1), VSHRZ7A.140
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) VSHRZ7A.141
*ELSE VSHRZ7A.142
DO I=P1,P1+P_POINTS-1 AJC1F405.84
U_1_P(I) = U_1(I) AJC1F405.85
V_1_P(I) = V_1(I) AJC1F405.86
U_0_P(I) = U_0(I) AJC1F405.87
V_0_P(I) = V_0(I) AJC1F405.88
ENDDO AJC1F405.89
*ENDIF VSHRZ7A.147
VSHRZ7A.148
DO I=P1,P1+P_POINTS-1 VSHRZ7A.149
USHEAR = U_1_P(I) - U_0_P(I) VSHRZ7A.150
VSHEAR = V_1_P(I) - V_0_P(I) VSHRZ7A.151
VSHR2 = MAX (1.0E-6 , USHEAR*USHEAR + VSHEAR*VSHEAR) VSHRZ7A.152
VSHR(I) = SQRT(VSHR2) VSHRZ7A.153
ENDDO VSHRZ7A.154
VSHRZ7A.155
RETURN VSHRZ7A.156
END VSHRZ7A.157
*ENDIF VSHRZ7A.158