OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
outdty.f
Go to the documentation of this file.
1  subroutine outdty
2 
3 c***********************************************************************
4 c subroutine outdt creates output datasets for upwelling and
5 c downwelling diffused radiation leaving the top and bottom of
6 c the atmosphere
7 c***********************************************************************
8 c.....include the common blocks
9  implicit real*8 (a-h,o-z)
10  include 'common_all.cmn'
11  real*8 tma(25),tmb(25),tmc(25),tmfd(25),tmfu(25),tms(25)
12  real*8 tmg(25),tmh(25),tmp(25),tmq(25),tmpp(25),tmqq(25)
13  real*8 tmrr(25),tmss(25)
14 c***********************************************************************
15 c
16  lsza=bfr1(35)+0.001
17  do i=1,lsza,1
18  m=msza(i)
19  tma(i)=the0in(m)
20  tmb(i)=fdirc(m)
21  tmc(i)=sbarz(m)
22  tmfd(i)=fdown(m)
23  tmfu(i)=fup(m)
24  tms(i)=oalb(m)
25  tmg(i)=albtdr(m)*pi
26  tmh(i)=albtdf(m)*pi
27  tmp(i)=albtrf(m)*pi
28  tmq(i)=albwl(m)*pi
29  tmpp(i)=tmq(i)/(tmb(i)+tmfd(i))
30  tmqq(i)=tms(i)-tmpp(i)
31  tmrr(i)=albrdr(m)
32  tmss(i)=albrdf(m)
33  enddo
34 c
35  iprn=4
36  call headr(iprn)
37 c
38  write(iprn,6659)
39  do 5567 i=1,lsza
40  it=msza(i)
41  write(iprn,6660)tma(i),pi
42  write(iprn,6661)tmb(i),tmfd(i)
43  if(iref.eq.1 .or. iref.eq.2)then
44  write(iprn,6662)tmfu(i),tms(i)
45  write(iprn,7663)tmg(i),tmh(i)
46  write(iprn,7664)tmp(i),tmq(i)
47  write(iprn,7665)tmpp(i),tmqq(i)
48  write(iprn,7666)tmrr(i),tmss(i)
49  endif
50  if(iref.eq.3)write(iprn,6665)tmfu(i),tms(i)
51  write(iprn,6668)
52  write(iprn,6664)(the(ir),ir=1,nangl)
53  do is=1,jpart
54  write(iprn,6667)jphi(is),(xzeroz(it,ir,is)*pi,ir=1,nangl)
55  enddo
56 5567 continue
57 c
58  iprn=3
59  call headr(iprn)
60 c
61  write(iprn,6659)
62  do 5568 i=1,lsza
63  it=msza(i)
64  write(iprn,6660)tma(i),pi
65  write(iprn,6661)tmb(i),tmfd(i)
66  if(iref.eq.1 .or. iref.eq.2)then
67  write(iprn,6662)tmfu(i),tms(i)
68  write(iprn,7663)tmg(i),tmh(i)
69  write(iprn,7664)tmp(i),tmq(i)
70  write(iprn,7665)tmpp(i),tmqq(i)
71  write(iprn,7666)tmrr(i),tmss(i)
72  endif
73  if(iref.eq.3)write(iprn,6665)tmfu(i),tms(i)
74  write(iprn,6668)
75  write(iprn,6664)(the(ir),ir=1,nangl)
76  do is=1,jpart
77  write(iprn,6667)jphi(is),(xzerod(it,ir,is)*pi,ir=1,nangl)
78  enddo
79 5568 continue
80 c*****format statements*************************************************
81 c
82 6659 format(t1,'fluxes')
83 6660 format(t8,'sza',t32,f6.1,t40,'f0_top',t64,1pe12.4)
84 6661 format(t8,'fdir_btm',t26,1pe12.4,t40,'fdif_btm',t64,1pe12.4)
85 6662 format(t8,'fdif_up',t26,1pe12.4,t40,'hem. ref(ocean)',t64,1pe12.4)
86 6664 format('phi theta',7(2x,f5.1,3x)/3(9x,7(2x,f5.1,3x)/))
87 6665 format(t8,'fdif_up',t26,1pe12.4,t40,'hem. ref(surf)',t64,1pe12.4)
88 6667 format(i3,6x,1p7e10.3/3(9x,1p7e10.3/))
89 6668 format(t1,'radiances (f0=pi)')
90 6672 format(t8,'fdif_up',t26,1pe12.4,t40,'sbar',t64,1pe12.4)
91 7663 format(t8,'ftw_dir(ocn)',t26,1pe12.4,
92  1 t40,'ftw_difdn(ocn)',t64,1pe12.4)
93 7664 format(t8,'ftw_difup(blow_ocn)',t27,1pe11.4,
94  1 t40,'ftw_difup(above_ocn)',t64,1pe12.4)
95 7665 format(t8,'hem_ref(ocn_trans)',t26,1pe12.4,
96  1 t40,'hem_ref(ocn_refl)',t64,1pe12.4)
97 7666 format(t8,'hem_ref(ocn_dirrfl)',t27,1pe11.4,
98  1 t40,'hem_ref(ocn_difrfl)',t64,1pe12.4)
99 c***********************************************************************
100  return
101  end
102 c************************************************************************
#define real
Definition: DbAlgOcean.cpp:26
subroutine outdty(oxzeroz, oxzerod)
Definition: outdty.f:2
#define pi
Definition: vincenty.c:23
subroutine headr(iprn)
Definition: headr.f:2