/[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.4 - (show annotations) (download)
Tue Apr 16 20:21:21 2013 UTC (12 years, 3 months ago) by jahn
Branch: MAIN
Changes since 1.3: +95 -34 lines
compute missing waveband information from provided values

1 C $Header: /u/gcmpack/MITgcm_contrib/darwin2/pkg/darwin/wavebands_init_fixed.F,v 1.3 2013/04/16 20:20:27 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 rlam450,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 rlam450 = 450.0 _d 0
282 do ilam = 1,tlam
283 if (pwaves(ilam) .eq. 450) nl450 = ilam
284 rlam = float(pwaves(ilam))
285 excdom(ilam) = exp(-darwin_Sdom*(rlam-rlam450))
286 enddo
287
288 WRITE(msgBuf,'(A,1P1E20.12)')
289 & 'WAVEBANDS_INIT_FIXED: darwin_aCDOM_fac = ',darwin_aCDOM_fac
290 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
291 & SQUEEZE_RIGHT, 1 )
292 WRITE(msgBuf,'(A,1P1E20.12)')
293 & 'WAVEBANDS_INIT_FIXED: darwin_Sdom = ', darwin_Sdom
294 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
295 & SQUEEZE_RIGHT, 1 )
296 WRITE(msgBuf,'(A,I3)')
297 & 'WAVEBANDS_INIT_FIXED: nl450 = ', nl450
298 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
299 & SQUEEZE_RIGHT, 1 )
300 #endif /* DAR_CALC_ACDOM */
301
302 #ifdef DAR_DIAG_ACDOM
303 c find waveband index for acdom diagnostic
304 if (darwin_diag_acdom_ilam.GE.100) then
305 do ilam = 1,tlam
306 if (pwaves(ilam) .eq. darwin_diag_acdom_ilam) then
307 darwin_diag_acdom_ilam = ilam
308 goto 60
309 endif
310 enddo
311 60 continue
312 endif
313
314 WRITE(msgBuf,'(A,I3,A,I4)')
315 & 'WAVEBANDS_INIT_FIXED: aCDOM diag ilam = ',
316 & darwin_diag_acdom_ilam, ', lambda = ',
317 & pwaves(darwin_diag_acdom_ilam)
318 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
319 & SQUEEZE_RIGHT, 1 )
320 #endif
321
322 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
323 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
324 & SQUEEZE_RIGHT, 1 )
325 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: wavebands:'
326 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
327 & SQUEEZE_RIGHT,myThid)
328 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
329 & ' idx low rep high width'
330 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
331 & SQUEEZE_RIGHT,myThid)
332 do i=1,tlam
333 WRITE(msgBuf,'(A,I4,F10.3,I6,F10.3,F9.3)')
334 & 'WAVEBANDS_INIT_FIXED: ', i,
335 & darwin_wavebands(i),pwaves(i),darwin_wavebands(i+1),wb_width(i)
336 CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
337 & SQUEEZE_RIGHT,myThid)
338 enddo
339 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
340 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
341 & SQUEEZE_RIGHT, 1 )
342
343 #ifdef DAR_RADTRANS
344 c absorption and scattering by particles
345 if (darwin_particleabsorbFile .NE. ' ' ) THEN
346 CALL MDSFINDUNIT( iUnit, myThid )
347 open(iUnit,file=darwin_particleabsorbFile,
348 & status='old',form='formatted')
349 do i = 1,6 ! six lines of text for the header
350 read(iUnit,'(a50)')title ! trucates or pads (with spaces) to 50 characters length
351 enddo
352 do ilam = 1,tlam
353 read(iUnit,'(I4,3F15.0)')splambda,sap,sbp,sbbp
354 if (splambda.NE.pwaves(ilam)) then
355 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
356 & "wavelength for particle spectrum doesn't match darwin_waves:"
357 CALL PRINT_ERROR( msgBuf, myThid )
358 WRITE(msgBuf,'(2A,I3,A,I4,A,I4)') 'WAVEBANDS_INIT_FIXED: ',
359 & 'ilam', ilam, ': ', splambda, ' versus ', pwaves(ilam)
360 CALL PRINT_ERROR( msgBuf, myThid )
361 STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
362 endif
363 apart(ilam) = sap
364 bpart(ilam) = sbp
365 bbpart(ilam) = sbbp
366 apart_P(ilam) = sap/darwin_part_size_P
367 bpart_P(ilam) = sbp/darwin_part_size_P
368 bbpart_P(ilam) = sbbp/darwin_part_size_P
369 enddo
370 close(iUnit)
371 else
372 do ilam = 1,tlam
373 apart(ilam) = 0. _d 0
374 bpart(ilam) = 0. _d 0
375 bbpart(ilam) = 0. _d 0
376 apart_P(ilam) = 0. _d 0
377 bpart_P(ilam) = 0. _d 0
378 bbpart_P(ilam) = 0. _d 0
379 enddo
380 endif
381
382 c print a summary
383 #ifndef OASIM
384 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: surface spectrum:'
385 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
386 & SQUEEZE_RIGHT, 1 )
387 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
388 & ' lam sf'
389 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
390 & SQUEEZE_RIGHT, 1 )
391 do ilam = 1,tlam
392 WRITE(msgBuf,'(A,I4,F15.6)') 'WAVEBANDS_INIT_FIXED: ',
393 & pwaves(ilam), sf(ilam)
394 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
395 & SQUEEZE_RIGHT, 1 )
396 enddo
397 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
398 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
399 & SQUEEZE_RIGHT, 1 )
400 #endif
401 c
402 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: water spectra:'
403 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
404 & SQUEEZE_RIGHT, 1 )
405 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
406 & ' lam aw bw'
407 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
408 & SQUEEZE_RIGHT, 1 )
409 do ilam = 1,tlam
410 WRITE(msgBuf,'(A,I4,F15.4,F10.4)') 'WAVEBANDS_INIT_FIXED: ',
411 & pwaves(ilam), aw(ilam), bw(ilam)
412 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
413 & SQUEEZE_RIGHT, 1 )
414 enddo
415 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
416 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
417 & SQUEEZE_RIGHT, 1 )
418 c
419 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: phyto spectra:'
420 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
421 & SQUEEZE_RIGHT, 1 )
422 do nabp = 1,tnabp
423 WRITE(msgBuf,'(A,I4)') 'WAVEBANDS_INIT_FIXED: type ',nabp
424 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
425 & SQUEEZE_RIGHT, 1 )
426 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
427 & ' lam ap ap_ps bp bbp'
428 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
429 & SQUEEZE_RIGHT, 1 )
430 do ilam = 1,tlam
431 WRITE(msgBuf,'(A,I4,3F10.4,F20.9)') 'WAVEBANDS_INIT_FIXED: ',
432 & pwaves(ilam), ap(nabp,ilam), ap_ps(nabp,ilam),
433 & bp(nabp,ilam), bbp(nabp,ilam)
434 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
435 & SQUEEZE_RIGHT, 1 )
436 enddo
437 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
438 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
439 & SQUEEZE_RIGHT, 1 )
440 enddo
441 c
442 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: particulate spectra:'
443 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
444 & SQUEEZE_RIGHT, 1 )
445 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
446 & ' lam apart bpart bbpart'
447 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
448 & SQUEEZE_RIGHT, 1 )
449 do ilam = 1,tlam
450 WRITE(msgBuf,'(A,I4,1P3G15.6)')'WAVEBANDS_INIT_FIXED: ',
451 & pwaves(ilam), apart(ilam), bpart(ilam), bbpart(ilam)
452 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
453 & SQUEEZE_RIGHT, 1 )
454 enddo
455 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
456 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
457 & SQUEEZE_RIGHT, 1 )
458 c
459 WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: particulate spectra ',
460 & 'in phosphorus units:'
461 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
462 & SQUEEZE_RIGHT, 1 )
463 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
464 & ' lam apart_P bpart_P bbpart_P'
465 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
466 & SQUEEZE_RIGHT, 1 )
467 do ilam = 1,tlam
468 WRITE(msgBuf,'(A,I4,2F15.9,F15.12)') 'WAVEBANDS_INIT_FIXED: ',
469 & pwaves(ilam), apart_P(ilam), bpart_P(ilam), bbpart_P(ilam)
470 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
471 & SQUEEZE_RIGHT, 1 )
472 enddo
473 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
474 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
475 & SQUEEZE_RIGHT, 1 )
476 c
477 #ifndef DAR_CALC_ACDOM
478 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: CDOM spectrum:'
479 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
480 & SQUEEZE_RIGHT, 1 )
481 WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',
482 & ' lam aCDOM'
483 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
484 & SQUEEZE_RIGHT, 1 )
485 do ilam = 1,tlam
486 WRITE(msgBuf,'(A,I4,F10.4)') 'WAVEBANDS_INIT_FIXED: ',
487 & pwaves(ilam), acdom(ilam)
488 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
489 & SQUEEZE_RIGHT, 1 )
490 enddo
491 WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'
492 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
493 & SQUEEZE_RIGHT, 1 )
494 #endif
495
496 c constants
497 pid = DACOS(-1.0D0)
498 rad = 180.0D0/pid
499 #endif
500
501 #endif /* WAVEBANDS */
502
503 return
504 end
505

  ViewVC Help
Powered by ViewVC 1.1.22