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

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

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

revision 1.3 by jahn, Tue Apr 16 20:20:27 2013 UTC revision 1.4 by jahn, Tue Apr 16 20:21:21 2013 UTC
# Line 56  c      _RL planck, c, hc, oavo, hcoavo, Line 56  c      _RL planck, c, hc, oavo, hcoavo,
56  c local indeces  c local indeces
57        integer nabp,i,ilam        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        do i = 1,tlam
65          pwaves(i) = darwin_waves(i)          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        enddo
78    
79  C band widths used to convert OASIM data to irradiation per nm  C if waveband boundaries not given, compute from representative values
80  C put boundaries half-way between central values  C these will be used to compute waveband widths
81  C but first and last boundary are at first and last "central" value        do i=1,tlam+1
82        if (darwin_wavebands(1).EQ.0) then          if (darwin_wavebands(i).LT.0) then
83          wb_width(1) = .5*(pwaves(2)-pwaves(1))  C         put boundaries half-way between central values
84          do i=2,tlam-1  C         but first and last boundary are at first and last "central" value
85            wb_width(i) = .5*(pwaves(i+1)-pwaves(i-1))            if (i.eq.1) then
86          enddo              darwin_wavebands(i) = pwaves(1)
87          wb_width(tlam) = .5*(pwaves(tlam)-pwaves(tlam-1))            elseif (i.le.tlam) then
88        else              darwin_wavebands(i) = .5*(pwaves(i-1)+pwaves(i))
89          do i=1,tlam            else
90            wb_width(i) = darwin_wavebands(i+1) - darwin_wavebands(i)              darwin_wavebands(i) = pwaves(tlam)
91          enddo            endif
92        endif          endif
93          enddo
94    
95    C waveband widths used to compute total PAR and alpha_mean
96        wb_totalWidth = 0.0        wb_totalWidth = 0.0
97        do i=1,tlam        do i=1,tlam
98            wb_width(i) = darwin_wavebands(i+1) - darwin_wavebands(i)
99          wb_totalWidth = wb_totalWidth + wb_width(i)          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        enddo
122    C     ...but require at least one non-zero-width band
123        if (wb_totalWidth.LE.0) then        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: ',          WRITE(msgBuf,'(2A)') 'WAVEBANDS_INIT_FIXED: ',
135       &  'please provide wavelengths in darwin_waves.'       &  'need to provide waveband boundaries in darwin_wavebands.'
136          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
137          STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'          STOP 'ABNORMAL END: S/R WAVEBANDS_INIT_FIXED'
138           endif
139        endif        endif
140    
141    
# Line 233  c   CDOM absorption exponent Line 286  c   CDOM absorption exponent
286        enddo        enddo
287    
288        WRITE(msgBuf,'(A,1P1E20.12)')        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       &      'WAVEBANDS_INIT_FIXED: darwin_Sdom = ', darwin_Sdom
294        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
295       &                    SQUEEZE_RIGHT, 1 )       &                    SQUEEZE_RIGHT, 1 )
# Line 262  c     find waveband index for acdom diag Line 319  c     find waveband index for acdom diag
319       &                    SQUEEZE_RIGHT, 1 )       &                    SQUEEZE_RIGHT, 1 )
320  #endif  #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  #ifdef DAR_RADTRANS
344  c  absorption and scattering by particles  c  absorption and scattering by particles
345        if (darwin_particleabsorbFile .NE. ' '  ) THEN        if (darwin_particleabsorbFile .NE. ' '  ) THEN
# Line 302  c  absorption and scattering by particle Line 380  c  absorption and scattering by particle
380        endif        endif
381    
382  c     print a summary  c     print a summary
       WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: waveband widths:'  
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                    SQUEEZE_RIGHT, 1 )  
       WRITE(msgBuf,'(A,A)') 'WAVEBANDS_INIT_FIXED: ',  
      &     ' lam width'  
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                    SQUEEZE_RIGHT, 1 )  
       do ilam = 1,tlam            
         WRITE(msgBuf,'(A,I4,F15.6)') 'WAVEBANDS_INIT_FIXED: ',  
      &     pwaves(ilam), wb_width(ilam)  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT, 1 )  
       enddo  
       WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED:'  
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                    SQUEEZE_RIGHT, 1 )  
 c  
383  #ifndef OASIM  #ifndef OASIM
384        WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: surface spectrum:'        WRITE(msgBuf,'(A)') 'WAVEBANDS_INIT_FIXED: surface spectrum:'
385        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22