pkg/streamice/streamice_visc_beta.F

5ca83cd8f7 Dani*0001 #include "STREAMICE_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
                0005 CBOP
                0006       SUBROUTINE STREAMICE_VISC_BETA ( myThid )
                0007
                0008 C     /============================================================\
0fbff46b46 dngo*0009 C     | SUBROUTINE                                                 |
5ca83cd8f7 Dani*0010 C     | o                                                          |
                0011 C     |============================================================|
                0012 C     |                                                            |
                0013 C     \============================================================/
                0014       IMPLICIT NONE
                0015
                0016 C     === Global variables ===
                0017 #include "SIZE.h"
                0018 #include "GRID.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "STREAMICE.h"
                0022 #include "STREAMICE_CG.h"
                0023
                0024 C     !INPUT/OUTPUT ARGUMENTS
                0025       INTEGER myThid
                0026 !       _RL taudx (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0027 !       _RL taudx (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0028
                0029 #ifdef ALLOW_STREAMICE
                0030
                0031 C     LOCAL VARIABLES
                0032       INTEGER i, j, bi, bj, k, l
                0033       _RL ux, uy, vx, vy, exx, eyy, exy, second_inv, unorm
0fbff46b46 dngo*0034       _RL umid, vmid, C_fric_val, Bglen_val
5ca83cd8f7 Dani*0035
                0036       DO bj=myByLo(myThid),myByHi(myThid)
                0037        DO bi=myBxLo(myThid),myBxHi(myThid)
                0038         DO j=1,sNy
                0039          DO i=1,sNx
                0040           IF (STREAMICE_hmask(i,j,bi,bj).eq.1) THEN
0fbff46b46 dngo*0041
5ca83cd8f7 Dani*0042            umid = 0
                0043            vmid = 0
                0044
                0045            DO k=0,1
                0046             DO l=0,1
0fbff46b46 dngo*0047              umid = umid + 0.25 *
                0048      &        dxG(i,j+l,bi,bj)*dyG(i+k,j,bi,bj) *
5ca83cd8f7 Dani*0049      &        recip_rA(i,j,bi,bj) *
0fbff46b46 dngo*0050      &        U_streamice(i+k,j+l,bi,bj)
                0051              vmid = vmid + 0.25 *
                0052      &        dxG(i,j+l,bi,bj)*dyG(i+k,j,bi,bj) *
5ca83cd8f7 Dani*0053      &        recip_rA(i,j,bi,bj) *
                0054      &        V_streamice(i+k,j+l,bi,bj)
                0055             ENDDO
                0056            ENDDO
0fbff46b46 dngo*0057
                0058            ux = (U_streamice(i+1,j+1,bi,bj) +
5ca83cd8f7 Dani*0059      &           U_streamice(i+1,j,bi,bj)   -
                0060      &           U_streamice(i,j+1,bi,bj)   -
                0061      &           U_streamice(i,j,bi,bj)) /
                0062      &           (2. * dxF(i,j,bi,bj))
0fbff46b46 dngo*0063            vx = (V_streamice(i+1,j+1,bi,bj) +
5ca83cd8f7 Dani*0064      &           V_streamice(i+1,j,bi,bj)   -
                0065      &           V_streamice(i,j+1,bi,bj)   -
                0066      &           V_streamice(i,j,bi,bj)) /
                0067      &           (2. * dxF(i,j,bi,bj))
0fbff46b46 dngo*0068            uy = (U_streamice(i+1,j+1,bi,bj) -
5ca83cd8f7 Dani*0069      &           U_streamice(i+1,j,bi,bj)   +
                0070      &           U_streamice(i,j+1,bi,bj)   -
                0071      &           U_streamice(i,j,bi,bj)) /
                0072      &           (2. * dyF(i,j,bi,bj))
0fbff46b46 dngo*0073            vy = (V_streamice(i+1,j+1,bi,bj) -
5ca83cd8f7 Dani*0074      &           V_streamice(i+1,j,bi,bj)   +
                0075      &           V_streamice(i,j+1,bi,bj)   -
                0076      &           V_streamice(i,j,bi,bj)) /
                0077      &           (2. * dyF(i,j,bi,bj))
                0078
                0079            exx = ux + k1AtC_str(i,j,bi,bj)*vmid
                0080            eyy = vy + k2AtC_str(i,j,bi,bj)*umid
0fbff46b46 dngo*0081            exy = .5*(uy+vx) +
5ca83cd8f7 Dani*0082      &      k1AtC_str(i,j,bi,bj)*umid + k2AtC_str(i,j,bi,bj)*vmid
                0083
                0084 !A_glen_isothermal, n_glen, eps_glen_min,
                0085
0fbff46b46 dngo*0086            second_inv =
5ca83cd8f7 Dani*0087      &      sqrt(exx**2+eyy**2+exx*eyy+exy**2+eps_glen_min**2)
                0088
bdd8102d3e Dani*0089 #ifdef STREAMICE_3D_GLEN_CONST
0fbff46b46 dngo*0090            IF (.not.STREAMICE_use_log_ctrl) THEN
                0091             Bglen_val = B_glen(i,j,1,bi,bj)**2
                0092            ELSE
                0093             Bglen_val = exp(B_glen(i,j,1,bi,bj))
                0094            ENDIF
bdd8102d3e Dani*0095 #else
0fbff46b46 dngo*0096            IF (.not.STREAMICE_use_log_ctrl) THEN
                0097             Bglen_val = B_glen(i,j,bi,bj)**2
                0098            ELSE
                0099             Bglen_val = exp(B_glen(i,j,bi,bj))
                0100            ENDIF
bdd8102d3e Dani*0101 #endif
0fbff46b46 dngo*0102
                0103            visc_streamice(i,j,bi,bj) =
                0104      &      .5 * Bglen_val *
5ca83cd8f7 Dani*0105      &      second_inv**((1-n_glen)/n_glen) * H_streamice(i,j,bi,bj)
                0106
0fbff46b46 dngo*0107            if (.not.STREAMICE_use_log_ctrl) THEN
                0108             C_fric_val = C_basal_friction(i,j,bi,bj)**2
                0109            else
                0110             C_fric_val = exp(C_basal_friction(i,j,bi,bj))
                0111            endif
                0112
5ca83cd8f7 Dani*0113            unorm = sqrt(umid**2+vmid**2+eps_u_min**2)
0fbff46b46 dngo*0114            tau_beta_eff_streamice(i,j,bi,bj) =
                0115      &       C_fric_val *
5ca83cd8f7 Dani*0116      &       unorm ** (n_basal_friction-1.0) *
                0117      &       float_frac_streamice (i,j,bi,bj)
0fbff46b46 dngo*0118
5ca83cd8f7 Dani*0119           ENDIF
                0120          ENDDO
                0121         ENDDO
                0122        ENDDO
                0123       ENDDO
                0124
                0125 #endif
                0126       RETURN
                0127       END