/[MITgcm]/MITgcm_contrib/darwin2/pkg/darwin/wavebands_init_fixed.F
ViewVC logotype

Contents of /MITgcm_contrib/darwin2/pkg/darwin/wavebands_init_fixed.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.5 - (show annotations) (download)
Tue Apr 16 20:21:57 2013 UTC (12 years, 3 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt64k_20130723, ctrb_darwin2_ckpt64h_20130528, ctrb_darwin2_ckpt64m_20130820, ctrb_darwin2_ckpt64n_20130826, ctrb_darwin2_ckpt64o_20131024, ctrb_darwin2_ckpt64i_20130622, ctrb_darwin2_ckpt64g_20130503, ctrb_darwin2_ckpt64l_20130806, ctrb_darwin2_ckpt64j_20130704, ctrb_darwin2_ckpt64p_20131118, ctrb_darwin2_ckpt64q_20131118, ctrb_darwin2_ckpt64p_20131024
Changes since 1.4: +20 -7 lines
make reference waveband for aCDOM a runtime parameter

1 C $Header: /u/gcmpack/MITgcm_contrib/darwin2/pkg/darwin/wavebands_init_fixed.F,v 1.4 2013/04/16 20:21:21 jahn Exp $
2 C $Name: $
3
4 c ANNA wavebands_init_fixed.F reads-in and assigns input paramters for WAVEBANDS.
5
6 #include "DARWIN_OPTIONS.h"
7
8 CBOP
9 C !ROUTINE: WAVEBANDS_INIT_FIXED
10 C !INTERFACE:
11 subroutine wavebands_init_fixed(myThid)
12
13 C !DESCRIPTION: \bv
14 C *==========================================================*
15 C | SUBROUTINE WAVEBANDS_INIT_FIXED
16 C | o reads-in and assigns input paramters for WAVEBANDS.
17 C *==========================================================*
18 C \ev
19
20 C !USES:
21 implicit none
22 C == Global variables ===
23 #include "SIZE.h"
24 #include "EEPARAMS.h"
25 #include "PARAMS.h"
26 #include "DARWIN_SIZE.h"
27 #include "SPECTRAL_SIZE.h"
28 #include "SPECTRAL.h"
29 #include "WAVEBANDS_PARAMS.h"
30 #include "DARWIN_IO.h"
31
32 C !INPUT/OUTPUT PARAMETERS:
33 C == Routine arguments ==
34 C myThid :: my Thread Id number
35 integer myThid
36 CEOP
37
38 #ifdef WAVEBANDS
39
40 C !LOCAL VARIABLES:
41 C == Local variables ==
42 c local variables
43 CHARACTER*(MAX_LEN_MBUF) msgBuf
44 character*80 title
45 integer iUnit
46 integer swlambda,splambda,ssflambda
47 _RL sap,sap_ps,sbp,sbbp
48 _RL saw,sbw
49 _RL ssf
50 c _RL planck, c, hc, oavo, hcoavo, rlamm
51 #ifdef DAR_CALC_ACDOM
52 _RL rlam
53 #else
54 _RL sacdom
55 #endif
56 c local indeces
57 integer nabp,i,ilam
58
59 C fill in missing waveband information:
60 C "representative values" darwin_waves need not be centered within
61 C waveband boundaries darwin_wavebands, so both may be given
62 C if representative values are not given, compute from waveband
63 C boundaries
64 do i = 1,tlam
65 if (darwin_waves(i) .gt. 0) then
66 pwaves(i) = darwin_waves(i)
67 elseif (darwin_wavebands(i).ge.0 .and.
68 & darwin_wavebands(i+1).ge.0 ) then
69 pwaves(i) = .5*(darwin_wavebands(i)+darwin_wavebands(i+1))
70 else
71 WRITE(msgBuf,'(3A)') 'WAVEBANDS_INIT_FIXED: ',
72 & 'please provide wavelengths in darwin_waves or ',
73 & 'waveband boundaries in darwin_wavebands.'
74 CALL PRINT_ERROR( msgBuf, myThid )
75 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
76 endif
77 enddo
78
79 C if waveband boundaries not given, compute from representative values
80 C these will be used to compute waveband widths
81 do i=1,tlam+1
82 if (darwin_wavebands(i).LT.0) then
83 C put boundaries half-way between central values
84 C but first and last boundary are at first and last "central" value
85 if (i.eq.1) then
86 darwin_wavebands(i) = pwaves(1)
87 elseif (i.le.tlam) then
88 darwin_wavebands(i) = .5*(pwaves(i-1)+pwaves(i))
89 else
90 darwin_wavebands(i) = pwaves(tlam)
91 endif
92 endif
93 enddo
94
95 C waveband widths used to compute total PAR and alpha_mean
96 wb_totalWidth = 0.0
97 do i=1,tlam
98 wb_width(i) = darwin_wavebands(i+1) - darwin_wavebands(i)
99 wb_totalWidth = wb_totalWidth + wb_width(i)
100 C allow for zero-width wavebands...
101 if (wb_width(i).LT.0) then
102 WRITE(msgBuf,'(2A,I3)') 'WAVEBANDS_INIT_FIXED: ',
103 & 'negative waveband width encountered, waveband: ',i
104 CALL PRINT_ERROR( msgBuf, myThid )
105 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
106 & 'Please check darwin_waves and darwin_wavebands.'
107 CALL PRINT_ERROR( msgBuf, myThid )
108 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: wavebands:'
109 CALL PRINT_ERROR( msgBuf, myThid )
110 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
111 & ' idx low rep high width'
112 CALL PRINT_ERROR( msgBuf, myThid )
113 do ilam=1,tlam
114 WRITE(msgBuf,'(A,I4,F10.3,I6,F10.3,F9.3)')
115 & 'WAVEBANDS_INIT_FIXED: ', ilam,darwin_wavebands(ilam),
116 & pwaves(ilam),darwin_wavebands(ilam+1),wb_width(ilam)
117 CALL PRINT_ERROR( msgBuf, myThid )
118 enddo
119 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
120 endif
121 enddo
122 C ...but require at least one non-zero-width band
123 if (wb_totalWidth.LE.0) then
124 #ifdef OASIM
125 if (tlam.eq.1) then
126 C in this case it doesn't matter, just make non-zero for
127 C alpha_mean computation
128 wb_width(1) = 1.
129 wb_totalWidth = 1.
130 else
131 #else
132 if (.TRUE.) then
133 #endif
134 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
135 & 'need to provide waveband boundaries in darwin_wavebands.'
136 CALL PRINT_ERROR( msgBuf, myThid )
137 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
138 endif
139 endif
140
141
142 c Water data files
143 if (darwin_waterabsorbFile .NE. ' ' ) THEN
144 CALL MDSFINDUNIT( iUnit, myThid )
145 open(iUnit,file=darwin_waterabsorbFile,
146 & status='old',form='formatted')
147 do i = 1,6 ! six lines of text for the header
148 read(iUnit,'(a50)')title ! trucates or pads (with spaces) to 50 characters length
149 enddo
150 do ilam = 1,tlam
151 read(iUnit,20)swlambda,saw,sbw
152 if (swlambda.NE.pwaves(ilam)) then
153 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
154 & "wavelength for water spectrum doesn't match darwin_waves:"
155 CALL PRINT_ERROR( msgBuf, myThid )
156 WRITE(msgBuf,'(2A,I3,A,I4,A,I4)') 'WAVEBANDS_INIT_FIXED: ',
157 & 'ilam', ilam, ': ', swlambda, ' versus ', pwaves(ilam)
158 CALL PRINT_ERROR( msgBuf, myThid )
159 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
160 endif
161 aw(ilam) = saw
162 bw(ilam) = sbw
163 enddo
164 close(iUnit)
165 20 format(i5,f15.4,f10.4)
166 else
167 WRITE(msgBuf,'(A)')
168 & 'WAVEBANDS_INIT_FIXED: need to specify water absorption'
169 CALL PRINT_ERROR( msgBuf, myThid )
170 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
171 endif
172
173
174 c phyto data files
175 c ANNA phyto input data files must have a column for absorption by PS pigs
176 c ANNA easiest way to 'turn off' PS for growth is to put same values in both abs columns
177 if (darwin_phytoabsorbFile.NE. ' ' ) THEN
178 CALL MDSFINDUNIT( iUnit, myThid )
179 open(iUnit,file=darwin_phytoabsorbFile,
180 & status='old',form='formatted')
181 do i = 1,6 ! six lines of text for the header
182 read(iUnit,'(a50)')title
183 enddo
184 sbbp = 0. _d 0
185 do nabp = 1,tnabp
186 read(iUnit,'(a50)')title ! reads one line of text for the phytoplankton type header
187 do ilam = 1,tlam
188 #ifdef DAR_NONSPECTRAL_BACKSCATTERING_RATIO
189 read(iUnit,30)splambda,sap,sap_ps,sbp
190 #else
191 read(iUnit,'(i4,3f10.0,f20.0)')splambda,sap,sap_ps,sbp,sbbp
192 #endif
193 if (splambda.NE.pwaves(ilam)) then
194 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
195 & "wavelength for phyto spectrum doesn't match darwin_waves:"
196 CALL PRINT_ERROR( msgBuf, myThid )
197 WRITE(msgBuf,'(2A,I3,A,I4,A,I4)') 'WAVEBANDS_INIT_FIXED: ',
198 & 'ilam', ilam, ': ', splambda, ' versus ', pwaves(ilam)
199 CALL PRINT_ERROR( msgBuf, myThid )
200 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
201 endif
202 ap(nabp,ilam) = sap
203 ap_ps(nabp,ilam) = sap_ps
204 bp(nabp,ilam) = sbp
205 bbp(nabp,ilam) = sbbp
206 enddo
207 enddo
208 close(iUnit)
209 30 format(i4,3f10.4)
210 else
211 WRITE(msgBuf,'(A)')
212 & 'WAVEBANDS_INIT_FIXED: need to specify phyto absorption'
213 CALL PRINT_ERROR( msgBuf, myThid )
214 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
215 endif
216
217
218 #ifndef OASIM
219 c QQ NEED IN HERE ifndef OASIM
220 c surface spectrum for initial use
221 if (darwin_surfacespecFile .NE. ' ' ) THEN
222 CALL MDSFINDUNIT( iUnit, myThid )
223 open(iUnit,file=darwin_surfacespecFile,
224 & status='old',form='formatted')
225 do i = 1,3 ! three lines of text for the header
226 read(iUnit,'(a50)')title
227 enddo
228 do ilam = 1,tlam
229 read(iUnit,40)ssflambda,ssf
230 if (ssflambda.NE.pwaves(ilam)) then
231 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
232 & "wavelength for surface spectrum doesn't match darwin_waves:"
233 CALL PRINT_ERROR( msgBuf, myThid )
234 WRITE(msgBuf,'(2A,I3,A,I4,A,I4)') 'WAVEBANDS_INIT_FIXED: ',
235 & 'ilam', ilam, ': ', ssflambda, ' versus ', pwaves(ilam)
236 CALL PRINT_ERROR( msgBuf, myThid )
237 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
238 endif
239 sf(ilam) = ssf
240 enddo
241 close(iUnit)
242 40 format(i5,f15.6)
243 else
244 WRITE(msgBuf,'(A)')
245 & 'WAVEBANDS_INIT_FIXED: need surface spectrum'
246 CALL PRINT_ERROR( msgBuf, myThid )
247 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
248 endif
249 #endif /* not OASIM */
250
251
252 c absorption by cdom
253 #ifndef DAR_CALC_ACDOM
254 c if no file given then CDOM is zero
255 if (darwin_acdomFile.NE. ' ' ) THEN
256 CALL MDSFINDUNIT( iUnit, myThid )
257 open(iUnit,file=darwin_acdomFile,
258 & status='old',form='formatted')
259 do i = 1,6 ! six lines of text for the header
260 read(iUnit,'(a50)')title
261 enddo
262 do i = 1,tlam
263 read(iUnit,50)sacdom
264 acdom(i) = sacdom
265 enddo
266 close(iUnit)
267 50 format(f10.4)
268 else
269 WRITE(msgBuf,'(A)')
270 & 'WAVEBANDS_INIT_FIXED: no aCDOM'
271 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
272 & SQUEEZE_RIGHT, 1 )
273
274 do i = 1,tlam
275 acdom(i) = 0. _d 0
276 enddo
277 endif
278 #else /* DAR_CALC_ACDOM */
279 c for 3-D or for direct comparison to RADTRANS would need the same formulation for CDOM as in radtrans.
280 c CDOM absorption exponent
281 nlaCDOM = 0
282 do ilam = 1,tlam
283 if (pwaves(ilam) .eq. darwin_lambda_aCDOM) nlaCDOM = ilam
284 rlam = float(pwaves(ilam))
285 excdom(ilam) = exp(-darwin_Sdom*(rlam-darwin_lambda_aCDOM))
286 enddo
287 if (nlaCDOM.eq.0) then
288 WRITE(msgBuf,'(A,I3,A)')
289 & 'WAVEBANDS_INIT_FIXED: no waveband found at ',
290 & darwin_lambda_aCDOM, ' nm (needed for DAR_CALC_ACDOM).'
291 CALL PRINT_ERROR( msgBuf, myThid )
292 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
293 endif
294
295 WRITE(msgBuf,'(A,1P1E20.12)')
296 & 'WAVEBANDS_INIT_FIXED: darwin_aCDOM_fac = ',darwin_aCDOM_fac
297 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
298 & SQUEEZE_RIGHT, 1 )
299 WRITE(msgBuf,'(A,1P1E20.12)')
300 & 'WAVEBANDS_INIT_FIXED: darwin_Sdom = ', darwin_Sdom
301 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
302 & SQUEEZE_RIGHT, 1 )
303 WRITE(msgBuf,'(A,I3,A,I4)')
304 & 'WAVEBANDS_INIT_FIXED: nlaCDOM = ', nlaCDOM, ', lambda = ',
305 & pwaves(nlaCDOM)
306 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
307 & SQUEEZE_RIGHT, 1 )
308 #endif /* DAR_CALC_ACDOM */
309
310 #ifdef DAR_DIAG_ACDOM
311 c find waveband index for acdom diagnostic
312 if (darwin_diag_acdom_ilam.GE.100) then
313 do ilam = 1,tlam
314 if (pwaves(ilam) .eq. darwin_diag_acdom_ilam) then
315 darwin_diag_acdom_ilam = ilam
316 goto 60
317 endif
318 enddo
319 WRITE(msgBuf,'(2A,I3,A)') 'WAVEBANDS_INIT_FIXED: ',
320 & 'darwin_diag_acdom_ilam =',darwin_diag_acdom_ilam,
321 & ' not found in darwin_waves'
322 CALL PRINT_ERROR( msgBuf, myThid )
323 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
324 60 continue
325 endif
326
327 WRITE(msgBuf,'(A,I3,A,I4)')
328 & 'WAVEBANDS_INIT_FIXED: aCDOM diag ilam = ',
329 & darwin_diag_acdom_ilam, ', lambda = ',
330 & pwaves(darwin_diag_acdom_ilam)
331 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
332 & SQUEEZE_RIGHT, 1 )
333 #endif
334
335 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
336 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
337 & SQUEEZE_RIGHT, 1 )
338 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: wavebands:'
339 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
340 & SQUEEZE_RIGHT,myThid)
341 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
342 & ' idx low rep high width'
343 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
344 & SQUEEZE_RIGHT,myThid)
345 do i=1,tlam
346 WRITE(msgBuf,'(A,I4,F10.3,I6,F10.3,F9.3)')
347 & 'WAVEBANDS_INIT_FIXED: ', i,
348 & darwin_wavebands(i),pwaves(i),darwin_wavebands(i+1),wb_width(i)
349 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
350 & SQUEEZE_RIGHT,myThid)
351 enddo
352 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
353 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
354 & SQUEEZE_RIGHT, 1 )
355
356 #ifdef DAR_RADTRANS
357 c absorption and scattering by particles
358 if (darwin_particleabsorbFile .NE. ' ' ) THEN
359 CALL MDSFINDUNIT( iUnit, myThid )
360 open(iUnit,file=darwin_particleabsorbFile,
361 & status='old',form='formatted')
362 do i = 1,6 ! six lines of text for the header
363 read(iUnit,'(a50)')title ! trucates or pads (with spaces) to 50 characters length
364 enddo
365 do ilam = 1,tlam
366 read(iUnit,'(I4,3F15.0)')splambda,sap,sbp,sbbp
367 if (splambda.NE.pwaves(ilam)) then
368 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
369 & "wavelength for particle spectrum doesn't match darwin_waves:"
370 CALL PRINT_ERROR( msgBuf, myThid )
371 WRITE(msgBuf,'(2A,I3,A,I4,A,I4)') 'WAVEBANDS_INIT_FIXED: ',
372 & 'ilam', ilam, ': ', splambda, ' versus ', pwaves(ilam)
373 CALL PRINT_ERROR( msgBuf, myThid )
374 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
375 endif
376 apart(ilam) = sap
377 bpart(ilam) = sbp
378 bbpart(ilam) = sbbp
379 apart_P(ilam) = sap/darwin_part_size_P
380 bpart_P(ilam) = sbp/darwin_part_size_P
381 bbpart_P(ilam) = sbbp/darwin_part_size_P
382 enddo
383 close(iUnit)
384 else
385 do ilam = 1,tlam
386 apart(ilam) = 0. _d 0
387 bpart(ilam) = 0. _d 0
388 bbpart(ilam) = 0. _d 0
389 apart_P(ilam) = 0. _d 0
390 bpart_P(ilam) = 0. _d 0
391 bbpart_P(ilam) = 0. _d 0
392 enddo
393 endif
394
395 c print a summary
396 #ifndef OASIM
397 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: surface spectrum:'
398 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
399 & SQUEEZE_RIGHT, 1 )
400 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
401 & ' lam sf'
402 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
403 & SQUEEZE_RIGHT, 1 )
404 do ilam = 1,tlam
405 WRITE(msgBuf,'(A,I4,F15.6)') 'WAVEBANDS_INIT_FIXED: ',
406 & pwaves(ilam), sf(ilam)
407 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
408 & SQUEEZE_RIGHT, 1 )
409 enddo
410 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
411 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
412 & SQUEEZE_RIGHT, 1 )
413 #endif
414 c
415 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: water spectra:'
416 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
417 & SQUEEZE_RIGHT, 1 )
418 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
419 & ' lam aw bw'
420 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
421 & SQUEEZE_RIGHT, 1 )
422 do ilam = 1,tlam
423 WRITE(msgBuf,'(A,I4,F15.4,F10.4)') 'WAVEBANDS_INIT_FIXED: ',
424 & pwaves(ilam), aw(ilam), bw(ilam)
425 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
426 & SQUEEZE_RIGHT, 1 )
427 enddo
428 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
429 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
430 & SQUEEZE_RIGHT, 1 )
431 c
432 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: phyto spectra:'
433 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
434 & SQUEEZE_RIGHT, 1 )
435 do nabp = 1,tnabp
436 WRITE(msgBuf,'(A,I4)') 'WAVEBANDS_INIT_FIXED: type ',nabp
437 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
438 & SQUEEZE_RIGHT, 1 )
439 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
440 & ' lam ap ap_ps bp bbp'
441 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
442 & SQUEEZE_RIGHT, 1 )
443 do ilam = 1,tlam
444 WRITE(msgBuf,'(A,I4,3F10.4,F20.9)') 'WAVEBANDS_INIT_FIXED: ',
445 & pwaves(ilam), ap(nabp,ilam), ap_ps(nabp,ilam),
446 & bp(nabp,ilam), bbp(nabp,ilam)
447 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
448 & SQUEEZE_RIGHT, 1 )
449 enddo
450 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
451 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
452 & SQUEEZE_RIGHT, 1 )
453 enddo
454 c
455 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: particulate spectra:'
456 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
457 & SQUEEZE_RIGHT, 1 )
458 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
459 & ' lam apart bpart bbpart'
460 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
461 & SQUEEZE_RIGHT, 1 )
462 do ilam = 1,tlam
463 WRITE(msgBuf,'(A,I4,1P3G15.6)')'WAVEBANDS_INIT_FIXED: ',
464 & pwaves(ilam), apart(ilam), bpart(ilam), bbpart(ilam)
465 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
466 & SQUEEZE_RIGHT, 1 )
467 enddo
468 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
469 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
470 & SQUEEZE_RIGHT, 1 )
471 c
472 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: particulate spectra ',
473 & 'in phosphorus units:'
474 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
475 & SQUEEZE_RIGHT, 1 )
476 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
477 & ' lam apart_P bpart_P bbpart_P'
478 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
479 & SQUEEZE_RIGHT, 1 )
480 do ilam = 1,tlam
481 WRITE(msgBuf,'(A,I4,2F15.9,F15.12)') 'WAVEBANDS_INIT_FIXED: ',
482 & pwaves(ilam), apart_P(ilam), bpart_P(ilam), bbpart_P(ilam)
483 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
484 & SQUEEZE_RIGHT, 1 )
485 enddo
486 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
487 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
488 & SQUEEZE_RIGHT, 1 )
489 c
490 #ifndef DAR_CALC_ACDOM
491 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: CDOM spectrum:'
492 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
493 & SQUEEZE_RIGHT, 1 )
494 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
495 & ' lam aCDOM'
496 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
497 & SQUEEZE_RIGHT, 1 )
498 do ilam = 1,tlam
499 WRITE(msgBuf,'(A,I4,F10.4)') 'WAVEBANDS_INIT_FIXED: ',
500 & pwaves(ilam), acdom(ilam)
501 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
502 & SQUEEZE_RIGHT, 1 )
503 enddo
504 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
505 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
506 & SQUEEZE_RIGHT, 1 )
507 #endif
508
509 c constants
510 pid = DACOS(-1.0D0)
511 rad = 180.0D0/pid
512 #endif
513
514 #endif /* WAVEBANDS */
515
516 return
517 end
518

  ViewVC Help
Powered by ViewVC 1.1.22