File indexing completed on 2023-08-04 05:10:43 UTC
view on githubraw file Latest commit 45315406 on 2023-08-03 16:50:12 UTC
037351a1a6 Mart*0001 #include "SEAICE_OPTIONS.h"
fec75090d3 Jean*0002 #ifdef ALLOW_OBCS
0003 # include "OBCS_OPTIONS.h"
0004 #else
0005 # define OBCS_UVICE_OLD
0006 #endif
037351a1a6 Mart*0007
fec75090d3 Jean*0008
0009
0010
b4949dd6db Jean*0011 SUBROUTINE SEAICE_CALC_STRAINRATES(
037351a1a6 Mart*0012 I uFld, vFld,
7bdcfa8e6c Mart*0013 O e11Loc, e22Loc, e12Loc,
2e75568507 Mart*0014 I iStep, myTime, myIter, myThid )
fec75090d3 Jean*0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
037351a1a6 Mart*0026 IMPLICIT NONE
0027
0028
0029 #include "SIZE.h"
0030 #include "EEPARAMS.h"
0031 #include "PARAMS.h"
0032 #include "GRID.h"
03c669d1ab Jean*0033 #include "SEAICE_SIZE.h"
037351a1a6 Mart*0034 #include "SEAICE_PARAMS.h"
694d703a74 Mart*0035 #include "SEAICE.h"
037351a1a6 Mart*0036
fec75090d3 Jean*0037
037351a1a6 Mart*0038
fec75090d3 Jean*0039
0040
0041
0042
0043
b4949dd6db Jean*0044
0045
0046
0047
03c669d1ab Jean*0048 _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0049 _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
7bdcfa8e6c Mart*0050 _RL e11Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0051 _RL e22Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0052 _RL e12Loc (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
fec75090d3 Jean*0053 INTEGER iStep
0054 _RL myTime
0055 INTEGER myIter
0056 INTEGER myThid
0057
037351a1a6 Mart*0058
0059 #ifdef SEAICE_CGRID
fec75090d3 Jean*0060
037351a1a6 Mart*0061
fec75090d3 Jean*0062
037351a1a6 Mart*0063 INTEGER i, j, bi, bj
fec75090d3 Jean*0064
694d703a74 Mart*0065 _RS hFacU, hFacV, noSlipFac
5dac41bc68 Mart*0066 _RL third
0067 PARAMETER ( third = 0.333333333333333333333333333 _d 0 )
03cd49feda Mart*0068
0069
0070 _RL dudx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0071 _RL dvdy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0072 _RL dudy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0073 _RL dvdx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0074 _RL uave (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0075 _RL vave (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
ba20a6318c Mart*0076
694d703a74 Mart*0077 noSlipFac = 0. _d 0
0078 IF ( SEAICE_no_slip ) noSlipFac = 1. _d 0
4d92a76442 Mart*0079
0080
0081
037351a1a6 Mart*0082
694d703a74 Mart*0083 DO bj=myByLo(myThid),myByHi(myThid)
0084 DO bi=myBxLo(myThid),myBxHi(myThid)
03cd49feda Mart*0085
0086
03c669d1ab Jean*0087 DO j=1-OLy,sNy+OLy-1
0088 DO i=1-OLx,sNx+OLx-1
fec75090d3 Jean*0089 dudx(i,j) = _recip_dxF(i,j,bi,bj) *
0090 & (uFld(i+1,j,bi,bj)-uFld(i,j,bi,bj))
0091 uave(i,j) = 0.5 _d 0 * (uFld(i,j,bi,bj)+uFld(i+1,j,bi,bj))
03cd49feda Mart*0092 ENDDO
0093 ENDDO
03c669d1ab Jean*0094 DO j=1-OLy,sNy+OLy-1
0095 DO i=1-OLx,sNx+OLx-1
fec75090d3 Jean*0096 dvdy(i,j) = _recip_dyF(i,j,bi,bj) *
0097 & (vFld(i,j+1,bi,bj)-vFld(i,j,bi,bj))
0098 vave(i,j) = 0.5 _d 0 * (vFld(i,j,bi,bj)+vFld(i,j+1,bi,bj))
03cd49feda Mart*0099 ENDDO
0100 ENDDO
0101
03c669d1ab Jean*0102 DO j=1-OLy,sNy+OLy-1
0103 DO i=1-OLx,sNx+OLx-1
fec75090d3 Jean*0104 e11Loc(i,j,bi,bj) = dudx(i,j) + vave(i,j) * k2AtC(i,j,bi,bj)
0105 e22Loc(i,j,bi,bj) = dvdy(i,j) + uave(i,j) * k1AtC(i,j,bi,bj)
0106 ENDDO
0107 ENDDO
0108 #ifndef OBCS_UVICE_OLD
0109
03c669d1ab Jean*0110 DO j=1-OLy,sNy+OLy-1
0111 DO i=1-OLx,sNx+OLx-1
fec75090d3 Jean*0112 e11Loc(i,j,bi,bj) = e11Loc(i,j,bi,bj)*maskInC(i,j,bi,bj)
0113 e22Loc(i,j,bi,bj) = e22Loc(i,j,bi,bj)*maskInC(i,j,bi,bj)
694d703a74 Mart*0114 ENDDO
0115 ENDDO
fec75090d3 Jean*0116 #endif /* OBCS_UVICE_OLD */
0117
03cd49feda Mart*0118
0119
03c669d1ab Jean*0120 DO j=1-OLy+1,sNy+OLy
0121 DO i=1-OLx+1,sNx+OLx
fec75090d3 Jean*0122 dudy(i,j) = ( uFld(i,j,bi,bj) - uFld(i ,j-1,bi,bj) )
0123 & * _recip_dyU(i,j,bi,bj)
0124 uave(i,j) = 0.5 _d 0 * (uFld(i,j,bi,bj)+uFld(i ,j-1,bi,bj))
03cd49feda Mart*0125 ENDDO
0126 ENDDO
03c669d1ab Jean*0127 DO j=1-OLy+1,sNy+OLy
0128 DO i=1-OLx+1,sNx+OLx
fec75090d3 Jean*0129 dvdx(i,j) = ( vFld(i,j,bi,bj) - vFld(i-1,j ,bi,bj) )
0130 & * _recip_dxV(i,j,bi,bj)
0131 vave(i,j) = 0.5 _d 0 * (vFld(i,j,bi,bj)+vFld(i-1,j ,bi,bj))
03cd49feda Mart*0132 ENDDO
0133 ENDDO
0134
03c669d1ab Jean*0135 DO j=1-OLy+1,sNy+OLy
0136 DO i=1-OLx+1,sNx+OLx
ec0d7df165 Mart*0137 hFacU = SIMaskU(i,j,bi,bj) - SIMaskU(i,j-1,bi,bj)
0138 hFacV = SIMaskV(i,j,bi,bj) - SIMaskV(i-1,j,bi,bj)
fec75090d3 Jean*0139 e12Loc(i,j,bi,bj) = 0.5 _d 0 * (
0140 & dudy(i,j) + dvdx(i,j)
0141 & - k1AtZ(i,j,bi,bj) * vave(i,j)
0142 & - k2AtZ(i,j,bi,bj) * uave(i,j)
694d703a74 Mart*0143 & )
ec0d7df165 Mart*0144 & *HEFFM(i ,j ,bi,bj)*HEFFM(i-1,j ,bi,bj)
0145 & *HEFFM(i ,j-1,bi,bj)*HEFFM(i-1,j-1,bi,bj)
4d92a76442 Mart*0146 & + noSlipFac * (
fec75090d3 Jean*0147 & 2.0 _d 0 * uave(i,j) * _recip_dyU(i,j,bi,bj) * hFacU
0148 & + 2.0 _d 0 * vave(i,j) * _recip_dxV(i,j,bi,bj) * hFacV
694d703a74 Mart*0149 & )
0150
0151
0152
fec75090d3 Jean*0153
0154
694d703a74 Mart*0155 ENDDO
0156 ENDDO
5dac41bc68 Mart*0157 IF ( SEAICE_no_slip .AND. SEAICE_2ndOrderBC ) THEN
0158 DO j=1-OLy+2,sNy+OLy-1
0159 DO i=1-OLx+2,sNx+OLx-1
ec0d7df165 Mart*0160 hFacU = (SIMaskU(i,j,bi,bj) - SIMaskU(i,j-1,bi,bj))*third
0161 hFacV = (SIMaskV(i,j,bi,bj) - SIMaskV(i-1,j,bi,bj))*third
0162 hFacU = hFacU*( SIMaskU(i,j-2,bi,bj)*SIMaskU(i,j-1,bi,bj)
0163 & + SIMaskU(i,j+1,bi,bj)*SIMaskU(i,j, bi,bj) )
0164 hFacV = hFacV*( SIMaskV(i-2,j,bi,bj)*SIMaskV(i-1,j,bi,bj)
0165 & + SIMaskV(i+1,j,bi,bj)*SIMaskV(i ,j,bi,bj) )
5dac41bc68 Mart*0166
4e4ad91a39 Jean*0167
5dac41bc68 Mart*0168
0169
0170
0171
0172
0173
4e4ad91a39 Jean*0174
5dac41bc68 Mart*0175
0176
0177
0178 e12Loc(i,j,bi,bj) = e12Loc(i,j,bi,bj) + 0.5 _d 0 * (
4e4ad91a39 Jean*0179 & _recip_dyU(i,j,bi,bj) * ( 6.0 _d 0 * uave(i,j)
ec0d7df165 Mart*0180 & - uFld(i,j-2,bi,bj)*SIMaskU(i,j-1,bi,bj)
0181 & - uFld(i,j+1,bi,bj)*SIMaskU(i,j ,bi,bj) ) * hFacU
5dac41bc68 Mart*0182 & + _recip_dxV(i,j,bi,bj) * ( 6.0 _d 0 * vave(i,j)
ec0d7df165 Mart*0183 & - vFld(i-2,j,bi,bj)*SIMaskV(i-1,j,bi,bj)
0184 & - vFld(i+1,j,bi,bj)*SIMaskV(i ,j,bi,bj) ) * hFacV
5dac41bc68 Mart*0185 & )
0186 ENDDO
0187 ENDDO
0188 ENDIF
694d703a74 Mart*0189 ENDDO
0190 ENDDO
4f95e6bec9 Gael*0191
4e4ad91a39 Jean*0192 #ifdef ALLOW_AUTODIFF
4f95e6bec9 Gael*0193 #ifdef SEAICE_DYN_STABLE_ADJOINT
0194
0195 CALL ZERO_ADJ( 1, e11Loc, myThid)
0196 CALL ZERO_ADJ( 1, e12Loc, myThid)
0197 CALL ZERO_ADJ( 1, e22Loc, myThid)
0198 #endif
4e4ad91a39 Jean*0199 #endif /* ALLOW_AUTODIFF */
4f95e6bec9 Gael*0200
037351a1a6 Mart*0201 #endif /* SEAICE_CGRID */
0202 RETURN
0203 END