OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
headr.f
Go to the documentation of this file.
1  subroutine headr(iprn)
2 c
3 c output the header record
4 c**********************************************************************
5 c
6  include 'afrt_rt2.cmn'
7 c
8 c***********************************************************************
9 c
10  character*28 sd1(5)
11  character*10 sd2(5)
12  character*3 tranc
13 c
14  sd1(1)='junge'
15  sd1(2)='deirmendjian modified gamma'
16  sd1(3)='log-normal (uni-modal)'
17  sd1(4)='log-normal (bi-modal)'
18  sd1(5)='log-normal (tri-modal)'
19 c
20  sd2(1)='(haze l)'
21  sd2(2)='(haze m)'
22  sd2(3)='(haze h)'
23  sd2(4)='(cloud c1)'
24  sd2(5)='(unknown)'
25 c
26  kfc=bfr1(47)+0.01
27  kpsudo=bfr1(34)+0.01
28  kref=bfr1(45)+0.01
29  kfoam=bfr1(41)+0.01
30  kwatr=bfr1(42)+0.01
31  chlo=bfr1(43)
32  wwrr=bfr1(44)
33  foamf=bfr1(75)
34 c
35  if(kfoam.eq.0)foamf=0.0
36  if(kwatr.eq.0)wwrr=0.0
37  if(kwatr.eq.0)chlo=0.0
38 c
39  if(iprn.eq.4)write(iprn,100)
40  if(iprn.eq.3)write(iprn,101)
41  if(iprn.eq.2)write(iprn,104)
42  if(iprn.eq.14)write(iprn,102)
43  if(iprn.eq.13)write(iprn,103)
44 c
45  write(iprn,105)bfr1(5)
46  if(kfc.eq.1)then
47  write(iprn,110)
48  kfunc=bfr1(48)+0.01
49  nfunc=bfr1(49)+0.01
50  if(kfunc.eq.2)then
51  write(iprn,111)sd1(kfunc),sd2(nfunc)
52  else
53  write(iprn,112)sd1(kfunc)
54  endif
55  goto(10,20,30,40,50),kfunc
56 10 continue
57  write(iprn,115)bfr1(6),bfr1(7)
58  write(iprn,200)bfr1(51),bfr1(52)
59  write(iprn,205)bfr1(53),bfr1(12)
60  write(iprn,120)bfr1(10),bfr1(11)
61  write(iprn,130)bfr1(13),bfr1(12)
62  goto 60
63 20 continue
64  write(iprn,115)bfr1(6),bfr1(7)
65  write(iprn,210)bfr1(54),bfr1(55)
66  write(iprn,215)bfr1(56),bfr1(57)
67  write(iprn,120)bfr1(10),bfr1(11)
68  write(iprn,130)bfr1(13),bfr1(12)
69  goto 60
70 30 continue
71  write(iprn,115)bfr1(6),bfr1(7)
72  write(iprn,125)bfr1(8),bfr1(9)
73  write(iprn,120)bfr1(10),bfr1(11)
74  write(iprn,130)bfr1(13),bfr1(12)
75  goto 60
76 40 continue
77  write(iprn,217)bfr1(6),bfr1(7)
78  write(iprn,220)bfr1(63),bfr1(64)
79  write(iprn,222)bfr1(8),bfr1(9)
80  write(iprn,225)bfr1(59),bfr1(60)
81  write(iprn,230)bfr1(58),bfr1(61)
82  write(iprn,235)bfr1(12),bfr1(62)
83  write(iprn,237)bfr1(10),bfr1(11)
84  write(iprn,238)bfr1(65),bfr1(66)
85  write(iprn,260)bfr1(13)
86  goto 60
87 50 continue
88  write(iprn,115)bfr1(6),bfr1(7)
89  write(iprn,220)bfr1(63),bfr1(64)
90  write(iprn,221)bfr1(71),bfr1(72)
91  write(iprn,125)bfr1(8),bfr1(9)
92  write(iprn,225)bfr1(59),bfr1(60)
93  write(iprn,245)bfr1(67),bfr1(68)
94  write(iprn,230)bfr1(58),bfr1(61)
95  write(iprn,250)bfr1(69),bfr1(12)
96  write(iprn,253)bfr1(62),bfr1(70)
97  write(iprn,237)bfr1(10),bfr1(11)
98  write(iprn,238)bfr1(65),bfr1(66)
99  write(iprn,239)bfr1(73),bfr1(74)
100  write(iprn,260)bfr1(13)
101 60 continue
102  write(iprn,135)bfr1(14),bfr1(15)
103  write(iprn,140)bfr1(16),bfr1(17)
104  write(iprn,145)bfr1(18),bfr1(19)
105  write(iprn,146)bfr1(31),bfr1(32)
106  write(iprn,150)bfr1(20),bfr1(21)
107  endif
108 c
109  if(kref.eq.2)then
110  write(iprn,155)
111  write(iprn,160)bfr1(23),bfr1(24),bfr1(22),wwrr
112  write(iprn,163)foamf,chlo
113  endif
114  write(iprn,165)
115  write(iprn,170)bfr1(25),bfr1(26)
116  write(iprn,175)bfr1(27),bfr1(28)
117  write(iprn,180)bfr1(29),bfr1(30)
118  if(icrft.eq.1)then
119  write(iprn,182)bfr1(100+nx-1+jpart+1),bfr1(100+nx-1+jpart+2)
120  endif
121  if(kpsudo.eq.1)then
122  write(iprn,186)
123  else
124  write(iprn,185)
125  endif
126 c
127  if(kref.eq.0)then
128  write(iprn,255)
129  endif
130  if(kref.eq.2)then
131  write(iprn,256)
132  endif
133  tranc=' no'
134  if(itrans.eq.1)tranc='yes'
135  write(iprn,257)bfr1(46),tranc
136  return
137 c
138 c.....format statements................................................
139 c
140 100 format(t18,'upwelling radiance at the top of the atmosphere')
141 101 format(t18,'downwelling radiance at the bottom of the',
142  1 ' atmosphere')
143 102 format(t18,'upwelling radiance at the aircraft altidue')
144 103 format(t18,'downwelling radiance at the aircraft altidue')
145 104 format(t18,'upwelling radiance just above the flat ocean surface')
146 105 format(t1,'wavelength',t32,f6.4,' um')
147 110 format(t1,'aerosols')
148 111 format(t8,'particle size dist.',t40,a,1x,a)
149 112 format(t8,'particle size dist.',t40,a)
150 115 format(t8,'n1 (refr. index real)',t32,f6.4,
151  1 t40,'n2 (refr. index imag.)',t66,1pe10.4)
152 120 format(t8,'rmin (um)',t32,f6.4,t40,'rmax (um)',t67,f9.4)
153 125 format(t8,'rg (um)',t32,f6.4,t40,'sigma',t70,f6.4)
154 130 format(t8,'r(eff)',t29,f9.4,t40,'delta x',t70,f6.4)
155 135 format(t8,'r1 (first moment)',t26,1pe12.4,
156  1 t40,'r2 (second moment)',t64,1pe12.4)
157 140 format(t8,'r3 (third moment)',t26,1pe12.4,
158  1 t40,'r4 (fourth moment)',t64,1pe12.4)
159 145 format(t8,'single scat. albedo',t32,f6.4,
160  1 t40,'asym. fac. (g)',t70,f6.4)
161 146 format(t8,'ccn',t29,f9.4,t40,'back scat. ratio',t67,f9.4)
162 150 format(t8,'scat. coeff',t26,1pe12.4,
163  1 t40,'ext. coeff.',t64,1pe12.4)
164 155 format(t1,'ocean')
165 160 format(t8,'n1 (refr. index real)',t32,f6.4,
166  1 t40,'n2 (refr. index imag.)',t66,1pe10.4/
167  2 t8,'wind speed (m/sec)',t32,0pf6.2,
168  3 t40,'albedo(water_leaving rad)',t65,1pe11.4)
169 163 format(t8,'foam (fraction)',t32,f6.4,
170  1 t40,'chlorophyl conc.(mg/m3)',t65,1pe11.4)
171 165 format(t1,'atmosphere')
172 170 format(t8,'tau(rayleigh)',t29,f9.4,
173  1 t40,'tau(aerosol)',t67,f9.4)
174 175 format(t8,'tau(ozone)',t29,f9.4,
175  1 t40,'tau(h2o)',t67,f9.4)
176 180 format(t8,'tau(total)',t29,f9.4,
177  1 t40,'mol. depol. fac',t70,f6.4)
178 182 format(t8,'tau(total_aircraft)',t29,f9.4,
179  1 t40,'aircraft_alt(km)',t70,f5.2)
180 185 format(t1,'model (atmosphere)',t32,'plane parallel')
181 186 format(t1,'model (atmosphere)',t32,'pseudo spherical')
182 200 format(t8,'rc',t29,f9.4,t40,'c',t64,1pe12.4)
183 205 format(t8,'nu',t29,f9.4,t40,'delx',t67,f9.4)
184 210 format(t8,'alfa',t29,f9.4,t40,'gamma',t67,f9.4)
185 215 format(t8,'a',t29,f9.4,t40,'b',t67,f9.4)
186 217 format(t8,'n1 (real mode 1)',t32,f6.4,
187  1 t40,'n2 (imag. mode 1)',t66,1pe10.4)
188 220 format(t8,'n1 (real mode 2)',t32,f6.4,
189  1 t40,'n2 (imag. mode 2)',t66,1pe10.4)
190 221 format(t8,'n1 (real mode 3)',t32,f6.4,
191  1 t40,'n2 (imag. mode 3)',t66,1pe10.4)
192 222 format(t8,'rg1(um)',t32,f6.4,t40,'sigma1',t70,f6.4)
193 225 format(t8,'rg2(um)',t32,f6.4,t40,'sigma2',t70,f6.4)
194 230 format(t8,'xnum1',t26,1pe12.4,t40,'xnum2',t64,1pe12.4)
195 235 format(t8,'delx1',t29,f9.4,t40,'delx2',t67,f9.4)
196 237 format(t8,'rmin1(um)',t32,f6.4,t40,'rmax1(um)',t67,f9.4)
197 238 format(t8,'rmin2(um)',t32,f6.4,t40,'rmax2(um)',t67,f9.4)
198 239 format(t8,'rmin3(um)',t32,f6.4,t40,'rmax3(um)',t67,f9.4)
199 245 format(t8,'rg3(um)',t32,f6.4,t40,'sigma3',t70,f6.4)
200 250 format(t8,'xnum3',t26,1pe12.4,t40,'delx1',t67,f9.4)
201 253 format(t8,'delx2',t29,f9.4,t40,'delx3',t67,f9.4)
202 255 format(t1,'model (lower surface)',t32,'lambertian (ground)')
203 256 format(t1,'model (lower surface)',t32,'non lambertian',
204  1 ' (rough ocean)')
205 257 format(t1,'surface pressure (atm.)',t32,f5.3,t40,'diffuse trans',
206  1 t73,a)
207 260 format(t8,'r(eff)',t29,f9.4)
208 c
209  end
210 c**********************************************************************
subroutine headr(iprn)
Definition: headr.f:2