File indexing completed on 2022-11-23 06:10:10 UTC
view on githubraw file Latest commit 20dee616 on 2022-11-22 15:45:38 UTC
38c3aa5b85 Mart*0001 #include "SEAICE_OPTIONS.h"
0002
0003
0004
0005
0006
0007 SUBROUTINE SEAICE_MOM_ADVECTION(
0008 I bi,bj,iMin,iMax,jMin,jMax,
0009 I uIceLoc, vIceLoc,
0010 O gU, gV,
0011 I myTime, myIter, myThid )
0012
0013
0014
0015
0016
0017
0018
0019
0020 IMPLICIT NONE
0021
0022
0023 #include "SIZE.h"
0024 #include "EEPARAMS.h"
0025 #include "PARAMS.h"
0026 #include "GRID.h"
0027 #include "SEAICE_SIZE.h"
0028 #include "SEAICE_PARAMS.h"
0029
0030
0031
0032
0033
0034
0035
0036
0037
0038
0039
0040
0041 INTEGER bi,bj
0042 INTEGER iMin,iMax,jMin,jMax
0043 _RL uIceLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0044 _RL vIceLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0045 _RL gU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0046 _RL gV(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0047 _RL myTime
0048 INTEGER myIter
0049 INTEGER myThid
0050
0051
0052 #ifdef SEAICE_ALLOW_MOM_ADVECTION
0053
0054
0055 LOGICAL DIFFERENT_MULTIPLE
0056 EXTERNAL DIFFERENT_MULTIPLE
0057
0058
0059 _RL uCf(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0060 _RL vCf(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0061 _RS hFacZ (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0062 _RS r_hFacZ (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0063 _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0064 _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0065 _RL KE (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0066 _RL vort3 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0067
0068
0069 INTEGER i,j,k
0070
0071
0072
0073 LOGICAL vorticityFlag
0074
0075
0076
0077
0078
0079
0080
0081
0082
0083
0084
0085 DO j=1-OLy,sNy+OLy
0086 DO i=1-OLx,sNx+OLx
0087 uCf(i,j) = 0.
0088 vCf(i,j) = 0.
0089 gU(i,j) = 0.
0090 gV(i,j) = 0.
0091 vort3(i,j) = 0.
0092 KE(i,j) = 0.
0093 #ifdef ALLOW_AUTODIFF
0094 hFacZ(i,j) = 0. _d 0
0095 #endif
0096 ENDDO
0097 ENDDO
0098
0099 k = 1
0100
0101 CALL MOM_CALC_HFACZ(bi,bj,k,hFacZ,r_hFacZ,myThid)
0102
0103
0104 DO j=1-OLy,sNy+OLy
0105 DO i=1-OLx,sNx+OLx
0106 uFld(i,j) = uIceLoc(i,j,bi,bj)
0107 vFld(i,j) = vIceLoc(i,j,bi,bj)
0108 ENDDO
0109 ENDDO
0110
0111 CALL MOM_CALC_KE(bi,bj,k,SEAICEselectKEscheme,uFld,vFld,KE,myThid)
0112
0113 CALL MOM_CALC_RELVORT3(bi,bj,k,uFld,vFld,hFacZ,vort3,myThid)
0114
0115
0116
0117
0118
0119
0120
0121
0122
0123
0124
0125
0126
0127 vorticityFlag = SEAICEhighOrderVorticity.OR.SEAICEupwindVorticity
0128 IF ( vorticityFlag ) THEN
0320e25227 Mart*0129 CALL MOM_VI_U_CORIOLIS_C4(bi,bj,k,SEAICEselectVortScheme,
38c3aa5b85 Mart*0130 & SEAICEhighOrderVorticity,
0131 & SEAICEupwindVorticity,
0132 & vFld,vort3,r_hFacZ,
0133 & uCf,myThid)
0134 ELSE
0320e25227 Mart*0135 CALL MOM_VI_U_CORIOLIS(bi,bj,k,SEAICEselectVortScheme,
38c3aa5b85 Mart*0136 & SEAICEuseJamartMomAdv,
0137 & vFld,vort3,hFacZ,r_hFacZ,
0138 & uCf,myThid)
0139 ENDIF
0140 DO j=jMin,jMax
0141 DO i=iMin,iMax
0142 gU(i,j) = gU(i,j)+uCf(i,j)
0143 ENDDO
0144 ENDDO
0145 IF ( vorticityFlag ) THEN
0320e25227 Mart*0146 CALL MOM_VI_V_CORIOLIS_C4(bi,bj,k,SEAICEselectVortScheme,
38c3aa5b85 Mart*0147 & SEAICEhighOrderVorticity,
0148 & SEAICEupwindVorticity,
0149 & uFld,vort3,r_hFacZ,
0150 & vCf,myThid)
0151 ELSE
0320e25227 Mart*0152 CALL MOM_VI_V_CORIOLIS(bi,bj,k,SEAICEselectVortScheme,
38c3aa5b85 Mart*0153 & SEAICEuseJamartMomAdv,
0154 & uFld,vort3,hFacZ,r_hFacZ,
0155 & vCf,myThid)
0156 ENDIF
0157 DO j=jMin,jMax
0158 DO i=iMin,iMax
0159 gV(i,j) = gV(i,j)+vCf(i,j)
0160 ENDDO
0161 ENDDO
0162
0163 #ifdef ALLOW_DIAGNOSTICS
0164 IF ( useDiagnostics ) THEN
0165 CALL DIAGNOSTICS_FILL(uCf,'SIuAdvZ3',k,1,2,bi,bj,myThid)
0166 CALL DIAGNOSTICS_FILL(vCf,'SIvAdvZ3',k,1,2,bi,bj,myThid)
0167 ENDIF
0168 #endif /* ALLOW_DIAGNOSTICS */
0169
0170
0171 CALL MOM_VI_U_GRAD_KE(bi,bj,k,KE,uCf,myThid)
0172 DO j=jMin,jMax
0173 DO i=iMin,iMax
0174 gU(i,j) = gU(i,j)+uCf(i,j)
0175 ENDDO
0176 ENDDO
0177 CALL MOM_VI_V_GRAD_KE(bi,bj,k,KE,vCf,myThid)
0178 DO j=jMin,jMax
0179 DO i=iMin,iMax
0180 gV(i,j) = gV(i,j)+vCf(i,j)
0181 ENDDO
0182 ENDDO
0183 #ifdef ALLOW_DIAGNOSTICS
0184 IF ( useDiagnostics ) THEN
0185 CALL DIAGNOSTICS_FILL(uCf,'SIKEx ',k,1,2,bi,bj,myThid)
0186 CALL DIAGNOSTICS_FILL(vCf,'SIKEy ',k,1,2,bi,bj,myThid)
0187 ENDIF
0188 #endif /* ALLOW_DIAGNOSTICS */
0189
0190
0191
0192 DO j=jMin,jMax
0193 DO i=iMin,iMax
0194 gU(i,j) = gU(i,j)*maskInW(i,j,bi,bj)
0195 gV(i,j) = gV(i,j)*maskInS(i,j,bi,bj)
0196 ENDDO
0197 ENDDO
0198
0199 #ifdef ALLOW_DIAGNOSTICS
0200 IF ( useDiagnostics ) THEN
0201 CALL DIAGNOSTICS_FILL(KE, 'SImomKE ',k,1,2,bi,bj,myThid)
0202 CALL DIAGNOSTICS_FILL(gU, 'SIuMmAdv',k,1,2,bi,bj,myThid)
0203 CALL DIAGNOSTICS_FILL(gV, 'SIvMmAdv',k,1,2,bi,bj,myThid)
0204 ENDIF
0205 #endif /* ALLOW_DIAGNOSTICS */
0206
0207 #endif /* SEAICE_ALLOW_MOM_ADVECTION */
0208
0209 RETURN
0210 END