pkg/thsice/thsice_reshape_layers.F

87ea84cac6 Jean*0001 #include "THSICE_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: THSICE_RESHAPE_LAYERS
                0005 C     !INTERFACE:
                0006       SUBROUTINE THSICE_RESHAPE_LAYERS(
                0007      U                                 qicen,
                0008      I                                 hlyr, hnew, myThid )
                0009
                0010 C     !DESCRIPTION: \bv
                0011 C     *==========================================================*
                0012 C     | S/R THSICE_RESHAPE_LAYERS
                0013 C     | Repartition into equal-thickness layers, conserving energy.
                0014 C     *==========================================================*
                0015 C     | This is the 2-layer version (formerly "NEW_LAYERS_WINTON")
                0016 C     |  from M. Winton 1999, JAOT, sea-ice model.
                0017 C     *==========================================================*
                0018 C     \ev
                0019
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022
                0023 C     == Global variables ===
dbce8fc2d4 Jean*0024 #include "EEPARAMS.h"
87ea84cac6 Jean*0025 #include "THSICE_PARAMS.h"
                0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     == Routine Arguments ==
bd8a00c1fc Jean*0029 C     qicen  :: ice enthalpy (J/kg)
87ea84cac6 Jean*0030 C     hnew   :: new ice layer thickness (m)
                0031 C     hlyr   :: individual ice layer thickness (m)
                0032 C     myThid :: Number of this instance
                0033       _RL  qicen(*)
                0034       _RL  hnew(*)
                0035       _RL  hlyr
                0036       INTEGER myThid
                0037 CEOP
                0038
                0039 #ifdef ALLOW_THSICE
                0040 C     == Local Variables ==
                0041 C      f1         :: Fraction of upper layer ice in new layer
                0042 C      qh1, qh2   :: qice*h for layers 1 and 2
                0043 C      qhtot      :: qh1 + qh2
                0044 C      q2tmp      :: Temporary value of qice for layer 2
                0045       _RL  f1
                0046       _RL  qh1, qh2
                0047       _RL  qhtot
                0048       _RL  q2tmp
                0049
                0050 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0051
                0052       if (hnew(1).gt.hnew(2)) then
                0053 C-    Layer 1 gives ice to layer 2
                0054          f1 = (hnew(1)-hlyr)/hlyr
                0055          q2tmp = f1*qicen(1) + (1. _d 0-f1)*qicen(2)
                0056          if (q2tmp.gt.Lfresh) then
                0057             qicen(2) = q2tmp
                0058          else
                0059 C-    Keep q2 fixed to avoid q2<Lfresh and T2>0
                0060             qh2 = hlyr*qicen(2)
                0061             qhtot = hnew(1)*qicen(1) + hnew(2)*qicen(2)
                0062             qh1 = qhtot - qh2
                0063             qicen(1) = qh1/hlyr
                0064          endif
                0065       else
                0066 C-    Layer 2 gives ice to layer 1
                0067          f1 = hnew(1)/hlyr
                0068          qicen(1) = f1*qicen(1) + (1. _d 0-f1)*qicen(2)
                0069       endif
                0070
                0071 #endif  /* ALLOW_THSICE */
                0072
                0073       RETURN
                0074       END