Line data Source code
1 : ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2 : ! Copyright (c) 2015, Regents of the University of Colorado
3 : ! All rights reserved.
4 : !
5 : ! Redistribution and use in source and binary forms, with or without modification, are
6 : ! permitted provided that the following conditions are met:
7 : !
8 : ! 1. Redistributions of source code must retain the above copyright notice, this list of
9 : ! conditions and the following disclaimer.
10 : !
11 : ! 2. Redistributions in binary form must reproduce the above copyright notice, this list
12 : ! of conditions and the following disclaimer in the documentation and/or other
13 : ! materials provided with the distribution.
14 : !
15 : ! 3. Neither the name of the copyright holder nor the names of its contributors may be
16 : ! used to endorse or promote products derived from this software without specific prior
17 : ! written permission.
18 : !
19 : ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
20 : ! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
21 : ! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
22 : ! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23 : ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
24 : ! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25 : ! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
26 : ! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27 : ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28 : !
29 : ! History
30 : ! May 2015 - D. Swales - Original version
31 : ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
32 :
33 : MODULE MOD_COSP_RTTOV
34 : use cosp_kinds, only : wp
35 : use mod_cosp_config, only : RTTOV_MAX_CHANNELS,N_HYDRO,rttovDir
36 : use cosp_phys_constants, only : mdry=>amd,mO3=>amO3,mco2=>amCO2,mCH4=>amCH4, &
37 : mn2o=>amN2O,mco=>amCO
38 : IMPLICIT NONE
39 :
40 : ! Module parameters
41 : integer, parameter :: maxlim = 10000
42 : real(wp),parameter :: eps = 0.622
43 :
44 : ! Initialization parameters
45 : integer :: &
46 : platform, & ! RTTOV platform
47 : sensor, & ! RTTOV instrument
48 : satellite, & ! RTTOV satellite
49 : nChannels ! Number of channels
50 : integer,dimension(RTTOV_MAX_CHANNELS) :: &
51 : iChannel ! RTTOV channel numbers
52 :
53 : CONTAINS
54 0 : subroutine rttov_column(nPoints,nLevels,nSubCols,q,p,t,o3,ph,h_surf,u_surf,v_surf, &
55 : p_surf,t_skin,t2m,q2m,lsmask,lon,lat,seaice,co2,ch4,n2o,co, &
56 : zenang,lCleanup, &
57 : ! Outputs
58 0 : Tb,error, &
59 : ! Optional arguments for surface emissivity calculation.
60 : surfem,month, &
61 : ! Optional arguments for all-sky calculation.
62 : tca,ciw,clw,rain,snow)
63 : ! Inputs
64 : integer,intent(in) :: &
65 : nPoints, & ! Number of gridpoints
66 : nLevels, & ! Number of vertical levels
67 : nSubCols ! Number of subcolumns
68 : real(wp),intent(in) :: &
69 : co2, & ! CO2 mixing ratio (kg/kg)
70 : ch4, & ! CH4 mixing ratio (kg/kg)
71 : n2o, & ! N2O mixing ratio (kg/kg)
72 : co, & ! CO mixing ratio (kg/kg)
73 : zenang ! Satellite zenith angle
74 : real(wp),dimension(nPoints),intent(in) :: &
75 : h_surf, & ! Surface height (m)
76 : u_surf, & ! Surface u-wind (m/s)
77 : v_surf, & ! Surface v-wind (m/s)
78 : p_surf, & ! Surface pressure (Pa)
79 : t_skin, & ! Skin temperature (K)
80 : t2m, & ! 2-meter temperature (K)
81 : q2m, & ! 2-meter specific humidity (kg/kg)
82 : lsmask, & ! Land/sea mask
83 : lon, & ! Longitude (deg)
84 : lat, & ! Latitude (deg)
85 : seaice ! Seaice fraction (0-1)
86 : real(wp),dimension(nPoints,nLevels),intent(in) :: &
87 : q, & ! Specific humidity (kg/kg)
88 : p, & ! Pressure(Pa)
89 : t, & ! Temperature (K)
90 : o3 ! Ozone
91 : real(wp),dimension(nPoints,nLevels+1),intent(in) :: &
92 : ph ! Pressure @ half-levels (Pa)
93 : logical,intent(in) :: &
94 : lCleanup ! Flag to determine whether to deallocate RTTOV types
95 :
96 : ! Optional inputs (Needed for surface emissivity calculation)
97 : integer,optional :: &
98 : month ! Month (needed to determine table to load)
99 : real(wp),dimension(nChannels),optional :: &
100 : surfem ! Surface emissivity for each RTTOV channel
101 :
102 : ! Optional inputs (Needed for all-sky calculation)
103 : real(wp),dimension(nPoints,nLevels),optional :: &
104 : tca ! Total column cloud amount (0-1)
105 : real(wp),dimension(nPoints,nSubCols,nLevels),optional :: &
106 : ciw, & ! Cloud ice
107 : clw, & ! Cloud liquid
108 : rain, & ! Precipitation flux (kg/m2/s)
109 : snow ! Precipitation flux (kg/m2/s)
110 :
111 : ! Outputs
112 : real(wp),dimension(nPoints,nChannels) :: &
113 : Tb ! RTTOV brightness temperature.
114 : character(len=128) :: &
115 : error ! Error messages (only populated if error encountered)
116 :
117 0 : end subroutine rttov_column
118 0 : function construct_rttov_coeffilename(platform,satellite,instrument)
119 : ! Inputs
120 : integer,intent(in) :: platform,satellite,instrument
121 : ! Outputs
122 : character(len=256) :: construct_rttov_coeffilename
123 : ! Local variables
124 : character(len=256) :: coef_file
125 : integer :: error
126 :
127 : ! Initialize
128 0 : error = 0
129 :
130 : ! Platform
131 0 : if (platform .eq. 1) coef_file = 'rtcoef_noaa_'
132 0 : if (platform .eq. 10) coef_file = 'rtcoef_metop_'
133 0 : if (platform .eq. 11) coef_file = 'rtcoef_envisat_'
134 0 : if (platform .ne. 1 .and. platform .ne. 10 .and. platform .ne. 11) then
135 0 : error=error+1
136 0 : write ( *,* ) 'Unsupported platform ID ',platform
137 0 : return
138 : endif
139 :
140 : ! Satellite
141 0 : if (satellite .lt. 10) then
142 0 : coef_file = trim(coef_file) // char(satellite+48)
143 0 : else if (satellite .lt. 100) then
144 0 : coef_file = trim(coef_file) // char(int(satellite/10)+48)
145 0 : coef_file = trim(coef_file) // char(satellite-int(satellite/10)*10+48)
146 : else
147 0 : error=error+1
148 0 : write ( *,* ) 'Unsupported satellite number ',satellite
149 0 : return
150 : endif
151 :
152 : ! Sensor
153 0 : if (sensor .eq. 3) coef_file = trim(coef_file) // '_amsua.dat'
154 0 : if (sensor .eq. 5) coef_file = trim(coef_file) // '_avhrr.dat'
155 0 : if (sensor .eq. 49) coef_file = trim(coef_file) // '_mwr.dat'
156 0 : if (sensor .ne. 3 .and. sensor .ne. 5 .and. sensor .ne. 49) then
157 0 : error=error+1
158 0 : write ( *,* ) 'Unsupported sensor number ', sensor
159 0 : return
160 : endif
161 :
162 0 : if (error .eq. 0) construct_rttov_coeffilename=coef_file
163 :
164 : end function construct_rttov_coeffilename
165 0 : function construct_rttov_scatfilename(platform,satellite,instrument)
166 : ! Inputs
167 : integer,intent(in) :: platform,satellite,instrument
168 : ! Outputs
169 : character(len=256) :: construct_rttov_scatfilename
170 : ! Local variables
171 : character(len=256) :: coef_file
172 : integer :: error
173 :
174 : ! Initialize
175 0 : error = 0
176 :
177 : ! Platform
178 0 : if (platform .eq. 1) coef_file = 'sccldcoef_noaa_'
179 0 : if (platform .eq. 10) coef_file = 'sccldcoef_metop_'
180 0 : if (platform .eq. 11) coef_file = 'sccldcoef_envisat_'
181 0 : if (platform .ne. 1 .and. platform .ne. 10 .and. platform .ne. 11) then
182 0 : error=error+1
183 0 : write ( *,* ) 'Unsupported platform ID ',platform
184 0 : return
185 : endif
186 :
187 : ! Satellite
188 0 : if (satellite .lt. 10) then
189 0 : coef_file = trim(coef_file) // char(satellite+48)
190 0 : else if (satellite .lt. 100) then
191 0 : coef_file = trim(coef_file) // char(int(satellite/10)+48)
192 0 : coef_file = trim(coef_file) // char(satellite-int(satellite/10)*10+48)
193 : else
194 0 : error=error+1
195 0 : write ( *,* ) 'Unsupported satellite number ',satellite
196 0 : return
197 : endif
198 :
199 : ! Sensor
200 0 : if (sensor .eq. 3) coef_file = trim(coef_file) // '_amsua.dat'
201 0 : if (sensor .eq. 5) coef_file = trim(coef_file) // '_avhrr.dat'
202 0 : if (sensor .eq. 49) coef_file = trim(coef_file) // '_mwr.dat'
203 0 : if (sensor .ne. 3 .and. sensor .ne. 5 .and. sensor .ne. 49) then
204 0 : error=error+1
205 0 : write ( *,* ) 'Unsupported sensor number ', sensor
206 0 : return
207 : endif
208 :
209 0 : if (error .eq. 0) construct_rttov_scatfilename=coef_file
210 :
211 : end function construct_rttov_scatfilename
212 : END MODULE MOD_COSP_RTTOV
|