OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
brdfg.f
Go to the documentation of this file.
1  subroutine brdfg(fio,brdfx,bmu,dmu,dmus2,eo,ddphi,amuo,pi,sumc,
2  1 sumcpi,sumdwn,calb,kkx,jjjj,nmum1,jpart)
3 c
4 c treat the lower boundary of the atmosphere as non lambertian
5 c surface and reflect all incident light (diffuse and direct)
6 c using the brdf of the surface
7 c
8 c***********************************************************************
9  implicit real*8 (a-h,o-z)
10  real*8 fio(4,50,46),bmu(51),dmu(51),dmus2(51),eo(4)
11  real*8 temp(4,50,46),z(4,4),tto(4),ttf(4),tth(4),ttd(4)
12  real*8 brdfx(25,25,46)
13 c***********************************************************************
14 c
15  write(*,*)'welcome to brdfg'
16  do i=1,jjjj
17  do j=1,jpart
18 c write(*,100)i,j,(fio(k,i,j),k=1,4)
19 100 format('fio',i3,i3,1p4e12.3)
20  enddo
21  enddo
22 c
23 c write(*,*)'bmu',bmu
24 c write(*,*)'dmu',dmu
25 c write(*,*)'dmus2',dmus2
26 c write(*,*)'eo',eo
27 c write(*,*)'ddphi,amuo',ddphi,amuo
28 c write(*,*)'jjjj,nmum1,jpart',jjjj,nmum1,jpart
29 c
30  mph2=2*(jpart-1)
31  do it=1,jjjj
32  itt=nmum1-it+1
33  do ip=1,jpart
34 c
35  sumtp=0.0d0
36  do itp=1,jjjj
37  sangi=dmu(itp)*ddphi
38  do ipp=1,mph2
39  ippz=ipp
40  if(ippz.gt.jpart)ippz=mph2-ipp+2
41  ipx=iabs(ipp-ip)+1
42  if(ipx.gt.jpart)ipx=mph2-ipx+2
43  fdif=(fio(1,itp,ippz)+fio(2,itp,ippz))*
44  1 sangi*bmu(itp)
45  sumtp=sumtp+brdfx(itp,it,ipx)*(1/pi)*fdif
46  if(itp.eq.kkx .and. ipp.eq.1)then
47  fsun=(eo(1)+eo(2))*amuo
48  sumtp=sumtp+brdfx(itp,it,ipx)*(1/pi)*fsun
49  endif
50  enddo
51  enddo
52  do i=1,2
53  fio(i,itt,ip)=0.5d0*sumtp
54  fio(i+2,itt,ip)=0.0d0
55  enddo
56  enddo
57  enddo
58 c compute the albedo of the surface
59  sumc=0.0d0
60  do it=jjjj+1,nmum1
61  sum3=fio(1,it,1)+fio(2,it,1)+fio(1,it,jpart)+fio(2,it,jpart)
62  do ip=2,jpart-1
63  sum3=sum3+2.0d0*(fio(1,it,ip)+fio(2,it,ip))
64  enddo
65  sumc=sumc+sum3*dabs(dmus2(it))*ddphi
66  enddo
67  sumcpi=sumc*pi
68  sumd=sumdwn+(eo(1)+eo(2))*amuo
69  write(*,*)'sumc,sumcpi,sumdwn,sumd',sumc,sumcpi,sumdwn,sumd
70  calb=sumc/sumd
71  write(*,*)'surface albedo=',calb
72  return
73  end
74 c***********************************************************************
subroutine brdfg(fio, brdfx, bmu, dmu, dmus2, eo, ddphi, amuo, pi, sumc, sumcpi, sumdwn, calb, kkx, nx, nmum1, jpart)
Definition: brdfg.f:3
#define real
Definition: DbAlgOcean.cpp:26
#define pi
Definition: vincenty.c:23
Definition: RsViirs.h:71