*IF DEF,OCEAN @DYALLOC.4656
C ******************************COPYRIGHT****************************** GTS2F400.9343
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9344
C GTS2F400.9345
C Use, duplication or disclosure of this code is subject to the GTS2F400.9346
C restrictions as set forth in the contract. GTS2F400.9347
C GTS2F400.9348
C Meteorological Office GTS2F400.9349
C London Road GTS2F400.9350
C BRACKNELL GTS2F400.9351
C Berkshire UK GTS2F400.9352
C RG12 2SZ GTS2F400.9353
C GTS2F400.9354
C If no contract has been raised with this copy of the code, the use, GTS2F400.9355
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9356
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9357
C Modelling at the above address. GTS2F400.9358
C ******************************COPYRIGHT****************************** GTS2F400.9359
C GTS2F400.9360
C*LL SOLSET.3
CLL Subroutine SOLSET SOLSET.4
CLL Can run on any FORTRAN 77 compiler with long lower case variables SOLSET.5
CLL SOLSET.6
CLL The code must be pre-compiled by the UPDOC system. SOLSET.7
CLL Option E selects the solar heating code. SOLSET.8
CLL Option A indicates that the Unified Model version is to be used. SOLSET.9
CLL The default is the COX standard code. SOLSET.10
CLL SOLSET.11
CLL Author: S J Foreman SOLSET.12
CLL Date: 8 February 1990 SOLSET.13
CLL Reviewer: J O S Alves SOLSET.14
CLL Review date: 24 July 1990 SOLSET.15
CLL Version 1.00 date 8 February 1990 SOLSET.16
CLL SOLSET.17
CLL Programming standards use Cox naming convention for Cox variables SOLSET.18
CLL with the addition that lower case variables are local to the SOLSET.19
CLL routine. SOLSET.20
CLL Otherwise follows UM doc paper 4 version 1. SOLSET.21
CLL SOLSET.22
CLL This forms part of UM brick P4. SOLSET.23
CLL SOLSET.24
CLL This routine calculates the solar penetration for a water type. SOLSET.25
CLL SOLSET.26
CLL External documentation: Water type 1B of Jerlov (1968) assumed; SOLSET.27
CLL penetration double exponential (Paulson & Simpson (1977)) SOLSET.28
CLL SOLSET.29
CLL Programming: Brick P4, paper 2, version number 1. SOLSET.30
CLL SOLSET.31
CLL Subroutine dependencies: EXP SOLSET.32
CLL SOLSET.33
CLLEND --------------------------------------------------------------- SOLSET.34
C* SOLSET.35
C*L -------------------------- Arguments ---------------------------- SOLSET.36
C SOLSET.37
SUBROUTINE SOLSET (SOL_PEN, RSOL, ETA1, ETA2, KFIX, 1SOLSET.38
+ KM, SOLSET.39
+ DZ, ZDZ SOLSET.40
+ ) SOLSET.41
C SOLSET.42
IMPLICIT NONE SOLSET.43
C SOLSET.44
C Define constants for array sizes SOLSET.45
C SOLSET.46
INTEGER SOLSET.47
+ KM ! IN Number of layers in model SOLSET.48
C SOLSET.49
C Physical arguments SOLSET.50
C SOLSET.51
REAL SOLSET.52
+ SOL_PEN (0:KM) ! OUT Proportion of solar energy at layer base SOLSET.53
+, RSOL ! IN Ratio of solar components SOLSET.54
+, ETA1 ! IN Penetration scale of first component SOLSET.55
+, ETA2 ! IN Penetration scale of second component SOLSET.56
+, DZ (KM) ! IN Layer thicknesses SOLSET.57
+, ZDZ (KM) ! IN Layer bases SOLSET.58
C SOLSET.59
INTEGER SOLSET.60
+ KFIX ! OUT Layer to which solar heating penetrates SOLSET.61
C* SOLSET.62
C*L ------------ External subroutines called ------------------------ SOLSET.63
INTRINSIC SOLSET.64
+ EXP ! Intrinsic function SOLSET.65
C* ----------------------------------------------------------------- SOLSET.66
C SOLSET.67
C Locally defined variables SOLSET.68
C SOLSET.69
INTEGER SOLSET.70
+ k ! Vertical index SOLSET.71
+, k_temp ! Temporary store for level number SOLSET.72
C SOLSET.73
REAL SOLSET.74
+ a, b, c, d ! Temporary values for exponentials SOLSET.75
C SOLSET.76
CL 1.1 Define values of physical constants SOLSET.77
CL 2.1 Calculate layer of max penetration (200m). SOLSET.78
C SOLSET.79
k_temp = 1 SOLSET.80
DO 2100, k = 1, KM SOLSET.81
k_temp = k SOLSET.82
IF (ZDZ(k).GT.200.0E2) GO TO 2110 SOLSET.83
2100 CONTINUE SOLSET.84
2110 CONTINUE SOLSET.85
KFIX = k_temp SOLSET.86
C SOLSET.87
C 2.2 Calculate proportion of radiation reaching base of layer SOLSET.88
C SOLSET.89
SOL_PEN(0) = 1.0 SOLSET.90
DO 2200, k = 1, (KFIX-1) SOLSET.91
a = -ETA1*ZDZ(k)/100. SOLSET.92
b = -ETA2*ZDZ(k)/100. SOLSET.93
IF (a.lt.-180.0) THEN SOLSET.94
c = 0.0 SOLSET.95
ELSE SOLSET.96
c = EXP(a) SOLSET.97
END IF SOLSET.98
IF (b.lt.-180.0) THEN SOLSET.99
d = 0.0 SOLSET.100
ELSE SOLSET.101
d = EXP(b) SOLSET.102
END IF SOLSET.103
SOL_PEN(k) = RSOL*c + (1.0-RSOL)*d SOLSET.104
2200 CONTINUE SOLSET.105
DO 2210, k = KFIX, KM SOLSET.106
SOL_PEN(k) = 0.0 SOLSET.107
2210 CONTINUE SOLSET.108
C SOLSET.109
CL Return from SOLSET SOLSET.110
C SOLSET.111
RETURN SOLSET.112
END SOLSET.113
C SOLSET.114
*ENDIF @DYALLOC.4657