OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
matrx1.f
Go to the documentation of this file.
1  subroutine matrx1
2 c
3 c include the common statements.....................................
4  implicit real*8 (a-h,o-z)
5  include 'afrt_rt2.cmn'
6 c***********************************************************************
7  amu=-cosmu(ii)
8  anu=sinmu(ii)
9  amup=-cosmu(kk)
10  anup=sinmu(kk)
11  amusq=amu**2
12  amumu=amu*amup
13  amups=amup**2
14  do 1 l=1,jpart
15  coosn=costh(l)
16  siin=sinth(l)
17  copsi=anu*anup+amu*amup*coosn
18  sisq=copsi**2
19  cfisq=coosn**2
20  sifi=copsi*coosn
21  sfisq=siin**2
22  if(amu-amup)23,210,23
23  23 if(amu+amup)14,211,14
24  210 if(l-1)14,11,14
25  211 if(l-jpart)14,214,14
26  11 if(ii-jjj)72,73,73
27  72 iq=4*(ii-1)
28  go to 75
29  73 iq=(nmum1-ii)*4
30  go to 75
31  214 if(ii-jjj)82,83,83
32  82 iq=4*(ii-1)
33  go to 76
34  83 iq=(nmum1-ii)*4
35  go to 76
36  14 continue
37 c++++++++++++++++++++++++++++++++++++++++++
38  x = amu * amup + anu * anup * coosn
39  xabs=dabs(x)
40  if(x.gt.1.0d0)x=1.0d0
41  if(x.lt.-1.0d0)x=-1.0d0
42  if(xabs .lt. 1.0e-6)x=0.0
43  xza=dacos(x)*57.29578d0
44  y=dasin(x)*57.29578d0
45  mtz=91.5-y
46  tf1=(dacos(x)/conv)
47  tf=10.0d0*tf1+1.0
48  tfm1=idint(tf+0.01d0)
49  tfp1=tfm1+1.0d0
50  if(l-jpart)16,16,17
51  17 mt=1
52  mn=nomat
53  go to 19
54  16 continue
55  mt=idint(tf+0.01d0)
56  18 mn=(l-1)*32
57  19 continue
58  call xntpln(tf,tfm1,tfp1,t(mt,1),t(mt+1,1),tmt1)
59  call xntpln(tf,tfm1,tfp1,t(mt,2),t(mt+1,2),tmt2)
60  call xntpln(tf,tfm1,tfp1,t(mt,3),t(mt+1,3),tmt3)
61  call xntpln(tf,tfm1,tfp1,t(mt,4),t(mt+1,4),tmt4)
62  p(1,l)=cfisq*tmt1+sisq*tmt2+2.0d0*sifi*tmt3
63  p(2,l)=sfisq*(amups*tmt1+amusq*tmt2+2.0d0*amumu*tmt3)
64  p(3,l)=siin*(amup*coosn*tmt1+amu*copsi*tmt2+(amup*copsi+
65  1 1amu*coosn)*tmt3)
66  p(4,l)=siin*(amu*coosn-amup*copsi)*tmt4
67  p(5,l)=sfisq*(amups*tmt2+amusq*tmt1+2.0d0*amumu*tmt3)
68  p(6,l)=sisq*tmt1+cfisq*tmt2+2.0d0*sifi*tmt3
69  pmats=const*0.5d0*(p(1,l)+p(2,l)+p(5,l)+p(6,l))*4.0d0*pi
70  p(7,l)=-siin*(amup*coosn*tmt2+amu*copsi*tmt1+(amup*copsi+
71  1amu*coosn)*tmt3)
72  p(8,l)=-p(4,l)
73  p(9,l)=-2.0d0*siin*(amu*coosn*tmt1+amup*copsi*tmt2+
74  1 (amup*coosn+amu*copsi)*tmt3)
75  p(10,l)=2.0d0*siin*(amu*coosn*tmt2+amup*copsi*tmt1+
76  1 (amup*coosn+amu*copsi)*tmt3)
77  p(11,l)=(sifi-amumu*sfisq)*(tmt1+tmt2)+(cfisq+sisq-sfisq
78  1 *(amusq+amups))*tmt3
79  p(12,l)=(cfisq-sisq-sfisq*(amusq-amups))*tmt4
80  p(13,l)=-2.0d0*siin*(amu*copsi-amup*coosn)*tmt4
81  p(14,l)=-p(13,l)
82  p(15,l)=(sisq-cfisq-sfisq*(amusq-amups))*tmt4
83  p(16,l)=(sifi+amumu*sfisq)*(tmt1+tmt2)+(cfisq+sisq+sfisq
84  1 *(amusq+amups))*tmt3
85  p(17,l)=sisq
86  p(18,l)=amusq*sfisq
87  p(19,l)=amu*copsi*siin
88  p(20,l)=0.0d0
89  p(21,l)=amups*sfisq
90  p(22,l)=cfisq
91  p(23,l)=-amup*coosn*siin
92  p(24,l)=0.0d0
93  p(25,l)=-2.0d0*amup*copsi*siin
94  p(26,l)=2.0d0*amu*coosn*siin
95  p(27,l)=-amumu*sfisq+sifi
96  p(28,l)=0.0d0
97  p(29,l)=0.0d0
98  p(30,l)=0.0d0
99  p(31,l)=0.0d0
100  p(32,l)=amumu*sfisq+sifi
101 c apply molecular depolarization correction
102  if(ipol.eq.1)then
103  do i=1,3
104  do j=1,3
105  k=16+(i-1)*4+j
106  dgm=bgm
107  if(i.eq.3 .or. j.eq.3)dgm=0.0d0
108  p(k,l)=agm*p(k,l)+dgm
109  enddo
110  enddo
111  p(32,l)=p(32,l)+cgm
112  endif
113 c++++++++++++++++++++++++++++++++++++++++++
114  go to 1
115  75 mn=0
116  do ik=1,16
117  jp=((ik-1)/4)*4
118  ip=iq+jp/4+1
119  ir=ik-jp
120  p(ik,l)=pp(ip,ir)
121  enddo
122  351 p(17,l)=sisq
123  p(18,l)=amusq*sfisq
124  p(19,l)=amu*copsi*siin
125  p(20,l)=0.0d0
126  p(21,l)=amups*sfisq
127  p(22,l)=cfisq
128  p(23,l)=-amup*coosn*siin
129  p(24,l)=0.0d0
130  p(25,l)=-2.0d0*amup*copsi*siin
131  p(26,l)=2.0d0*amu*coosn*siin
132  p(27,l)=-amumu*sfisq+sifi
133  p(28,l)=0.0d0
134  p(29,l)=0.0d0
135  p(30,l)=0.0d0
136  p(31,l)=0.0d0
137  p(32,l)=amumu*sfisq+sifi
138 c apply molecular depolarization correction
139  if(ipol.eq.1)then
140  do i=1,3
141  do j=1,3
142  k=16+(i-1)*4+j
143  dgm=bgm
144  if(i.eq.3 .or. j.eq.3) dgm=0.0d0
145  p(k,l)=agm*p(k,l)+dgm
146  enddo
147  enddo
148  p(32,l)=p(32,l)+cgm
149  endif
150  if(ii-jjj)1139,1,1
151  1139 if(l-1)1,1140,1
152  1140 lz=jjpart
153 c++++++++++++++++++++++++++++++++++++++++++
154  x = amu * amup + anu * anup * coosn
155  xabs=dabs(x)
156  if(x.gt.1.0d0) x=1.0d0
157  if(x.lt.-1.0d0) x=-1.0d0
158  if(xabs.lt.1.0e-6) x=0.0
159  xza=dacos(x)*57.29578d0
160  y=dasin(x)*57.29578d0
161  mtz=91.5-y
162  tf1=(dacos(x)/conv)
163  tf=10.0d0*tf1+1.0
164  tfm1=idint(tf+0.01d0)
165  tfp1=tfm1+1.0d0
166  if(lz-jpart)12,12,13
167  13 mt=1
168  mn=nomat
169  go to 29
170  12 continue
171  mt=idint(tf+0.01d0)
172  28 mn=(lz-1)*32
173  29 continue
174  call xntpln(tf,tfm1,tfp1,t(mt,1),t(mt+1,1),tmt1)
175  call xntpln(tf,tfm1,tfp1,t(mt,2),t(mt+1,2),tmt2)
176  call xntpln(tf,tfm1,tfp1,t(mt,3),t(mt+1,3),tmt3)
177  call xntpln(tf,tfm1,tfp1,t(mt,4),t(mt+1,4),tmt4)
178  p(1,lz)=cfisq*tmt1+sisq*tmt2+2.0d0*sifi*tmt3
179  p(2,lz)=sfisq*(amups*tmt1+amusq*tmt2+2.0d0*amumu*tmt3)
180  p(3,lz)=siin*(amup*coosn*tmt1+amu*copsi*tmt2+(amup*copsi+
181  1amu*coosn)*tmt3)
182  p(4,lz)=siin*(amu*coosn-amup*copsi)*tmt4
183  p(5,lz)=sfisq*(amups*tmt2+amusq*tmt1+2.0d0*amumu*tmt3)
184  p(6,lz)=sisq*tmt1+cfisq*tmt2+2.0d0*sifi*tmt3
185  pmats=const*0.5d0*(p(1,lz)+p(2,lz)+p(5,lz)+p(6,lz))*4.0d0*pi
186  p(7,lz)=-siin*(amup*coosn*tmt2+amu*copsi*tmt1+(amup*copsi+
187  1amu*coosn)*tmt3)
188  p(8,lz)=-p(4,lz)
189  p(9,lz)=-2.0d0*siin*(amu*coosn*tmt1+amup*copsi*tmt2+
190  1 (amup*coosn+amu*copsi)*tmt3)
191  p(10,lz)=2.0d0*siin*(amu*coosn*tmt2+amup*copsi*tmt1+
192  1 (amup*coosn+amu*copsi)*tmt3)
193  p(11,lz)=(sifi-amumu*sfisq)*(tmt1+tmt2)+(cfisq+sisq-sfisq
194  1 *(amusq+amups))*tmt3
195  p(12,lz)=(cfisq-sisq-sfisq*(amusq-amups))*tmt4
196  p(13,lz)=-2.0d0*siin*(amu*copsi-amup*coosn)*tmt4
197  p(14,lz)=-p(13,lz)
198  p(15,lz)=(sisq-cfisq-sfisq*(amusq-amups))*tmt4
199  p(16,lz)=(sifi+amumu*sfisq)*(tmt1+tmt2)+(cfisq+sisq+sfisq
200  1 *(amusq+amups))*tmt3
201  p(17,lz)=sisq
202  p(18,lz)=amusq*sfisq
203  p(19,lz)=amu*copsi*siin
204  p(20,lz)=0.0d0
205  p(21,lz)=amups*sfisq
206  p(22,lz)=cfisq
207  p(23,lz)=-amup*coosn*siin
208  p(24,lz)=0.0d0
209  p(25,lz) = -2.0d0*amup*copsi*siin
210  p(26,lz) = 2.0d0*amu*coosn*siin
211  p(27,lz)=-amumu*sfisq+sifi
212  p(28,lz)=0.0d0
213  p(29,lz)=0.0d0
214  p(30,lz)=0.0d0
215  p(31,lz)=0.0d0
216  p(32,lz)=amumu*sfisq+sifi
217 c apply molecular depolarization correction
218  if(ipol.eq.1)then
219  do i=1,3
220  do j=1,3
221  k=16+(i-1)*4+j
222  dgm=bgm
223  if(i.eq.3 .or. j.eq.3)dgm=0.0d0
224  p(k,lz)=agm*p(k,lz)+dgm
225  enddo
226  enddo
227  p(32,lz)=p(32,lz)+cgm
228  endif
229 c++++++++++++++++++++++++++++++++++++++++++
230  go to 1
231  76 mn=nomat-31
232  mnz=nomat-32
233  mnn=mn+15
234  do ik=mn,mnn
235  jp=((ik-mn)/4)*4
236  ip=iq+jp/4+1
237  ir=ik-jp-mn+1
238  p(ik-mnz,lz)=qq(ip,ir)
239  enddo
240  mn=mn-1
241  go to 351
242  1 continue
243  return
244  end
245 c***********************************************************************
const
subroutine const(NGAUSS, NMAX, MMAX, P, X, W, AN, ANN, S, SS, NP, EPS)
Definition: ampld.lp.f:924
xntpln
subroutine xntpln(x, x1, x2, y1, y2, y)
Definition: xntpln.f:2
pi
#define pi
Definition: vincenty.c:23
matrx1
subroutine matrx1
Definition: matrx1.f:2


ABOUT

Our Team

Contact Us

DATA

Get Started

Find Data

Use Data

TOOLS

SeaBASS

SeaDAS

Giovanni Data Visualizer

Worldview Mapping Interface

Mission Quality Monitor

HELP

Level 1 & 2 Browser Help

Level 3 & 4 Browser Help

File Search Help

Search & Download Help

Earthdata Forum

Join Mailing List

How to Cite Data

CONNECT WITH US
COMPLIANCE

Web Privacy Policy

Data & Information Policy

Communications Policy

Accessibility Policy

Freedom of Information Act

USA.gov

Responsible NASA Official: Sean Bailey
Curator: OceanColor Webmaster