C $Header: /u/gcmpack/MITgcm/pkg/streamice/streamice_visc_beta_hybrid.F,v 1.9 2016/03/17 20:15:43 dgoldberg Exp $ C $Name: $ #include "STREAMICE_OPTIONS.h" #ifdef ALLOW_AUTODIFF # include "AUTODIFF_OPTIONS.h" #endif C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP SUBROUTINE STREAMICE_VISC_BETA_HYBRID ( myThid ) C /============================================================\ C | SUBROUTINE | C | o | C |============================================================| C | | C \============================================================/ IMPLICIT NONE C === Global variables === #include "SIZE.h" #include "GRID.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "STREAMICE.h" #include "STREAMICE_CG.h" #ifdef ALLOW_AUTODIFF_TAMC # include "tamc.h" #endif C !INPUT/OUTPUT ARGUMENTS INTEGER myThid ! _RL taudx (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) ! _RL taudx (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) #ifdef ALLOW_STREAMICE #ifdef STREAMICE_HYBRID_STRESS C LOCAL VARIABLES INTEGER i, j, bi, bj, k, l, m INTEGER ikey_1 _RL ux, uy, vx, vy, exx, eyy, exy, unorm, second_inv _RL ub, vb, fb, mean_u_shear, mean_v_shear, umid, vmid _RL omega_temp (Nr+1), u_shear(Nr+1), v_shear(Nr+1) #ifdef STREAMICE_FLOWLINE_BUTTRESS _RL buttr_param, pwr #endif _RL STREAMICE_BSTRESS_EXP ! _RL total_vol_out external STREAMICE_BSTRESS_EXP #ifdef STREAMICE_FLOWLINE_BUTTRESS buttr_param = 5**(1./3.) / (streamice_buttr_width/2.)**(4./3.) pwr = 1./n_glen #endif DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO j=1,sNy DO i=1,sNx IF (STREAMICE_hmask(i,j,bi,bj).eq.1) THEN umid = 0 vmid = 0 DO k=0,1 DO l=0,1 umid = umid + 0.25 * & dxG(i,j+l,bi,bj)*dyG(i+k,j,bi,bj) * & recip_rA(i,j,bi,bj) * & U_streamice(i+k,j+l,bi,bj) vmid = vmid + 0.25 * & dxG(i,j+l,bi,bj)*dyG(i+k,j,bi,bj) * & recip_rA(i,j,bi,bj) * & V_streamice(i+k,j+l,bi,bj) ENDDO ENDDO ux = (U_streamice(i+1,j+1,bi,bj) + & U_streamice(i+1,j,bi,bj) - & U_streamice(i,j+1,bi,bj) - & U_streamice(i,j,bi,bj)) / & (2. * dxF(i,j,bi,bj)) vx = (V_streamice(i+1,j+1,bi,bj) + & V_streamice(i+1,j,bi,bj) - & V_streamice(i,j+1,bi,bj) - & V_streamice(i,j,bi,bj)) / & (2. * dxF(i,j,bi,bj)) uy = (U_streamice(i+1,j+1,bi,bj) - & U_streamice(i+1,j,bi,bj) + & U_streamice(i,j+1,bi,bj) - & U_streamice(i,j,bi,bj)) / & (2. * dyF(i,j,bi,bj)) vy = (V_streamice(i+1,j+1,bi,bj) - & V_streamice(i+1,j,bi,bj) + & V_streamice(i,j+1,bi,bj) - & V_streamice(i,j,bi,bj)) / & (2. * dyF(i,j,bi,bj)) exx = ux + k1AtC_str(i,j,bi,bj)*vmid eyy = vy + k2AtC_str(i,j,bi,bj)*umid exy = .5*(uy+vx) + & k1AtC_str(i,j,bi,bj)*umid + k2AtC_str(i,j,bi,bj)*vmid visc_streamice (i,j,bi,bj) = 0.0 streamice_omega(i,j,bi,bj) = 0.0 omega_temp (Nr+1) = 0.0 u_shear(Nr+1) = 0.0 v_shear(Nr+1) = 0.0 DO m=Nr,1,-1 #ifdef ALLOW_AUTODIFF_TAMC act1 = bi - myBxLo(myThid) max1 = myBxHi(myThid) - myBxLo(myThid) + 1 act2 = bj - myByLo(myThid) max2 = myByHi(myThid) - myByLo(myThid) + 1 act3 = myThid - 1 max3 = nTx*nTy act4 = ikey_dynamics - 1 ikey_1 = m & + Nr*(i-1) & + Nr*sNx*(j-1) & + Nr*sNx*sNy*act1 & + Nr*sNx*sNy*max1*act2 & + Nr*sNx*sNy*max1*max2*act3 & + Nr*sNx*sNy*max1*max2*max3*act4 CADJ STORE visc_streamice_full(i,j,m,bi,bj) CADJ & = comlev1_stream_hybrid, key=ikey_1 #endif streamice_vert_shear_uz (m) = streamice_taubx(i,j,bi,bj) / & visc_streamice_full(i,j,m,bi,bj) & * streamice_sigma_coord(m) streamice_vert_shear_vz (m) = streamice_tauby(i,j,bi,bj) / & visc_streamice_full(i,j,m,bi,bj) & * streamice_sigma_coord(m) second_inv = & sqrt(exx**2+eyy**2+exx*eyy+exy**2+eps_glen_min**2+ & 0.25 * streamice_vert_shear_uz(m)**2 + & 0.25 * streamice_vert_shear_vz(m)**2) #ifdef STREAMICE_3D_GLEN_CONST #if (defined (ALLOW_STREAMICE_OAD_FP)) visc_full_new_si(i,j,m,bi,bj) = #else visc_streamice_full(i,j,m,bi,bj) = #endif & .5 * B_glen(i,j,m,bi,bj)**2 * & second_inv**((1-n_glen)/n_glen) #else #if (defined (ALLOW_STREAMICE_OAD_FP)) visc_full_new_si(i,j,m,bi,bj) = #else visc_streamice_full(i,j,m,bi,bj) = #endif & .5 * B_glen(i,j,bi,bj)**2 * & second_inv**((1-n_glen)/n_glen) #endif visc_streamice (i,j,bi,bj) = visc_streamice (i,j,bi,bj) + & H_streamice(i,j,bi,bj) * streamice_delsigma (m) * #if (defined (ALLOW_STREAMICE_OAD_FP)) & visc_full_new_si(i,j,m,bi,bj) #else & visc_streamice_full(i,j,m,bi,bj) #endif omega_temp (m) = omega_temp(m+1) + & streamice_sigma_coord(m) * streamice_delsigma(m) / #if (defined (ALLOW_STREAMICE_OAD_FP)) & visc_full_new_si(i,j,m,bi,bj) #else & visc_streamice_full(i,j,m,bi,bj) #endif u_shear (m) = u_shear (m+1) + & streamice_vert_shear_uz (m) * streamice_delsigma (m) * & H_streamice(i,j,bi,bj) v_shear (m) = v_shear (m+1) + & streamice_vert_shear_vz (m) * streamice_delsigma (m) * & H_streamice(i,j,bi,bj) ENDDO mean_u_shear = 0.0 mean_v_shear = 0.0 DO m=Nr,1,-1 streamice_omega(i,j,bi,bj) = streamice_omega(i,j,bi,bj) + & streamice_delsigma(m)*(omega_temp(m)+omega_temp(m+1))*.5 & * H_streamice(i,j,bi,bj)**2 mean_u_shear = mean_u_shear + & streamice_delsigma(m)*(u_shear(m)+u_shear(m+1))*.5 mean_v_shear = mean_v_shear + & streamice_delsigma(m)*(v_shear(m)+v_shear(m+1))*.5 ENDDO streamice_u_surf(i,j,bi,bj) = & u_shear(1) + umid - mean_u_shear streamice_v_surf(i,j,bi,bj) = & v_shear(1) + vmid - mean_v_shear ub = umid - streamice_taubx(i,j,bi,bj) * & streamice_omega(i,j,bi,bj) / H_streamice(i,j,bi,bj) streamice_u_bed (i,j,bi,bj) = ub vb = vmid - streamice_tauby(i,j,bi,bj) * & streamice_omega(i,j,bi,bj) / H_streamice(i,j,bi,bj) streamice_v_bed (i,j,bi,bj) = vb unorm = sqrt(ub**2+vb**2+eps_u_min**2) fb = C_basal_friction(i,j,bi,bj)**2 * & STREAMICE_BSTRESS_EXP (unorm,n_basal_friction) * & streamice_basal_geom(i,j,bi,bj) * & float_frac_streamice(i,j,bi,bj) tau_beta_eff_streamice(i,j,bi,bj) = & fb / & (1+fb*streamice_omega(i,j,bi,bj)/H_streamice(i,j,bi,bj)) #ifdef STREAMICE_FLOWLINE_BUTTRESS if (usestreamiceflowlineButtr) then tau_beta_eff_streamice(i,j,bi,bj) = & tau_beta_eff_streamice(i,j,bi,bj) + & buttr_param*B_glen(i,j,bi,bj)**2 * & STREAMICE_BSTRESS_EXP (unorm,pwr)* & H_streamice(i,j,bi,bj) endif #endif ENDIF ENDDO ENDDO ENDDO ENDDO #ifdef ALLOW_OPENAD #ifdef STREAMICE_HYBRID_STRESS tau_beta_eff_streamice(1,1,1,1) = & tau_beta_eff_streamice(1,1,1,1) + & 0. * streamice_u_surf(1,1,1,1) + & 0. * streamice_v_surf(1,1,1,1) #endif #endif #endif #endif RETURN END