*IF DEF,S40_1A SJC0F305.2
C ******************************COPYRIGHT****************************** GTS2F400.9199
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9200
C GTS2F400.9201
C Use, duplication or disclosure of this code is subject to the GTS2F400.9202
C restrictions as set forth in the contract. GTS2F400.9203
C GTS2F400.9204
C Meteorological Office GTS2F400.9205
C London Road GTS2F400.9206
C BRACKNELL GTS2F400.9207
C Berkshire UK GTS2F400.9208
C RG12 2SZ GTS2F400.9209
C GTS2F400.9210
C If no contract has been raised with this copy of the code, the use, GTS2F400.9211
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9212
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9213
C Modelling at the above address. GTS2F400.9214
C ******************************COPYRIGHT****************************** GTS2F400.9215
C GTS2F400.9216
C*LL SLBTUV.3
CLL SUBROUTINE SLAB_T_UV SLBTUV.4
CLL ------------------- SLBTUV.5
CLL SLBTUV.6
CLL INTERPOLATES U AND V CURRENTS ONTO ARAKAWA C GRID SLBTUV.7
CLL BEFORE CALLING SLAB TEMPERTURE ADVECTION SLBTUV.8
CLL CALLED FROM UMSLAB SLBTUV.9
CLL SLBTUV.10
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO ANSI SLBTUV.11
CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS. SLBTUV.12
CLL SLBTUV.13
CLL ALL QUANTITIES IN THIS ROUTINE ARE IN S.I. UNITS UNLESS SLBTUV.14
CLL OTHERWISE STATED. SLBTUV.15
CLL SLBTUV.16
CLL WRITTEN BY R.E.CARNELL (05/07/94) SLBTUV.17
CLL SLBTUV.18
CLL SLBTUV.19
CLL MODEL MODIFICATION HISTORY SINCE INSERTION IN UM 3.4: SLBTUV.20
CLL VERSION DATE SLBTUV.21
CLL SLBTUV.22
CLL 4.0 Added vertical SST advection. R.CArnell(J.Crossley) SJC1F400.553
!LL 4.4 04/08/97 Add missing ARGOINDX to various argument lists. SDR1F404.169
!LL D. Robinson. SDR1F404.170
CLL SLBTUV.23
CLL ADHERES TO THE STANDARDS OF MET. DYNAMICS SUBROUTINES. SLBTUV.24
CLLEND--------------------------------------------------------------- SLBTUV.25
C*L SLBTUV.26
subroutine slab_t_uv( 1,3SLBTUV.27
*CALL ARGOINDX 
SDR1F404.171
C in : model data and atmos/ancillary fields. SLBTUV.29
& l1,l2,icols,jrows,jrowsm1,landmask SLBTUV.30
&,lglobal,u_field,dz1 SJC1F400.554
&,delta_lat,delta_long,base_lat,timestep SLBTUV.32
&,cos_u_latitude,cos_p_latitude SLBTUV.33
&,sec_p_latitude SLBTUV.34
&,sin_u_latitude SLBTUV.35
&,ucurrent,vcurrent SLBTUV.36
C SLBTUV.37
C inout : primary variables SLBTUV.38
&,slabtemp SLBTUV.39
&,opensea SLBTUV.40
C SLBTUV.41
C out : diagnostics SLBTUV.42
&,wtsfc SJC1F400.555
&,wtbase SJC1F400.556
& ) SLBTUV.43
C SLBTUV.44
implicit none SLBTUV.45
C SLBTUV.46
*CALL TYPOINDX SDR1F404.172
integer SLBTUV.47
& l1 ! in size of data vectors SLBTUV.48
&,l2 ! in amount of data to be processed SLBTUV.49
&,icols ! in number of columns EW SLBTUV.50
&,jrows ! in number of rows NS SLBTUV.51
&,jrowsm1 ! in number of rows NS - 1 SLBTUV.52
&,dz1 ! in depth of slab ocean SJC1F400.557
&,u_field ! in points in u_field SJC1F400.558
logical SLBTUV.53
& lglobal ! in true if model is global SLBTUV.54
&,landmask(icols,jrows) ! in mask true at land points SLBTUV.55
&,opensea(icols,jrows) ! in true if open sea (no ice) SLBTUV.56
real SLBTUV.57
& delta_lat ! in meridional grid spacing deg SLBTUV.58
&,delta_long ! in zonal grid spacing in degrees SLBTUV.59
&,base_lat ! in base latitude in degrees SLBTUV.60
&,timestep ! in slab timestep in seconds SLBTUV.61
&,cos_p_latitude(icols,jrows) ! in cosine of latitude on p grid SLBTUV.62
&,cos_u_latitude(icols,jrowsm1)! in cosine of latitude on uv grid SLBTUV.63
&,sec_p_latitude(icols,jrows) ! in secont of latitude on p grid SLBTUV.64
&,sin_u_latitude(icols,jrowsm1)! in sine of latitude on uv grid SLBTUV.65
&,ucurrent(icols,jrowsm1) ! in zonal surface current (M/S) SLBTUV.66
&,vcurrent(icols,jrowsm1) ! in meridional sfc current (M/S) SLBTUV.67
&,slabtemp(icols,jrows) ! inout slab ocean temperature C SLBTUV.68
&,wtsfc(icols,jrows) ! out w x slab temp at surface SJC1F400.559
&,wtbase(icols,jrows) ! out w x slab temp at base SJC1F400.560
C SLBTUV.69
C Global UM parameters SLBTUV.70
*CALL C_A SLBTUV.71
*CALL C_MDI SLBTUV.72
*CALL C_PI SLBTUV.73
C SLBTUV.74
C variables local to this subroutine are now defined SLBTUV.75
C SLBTUV.76
integer SLBTUV.77
& i,j ! loop counters SLBTUV.78
&,icolsm1 ! number of tracer columns - 1 SLBTUV.79
logical SLBTUV.80
& ocean(icols,jrows) ! true for ocean points on p grid SLBTUV.81
real SLBTUV.82
& uv ! workspace scalar SLBTUV.83
&,dlat_rad ! grid spacing in radians SLBTUV.84
&,dlon_rad ! grid spacing in radians SLBTUV.85
&,tdiff ! slabt_old-slabtemp SLBTUV.86
C SLBTUV.87
real SLBTUV.88
& hmask(icols,jrows) ! 0.0 for land 1.0 for sea at p pts SLBTUV.89
&,tmask(icols,jrows) ! 1.0 for opensea 0.0 ice/land p pts SLBTUV.90
&,umask(icols,jrowsm1) ! 0.0 for uv land 1.0 for sea uv pts SLBTUV.91
C SLBTUV.92
real SLBTUV.93
& ucurrent_c(icols,jrowsm1) ! u current on C grid SLBTUV.94
&,vcurrent_c(icols,jrowsm1) ! v current on C grid SLBTUV.95
&,slabt_old(icols,jrows) ! initial slabtemp SLBTUV.96
&,slabt_work(icols,jrows) ! slabtemp (no mdi) SLBTUV.97
C* SLBTUV.98
C start executable code SLBTUV.99
C SLBTUV.100
C initialise various constants. SLBTUV.101
icolsm1 = icols-1 SLBTUV.102
dlat_rad = delta_lat * pi_over_180 SLBTUV.103
dlon_rad = delta_long * pi_over_180 SLBTUV.104
C SLBTUV.105
C First set up land sea and ice-free sea masks SLBTUV.106
C SLBTUV.107
do j = 1,jrows SLBTUV.108
do i = 1,icols SLBTUV.109
ocean(i,j) = .not.landmask(i,j) SLBTUV.110
hmask(i,j) = 0.0 SLBTUV.111
if (ocean(i,j)) hmask(i,j) = 1.0 SLBTUV.112
tmask(i,j) = 0.0 SLBTUV.113
if (opensea(i,j)) tmask(i,j) = 1.0 SLBTUV.114
slabt_work(i,j) = slabtemp(i,j) SLBTUV.115
if (slabt_work(i,j).eq.rmdi) slabt_work(i,j) = 0.0 SLBTUV.116
end do SLBTUV.117
end do SLBTUV.118
C SLBTUV.119
C Calculate Arakawa B grid velocity mask. SLBTUV.120
do j = 1,jrowsm1 SLBTUV.121
do i = 1,icolsm1 SLBTUV.122
umask(i,j) = 1.0 SLBTUV.123
uv = hmask(i,j)+hmask(i+1,j)+hmask(i,j+1)+hmask(i+1,j+1) SLBTUV.124
if (uv.lt.3.5) umask(i,j) = 0.0 SLBTUV.125
end do SLBTUV.126
if (lglobal) then SLBTUV.127
umask(icols,j) = 1.0 SLBTUV.128
uv = hmask(icols,j)+hmask(icols,j+1)+hmask(1,j)+hmask(1,j+1) SLBTUV.129
if (uv.lt.3.5) umask(icols,j) = 0.0 SLBTUV.130
else SLBTUV.131
umask(icols,j) = 0.0 ! what should i do here ? SLBTUV.132
endif SLBTUV.133
end do SLBTUV.134
do j=1,jrowsm1 SLBTUV.135
do i=1,icols SLBTUV.136
ucurrent(i,j) = ucurrent(i,j)*umask(i,j) SLBTUV.137
vcurrent(i,j) = vcurrent(i,j)*umask(i,j) SLBTUV.138
end do SLBTUV.139
end do SLBTUV.140
c SLBTUV.141
C Interpolate currents to C grid. SLBTUV.142
c SLBTUV.143
call uv_to_cu( SDR1F404.173
*CALL ARGOINDX SDR1F404.174
& ucurrent,ucurrent_c,jrowsm1,icols) SDR1F404.175
call uv_to_cv( SDR1F404.176
*CALL ARGOINDX SDR1F404.177
& vcurrent,vcurrent_c,jrowsm1,icols) SDR1F404.178
c SLBTUV.146
C Copy initial slabt temp to workspace SLBTUV.147
c SLBTUV.148
do j=1,jrows SLBTUV.149
do i=1,icols SLBTUV.150
slabt_old(i,j) = slabtemp(i,j) SLBTUV.151
end do SLBTUV.152
end do SLBTUV.153
C SLBTUV.154
C Call slab_temp_advect to advect slab temperature. SLBTUV.155
C SLBTUV.156
call slab_temp_advect( SLBTUV.157
& L1,u_field,landmask SJC1F400.561
&,icols,jrows,jrowsm1,lglobal,dlat_rad,dlon_rad,timestep,a,dz1 SJC1F400.562
&,ucurrent_c,vcurrent_c,tmask,opensea,cos_p_latitude SLBTUV.159
&,sec_p_latitude,cos_u_latitude SJC1F400.563
&,sin_u_latitude,slabt_work,wtsfc,wtbase SJC1F400.564
& ) SLBTUV.161
C SLBTUV.162
C copy work variables to primary space SLBTUV.163
C SLBTUV.164
do j=1,jrows SLBTUV.165
do i=1,icols SLBTUV.166
if (tmask(i,j) .eq. 1.0) slabtemp(i,j)=slabt_work(i,j) SLBTUV.167
end do SLBTUV.168
end do SLBTUV.169
return SLBTUV.170
end SLBTUV.171
*ENDIF SLBTUV.172