pkg/thsice/thsice_check_conserv.F

fc7306ba7d Jean*0001 #include "THSICE_OPTIONS.h"
17fd302697 Jean*0002
fc7306ba7d Jean*0003 C     !ROUTINE: THSICE_CHECK_CONSERV
                0004 C     !INTERFACE:
                0005       SUBROUTINE THSICE_CHECK_CONSERV(
7269783f6f Jean*0006      I             dBugFlag, i, j, bi, bj, iceStart,
fc7306ba7d Jean*0007      I             iceFrac, compact, hIce, hSnow, qicen,
7269783f6f Jean*0008      I             qleft, ffresh, fsalt,
fc7306ba7d Jean*0009      I             myTime, myIter, myThid )
                0010 C     *==========================================================*
17fd302697 Jean*0011 C     | S/R  THSICE_CHECK_CONSERV
fc7306ba7d Jean*0012 C     | o Check Conservation of Energy, water and salt
                0013 C     *==========================================================*
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 C     === Global variables ===
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 c #include "PARAMS.h"
                0021 #include "THSICE_SIZE.h"
                0022 #include "THSICE_PARAMS.h"
87ea84cac6 Jean*0023 #include "THSICE_VARS.h"
17fd302697 Jean*0024
fc7306ba7d Jean*0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     === Routine arguments ===
                0027 C     myIter :: iteration counter for this thread
                0028 C     myTime :: time counter for this thread
                0029 C     myThid :: thread number for this instance of the routine.
7269783f6f Jean*0030       LOGICAL dBugFlag
fc7306ba7d Jean*0031       INTEGER i,j, bi,bj
                0032       INTEGER iceStart
                0033       _RL iceFrac
                0034       _RL compact, hIce, hSnow, qicen(nlyr)
                0035       _RL qleft, fsalt, ffresh
                0036       _RL  myTime
                0037       INTEGER myIter
                0038       INTEGER myThid
                0039
                0040 #ifdef ALLOW_THSICE
                0041 C     !LOCAL VARIABLES:
                0042 C     === Local variables ===
                0043       _RL dEnerg, dWater, dSalt
                0044       _RL flxFrac
7269783f6f Jean*0045       _RL flxAtm, frwAtm
                0046       LOGICAL dBugLoc
                0047
                0048 C-    define grid-point location where to print debugging values
                0049 #include "THSICE_DEBUG.h"
fc7306ba7d Jean*0050
17fd302697 Jean*0051  1010 FORMAT(A,1P4E14.6)
fc7306ba7d Jean*0052
7269783f6f Jean*0053           dBugLoc = .FALSE.
                0054 #ifdef ALLOW_DBUG_THSICE
                0055           dBugLoc = dBug(i,j,bi,bj)
                0056 #endif
fc7306ba7d Jean*0057           flxFrac = iceFrac
7269783f6f Jean*0058           flxAtm = icFlxAtm(i,j,bi,bj)
                0059           frwAtm = icFrwAtm(i,j,bi,bj)
fc7306ba7d Jean*0060           IF (iceStart.EQ.1) flxFrac = 1.
                0061
                0062 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
17fd302697 Jean*0063           dEnerg= -rhos*snowHeight(i,j,bi,bj)*qsnow
fc7306ba7d Jean*0064      &            -rhoi*iceHeight(i,j,bi,bj)
                0065      &             *(Qice1(i,j,bi,bj)+Qice2(i,j,bi,bj))*0.5
                0066           dWater = rhos*snowheight(i,j,bi,bj)+rhoi*iceHeight(i,j,bi,bj)
                0067           dSalt =  rhoi*iceHeight(i,j,bi,bj)*saltice
7269783f6f Jean*0068          IF (dBugLoc) WRITE(6,1010) 'ThSI_CHK: Ener0,Water0,Salt0 =',
fc7306ba7d Jean*0069      &    dEnerg, dWater, dSalt
                0070 C--
                0071           dEnerg = dEnerg*iceFrac
17fd302697 Jean*0072      &     + compact*( rhos*hSnow*qsnow
fc7306ba7d Jean*0073      &               + rhoi*hIce*(qicen(1)+qicen(2))*0.5
                0074      &               )
                0075           dWater = dWater*iceFrac
                0076      &     - compact*( rhos*hSnow + rhoi*hIce )
                0077           dSalt =  dSalt*iceFrac
                0078      &     - compact* rhoi*hIce*saltice
                0079
7269783f6f Jean*0080          IF (dBugLoc) WRITE(6,1010) 'ThSI_CHK: dEner,dH20,dSal /dt=',
fc7306ba7d Jean*0081      &    dEnerg/thSIce_deltaT,dWater/thSIce_deltaT,dSalt/thSIce_deltaT
7269783f6f Jean*0082          IF (dBugLoc) WRITE(6,1010) 'ThSI_CHK: fxH,fxW,fxS=',
                0083      &    flxAtm-qleft, -ffresh-frwAtm,-fsalt
fc7306ba7d Jean*0084           dEnerg = dEnerg + thSIce_deltaT*flxFrac*(flxAtm-qleft)
87ea84cac6 Jean*0085           dWater = dWater - thSIce_deltaT*flxFrac*(ffresh+frwAtm)
fc7306ba7d Jean*0086           dSalt  = dSalt  - thSIce_deltaT*flxFrac*fsalt
                0087
b7411f1a84 Jean*0088 c#ifdef ALLOW_TIMEAVE
                0089 c         ice_flx2oc_Ave(i,j,bi,bj) = ice_flx2oc_Ave(i,j,bi,bj)
                0090 c    &          + dEnerg
                0091 c         ice_frw2oc_Ave(i,j,bi,bj) = ice_frw2oc_Ave(i,j,bi,bj)
                0092 c    &          + dWater
                0093 c         ice_salFx_Ave(i,j,bi,bj) = ice_salFx_Ave(i,j,bi,bj)
                0094 c    &          + dSalt
                0095 c#endif /*ALLOW_TIMEAVE*/
fc7306ba7d Jean*0096 C--
7269783f6f Jean*0097          IF (dBugLoc) WRITE(6,1010) 'ThSI_CHK: resid.H,W,S=',
fc7306ba7d Jean*0098      &    dEnerg/thSIce_deltaT,dWater/thSIce_deltaT,dSalt/thSIce_deltaT
7269783f6f Jean*0099          IF (dBugLoc) WRITE(6,1010) 'ThSI_CHK: hIc,hSn,snow*dt=',
8d49675495 Jean*0100      &    hIce, hSnow
                0101 c    &    hIce, hSnow, snowPrc(i,j,bi,bj)*thSIce_deltaT/rhos
fc7306ba7d Jean*0102
                0103 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0104
                0105 #endif  /*ALLOW_THSICE*/
                0106
                0107       RETURN
                0108       END