*IF DEF,SEAICE ORH1F305.466
C ******************************COPYRIGHT****************************** GTS2F400.7741
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7742
C GTS2F400.7743
C Use, duplication or disclosure of this code is subject to the GTS2F400.7744
C restrictions as set forth in the contract. GTS2F400.7745
C GTS2F400.7746
C Meteorological Office GTS2F400.7747
C London Road GTS2F400.7748
C BRACKNELL GTS2F400.7749
C Berkshire UK GTS2F400.7750
C RG12 2SZ GTS2F400.7751
C GTS2F400.7752
C If no contract has been raised with this copy of the code, the use, GTS2F400.7753
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7754
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7755
C Modelling at the above address. GTS2F400.7756
C ******************************COPYRIGHT****************************** GTS2F400.7757
C GTS2F400.7758
C*LL PSEUDAIR.3
CLL SUBROUTINE PSEUDAIR PSEUDAIR.4
CLL ------------------- PSEUDAIR.5
CLL PSEUDAIR.6
CLL PSEUDO ATMOSPHERIC MODEL TO PROVIDE THE OCEAN HALF OF THE PSEUDAIR.7
CLL THERMODYNAMIC SEA ICE MODEL WITH THE FORCING IT EXPECTS. PSEUDAIR.8
CLL PSEUDAIR.9
CLL THIS ROUTINE FORMS PART OF SYSTEM COMPONENT P4. PSEUDAIR.10
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO ANSI PSEUDAIR.11
CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS. PSEUDAIR.12
CLL IT ADHERES TO THE STANDARDS OF DOCUMENTATION PAPER 4, VERSION 1. PSEUDAIR.13
CLL PSEUDAIR.14
CLL ALL QUANTITIES IN THIS ROUTINE ARE IN S.I. UNITS UNLESS PSEUDAIR.15
CLL OTHERWISE STATED. PSEUDAIR.16
CLL PSEUDAIR.17
CLL WRITTEN BY J.F.THOMSON (18/01/91) PSEUDAIR.18
CLL VERSION NUMBER 1.1 PSEUDAIR.19
CLL REVIEWED BY H.CATTLE (22/02/91) PSEUDAIR.20
CLL PSEUDAIR.21
! Modification History: ORH1F305.4889
! Version Date Details ORH1F305.4890
! ------- ------- ------------------------------------------ ORH1F305.4891
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.4892
! 4.0 Removed redundant variables. J.F.Crossley OJC3F400.26
! 4.0 Weight heatflux by ice fraction in models OJC2F400.1
! with ice dynamics. J.F.Crossley OJC2F400.2
! 4.5 10.08/97 New dynamic ice control logicals ODC1F405.385
CLLEND--------------------------------------------------------------- PSEUDAIR.22
C*L PSEUDAIR.23
SUBROUTINE PSEUDAIR( 1PSEUDAIR.24
*CALL ARGOINDX 
ORH7F402.117
C INOUT : PRIMARY VARIABLES. PSEUDAIR.26
& ICY PSEUDAIR.27
&,AICE PSEUDAIR.28
&,HICE PSEUDAIR.29
&,HSNOW PSEUDAIR.30
C PSEUDAIR.31
C IN : CLIMATOLOGICAL FORCING DATA. PSEUDAIR.32
&,SOLICE PSEUDAIR.33
&,TAIR PSEUDAIR.34
C PSEUDAIR.36
C OUT : FIELDS REQUIRED BY ICEFLOE - CALCULATED FROM FORCING DATA. PSEUDAIR.37
&,TOPMELT PSEUDAIR.38
&,BOTMELT PSEUDAIR.39
&,HEATFLUX PSEUDAIR.40
&,SOLARFLX PSEUDAIR.41
C PSEUDAIR.43
C IN : CONSTANTS REQUIRED BY PSEUDAIR. PSEUDAIR.44
C PSEUDAIR.45
&,TFREEZE PSEUDAIR.46
&,RHOCP PSEUDAIR.47
&,IMT PSEUDAIR.48
&,JMT PSEUDAIR.49
& ) PSEUDAIR.50
C PSEUDAIR.51
IMPLICIT NONE PSEUDAIR.52
C PSEUDAIR.53
*CALL CNTLOCN ORH1F305.4893
*CALL TYPOINDX ORH7F402.118
C PSEUDAIR.54
INTEGER PSEUDAIR.55
& IMT ! NUMBER OF POINTS IN A ROW. PSEUDAIR.56
&,JMT ! NUMBER OF POINTS IN A COLUMN. PSEUDAIR.57
REAL PSEUDAIR.58
& AICE(IMT,JMT) ! FRACTIONAL ICE CONCENTRATION. PSEUDAIR.59
&,HICE(IMT,JMT) ! ICE DEPTH AVERAGED OVER GRID SQUARE (IN M). PSEUDAIR.60
&,HSNOW(IMT,JMT) ! SNOW DEPTH OVER ICE FRACTION ONLY (IN M). PSEUDAIR.61
&,SOLICE(IMT,JMT) ! INCIDENT SOLAR RADIATION (IN W M-2)) PSEUDAIR.62
&,TAIR(IMT,JMT) ! SURFACE AIR TEMPERATURE (IN CELSIUS) PSEUDAIR.63
&,TOPMELT(IMT,JMT) ! RATE OF MELTING OF SNOW (IN W M-2) PSEUDAIR.65
& ! CAN BE TRANSFERRED TO ICE PSEUDAIR.66
&,BOTMELT(IMT,JMT) ! DIFFUSIVE HEAT FLUX THROUGH ICE. IF THE PSEUDAIR.67
& ! DIFFERENCE BETWEEN THIS AND OCEANFLX PSEUDAIR.68
& ! IS +VE, ICE MELTS AT THE BASE. IF IT IS PSEUDAIR.69
& ! -VE ICE ACCRETES THERE. (IN W M-2) PSEUDAIR.70
&,HEATFLUX(IMT,JMT) ! NET NON-PENETRATIVE HEAT FLUX OVER LEADS. PSEUDAIR.71
& ! (IN W M-2) PSEUDAIR.72
&,SOLARFLX(IMT,JMT) ! NET PENETRATIVE HEAT FLUX OVER LEADS. PSEUDAIR.73
& ! (IN W M-2) PSEUDAIR.74
LOGICAL PSEUDAIR.76
& ICY(IMT,JMT) ! TRUE IF BOX CONTAINS ICE. PSEUDAIR.77
REAL PSEUDAIR.78
& TFREEZE ! FREEZING POINT OF SEA WATER (IN CELSIUS) PSEUDAIR.79
&,RHOCP ! VOLUMETRIC HEAT CAPACITY OF WATER PSEUDAIR.80
& ! (IN J K-1 M-3) PSEUDAIR.81
C PSEUDAIR.82
C VARIABLES LOCAL TO THIS SUBROUTINE ARE NOW DEFINED PSEUDAIR.83
C PSEUDAIR.84
LOGICAL PSEUDAIR.85
& LSNOW(IMT,JMT) ! TRUE IF A GRID BOX CONTAINS MORE THAN THE PSEUDAIR.86
& ! MINIMUM SNOW DEPTH PSEUDAIR.87
&,LNOSNOW(IMT,JMT) ! TRUE FOR ICY BOXES WITH SNOWDEPTH LESS THAN PSEUDAIR.88
& ! MINIMUM SNOW DEPTH PSEUDAIR.89
&,LMELT(IMT,JMT) ! TRUE FOR ICY BOXES WHERE SURFACE IS MELTING PSEUDAIR.90
REAL PSEUDAIR.91
& RGAMMA(IMT,JMT) ! THERMAL RESISTANCE OF ICE&SNOW COMBINATION. PSEUDAIR.92
&,GAMMA(IMT,JMT) ! RECIPROCAL OF RGAMMA (IN W M-2 K-1.) PSEUDAIR.93
&,ATMSFLUX(IMT,JMT) ! TOTAL NET SURFACE HEAT FLUX OVER LEADS. PSEUDAIR.94
& ! (IN W M-2) PSEUDAIR.95
&,COALB(IMT,JMT) ! SURFACE COALBEDOS. (1 - ALBEDO) PSEUDAIR.96
&,TESTMELT(IMT,JMT) ! ARRAY FOR DECIDING IF MELTING IS HAPPENING. PSEUDAIR.97
&,COALBEDO(5) ! COALBEDOS OF : 1 DRY SNOW PSEUDAIR.98
& ! 2 MELTING SNOW PSEUDAIR.99
& ! 3 DRY SNOW-FREE ICE PSEUDAIR.100
& ! 4 MELTING ICE PSEUDAIR.101
& ! 5 LEADS PSEUDAIR.102
C PSEUDAIR.103
C DEFINE LOCAL PARAMETERS PSEUDAIR.104
INTEGER PSEUDAIR.105
& IMTM1 ! NUMBER OF POINTS IN A ROW MINUS 1. PSEUDAIR.106
REAL PSEUDAIR.107
& HSNOWMIN ! MIN. DEPTH OF SNOW WHICH AFFECTS ALBEDO. PSEUDAIR.108
&,HANEY ! HANEY COEFFICIENT (IN W M-2 K-1). PSEUDAIR.109
&,RHANEY ! RECIPROCAL OF HANEY. PSEUDAIR.110
&,CONDICE ! THERMAL CONDUCTIVITY OF ICE (IN W M-1 K-1). PSEUDAIR.111
&,RCONDICE ! RECIPROCAL OF CONDICE. PSEUDAIR.112
&,CONDSNO ! THERMAL CONDUCTIVITY OF SNOW (IN W M-1 K-1). PSEUDAIR.113
&,RCONDSNO ! RECIPROCAL OF CONDSNO. PSEUDAIR.114
&,CON1 ! RATIO OF TFREEZE AND HANEY. PSEUDAIR.115
&,ZERO ! CONSTANT PSEUDAIR.116
&,ONE ! CONSTANT PSEUDAIR.117
&,THIRTY ! CONSTANT PSEUDAIR.118
&,SIXTYONE ! CONSTANT PSEUDAIR.119
INTEGER PSEUDAIR.120
& I,J ! INDICES FOR DO LOOPS ORH3F405.97
C PSEUDAIR.122
C PSEUDAIR.123
C PSEUDAIR.124
C----------------------------------------------------------------------- PSEUDAIR.125
C----------------------------------------------------------------------- PSEUDAIR.126
C SET VARIOUS CONSTANTS AND ARRAYS PSEUDAIR.127
C PSEUDAIR.128
DATA COALBEDO/0.2,0.35,0.3,0.5,0.94/ PSEUDAIR.129
DATA HSNOWMIN/0.01/ PSEUDAIR.130
C PSEUDAIR.131
C PSEUDAIR.132
IMTM1=IMT - 1 PSEUDAIR.133
ZERO = 0.0 PSEUDAIR.134
ONE = 1.0 PSEUDAIR.135
THIRTY = 30.0 PSEUDAIR.136
SIXTYONE = 61.0 PSEUDAIR.137
HANEY =1.E-5*RHOCP PSEUDAIR.138
RHANEY = ONE/HANEY PSEUDAIR.139
CONDICE = 2.166 PSEUDAIR.140
RCONDICE = ONE/CONDICE PSEUDAIR.141
CONDSNO = 0.3299 PSEUDAIR.142
RCONDSNO = ONE/CONDSNO PSEUDAIR.143
CON1 = TFREEZE*RHANEY PSEUDAIR.144
C PSEUDAIR.145
C PSEUDAIR.146
C SET UP ARRAYS TO DISTINGUISH ICY BOXES WITH AND WITHOUT THE PSEUDAIR.147
C MINIMUM SNOW COVER REQUIRED TO AFFECT SURFACE ALBEDO. PSEUDAIR.148
C PSEUDAIR.149
DO 10 J=J_1,J_JMT ORH3F402.233
DO 10 I=1,IMT PSEUDAIR.151
LSNOW(I,J) = ICY(I,J).AND.(HSNOW(I,J).GE.HSNOWMIN) PSEUDAIR.152
LNOSNOW(I,J) = ICY(I,J).AND. PSEUDAIR.153
& (HSNOW(I,J).LT.HSNOWMIN) PSEUDAIR.154
C PSEUDAIR.155
C PSEUDAIR.156
10 CONTINUE PSEUDAIR.157
C PSEUDAIR.158
C PSEUDAIR.159
C PSEUDAIR.160
C ---------------------------------------------------------------- PSEUDAIR.161
C BEGIN GRIDPOINT BY GRIDPOINT CALCULATION PSEUDAIR.162
C ---------------------------------------------------------------- PSEUDAIR.163
C PSEUDAIR.164
DO 100 J=J_1,J_JMT ORH3F402.234
DO 100 I=1,IMT PSEUDAIR.166
C PSEUDAIR.167
C ---------------------------------------------------------------- PSEUDAIR.168
C ---------------------------------------------------------------- PSEUDAIR.169
C PSEUDAIR.170
C SET DOWNWARD HEAT FLUXES OVER LEADS,USING PSEUDO-HANEY FORCING. PSEUDAIR.171
C WEIGHT THEM BY THE FRACTIONAL LEAD AREA IN THE SAME WAY AS THE PSEUDAIR.172
C ATMOSPHERIC MODEL WOULD DO. PSEUDAIR.173
C PSEUDAIR.174
IF ( ICY(I,J) ) THEN PSEUDAIR.175
HEATFLUX(I,J) = HANEY*( TAIR(I,J) - TFREEZE ) * (ONE-AICE(I,J)) PSEUDAIR.176
SOLARFLX(I,J) = COALBEDO(5) * SOLICE(I,J) * (ONE-AICE(I,J)) PSEUDAIR.177
ATMSFLUX(I,J) = HEATFLUX(I,J) + SOLARFLX(I,J) PSEUDAIR.178
ELSE PSEUDAIR.179
HEATFLUX(I,J) = ZERO PSEUDAIR.180
SOLARFLX(I,J) = ZERO PSEUDAIR.181
ATMSFLUX(I,J) = ZERO PSEUDAIR.182
ENDIF PSEUDAIR.183
C PSEUDAIR.184
C FILL UP COALBEDO ARRAY ASSUMING NO SURFACE MELTING PSEUDAIR.185
C PSEUDAIR.186
IF (LNOSNOW(I,J)) THEN PSEUDAIR.187
COALB(I,J) = COALBEDO(3) PSEUDAIR.188
ELSEIF (LSNOW(I,J)) THEN PSEUDAIR.189
COALB(I,J) = COALBEDO(1) PSEUDAIR.190
ENDIF PSEUDAIR.191
C PSEUDAIR.192
C SET UP ARRAY TESTMELT TO BE +VE OR -VE ACCORDING TO WHETHER PSEUDAIR.193
C SURFACE MELTING IS OCCURRING. NOTE THAT IT IS SET TO A PSEUDAIR.194
C CONVENIENT NEGATIVE NUMBER (TFREEZE) AT ICE-FREE POINTS. PSEUDAIR.195
C PSEUDAIR.196
IF (ICY(I,J)) THEN PSEUDAIR.197
RGAMMA(I,J) =HSNOW(I,J)*CONDICE*RCONDSNO + HICE(I,J)/AICE(I,J) PSEUDAIR.198
RGAMMA(I,J) = RGAMMA(I,J)*RCONDICE PSEUDAIR.199
GAMMA(I,J) = ONE/RGAMMA(I,J) PSEUDAIR.200
TESTMELT(I,J) = SOLICE(I,J)*COALB(I,J) PSEUDAIR.201
TESTMELT(I,J) = TESTMELT(I,J) + TFREEZE*GAMMA(I,J) PSEUDAIR.202
TESTMELT(I,J) = TESTMELT(I,J) + HANEY*TAIR(I,J) PSEUDAIR.203
ELSE PSEUDAIR.204
TESTMELT(I,J) = TFREEZE PSEUDAIR.205
ENDIF PSEUDAIR.206
C PSEUDAIR.207
LMELT(I,J) = TESTMELT(I,J) .GE. ZERO PSEUDAIR.208
C PSEUDAIR.209
C CHANGE COALBEDO VALUES AT POINTS WHERE THE SURFACE IS MELTING PSEUDAIR.210
C PSEUDAIR.211
IF(LMELT(I,J).AND.LNOSNOW(I,J)) THEN PSEUDAIR.212
COALB(I,J) = COALBEDO(4) PSEUDAIR.213
ELSEIF(LMELT(I,J).AND.LSNOW(I,J)) THEN PSEUDAIR.214
COALB(I,J) = COALBEDO(2) PSEUDAIR.215
ENDIF PSEUDAIR.216
C PSEUDAIR.217
C SET TOPMELT AND BOTMELT AT POINTS WHERE THE SURFACE IS FROZEN PSEUDAIR.218
C THE ALBEDO IS UNCHANGED HERE SO WE CAN REUSE THE VALUES PSEUDAIR.219
C IN TESTMELT. PSEUDAIR.220
C PSEUDAIR.221
IF( ICY(I,J).AND.(.NOT.LMELT(I,J)) ) THEN PSEUDAIR.222
TOPMELT(I,J) = ZERO PSEUDAIR.223
BOTMELT(I,J) = TESTMELT(I,J)/(HANEY + GAMMA(I,J) ) PSEUDAIR.224
BOTMELT(I,J) = (BOTMELT(I,J)-TFREEZE)*GAMMA(I,J) PSEUDAIR.225
ENDIF PSEUDAIR.226
C PSEUDAIR.227
C NOW DEAL WITH POINTS WHERE SURFACE IS MELTING. PSEUDAIR.228
C PSEUDAIR.229
IF(ICY(I,J).AND.LMELT(I,J)) THEN PSEUDAIR.230
BOTMELT(I,J) = -TFREEZE*GAMMA(I,J) PSEUDAIR.231
TOPMELT(I,J) = SOLICE(I,J)*COALB(I,J) PSEUDAIR.232
TOPMELT(I,J) = TOPMELT(I,J)+(HANEY * TAIR(I,J)) PSEUDAIR.233
TOPMELT(I,J) = TOPMELT(I,J) - BOTMELT(I,J) PSEUDAIR.234
ENDIF PSEUDAIR.235
C PSEUDAIR.236
C WEIGHT TOPMELT AND BOTMELT BY THE AREA OF ICE, IN THE SAME PSEUDAIR.237
C WAY AS THE ATMOSPHERIC MODEL WOULD DO. PSEUDAIR.238
C PSEUDAIR.239
IF ( ICY(I,J) ) THEN PSEUDAIR.240
TOPMELT(I,J) = TOPMELT(I,J)*AICE(I,J) PSEUDAIR.241
BOTMELT(I,J) = BOTMELT(I,J)*AICE(I,J) PSEUDAIR.242
ELSE PSEUDAIR.243
TOPMELT(I,J) = ZERO PSEUDAIR.244
BOTMELT(I,J) = ZERO PSEUDAIR.245
ENDIF PSEUDAIR.246
C PSEUDAIR.247
C ---------------------------------------------------------------- PSEUDAIR.248
C END GRIDPOINT BY GRIDPOINT CALCULATION PSEUDAIR.249
C ---------------------------------------------------------------- PSEUDAIR.250
C PSEUDAIR.251
100 CONTINUE PSEUDAIR.252
C PSEUDAIR.253
C ---------------------------------------------------------------- PSEUDAIR.254
C Multiply heatflux and solarflx by AICE in runs with ice OJC2F400.3
C dynamics. OJC2F400.4
if (l_icesimple .or. l_icefreedr) then ODC1F405.386
do j=j_1,j_jmt ORH3F402.235
do i=1,imt OJC2F400.7
heatflux(i,j) = heatflux(i,j) * aice(i,j) OJC2F400.8
end do OJC2F400.9
end do OJC2F400.10
endif OJC2F400.11
C ---------------------------------------------------------------- PSEUDAIR.255
C PSEUDAIR.256
IF (L_OCYCLIC) THEN ORH1F305.4894
C ENSURE THAT THE FORCING DATASETS ARE CYCLIC. PSEUDAIR.259
C PSEUDAIR.260
DO 200 J = J_1,J_JMT ORH3F402.236
TOPMELT(1,J) = TOPMELT(IMTM1,J) PSEUDAIR.262
TOPMELT(IMT,J) = TOPMELT(2,J) PSEUDAIR.263
BOTMELT(1,J) = BOTMELT(IMTM1,J) PSEUDAIR.264
BOTMELT(IMT,J) = BOTMELT(2,J) PSEUDAIR.265
ATMSFLUX(1,J) = ATMSFLUX(IMTM1,J) PSEUDAIR.268
ATMSFLUX(IMT,J) = ATMSFLUX(2,J) PSEUDAIR.269
200 CONTINUE PSEUDAIR.270
C PSEUDAIR.271
ENDIF ORH1F305.4895
C PSEUDAIR.274
RETURN PSEUDAIR.275
END PSEUDAIR.276
*ENDIF PSEUDAIR.277