*IF DEF,OCEAN ORH1F305.474
C ******************************COPYRIGHT****************************** GTS2F400.9361
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9362
C GTS2F400.9363
C Use, duplication or disclosure of this code is subject to the GTS2F400.9364
C restrictions as set forth in the contract. GTS2F400.9365
C GTS2F400.9366
C Meteorological Office GTS2F400.9367
C London Road GTS2F400.9368
C BRACKNELL GTS2F400.9369
C Berkshire UK GTS2F400.9370
C RG12 2SZ GTS2F400.9371
C GTS2F400.9372
C If no contract has been raised with this copy of the code, the use, GTS2F400.9373
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9374
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9375
C Modelling at the above address. GTS2F400.9376
C ******************************COPYRIGHT****************************** GTS2F400.9377
C GTS2F400.9378
C*LL SOLSET2.3
CLL Subroutine SOLSET2 SOLSET2.4
CLL Can run on any FORTRAN 77 compiler with long lower case variables SOLSET2.5
CLL SOLSET2.6
CLL Author: N K TAYLOR SOLSET2.7
CLL Date: 17 December 1993 SOLSET2.8
CLL Version 3.3 SOLSET2.9
CLL SOLSET2.10
CLL Programming standards use Cox naming convention for Cox variables SOLSET2.11
CLL with the addition that lower case variables are local to the SOLSET2.12
CLL routine. SOLSET2.13
CLL Otherwise follows UM doc paper 4 version 1. SOLSET2.14
CLL SOLSET2.15
CLL This forms part of UM brick P4. SOLSET2.16
CLL SOLSET2.17
CLL This routine calculates the solar penetration for any water type. SOLSET2.18
CLL Solar penetration is calculated as a single exponential functio SOLSET2.19
CLL with a light extinction coefficient that varies with depth and SOLSET2.20
CLL with phytoplankton pigment (chlorophyll) concentration. SOLSET2.21
CLL The light model used here has three layers : the top two layers SOLSET2.22
CLL correspond exactly with the top two layers of the ocean model. SOLSET2.23
CLL The third layer covers all other ocean model layers down to the SOLSET2.24
CLL bottom. SOLSET2.25
CLL The polynomial coefficients b0,...,b5 have been defined with SOLSET2.26
CLL the present distribution of ocean model levels in mind - namely SOLSET2.27
CLL a near-surface vertical resolution of 10m. If the model rsolut SOLSET2.28
CLL changes in the future then new coefficients should be used. SOLSET2.29
CLL SOLSET2.30
CLL External documentation: Solar penetration is calculated as single SOLSET2.31
CLL exponential function whose extinction coefficient varies with SOLSET2.32
CLL depth and chlorophyll concentration. (Anderson, 1993) SOLSET2.33
CLL SOLSET2.34
CLL Subroutine dependencies: EXP SOLSET2.35
CLL SOLSET2.36
CLLEND --------------------------------------------------------------- SOLSET2.37
C* SOLSET2.38
C*L -------------------------- Arguments ---------------------------- SOLSET2.39
C SOLSET2.40
SUBROUTINE SOLSET2 (SOL_PEN, RTPIG, KFIX, ETA 1SOLSET2.41
+ ,KM, IMT SOLSET2.42
+ ,DZ, ZDZ SOLSET2.43
+ ) SOLSET2.44
C SOLSET2.45
IMPLICIT NONE SOLSET2.46
C SOLSET2.47
C Define constants for array sizes SOLSET2.48
C SOLSET2.49
INTEGER SOLSET2.50
+ KM ! IN Number of layers in model SOLSET2.51
+, IMT ! IN Number of points per row SOLSET2.52
C SOLSET2.53
C Physical arguments SOLSET2.54
C SOLSET2.55
REAL SOLSET2.56
+ SOL_PEN (IMT,0:KM) ! OUT Proportion of solar energy at layer b SOLSET2.57
+, ETA (IMT,KM) ! OUT Light extinction coefficient in 1/m. SOLSET2.58
+, DZ (KM) ! IN Layer thicknesses SOLSET2.59
+, ZDZ (KM) ! IN Layer bases SOLSET2.60
+, RTPIG (IMT,KM) ! IN Square root of chlorophyll pigment SOLSET2.61
C ! concentration in milligrams/m**3 SOLSET2.62
C SOLSET2.63
INTEGER SOLSET2.64
+ KFIX ! OUT Layer to which solar heating penetrates SOLSET2.65
C* SOLSET2.66
C*L ------------ External subroutines called ------------------------ SOLSET2.67
INTRINSIC SOLSET2.68
+ EXP ! Intrinsic function SOLSET2.69
C* ----------------------------------------------------------------- SOLSET2.70
C SOLSET2.71
C Locally defined variables SOLSET2.72
C SOLSET2.73
INTEGER SOLSET2.74
+ k ! Vertical index SOLSET2.75
+, k_temp ! Temporary store for level number SOLSET2.76
+, i ! Horizontal index SOLSET2.77
C SOLSET2.78
REAL b0(3), b1(3), b2(3), b3(3), b4(3), b5(3) ! Coefficients SOLSET2.79
C ! in the polynomial expression of the light SOLSET2.80
C ! extinction coeff. as a function of PIGMENT SOLSET2.81
C ! concentration. Each coefficent takes one SOLSET2.82
C ! of three discrete values, depending on the SOLSET2.83
C ! depth of the ocean model layer SOLSET2.84
C SOLSET2.85
CL 1.1 Define values of physical constants SOLSET2.86
C SOLSET2.87
DATA b0 / 0.095934 , 0.026590 , 0.015464 / SOLSET2.88
DATA b1 / 0.039307 , 0.016301 , 0.14886 / SOLSET2.89
DATA b2 / 0.051891 , 0.073944 ,-0.15711 / SOLSET2.90
DATA b3 /-0.020760 ,-0.038958 , 0.15065 / SOLSET2.91
DATA b4 / 0.0043139 , 0.0075507 ,-0.055830 / SOLSET2.92
DATA b5 /-0.00035055 ,-0.00054532 , 0.0075811 / SOLSET2.93
C SOLSET2.94
CL 2.1 Calculate layer of max penetration (200m). SOLSET2.95
C SOLSET2.96
k_temp = 1 SOLSET2.97
DO 2100, k = 1, KM SOLSET2.98
k_temp = k SOLSET2.99
IF (ZDZ(k).GT.200.0E2) GO TO 2110 SOLSET2.100
2100 CONTINUE SOLSET2.101
2110 CONTINUE SOLSET2.102
KFIX = k_temp SOLSET2.103
C SOLSET2.104
CL 3.1 Calculate extinction coefficient for the three conceptual SOLSET2.105
CL layers of the light model SOLSET2.106
C Extinction coeff. for layer 3 of the light model (which SOLSET2.107
C really extends to the sea floor is computed based on the SOLSET2.108
C pigment concentration in level 3 of the ocean model (which SOLSET2.109
C DOESNT extend to the sea floor in general) SOLSET2.110
C SOLSET2.111
DO 3100 k = 1,3 SOLSET2.112
DO 3110 i = 1,IMT SOLSET2.113
eta(i,k) = b0(k) + b1(k)*RTPIG(i,k) + b2(k)*(RTPIG(i,k)**2) SOLSET2.114
+ + b3(k)*(RTPIG(i,k)**3) + b4(k)*(RTPIG(i,k)**4) SOLSET2.115
+ + b5(k)*(RTPIG(i,k)**5) SOLSET2.116
3110 CONTINUE SOLSET2.117
3100 CONTINUE SOLSET2.118
C SOLSET2.119
C Polynomial expression only valid for pigment concentration SOLSET2.120
C less than 16 mg/m**3. Therefore impose a limit on the SOLSET2.121
C attenuation coeff. computed for high pigment concs. SOLSET2.122
DO I=1,IMT SOLSET2.123
IF (RTPIG(I,1).GT.5.4) THEN SOLSET2.124
eta(i,1)=0.611 SOLSET2.125
eta(i,2)=0.09 SOLSET2.126
eta(i,3)=0.12 SOLSET2.127
ENDIF SOLSET2.128
ENDDO SOLSET2.129
C SOLSET2.130
DO 3200 k = 4,km SOLSET2.131
DO 3210 i = 1,IMT SOLSET2.132
eta(i,k) = eta(i,3) SOLSET2.133
3210 CONTINUE SOLSET2.134
3200 CONTINUE SOLSET2.135
C SOLSET2.136
C SOLSET2.137
CL 4.1 Calculate proportion of radiation reaching base of each SOLSET2.138
CL ocean model layer SOLSET2.139
C SOLSET2.140
DO 4100 i = 1,IMT SOLSET2.141
SOL_PEN(i,0) = 1.0 SOLSET2.142
SOL_PEN(i,1) = EXP (-eta(i,1)*dz(1)/100.) SOLSET2.143
SOL_PEN(i,2) = EXP (-eta(i,2)*dz(2)/100.) * SOL_PEN(i,1) SOLSET2.144
4100 CONTINUE SOLSET2.145
C SOLSET2.146
DO 4200 k = 3, (KFIX-1) SOLSET2.147
DO 4210 i = 1,IMT SOLSET2.148
SOL_PEN(i,k) = EXP(-eta(i,3)*(zdz(k)-zdz(2))/100.)*SOL_PEN(i,2) SOLSET2.149
4210 CONTINUE SOLSET2.150
4200 CONTINUE SOLSET2.151
C SOLSET2.152
DO 4300 k = KFIX,KM SOLSET2.153
DO 4310 i = 1,IMT SOLSET2.154
SOL_PEN(i,k) = 0.0 SOLSET2.155
4310 CONTINUE SOLSET2.156
4300 CONTINUE SOLSET2.157
C SOLSET2.158
CL Return from SOLSET2 SOLSET2.159
C SOLSET2.160
RETURN SOLSET2.161
END SOLSET2.162
C SOLSET2.163
*ENDIF SOLSET2.164