OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
mdiffn.f
Go to the documentation of this file.
1  subroutine mdiffn(ib,ie,il,dlyr)
2 c
3 c compute the integral: int(pidw)
4 c
5 c*************************************************************************
6 c.....includes the common blocks
7  implicit real*8 (a-h,o-z)
8  include 'afrt_rt2.cmn'
9 c
10  real*8 fiit(4,2*nsz,nph)
11 c**************************************************************************
12 c
13  do it=ib,ie
14  do ip=1,jpart
15  if(ip.eq.1 .or. ip.eq.jpart)then
16  do is=1,4
17  sumta=0.0d0
18  do kk=1,nmum1
19  sumtb=0.0d0
20  do ll=1,jpart
21  if(ip.eq.1)then
22  llp=ll
23  ipc=ip+ll-1
24  else
25  llp=jpart-ll+1
26  ipc=ip+ll-1
27  endif
28  do ic=1,4
29  fiit(ic,kk,llp)=fiic(ic,kk,llp)
30  enddo
31  if(ipc.gt. jpart)then
32  fiit(3,kk,llp)=-fiic(3,kk,llp)
33  fiit(4,kk,llp)=-fiic(4,kk,llp)
34  endif
35  prod1=0.0d0
36  do j=1,4
37  ij=(is-1)*4+j
38  prod1=prod1+(c(kk)*tmsl*ppin(ij,ll,it,kk)+
39  1 trsl*ppin(ij+16,ll,it,kk))*fiit(j,kk,llp)/dlyr
40  enddo
41  if(ll.eq.1 .or. ll.eq.jpart) then
42  sumtb=sumtb+prod1
43  else if(is.le.2)then
44  sumtb=sumtb+2.0d0*prod1
45  endif
46  enddo
47  sumta=sumta+sumtb*dcmu(kk)
48  enddo
49  ftmp(is,it,ip)=sumta*ddphi
50  enddo
51  else
52  do is=1,4
53  sumta=0.0d0
54  do kk=1,nmum1
55  sumtb=0.0d0
56  do ll=1,nophi
57  mnz=ll+ip-2
58  mmp=mnz+1-(nophi*(mnz/nophi))
59  if(ll.le.jpart .and. mmp.le.jpart)then
60  iflg1=0
61  iflg2=0
62  llp=ll
63  else if(ll.le.jpart .and. mmp.gt.jpart)then
64  iflg1=1
65  iflg2=0
66  llp=ll
67  mmp=nophi-mmp+2
68  else if(ll.gt.jpart .and. mmp.le.jpart)then
69  iflg1=1
70  iflg2=1
71  llp=nophi-ll+2
72  else if(ll.gt.jpart .and. mmp.gt.jpart)then
73  iflg1=0
74  iflg2=1
75  llp=nophi-ll+2
76  mmp=nophi-mmp+2
77  endif
78  do ic=1,4
79  fiit(ic,kk,llp)=fiic(ic,kk,llp)
80  enddo
81  if(iflg1.eq.1)then
82  fiit(3,kk,mmp)=-fiic(3,kk,mmp)
83  fiit(4,kk,mmp)=-fiic(4,kk,mmp)
84  endif
85  prod1=0.0d0
86  do j=1,4
87  ij=(is-1)*4+j
88  prod1=prod1+(c(kk)*tmsl*ppin(ij,llp,it,kk)+
89  1 trsl*ppin(ij+16,llp,it,kk))*fiit(j,kk,mmp)/dlyr
90  enddo
91  if(is.ge.3 .and. iflg2.eq.1)then
92  prod1=-prod1
93  endif
94  sumtb=sumtb+prod1
95  enddo
96  sumta=sumta+sumtb*dcmu(kk)
97  enddo
98  ftmp(is,it,ip)=sumta*ddphi
99  enddo
100  endif
101  enddo
102  enddo
103  return
104  end
105 c**********************************************************************
#define real
Definition: DbAlgOcean.cpp:26
subroutine mdiffn(ib, ie, il, dlyr)
Definition: mdiffn.f:2