pkg/thsice/thsice_reshape_layers.F

C $Header:  $
C $Name:  $

#include "THSICE_OPTIONS.h"

CBOP
C     !ROUTINE: THSICE_RESHAPE_LAYERS
C     !INTERFACE:
      SUBROUTINE THSICE_RESHAPE_LAYERS(
     U                                 qicen,
     I                                 hlyr, hnew, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R THSICE_RESHAPE_LAYERS
C     | Repartition into equal-thickness layers, conserving energy.
C     *==========================================================*
C     | This is the 2-layer version (formerly "NEW_LAYERS_WINTON") 
C     |  from M. Winton 1999, JAOT, sea-ice model.
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global variables ===
#include "THSICE_PARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine Arguments ==
C     qicen  :: ice enthalpy (J m-3)
C     hnew   :: new ice layer thickness (m)
C     hlyr   :: individual ice layer thickness (m)
C     myThid :: Number of this instance
      _RL  qicen(*)
      _RL  hnew(*)
      _RL  hlyr
      INTEGER myThid
CEOP

#ifdef ALLOW_THSICE
C     == Local Variables ==
C      f1         :: Fraction of upper layer ice in new layer
C      qh1, qh2   :: qice*h for layers 1 and 2
C      qhtot      :: qh1 + qh2
C      q2tmp      :: Temporary value of qice for layer 2
      _RL  f1
      _RL  qh1, qh2
      _RL  qhtot
      _RL  q2tmp

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      if (hnew(1).gt.hnew(2)) then
C-    Layer 1 gives ice to layer 2
         f1 = (hnew(1)-hlyr)/hlyr
         q2tmp = f1*qicen(1) + (1. _d 0-f1)*qicen(2)
         if (q2tmp.gt.Lfresh) then
            qicen(2) = q2tmp
         else
C-    Keep q2 fixed to avoid q2<Lfresh and T2>0
            qh2 = hlyr*qicen(2)
            qhtot = hnew(1)*qicen(1) + hnew(2)*qicen(2)
            qh1 = qhtot - qh2
            qicen(1) = qh1/hlyr
         endif
      else
C-    Layer 2 gives ice to layer 1
         f1 = hnew(1)/hlyr
         qicen(1) = f1*qicen(1) + (1. _d 0-f1)*qicen(2)
      endif

#endif  /* ALLOW_THSICE */

      RETURN
      END
1	C $Header: $
2	C $Name: $
3
4	#include "THSICE_OPTIONS.h"
5
6	CBOP
7	C !ROUTINE: THSICE_RESHAPE_LAYERS
8	C !INTERFACE:
9	SUBROUTINE THSICE_RESHAPE_LAYERS(
10	U qicen,
11	I hlyr, hnew, myThid )
12
13	C !DESCRIPTION: \bv
14	C ==========================================================
15	C \| S/R THSICE_RESHAPE_LAYERS
16	C \| Repartition into equal-thickness layers, conserving energy.
17	C ==========================================================
18	C \| This is the 2-layer version (formerly "NEW_LAYERS_WINTON")
19	C \| from M. Winton 1999, JAOT, sea-ice model.
20	C ==========================================================
21	C \ev
22
23	C !USES:
24	IMPLICIT NONE
25
26	C == Global variables ===
27	#include "THSICE_PARAMS.h"
28
29	C !INPUT/OUTPUT PARAMETERS:
30	C == Routine Arguments ==
31	C qicen :: ice enthalpy (J m-3)
32	C hnew :: new ice layer thickness (m)
33	C hlyr :: individual ice layer thickness (m)
34	C myThid :: Number of this instance
35	_RL qicen(*)
36	_RL hnew(*)
37	_RL hlyr
38	INTEGER myThid
39	CEOP
40
41	#ifdef ALLOW_THSICE
42	C == Local Variables ==
43	C f1 :: Fraction of upper layer ice in new layer
44	C qh1, qh2 :: qice*h for layers 1 and 2
45	C qhtot :: qh1 + qh2
46	C q2tmp :: Temporary value of qice for layer 2
47	_RL f1
48	_RL qh1, qh2
49	_RL qhtot
50	_RL q2tmp
51
52	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
53
54	if (hnew(1).gt.hnew(2)) then
55	C- Layer 1 gives ice to layer 2
56	f1 = (hnew(1)-hlyr)/hlyr
57	q2tmp = f1qicen(1) + (1. _d 0-f1)qicen(2)
58	if (q2tmp.gt.Lfresh) then
59	qicen(2) = q2tmp
60	else
61	C- Keep q2 fixed to avoid q2<Lfresh and T2>0
62	qh2 = hlyr*qicen(2)
63	qhtot = hnew(1)qicen(1) + hnew(2)qicen(2)
64	qh1 = qhtot - qh2
65	qicen(1) = qh1/hlyr
66	endif
67	else
68	C- Layer 2 gives ice to layer 1
69	f1 = hnew(1)/hlyr
70	qicen(1) = f1qicen(1) + (1. _d 0-f1)qicen(2)
71	endif
72
73	#endif /* ALLOW_THSICE */
74
75	RETURN
76	END