Back to home page

MITgcm
 
 

    

File indexing completed on 2020-04-22 05:11:28 UTC

view on githubraw file Latest commit 07e78522 on 2020-04-21 13:33:29 UTC
bdd8102d3e Dani*0001 #include "STREAMICE_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 
                0005 CBOP
07e785229e dngo*0006       SUBROUTINE STREAMICE_FORCED_BUTTRESS( myThid )
                0007 c      O taudx,
                0008 c      O taudy )
bdd8102d3e Dani*0009 
07e785229e dngo*0010 C     *============================================================*
                0011 C     | SUBROUTINE                                                 |
bdd8102d3e Dani*0012 C     | o                                                          |
07e785229e dngo*0013 C     *============================================================*
bdd8102d3e Dani*0014 C     |                                                            |
07e785229e dngo*0015 C     *============================================================*
bdd8102d3e Dani*0016       IMPLICIT NONE
                0017 
                0018 C     === Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
                0023 #include "STREAMICE.h"
                0024 #include "STREAMICE_CG.h"
                0025 
                0026 C     !INPUT/OUTPUT ARGUMENTS
                0027       INTEGER myThid
07e785229e dngo*0028 c       _RL taudx (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0029 c       _RL taudy (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
bdd8102d3e Dani*0030 
                0031 #ifdef ALLOW_STREAMICE
                0032 #ifdef STREAMICE_STRESS_BOUNDARY_CONTROL
                0033 
                0034 C     LOCAL VARIABLES
07e785229e dngo*0035       INTEGER i, j, bi, bj, k
e0987c9b93 Dani*0036       _RL unconf_stress, i_rhow
                0037       _RL avg_density
                0038      & (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0039 #ifdef STREAMICE_FIRN_CORRECTION
                0040       _RL firn_depth, h
                0041 #endif
                0042 
                0043       i_rhow = 1./streamice_density_ocean_avg
                0044 #ifdef STREAMICE_FIRN_CORRECTION
07e785229e dngo*0045       firn_depth = streamice_density *
e0987c9b93 Dani*0046      &    streamice_firn_correction
                0047      & / (streamice_density-streamice_density_firn)
07e785229e dngo*0048 #endif /* STREAMICE_FIRN_CORRECTION */
                0049 
e0987c9b93 Dani*0050       DO bj = myByLo(myThid), myByHi(myThid)
                0051        DO bi = myBxLo(myThid), myBxHi(myThid)
                0052         DO j=1-OLy+1,sNy+OLy-1
                0053          DO i=1-OLx+1,sNx+OLx-1
                0054 #ifdef STREAMICE_FIRN_CORRECTION
                0055           if (STREAMICE_apply_firn_correction) then
                0056            if (streamice_hmask(i,j,bi,bj).eq.1) then
                0057             h = h_streamice(i,j,bi,bj)
                0058             if (h.lt.firn_depth) then
                0059              avg_density(i,j,bi,bj) = streamice_density_firn
                0060             else
07e785229e dngo*0061              avg_density(i,j,bi,bj) = streamice_density *
e0987c9b93 Dani*0062      &        (h - streamice_firn_correction) / h
                0063             endif
                0064            endif
                0065           else
07e785229e dngo*0066 #endif /* STREAMICE_FIRN_CORRECTION */
e0987c9b93 Dani*0067            avg_density(i,j,bi,bj) = streamice_density
                0068 #ifdef STREAMICE_FIRN_CORRECTION
                0069           endif
07e785229e dngo*0070 #endif /* STREAMICE_FIRN_CORRECTION */
e0987c9b93 Dani*0071          ENDDO
                0072         ENDDO
                0073        ENDDO
                0074       ENDDO
                0075 
bdd8102d3e Dani*0076       DO bj = myByLo(myThid), myByHi(myThid)
                0077        DO bi = myBxLo(myThid), myBxHi(myThid)
                0078         DO j=1-OLy+1,sNy+OLy-1
                0079          DO i=1-OLy+1,sNx+OLy-1
07e785229e dngo*0080 c         taudx_SI(i,j,bi,bj) = 0. _d 0
                0081 c         taudy_SI(i,j,bi,bj) = 0. _d 0
                0082           IF (streamice_hmask(i,j,bi,bj).eq.1.0) THEN
bdd8102d3e Dani*0083 
                0084             ! baseline unconfined stress
                0085 
                0086             IF (float_frac_streamice(i,j,bi,bj) .eq. 1.0) THEN
                0087 
                0088               unconf_stress = gravity *
e0987c9b93 Dani*0089      &         (avg_density(i,j,bi,bj) * H_streamice(i,j,bi,bj)**2 -
bdd8102d3e Dani*0090 #ifdef USE_ALT_RLOW
                0091      &          streamice_density_ocean_avg * R_low_si(i,j,bi,bj)**2)
07e785229e dngo*0092 #else
bdd8102d3e Dani*0093      &          streamice_density_ocean_avg * R_low(i,j,bi,bj)**2)
                0094 #endif
                0095 
                0096             ELSE
                0097 
e0987c9b93 Dani*0098 #ifdef STREAMICE_FIRN_CORRECTION
                0099              if (STREAMICE_apply_firn_correction) then
                0100 
07e785229e dngo*0101               if (H_streamice(i,j,bi,bj).lt.firn_depth) then
                0102                unconf_stress =
                0103      &          streamice_density_firn * gravity *
                0104      &          (1-streamice_density_firn*i_rhow) *
                0105      &          H_streamice(i,j,bi,bj)**2
                0106               else
                0107                unconf_stress = gravity * (
                0108      &          streamice_density_firn * firn_depth**2 +
                0109      &          (h_streamice(i,j,bi,bj)-firn_depth) *
                0110      &           (streamice_density_firn*firn_depth+streamice_density*
                0111      &           (h_streamice(i,j,bi,bj)-streamice_firn_correction)) -
                0112      &          streamice_density**2*i_rhow*
                0113      &           (h_streamice(i,j,bi,bj)-streamice_firn_correction)**2
                0114      &          )
                0115               endif
                0116 
                0117              else
                0118 #endif /* STREAMICE_FIRN_CORRECTION */
e0987c9b93 Dani*0119 
bdd8102d3e Dani*0120               unconf_stress = streamice_density * gravity *
                0121      &         (1-streamice_density/streamice_density_ocean_avg) *
                0122      &          H_streamice(i,j,bi,bj)**2
                0123 
e0987c9b93 Dani*0124 #ifdef STREAMICE_FIRN_CORRECTION
                0125              endif
07e785229e dngo*0126 #endif /* STREAMICE_FIRN_CORRECTION */
e0987c9b93 Dani*0127 
bdd8102d3e Dani*0128             ENDIF
                0129 
                0130             ! right face
                0131 
                0132             if (streamice_ufacemask(i+1,j,bi,bj).eq.2.0) then
                0133 
                0134              do k=0,1
                0135               if (streamice_umask(i+1,j+k,bi,bj).eq.1.0) then
                0136 
07e785229e dngo*0137 c               if ((j+k).eq.10) then
                0138 c                print *, "GOT HERE 1", unconf_stress,
                0139 c     &               taudx_SI(i+1,j+k,bi,bj)
                0140 c               endif
bdd8102d3e Dani*0141 
                0142                taudx_SI(i+1,j+k,bi,bj) = taudx_SI(i+1,j+k,bi,bj) +
07e785229e dngo*0143      &          (streamice_u_normal_pert(i+1,j,bi,bj)  +
bdd8102d3e Dani*0144      &           streamice_u_normal_stress(i+1,j,bi,bj)) *
                0145      &          .5 * unconf_stress * dyG(i+1,j,bi,bj)
                0146 
                0147                taudy_SI(i+1,j+k,bi,bj) = taudy_SI(i+1,j+k,bi,bj) +
                0148      &         (streamice_v_shear_pert(i+1,j,bi,bj) +
                0149      &          streamice_v_shear_stress(i+1,j,bi,bj)) *
                0150      &          .5 * unconf_stress * dyG(i+1,j,bi,bj)
                0151 
07e785229e dngo*0152 c               if ((j+k).eq.10) then
                0153 c                print *, "GOT HERE 1", taudx_SI(i+1,j+k,bi,bj)
                0154 c               endif
e0987c9b93 Dani*0155 
bdd8102d3e Dani*0156               endif
                0157              enddo
07e785229e dngo*0158             endif
bdd8102d3e Dani*0159 
                0160             ! left face
                0161 
                0162             if (streamice_ufacemask(i,j,bi,bj).eq.2.0) then
                0163 
                0164              do k=0,1
                0165               if (streamice_umask(i,j+k,bi,bj).eq.1.0) then
                0166 
                0167                taudx_SI(i,j+k,bi,bj) = taudx_SI(i,j+k,bi,bj) -
                0168      &         (streamice_u_normal_pert(i,j,bi,bj) +
                0169      &          streamice_u_normal_stress(i,j,bi,bj)) *
                0170      &          .5 * unconf_stress * dyG(i,j,bi,bj)
                0171 
                0172                taudy_SI(i,j+k,bi,bj) = taudy_SI(i,j+k,bi,bj) -
                0173      &         (streamice_v_shear_pert(i,j,bi,bj) +
                0174      &          streamice_v_shear_stress(i,j,bi,bj)) *
                0175      &          .5 * unconf_stress * dyG(i,j,bi,bj)
                0176 
                0177               endif
                0178              enddo
                0179             endif
                0180 
                0181             if (streamice_vfacemask(i,j+1,bi,bj).eq.2.0) then
                0182 
                0183              do k=0,1
                0184               if (streamice_umask(i+k,j+1,bi,bj).eq.1.0) then
                0185 
                0186                taudy_SI(i+k,j+1,bi,bj) = taudy_SI(i+k,j+1,bi,bj) +
                0187      &         (streamice_v_normal_pert(i,j+1,bi,bj) +
                0188      &          streamice_v_normal_stress(i,j+1,bi,bj)) *
                0189      &           .5 * dxG(i,j+1,bi,bj) * unconf_stress
                0190 
                0191                taudx_SI(i+k,j+1,bi,bj) = taudx_SI(i+k,j+1,bi,bj) +
                0192      &         (streamice_u_shear_pert(i,j+1,bi,bj) +
                0193      &          streamice_u_shear_stress(i,j+1,bi,bj)) *
                0194      &          .5 * unconf_stress * dxG(i,j+1,bi,bj)
                0195 
                0196               endif
                0197              enddo
                0198             endif
                0199 
                0200             if (streamice_vfacemask(i,j,bi,bj).eq.2.0) then
07e785229e dngo*0201 
bdd8102d3e Dani*0202              do k=0,1
                0203               if (streamice_umask(i+k,j,bi,bj).eq.1.0) then
                0204 
                0205                taudy_SI(i+k,j,bi,bj) = taudy_SI(i+k,j,bi,bj) -
                0206      &         (streamice_v_normal_pert(i,j,bi,bj) +
                0207      &          streamice_v_normal_stress(i,j,bi,bj)) *
                0208      &          .5 * dxG(i,j,bi,bj) * unconf_stress
                0209 
                0210                taudx_SI(i+k,j,bi,bj) = taudx_SI(i+k,j,bi,bj) -
                0211      &         (streamice_u_shear_pert(i,j,bi,bj) +
                0212      &          streamice_u_shear_stress(i,j,bi,bj)) *
                0213      &          .5 * unconf_stress * dxG(i,j,bi,bj)
                0214 
                0215               endif
                0216              enddo
                0217             endif
07e785229e dngo*0218 
                0219           ENDIF
bdd8102d3e Dani*0220          ENDDO
                0221         ENDDO
                0222        ENDDO
                0223       ENDDO
07e785229e dngo*0224 
                0225 #endif /* STREAMICE_STRESS_BOUNDARY_CONTROL */
                0226 #endif /* ALLOW_STREAMICE */
bdd8102d3e Dani*0227       RETURN
                0228       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!