*IF DEF,S40_1A SLBDIF1A.2
C ******************************COPYRIGHT****************************** GTS2F400.8983
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8984
C GTS2F400.8985
C Use, duplication or disclosure of this code is subject to the GTS2F400.8986
C restrictions as set forth in the contract. GTS2F400.8987
C GTS2F400.8988
C Meteorological Office GTS2F400.8989
C London Road GTS2F400.8990
C BRACKNELL GTS2F400.8991
C Berkshire UK GTS2F400.8992
C RG12 2SZ GTS2F400.8993
C GTS2F400.8994
C If no contract has been raised with this copy of the code, the use, GTS2F400.8995
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8996
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8997
C Modelling at the above address. GTS2F400.8998
C ******************************COPYRIGHT****************************** GTS2F400.8999
C GTS2F400.9000
CLL SLBDIF1A.3
C SUBROUTINE SLABDIFF SLBDIF1A.4
C ------------------- SLBDIF1A.5
C SLBDIF1A.6
CLL THIS ROUTINE IS FOR USE WITH THE 'SLAB' OCEAN MODEL ONLY. SLBDIF1A.7
CLL SLBDIF1A.8
CLL DEL2 DIFFUSION OF SLAB TEMPERATURE, WITH CHECK FOR STABILITY. SLBDIF1A.9
CLL DIFFUSION COEFFICIENT USED IS DEPENDENT ON RESOLUTION SLBDIF1A.10
CLL SUGGESTED VALUES ARE SLBDIF1A.11
CLL SLBDIF1A.12
CLL 4.0E4 FOR 5 X 7.5 DEGREE LAT/LONG SLBDIF1A.13
CLL 2.0E4 FOR 2.5 X 3.75 DEGREE LAT/LONG SLBDIF1A.14
CLL SLBDIF1A.15
CLL THIS ROUTINE FORMS PART OF SYSTEM COMPONENT P40. SLBDIF1A.16
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO ANSI SLBDIF1A.17
CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS, THE SLBDIF1A.18
CLL USE OF ENDDO AND DYNAMIC ALLOCATION. SLBDIF1A.19
CLL IT ADHERES TO THE STANDARDS OF DOCUMENTATION PAPER 3, VERSION 5. SLBDIF1A.20
CLL SLBDIF1A.21
CLL ALL QUANTITIES IN THIS ROUTINE ARE IN S.I. UNITS UNLESS SLBDIF1A.22
CLL OTHERWISE STATED. SLBDIF1A.23
CLL SLBDIF1A.24
CLL CALLED BY: UMSLAB SLBDIF1A.25
CLL SLBDIF1A.26
CLL WRITTEN BY C.A.SENIOR (09/9/93) SLBDIF1A.27
CLL MODIFIED BY C.A.SENIOR (27/10/93) to include stability test SLBDIF1A.28
CLL MODIFIED BY C.A.SENIOR (14/12/93) to update to version 3.2 SLBDIF1A.29
CLL MODIFIED BY C.A.SENIOR (17/12/93) after review SLBDIF1A.30
CLL MODIFIED BY C.A.SENIOR (25/02/94) after further review SLBDIF1A.31
CLL VERSION NUMBER 1.1 SLBDIF1A.32
CLL REVIEWER: W.J.INGRAM SLBDIF1A.33
CLL SLBDIF1A.34
CLLEND--------------------------------------------------------------- SLBDIF1A.35
C SLBDIF1A.36
SUBROUTINE SLABDIFF(SLABTEMP, 2SLBDIF1A.37
+ OPENSEA, SLBDIF1A.38
+ L1,L2, SLBDIF1A.39
+ JROWS, SLBDIF1A.40
+ ICOLS, SLBDIF1A.41
+ AHDT, SLBDIF1A.42
+ DELTA_LONG,DELTA_LAT,BASE_LAT, SLBDIF1A.43
+ COS_P_LATITUDE,COS_U_LATITUDE,SEC_P_LATITUDE) SLBDIF1A.44
SLBDIF1A.45
INTEGER L1 ! IN SIZE OF DATA VECTORS SLBDIF1A.46
+,L2 ! IN AMOUNT OF DATA TO BE PROCESSED SLBDIF1A.47
+,JROWS ! IN NO OF ROWS N-S SLBDIF1A.48
+,ICOLS ! IN NO OF COLUMNS E-W SLBDIF1A.49
REAL SLBDIF1A.50
+ SLABTEMP(ICOLS,JROWS) ! INOUT HEAT CONTENT OF THE SLAB SLBDIF1A.51
+,DT ! IN TIMESTEP FOR UPDATING SLAB MODEL SLBDIF1A.52
+,DELTA_LONG ! IN EW GRID SPACING (DEGREES) SLBDIF1A.53
+,DELTA_LAT ! IN NS GRID SPACING (DEGREES) SLBDIF1A.54
+,BASE_LAT ! IN LATITUDE OF FIRST ROW (DEGREES) SLBDIF1A.55
+,AHDT ! DIFFUSION COEFFICENT * TIMESTEP SLBDIF1A.56
C SLBDIF1A.57
REAL SLBDIF1A.58
+ COS_U_LATITUDE(ICOLS,JROWS) ! COSINE OF LATITUDE ON U GRID SLBDIF1A.59
+,COS_P_LATITUDE(ICOLS,JROWS) ! COSINE OF LATITUDE ON P GRID SLBDIF1A.60
+,SEC_P_LATITUDE(ICOLS,JROWS) ! 1/COS_P_LATITUDE SLBDIF1A.61
C SLBDIF1A.62
LOGICAL SLBDIF1A.63
+ OPENSEA(ICOLS,JROWS) ! IN TRUE IF BOX CONTAINS ICE FREE SEA SLBDIF1A.64
+ ! POINTS, FALSE AT LAND/SEA_ICE POINTS SLBDIF1A.65
C SLBDIF1A.66
C Include Comdecks SLBDIF1A.67
*CALL C_A 
SLBDIF1A.68
*CALL C_PI SLBDIF1A.69
C SLBDIF1A.70
C Local variables SLBDIF1A.71
C SLBDIF1A.72
INTEGER SLBDIF1A.73
+ ICOLSM1 ! ICOLS MINUS 1 SLBDIF1A.74
+,JROWSM1 ! JROWS MINUS 1. SLBDIF1A.75
+,J ! LOOPCOUNTER SLBDIF1A.76
+,I ! LOOPCOUNTER SLBDIF1A.77
REAL SLBDIF1A.78
+ ZMASK(ICOLS,JROWS) ! MASK,1=OPEN SEA,0=LAND+SEA-ICE SLBDIF1A.79
+,DYT ! GRID SPACING N-S SLBDIF1A.80
+,DXT ! GRID SPACING E-W SLBDIF1A.81
+,DYTR ! 1/DYT SLBDIF1A.82
+,DXT2R ! 1/(2*DXT) SLBDIF1A.83
+,DIFFUS(ICOLS,JROWS) ! DIFFUSION INCREMENT SLBDIF1A.84
+,ROWCOEF ! COS WEIGHTED COEFF. E-W SLBDIF1A.85
+,COLCOEF_J ! COS WEIGHTED COEFF. N-S AT ROW J SLBDIF1A.86
+,COLCOEF_JM1 ! COS WEIGHTED COEFF. N-S AT ROW J-1 SLBDIF1A.87
+,TEMPA(ICOLS) ! E-W DIFUSION INCREMENTS SLBDIF1A.88
+,STABLT ! STABILITY COEFFICENT SLBDIF1A.89
C SLBDIF1A.90
PARAMETER ( STABLT= 0.1) ! STABILITY COEFFICIENT SLBDIF1A.91
C SLBDIF1A.92
C INITIALISE CONSTANTS. SLBDIF1A.93
C SLBDIF1A.94
JROWSM1 = JROWS-1 SLBDIF1A.95
ICOLSM1 = ICOLS-1 SLBDIF1A.96
C SLBDIF1A.97
C SET UP REAL OPEN SEA MASK AND EXCLUDE POLAR ROWS SLBDIF1A.98
C SLBDIF1A.99
DO J = 2,JROWSM1 SLBDIF1A.100
DO I = 1,ICOLS SLBDIF1A.101
IF ( OPENSEA(I,J) ) THEN SLBDIF1A.102
ZMASK(I,J) = 1.0 SLBDIF1A.103
ELSE SLBDIF1A.104
ZMASK(I,J) = 0.0 SLBDIF1A.105
ENDIF SLBDIF1A.106
ENDDO SLBDIF1A.107
ENDDO SLBDIF1A.108
DO I = 1,ICOLS SLBDIF1A.109
ZMASK(I,1) = 0 SLBDIF1A.110
ZMASK(I,JROWS) = 0 SLBDIF1A.111
ENDDO SLBDIF1A.112
C SLBDIF1A.113
C CALCULATE GRID SPACINGS IN RADIANS SLBDIF1A.114
C SLBDIF1A.115
C SLBDIF1A.116
DYT = DELTA_LAT * A / RECIP_PI_OVER_180 SLBDIF1A.117
DXT = DELTA_LONG * A / RECIP_PI_OVER_180 SLBDIF1A.118
DYTR = 1. / DYT SLBDIF1A.119
DXT2R = .5/DXT SLBDIF1A.120
C SLBDIF1A.121
C CALCULATE COEFFICIENTS SLBDIF1A.122
C SLBDIF1A.123
DO J = 2,JROWSM1 SLBDIF1A.124
ROWCOEF = 4.0 * AHDT * SEC_P_LATITUDE(1,J) SLBDIF1A.125
& * SEC_P_LATITUDE(1,J) * DXT2R SLBDIF1A.126
C SLBDIF1A.127
C CHECK STABILITY AND RESET ROWCOEF IF UNSTABLE SLBDIF1A.128
C SLBDIF1A.129
IF (ROWCOEF * DXT2R .GT. STABLT) ROWCOEF = STABLT / DXT2R SLBDIF1A.130
C SLBDIF1A.131
COLCOEF_J = AHDT * COS_U_LATITUDE(1,J) SLBDIF1A.132
& * DYTR * DYTR * SEC_P_LATITUDE(1,J) SLBDIF1A.133
COLCOEF_JM1 = AHDT * COS_U_LATITUDE(1,J-1) SLBDIF1A.134
& * DYTR * DYTR * SEC_P_LATITUDE(1,J) SLBDIF1A.135
C SLBDIF1A.136
C SLBDIF1A.137
C CALCULATE DIFFUSION INCREMENTS USING DEL2 SLBDIF1A.138
C SLBDIF1A.139
C 1. E-W INCREMENTS SLBDIF1A.140
C SLBDIF1A.141
DO I = 2,ICOLS SLBDIF1A.142
TEMPA(I) = DXT2R * ( SLABTEMP(I,J) - SLABTEMP(I-1,J) ) SLBDIF1A.143
END DO SLBDIF1A.144
TEMPA (1) = DXT2R * (SLABTEMP(1,J) - SLABTEMP(ICOLS,J) ) SLBDIF1A.145
C SLBDIF1A.146
C 2. ADD IN N-S INCREMENTS SLBDIF1A.147
C SLBDIF1A.148
DO I = 2,ICOLSM1 SLBDIF1A.149
DIFFUS(I,J) = ROWCOEF SLBDIF1A.150
& * ( ZMASK(I+1,J) * TEMPA(I+1) - ZMASK(I-1,J) * TEMPA(I)) SLBDIF1A.151
& + COLCOEF_J SLBDIF1A.152
& * ZMASK(I,J+1) * ( SLABTEMP(I,J+1) - SLABTEMP(I,J) ) SLBDIF1A.153
& + COLCOEF_JM1 SLBDIF1A.154
& * ZMASK(I,J-1) * ( SLABTEMP(I,J-1) - SLABTEMP(I,J) ) SLBDIF1A.155
END DO SLBDIF1A.156
C SLBDIF1A.157
C CALCULATE DIFFUSION INCREMENTS AT 1ST AND LAST COLUMNS SLBDIF1A.158
C SLBDIF1A.159
DIFFUS(1,J) = ROWCOEF SLBDIF1A.160
& * ( ZMASK(2,J) * TEMPA(2) - ZMASK(ICOLS,J) * TEMPA(1) ) SLBDIF1A.161
& + COLCOEF_J SLBDIF1A.162
& * ZMASK(1,J+1) * ( SLABTEMP(1,J+1) - SLABTEMP(1,J) ) SLBDIF1A.163
& + COLCOEF_JM1 SLBDIF1A.164
& * ZMASK(1,J-1) * ( SLABTEMP(1,J-1) - SLABTEMP(1,J) ) SLBDIF1A.165
C SLBDIF1A.166
DIFFUS(ICOLS,J) = ROWCOEF SLBDIF1A.167
& * ( ZMASK(1,J) * TEMPA(1) - ZMASK(ICOLSM1,J) * TEMPA(ICOLS)) SLBDIF1A.168
& + COLCOEF_J SLBDIF1A.169
& * ZMASK(ICOLS,J+1) * (SLABTEMP(ICOLS,J+1) SLBDIF1A.170
& -SLABTEMP(ICOLS,J)) SLBDIF1A.171
& + COLCOEF_JM1 SLBDIF1A.172
& * ZMASK(ICOLS,J-1) * (SLABTEMP (ICOLS,J-1) SLBDIF1A.173
& - SLABTEMP(ICOLS,J) ) SLBDIF1A.174
END DO SLBDIF1A.175
C SLBDIF1A.176
C ADD IN DIFFUSION INCREMENTS. SLBDIF1A.177
C MULTIPLY BY ZMASK SO DIFFUSION ONLY ADDED AT OPEN SEA POINTS SLBDIF1A.178
C DO NOT RESET POLAR ROWS TO MAINTAIN CONSERVANCY SLBDIF1A.179
C SLBDIF1A.180
DO J = 2,JROWSM1 SLBDIF1A.181
DO I = 1,ICOLS SLBDIF1A.182
SLABTEMP(I,J) = SLABTEMP(I,J) + DIFFUS(I,J) * ZMASK(I,J) SLBDIF1A.183
END DO SLBDIF1A.184
END DO SLBDIF1A.185
RETURN SLBDIF1A.186
END SLBDIF1A.187
*ENDIF SLBDIF1A.188