*IF DEF,OCEAN ORH1F305.475
C ******************************COPYRIGHT****************************** GTS2F400.9397
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9398
C GTS2F400.9399
C Use, duplication or disclosure of this code is subject to the GTS2F400.9400
C restrictions as set forth in the contract. GTS2F400.9401
C GTS2F400.9402
C Meteorological Office GTS2F400.9403
C London Road GTS2F400.9404
C BRACKNELL GTS2F400.9405
C Berkshire UK GTS2F400.9406
C RG12 2SZ GTS2F400.9407
C GTS2F400.9408
C If no contract has been raised with this copy of the code, the use, GTS2F400.9409
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9410
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9411
C Modelling at the above address. GTS2F400.9412
C ******************************COPYRIGHT****************************** GTS2F400.9413
C GTS2F400.9414
C*LL SPECTRAL.3
CLL Subroutine SPECTRAL SPECTRAL.4
CLL Can run on any FORTRAN 77 compiler with long lower case variables SPECTRAL.5
CLL SPECTRAL.6
CLL Author: N K TAYLOR SPECTRAL.7
CLL Version 3.3 Date 17 December 1993 SPECTRAL.8
CLL SPECTRAL.9
CLL Programming standards use Cox naming convention for Cox variables SPECTRAL.10
CLL with the addition that lower case variables are local to the SPECTRAL.11
CLL routine. SPECTRAL.12
CLL Otherwise follows UM doc paper 4 version 1. SPECTRAL.13
CLL SPECTRAL.14
CLL This routine calculates the spectrally-averaged photosynthesis SPECTRAL.15
CLL for each layer. SPECTRAL.16
CLL The light model used here has three layers : the top two layers SPECTRAL.17
CLL correspond exactly with the top two layers of the ocean model. SPECTRAL.18
CLL The third layer covers all other ocean model layers down to the SPECTRAL.19
CLL bottom. SPECTRAL.20
CLL The polynomial coefficients have been defined with SPECTRAL.21
CLL the present distribution of ocean model levels in mind - namely SPECTRAL.22
CLL a near-surface vertical resolution of 10m. If the model rsolut SPECTRAL.23
CLL changes in the future then new coefficients should be used. SPECTRAL.24
CLL SPECTRAL.25
CLL External documentation: Solar penetration is calculated as single SPECTRAL.26
CLL exponential function whose extinction coefficient varies with SPECTRAL.27
CLL depth and chlorophyll concentration. (Anderson, 1993) SPECTRAL.28
CLL SPECTRAL.29
CLL SPECTRAL.30
CLLEND --------------------------------------------------------------- SPECTRAL.31
C* SPECTRAL.32
C*L -------------------------- Arguments ---------------------------- SPECTRAL.33
C SPECTRAL.34
SUBROUTINE SPECTRAL (SOL_NOON,SOL_PEN,RTPIG, 1SPECTRAL.35
*CALL ARGOCBIO 
SPECTRAL.36
+ KFIX,ALPHMX,ETA, SPECTRAL.37
+ DZ,JMT, SPECTRAL.38
+ IMT,KM,PSMAX,PSYNTH) SPECTRAL.39
SPECTRAL.40
C SPECTRAL.41
IMPLICIT NONE SPECTRAL.42
C SPECTRAL.43
C Define constants for array sizes SPECTRAL.44
C SPECTRAL.45
INTEGER SPECTRAL.46
+ KM ! IN Number of layers in model SPECTRAL.47
+, IMT ! IN Number of points per row SPECTRAL.48
+, JMT ! IN Number of rows SPECTRAL.49
+, KFIX ! IN Layer to which solar radiation penetrates SPECTRAL.50
C SPECTRAL.51
C Physical arguments SPECTRAL.52
C SPECTRAL.53
*CALL TYPOCBIO SPECTRAL.54
REAL SPECTRAL.55
+ SOL_PEN (IMT,0:KM) ! IN Proportion of solar energy at layer ba SPECTRAL.56
+, SOL_NOON (IMT) ! IN Noon irradiance (uEinstein/m2/s) SPECTRAL.57
+, DZ (KM) ! IN Layer thicknesses SPECTRAL.58
+, PSMAX ! IN Max rate of p/s (mgC/mgCHL/hour) SPECTRAL.59
+, PSYNTH (IMT,KM) ! OUT Daily rate of p/s (mgC/m3/day) SPECTRAL.60
+, ETA (IMT,KM) ! IN Light extinction coefficient SPECTRAL.61
+, ALPHMX ! IN Max. photosynthetic efficiency SPECTRAL.62
+, RTPIG (IMT,KM) ! IN SQRT of PIGMENT (chlorophyll) SPECTRAL.63
C ! concentration in milligrams/m**3 SPECTRAL.64
C* SPECTRAL.65
*IF DEF,OBIOLOGY ORH1F305.476
C* ----------------------------------------------------------------- SPECTRAL.66
C SPECTRAL.67
C Locally defined variables SPECTRAL.68
C SPECTRAL.69
INTEGER SPECTRAL.70
+ k ! Vertical index SPECTRAL.71
+, i ! Horizontal index SPECTRAL.72
C SPECTRAL.73
REAL sol_bot (imt,0:km) ! Noon irrad. leaving bottom of each layer SPECTRAL.74
REAL acof(5) ! Coeffs in expression of surface value of chlorphy SPECTRAL.75
C ! x-section as a function of pigment conc. SPECTRAL.76
REAL gcof(10) ! Fitted coefficients in expression for chlorophyll SPECTRAL.77
C ! absorption cross-section as a function of depth SPECTRAL.78
C ! and pigment concentration. SPECTRAL.79
REAL omega(5) ! Coefficients in polynomial expansion of depth- SPECTRAL.80
C ! integrated daily p/s (Platt et al, 1990) SPECTRAL.81
REAL terma(IMT,KM),termb(IMT,KM),termc(IMT,KM) ! Intermediates SPECTRAL.82
+, astar(IMT,KM) ! Chlorophyll x-section (dimensionless) SPECTRAL.83
C ! (relative to surface) SPECTRAL.84
REAL SPECTRAL.85
+ dastar(IMT,KM) ! Chlorophyll x-section vertical increment SPECTRAL.86
+, astar0(IMT,KM) ! Surface chlorophyll x- section (now depth- SPECTRAL.87
C ! dependent) SPECTRAL.88
REAL v1(IMT,KM) ! Intermediates in p/s calculation SPECTRAL.89
+, v2(IMT,KM) ! SPECTRAL.90
+, fxa ! SPECTRAL.91
C SPECTRAL.92
C Define values of physical constants SPECTRAL.93
C SPECTRAL.94
DATA acof / 3.6796E-1 , 1.7537E-1 , -6.5276E-2 , SPECTRAL.95
+ 1.3528E-2 , -1.1108E-3 / SPECTRAL.96
DATA gcof / 4.8014E-2 , 2.3779E-4 , -9.0545E-3 , 8.5217E-4 , SPECTRAL.97
+ -2.3074E-2 , 3.1095E-3 , 1.2398E-3 , 2.7974E-3 , SPECTRAL.98
+ -6.1991E-4 , -3.9804E-6 / SPECTRAL.99
DATA omega / 1.9004 , -2.8333E-1 , 2.8050E-2 , -1.4729E-3 , SPECTRAL.100
+ 3.0841E-5 / SPECTRAL.101
C SPECTRAL.102
C Calculate light leaving bottom of each ocean model layer SPECTRAL.103
C Calculation need be done only as far as KFIX since no light SPECTRAL.104
C penetrates below that layer (by definition) SPECTRAL.105
C SPECTRAL.106
DO 4200 K = 0, KFIX SPECTRAL.107
DO 4210 I = 1,IMT SPECTRAL.108
SOL_BOT(I,K) = SOL_PEN(I,K) * SOL_NOON(I) SPECTRAL.109
4210 CONTINUE SPECTRAL.110
4200 CONTINUE SPECTRAL.111
SPECTRAL.112
C SPECTRAL.113
C Compute surface value of chlorophyll x-section SPECTRAL.114
C SPECTRAL.115
DO K=1,KFIX SPECTRAL.116
DO I=1,IMT SPECTRAL.117
astar0(I,K) = acof(1) + acof(2)*RTPIG(I,K) SPECTRAL.118
+ + acof(3)*(RTPIG(I,K)**2) SPECTRAL.119
+ + acof(4)*(RTPIG(I,K)**3) SPECTRAL.120
+ + acof(5)*(RTPIG(I,K)**4) SPECTRAL.121
ENDDO SPECTRAL.122
ENDDO SPECTRAL.123
SPECTRAL.124
C SPECTRAL.125
C Calculate Chlorophyll cross-section, a*. SPECTRAL.126
C a* is given by the following relation SPECTRAL.127
C d(a*)/dz = g1 + g2*c + g3*v +g4*c*v + g5*c*c + g6*v*v SPECTRAL.128
C + g7*c*c*c + g8*v*v*v + g9*c*c*v + g10*c*v*v SPECTRAL.129
C SPECTRAL.130
C where c=sqrt(pigment) SPECTRAL.131
C v=ln(z+1) where z=depth (m) SPECTRAL.132
C g1...g10 = fitted coefficients SPECTRAL.133
C DZ must be converted from cms to metres before use SPECTRAL.134
C - hence the factor 0.01 in front of it. SPECTRAL.135
C SPECTRAL.136
SPECTRAL.137
DO 4300 k = 1,KFIX SPECTRAL.138
DO 4310 I = 1,IMT SPECTRAL.139
SPECTRAL.140
terma(I,K) = gcof(1) + RTPIG(I,K) * SPECTRAL.141
+ (gcof(2) + RTPIG(I,K) * SPECTRAL.142
+ (gcof(3) + RTPIG(I,K)*gcof(4))) SPECTRAL.143
SPECTRAL.144
termb(I,K) = gcof(5) + RTPIG(I,K) * SPECTRAL.145
+ (gcof(6) + RTPIG(I,K)*gcof(7)) SPECTRAL.146
SPECTRAL.147
termc(I,K) = gcof(8) + RTPIG(I,K)*gcof(9) SPECTRAL.148
SPECTRAL.149
dastar(I,K) = terma(I,K)*DZ(K)*0.01 + termb(I,K)*DLCO(K,1) SPECTRAL.150
+ + termc(I,K)*DLCO(K,2) + gcof(10)*DLCO(K,3) SPECTRAL.151
SPECTRAL.152
4310 CONTINUE SPECTRAL.153
4300 CONTINUE SPECTRAL.154
SPECTRAL.155
C SPECTRAL.156
DO I=1,IMT SPECTRAL.157
astar(I,1) = 0.5*dastar(I,1) SPECTRAL.158
ENDDO SPECTRAL.159
SPECTRAL.160
DO K=2,KFIX SPECTRAL.161
DO I=1,IMT SPECTRAL.162
astar(I,K) = astar(I,K-1) + 0.5*(dastar(I,K-1) + dastar(I,K)) SPECTRAL.163
ENDDO SPECTRAL.164
ENDDO SPECTRAL.165
SPECTRAL.166
C SPECTRAL.167
C Now calculate photosynthesis SPECTRAL.168
C SPECTRAL.169
fxa = alphmx/psmax SPECTRAL.170
DO K=1,KFIX SPECTRAL.171
DO I=1,IMT SPECTRAL.172
v1(I,K) = fxa * (astar(I,K) + astar0(I,K)) SPECTRAL.173
v2(I,K) = v1(I,K) * sol_bot(I,K) SPECTRAL.174
v1(I,K) = v1(I,K) * sol_bot(I,K-1) SPECTRAL.175
C SPECTRAL.176
C v1,v2 must not excedd the range for which the polynamial was SPECTRAL.177
C fitted. Hence limit v1,v2 to be less than 15.0, since values SPECTRAL.178
C outside ot this range should not occur in the normal course SPECTRAL.179
C of events. SPECTRAL.180
C SPECTRAL.181
v1(I,K) = AMIN1(v1(I,K),15.0) SPECTRAL.182
v2(I,K) = AMIN1(v2(I,K),15.0) SPECTRAL.183
C SPECTRAL.184
PSYNTH(I,K) = omega(1) * (v1(I,K)-v2(I,K)) SPECTRAL.185
+ + omega(2) * ((v1(I,K))**2 - (v2(I,K))**2) SPECTRAL.186
+ + omega(3) * ((v1(I,K))**3 - (v2(I,K))**3) SPECTRAL.187
+ + omega(4) * ((v1(I,K))**4 - (v2(I,K))**4) SPECTRAL.188
+ + omega(5) * ((v1(I,K))**5 - (v2(I,K))**5) SPECTRAL.189
PSYNTH(I,K) = (PSYNTH(I,K)) / (ETA(I,K)) SPECTRAL.190
ENDDO SPECTRAL.191
ENDDO SPECTRAL.192
SPECTRAL.193
C Photosynthesis is zero below the layer where all light is SPECTRAL.194
C extinguished SPECTRAL.195
C SPECTRAL.196
DO K=KFIX+1,KM SPECTRAL.197
DO I=1,IMT SPECTRAL.198
PSYNTH(I,K) = 0.0 SPECTRAL.199
ENDDO SPECTRAL.200
ENDDO SPECTRAL.201
C SPECTRAL.202
CL Return from SPECTRAL SPECTRAL.203
C SPECTRAL.204
*ENDIF ORH1F305.477
RETURN SPECTRAL.205
END SPECTRAL.206
C SPECTRAL.207
*ENDIF SPECTRAL.208