| 1 | subroutine interpolateH2Ocont_PPC(wn,temp,presS,presF,abcoef,firstcall) |
|---|
| 2 | |
|---|
| 3 | !================================================================== |
|---|
| 4 | ! |
|---|
| 5 | ! Purpose |
|---|
| 6 | ! ------- |
|---|
| 7 | ! Calculates the H2O continuum opacity, using the formulae |
|---|
| 8 | ! provided in Pierrehumbert, PPC (2010). As this is based on |
|---|
| 9 | ! the CKD continuum, it provides a useful check for the |
|---|
| 10 | ! implementation of the more general interpolateH2Ocont_CKD.F90. |
|---|
| 11 | ! |
|---|
| 12 | ! Authors |
|---|
| 13 | ! ------- |
|---|
| 14 | ! R. Wordsworth (2012) |
|---|
| 15 | ! |
|---|
| 16 | !================================================================== |
|---|
| 17 | |
|---|
| 18 | use watercommon_h, only: mH2O |
|---|
| 19 | use datafile_mod, only: datadir |
|---|
| 20 | implicit none |
|---|
| 21 | |
|---|
| 22 | ! input |
|---|
| 23 | double precision wn ! wavenumber (cm^-1) |
|---|
| 24 | double precision temp ! temperature (Kelvin) |
|---|
| 25 | double precision presS ! self-pressure (Pascals) |
|---|
| 26 | double precision presF ! foreign (air) pressure (Pascals) |
|---|
| 27 | |
|---|
| 28 | ! parameters |
|---|
| 29 | double precision, parameter :: T0 = 296.0 |
|---|
| 30 | double precision, parameter :: p0 = 1.D+4 |
|---|
| 31 | |
|---|
| 32 | ! variables |
|---|
| 33 | double precision rho_w, x |
|---|
| 34 | |
|---|
| 35 | ! output |
|---|
| 36 | double precision abcoef ! absorption coefficient (m^-1) |
|---|
| 37 | |
|---|
| 38 | logical firstcall |
|---|
| 39 | |
|---|
| 40 | x = wn - 2500. |
|---|
| 41 | |
|---|
| 42 | if(firstcall)then ! called by sugas_corrk only |
|---|
| 43 | print*,'----------------------------------------------------' |
|---|
| 44 | print*,'Testing H2O continuum...' |
|---|
| 45 | |
|---|
| 46 | print*,'interpolateH2Ocont: At wavenumber ',wn,' cm^-1' |
|---|
| 47 | print*,' temperature ',temp,' K' |
|---|
| 48 | print*,' H2O pressure ',presS,' Pa' |
|---|
| 49 | |
|---|
| 50 | rho_w = presS/((8.31446/(mH2O/1000.))*temp) |
|---|
| 51 | |
|---|
| 52 | if(wn.gt.500 .and. wn.lt.1400)then |
|---|
| 53 | abcoef = exp(12.167 - 0.050898*wn + 8.3207e-5*wn**2 - 7.0748e-8*wn**3 + 2.3261e-11*wn**4)*(T0/temp)**4.25*(presS/p0) |
|---|
| 54 | elseif(wn.gt.2100 .and. wn.lt.3000)then |
|---|
| 55 | abcoef = exp(-6.0055 - 0.0021363*x + 6.4723e-7*x**2 - 1.493e-8*x**3 + 2.5621e-11*x**4 + 7.328e-14*x**5)*(T0/temp)**4.25*(presS/p0) |
|---|
| 56 | else |
|---|
| 57 | abcoef = 0.0 |
|---|
| 58 | endif |
|---|
| 59 | abcoef = abcoef*rho_w |
|---|
| 60 | |
|---|
| 61 | print*,'The self absorption is ',abcoef,' m^-1' |
|---|
| 62 | print*,'And optical depth / km : ',1000.0*abcoef |
|---|
| 63 | |
|---|
| 64 | else |
|---|
| 65 | |
|---|
| 66 | rho_w = presS/((8.31446/(mH2O/1000.))*temp) |
|---|
| 67 | |
|---|
| 68 | if(wn.gt.500 .and. wn.lt.1400)then |
|---|
| 69 | abcoef = exp(12.167 - 0.050898*wn + 8.3207e-5*wn**2 - 7.0748e-8*wn**3 + 2.3261e-11*wn**4)*(T0/temp)**4.25*(presS/p0) |
|---|
| 70 | elseif(wn.gt.2100 .and. wn.lt.3000)then |
|---|
| 71 | abcoef = exp(-6.0055 - 0.0021363*x + 6.4723e-7*x**2 - 1.493e-8*x**3 + 2.5621e-11*x**4 + 7.328e-14*x**5)*(T0/temp)**4.25*(presS/p0) |
|---|
| 72 | else |
|---|
| 73 | abcoef = 0.0 |
|---|
| 74 | endif |
|---|
| 75 | abcoef = abcoef*rho_w |
|---|
| 76 | |
|---|
| 77 | ! unlike for Rayleigh scattering, we do not currently weight by the BB function |
|---|
| 78 | ! however our bands are normally thin, so this is no big deal. |
|---|
| 79 | |
|---|
| 80 | endif |
|---|
| 81 | |
|---|
| 82 | return |
|---|
| 83 | end subroutine interpolateH2Ocont_PPC |
|---|
| 84 | |
|---|
