OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
afrt.cpp
Go to the documentation of this file.
1 /*
2  * afrt.cpp
3  *
4  * Created on: Mar 22, 2019
5  * Author: Samuel Anderson
6  */
7 
8 #include <math.h>
9 #include <afrt.h>
10 #include <array>
11 
12 /**************************************************************************
13  * NAME: Afrt()
14  *
15  * DESCRIPTION: Constructor
16  *
17  *************************************************************************/
18 
20 {
21 }
22 
23 /**************************************************************************
24  * NAME: ~Afrt()
25  *
26  * DESCRIPTION: Destructor
27  *
28  *************************************************************************/
29 
31 {
32 }
33 
34 /**************************************************************************
35  * NAME: Initialize()
36  *
37  * DESCRIPTION: Initialize object class should it be required
38  *
39  *************************************************************************/
40 
42 {
43  return RT_SUCCESS;
44 }
45 
46 /**************************************************************************
47  * NAME: ocn()
48  *
49  * DESCRIPTION: Compute ocean surface reflectance
50  *
51  *************************************************************************/
52 
53 int Afrt::ocn()
54 {
55  return RT_SUCCESS;
56 }
57 
58 /**************************************************************************
59  * NAME: rt1()
60  *
61  * DESCRIPTION: First part of the radiative transfer program. Compute
62  * optical thickness profiles.
63  *
64  *************************************************************************/
65 
66 int Afrt::rt1()
67 {
68  return RT_SUCCESS;
69 }
70 
71 /**************************************************************************
72  * NAME: rt1()
73  *
74  * DESCRIPTION: First part of the radiative transfer program. Compute
75  * optical thickness profiles.
76  *
77  *************************************************************************/
78 
79 int Afrt::rt2(int ilm, int isd, int itau, int iwnd,
80  rt2_in* rt2in, rt2_out* rt2out,
81  rt1_in* rt1in, rt1_out* rt1out,
82  ocn_in* ocnin, ocn_out* ocnout,
83  phs_in* phsin, phs_out* phsout)
84 {
85  int status = 0;
86 
87  ifc = rt1out->ifc[0][0][0];
88  iref = rt2in->iref;
89  iglint = rt2in->iglint;
90  itrans = rt2in->itrans;
91  iwatr = rt2in->iwatr;
92  ifoam = rt2in->ifoam;
93  ipol = rt2in->ipol;
94  nx = rt2in->inx;
95  dphi = rt2in->dphi;
96  alw = rt2in->albwat[ilm];
97  nmu = 2*nx-2;
98  nophi = 360.0/dphi;
99  jpart = nophi/2+1;
100  ddphi = dphi*D2R;
101  conr = 3.0/(8.0*M_PI);
102 // rt1 inputs
103  rho = rt1out->rho[0][0][0];
104  nolyr = rt1out->nolyr[0][0][0];
105  wvlth = rt1out->wvlth[0][0][0];
106  tautot = rt1out->tautot[0][0][0];
107  for (int i=0; i<nolyr; i++) {
108  dtmm[i] = rt1out->dtmm[0][0][0][i];
109  dtrr[i] = rt1out->dtrr[0][0][0][i];
110  dtaa[i] = rt1out->dtaa[0][0][0][i];
111  dtot[i] = rt1out->dtot[0][0][0][i];
112  }
113 // phs inputs
114  int olm = ilm-rt2in->ilm1;
115  int osd = isd-rt2in->isd1;
116  cnst = pow(wvlth,2.0)/(4.0*pow(M_PI,2.0)*phsout->qscat[olm][osd]);
117  qsqt = phsout->qscat[olm][osd]/phsout->qext[olm][osd];
118  for (int i=0; i<ntf; i++) {
119  thd[i] = phsout->thd[olm][osd][i];
120  for (int k=0; k<nstk; k++) {
121  t[k][i] = phsout->t[olm][osd][k][i];
122  }
123  }
124 // ocn inputs
125  xrw = ocnin->xr;
126  xiw = ocnin->xi;
127  vz = ocnin->v;
128  for (int i=0; i<nsza; i++) {
129  for (int j=0; j<nthe; j++) {
130  for (int l=0; l<nphi; l++) {
131  for (int k=0; k<16; k++) {
132  txx[i][j][l][k] = ocnout->txx[0][0][i][j][l][k];
133  }
134  }
135  }
136  }
137 
138  memset(&fnull, 0, sizeof(fdat));
139  unit53.assign(nolyr+1, fnull);
140  unit54.assign(nolyr+1, fnull);
141  unit55.assign(nolyr+1, fnull);
142  unit64.assign(nolyr+1, fnull);
143  unit65.assign(nolyr+1, fnull);
144  unit71.assign(nolyr+1, fnull);
145  unit72.assign(nolyr+1, fnull);
146 
147  insz = 0;
148 // loop over solar zenith angle
149  for (ksza = rt2in->ithe01; ksza <= rt2in->ithe02; ksza++) {
150  int isza = ksza-rt2in->ithe01;
151  msza[isza] = ksza;
152  insz += 1;
153  calb = 0.0;
154  jpass = 0;
155  for (int i=0; i<nmu; i++) {
156  c[i] = 1.0;
157  }
158  for (int i=0; i < 2*nmu; i++) {
159  for (int k=1; k<nstk; k++ ) {
160  pp[k][i] = 0.0;
161  qq[k][i] = 0.0;
162  }
163  }
164  for (int i=0; i<2; i++) {
165  ei[i] = 0.50;
166  ei[i+2] = 0.0;
167  }
168  for (int i = 0; i < nx; i++) {
169  rmu[i] = rt2in->rx[i];
170  rmu[nmu-i] = 180.0 - rt2in->rx[i];
171  }
172  for (int i = 0; i < nmu+1; i++) {
173  cmu[i] = cos(rmu[i]*D2R);
174  }
175  for (int i = 0; i < nmu; i++) {
176  double xmu = (rmu[i] + rmu[i+1])/2.0;
177  the[i] = xmu;
178  if (i > nx-2) {
179  the[i] = the[nmu-1-i];
180  }
181  if (abs(xmu - rt2in->the0in[ksza-1]) <= 1.0e-3) {
182  amuo = cos(xmu*D2R);
183  kkx = i;
184  }
185  cosmu[i] = cos(xmu*D2R);
186  sinmu[i] = sin(xmu*D2R);
187  }
188  for (int l=0; l<nophi+1; l++) {
189  phi[l] = l*dphi;
190  }
191  for (int i = 0; i < jpart; i++) {
192  costh[i] = cos(((double)i)*dphi*D2R);
193  sinth[i] = sin(((double)i)*dphi*D2R);
194  }
195  for (int i = 0; i < nmu; i++) {
196  dcmu2[i] = (pow(cmu[i], 2.0) - pow(cmu[i+1], 2.0))/2.0;
197  dcmu[i] = cmu[i] - cmu[i+1];
198  }
199 // determine an average value of phase matrix in the forward/
200 // backward direction
201  if (ifc == 1) {
202  hump(cnst, t, pp, nmu, dphi+0.001, rmu, thd, 0);
203  hump(cnst, t, qq, nmu, dphi+0.001, rmu, thd, 1);
204  }
205  if (iref == 2) {
206  anglw();
207  }
208 // compute the attenuation parameters
209 // determine the total optical thickness at every level in the atmosphere
210  taupl[0] = 0.0;
211  for (int i=0; i<nolyr; i++) {
212  taupl[i+1] = taupl[i] + dtot[i];
213  }
214 // compute the solar attenuation up to the middle as well as
215 // bottom of the layer (plane parallel case)
216  efactb[0] = 1.0;
217  for (int i = 0; i < nolyr; i++) {
218  efact[i] = exp(-(0.50*dtot[i]+taupl[i])/amuo);
219  efactb[i+1] = exp(-taupl[i+1]/amuo);
220  }
221  eo[0] = 0.5*exp(-taupl[nolyr]/amuo);
222  eo[1] = 0.5*exp(-taupl[nolyr]/amuo);
223  totl[0] = 1.0e-10;
224  for (int i = 0; i < nolyr; i++) {
225  totl[i+1] = totl[i] + dtot[i];
226  }
227  for (int i = 0; i < nolyr; i++) {
228  for (int j=0; j<nmu; j++) {
229  emdtm[j][i] = exp(-dtot[i]/abs(cosmu[j]));
230  emtm[j][i] = exp(-(totl[i+1]-0.5*dtot[i])/abs(cosmu[j]));
231  }
232  }
233 // compute the scattering phase matrices (rayleigh/aerosol)
234 // compute phase matrices for first scatter
235  int kk = kkx;
236  for (int ii = 0; ii < nmu; ii++) {
237  matrx(ii, kk);
238  for (int i = 0; i < jpart; i++) {
239  for (int k = 0; k < 32; k++) {
240  pfs[ii][i][k] = p[i][k];
241  }
242  }
243  }
244 // compute phase matrices for second scatter
245  for (int i = 0; i < nx-1; i++) {
246  qsp[i] = 0.0;
247  }
248  for (int ii = 0; ii < nmu; ii++) {
249  for (int kk = 0; kk < nmu; kk++) {
250  matrx(ii, kk);
251  for (int i = 0; i < jpart; i++) {
252  for (int k = 0; k < 32; k++) {
253  ppin[kk][ii][i][k] = p[i][k];
254  }
255  }
256  }
257  if (ifc != 0) {
258  ee[0] = 0.5;
259  ee[1] = 0.5;
260  for (int k = 0; k < nx-1; k++) {
261  double qspp = 0.0;
262  for (int m = 0; m < jpart; m++) {
263  double xfot = cnst*(ee[0]*(ppin[k][ii][m][0] +
264  ppin[k][ii][m][3]) + ee[1]*
265  (ppin[k][ii][m][1] + ppin[k][ii][m][5]));
266  if (m==0 || m==jpart-1) {
267  qspp = qspp + xfot;
268  } else {
269  qspp = qspp + 2.0*xfot;
270  }
271  }
272  qsp[k] = qsp[k] + qspp*dcmu[ii]*ddphi;
273  }
274  }
275  }
276  if (ifc != 0) {
277  for (int i = 0; i < nx-1; i++) {
278  c[i] = 1.0/qsp[i];
279  c[nmu-i] = c[i];
280  }
281  }
282 // begin radiative transfer calculations
283  int ibgn = 0;
284  int iend = 1;
285  if (insz == 1 && (iref == 0 || itrans == 1)) {
286  iend = 2;
287  }
288 // illumination from the top of the atmosphere(kzz = 0)
289 // illumination from the bottom of the atmosphere(kzz = 1)
290  for (kzz = ibgn; kzz < iend; kzz++) {
291  jpass = 0;
292  int nump = rt2in->inpass1;
293  double d1px[nphi][nsza][2];
294  double d2px[nphi][nsza][2];
295  for (int k = 0; k < 2; k++) {
296  for (int i = 0; i < nx-1; i++) {
297  for (int j = 0; j < jpart; j++) {
298  d1px[j][i][k] = 0.0;
299  d2px[j][i][k] = 0.0;
300  }
301  }
302  }
303  if (insz == 1 && (iref == 0 || itrans == 1)) {
304  nump = rt2in->inpass2;
305  }
306  if (kzz == 0) {
307  single_down();
308  }
309  if (kzz == 1 && iref == 0) {
310  // initialize unit 55
311  unit55.assign(nolyr+1, fnull);
312  if(iref==0) {
313  for (int i=nx-1; i<nmu; i++) {
314  for (int j=0; j<jpart; j++) {
315  for (int k=0; k<2; k++) {
316  unit55[nolyr].f[j][i][k] = 0.5/M_PI;
317  unit55[nolyr].f[j][i][k+2] = 0.0;
318  }
319  }
320  }
321  }
322  if(iref==1 || iref==2 || iref==3) {
323  fio = unit53[nolyr];
324  }
325  single_up();
326  }
327  if (kzz == 1 && itrans == 1) {
328 // focn_below();
329 // snglup();
330  }
331  getrad();
332  for (int ka = 0; ka < nump; ka++) {
333 // initialize the disk units
334  kdx = ka - (ka/2)*2;
335  if (kdx == 0) {
336  irad = &unit64;
337  iwrt = &unit65;
338  } else {
339  irad = &unit65;
340  iwrt = &unit64;
341  }
342  if (kzz == 0) {
343  multp1d();
344  } else if (kzz == 1 && iref == 0) {
345  multp2d();
346  } else if (kzz == 1 && itrans == 1) {
347 // multp2d_trans();
348  }
349  jpass++;
350  getrad();
351  double d3 = 1.0;
352  if (jpass > 2) {
353  for (int i=0; i<nx-1; i++ ) {
354  for (int j=0; j<jpart; j++) {
355  d1px[j][i][0]=d1px[j][i][1];
356  d2px[j][i][0]=d2px[j][i][1];
357  }
358  }
359  for (int i=0; i<nx-1; i++) {
360  for (int j=0; j<jpart; j++) {
361  double r1=geoiup[j][i][jpass-3];
362  double r2=geoiup[j][i][jpass-2];
363  double r3=geoiup[j][i][jpass-1];
364  double rat=(r3-r2)/(r2-r1);
365  double r4=r1+(r2-r1)/(1.0-rat);
366  d1px[j][i][1]=r4;
367  }
368  }
369  for (int i=0; i<nx-1; i++) {
370  for (int j=0; j<jpart; j++) {
371  double u1=geoidn[j][i][jpass-3];
372  double u2=geoidn[j][i][jpass-2];
373  double u3=geoidn[j][i][jpass-1];
374  double uat=(u3-u2)/(u2-u1);
375  double u4=u1+(u2-u1)/(1.0-uat);
376  d2px[j][i][1]=u4;
377  }
378  }
379  double df1[nphi][nsza];
380  double df2[nphi][nsza];
381  // compute the difference
382  for (int i=0; i<nx-1; i++ ) {
383  for (int j=0; j<jpart; j++) {
384  df1[j][i]=100.0*(d1px[j][i][1]-d1px[j][i][0])/d1px[j][i][1];
385  df2[j][i]=100.0*(d2px[j][i][1]-d2px[j][i][0])/d2px[j][i][1];
386  }
387  }
388  // compute the max value
389  double xmax1 = 0.0;
390  double xmax2 = 0.0;
391  for (int i=0; i<nx-1; i++ ) {
392  for (int j=0; j<jpart; j++) {
393  if(df1[j][i]>xmax1) xmax1=df1[j][i];
394  if(df2[j][i]>xmax2) xmax2=df2[j][i];
395  }
396  }
397  d3 = max(xmax1, xmax2);
398  }
399  unit71[jpass] = iwrt->at(0);
400  unit72[jpass] = iwrt->at(nolyr);
401  if (jpass > 2) {
402  if (d3 <= 0.1 || jpass >= 20) break;
403  }
404  }
405  geocor();
406  // illumination from bottom is done only once
407  if (kzz == 1) break;
408  }
409  }
410  for (int i=0; i<(rt2in->ithe02-rt2in->ithe01+1); i++) {
411  int m=msza[i];
412  rt2out->tma[0][0][0][0][i]=rt2in->the0in[m];
413  rt2out->tmb[0][0][0][0][i]=fdirc[m];
414  rt2out->tmc[0][0][0][0][i]=sbarz[m];
415  rt2out->tmfd[0][0][0][0][i]=fdown[m];
416  rt2out->tmfu[0][0][0][0][i]=fup[m];
417  rt2out->tms[0][0][0][0][i]=oalb[m];
418  rt2out->tmg[0][0][0][0][i]=albtdr[m];
419  rt2out->tmh[0][0][0][0][i]=albtdf[m];
420  rt2out->tmp[0][0][0][0][i]=albtrf[m];
421  rt2out->tmq[0][0][0][0][i]=albwl[m];
422  rt2out->tmpp[0][0][0][0][i]=albwl[m]/(fdirc[m]+fdown[m]);
423  rt2out->tmqq[0][0][0][0][i]=oalb[m]-rt2out->tmpp[0][0][0][0][i];
424  rt2out->tmrr[0][0][0][0][i]=albrdr[m];
425  rt2out->tmss[0][0][0][0][i]=albrdf[m];
426  for (int is=0; is<jpart; is++) {
427  for (int ir=0; ir<nx-1; ir++) {
428  for (int s=0; s<nstk; s++) {
429  rt2out->xzerod[0][0][0][0][i][ir][is][s] = xzerod[is][ir][m][s];
430  rt2out->xzeroz[0][0][0][0][i][ir][is][s] = xzeroz[is][ir][m][s];
431  }
432  }
433  }
434  }
435 
436  return status;
437 }
438 
439 /**************************************************************************
440  * NAME: hump()
441  *
442  * DESCRIPTION: program to compute pbar for each mup when mu=mup and delfi=0
443  *
444  *************************************************************************/
445 
446 int Afrt::hump(double cnst, double t[][ntf], double tp[][nlyr],
447  int nm, double lp, double rmu[], double thd[], int ixy)
448 {
449  double p[nstk][nstk];
450  memset(p, 0, nstk*nstk*sizeof(double));
451  double dp=0.10;
452  double dt=0.10;
453  double fi1=lp/2;
454  int ni1=fi1/dp+1;
455  dp=fi1/((double) ni1);
456  double costh[nlyr];
457  double sinth[nlyr];
458  for (int k=0; k<ni1; k++) {
459  double angle;
460  if(ixy!=0) {
461  angle=(180.0-lp/2.0+((double)k)*dp+dp/2.0)*D2R;
462  } else {
463  angle=(((double)k)*dp+dp/2.0)*D2R;
464  }
465  sinth[k] = sin(angle);
466  costh[k] = cos(angle);
467  }
468  double deldeg = dt;
469  double dcmu[nlyr];
470  for (int kl=0; kl<nm/2; kl++) {
471  double deg = rmu[kl+1] - rmu[kl];
472  double nodeg = deg/deldeg;
473  deldeg = deg / nodeg;
474  double thetd = (rmu[kl]+rmu[kl+1])/2.0;
475  double amup = cos(thetd*D2R);
476  for (int i=0; i<nodeg+1; i++) {
477  dcmu[i] = cos((thetd-deg/2.0+((double)i)*deldeg)*D2R)-
478  cos((thetd-deg/2.0+((double)(i+1))*deldeg)*D2R);
479  }
480  double ddmu = cos(rmu[kl]*D2R)-cos(rmu[kl+1]*D2R);
481  double amup2=pow(amup,2.0);
482  for (int i=0; i<nstk; i++) {
483  int k=kl*nstk+i;
484  for (int j=0; j<nstk; j++) {
485  tp[j][k]=0.0;
486  }
487  }
488  for (int i=0; i<nodeg; i++) {
489  double amu=cos((thetd-(deg-deldeg)/2.0+((double)i)*deldeg)*D2R);
490  if(ixy!=0) {
491  amu=-amu;
492  }
493  memset(p, 0, nstk*nstk*sizeof(double));
494  double amusq=pow(amu,2.0);
495  double amumu=amu*amup;
496  double anunu = sqrt((1.0-amup2)*(1.0-amusq));
497  for (int j=0; j<ni1; j++) {
498  double copsi=anunu+amumu*costh[j];
499  double sifi=copsi*costh[j];
500  double sfisq=pow(sinth[j],2.0);
501  double cfisq=pow(costh[j],2.0);
502  double sisq=pow(copsi,2.0);
503  //double a=amup*costh[j];
504  //double b=amup*copsi;
505  //double c=amu*costh[j];
506  //double d=amu*copsi;
507  double e=sfisq*(amusq+amup2);
508  double g=amumu*sfisq;
509  double h=sfisq*(amusq-amup2);
510  //double x=amumu+anunu*costh[j];
511  double yz= acos(amumu+anunu*costh[j])/D2R;
512  int m=10.0*yz;
513  if(m==0) m=0;
514  double t1, t2, t3, t4;
515  xntpln(yz,thd[m],thd[m+1],t[0][m],t[0][m+1],t1);
516  xntpln(yz,thd[m],thd[m+1],t[1][m],t[1][m+1],t2);
517  xntpln(yz,thd[m],thd[m+1],t[2][m],t[2][m+1],t3);
518  xntpln(yz,thd[m],thd[m+1],t[3][m],t[3][m+1],t4);
519  p[2][2]=p[2][2]+(sifi-g)*(t1+t2)+(cfisq+sisq-e)*t3;
520  p[1][1]=p[1][1]+sisq*t1+cfisq*t2+2.0 *sifi * t3;
521  p[1][0]=p[1][0]+sfisq*(amup2*t1+amusq*t2+2.0 * amumu *t3 );
522  p[0][1]=p[0][1]+sfisq*(amup2*t2+amusq*t1+2.0 * amumu *t3);
523  p[0][0]=p[0][0]+cfisq*t1+sisq*t2+2.0 * sifi *t3;
524  p[2][3]=p[2][3]+(sisq-cfisq-h)*t4;
525  p[3][2]=p[3][2]+(cfisq-sisq-h)*t4;
526  p[3][3]=p[3][3]+(sifi+g)*(t1+t2)+(cfisq+sisq+e)*t3;
527  }
528  for (int k=0; k<nstk; k++) {
529  int kk = kl*4+k;
530  for (int l=0; l<nstk; l++) {
531  //double ttpp1=cnst*p[0][k]*dcmu[i]*dp/fi1;
532  //double ttpp2=cnst*p[1][k]*dcmu[i]*dp/fi1;
533  //double ttpp=0.5*(ttpp1+ttpp2);
534  tp[l][kk]=p[l][k]*dcmu[i]*dp/fi1+tp[l][kk];
535  }
536  }
537  }
538  for (int k=0; k<nstk; k++) {
539  int kk = kl*4+k;
540  for (int l=0; l<nstk; l++) {
541  tp[l][kk]=tp[l][kk]/ddmu;
542  }
543  }
544  //int id = kl*4;
545  //double ppbar=cnst*(tp[0][id]+tp[1][id]+tp[0][id+1]+tp[1][id+1])*0.5;
546  }
547 
548  return RT_SUCCESS;
549 }
550 
551 /**************************************************************************
552  * NAME: anglw()
553  *
554  * DESCRIPTION: compute angles of refraction and sin/cos assuming flat ocean
555  *
556  *************************************************************************/
557 
559 {
560  double rmuw[2*nthe];
561  for (int i=0; i<nx; i++) {
562  double cnuw = sqrt(1.0-pow(cmu[i],2.0))/xrw;
563  rmuw[i]=asin(cnuw)/D2R;
564  }
565 // compute the center of the bin and its sin/cos
566  for (int i=0; i<nx-1; i++) {
567  double thew = 0.5*(rmuw[i]+rmuw[i+1]);
568  double dnxy = pow(xrw,2.0)+pow(xiw,2.0);
569  double yrw=xrw/dnxy;
570  double yiw=xiw/dnxy;
571  frs(the[i],xrw,xiw,rfair[i]);
572  frs(thew,yrw,yiw,rfwat[i]);
573  }
574  return RT_SUCCESS;
575 }
576 
577 /**************************************************************************
578  * NAME: frs()
579  *
580  * DESCRIPTION: compute the reflectivity of a flat ocean
581  *
582  *************************************************************************/
583 
584 int Afrt::frs(double xx, double xr, double xi, double& rfsea)
585 {
586  double cost = cos(xx*D2R);
587  // calculate the elements of fresnel matrix
588  double sinsq = (1.0-pow(cost,2.0));
589  double sinsq2 = pow(sinsq,2.0);
590  double a = (pow(xr,2.0)-pow(xi,2.0)-1.0 + pow(cost,2.0));
591  double b = (-2.0 * xr * xi);
592  double r = sqrt(pow(a,2.0) + pow(b,2.0));
593  double tmr = pow(cost,2.0)*r;
594  double xp = sqrt(2.0*r + 2.0*a);
595  double xmm = (2.0*r - 2.0*a);
596  if(xmm < 0.0 && xmm > -9.0) xmm = -xmm;
597  double xm=sqrt(xmm);
598  double dnmr1 = sinsq2 + tmr + cost*sinsq*xp;
599  double qrmu = (sinsq2 - tmr)/dnmr1;
600  double qimu = (cost*sinsq*xm)/dnmr1;
601  double dnmr2 = pow(cost,2.0) + r + cost*xp;
602  double rrr = (pow(cost,2.0) - r)/dnmr2;
603  double rri = cost*xm/dnmr2;
604  double rer = qrmu*rrr - qimu*rri;
605  double rei = qimu*rrr + qrmu*rri;
606  double r11 = pow(rer,2.0) + pow(rei,2.0);
607  double r22 = pow(rrr,2.0) + pow(rri,2.0);
608  //double r33 = rer*rrr + rei*rri;
609  //double r34 = rri*rer - rei*rrr;
610  rfsea = 0.5*(r11+r22);
611 
612  return RT_SUCCESS;
613 }
614 
615 /**************************************************************************
616  * NAME: matrx()
617  *
618  * DESCRIPTION: Compute scattering matrices
619  *
620  *************************************************************************/
621 
622 int Afrt::matrx(int ii, int kk)
623 {
624  amusq=pow(cosmu[ii],2.0);
625  amumu=cosmu[ii]*cosmu[kk];
626  amups=pow(cosmu[kk],2.0);
627  for (int l=0; l<jpart; l++) {
628  copsi=sinmu[ii]*sinmu[kk]+cosmu[ii]*cosmu[kk]*costh[l];
629  copsq=pow(copsi,2.0);
630  cfisq=pow(costh[l],2.0);
631  copcs=copsi*costh[l];
632  sfisq=pow(sinth[l],2.0);
633  int iq, ip, ir, jp, mn;
634  if((cosmu[kk]-cosmu[ii])==0) {
635  if(l==0) {
636  if((ii-nx)<0) {
637  iq=4*ii;
638  } else {
639  iq=4*(nmu-ii-1);
640  }
641  mn=0;
642  for (int ik=0; ik<16; ik++) {
643  jp=4*(ik/4);
644  ip=iq+jp/4;
645  ir=ik-jp;
646  p[l][ik]=pp[ir][ip];
647  }
648  depol(ii, kk, l);
649  if((ii-nx)<0) {
650  if(l==0) {
651  mats(ii, kk, jpart);
652  }
653  }
654  } else {
655  mats(ii, kk, l);
656  }
657  } else if((cosmu[ii]+cosmu[kk])==0) {
658  if((l-jpart)==0) {
659  if((ii-nx)<0) {
660  iq=4*ii;
661  } else {
662  iq=4*(nmu-ii-1);
663  }
664  mn=jpart*32-31;
665  for (int ik=mn; ik<=mn+15; ik++) {
666  jp=4*((ik-mn)/4);
667  ip=iq+jp/4;
668  ir=ik-jp-mn;
669  p[l][ik-mn]=qq[ir][ip];
670  }
671  mn=mn-1;
672  depol(ii, kk, l);
673  if((ii-nx)<0) {
674  if(l==0) {
675  mats(ii, kk, jpart);
676  }
677  }
678  } else {
679  mats(ii, kk, l);
680  }
681  } else {
682  mats(ii, kk, l);
683  }
684  }
685 
686  return RT_SUCCESS;
687 }
688 /**************************************************************************
689  * NAME: mats()
690  *
691  * DESCRIPTION: Compute scattering matrices subroutine
692  *
693  *************************************************************************/
694 
695 int Afrt::mats(int ii, int kk, int l)
696 {
697  double x = cosmu[ii] * cosmu[kk] + sinmu[ii] * sinmu[kk] * costh[l];
698  if(x>1.0) x = 1.0;
699  if(x<-1.0) x = -1.0;
700  if(abs(x) < 1.0e-6) x = 0.0;
701  double tf = 10.0*(acos(x)/D2R);
702  double tfm1 = floor(tf + 0.01);
703  double tfp1 = tfm1 + 1.0;
704  int mt = 0;
705  if ((l - jpart) <= 0) {
706  mt = tfm1;
707  }
708  double tmt1, tmt2, tmt3, tmt4;
709  xntpln(tf, tfm1, tfp1, t[0][mt], t[0][mt+1], tmt1);
710  xntpln(tf, tfm1, tfp1, t[1][mt], t[1][mt+1], tmt2);
711  xntpln(tf, tfm1, tfp1, t[2][mt], t[2][mt+1], tmt3);
712  xntpln(tf, tfm1, tfp1, t[3][mt], t[3][mt+1], tmt4);
713  p[l][0] = cfisq*tmt1 + copsq*tmt2 + 2.0*copcs*tmt3;
714  p[l][1] = sfisq*(amups*tmt1 + amusq*tmt2 + 2.0*amumu*tmt3);
715  p[l][2] = -sinth[l]*(cosmu[kk]*costh[l]*tmt1 + cosmu[ii]*copsi*tmt2 +
716  (cosmu[kk]*copsi + cosmu[ii]*costh[l])*tmt3);
717  p[l][3] = sinth[l]*(cosmu[kk]*copsi - cosmu[ii]*costh[l])*tmt4;
718  p[l][4] = sfisq*(amups*tmt2 + amusq*tmt1 + 2.0*amumu*tmt3);
719  p[l][5] = copsq * tmt1 + cfisq * tmt2 + 2.0 * copcs * tmt3;
720  //double pmats = cnst*0.5*(p[l][0]+p[l][1]+p[l][4]+p[l][5])*4.0*M_PI;
721  p[l][6]=sinth[l]*(cosmu[kk]*costh[l]*tmt2+cosmu[ii]*copsi*tmt1+
722  (cosmu[kk]*copsi+cosmu[ii]*costh[l])*tmt3);
723  p[l][7]=-p[l][3];
724  p[l][8]=2.0*sinth[l]*(cosmu[ii]*costh[l]*tmt1+cosmu[kk]*copsi*tmt2+
725  (cosmu[kk]*costh[l]+cosmu[ii]*copsi)*tmt3);
726  p[l][9]=-2.0*sinth[l]*(cosmu[ii]*costh[l]*tmt2+cosmu[kk]*copsi*tmt1+
727  (cosmu[kk]*costh[l]+cosmu[ii]*copsi)*tmt3);
728  p[l][10]=(copcs-amumu*sfisq)*(tmt1+tmt2)+(cfisq+copsq-sfisq*(amusq+amups))*tmt3;
729  p[l][11]=(cfisq-copsq-sfisq*(amusq-amups))*tmt4;
730  p[l][12]=2.0*sinth[l]*(cosmu[ii]*copsi-cosmu[kk]*costh[l])*tmt4;
731  p[l][13]=-p[l][12];
732  p[l][14]=(copsq-cfisq-sfisq*(amusq-amups))*tmt4;
733  p[l][15]=(copcs+amumu*sfisq)*(tmt1+tmt2)+(cfisq+copsq+sfisq*(amusq+amups))*tmt3;
734  depol(ii, kk, l);
735 
736  return RT_SUCCESS;
737 }
738 
739 /**************************************************************************
740  * NAME: depol()
741  *
742  * DESCRIPTION: Compute scattering matrices subroutine
743  *
744  *************************************************************************/
745 
746 int Afrt::depol(int ii, int kk, int l)
747 {
748  p[l][16] = copsq;
749  p[l][17] = amusq *sfisq;
750  p[l][18] = -cosmu[ii]*copsi*sinth[l];
751  p[l][19] = 0.0;
752  p[l][20] = amups*sfisq;
753  p[l][21] = cfisq;
754  p[l][22] = cosmu[kk]*costh[l]*sinth[l];
755  p[l][23] = 0.0;
756  p[l][24] = 2.0*cosmu[kk]*copsi*sinth[l];
757  p[l][25] = -2.0*cosmu[ii]*costh[l]*sinth[l];
758  p[l][26] = -amumu*sfisq + copcs;
759  p[l][27] = 0.0;
760  p[l][28] = 0.0;
761  p[l][29] = 0.0;
762  p[l][30] = 0.0;
763  p[l][31] = amumu*sfisq + copcs;
764  // apply molecular depolarization correction
765  if (ipol == 1) {
766  double gam = rho/(2.0-rho);
767  double agm = (1.0-gam)/(1+2.0*gam);
768  double bgm = gam/(1.0+2.0*gam);
769  double cgm = (1.0-3.0*gam)/(1.0+2.0*gam);
770  for (int i=0; i<3; i++) {
771  for (int j=0; j<3; j++) {
772  int k = 16+i*4+j;
773  double dgm = bgm;
774  if(i==2 || j==2) dgm = 0.0;
775  p[l][k] = agm * p[l][k] + dgm;
776  }
777  }
778  p[l][31] = p[l][31] + cgm;
779  }
780  return RT_SUCCESS;
781 }
782 
783 /**************************************************************************
784  * NAME: single_down()
785  *
786  * DESCRIPTION: Compute scattering matrices subroutine
787  *
788  *************************************************************************/
789 
791 {
792 // initialize the buffers
793  ftmp = fnull;
794 // initialize all levels
795  unit53.assign(nolyr+1, fnull);
796  unit64.assign(nolyr+1, fnull);
797 // compute the downward diffuse radiation at each level
798  double qfi[nstk];
799  double gfot[nstk];
800  for (int il=0; il<nolyr; il++) {
801  fiib = unit53[il];
802  fio = unit53[il+1];
803  tmsl=dtmm[il]*qsqt*cnst;
804  trsl=dtrr[il]*conr;
805  for (int is=0; is<nstk; is++) {
806  qfi[is]=ei[is]*efact[il]/dtot[il];
807  }
808  for (int it=0; it<(nx-1); it++) {
809  for (int ip=0; ip<jpart; ip++) {
810  for (int is=0; is<nstk; is++) {
811  gfot[is]=0.0;
812  }
813  for (int i=0; i<nstk; i++) {
814  for (int j=0; j<nstk; j++) {
815  int ij=i*4+j;
816  gfot[i]=gfot[i]+(pfs[it][ip][ij]*tmsl +
817  pfs[it][ip][ij+16]*trsl)*qfi[j];
818  }
819  ftmp.f[ip][it][i]=gfot[i]*(1.0-emdtm[it][il]);
820  ftmp.f[ip][it][2]= (i>=2) ? -ftmp.f[ip][it][2] : ftmp.f[ip][it][2];
821  ftmp.f[ip][it][3]= (i>=2) ? -ftmp.f[ip][it][3] : ftmp.f[ip][it][3];
822  fio.f[ip][it][i] = fiib.f[ip][it][i]*emdtm[it][il] +
823  ftmp.f[ip][it][i];
824  }
825  }
826  }
827  unit53[il+1] = fio;
828  unit54[il] = ftmp;
829  }
830  if(iref==1) {
831 // fltocn_new();
832  unit53[nolyr] = fio;
833  }
834 // save the reflected radiation
835  ftmpb = fio;
836 // compute the upward diffuse radiation at each level
837  for (int il=0; il<nolyr; il++) {
838  int im=nolyr-il-1;
839  fiib = unit53[im+1];
840  fio = unit53[im];
841  ftmp = unit54[im];
842  tmsl=dtmm[im]*qsqt*cnst;
843  trsl=dtrr[im]*conr;
844  for (int is=0; is<nstk; is++) {
845  qfi[is]=ei[is]*efact[im]/dtot[im];
846  }
847  for (int it=nx-1; it<nmu; it++) {
848  for (int ip=0; ip<jpart; ip++) {
849  for (int is=0; is<nstk; is++) {
850  gfot[is]=0.0;
851  }
852  for (int i=0; i<nstk; i++) {
853  for (int j=0; j<nstk; j++) {
854  int ij=i*4+j;
855  gfot[i]=gfot[i]+(pfs[it][ip][ij]*tmsl +
856  pfs[it][ip][ij+16]*trsl)*qfi[j];
857  }
858  ftmp.f[ip][it][i] = gfot[i]*(1.0-emdtm[it][im]);
859  ftmp.f[ip][it][2]= (i>=2) ? -ftmp.f[ip][it][2] : ftmp.f[ip][it][2];
860  ftmp.f[ip][it][3]= (i>=2) ? -ftmp.f[ip][it][3] : ftmp.f[ip][it][3];
861  fio.f[ip][it][i]=fiib.f[ip][it][i]*emdtm[it][im] +
862  ftmp.f[ip][it][i];
863  }
864  }
865  }
866 // add the contribution from the specular reflection
867 /*
868  for (int is=0; is<nstk; is++) {
869  qfi[is]=eox[is]*efact[il]/dtot[il]
870  }
871 
872  for (int it=nx-1; it<nmu; it++) {
873  int itp=nmu-it;
874  for (int ip=0; ip<jpart; ip++) {
875  for (int is=0; is<nstk; is++) {
876  gfot[is]=0.0
877  }
878  for (int i=0; i<nstk; i++) {
879  for (int j=0; j<nstk; j++) {
880  int ij=i*4+j;
881  gfot[i]=gfot[i]+(pfs[itp][ip][ij]*tmsl +
882  pfs[itp][ip][ij+16]*trsl)*qfi[j];
883  }
884  ftmp.f[ip][it][i] = gfot[i]*(1.0-emdtm[itp][im]);
885  ftmp.f[ip][it][2]= (i>=2) ? -ftmp.f[ip][it][2]: ftmp.f[ip][it][2];
886  ftmp.f[ip][it][3]= (i>=2) ? -ftmp.f[ip][it][3]: ftmp.f[ip][it][3];
887  fio.f[ip][it][i]=fio.f[ip][it][i]+ftmp.f[ip][it][i]+
888  ftmpb.f[ip][it][i]*atnflx[it][il+1];
889  }
890  }
891  }
892 */
893  unit53[im] = fio;
894  unit54[im] = ftmp;
895  }
896 // copy all records to unit 64 for multiple scattering calculations
897  for (int il=0; il<=nolyr; il++) {
898  unit64[il] = unit53[il];
899  }
900 
901  return RT_SUCCESS;
902 }
903 
904 /**************************************************************************
905  * NAME: single_up()
906  *
907  * DESCRIPTION: Compute scattering matrices subroutine
908  *
909  *************************************************************************/
910 
912 {
913  memset(&fio, 0, sizeof(fdat));
914  memset(&ftmp, 0, sizeof(fdat));
915  memset(&ftmpa, 0, sizeof(fdat));
916 // compute the upwelling single scattered diffused radiation
917 // save the upwelling diffuse radiation for level nolyr+1 in the buffer ftmpa
918  fiib = unit55[nolyr];
919  ftmpa = unit55[nolyr];
920  for (int il=0; il<nolyr; il++) {
921  int im=nolyr-il-1;
922  tmsl=dtmm[im]*qsqt*cnst;
923  trsl=dtrr[im]*conr;
924  dlyr=dtot[im];
925  for (int i=0; i<nmu; i++) {
926  for (int j=0; j<jpart; j++) {
927  for (int k=0; k<nstk; k++) {
928  ftmp.f[j][i][k]=0.0;
929  fiic.f[j][i][k]=ftmpa.f[j][i][k]*emtm[i][im];
930  }
931  }
932  }
933  mdiffn(nx-1, nmu-1, im, dlyr);
934  for (int i=0; i<nmu; i++) {
935  for (int j=0; j<jpart; j++) {
936  for (int k=0; k<nstk; k++) {
937  fio.f[j][i][k] = fiib.f[j][i][k]*emdtm[i][im] +
938  ftmp.f[j][i][k]*(1.0-emdtm[i][im]);
939  }
940  }
941  }
942  fio = unit55[im];
943  fiib = fio;
944  }
945 // compute the downward radiation
946  fiib = unit55[0];
947  for (int il=0; il<nolyr; il++) {
948  fio = unit55[il+1];
949  tmsl=dtmm[il]*qsqt*cnst;
950  trsl=dtrr[il]*conr;
951  dlyr=dtot[il];
952  for (int i=0; i<(nx-1); i++) {
953  for (int j=0; j<jpart; j++) {
954  for (int k=0; k<nstk; k++) {
955  fiic.f[j][i][k]=ftmpa.f[j][i][k]*emtm[i][il];
956  }
957  }
958  }
959  mdiffn(0, nx-2, il, dlyr);
960  for (int i=0; i<(nx-1); i++) {
961  for (int j=0; j<jpart; j++) {
962  for (int k=0; k<nstk; k++) {
963  fio.f[j][i][k]=fiib.f[j][i][k]*emdtm[i][il] +
964  ftmp.f[j][i][k]*(1.0-emdtm[i][il]);
965  }
966  }
967  }
968  fiib = fio;
969  unit55[il+1] = fio;
970  }
971 // if iref=0 then copy all records to unit 64 for multiple scattering
972 // calculations
973  if(iref == 0 || itrans == 1) {
974  for (int il=0; il<nolyr; il++) {
975  unit64[il] = unit55[il];
976  }
977  eo[0]=0.0;
978  eo[1]=0.0;
979  }
980  return RT_SUCCESS;
981 }
982 
983 /**************************************************************************
984  * NAME: getrad()
985  *
986  * DESCRIPTION: Compute scattering matrices subroutine
987  *
988  *************************************************************************/
989 
991 {
992 // get the radiances at the top and bottom of the atmosphere
993  if (jpass == 0) {
994  fio = unit53[nolyr];
995  } else {
996  fio = iwrt->at(nolyr);
997  }
998  double suma = 0.0;
999  for (int i=0; i<nx-1; i++ ) {
1000  double psum = 0.0;
1001  for (int k=0; k<2; k++ ) {
1002  psum = fio.f[0][i][k] + fio.f[jpart-1][i][k] + psum;
1003  for (int j=1; j<nophi/2; j++ ) {
1004  psum = psum + 2.0*fio.f[j][i][k];
1005  }
1006  }
1007  suma = suma + psum*dcmu2[i]*6.2831854/double(nophi);
1008  }
1009  double sumdwn = suma;
1010  factr = eo[0] + eo[1];
1011  fluxd[nolyr][jpass] = sumdwn;
1012  for (int i=0; i<nx-1; i++ ) {
1013  for (int j=0; j<jpart; j++) {
1014  geoidn[j][i][jpass] = fio.f[j][i][0]+fio.f[j][i][1];
1015  }
1016  }
1017  if (jpass == 0) {
1018  fio = unit53[0];
1019  } else {
1020  fio = iwrt->at(0);
1021  }
1022  for (int i=nx-1; i<nmu; i++) {
1023  int ij = i-(nx-1);
1024  for (int j=0; j<jpart; j++) {
1025  geoiup[j][ij][jpass] = fio.f[j][i][0]+fio.f[j][i][1];
1026  }
1027  }
1028  suma = 0.0;
1029  for (int i=nx-1; i<nmu; i++) {
1030  double psum = 0.0;
1031  for (int k=0; k<2; k++) {
1032  psum = fio.f[0][i][k]+fio.f[jpart-1][i][k] + psum;
1033  }
1034  for (int k=0; k<2; k++) {
1035  for (int j=1; j<nophi/2; j++) {
1036  psum = psum + 2.*fio.f[j][i][k];
1037  }
1038  }
1039  suma=suma+psum*dcmu2[i]*6.2831854/nophi;
1040  }
1041  double sumup = abs(suma);
1042  fluxu[0][jpass]=sumup;
1043 
1044  return RT_SUCCESS;
1045 }
1046 
1047 /**************************************************************************
1048  * NAME: multp1d()
1049  *
1050  * DESCRIPTION: Compute scattering matrices subroutine
1051  *
1052  *************************************************************************/
1053 
1055 {
1056 // compute the downward diffuse radiation at each level
1057  sngla = fnull;
1058  snglb = fnull;
1059  iwrt->at(0) = irad->at(0);
1060  for (int il=0; il<nolyr; il++) {
1061  if(il==0) {
1062  fiib = iwrt->at(il);
1063  fio = irad->at(il+1);
1064  sngla = unit53[il];
1065  snglb = unit53[il+1];
1066 // determine average intensity at the center of the layer il
1067  for (int i=0; i<nmu; i++) {
1068  for (int j=0; j<jpart; j++) {
1069  for (int k=0; k<nstk; k++) {
1070  fiic.f[j][i][k] = 0.50 * (fio.f[j][i][k] + fiib.f[j][i][k]);
1071  ftmp.f[j][i][k] = 0.0;
1072  }
1073  }
1074  }
1075  tmsl=dtmm[il]*qsqt*cnst;
1076  trsl=dtrr[il]*conr;
1077  dlyr=dtot[il];
1078  if(ifc==0) tmsl=0.0;
1079  mdiffn(0,nx-2,il,dlyr);
1080  for (int i=0; i<nx-1; i++) {
1081  for (int j=0; j<jpart; j++) {
1082  for (int k=0; k<nstk; k++) {
1083  fio.f[j][i][k]=fiib.f[j][i][k]*emdtm[i][il] +
1084  ftmp.f[j][i][k]*(1.0-emdtm[i][il]) +
1085  snglb.f[j][i][k]-sngla.f[j][i][k]*emdtm[i][il];
1086  }
1087  }
1088  }
1089  iwrt->at(il+1) = fio;
1090  } else {
1091  fiib = iwrt->at(il-1);
1092  sngla = unit53[il-1];
1093  snglb = unit53[il+1];
1094  fiic = fio;
1095  ftmp = fnull;
1096  fio = irad->at(il+1);
1097  tmsl=(dtmm[il-1]+dtmm[il])*qsqt*cnst;
1098  trsl=(dtrr[il-1]+dtrr[il])*conr;
1099  dlyr=(dtot[il-1]+dtot[il]);
1100  if(ifc==0) tmsl=0.0;
1101  mdiffn(0,nx-2,il,dlyr);
1102  for (int i=0; i<nx-1; i++) {
1103  for (int j=0; j<jpart; j++) {
1104  for (int k=0; k<nstk; k++) {
1105  fio.f[j][i][k] = fiib.f[j][i][k]*emdtm[i][il-1]*emdtm[i][il]+
1106  ftmp.f[j][i][k]*(1.0-emdtm[i][il-1]*emdtm[i][il])+
1107  snglb.f[j][i][k]-sngla.f[j][i][k]*emdtm[i][il-1]*emdtm[i][il];
1108  }
1109  }
1110  }
1111  iwrt->at(il+1) = fio;
1112  }
1113  }
1114  if(iref==1) {
1115 // fltocn_new();
1116  iwrt->at(nolyr) = fio;
1117  }
1118 
1119  if(iref==2) {
1120  rsea_new();
1121  iwrt->at(nolyr) = fio;
1122  }
1123 
1124  if(iref==3) {
1125 // brdfg(fio,brdfx,cosmu,dcmu,dcmu2,eo,ddphi,amuo,M_PI,sumc,
1126 // sumcpi,sumdwn,calb,kkx,nx-1,nmu,jpart);
1127  iwrt->at(nolyr) = fio;
1128  }
1129 // compute the upward diffuse radiation at each level
1130  for (int il=0; il<nolyr; il++) {
1131  int im=nolyr-il-1;
1132  if(il==0) {
1133  fiib = iwrt->at(im+1);
1134  fio = iwrt->at(im);
1135  sngla = unit53[im+1];
1136  snglb = unit53[im];
1137  for (int i=0; i<nmu; i++) {
1138  for (int j=0; j<jpart; j++) {
1139  for (int k=0; k<nstk; k++) {
1140  fiic.f[j][i][k] = 0.50*(fio.f[j][i][k]+fiib.f[j][i][k]);
1141  ftmp.f[j][i][k] = 0.0;
1142  }
1143  }
1144  }
1145  tmsl=dtmm[im]*qsqt*cnst;
1146  trsl=dtrr[im]*conr;
1147  dlyr=dtot[im];
1148  if(ifc==0) tmsl=0.0;
1149  mdiffn(nx-1,nmu-1,im,dlyr);
1150  for (int i=nx-1; i<nmu; i++) {
1151  for (int j=0; j<jpart; j++) {
1152  for (int k=0; k<nstk; k++) {
1153  fio.f[j][i][k] = fiib.f[j][i][k]*emdtm[i][im] +
1154  ftmp.f[j][i][k]*(1.0-emdtm[i][im]) +
1155  snglb.f[j][i][k]-sngla.f[j][i][k]*emdtm[i][im];
1156  }
1157  }
1158  }
1159  iwrt->at(im) = fio;
1160  } else {
1161  fiib = iwrt->at(im+2);
1162  sngla = unit53[im+2];
1163  snglb = unit53[im];
1164  for (int i=0; i<nmu; i++) {
1165  for (int j=0; j<jpart; j++) {
1166  for (int k=0; k<nstk; k++) {
1167  fiic.f[j][i][k]=fio.f[j][i][k];
1168  ftmp.f[j][i][k]=0.0;
1169  }
1170  }
1171  }
1172  fio = iwrt->at(im);
1173  tmsl=(dtmm[im+1]+dtmm[im])*qsqt*cnst;
1174  trsl=(dtrr[im+1]+dtrr[im])*conr;
1175  dlyr=(dtot[im+1]+dtot[im]);
1176  if(ifc==0) tmsl=0.0;
1177  mdiffn(nx-1,nmu-1,im,dlyr);
1178  for (int i=nx-1; i<nmu; i++) {
1179  for (int j=0; j<jpart; j++) {
1180  for (int k=0; k<nstk; k++) {
1181  fio.f[j][i][k] = fiib.f[j][i][k]*emdtm[i][im+1]*emdtm[i][im] +
1182  ftmp.f[j][i][k]*(1.0-emdtm[i][im+1]*emdtm[i][im])+
1183  snglb.f[j][i][k]-sngla.f[j][i][k]*emdtm[i][im+1]*emdtm[i][im];
1184  }
1185  }
1186  }
1187  iwrt->at(im) = fio;
1188  }
1189  }
1190  return RT_SUCCESS;
1191 }
1192 
1193 /**************************************************************************
1194  * NAME: multp2d()
1195  *
1196  * DESCRIPTION: Compute scattering matrices subroutine
1197  *
1198  *************************************************************************/
1199 
1201 {
1202  // compute the downward diffuse radiation at each level c
1203  iwrt->at(0) = irad->at(0);
1204  for (int il=0; il<nolyr; il++) {
1205  if (il == 1) {
1206  fiib = iwrt->at(il);
1207  fio = irad->at(il+1);
1208 // determine average intensity at the center of the layer il
1209  for (int i=0; i<nmu; i++) {
1210  for (int j=0; j<jpart; j++) {
1211  for (int k=0; k<nstk; k++) {
1212  fiic.f[j][i][k] = 0.50 * (fio.f[j][i][k] + fiib.f[j][i][k]);
1213  ftmp.f[j][i][k] = 0.0;
1214  }
1215  }
1216  }
1217  tmsl=dtmm[il]*qsqt*cnst;
1218  trsl=dtrr[il]*conr;
1219  dlyr=dtot[il];
1220  if(ifc==0) tmsl=0.0;
1221  mdiffn(0,nx-2,il,dlyr);
1222  for (int i=0; i<nx-1; i++) {
1223  for (int j=0; j<jpart; j++) {
1224  for (int k=0; k<nstk; k++) {
1225  fio.f[j][i][k] = fiib.f[j][i][k]*emdtm[i][il] +
1226  ftmp.f[j][i][k]*(1.0-emdtm[i][il]);
1227  }
1228  }
1229  }
1230  iwrt->at(il+1) = fio;
1231  } else {
1232  fiib = iwrt->at(il-1);
1233  fiic = fio;
1234  ftmp = fnull;
1235  fio = irad->at(il+1);
1236  tmsl=(dtmm[il-1]+dtmm[il])*qsqt*cnst;
1237  trsl=(dtrr[il-1]+dtrr[il])*conr;
1238  dlyr=(dtot[il-1]+dtot[il]);
1239  if(ifc==0) tmsl=0.0;
1240  mdiffn(0,nx-2,il,dlyr);
1241  for (int i=0; i<nx-1; i++) {
1242  for (int j=0; j<jpart; j++) {
1243  for (int k=0; k<nstk; k++) {
1244  fio.f[j][i][k] = fiib.f[j][i][k]*emdtm[i][il-1]*emdtm[i][il] +
1245  ftmp.f[j][i][k]*(1.0-emdtm[i][il-1]*emdtm[i][il]);
1246  }
1247  }
1248  }
1249  iwrt->at(il+1) = fio;
1250  }
1251  }
1252 // compute the upward diffuse radiation at each level
1253  for (int il=0; il<nolyr; il++) {
1254  int im=nolyr-il-1;
1255  if(il==1) {
1256  fiib = iwrt->at(im+1);
1257  fio = iwrt->at(im);
1258  for (int i=0; i<nmu; i++) {
1259  for (int j=0; j<jpart; j++) {
1260  for (int k=0; k<nstk; k++) {
1261  fiic.f[j][i][k]=0.50*(fio.f[j][i][k]+fiib.f[j][i][k]);
1262  ftmp.f[j][i][k]=0.0;
1263  }
1264  }
1265  }
1266  tmsl=dtmm[im]*qsqt*cnst;
1267  trsl=dtrr[im]*conr;
1268  dlyr=dtot[im];
1269  if(ifc==0) tmsl=0.0;
1270  mdiffn(nx-1,nmu-1,im,dlyr);
1271  for (int i=nx-1; i<nmu; i++) {
1272  for (int j=0; j<jpart; j++) {
1273  for (int k=0; k<nstk; k++) {
1274  fio.f[j][i][k] = fiib.f[j][i][k]*emdtm[i][im] +
1275  ftmp.f[j][i][k]*(1.0-emdtm[i][im]);
1276  }
1277  }
1278  }
1279  iwrt->at(im) = fio;
1280  } else {
1281  fiib = iwrt->at(im+2);
1282  for (int i=0; i<nmu; i++) {
1283  for (int j=0; j<jpart; j++) {
1284  for (int k=0; k<nstk; k++) {
1285  fiic.f[j][i][k]=fio.f[j][i][k];
1286  ftmp.f[j][i][k]=0.0;
1287  }
1288  }
1289  }
1290  fio = iwrt->at(im);
1291  tmsl=(dtmm[im+1]+dtmm[im])*qsqt*cnst;
1292  trsl=(dtrr[im+1]+dtrr[im])*conr;
1293  dlyr=(dtot[im+1]+dtot[im]);
1294  if(ifc==0) tmsl=0.0;
1295  mdiffn(nx-1,nmu-1,im,dlyr);
1296  for (int i=nx-1; i<nmu; i++) {
1297  for (int j=0; j<jpart; j++) {
1298  for (int k=0; k<nstk; k++) {
1299  fio.f[j][i][k] = fiib.f[j][i][k]*emdtm[i][im+1]*emdtm[i][im] +
1300  ftmp.f[j][i][k]*(1.0-emdtm[i][im+1]*emdtm[i][im]);
1301  }
1302  }
1303  }
1304  iwrt->at(im) = fio;
1305  }
1306  }
1307  return RT_SUCCESS;
1308 }
1309 
1310 /**************************************************************************
1311  * NAME: geocor()
1312  *
1313  * DESCRIPTION: Compute scattering matrices subroutine
1314  *
1315  *************************************************************************/
1317 {
1318 
1319  int m1 = jpass-2;
1320  int m2 = jpass-1;
1321  int m3 = jpass;
1322  double tup[nphi][nthe][nsza];
1323  double tdn[nphi][nthe][nsza];
1324 // apply geo series correction to the fluxes leaving the bottom of the atmosphere
1325  double temp1[nlyr];
1326  double temp2[nlyr];
1327  double rr1, rr2;
1328  geom(fluxd[nolyr][m1],fluxd[nolyr][m2],fluxd[nolyr][m3],rr1,temp1[nolyr]);
1329  geom(fluxu[0][m1],fluxu[0][m2],fluxu[0][m3],rr2,temp2[0]);
1330  //
1331  // if(kzz==0) {
1332  // double totflxgs=temp1[nolyr]+temp2[0]+amuo*factr;
1333  // double ctest=totflxgs/amuo;
1334  // }
1335  double gz, sb;
1336  if(kzz==0) gz = temp1[nolyr];
1337  if(kzz==1 && itrans==0) sb = temp1[nolyr];
1338 // apply geo series correction to the radiances leaving the top &
1339 // bottom of the atmosphere
1340  ftmp = unit71[m3];
1341  ftmpa = unit71[m2];
1342  ftmpb = unit71[m1];
1343 // if iglint=1, remove the direct component
1344  if(kzz==0 && iglint==1) {
1345  for (int i=nx-1; i<nmu; i++) {
1346  for (int j=0; j<jpart; j++) {
1347  for (int k=0; k<nstk; k++) {
1348  double abcz=exp(-tautot/abs(cosmu[i]));
1349  ftmp.f[j][i][k]=ftmp.f[j][i][k]-fglint.f[j][i][k]*abcz;
1350  ftmpa.f[j][i][k]=ftmpa.f[j][i][k]-fglint.f[j][i][k]*abcz;
1351  ftmpb.f[j][i][k]=ftmpb.f[j][i][k]-fglint.f[j][i][k]*abcz;
1352  }
1353  }
1354  }
1355  }
1356  //
1357  double ratiog;
1358  for (int i=nx-1; i<nmu; i++) {
1359  int m = nmu-i-1;
1360  for (int j=0; j<jpart; j++) {
1361  for (int k=0; k<nstk; k++) {
1362  if(ftmp.f[j][i][k] <= 1.0e-15) {
1363  fioup.f[j][m][k]=ftmp.f[j][i][k];
1364  } else {
1365  geom(ftmpb.f[j][i][k],ftmpa.f[j][i][k],ftmp.f[j][i][k],
1366  ratiog,fioup.f[j][m][k]);
1367  }
1368  }
1369  }
1370  }
1371  ftmp = unit72[m3];
1372  ftmpa = unit72[m2];
1373  ftmpb = unit72[m1];
1374  for (int i=nx-1; i<nmu; i++) {
1375  int m = nmu-i-1;
1376  for (int j=0; j<jpart; j++) {
1377  for (int k=0; k<nstk; k++) {
1378  if(ftmp.f[j][i][k]<=1.0e-15) {
1379  fioup_btm.f[j][m][k]=ftmp.f[j][i][k];
1380  } else {
1381  geom(ftmpb.f[j][i][k],ftmpa.f[j][i][k],ftmp.f[j][i][k],
1382  ratiog,fioup_btm.f[j][m][k]);
1383  }
1384  }
1385  }
1386  }
1387  for (int i=0; i<nx-1; i++) {
1388  for (int j=0; j<jpart; j++) {
1389  for (int k=0; k<nstk; k++) {
1390  if(ftmp.f[j][i][k]<=1.0e-15) {
1391  fiodn.f[j][i][k]=ftmp.f[j][i][k];
1392  } else {
1393  geom(ftmpb.f[j][i][k],ftmpa.f[j][i][k],ftmp.f[j][i][k],
1394  ratiog,fiodn.f[j][i][k]);
1395  }
1396  }
1397  }
1398  }
1399  if(kzz==0) {
1400  fdirc[ksza-1]=amuo*factr*M_PI;
1401  fdown[ksza-1]=temp1[nolyr]*M_PI;
1402  fup[ksza-1]=temp2[0]*M_PI;
1403  for (int i=0; i<nx-1; i++) {
1404  for (int j=0; j<jpart; j++) {
1405  xzeroz[j][i][ksza-1][0]=fioup.f[j][i][0]+fioup.f[j][i][1];
1406  xzeroz[j][i][ksza-1][1]=fioup.f[j][i][0]-fioup.f[j][i][1];
1407  xzeroz[j][i][ksza-1][2]=fioup.f[j][i][2];
1408  xzeroz[j][i][ksza-1][3]=fioup.f[j][i][3];
1409  xzerod[j][i][ksza-1][0]=fiodn.f[j][i][0]+fiodn.f[j][i][1];
1410  xzerod[j][i][ksza-1][1]=fiodn.f[j][i][0]-fiodn.f[j][i][1];
1411  xzerod[j][i][ksza-1][2]=fiodn.f[j][i][2];
1412  xzerod[j][i][ksza-1][3]=fiodn.f[j][i][3];
1413  }
1414  }
1415  if(iref==1 || iref==2 || iref==3) {
1416  oalb[ksza-1]=calb;
1417  }
1418  }
1419  for (int i=0; i<nx-1; i++) {
1420  for (int j=0; j<jpart; j++) {
1421  xzero_up[j][i][ksza-1]=fioup.f[j][i][0]+fioup.f[j][i][2];
1422  xzero_btm[j][i][ksza-1]=fioup_btm.f[j][i][0]+fioup_btm.f[j][i][2];
1423  }
1424  }
1425  if(kzz==1 && itrans==1) {
1426  for (int i=0; i<nx-1; i++) {
1427  for (int j=0; j<jpart; j++) {
1428  xzero_up[j][i][ksza-1]=fioup.f[j][i][0]+fioup.f[j][i][2];
1429  xzero_btm[j][i][ksza-1]=fioup_btm.f[j][i][0]+fioup_btm.f[j][i][2];
1430  }
1431  }
1432  } else if (kzz==1 && itrans==0) {
1433  double ef=amuo*efactb[nolyr];
1434  double ftot=(gz+ef);
1435  for (int i=0; i<nx-1; i++) {
1436  for (int j=0; j<jpart; j++) {
1437  tdn[j][i][0]=(fiodn.f[j][i][0]+fiodn.f[j][i][1]);
1438  tdn[j][i][1]=(fiodn.f[j][i][0]-fiodn.f[j][i][1]);
1439  tdn[j][i][2]=(fiodn.f[j][i][2]);
1440  tdn[j][i][3]=(fiodn.f[j][i][3]);
1441  tup[j][i][0]=(fioup.f[j][i][0]+fioup.f[j][i][1]);
1442  tup[j][i][1]=(fioup.f[j][i][0]-fioup.f[j][i][1]);
1443  tup[j][i][2]=(fioup.f[j][i][2]);
1444  tup[j][i][3]=(fioup.f[j][i][3]);
1445  }
1446  }
1447  sbarz[ksza-1]=sb;
1448  for (int i=0; i<nx-1; i++) {
1449  for (int j=0; j<jpart; j++) {
1450  for (int s=0; s<nstk; s++) {
1451  tupz[j][i][ksza-1][s]=tup[j][i][s]*ftot;
1452  tdwnz[j][i][ksza-1][s]=tdn[j][i][s]*ftot;
1453  }
1454  }
1455  }
1456  }
1457  if(insz>1) {
1458  double ef=amuo*efactb[nolyr];
1459  double ftot=(gz+ef);
1460  sbarz[ksza-1]=sb;
1461  for (int i=0; i<nx-1; i++) {
1462  for (int j=0; j<jpart; j++) {
1463  for (int s=0; s<nstk; s++) {
1464  tupz[j][i][ksza-1][s]=tup[j][i][s]*ftot;
1465  tdwnz[j][i][ksza-1][s]=tdn[j][i][s]*ftot;
1466  }
1467  }
1468  }
1469  }
1470  return RT_SUCCESS;
1471 }
1472 
1473 /**************************************************************************
1474  * NAME: rsea_new()
1475  *
1476  * DESCRIPTION: Treat the lower boundary of the atmosphere as non-lambertian
1477  * surface (rough ocean surface) and reflect all incident light
1478  * (diffuse and direct light) using the reflection matrix of the surface
1479  *
1480  *************************************************************************/
1482 {
1483  double tempa[nphi][2*nsza][nstk];
1484  double tempc[nphi][2*nsza][nstk];
1485  double tss[nphi][2*nsza][nstk];
1486  for (int i=0; i<nmu; i++) {
1487  for (int j=0; j<jpart; j++) {
1488  for (int k=0; k<nstk; k++) {
1489  tempa[j][i][k]=0.0;
1490  tempc[j][i][k]=0.0;
1491  tss[j][i][k]=0.0;
1492  }
1493  }
1494  }
1495 // total downward flux
1496  double sumdnz;
1497  fluxlvl(fio.f,sumdnz,0);
1498  double pflx0 = (eo[0]+eo[1])*cosmu[kkx];
1499  double pflx = pflx0+sumdnz;
1500 // contribution from the direct beam
1501  for (int it=0; it<(nx-1); it++) {
1502  int itt=nmu-it-1;
1503  for (int ip=0; ip<jpart; ip++) {
1504  for (int is=0; is<nstk; is++) {
1505  for (int k=0; k<nstk; k++) {
1506  int ms=is*4+k;
1507  tempa[ip][itt][is]=tempa[ip][itt][is] +
1508  txx[it][kkx][ip][ms]*eo[k];
1509  }
1510  }
1511  }
1512  }
1513  double flxtempa;
1514  fluxlvl(tempa,flxtempa,1);
1515 // contribution from diffuse beam (integrate over thetaprime & phiprime)
1516  for (int it=0; it<(nx-1); it++) {
1517  int itt=nmu-it-1;
1518  for (int ip=0; ip<jpart; ip++) {
1519  for (int is=0; is<nstk; is++) {
1520  for (int itp=0; itp<(nx-1); itp++) {
1521  double sangi = abs(dcmu[itp])*ddphi;
1522  for (int ipp=0; ipp<nophi; ipp++) {
1523  int jpp=ipp;
1524  int jpx=abs(ipp-ip);
1525  double fiit[nphi][2*nsza][nstk];
1526  if(ipp>jpart-1)jpp=nophi-jpp;
1527  if(jpx>jpart-1)jpx=nophi-jpx;
1528  for (int i=0; i<2; i++) {
1529  fiit[jpp][itp][i]=fio.f[jpp][itp][i];
1530  fiit[jpp][itp][i+2]=fio.f[jpp][itp][i+2];
1531  if(ipp>jpart-1) {
1532  fiit[jpp][itp][i+2]= -fiit[jpp][itp][i+2];
1533  }
1534  }
1535  double prodt3a=0.0;
1536  for (int k=0; k<nstk; k++) {
1537  int m = is*4+k;
1538  prodt3a=prodt3a+txx[it][itp][jpx][m]*fiit[jpp][itp][k];
1539  }
1540  tempc[ip][itt][is]=tempc[ip][itt][is]+prodt3a*sangi;
1541  }
1542  }
1543  }
1544  }
1545  }
1546 // save the glint contribution from the direct beam
1547 // into fglint buffer
1548  for (int i=0; i<nmu; i++) {
1549  for (int j=0; j<jpart; j++) {
1550  for (int k=0; k<nstk; k++) {
1551  fglint.f[j][i][k]=tempa[j][i][k];
1552  }
1553  }
1554  }
1555  double flxtempc;
1556  fluxlvl(tempc,flxtempc,1);
1557  for (int i=nx-1; i<nmu; i++) {
1558  int ii=i-(nx-1);
1559  //double sang = abs(dcmu2[i])*ddphi;
1560  for (int j=0; j<jpart; j++) {
1561  for (int k=0; k<nstk; k++) {
1562  tss[j][i][k]=tempa[j][i][k]+tempc[j][i][k];
1563  tss[j][ii][k]=0.0;
1564  }
1565  }
1566  }
1567 
1568 // compute the upwelling fluxes due to each component
1569  double flxza, flxzc;
1570  fluxlvl(tempa,flxza,1);
1571  fluxlvl(tempc,flxzc,1);
1572  //double albdtot=(flxza+flxzc)/pflx;
1573  albrdr[ksza-1]=flxza/pflx;
1574  albrdf[ksza-1]=flxzc/pflx;
1575 
1576 // correct the upwelling radiance for foam and underwater radiances
1577 // foam correction effective reflectance of the whitecaps (Koepke, 1984)
1578  double ref[39] = {
1579  0.220,0.220,0.220,0.220,0.220,0.220,0.215,0.210,0.200,0.190,
1580  0.175,0.155,0.130,0.080,0.100,0.105,0.100,0.080,0.045,0.055,
1581  0.065,0.060,0.055,0.040,0.000,0.000,0.000,0.000,0.000,0.000,
1582  0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000};
1583  double radxi[nphi][2*nsza];
1584  memset(radxi, 0.0, nphi*2*nsza*sizeof(double));
1585  double wl=wvlth*1.0e4;
1586 // compute whitecaps reflectance 'afoam' for wavelength 'wl'
1587  int iwl=(int)((wl-0.2)/0.1);
1588  double wlp=0.5+(iwl-1)*0.1;
1589  double afoam=ref[iwl+1]+(wl-wlp)/0.1*(ref[iwl]-ref[iwl+1]);
1590  double fracfm, ffoam, xifm;
1591  if(ifoam==1) {
1592  fracfm=2.95e-6*pow(vz,3.52);
1593  ffoam=afoam*fracfm;
1594  xifm=(ffoam*pflx)/M_PI;
1595  } else {
1596  ffoam=0.0;
1597  fracfm=0.0;
1598  xifm=0.0;
1599  }
1600 // underwater contribution compute the upwelling radiance from the
1601 // albedo of water just below the ocean surface
1602  if(iwatr==1) {
1603 // compute the downward diffused flux
1604  double fzz;
1605  fluxlvl(fio.f,fzz,0);
1606  double suma = 0.0;
1607  double sumtt=0.0;
1608  double sumd=0.0;
1609  double sumu=0.0;
1610  for (int i=0; i<(nx-1); i++) {
1611  double psum = 0.0;
1612  for (int k=0; k<2; k++) {
1613  psum=(fio.f[0][i][k]+fio.f[jpart][i][k])+psum;
1614  for (int j=1; j<nophi/2; j++) {
1615  psum=psum+2.*fio.f[j][i][k];
1616  }
1617  }
1618  suma=suma+psum*dcmu2[i]*(1.0-rfair[i])*ddphi;
1619  }
1620  sumtt=(eo[0]+eo[1])*cosmu[kkx]*(1.0-rfair[kkx]);
1621  sumd=suma+sumtt;
1622 // compute the upwelling flux and radiance just below the ocean surface
1623  sumu=alw*sumd;
1624  double radu=sumu/M_PI;
1625  albtdr[ksza-1]=sumtt;
1626  albtdf[ksza-1]=suma;
1627  albtdt[ksza-1]=sumd;
1628  albtrf[ksza-1]=sumu;
1629 // compute the radiance just above the ocean surface
1630  for (int i=0; i<(nx-1); i++) {
1631  int ii=nmu-i-1;
1632  for (int j=0; j<jpart; j++) {
1633  radxi[j][ii]=((1.0-rfwat[i])*radu)/(pow(xrw,2.0)+xiw*2);
1634  radxi[j][i]=0.0;
1635  }
1636  }
1637  }
1638 // compute the flux of the water leaving radiance
1639  double qsumzz=0.0;
1640  for (int i=nx-1; i<nmu; i++) {
1641  double qsumz=0.0;
1642  for (int j=0; j<jpart; j++) {
1643  if(j==0 || j==jpart-1) {
1644  qsumz=qsumz+radxi[j][i];
1645  } else {
1646  qsumz=qsumz+2.0*radxi[j][i];
1647  }
1648  }
1649  qsumzz=qsumzz+qsumz*abs(dcmu2[i])*ddphi;
1650  }
1651  albwl[ksza-1]=qsumzz;
1652  for (int it=nx-1; it<nmu; it++) {
1653  for (int ip=0; ip<jpart; ip++) {
1654  for (int ks=0; ks<nstk; ks++) {
1655  if(ks<=2) {
1656  fio.f[ip][it][ks]=(1.0-fracfm)*tss[ip][it][ks] +
1657  0.5*xifm+0.5*radxi[ip][it];
1658  } else {
1659  fio.f[ip][it][ks]=(1.0-fracfm)*tss[ip][it][ks];
1660  }
1661  }
1662  }
1663  }
1664  //
1665  for (int it=nx-1; it<nmu; it++) {
1666  int itp=nmu-it-1;
1667  for (int ip=0; ip<jpart; ip++) {
1668  raddir[ip][itp][ksza-1]=tempa[ip][it][0]+tempa[ip][it][0];
1669  radocn[ip][itp][ksza-1]=radxi[ip][it];
1670  radsky[ip][itp][ksza-1]=tempc[ip][it][0]+tempc[ip][it][0];
1671  }
1672  }
1673  double sumc;
1674  fluxlvl(fio.f,sumc,1);
1675  //double sumcpi=sumc*M_PI;
1676  calb=sumc/pflx;
1677 
1678  return RT_SUCCESS;
1679 }
1680 
1681 /**************************************************************************
1682  * NAME: fluxlvl()
1683  *
1684  * DESCRIPTION: Compute fluxes
1685  *
1686  *************************************************************************/
1687 int Afrt::fluxlvl(double buft[][2*nsza][nstk], double& sumg, int iflag)
1688 {
1689  int m = 0;
1690  int n = nx-1;
1691  if(iflag==1) {
1692  m=nx-1;
1693  n=nmu;
1694  }
1695  double anophi = (double) nophi;
1696  sumg = 0.0;
1697  for (int i=m; i<n; i++) {
1698  double psumg = 0.0;
1699  for (int k=0; k<2; k++) {
1700  psumg=buft[0][i][k]+buft[jpart-1][i][k]+psumg;
1701  for (int j=1; j<nophi/2; j++) {
1702  psumg=psumg+2.0*buft[j][i][k];
1703  }
1704  }
1705  sumg=sumg+psumg*dcmu2[i]*6.2831854/anophi;
1706  }
1707  sumg=abs(sumg);
1708 
1709  return RT_SUCCESS;
1710 }
1711 
1712 /**************************************************************************
1713  * NAME: geom()
1714  *
1715  * DESCRIPTION: Compute scattering matrices subroutine
1716  *
1717  *************************************************************************/
1718 int Afrt::geom(double a, double b, double c, double& r, double& g)
1719 {
1720  g = c;
1721  r = 0.0;
1722  if (g > 1.0e-15) {
1723  double dif1 = b - a;
1724  double dif2 = c - b;
1725  double dif2p = abs(100.0 * dif2 / c);
1726  if (dif2p >= 1.0e-2) {
1727  r = dif2 / dif1;
1728  g = a + dif1 / (1.0 - r);
1729  }
1730  }
1731  return RT_SUCCESS;
1732 }
1733 
1734 /**************************************************************************
1735  * NAME: xntpln()
1736  *
1737  * DESCRIPTION: Compute scattering matrices subroutine
1738  *
1739  *************************************************************************/
1740 int Afrt::xntpln(double x,double x1,double x2,double y1,double y2,double &y)
1741 {
1742  double slope=(y1-y2)/(x1-x2);
1743  y = y1 + slope*(x-x1);
1744 
1745  return RT_SUCCESS;
1746 }
1747 
1748 /**************************************************************************
1749  * NAME: mdiffn()
1750  *
1751  * DESCRIPTION: Compute scattering matrices subroutine
1752  *
1753  *************************************************************************/
1754 int Afrt::mdiffn(int ib, int ie, int il, double dlyr)
1755 {
1756  double fiit[nphi][2*nsza][nstk];
1757  double fiiz[nphi][nthe][2*nsza][nstk];
1758 
1759  for (int kk=0; kk<nmu; kk++) {
1760  for (int ll=0; ll<jpart; ll++) {
1761  for (int is=0; is<nstk; is++) {
1762  fiit[ll][kk][is]=fiic.f[ll][kk][is];
1763  }
1764  }
1765  for (int ll=jpart; ll<=nophi; ll++) {
1766  fiit[ll][kk][0]=fiic.f[nophi-ll][kk][0];
1767  fiit[ll][kk][1]=fiic.f[nophi-ll][kk][1];
1768  fiit[ll][kk][2]=-fiic.f[nophi-ll][kk][2];
1769  fiit[ll][kk][3]=-fiic.f[nophi-ll][kk][3];
1770  }
1771  }
1772  for (int kk=0; kk<nmu; kk++) {
1773  for (int ip=0; ip<jpart; ip++) {
1774  for (int ll=0; ll<=nophi; ll++) {
1775  int mmp=ll+ip;
1776  if(ll>jpart-1) {
1777  mmp=nophi*(1+mmp/nophi)-mmp;
1778  }
1779  for (int is=0; is<nstk; is++) {
1780  fiiz[ll][ip][kk][is]=fiit[mmp][kk][is];
1781  }
1782  }
1783  }
1784  }
1785  for (int ii=0; ii<nmu; ii++) {
1786  for (int kk=0; kk<nmu; kk++) {
1787  for (int ll=jpart; ll<=nophi; ll++) {
1788  for (int is=0; is<nstk; is++) {
1789  for (int j=0; j<nstk; j++) {
1790  int ij=is*4+j;
1791  if (is<2) {
1792  ppin[kk][ii][ll][ij]=ppin[kk][ii][nophi-ll][ij];
1793  ppin[kk][ii][ll][ij+16]=ppin[kk][ii][nophi-ll][ij+16];
1794  } else {
1795  ppin[kk][ii][ll][ij]=-ppin[kk][ii][nophi-ll][ij];
1796  ppin[kk][ii][ll][ij+16]=-ppin[kk][ii][nophi-ll][ij+16];
1797  }
1798  }
1799  }
1800  }
1801  }
1802  }
1803 
1804  for (int it=ib; it<=ie; it++) {
1805  for (int ip=0; ip<jpart; ip++) {
1806  for (int is=0; is<nstk; is++) {
1807  double sumta=0.0;
1808  for (int kk=0; kk<nmu; kk++) {
1809  double sumtb=0.0;
1810  for (int ll=0; ll<nophi; ll++) {
1811  double prod1=0.0;
1812  for (int j=0; j<nstk; j++) {
1813  int ij=is*4+j;
1814  prod1=prod1+(c[kk]*tmsl*ppin[kk][it][ll][ij]+
1815  trsl*ppin[kk][it][ll][ij+16])*fiiz[ll][ip][kk][j]/dlyr;
1816  }
1817  sumtb=sumtb+prod1;
1818  }
1819  sumta=sumta+sumtb*dcmu[kk];
1820  }
1821  ftmp.f[ip][it][is]=sumta*ddphi;
1822  }
1823  }
1824  }
1825  return RT_SUCCESS;
1826 }
fdat ftmp
Definition: afrt.h:100
double_4darray dtrr
Definition: AfrtProcess.h:248
double rmu[2 *nthe]
Definition: afrt.h:116
int hump(double cnst, double t[][ntf], double tp[][nlyr], int nm, double lp, double rmu[], double thd[], int ixy)
Definition: afrt.cpp:446
double xzeroz[nphi][nthe][nsza][nstk]
Definition: afrt.h:161
double nx
Definition: afrt.h:177
int r
Definition: decode_rs.h:73
int_3darray nolyr
Definition: AfrtProcess.h:239
int iglint
Definition: afrt.h:201
data_t t[NROOTS+1]
Definition: decode_rs.h:77
double pfs[2 *nsza][2 *nphi][32]
Definition: afrt.h:135
int mdiffn(int ib, int ie, int il, double dlyr)
Definition: afrt.cpp:1754
double fluxu[nlyr][20]
Definition: afrt.h:159
double_6darray txx
Definition: AfrtProcess.h:168
virtual int initialize()
Definition: afrt.cpp:41
fdat fnull
Definition: afrt.h:96
int j
Definition: decode_rs.h:73
double dtaa[nlyr]
Definition: afrt.h:169
int16 iflag[18338]
double oalb[nsza]
Definition: afrt.h:142
int status
Definition: l1_czcs_hdf.c:32
double_4darray dtot
Definition: AfrtProcess.h:251
double dphi
Definition: afrt.h:178
fdat fio
Definition: afrt.h:97
fdat fioup_btm
Definition: afrt.h:106
double radsky[nphi][nthe][nsza]
Definition: afrt.h:156
double ei[nstk]
Definition: afrt.h:111
double xi
Definition: AfrtProcess.h:152
double dtrr[nlyr]
Definition: afrt.h:168
double t[nstk][ntf]
Definition: afrt.h:133
fdat fiodn
Definition: afrt.h:107
double emdtm[2 *nsza][nlyr]
Definition: afrt.h:131
double albrdf[nsza]
Definition: afrt.h:150
int geom(double a, double b, double c, double &r, double &g)
Definition: afrt.cpp:1718
Afrt()
Definition: afrt.cpp:19
double albtdr[nsza]
Definition: afrt.h:144
std::vector< fdat > unit65
Definition: afrt.h:89
int single_down()
Definition: afrt.cpp:790
double xrw
Definition: afrt.h:184
int matrx(int ii, int kk)
Definition: afrt.cpp:622
double copcs
Definition: afrt.h:194
real, dimension(260) sb
double pp[nstk][nlyr]
Definition: afrt.h:114
double_8darray xzeroz
Definition: AfrtProcess.h:421
int ifoam
Definition: AfrtProcess.h:319
int inx
Definition: AfrtProcess.h:303
std::vector< fdat > unit53
Definition: afrt.h:85
double sinmu[2 *nthe]
Definition: afrt.h:121
double v
Definition: AfrtProcess.h:153
double conr
Definition: afrt.h:183
int nolyr
Definition: afrt.h:206
double_5darray tmb
Definition: AfrtProcess.h:402
int itrans
Definition: AfrtProcess.h:289
double cfisq
Definition: afrt.h:193
double tdwnz[nphi][nthe][nsza][nstk]
Definition: afrt.h:166
int kkx
Definition: afrt.h:213
float h[MODELMAX]
Definition: atrem_corl1.h:131
double_3darray wvlth
Definition: AfrtProcess.h:268
double copsq
Definition: afrt.h:192
int isd1
Definition: AfrtProcess.h:293
double albtrf[nsza]
Definition: afrt.h:146
fdat fglint
Definition: afrt.h:108
double taupl[nlyr]
Definition: afrt.h:127
double cnst
Definition: afrt.h:182
double_4darray t
Definition: AfrtProcess.h:129
double geoiup[nphi][nsza][20]
Definition: afrt.h:157
int getrad()
Definition: afrt.cpp:990
int ithe02
Definition: AfrtProcess.h:302
int ithe01
Definition: AfrtProcess.h:301
this program makes no use of any feature of the SDP Toolkit that could generate such a then geolocation is calculated at that and then aggregated up to Resolved feature request Bug by adding three new int8 SDSs for each high resolution offsets between the high resolution geolocation and a bi linear interpolation extrapolation of the positions This can be used to reconstruct the high resolution geolocation Resolved Bug by delaying cumulation of gflags until after validation of derived products Resolved Bug by setting Latitude and Longitude to the correct fill resolving to support Near Real Time because they may be unnecessary if use of entrained ephemeris and attitude data is turned resolving bug report Corrected to filter out Aqua attitude records with missing status helping resolve bug MOD_PR03 will still correctly write scan and pixel data that does not depend upon the start thereby resolving MODur00108 Changed header guard macro names to avoid reserved name resolving MODur00104 Maneuver list file for Terra satellite was updated to include data from Jecue DuChateu Maneuver list files for both Terra and Aqua were updated to include two maneuvers from recent IOT weekly reports The limits for Z component of angular momentum was and to set the fourth GEO scan quality flag for a scan depending upon whether or not it occurred during one of them Added _FillValue attributes to many and changed the fill value for the sector start times from resolving MODur00072 Writes boundingcoordinate metadata to L1A archived metadata For PERCENT *ECS change to treat rather resolving GSFcd01518 Added a LogReport Changed to create the Average Temperatures vdata even if the number of scans is
Definition: HISTORY.txt:301
int inpass1
Definition: AfrtProcess.h:312
int jpass
Definition: afrt.h:210
float tp[MODELMAX]
Definition: atrem_corl1.h:173
double sinth[2 *nphi]
Definition: afrt.h:126
double raddir[nphi][nthe][nsza]
Definition: afrt.h:154
int32_t im
Definition: atrem_corl1.h:161
int jpart
Definition: afrt.h:209
double qsqt
Definition: afrt.h:179
double totl[nlyr]
Definition: afrt.h:128
int kdx
Definition: afrt.h:214
int ksza
Definition: afrt.h:212
std::vector< fdat > unit64
Definition: afrt.h:88
double xr
Definition: AfrtProcess.h:151
double phi[2 *nphi]
Definition: afrt.h:124
double the0in[nsza]
Definition: AfrtProcess.h:326
double_5darray tma
Definition: AfrtProcess.h:401
int inpass2
Definition: AfrtProcess.h:313
double_5darray tmrr
Definition: AfrtProcess.h:414
double_3darray thd
Definition: AfrtProcess.h:128
double the[2 *nsza]
Definition: afrt.h:122
int kzz
Definition: afrt.h:211
fdat fiic
Definition: afrt.h:99
double txx[nsza][nthe][nphi][16]
Definition: afrt.h:153
double_5darray tmg
Definition: AfrtProcess.h:407
std::vector< fdat > unit55
Definition: afrt.h:87
double amups
Definition: afrt.h:190
int iglint
Definition: AfrtProcess.h:317
int geocor()
Definition: afrt.cpp:1316
fdat ftmpa
Definition: afrt.h:101
double dtot[nlyr]
Definition: afrt.h:170
int itrans
Definition: afrt.h:202
double amuo
Definition: afrt.h:176
virtual ~Afrt()
Definition: afrt.cpp:30
double geoidn[nphi][nsza][20]
Definition: afrt.h:158
double_5darray tmq
Definition: AfrtProcess.h:410
int ifc
Definition: afrt.h:199
int rsea_new()
Definition: afrt.cpp:1481
double alw
Definition: afrt.h:187
double_3darray tautot
Definition: AfrtProcess.h:257
double wvlth
Definition: afrt.h:180
fdat ftmpb
Definition: afrt.h:102
double albtdt[nsza]
Definition: afrt.h:147
double amusq
Definition: afrt.h:188
double copsi
Definition: afrt.h:191
double_5darray tmh
Definition: AfrtProcess.h:408
double albwl[nsza]
Definition: afrt.h:148
float32 slope[]
Definition: l2lists.h:30
int ilm1
Definition: AfrtProcess.h:291
#define D2R
Definition: proj_define.h:91
int ifoam
Definition: afrt.h:204
const int RT_SUCCESS
Definition: AfrtConstants.h:34
int fluxlvl(double buft[][2 *nsza][nstk], double &sumg, int iflag)
Definition: afrt.cpp:1687
double fluxd[nlyr][20]
Definition: afrt.h:160
int ipol
Definition: AfrtProcess.h:311
double amumu
Definition: afrt.h:189
double_5darray tmss
Definition: AfrtProcess.h:415
double_4darray dtmm
Definition: AfrtProcess.h:249
#define M_PI
Definition: pml_iop.h:15
float dp[MODELMAX]
int nmu
Definition: afrt.h:207
int mats(int ii, int kk, int l)
Definition: afrt.cpp:695
double xzerod[nphi][nthe][nsza][nstk]
Definition: afrt.h:162
double factr
Definition: afrt.h:174
double_5darray tmc
Definition: AfrtProcess.h:403
integer, parameter double
std::vector< fdat > unit71
Definition: afrt.h:90
double_5darray tmfu
Definition: AfrtProcess.h:405
int anglw()
Definition: afrt.cpp:558
int frs(double xx, double xr, double xi, double &rfsea)
Definition: afrt.cpp:584
double dlyr
Definition: afrt.h:173
double vz
Definition: afrt.h:186
double xiw
Definition: afrt.h:185
double rfwat[2 *nsza]
Definition: afrt.h:152
double_5darray tmfd
Definition: AfrtProcess.h:404
double sbarz[nsza]
Definition: afrt.h:143
std::vector< fdat > * irad
Definition: afrt.h:93
std::vector< fdat > unit54
Definition: afrt.h:86
double dcmu2[2 *nthe]
Definition: afrt.h:119
double_5darray tmqq
Definition: AfrtProcess.h:413
double_3darray rho
Definition: AfrtProcess.h:270
double_8darray xzerod
Definition: AfrtProcess.h:422
double tmsl
Definition: afrt.h:171
double_5darray tmp
Definition: AfrtProcess.h:409
double c[2 *nsza]
Definition: afrt.h:123
data_t b[NROOTS+1]
Definition: decode_rs.h:77
int ipol
Definition: afrt.h:205
double cosmu[2 *nthe]
Definition: afrt.h:120
double_2darray qext
Definition: AfrtProcess.h:119
double_5darray tms
Definition: AfrtProcess.h:406
double tupz[nphi][nthe][nsza][nstk]
Definition: afrt.h:165
int insz
Definition: afrt.h:215
double fdown[nsza]
Definition: afrt.h:139
std::vector< fdat > unit72
Definition: afrt.h:91
int iref
Definition: AfrtProcess.h:288
fdat fioup
Definition: afrt.h:105
double dcmu[2 *nthe]
Definition: afrt.h:118
double tautot
Definition: afrt.h:197
double albtdf[nsza]
Definition: afrt.h:145
double rfair[2 *nsza]
Definition: afrt.h:151
int rt2(int ilm, int isd, int itau, int iwnd, rt2_in *rt2in, rt2_out *rt2out, rt1_in *rt1in, rt1_out *rt1out, ocn_in *ocnin, ocn_out *ocnout, phs_in *phsin, phs_out *phsout)
Definition: afrt.cpp:79
double calb
Definition: afrt.h:175
double dphi
Definition: AfrtProcess.h:323
int iwatr
Definition: afrt.h:203
double albwat[nwnd]
Definition: AfrtProcess.h:328
double ee[nstk]
Definition: afrt.h:110
double f[nphi][2 *nsza][nstk]
Definition: afrt.h:83
double qq[nstk][nlyr]
Definition: afrt.h:115
double ddphi
Definition: afrt.h:181
int depol(int ii, int kk, int l)
Definition: afrt.cpp:746
int_3darray ifc
Definition: AfrtProcess.h:240
double_5darray tmpp
Definition: AfrtProcess.h:412
double_4darray dtaa
Definition: AfrtProcess.h:250
double efact[nlyr]
Definition: afrt.h:129
data_t s[NROOTS]
Definition: decode_rs.h:75
int single_up()
Definition: afrt.cpp:911
int iwatr
Definition: AfrtProcess.h:320
double dtmm[nlyr]
Definition: afrt.h:167
double cmu[2 *nthe]
Definition: afrt.h:117
double p[2 *nphi][32]
Definition: afrt.h:113
double ppin[2 *nsza][2 *nsza][2 *nphi][32]
Definition: afrt.h:136
double fup[nsza]
Definition: afrt.h:140
fdat snglb
Definition: afrt.h:104
std::vector< fdat > * iwrt
Definition: afrt.h:94
int ocn()
Definition: afrt.cpp:53
int multp1d()
Definition: afrt.cpp:1054
no change in intended resolving MODur00064 Corrected handling of bad ephemeris attitude resolving resolving GSFcd00179 Corrected handling of fill values for[Sensor|Solar][Zenith|Azimuth] resolving MODxl01751 Changed to validate LUT version against a value retrieved from the resolving MODxl02056 Changed to calculate Solar Diffuser angles without adjustment for estimated post launch changes in the MODIS orientation relative to incidentally resolving defects MODxl01766 Also resolves MODxl01947 Changed to ignore fill values in SCI_ABNORM and SCI_STATE rather than treating them as resolving MODxl01780 Changed to use spacecraft ancillary data to recognise when the mirror encoder data is being set by side A or side B and to change calculations accordingly This removes the need for seperate LUTs for Side A and Side B data it makes the new LUTs incompatible with older versions of the and vice versa Also resolves MODxl01685 A more robust GRing algorithm is being which will create a non default GRing anytime there s even a single geolocated pixel in a granule Removed obsolete messages from seed as required for compatibility with version of the SDP toolkit Corrected test output file names to end in per delivery and then split off a new MYD_PR03 pcf file for Aqua Added AssociatedPlatformInstrumentSensor to the inventory metadata in MOD01 mcf and MOD03 mcf Created new versions named MYD01 mcf and MYD03 where AssociatedPlatformShortName is rather than Terra The program itself has been changed to read the Satellite Instrument validate it against the input L1A and LUT and to use it determine the correct files to retrieve the ephemeris and attitude data from Changed to produce a LocalGranuleID starting with MYD03 if run on Aqua data Added the Scan Type file attribute to the Geolocation copied from the L1A and attitude_angels to radians rather than degrees The accumulation of Cumulated gflags was moved from GEO_validate_earth_location c to GEO_locate_one_scan c
Definition: HISTORY.txt:464
double costh[2 *nphi]
Definition: afrt.h:125
int nophi
Definition: afrt.h:208
double qsp[nsza]
Definition: afrt.h:138
int multp2d()
Definition: afrt.cpp:1200
Definition: RsViirs.h:71
double xzero_btm[nphi][nthe][nsza]
Definition: afrt.h:164
double sfisq
Definition: afrt.h:195
int xntpln(double x, double x1, double x2, double y1, double y2, double &y)
Definition: afrt.cpp:1740
fdat sngla
Definition: afrt.h:103
int iref
Definition: afrt.h:200
fdat fiib
Definition: afrt.h:98
double eo[nstk]
Definition: afrt.h:112
#define abs(a)
Definition: misc.h:90
double radocn[nphi][nthe][nsza]
Definition: afrt.h:155
int i
Definition: decode_rs.h:71
double rho
Definition: afrt.h:196
PGE01 indicating that PGE02 PGE01 V6 for and PGE01 V2 for MOD03 were used to produce the granule By convention adopted in all MODIS Terra PGE02 code versions are The fourth digit of the PGE02 version denotes the LUT version used to produce the granule The source of the metadata environment variable ProcessingCenter was changed from a QA LUT value to the Process Configuration A sign used in error in the second order term was changed to a
Definition: HISTORY.txt:424
double thd[ntf]
Definition: afrt.h:134
double trsl
Definition: afrt.h:172
double fdirc[nsza]
Definition: afrt.h:141
double albrdr[nsza]
Definition: afrt.h:149
double xzero_up[nphi][nthe][nsza]
Definition: afrt.h:163
int k
Definition: decode_rs.h:73
int msza[nsza]
Definition: afrt.h:198
double rx[nthe]
Definition: AfrtProcess.h:325
double_2darray qscat
Definition: AfrtProcess.h:118
double emtm[2 *nsza][nlyr]
Definition: afrt.h:132
l2prod max
int rt1()
Definition: afrt.cpp:66
double efactb[nlyr]
Definition: afrt.h:130