File indexing completed on 2023-09-21 05:10:49 UTC
view on githubraw file Latest commit 96b00645 on 2023-09-20 15:15:14 UTC
96b006450c dngo*0001 #include "STREAMICE_OPTIONS.h"
0002 #ifdef ALLOW_AUTODIFF
0003 # include "AUTODIFF_OPTIONS.h"
0004 #endif
0005 #ifdef ALLOW_COST
0006 # include "COST_OPTIONS.h"
0007 #endif
0008
0009 subroutine streamice_cost_reg_accum ( myIter, myThid )
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019 IMPLICIT NONE
0020
0021
0022 #include "SIZE.h"
0023 #include "GRID.h"
0024 #include "EEPARAMS.h"
0025 #include "PARAMS.h"
0026 #include "DYNVARS.h"
0027 #ifdef ALLOW_STREAMICE
0028 # include "STREAMICE.h"
0029 #endif
0030
0031 #ifdef ALLOW_COST
0032 # include "cost.h"
0033 #endif
0034 #ifdef ALLOW_AUTODIFF_TAMC
0035 # include "tamc.h"
0036 #endif
0037
0038
0039
0040 integer myIter, myThid
0041
0042 #ifdef ALLOW_STREAMICE_TC_COST
0043
0044 _RL HAF
0045 integer i, j, k, bi, bj
0046 integer ig, jg
0047 integer itlo,ithi
0048 integer jtlo,jthi
0049 integer il
0050 logical calc_prior_cost_bglen
0051
0052 _RL i_numcells, dCdx, dCdy, dBdx, dBdy, gridtimfac, dMdx, dMdy
0053 _RL rhoi, rhow, r, i_r, surf_err, h, hf
0054 _RL cfricval, bglenval, cfricvalp1, bglenvalp1
0055
0056 if (STREAMICEBglenCostMaskFile .ne. ' ') then
0057 calc_prior_cost_bglen = .true.
0058 else
0059 calc_prior_cost_bglen = .false.
0060 endif
0061
0062 rhoi = streamice_density
0063 rhow = streamice_density_ocean_avg
0064 r=rhoi/rhow
0065 i_r = 1./r
0066 i_numcells = 1.0/(Nx*Ny)
0067 gridtimfac = i_numcells / nTimeSteps
0068
0069
0070 DO bj=myByLo(myThid),myByHi(myThid)
0071 DO bi=myBxLo(myThid),myBxHi(myThid)
0072 do j=1,sNy
0073 do i=1,sNx
0074
0075 cfricval = C_basal_friction(i,j,bi,bj)
0076 bglenval = B_glen(i,j,bi,bj)
0077
0078 cfricvalp1 = C_basal_friction(i+1,j,bi,bj)
0079 dCdx = (Cfricvalp1-cfricval)/
0080 & (dxC(i+1,j,bi,bj))
0081 cfricvalp1 = C_basal_friction(i,j+1,bi,bj)
0082 dCdy = (Cfricvalp1-cfricval)/
0083 & (dxC(i,j+1,bi,bj))
0084
0085 bglenvalp1 = B_glen(i+1,j,bi,bj)
0086 dBdx = (bglenvalp1-
0087 & bglenval) /
0088 & (dxC(i+1,j,bi,bj))
0089 bglenvalp1 = B_glen(i,j+1,bi,bj)
0090 dBdy = (bglenvalp1-
0091 & bglenval) /
0092 & (dyC(i,j+1,bi,bj))
0093 dMdx = (streamice_bdot_maxmelt_v(i+1,j,bi,bj)-
0094 & streamice_bdot_maxmelt_v(i,j,bi,bj)) /
0095 & (dxC(i+1,j,bi,bj))
0096 dMdy = (streamice_bdot_maxmelt_v(i,j+1,bi,bj)-
0097 & streamice_bdot_maxmelt_v(i,j,bi,bj)) /
0098 & (dyC(i+1,j,bi,bj))
0099
0100 if (streamice_hmask(i,j,bi,bj).eq.1.0) then
0101
0102 cost_func1_streamice(bi,bj) =
0103 & cost_func1_streamice(bi,bj) +
0104 & streamice_wgt_tikh_beta * (dCdx**2+dCdy**2) * gridtimfac
0105 cost_smooth_fric_streamice(bi,bj) =
0106 & cost_smooth_fric_streamice(bi,bj) +
0107 & streamice_wgt_tikh_beta * (dCdx**2+dCdy**2) * gridtimfac
0108
0109 cost_func1_streamice(bi,bj) =
0110 & cost_func1_streamice(bi,bj) +
0111 & streamice_wgt_tikh_bglen * (dBdx**2+dBdy**2) * gridtimfac
0112 cost_smooth_glen_streamice(bi,bj) =
0113 & cost_smooth_glen_streamice(bi,bj) +
0114 & streamice_wgt_tikh_bglen * (dBdx**2+dBdy**2) * gridtimfac
0115
0116 cost_func1_streamice(bi,bj) =
0117 & cost_func1_streamice(bi,bj) +
0118 & streamice_wgt_tikh_gen * (dMdx**2+dMdy**2) * gridtimfac
0119 cost_smooth_glen_streamice(bi,bj) =
0120 & cost_smooth_glen_streamice(bi,bj) +
0121 & streamice_wgt_tikh_gen * (dMdx**2+dMdy**2) * gridtimfac
0122
0123 h = H_streamice(i,j,bi,bj)
0124 hf = -1.0 * i_r * R_low_si (i,j,bi,bj)
0125
0126 IF ((h-hf) .gt. 5. .AND. B_glen0(i,j,bi,bj).gt.0.0 .and.
0127 & calc_prior_cost_bglen) then
0128
0129 cost_func1_streamice(bi,bj) =
0130 & cost_func1_streamice(bi,bj) +
0131 & streamice_wgt_prior_bglen * gridtimfac *
0132 & (B_glen(i,j,bi,bj)-B_glen0(i,j,bi,bj))**2
0133 cost_prior_streamice(bi,bj) =
0134 & cost_prior_streamice(bi,bj) +
0135 & streamice_wgt_prior_bglen * gridtimfac *
0136 & (B_glen(i,j,bi,bj)-B_glen0(i,j,bi,bj))**2
0137
0138 ENDIF
0139
0140 endif
0141
0142 end do
0143 end do
0144 end do
0145 end do
0146
0147 #endif
0148
0149 RETURN
0150 END
