SUBROUTINE RSSQDP ,2RSSQDP1A.23
& (p_field,p_levels,row_length, RSSQDP1A.24
& pstar, RSSQDP1A.25
& ak,bk,delta_ak,delta_bk,cos_p_latitude, RSSQDP1A.26
& rs_squared_deltap, RSSQDP1A.27
& latitude_step_inverse) RSSQDP1A.28
RSSQDP1A.29
IMPLICIT NONE RSSQDP1A.30
! RSSQDP1A.31
! Description: Calculates rs^2 * delta_pressure - mass field for the RSSQDP1A.32
! the calculation of mass weighted fields in the routine RSSQDP1A.33
! QT_POS. RSSQDP1A.34
! RSSQDP1A.35
! RSSQDP1A.36
! Current Code Owner: I Edmond RSSQDP1A.37
! RSSQDP1A.38
! History: RSSQDP1A.39
! Version Date Comment RSSQDP1A.40
! ------- ---- ------- RSSQDP1A.41
! 4.1 15/6/96 Original code. Ian Edmond RSSQDP1A.42
! RSSQDP1A.43
! Code Description: RSSQDP1A.44
! Language: FORTRAN 77 + common extensions. RSSQDP1A.45
! This code is written to UMDP3 v6 programming standards. RSSQDP1A.46
! RSSQDP1A.47
! System component covered: <appropriate code> RSSQDP1A.48
! System Task: <appropriate code> RSSQDP1A.49
! RSSQDP1A.50
! Declarations: RSSQDP1A.51
! These are of the form:- RSSQDP1A.52
! INTEGER ExampleVariable !Description of variable RSSQDP1A.53
! RSSQDP1A.54
! 1.0 Subroutine arguments RSSQDP1A.55
RSSQDP1A.56
! 1.1 Scalar arguments with intent(in): RSSQDP1A.57
INTEGER RSSQDP1A.58
& p_field, ! NUMBER OF PRESSURE POINTS. RSSQDP1A.59
& row_length, ! NUMBER OF POINTS ON A ROW. RSSQDP1A.60
& p_levels ! NUMBER OF MODEL LEVELS. RSSQDP1A.61
RSSQDP1A.62
REAL RSSQDP1A.63
& cos_p_latitude(p_field) ! HOLDS COSINES OF LATITUDE AT P POINTS RSSQDP1A.64
&,latitude_step_inverse ! 1./(LATITUDE STEP IN RADIANS) RSSQDP1A.65
&,ak(p_levels) ! A PART OF ETA CO-ORDINATE RSSQDP1A.66
&,bk(p_levels) ! B PART OF ETA CO-ORDINATE RSSQDP1A.67
&,delta_ak(p_levels) ! LAYER THICKNESS OF A PART OF ETA RSSQDP1A.68
&,delta_bk(p_levels) ! LAYER THICKNESS OF B PART OF ETA RSSQDP1A.69
&,rs_squared_deltap(p_field,p_levels) ! SPACE USED TO PUT RSSQDP1A.70
& ! MASS FIELD IN. RSSQDP1A.71
RSSQDP1A.72
! 2.1 Array arguments with intent(In): RSSQDP1A.73
REAL RSSQDP1A.74
& pstar(p_field) ! ARRAY FOR SURFACE PRESSURE RSSQDP1A.75
RSSQDP1A.76
! 3.0 Local parameters: RSSQDP1A.77
LOGICAL llints ! Arg passed to CALC_RS RSSQDP1A.78
PARAMETER (llints=.FALSE.) RSSQDP1A.79
RSSQDP1A.80
! 4.0 Local scalars: RSSQDP1A.81
INTEGER RSSQDP1A.82
& i,k,j RSSQDP1A.83
RSSQDP1A.84
REAL RSSQDP1A.85
& polar_cosine RSSQDP1A.86
RSSQDP1A.87
! 5.0 Local dynamic arrays: RSSQDP1A.88
REAL RSSQDP1A.89
& work1(p_field) RSSQDP1A.90
RSSQDP1A.91
! Function & Subroutine calls: RSSQDP1A.92
EXTERNAL CALC_RS RSSQDP1A.93
RSSQDP1A.94
polar_cosine = 0.125/latitude_step_inverse RSSQDP1A.95
!- End of header RSSQDP1A.96
!--------------------------------------------------------------------- RSSQDP1A.97
! SECTION 2. Calculate rs squared and mass weighted theta on RSSQDP1A.98
! each row at each level. RSSQDP1A.99
!--------------------------------------------------------------------- RSSQDP1A.100
RSSQDP1A.101
! Call CALC_RS to get rs for level 1. RSSQDP1A.102
! RS is returned in rs_squared_deltap( ,1) RSSQDP1A.103
! TS is returned in work1, rs at level K-1 is input in RSSQDP1A.104
! rs_squared_deltap( ,2) as at k-1= 0 the input is not used RSSQDP1A.105
! by CALC_RS. RSSQDP1A.106
RSSQDP1A.107
Call CALC_RS
(pstar,ak,bk,work1,rs_squared_deltap(1,2), RSSQDP1A.108
* rs_squared_deltap(1,1),p_field,1,p_levels,llints) RSSQDP1A.109
RSSQDP1A.110
Do k= 2,p_levels RSSQDP1A.111
RSSQDP1A.112
! Call calc_rs to get rs for level k. RSSQDP1A.113
! rs is returned in rs_squared_deltap(1,k) RSSQDP1A.114
! ts is returned in work1, rs at level k-1 is input as RSSQDP1A.115
! rs_squared_deltap(k-1). RSSQDP1A.116
RSSQDP1A.117
i=k RSSQDP1A.118
Call CALC_RS(pstar,ak,bk,work1,rs_squared_deltap(1,k-1), RSSQDP1A.119
* rs_squared_deltap(1,k),p_field,I,p_levels,llints) RSSQDP1A.120
RSSQDP1A.121
End do RSSQDP1A.122
RSSQDP1A.123
! Form rs squared * delta p * cosine of latitude and RSSQDP1A.124
! zonal mean mass-weighted theta. RSSQDP1A.125
RSSQDP1A.126
Do k=1,p_levels RSSQDP1A.127
Do i=row_length+1,p_field-row_length RSSQDP1A.128
rs_squared_deltap(i,k) = rs_squared_deltap(i,k)* RSSQDP1A.129
& rs_squared_deltap(i,k)* RSSQDP1A.130
& (delta_ak(k)+delta_bk(k)*pstar(I)) RSSQDP1A.131
& *cos_p_latitude(I) RSSQDP1A.132
End do RSSQDP1A.133
! Set polar values. RSSQDP1A.134
! The correct cosine value is delta_phi/8 RSSQDP1A.135
Do I=1,row_length RSSQDP1A.136
rs_squared_deltap(i,k) = rs_squared_deltap(i,k)* RSSQDP1A.137
& rs_squared_deltap(i,k)* RSSQDP1A.138
& (delta_ak(k)+delta_bk(k)*pstar(I)) RSSQDP1A.139
& *polar_cosine RSSQDP1A.140
j=p_field-row_length+I RSSQDP1A.141
rs_squared_deltap(j,k) = rs_squared_deltap(j,k)* RSSQDP1A.142
& rs_squared_deltap(j,k)* RSSQDP1A.143
& (delta_ak(k)+delta_bk(k)*pstar(j)) RSSQDP1A.144
& *polar_cosine RSSQDP1A.145
End do RSSQDP1A.146
End do RSSQDP1A.147
RSSQDP1A.148
RETURN RSSQDP1A.149
END RSSQDP1A.150
*ENDIF RSSQDP1A.151