OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
compc.f
Go to the documentation of this file.
1  subroutine compc
2 c
3 c***********************************************************************
4 c include the common statements.....................................
5  implicit real*8 (a-h,o-z)
6  include 'common_all.cmn'
7 c***********************************************************************
8 c
9  real * 4 ee(2),qspp(50)
10  ee(1) = 0.5
11  ee(2) = 0.5
12  do 20 k=1,nangl
13  i=ii
14  qspp(i)=0.
15  do 7 m=1,jpart
16  xfot=const*(ee(1)*(ppin(1,m,i,k)+ppin(5,m,i,k))+
17  1 ee(2)*(ppin(2,m,i,k)+ppin(6,m,i,k)))
18 c write(6,150)ii,k,m,ppin(1,m,i,k),ppin(5,m,i,k),
19 c 1 ppin(2,m,i,k),ppin(6,m,i,k),xfot
20 150 format('ii,k,pin,xfot',3i3,1x,1p5e11.3)
21  if(m.eq.1.or.m.eq.jpart)go to 9
22  qspp(i)=qspp(i)+2.*xfot
23  go to 6
24  9 qspp(i)=qspp(i)+xfot
25  6 continue
26 c write(6,966)i,k,m,ppin(1,m,i,k),ppin(2,m,i,k),const,xfot,qspp(i)
27 966 format(3i3,1x,1p5e11.3)
28 7 continue
29  sum=qspp(i)*dmu(i)*ddphi
30  qsp(k)=qsp(k)+sum
31 c write(6,100)i,k,qsp(k),sum,qspp(i),dmu(i),ddphi
32 100 format('i,k,qsp,sum,qssp,dmu,dphi',2i3,1p5e9.2)
33  20 continue
34  return
35  end
36 c***********************************************************************
subroutine const(NGAUSS, NMAX, MMAX, P, X, W, AN, ANN, S, SS, NP, EPS)
Definition: ampld.lp.f:924
subroutine compc
Definition: compc.f:2