SUBROUTINE QSAT_VARS(fixhd,len_fixhd,pstar, 2,1QSATVAR1.24
& levdepc,len1_levdepc,len2_levdepc, QSATVAR1.25
& p_levels,q_levels, QSATVAR1.26
& p_field,level, QSATVAR1.27
& d1,d2,d3,d4) QSATVAR1.28
QSATVAR1.29
IMPLICIT NONE QSATVAR1.30
! QSATVAR1.31
! Description: Calculates the relative humidity and rate of change of QSATVAR1.32
! saturated vapour pressure (es) wrt temperature on PF QSATVAR1.33
! theta levels. QSATVAR1.34
! QSATVAR1.35
! Method: QSATVAR1.36
! QSATVAR1.37
! Current Code Owner: I Edmond QSATVAR1.38
! QSATVAR1.39
! History: QSATVAR1.40
! Version Date Comment QSATVAR1.41
! ------- ---- ------- QSATVAR1.42
! 4.1 15/6/96 Original code. Ian Edmond QSATVAR1.43
! 4.4 09/04/97 Comments about thetaL qT changed to theta and PXDG1406.1
! in line with changes made in UMDP107 Ian Edmond PXDG1406.2
! 4.5 14/09/98 Optimisation changes for T3E D.M. Goddard PXDG1406.3
! 4.6 29/07/99 Correct compile error in non-T3E branch D.M. Goddar PXDG1406.4
! 4.5 29/07/98 Optimisation changes for T3E Rewrote **KAPPA UDG5F405.514
! calculations to reduce number of "**"'s and UDG5F405.515
! replaced "**"'s with vector function powr_v UDG5F405.516
! Author D.M. Goddard UDG5F405.517
! QSATVAR1.44
! Code Description: QSATVAR1.45
! Language: FORTRAN 77 + common extensions. QSATVAR1.46
! This code is written to UMDP3 v6 programming standards. QSATVAR1.47
! QSATVAR1.48
! System component covered: <appropriate code> QSATVAR1.49
! System Task: <appropriate code> QSATVAR1.50
! QSATVAR1.51
! Declarations: QSATVAR1.52
! These are of the form:- QSATVAR1.53
! INTEGER ExampleVariable !Description of variable QSATVAR1.54
! QSATVAR1.55
! 1.0 Global variables (*CALLed COMDECKs etc...): QSATVAR1.56
*CALL C_R_CP 
QSATVAR1.57
QSATVAR1.58
! Subroutine arguments QSATVAR1.59
! Scalar arguments with intent(in): QSATVAR1.60
INTEGER QSATVAR1.61
& level QSATVAR1.62
&,len_fixhd ! Length of fixed length header QSATVAR1.63
&,len2_levdepc ! 2nd dim of lev dep consts QSATVAR1.64
&,len1_levdepc ! 1st dim of lev dep consts QSATVAR1.65
&,p_field ! No of p-points per level QSATVAR1.66
&,p_levels ! No of levels QSATVAR1.67
&,q_levels ! No of wet levels QSATVAR1.68
QSATVAR1.69
! Array arguments with intent(in): QSATVAR1.70
INTEGER QSATVAR1.71
& fixhd(256) QSATVAR1.72
QSATVAR1.73
REAL QSATVAR1.74
& levdepc(1+len1_levdepc*len2_levdepc) QSATVAR1.75
QSATVAR1.76
! Array arguments with intent(InOut): QSATVAR1.77
REAL QSATVAR1.78
& d1(p_field) ! Theta / T on PF theta or UM full levels UIE2F404.1324
&,d2(p_field) ! q on PF theta or UM full levels QSATVAR1.80
QSATVAR1.81
! Scalar arguments with intent(out): QSATVAR1.82
QSATVAR1.83
! Array arguments with intent(out): QSATVAR1.84
REAL QSATVAR1.85
& d3(p_field) ! RH/qs on PF theta or UM full levels QSATVAR1.86
&,d4(p_field) ! dlnesBydT on PF theta or UM full levels QSATVAR1.87
QSATVAR1.88
! ErrorStatus QSATVAR1.89
INTEGER QSATVAR1.90
& len_io QSATVAR1.91
&,icode ! Return code; successful=0 QSATVAR1.92
! error > 0 QSATVAR1.93
CHARACTER*(40) QSATVAR1.94
& cmessage ! Error message If icode > 0 QSATVAR1.95
QSATVAR1.96
! Local scalars: QSATVAR1.97
INTEGER QSATVAR1.98
& i QSATVAR1.99
QSATVAR1.100
REAL QSATVAR1.101
& press1 !Intermediate temporaries used in calc of pstar QSATVAR1.102
&,press2 !Intermediate temporaries used in calc of pstar QSATVAR1.103
&,pexner1 QSATVAR1.104
&,pexner2 QSATVAR1.105
QSATVAR1.106
! Local dynamic arrays: QSATVAR1.107
REAL QSATVAR1.108
& pstar(p_field) ! Pstar on output grid QSATVAR1.109
&,pfield(p_field) ! Pressure of individual output level QSATVAR1.110
&,exner(p_field) ! Exner pressure on output half levels QSATVAR1.111
& ! or theta levels. QSATVAR1.112
*IF DEF,VECTLIB PXVECTLB.126
&,a_pexner1(p_field) UDG5F405.519
&,a_pexner2(p_field) UDG5F405.520
&,a_pexner1_kappa(p_field) UDG5F405.521
&,a_pexner2_kappa(p_field) UDG5F405.522
*ENDIF UDG5F405.523
! Function & Subroutine calls: UDG5F405.524
External qsat_pf UDG5F405.525
!- End of header QSATVAR1.114
QSATVAR1.116
*IF DEF,VECTLIB PXVECTLB.127
If (fixhd(3).eq.5) then ! LS dump UDG5F405.527
UDG5F405.528
Do i=1,p_field UDG5F405.529
! Find exner pressures on theta levels on PF vertical grid UDG5F405.530
! if LS variables. Otherwise (UM variables) use exner pressure UDG5F405.531
! on full UM levels. UDG5F405.532
UDG5F405.533
press1 = levdepc(level) UDG5F405.534
& + levdepc(level+p_levels) * pstar(i) UDG5F405.535
a_pexner1(i) = (press1 / pref) UDG5F405.536
UDG5F405.537
! Exner pressure at pressure level just above theta level UDG5F405.538
! of interest on PF vertical grid. UDG5F405.539
press2 = levdepc(level+1) UDG5F405.540
& + levdepc(level+1+p_levels) * pstar(i) UDG5F405.541
a_pexner2(i) = (press2 / pref) UDG5F405.542
End Do UDG5F405.543
call powr_v(p_field,a_pexner1,kappa,a_pexner1_kappa) UDG5F405.544
call powr_v(p_field,a_pexner2,kappa,a_pexner2_kappa) UDG5F405.545
UDG5F405.546
Do i=1,p_field UDG5F405.547
UDG5F405.548
! Pressures on theta levels of PF vertical grid read into UDG5F405.549
! pfield for each level separately. UDG5F405.550
pexner2=a_pexner2_kappa(i) UDG5F405.551
pexner1=a_pexner1_kappa(i) UDG5F405.552
pfield(i) = (pexner2 - pexner1) UDG5F405.553
& / ( (a_pexner2(i) UDG5F405.554
& - a_pexner1(i) ) * kappa) UDG5F405.555
End Do UDG5F405.556
call powr_v(p_field,pfield,(1/(kappa-1)),pfield) UDG5F405.557
UDG5F405.558
Do i=1,p_field UDG5F405.559
UDG5F405.560
pfield(i)=pfield(i)*pref UDG5F405.561
UDG5F405.562
End Do UDG5F405.563
UDG5F405.564
else if (fixhd(3).eq.1) then ! UM dump UDG5F405.565
UDG5F405.566
Do i=1,p_field UDG5F405.567
pfield(i) = levdepc(level) UDG5F405.568
& + levdepc(level+p_levels) * pstar(i) UDG5F405.569
Enddo UDG5F405.570
UDG5F405.571
else UDG5F405.572
UDG5F405.573
write(*,*)'Check vertical coordinate type of dump' UDG5F405.574
UDG5F405.575
end if UDG5F405.576
UDG5F405.577
Do i=1,p_field UDG5F405.578
UDG5F405.579
! Exner pressures on theta levels on PF vertical grid or UDG5F405.580
! full levels on UM grid. UDG5F405.581
exner(i) = (pfield(i) / pref) UDG5F405.582
UDG5F405.583
End Do UDG5F405.584
call powr_v(p_field,exner,kappa,exner) UDG5F405.585
UDG5F405.586
Do i=1,p_field UDG5F405.587
! Find T from theta and the theta level exner pressure. UDG5F405.588
d1(i) = d1(i) * exner(i) UDG5F405.589
End do UDG5F405.590
*ELSE UDG5F405.591
Do i=1,p_field PXDG1406.5
QSATVAR1.118
! Find exner pressures on theta levels on PF vertical grid QSATVAR1.119
! if LS variables. Otherwise (UM variables) use exner pressure QSATVAR1.120
! on full UM levels. QSATVAR1.121
If (fixhd(3).eq.5) then ! LS dump QSATVAR1.122
QSATVAR1.123
press1 = levdepc(level) QSATVAR1.124
& + levdepc(level+p_levels) * pstar(i) QSATVAR1.125
pexner1 = (press1 / pref)**kappa QSATVAR1.126
QSATVAR1.127
! Exner pressure at pressure level just above theta level QSATVAR1.128
! of interest on PF vertical grid. QSATVAR1.129
press2 = levdepc(level+1) QSATVAR1.130
& + levdepc(level+1+p_levels) * pstar(i) QSATVAR1.131
pexner2 = (press2 / pref)**kappa QSATVAR1.132
QSATVAR1.133
! Pressures on theta levels of PF vertical grid read into QSATVAR1.134
! pfield for each level separately. QSATVAR1.135
pfield(i) = ( (pexner2 - pexner1) QSATVAR1.136
& / ( (pexner2**(1/kappa) QSATVAR1.137
& - pexner1**(1/kappa) ) * kappa) QSATVAR1.138
& )**(1/(kappa-1))*pref QSATVAR1.139
QSATVAR1.140
else if (fixhd(3).eq.1) then ! UM dump QSATVAR1.141
QSATVAR1.142
pfield(i) = levdepc(level) QSATVAR1.143
& + levdepc(level+p_levels) * pstar(i) QSATVAR1.144
QSATVAR1.145
else QSATVAR1.146
QSATVAR1.147
write(*,*)'Check vertical coordinate type of dump' QSATVAR1.148
QSATVAR1.149
End if QSATVAR1.150
QSATVAR1.151
! Exner pressures on theta levels on PF vertical grid or QSATVAR1.152
! full levels on UM grid. QSATVAR1.153
exner(i) = (pfield(i) / pref)**kappa QSATVAR1.154
QSATVAR1.155
! Find T from theta and the theta level exner pressure. UIE2F404.1325
d1(i) = d1(i) * exner(i) QSATVAR1.157
QSATVAR1.158
End do QSATVAR1.159
*ENDIF UDG5F405.592
QSATVAR1.160
! Saturated mixing ratio qs for a single level read into d3. QSATVAR1.161
! Rate of change of saturated vapour pressure es wrt temperature QSATVAR1.162
! for a single level read into d4. QSATVAR1.163
Call qsat_pf(d3, ! OUT qs QSATVAR1.164
& d4, ! OUT dlnesBydT QSATVAR1.165
& d1, ! IN TL QSATVAR1.166
& pfield, ! IN P on PF theta levels QSATVAR1.167
& p_field) ! IN Size of fields QSATVAR1.168
QSATVAR1.169
Do i=1,p_field QSATVAR1.170
QSATVAR1.171
! By definition, RH = q/qs. QSATVAR1.172
d3(i) = d2(i)/d3(i) QSATVAR1.173
QSATVAR1.174
! Convert temperature back into theta using theta level QSATVAR1.175
! exner pressures. T -> Theta = d1 UIE2F404.1326
d1(i) = d1(i) / exner(i) QSATVAR1.177
QSATVAR1.178
End do ! i QSATVAR1.179
QSATVAR1.180
RETURN QSATVAR1.181
END QSATVAR1.182
*ENDIF UDG5F405.593