OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
attenew.f
Go to the documentation of this file.
1  subroutine attenew
2 c
3 c subroutine atten computes the attenuation factors for the
4 c direct and the difffused beams
5 c***********************************************************************
6 c.....includes the common blocks
7  implicit real*8 (a-h,o-z)
8  include 'afrt_rt2.cmn'
9  real*8 dtotl(1000)
10  real*8 totl(1000),e(1000),u(1000)
11 c
12 c***********************************************************************
13 c
14 c determine the total optical thickness at every level in the
15 c atmosphere
16 c
17  taupl(1)=0.0d0
18  do i=1,nolyr
19  taupl(i+1)=taupl(i)+dtot(i)
20  enddo
21 c
22  in=1
23  il=1
24  iu=1
25  if(ipsudo.eq.1)then
26  totl(1)=1.0d-10
27  do i=2,(nolyr+1)
28  call spline(pl(i),ppo,totsp,nmodl,in,totl(i),il,iu,vl,
29  1 vu,e,u)
30  enddo
31  do i=1,nolyr
32  dtotl(i)=totl(i+1)-totl(i)
33  enddo
34 c
35 c compute the solar attenuation upto the middle as well as
36 c bottom of the layer
37 c
38  efactb(1)=1.0d0
39  do i=1,nolyr
40  plths=0.5d0*dtotl(i)+totl(i)
41  efact(i)=dexp(-plths)
42  efactb(i+1)=dexp(-totl(i+1))
43  enddo
44  eo(1)=0.5d0*dexp(-totl(nolyr+1))
45  eo(2)=0.5d0*dexp(-totl(nolyr+1))
46  else
47 c
48 c compute the solar attenuation upto the middle as well as
49 c bottom of the layer (plane parallel case)
50 c
51  efactb(1)=1.0d0
52  do i=1,nolyr
53  plthx=0.50d0*dtot(i)+taupl(i)
54  efact(i)=dexp(-plthx/amuo)
55  efactb(i+1)=dexp(-taupl(i+1)/amuo)
56 c write(6,193)amuo,i,dtrr(i),dtmm(i),dtaa(i),efact(i)
57 193 format('amuo,i,dtrr,dtmm,dtaa,amuo,efact',1pe11.3/i2,1p6e11.3)
58  enddo
59  eo(1)=0.5d0*dexp(-taupl(nolyr+1)/amuo)
60  eo(2)=0.5d0*dexp(-taupl(nolyr+1)/amuo)
61  endif
62 c
63  if(ipsudo.eq.1)then
64  do i=1,(nolyr+1)
65 c write(6,149)ht(i),totl(i),dtotl(i),efact(i)
66 149 format('htl,totl,dtotl,efact'/1p5e12.5)
67  enddo
68  endif
69 c
70  if(ipsudo.ne.1)then
71  totl(1)=1.0d-10
72  do i=1,nolyr
73  totl(i+1)=totl(i)+dtot(i)
74  enddo
75  endif
76  do i=1,nolyr
77  xxx=totl(i+1)-0.5d0*dtot(i)
78  do j=1,nmum1
79  zzz = dabs(cosmu(j))
80  emdtm(i,j)=dexp(-dtot(i)/zzz)
81 c emd2tm(i,j)=dexp(-(0.5d0*dtot(i))/zzz)
82  emtm(i,j)=dexp(-xxx/zzz)
83  enddo
84  enddo
85 c
86  do i=1,(nolyr+1)
87  do j=1,(nx-1)
88  zzz=dabs(cosmu(j))
89  xxx=totl(i)
90  atnflx(i,j)=dexp(-xxx/zzz)
91  enddo
92  enddo
93 c
94  return
95  end
96 c**********************************************************************
subroutine attenew
Definition: attenew.f:2
subroutine spline(s, x, y, n, in, t, il, iu, vl, vu, e, u)
Definition: phs.f:1348
#define real
Definition: DbAlgOcean.cpp:26