Ticket #200: gpsro_drivertl.f90

File gpsro_drivertl.f90, 4.0 KB (added by Huw Lewis, 14 years ago)

tangent linear executable program

Line 
1PROGRAM gpsro_driver
2
3IMPLICIT NONE
4
5
6INTEGER, PARAMETER :: nlev=38 ! no. of p levels in state vec.
7INTEGER, PARAMETER :: nobs=110 ! initially assume 250 m spacing
8REAL :: roc
9REAL :: undul
10REAL :: lat
11REAL :: pres(nlev),temp(nlev),q(nlev)
12REAL :: pres_prime(nlev),temp_prime(nlev),q_prime(nlev)
13REAL :: zg(nlev)
14REAL :: a(nobs)
15REAL :: alpha(nobs),alpha_prime(nobs)
16REAL :: alpha1(nobs),alpha2(nobs)
17REAL :: pres2(nlev),temp2(nlev),q2(nlev)
18
19
20
21INTEGER :: i
22
23
24!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
25! THIS DATA SHOULD BE REPLACED WITH THE UM MODEL INPUT
26!
27! set the atmospheric profile parameters easy values, to get the code
28! ruuning. This is where the UM data should go in.
29
30! set latitude to arb. value = 45 degrees
31
32lat = 45.0
33
34! set profile data
35
36DO i = 1,nlev
37
38! level height
39
40 zg(i) = REAL(i)*1000.0
41
42! pres (hPa)
43
44 pres(i) = 1013.0*EXP(-zg(i)/6000.0)
45
46 pres_prime(i) = 0.001*pres(i)
47
48 pres2(i) = pres(i)+pres_prime(i)
49
50
51! temp (K)
52
53 temp(i) = 270.0 ! isothermal for simplicity
54
55 temp2(i) = temp(i) + temp_prime(i)
56
57! Specific humidity (g/kg)
58
59 q(i) = 10.0*EXP(-zg(i)/1500.0)
60
61 q_prime(i) = 0.01*q(i)
62
63 q2(i) = q(i) + q_prime(i)
64
65
66ENDDO
67
68!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
69
70
71!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
72!
73! I DON'T THINK YOU'LL NEED TO CHANGE THESE VALUES FOR THE STUDY
74! THEY SHOULD BE A REASONABLE STARTING POINT
75!
76! Now set the observation "impact heights". We'll assume that the observation
77! profile is always on a set of fixed impact heights, with a 250 m spacing.
78!
79! impact height = impact parameter - radius of curvature
80!
81!
82! radius of curvature
83
84roc = 6371000.0 ! set to mean radius of earth. OK for this study.
85
86undul = 0.0 ! ok for this study
87
88DO i = 1, nobs
89
90 a(i) = roc + 3000.0+REAL(i-1)*250.0
91
92ENDDO
93!
94!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
95
96! The routine that forward models the bending angles
97
98CALL alpha_optl(nlev, & ! no. of model levs (=38)
99 nobs, & ! no. of bending angles in profile
100 roc, & ! radius of curv.
101 undul, & ! undulation (set to 0.0)
102 lat, & ! latitude of ob. location (degrees)
103 pres, & ! pressure on mod levels (hPa)
104 pres_prime, &
105 temp, & ! temp on model levels
106 temp_prime, &
107 q, & ! specific humidity (g/kg)
108 q_prime, &
109 zg, & ! geopotential height of model levels (m)
110 a, & ! impact parameters
111 alpha, & ! **OUTPUT** bending angles PROFILE
112 alpha_prime) ! **OUTPUT** bending angle perts PROFILE
113
114
115CALL alpha_op(nlev, & ! no. of model levs (=38)
116 nobs, & ! no. of bending angles in profile
117 roc, & ! radius of curv.
118 undul, & ! undulation (set to 0.0)
119 lat, & ! latitude of ob. location (degrees)
120 pres, & ! pressure on mod levels (hPa)
121 temp, & ! temp on model levels
122 q, & ! specific humidity (g/kg)
123 zg, & ! geopotential height of model levels (m)
124 a, & ! impact parameters
125 alpha1) ! **OUTPUT** bending angles PROFILE
126
127
128
129CALL alpha_op(nlev, & ! no. of model levs (=38)
130 nobs, & ! no. of bending angles in profile
131 roc, & ! radius of curv.
132 undul, & ! undulation (set to 0.0)
133 lat, & ! latitude of ob. location (degrees)
134 pres2, & ! pressure on mod levels (hPa)
135 temp2, & ! temp on model levels
136 q2, & ! specific humidity (g/kg)
137 zg, & ! geopotential height of model levels (m)
138 a, & ! impact parameters
139 alpha2) ! **OUTPUT** bending angles PROFILE
140
141
142
143DO i = 1,nobs
144
145 write (6,'(i4,3e16.6)') i,a(i)-roc,alpha_prime(i),(alpha2(i)-alpha1(i))
146
147ENDDO
148
149
150END