OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
fltocn_new.f
Go to the documentation of this file.
1  subroutine fltocn_new
2 c subroutine fltocn(fio,cosmu,dcmu,dmus2,eo,ddphi,amuo,pi,sumc,sumcpi,
3 c 1 sumdwn,calb,rmu,conv,eox,kkx,nx,nmum1,jpart)
4 c
5 c treat the lower boundary of the atmosphere as flat ocean and
6 c reflect all incident light (diffuse and direct) according to
7 c fresnel law
8 c
9 c***********************************************************************
10 c.....include the common and declaration statemnets.....................
11  implicit real*8 (a-h,o-z)
12 c
13  include 'afrt_rt2.cmn'
14  real*8 zx(4,4),temp(4,2*nsz,nph)
15 c***********************************************************************
16 
17 c***********************************************************************
18 c implicit real*8 (a-h,o-z)
19 c real*8 fio(4,2*nsz,nph),cosmu(51),dmu(51),dmus2(51),eo(4)
20 c real*8 temp(4,2*nsz,nph),z(4,4),tto(4),ttf(4),tth(4),ttd(4)
21 c real*8 zx(4,4),rmu(51),eox(4)
22 c***********************************************************************
23 c
24 c write(*,*)'welcome to fltocn'
25  xzx=-1.0d-8
26  xr=1.3340d0
27  xi=0.0d0
28 c initalize the glint buffer
29  do i=1,nmum1
30  do j=1,jpart
31  do k=1,4
32  fglint(k,i,j)=0.0d0
33  enddo
34  enddo
35  enddo
36  do 500 it=1,(nx-1)
37  itp=(nmum1-it)+1
38 c write(*,*)'ready to begin the 400 loop'
39  cost=cosmu(it)
40  thetac= dacos(cost)
41  sinsq = (1.0d0-cost**2)
42  sinsq2 = sinsq**2
43  a=(xr**2-xi**2-1.0d0+cost**2)
44  b=(-2.0d0*xr*xi)
45  r=dsqrt(a**2+b**2)
46  tmr=cost**2*r
47  xp=dsqrt(2.0d0*r+2.0d0*a)
48  xmm=(2.0d0*r-2.0d0*a)
49  if(xmm .lt. 0.0d0 .and. xmm .gt. xzx) xmm=-xmm
50  xm=dsqrt(xmm)
51  dnmr1=(sinsq2+tmr+cost*sinsq*xp)
52  qrmu=(sinsq2-tmr)/dnmr1
53  qimu=(cost*sinsq*xm)/dnmr1
54  dnmr2=(cost**2+r+cost*xp)
55  rrr=(cost**2-r)/dnmr2
56  rri=(cost*xm)/dnmr2
57  rer=qrmu*rrr-qimu*rri
58  rei=qimu*rrr+qrmu*rri
59  r11=rer**2+rei**2
60  r22=rrr**2+rri**2
61  r33=rer*rrr+rei*rri
62  r34=rri*rer-rei*rrr
63  zx(1,1)=r11
64  zx(2,2)=r22
65  zx(3,3)=r33
66  zx(3,4)=r34
67  zx(4,3)=-r34
68  zx(4,4)=r33
69 
70 c write(6,120)cost,r11,r22,r33,r34
71 120 format(f8.4,1p4e15.5)
72 c
73 c
74 c write(*,*)'zx matrix',zx
75 c apply the zx matrix to the incident radiation
76 c solid angle of the incident beam=solid angle of the reflected beam
77  do ip=1,jpart
78  do i=1,4
79  sum2=0.0d0
80  do j=1,4
81  sum2=sum2+zx(i,j)*fio(j,it,ip)
82  enddo
83  temp(i,itp,ip)=sum2
84  enddo
85  enddo
86  if(it.eq.kkx)then
87 c write(*,*)'eo',eo
88  sang=dcmu(kkx)*ddphi
89  do i=1,4
90  sum1=0.0d0
91  do j=1,4
92  sum1=sum1+zx(i,j)*eo(j)/sang
93  enddo
94  temp(i,itp,1)=temp(i,itp,1)+sum1
95  fglint(i,itp,1)=sum1
96  enddo
97  endif
98  500 continue
99 c
100 c tranfer the stokes parameter from the temp buffer to fio
101 c only for the upward direction
102  do it=nx,nmum1
103  do ip=1,jpart
104  do i=1,4
105  fio(i,it,ip)=temp(i,it,ip)
106  enddo
107  enddo
108  enddo
109 c
110 c compute the albedo of the flat ocen
111  sumc=0.0d0
112  do it=nx,nmum1
113  sum3=fio(1,it,1)+fio(2,it,1)+fio(1,it,jpart)+fio(2,it,jpart)
114  do ip=2,jpart-1
115  sum3=sum3+2.0d0*(fio(1,it,ip)+fio(2,it,ip))
116  enddo
117  sumc=sumc+sum3*dabs(dcmusq(it))*ddphi
118  enddo
119  sumcpi=sumc*pi
120  sumd=sumdwn+(eo(1)+eo(2))*amuo
121 c write(*,*)'sumc,sumcpi,sumdwn,sumd',sumc,sumcpi,sumdwn,sumd
122  calb=sumc/sumd
123 c write(*,*)'ocean albedo=',calb
124  return
125  end
126 c***********************************************************************
subroutine fltocn_new
Definition: fltocn_new.f:2
#define real
Definition: DbAlgOcean.cpp:26
#define pi
Definition: vincenty.c:23
Definition: RsViirs.h:71