!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***S/P GASOPTS - OPTICAL DEPTHS CALCULATION
*
#include "phy_macros_f.h"
subroutine gasopts (taug, gw, dp, ib, ig, o3, qq, inpt, dip, dt, 1,4
1 rmu3, lev1, gh, il1, il2, ilg, lay, urbf)
#include "impnone.cdk"
*
integer ilg, lay, lev, ib, ig, lev1, il1, il2, k, i, m,ng2, ng
real taug(ilg,lay)
real gw, xx
*
real dp(ilg,lay), o3(ilg,lay), qq(ilg,lay), dip(ilg,lay),
1 dt(ilg,lay), rmu3(ilg), urbf(ilg,lay)
integer inpt(ilg,lay)
logical gh
integer init
*
*Authors
* J. Li, M. Lazare, CCCMA, rt code for gcm4
* (Ref: J. Li, H. W. Barker, 2005:
* JAS Vol. 62, no. 2, pp. 286\226309)
* P. Vaillancourt, D. Talbot, RPN/CMC;
* adapted for CMC/RPN physics (May 2006)
*
*Revisions
* 001 M.Lazarre,K.Winger,P.Vaillancourt (Apr 08) - use integer variables instead of actual integers
*
*Object
*
* Calculation of the optical depths due to nongray gaseous
* absorption for the solar, in each layer for a given band ib and
* cumulative probability gw.
* relative solar energy in each solar band are
* band 1: 621.6958
* band 1gh: 6.8988
* band 2: 429.5020
* band 2gh: 8.7245
* band 3: 242.8750
* band 3gh: 4.0330
* band 4: 30.9570
* band 4gh: 9.6167
*
* total relative solar energy in from 0.2 - 4 um is
* 1354.3029 w / m^2, plus 11.9006 w / m^2 in 4 - 10 um.
* total 1366.2035 w / m^2
*
* minor gas:
* 3 = co2
* 6 = o2
* this subroutine only calculates taug below 1 mb
*
*Arguments
*
* taug gaseous optical depth
* dp air mass path for a model layer (explained in raddriv).
* o3 o3 mass mixing ratio
* qq water vapor mass mixing ratio
* dip interpolation factor for pressure between two
* neighboring standard input data pressure levels
* dt layer temperature - 250 k
* inpt number of the level for the standard input data pressures
* rmu3 a factor of solar zenith angle, given in raddriv
*----------------------------------------------------------------------
*
**
#include "bands.cdk"
c
#include "tracegases.cdk"
c
if (ib .eq. 1) then
c
c----------------------------------------------------------------------
c band (14500 - 50000 cm^-1), nongray gaseous absorption of o3,
c h2o and o2.
c relative solar energy 629.0629 wm^-2.
c ig9 (50000-42000) uvc 1.57122 (wm^-2)
c ig8 (42000-37400) uvc 2.78822
c ig7 (37400-35700) uvc 2.78486
c uvc all included in gh part
c
c ig6 (35700-34000) uvb 5.54284
c ig4 (34000-32185) uvb, uva 9.71153
c ig3 (32185-30300) uva j value: 32185 cm^-1 16.03334
c ig2 (30300-25000) uva 73.07372
c ig1 (25000-20000) par 187.18623
c ig1 (20000-14500) par 330.38562
c par: photosynthetic active radiation
c
c the effect of h2o and o2 is added with simple method
c----------------------------------------------------------------------
c
if(ig .eq. 1) then
do 100 k = lev1, lay
do 100 i = il1, il2
m = inpt(i,k)
if (inpt(i,k).ge.950) m = inpt(i,k) - 1000
c
if (m .lt. 7) then
xx = (cs1o21 - 0.881e-05 * rmu3(i)) * rmo2
else
xx = (0.108e-04 - 0.881e-05 * rmu3(i)) * rmo2
endif
c
if (m .lt. 15) then
xx = xx+ (0.199e-02 - 0.952e-03 * rmu3(i)) * qq(i,k)
else
xx = xx+ (0.208e-02 - 0.952e-03 * rmu3(i)) * qq(i,k)
endif
c
taug(i,k) = (cs1o3(ig) * o3(i,k) + xx) * dp(i,k)
100 continue
else
do 120 k = lev1, lay
do 120 i = il1, il2
taug(i,k) = cs1o3(ig) * o3(i,k) * dp(i,k)
120 continue
endif
c
gw = gws1(ig)
c
else if (ib .eq. 2) then
c
c----------------------------------------------------------------------
c band (8400 - 14500 cm^-1), nongray gaseous absorption of h2o,
c o2 and o3
c relative solar energy 429.5020 w m^-2
c----------------------------------------------------------------------
c
if (ig .le. 2) then
ng2 = 6
call tline2 (taug, cs2h2o(1,1,ig), cs2o2(1,1,ig), qq, o3,
1 ng2, dp, dip, dt, inpt,
2 lev1, gh, mtl, il1, il2, ilg, lay, urbf)
else
ng = 1
init=2
call tline1 (taug, cs2h2o(1,1,ig), qq, ng, dp, dip,
1 dt, inpt, lev1, gh, mtl, init,
2 il1, il2, ilg, lay, urbf)
endif
c
c----------------------------------------------------------------------
c simply add o3 effect
c----------------------------------------------------------------------
c
do 200 k = lev1, lay
do 200 i = il1, il2
taug(i,k) = taug(i,k) + cs2o3(ig) * o3(i,k) * dp(i,k)
200 continue
c
gw = gws2(ig)
c
else if (ib .eq. 3) then
c
c----------------------------------------------------------------------
c band (4200 - 8400 cm^-1), nongray gaseous absorption of h2o
c and co2
c relative solar energy 242.8750 wm^-2
c----------------------------------------------------------------------
c
ng2 = 3
call tline2 (taug, cs3h2o(1,1,ig), cs3co2(1,1,ig), qq, o3,
1 ng2, dp, dip, dt, inpt,
2 lev1, gh, mtl, il1, il2, ilg, lay, urbf)
c
gw = gws3(ig)
c
else if (ib .eq. 4) then
c
c----------------------------------------------------------------------
c band (2200 - 4200 cm^-1), nongray gaseous absorption of h2o
c and co2
c relative solar energy 30.9570 w m^-2
c----------------------------------------------------------------------
c
ng2 = 3
call tline2 (taug, cs4h2o(1,1,ig), cs4co2(1,1,ig), qq, o3,
1 ng2, dp, dip, dt, inpt,
2 lev1, gh, mtl, il1, il2, ilg, lay, urbf)
c
gw = gws4(ig)
c
endif
c
return
end