File: rayive.f90

package info (click to toggle)
code-saturne 4.3.3%2Brepack-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 77,992 kB
  • sloc: ansic: 281,257; f90: 122,305; python: 56,490; makefile: 3,915; xml: 3,285; cpp: 3,183; sh: 1,139; lex: 176; yacc: 101; sed: 16
file content (111 lines) | stat: -rw-r--r-- 3,753 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
!-------------------------------------------------------------------------------

! This file is part of Code_Saturne, a general-purpose CFD tool.
!
! Copyright (C) 1998-2016 EDF S.A.
!
! This program is free software; you can redistribute it and/or modify it under
! the terms of the GNU General Public License as published by the Free Software
! Foundation; either version 2 of the License, or (at your option) any later
! version.
!
! This program 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 GNU General Public License for more
! details.
!
! You should have received a copy of the GNU General Public License along with
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
! Street, Fifth Floor, Boston, MA 02110-1301, USA.

!-------------------------------------------------------------------------------
!> \file rayive.f90
!> \brief 1D Radiative scheme - IR H20 and dimere absorption

!> \brief Compute in infrared spectral domain the emeissivity of H2O and dimere
!-------------------------------------------------------------------------------
! Arguments
!______________________________________________________________________________.
!  mode           name          role
!______________________________________________________________________________!
!> \param[out]      tauv      transmission function for water vapor and dimers
!> \param[out]      dtauv     d(tauv)/dz
!> \param[in]       qqqq      optical dpeth for water vapor (z,z')
!> \param[in]       xqx       effective concentration absorption by water vapor
!> \param[in]       qqqqc     idem qqqq for dimers
!> \param[in]       xqc       idem xqx for dimers
!> \param[in]       ro        air density
!-------------------------------------------------------------------------------
subroutine rayive (tauv,dtauv,qqqq,xqx,qqqqc,xqc,ro)

implicit none

!===============================================================================
!... declaration des variables externes

double precision tauv,dtauv,qqqq,xqx,qqqqc,xqc,ro

!... declaration des variables internes

double precision u,us,xu,xus,za,dza
double precision a0,a1,a2,a3,a4,b0,b1,b2,b3,b4
double precision as0,as1,as2,bs0,bs1,bs2
double precision abs0,dabs0
double precision n1,dn1,d1,dd1,t1,dt1,n2,dn2,d2,dd2,t2,dt2

data a0,a1,a2,a3,a4/7.76192d-7,1.33836d-3,1.66649d-1,2.17686      &
,2.69020/
data b0,b1,b2,b3,b4/7.79097d-7,1.36832d-3,1.79601d-1,2.70573      &
,5.15119/
data as0,as1,as2/1.5075d-2,-3.6185d-2,1.9245d-2/
data bs0,bs1,bs2/1.5075d-2,1.9547d-1,7.5271d-1/

!===============================================================================

u = qqqq/10.d0
us = qqqqc/10.d0
xu = xqx/10.d0
xus = xqc/10.d0

!  emissivite de la vapeur d'eau

if(u.ge.0.01d0) then
  za = 0.24d0*log10(u+0.01d0) + 0.622d0
  dza = 0.24d0/(u + 0.01d0)/log(10.d0)
else
  za = 0.846d0*(u + 3.59d-5)**0.243d0 - 6.9d-2
  dza = 0.846d0*0.243d0*(u + 3.59d-5)**(0.243d0 - 1.d0)
endif

!  emissivite des dimeres

n1 = a0 + u*(a1 + u*(a2 + u*(a3 + u*a4)))
dn1 = a1 + u*(2.d0*a2 + u*(3.d0*a3 + u*4.d0*a4))
d1 = b0 + u*(b1 + u*(b2 + u*(b3 + u*(b4 + u))))
dd1 = b1 + u*(2.d0*b2 + u*(3.d0*b3 + u*(4.d0*b4 + u*5.d0)))
t1 = n1/d1

dt1 = dn1/d1 - n1*dd1/d1/d1

if(us.le.0.5d0) then
  n2 = as0 + us*(as1 + us*as2)
  dn2 = as1 + us*2.d0*as2
  d2 = bs0 + us*(bs1 + us*(bs2 + us))
  dd2 = bs1 + us*(2.d0*bs2 + 3.d0*us)
  t2 = n2/d2

  dt2 = dn2/d2 - n2*dd2/d2/d2
else
  t2 = 0.d0
  dt2 = 0.d0
endif

!  transmission totale

abs0 = za + 0.4614d0*t1*(1.d0 - t2)
tauv = 1.d0 - abs0
dabs0 = (dza*xu + 0.4614d0*(dt1*xu*(1.d0 - t2) - t1*dt2*xus))*ro
dtauv = -dabs0

return
end subroutine rayive