*IF DEF,OCEAN @DYALLOC.4658
C ******************************COPYRIGHT****************************** GTS2F400.9289
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9290
C GTS2F400.9291
C Use, duplication or disclosure of this code is subject to the GTS2F400.9292
C restrictions as set forth in the contract. GTS2F400.9293
C GTS2F400.9294
C Meteorological Office GTS2F400.9295
C London Road GTS2F400.9296
C BRACKNELL GTS2F400.9297
C Berkshire UK GTS2F400.9298
C RG12 2SZ GTS2F400.9299
C GTS2F400.9300
C If no contract has been raised with this copy of the code, the use, GTS2F400.9301
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9302
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9303
C Modelling at the above address. GTS2F400.9304
C ******************************COPYRIGHT****************************** GTS2F400.9305
C GTS2F400.9306
C*LL SOLADD.3
CLL Subroutine SOLADD SOLADD.4
CLL Can run on any FORTRAN 77 compiler with long lower case variables SOLADD.5
CLL SOLADD.6
CLL The code must be pre-compiled by the UPDOC system. SOLADD.7
CLL NT091293.142
CLL NT091293.143
CLL SOLADD.11
CLL Author: S J Foreman SOLADD.12
CLL Date: 8 February 1990 SOLADD.13
CLL Reviewer: J O S Alves SOLADD.14
CLL Review date: 24 July 1990 SOLADD.15
CLL NT091293.144
CLL Version 1.00 date 8 February 1990 SOLADD.16
CLL SOLADD.17
CLL REVISED: 1 DECEMBER 1993 by N.K. TAYLOR NT091293.145
CLL An extra dimension added to SOLPEN so that solar radiati NT091293.146
CLL reaching the bottom of a layer can vary spatially if NT091293.147
CLL biological routines are used to predict chlorophyll NT091293.148
CLL NT091293.149
CLL Programming standards use Cox naming convention for Cox variables SOLADD.18
CLL with the addition that lower case variables are local to the SOLADD.19
CLL routine. SOLADD.20
CLL Otherwise follows UM doc paper 4 version 1. SOLADD.21
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.4908
CLL SOLADD.22
CLL This forms part of UM brick P4. SOLADD.23
CLL SOLADD.24
CLL This routine calculates the solar penetration for a water type. SOLADD.25
CLL SOLADD.26
CLL External documentation: SOLADD.27
CLL Programming: Brick P4, paper 2, version number 1. SOLADD.28
CLL SOLADD.29
CLL Subroutine dependencies: SOLADD.30
CLL SOLSET must be called before this routine to set the constants SOLADD.31
CLL SOLADD.32
CLLEND --------------------------------------------------------------- SOLADD.33
C* SOLADD.34
C*L -------------------------- Arguments ---------------------------- SOLADD.35
C SOLADD.36
SUBROUTINE SOLADD (TA,DTWORK, 2JG170893.148
+ SOL, C2DTTS, SOLADD.38
+ SOL_PEN, KFIX, SOLADD.39
+ KM,IMT,NT, SOLADD.40
+ KMT, SOLADD.41
+ DZ, SOLADD.42
+ SPECIFIC_HEAT,RHO_WATER SOLADD.43
+ ) SOLADD.44
C SOLADD.45
IMPLICIT NONE SOLADD.46
C SOLADD.47
*CALL OARRYSIZ 
ORH6F401.23
C Define constants for array sizes SOLADD.48
C SOLADD.49
INTEGER IMT ! IN Number of points per row SOLADD.50
+, KM ! IN Number of layers in model SOLADD.51
+, NT ! IN Number of tracers SOLADD.52
Integer KFIX ! max penetration depth of solar radiation ORH1F304.212
C SOLADD.53
C Physical arguments SOLADD.54
C SOLADD.55
REAL SOLADD.56
+ TA(IMT,KM,NT) ! INOUT Tracer values SOLADD.57
+, DTWORK(IMT,KM) ! OUT Temperature change JG170893.149
&,DTWORKA(IMT,KFIX) ! workspace for temperature change diagnostic JG170893.150
+, SOL (IMT) ! IN Solar heating rate (W/m2) SOLADD.58
+, C2DTTS ! IN Surface timestep SOLADD.59
+, SOL_PEN(IMT,0:KM) !IN Proportion of sol energy at layer base OJP0F404.684
+, DZ (KM) ! IN Thicknesses (scaled by timestep varn) SOLADD.61
+, SPECIFIC_HEAT ! IN Specific heat capacity (SI) SOLADD.62
+, RHO_WATER ! IN Density of sea water (SI) SOLADD.63
SOLADD.64
C SOLADD.65
INTEGER SOLADD.66
+ KMT(IMT) ! IN Number of gridpoints in column ORH1F304.213
*CALL CNTLOCN ORH1F305.4909
! ORH1F305.4911
C* SOLADD.69
C Locally defined variables SOLADD.70
C SOLADD.71
INTEGER SOLADD.72
+ i ! Horizontal loop index SOLADD.73
+, k ! Vertical loop index SOLADD.74
C SOLADD.75
REAL SOLADD.76
+ scale ! Scaling for layer thickness and ht capacity. SOLADD.77
+, convert ! Conversion from SI rate to temp change SOLADD.78
+, dzr (0:KM) ! Reciprocal depth SOLADD.79
+, a ! temporary storage SOLADD.80
C SOLADD.81
CL 1.1 Add in heating to all layers above KFIX SOLADD.82
C SOLADD.83
C Scaling converts form SI heating rate to cgs total heating per SOLADD.84
C unit depth SOLADD.85
C SOLADD.86
scale = 100.0*C2DTTS/SPECIFIC_HEAT/RHO_WATER SOLADD.87
C SOLADD.88
C Calculate reciprocal depths SOLADD.89
C SOLADD.90
dzr(0) = 0.0 SOLADD.91
DO 1100, k = 1, KM SOLADD.92
dzr(k) = 1.0/DZ(k) SOLADD.93
1100 CONTINUE SOLADD.94
C SOLADD.95
DO 1120, k = 1, KFIX SOLADD.96
DO 1110, i = 1, IMT SOLADD.98
convert = (SOL_PEN(i,k-1) - SOL_PEN(i,k))*scale*dzr(k) NT091293.158
TA(i,k,1) = TA(i,k,1) + SOL(i)*convert SOLADD.99
DTWORK(I,K)=SOL(i)*convert JG170893.151
DTWORKA(I,K)=0. JG170893.152
1110 CONTINUE SOLADD.100
1120 CONTINUE SOLADD.101
C SOLADD.102
CL 2.1 Allow for bottom layer above max penetration SOLADD.103
C SOLADD.104
DO 2100, i = 1, IMT SOLADD.105
a=scale*dzr(KMT(i))*SOL(i)*SOL_PEN(i,KMT(i)) NT091293.163
IF (KMT(i).LT.KFIX.AND.KMT(i).GT.0) THEN SOLADD.107
TA(i,KMT(i),1) = TA(i,KMT(i),1) + a SOLADD.108
DTWORKA(i,KMT(i)) = a JG170893.153
END IF SOLADD.109
2100 CONTINUE SOLADD.110
C JG170893.154
DO K=1,KFIX JG170893.155
DO I=1,IMT JG170893.156
DTWORK(I,K)=DTWORK(I,K)+DTWORKA(I,K) JG170893.157
ENDDO JG170893.158
ENDDO JG170893.159
DO K=KFIX+1,KM JG170893.160
DO I=1,IMT JG170893.161
DTWORK(I,K)=0 JG170893.162
ENDDO JG170893.163
ENDDO JG170893.164
C SOLADD.111
CL Return from SOLADD SOLADD.112
C SOLADD.113
RETURN SOLADD.114
END SOLADD.115
*ENDIF @DYALLOC.4659