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