*IF DEF,SEAICE FREEZEUP.2
C ******************************COPYRIGHT****************************** GTS2F400.3169
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3170
C GTS2F400.3171
C Use, duplication or disclosure of this code is subject to the GTS2F400.3172
C restrictions as set forth in the contract. GTS2F400.3173
C GTS2F400.3174
C Meteorological Office GTS2F400.3175
C London Road GTS2F400.3176
C BRACKNELL GTS2F400.3177
C Berkshire UK GTS2F400.3178
C RG12 2SZ GTS2F400.3179
C GTS2F400.3180
C If no contract has been raised with this copy of the code, the use, GTS2F400.3181
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3182
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3183
C Modelling at the above address. GTS2F400.3184
C ******************************COPYRIGHT****************************** GTS2F400.3185
C GTS2F400.3186
C*LL FREEZEUP.3
CLL SUBROUTINE FREEZEUP FREEZEUP.4
CLL ------------------- FREEZEUP.5
CLL THIS ROUTINE IMPOSES A MINIMUM TEMPERATURE OF FREEZING AT ALL FREEZEUP.6
CLL LEVELS, AND STORES NEGATIVE HEAT FLUXES RELEASED BY THIS IN THE FREEZEUP.7
CLL ARRAY CARYHEAT, FOR THE ICE MODEL. IT ALSO IDENTIFIES ICE-FREE FREEZEUP.8
CLL PLACES WHERE ICE IS ABOUT TO FORM, AND SETS NEWICE TO TRUE AT FREEZEUP.9
CLL SUCH PLACES. IT IS CALLED FROM WITHIN TRACER, AFTER THE TRACER FREEZEUP.10
CLL FIELDS HAVE BEEN UPDATED BUT BEFORE FILTERING. FREEZEUP.11
CLL IT CAN BE COMPILED BY ANY FORTRAN COMPILER WHICH TOLERATES FREEZEUP.12
CLL IN-LINE COMMENTS. FREEZEUP.13
CLL AUTHOR: D L ROBERTS FREEZEUP.14
CLL DATE: 22/10/90 FREEZEUP.15
CLL REVIEWED BY: J F THOMPSON FREEZEUP.16
CLL VERSION 1.3 FREEZEUP.17
CLL REVISED: 7/2/91 BY J F THOMSON FREEZEUP.18
CLL STORES HEAT NOT HEAT FLUX FOR ICE MODEL. FREEZEUP.19
CLL SATISFIES ENERGY CONSERVATION. FREEZEUP.20
CLL ALSO MODIFIED TO CALCULATE DENSITY CHANGE AND ADD FREEZEUP.21
CLL IT TO THAT FROM ICEFLUX FOR MIXED LAYER MODEL. FREEZEUP.22
CLL REVISED: 30/6/92 BY J F THOMSON FREEZEUP.23
CLL REVERTS TO VERSION 1.1 STORING HEAT FLUX IN CARYHEAT FREEZEUP.24
CLL REVISED:11/8/92 BY N K TAYLOR FREEZEUP.25
CLL REVISED: O. Alves 12/12/93 add OSKIPLND option to STATE routines JA121293.383
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.321
CLL Version 4.0 7.7.95 Diagnose any heat supplied to the bottom layer to OJG0F400.72
CLL avoid freezing in HEATSINK. (J. Murphy, mod. coded by J. Gregory) OJG0F400.73
! 4.4 15/08/97 Remove SKIPLAND code. R. Hill ORH7F404.69
CLL RESETS TEMPERATURES AT ALL LEVELS (EXCEPT THE BOTTOM-MOST), BUT FREEZEUP.26
CLL ONLY PASSES THE IMPLIED HEAT TO THE ICE MODEL FOR LEVEL 1. AT LOWER FREEZEUP.27
CLL LEVELS THIS HEAT IS USED TO COOL THE LEVEL IMMEDIATELY BELOW (IN FREEZEUP.28
CLL ORDER TO CONSERVE HEAT). THIS IS TO PREVENT TEMPERATURES FREEZEUP.29
CLL BELOW FREEZING BEING TRIGGERED BY NUMERICAL PROBLEMS WITH FREEZEUP.30
CLL THE ADVECTION SCHEME, ISOPYCNAL DIFFUSION AND FILTERING. FREEZEUP.31
CLL PROGRAMMING STANDARDS USE COX NAMING CONVENTION FOR COX VARIABLES FREEZEUP.32
CLL OTHERWISE FOLLOWS UM DOC PAPER 4 VERSION 1. FREEZEUP.33
CLL THIS FORMS PART OF SYSTEM COMPONENT P4. FREEZEUP.34
C* --------------------------------------------------------------- FREEZEUP.35
C*L FREEZEUP.36
SUBROUTINE FREEZEUP(TA,ICY,NEWICE,CARYHEAT,IMT,KM,NT,FM, 2,2FREEZEUP.37
& HEATSINK, OJG0F400.74
& J,JMT, ORH7F404.70
+ DRHOICE, FREEZEUP.40
& IMT_MIX_ARG,KM_MIX_ARG, ORH1F305.322
+ DZ,C2DTTS,CSUBP,RHOWATER,TFREEZE) FREEZEUP.43
C FREEZEUP.44
IMPLICIT NONE FREEZEUP.45
C FREEZEUP.46
*CALL CNTLOCN 
ORH1F305.323
*CALL OARRYSIZ ORH1F305.324
INTEGER FREEZEUP.47
+ IMT, ! IN NUMBER OF COLUMNS. FREEZEUP.48
+ KM, ! IN NUMBER OF LAYERS. FREEZEUP.49
+ NT ! IN NUMBER OF TRACERS. FREEZEUP.50
&,IMT_MIX_ARG ! IMT_MIX through arg list ORH1F305.325
&,KM_MIX_ARG ! KM_MIX through arg list ORH1F305.326
&,JMT ! IN No of rows JA121293.389
&,J ! IN ROW NUMBER JA121293.390
C FREEZEUP.51
LOGICAL FREEZEUP.52
+ ICY(IMT), ! IN TRUE WHERE SEA-ICE EXISTS AT PRESENT. FREEZEUP.53
+ NEWICE(IMT) ! OUT TRUE WHERE ICE DOES NOT YET EXIST BUT IS FREEZEUP.54
+ ! ABOUT TO FORM. FREEZEUP.55
C FREEZEUP.56
REAL FREEZEUP.57
+ TA(IMT,KM,NT), ! INOUT TRACER ARRAY. FREEZEUP.58
+ CARYHEAT(IMT), ! OUT THIS ARRAY IS ZERO EXCEPT AT PLACES WHERE FREEZEUP.59
+ ! ICE IS ABOUT TO FORM, WHERE IT CONTAINS THE FREEZEUP.60
+ ! (NEGATIVE) HEAT FLUX THAT WILL BE CONVERTED FREEZEUP.61
+ ! TO AN INITIAL ICE DEPTH IN ICEFLOE. FREEZEUP.62
+ HEATSINK(IMT), ! OUT Heat 'lost' when T set to TFREEZE at bottom OJG0F400.75
+ ! model level OJG0F400.76
+ DZ(KM), ! IN LAYER THICKNESSES, IN CM. FREEZEUP.63
+ ! IF VARIABLE TIMESTEP WITH DEPTH IS BEING USED, FREEZEUP.66
+ ! THE CALL TO FREEZEUP HAS RZ INSTEAD OF DZ. FREEZEUP.67
+ FM(IMT,KM), ! IN MASKING ARRAY FOR TRACER POINTS: EQUALS 1.0 FREEZEUP.70
+ ! AT OCEAN POINTS AND 0.0 AT LAND/SEABED POINTS. FREEZEUP.71
+ C2DTTS, ! IN TWICE THE TRACER TIMESTEP AT THE SURFACE FREEZEUP.72
+ ! LEVEL, EXCEPT ON A FORWARD TIMESTEP WHEN IT IS FREEZEUP.73
+ ! EQUAL TO THE TRACER TIMESTEP. FREEZEUP.74
+ CSUBP, ! IN SPECIFIC HEAT CAPACITY, IN J/(K*KG). FREEZEUP.75
+ RHOWATER, ! IN DENSITY OF SEA WATER, IN KG/M**3. FREEZEUP.76
+ TFREEZE ! IN FREEZING POINT OF SEA-WATER, IN CELSIUS. FREEZEUP.77
C FREEZEUP.80
REAL DRHOICE(IMT_ICE_MIX) ! OUT DENSITY CHANGE AT SURFACE DUE TO ORH1F305.330
+ ! ICE-OCEAN FLUXES, FOR MIXED LAYER MODEL. FREEZEUP.82
C FREEZEUP.83
EXTERNAL STATED FREEZEUP.84
C* FREEZEUP.87
C LOCAL VARIABLES. FREEZEUP.88
C FREEZEUP.89
INTEGER I ! LOOP COUNTER FOR COLUMNS. FREEZEUP.90
INTEGER K ! LOOP COUNTER FOR LEVELS. FREEZEUP.91
REAL CONFLUX ! CONVERSION FACTOR FROM TEMP. TO W/(M**2.cm.K) FREEZEUP.92
+,RHO1(IMT_MIX_ARG,KM_MIX_ARG) ! SURF DNSTY BEFORE TRACERS UPDATED ORH1F305.331
+,RHO2(IMT_MIX_ARG,KM_MIX_ARG) ! SURF DNSTY AFTER TRACERS UPDATED ORH1F305.332
+,WORK1(IMT_MIX_ARG,KM_MIX_ARG) ! WORK ARRAY USED BY SUBRTNE STATE ORH1F305.333
+,WORK2(IMT_MIX_ARG,KM_MIX_ARG) ! WORK ARRAY USED BY SUBRTNE STATE ORH1F305.334
C FREEZEUP.101
CONFLUX = (CSUBP*RHOWATER)/(100.0*C2DTTS) FREEZEUP.102
C FREEZEUP.103
IF (L_OMIXLAY) THEN ORH1F305.335
C FIND SURFACE DENSITY BEFORE UPDATING TRACERS. FREEZEUP.106
C FREEZEUP.107
JA121293.404
CALL STATED(TA(1,1,1),TA(1,1,2),RHO1,WORK1,WORK2,IMT,1,J JA121293.405
&,KM JA121293.406
&,JMT ORH7F404.71
&) JA121293.409
JA121293.410
JA121293.415
C FREEZEUP.109
ENDIF ORH1F305.338
DO 100 I = 1,IMT FREEZEUP.112
NEWICE(I) = (TA(I,1,1) .LT. TFREEZE) .AND. (.NOT. ICY(I)) FREEZEUP.113
NEWICE(I) =(NEWICE(I) .AND. (FM(I,1) .GT. 0.1)) FREEZEUP.114
CARYHEAT(I) = 0.0 FREEZEUP.115
100 CONTINUE FREEZEUP.116
C FREEZEUP.117
C THE PREVIOUS AND FOLLOWING LOOPS ARE SEPARATED TO ALLOW FREEZEUP.118
C BETTER VECTORISATION. FREEZEUP.119
C FREEZEUP.120
C Reset temperatures in surface layer and store heat in CARYHEAT FREEZEUP.121
C FREEZEUP.122
DO 110 I = 1,IMT FREEZEUP.123
IF (TA(I,1,1) .LT. TFREEZE) THEN FREEZEUP.124
CARYHEAT(I) = CARYHEAT(I) + FREEZEUP.125
+ CONFLUX*DZ(1)*FM(I,1)*( TA(I,1,1) - TFREEZE ) FREEZEUP.126
TA(I,1,1) = TFREEZE FREEZEUP.127
ENDIF FREEZEUP.128
CARYHEAT(I) = CARYHEAT(I) * FM(I,1) FREEZEUP.129
110 CONTINUE FREEZEUP.130
C FREEZEUP.131
C Below the surface level, reset temperatures and pass heat down FREEZEUP.132
C to the next level below (to conserve heat) FREEZEUP.133
C FREEZEUP.134
DO 140 K=2,KM-1 FREEZEUP.135
DO 130 I = 1,IMT FREEZEUP.136
IF (TA(I,K,1) .LT. TFREEZE) THEN FREEZEUP.137
TA(I,K+1,1) = TA(I,K+1,1) + FREEZEUP.138
+ (DZ(K)/DZ(K+1))*FM(I,K+1)*(TA(I,K,1)-TFREEZE) FREEZEUP.139
C If layer K+1 is not active, the heat moved down in the previous line OJG0F400.81
C will have been lost. Add it to HEATSINK. OJG0F400.82
HEATSINK(I)=(1.0-FM(I,K+1))*CONFLUX*DZ(K)*(TA(I,K,1)-TFREEZE) OJG0F400.83
TA(I,K,1) = TFREEZE FREEZEUP.140
ENDIF FREEZEUP.141
130 CONTINUE FREEZEUP.142
140 CONTINUE FREEZEUP.143
IF (L_OMIXLAY) THEN ORH1F305.339
C FIND SURFACE DENSITY AFTER UPDATING TRACERS, THEN FIND THE FREEZEUP.146
C RESULTANT CHANGE IN DENSITY. FREEZEUP.147
C FREEZEUP.148
CALL STATED(TA(1,1,1),TA(1,1,2),RHO2,WORK1,WORK2,IMT,1,J JA121293.425
&,KM JA121293.426
&,JMT ORH7F404.72
&) JA121293.429
JA121293.430
JA121293.435
DO 160 I = 1,IMT FREEZEUP.150
DRHOICE(I) = DRHOICE(I) +(RHO2(I,1) - RHO1(I,1)) FREEZEUP.151
160 CONTINUE FREEZEUP.152
ENDIF ! L_OMIXLAY = true ORH1F305.342
IF (L_OCYCLIC) THEN ORH1F305.343
C FREEZEUP.155
C MAKE NEWICE, CARYHEAT AND HEATSINK CYCLICALLY CONTINUOUS,IF NECESSARY OJG0F400.84
C FREEZEUP.157
CARYHEAT(1) = CARYHEAT(IMT-1) FREEZEUP.158
CARYHEAT(IMT) = CARYHEAT(2) FREEZEUP.159
NEWICE(1) = NEWICE(IMT-1) FREEZEUP.160
NEWICE(IMT) = NEWICE(2) FREEZEUP.161
HEATSINK(1)=HEATSINK(IMT-1) OJG0F400.85
HEATSINK(IMT)=HEATSINK(2) OJG0F400.86
ENDIF ! L_OCYCLIC = true ORH1F305.344
C FREEZEUP.164
RETURN FREEZEUP.165
END FREEZEUP.166
*ENDIF FREEZEUP.167