File indexing completed on 2018-03-02 18:37:41 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
b2ea1d2979 Jean*0001 #include "ATM_PHYS_OPTIONS.h"
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014 SUBROUTINE ATM_PHYS_TENDENCY_APPLY_U(
73b1dccda0 Jean*0015 U gU_arr,
0016 I iMin,iMax,jMin,jMax, k, bi, bj,
0017 I myTime, myIter, myThid )
b2ea1d2979 Jean*0018
0019
0020
0021
0022
0023
0024 IMPLICIT NONE
0025 #include "SIZE.h"
0026 #include "EEPARAMS.h"
0d5d00bd7f Jean*0027 #include "PARAMS.h"
0028 #include "GRID.h"
b2ea1d2979 Jean*0029 #include "DYNVARS.h"
0d5d00bd7f Jean*0030 #include "FFIELDS.h"
b2ea1d2979 Jean*0031 #include "ATM_PHYS_PARAMS.h"
0032 #include "ATM_PHYS_VARS.h"
0033
73b1dccda0 Jean*0034
0035
0036
0037
0038
0039
0040
0041
0042
0043 _RL gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0044 INTEGER iMin, iMax, jMin, jMax
0045 INTEGER k, bi, bj
0046 _RL myTime
0047 INTEGER myIter
0048 INTEGER myThid
b2ea1d2979 Jean*0049
0050
0051
0052 INTEGER i, j
0d5d00bd7f Jean*0053 _RL damp_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
b2ea1d2979 Jean*0054
0055 IF ( atmPhys_addTendU ) THEN
0d5d00bd7f Jean*0056
b2ea1d2979 Jean*0057
0058 DO j=jMin,jMax
0059 DO i=iMin,iMax
73b1dccda0 Jean*0060 gU_arr(i,j) = gU_arr(i,j)
55a26a1b95 Jean*0061 & + halfRL *( atmPhys_dU(i-1,j,k,bi,bj)
0062 & + atmPhys_dU( i ,j,k,bi,bj)
0063 & )*recip_hFacW(i,j,k,bi,bj)
0064
b2ea1d2979 Jean*0065 ENDDO
0066 ENDDO
0d5d00bd7f Jean*0067
0068 IF ( atmPhys_dampUVfac(k).GT.zeroRL ) THEN
0069 DO j=jMin,jMax
0070 DO i=iMin,iMax
73b1dccda0 Jean*0071 gU_arr(i,j) = gU_arr(i,j)
0d5d00bd7f Jean*0072 & - maskW(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)*atmPhys_dampUVfac(k)
0073 damp_dKE(i,j) =
0074 & - uVel(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)*atmPhys_dampUVfac(k)
0075 & *hFacW(i,j,k,bi,bj)*drF(k)*rUnit2mass
0076 ENDDO
0077 ENDDO
0078 #ifdef ALLOW_FRICTION_HEATING
0079 IF ( addFrictionHeating ) THEN
0080 DO j=1,sNy
0081 DO i=1,sNx
0082 frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj)
e24c9bfc82 Jean*0083 & - halfRL * ( damp_dKE( i, j)*rAw( i, j,bi,bj)
0084 & + damp_dKE(i+1,j)*rAw(i+1,j,bi,bj)
0085 & )*recip_rA(i,j,bi,bj)
0d5d00bd7f Jean*0086 ENDDO
0087 ENDDO
0088 ENDIF
0089 #endif /* ALLOW_FRICTION_HEATING */
0090 ENDIF
0091
b2ea1d2979 Jean*0092 ENDIF
0093
0094 RETURN
0095 END
0096
0097
0098
0099
0100
0101
0102 SUBROUTINE ATM_PHYS_TENDENCY_APPLY_V(
73b1dccda0 Jean*0103 U gV_arr,
0104 I iMin,iMax,jMin,jMax, k, bi, bj,
0105 I myTime, myIter, myThid )
b2ea1d2979 Jean*0106
0107
0108
0109
0110
0111
0112 IMPLICIT NONE
0113 #include "SIZE.h"
0114 #include "EEPARAMS.h"
0d5d00bd7f Jean*0115 #include "PARAMS.h"
0116 #include "GRID.h"
b2ea1d2979 Jean*0117 #include "DYNVARS.h"
0d5d00bd7f Jean*0118 #include "FFIELDS.h"
b2ea1d2979 Jean*0119 #include "ATM_PHYS_PARAMS.h"
0120 #include "ATM_PHYS_VARS.h"
0121
73b1dccda0 Jean*0122
0123
0124
0125
0126
0127
0128
0129
0130
0131 _RL gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0132 INTEGER iMin, iMax, jMin, jMax
0133 INTEGER k, bi, bj
0134 _RL myTime
0135 INTEGER myIter
0136 INTEGER myThid
b2ea1d2979 Jean*0137
0138
0139
0140 INTEGER i, j
0d5d00bd7f Jean*0141 _RL damp_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
b2ea1d2979 Jean*0142
0143 IF ( atmPhys_addTendV ) THEN
0d5d00bd7f Jean*0144
b2ea1d2979 Jean*0145
0146 DO j=jMin,jMax
0147 DO i=iMin,iMax
73b1dccda0 Jean*0148 gV_arr(i,j) = gV_arr(i,j)
55a26a1b95 Jean*0149 & + halfRL *( atmPhys_dV(i,j-1,k,bi,bj)
0150 & + atmPhys_dV(i, j ,k,bi,bj)
0151 & )*recip_hFacS(i,j,k,bi,bj)
0152
b2ea1d2979 Jean*0153 ENDDO
0154 ENDDO
0d5d00bd7f Jean*0155
0156 IF ( atmPhys_dampUVfac(k).GT.zeroRL ) THEN
0157 DO j=jMin,jMax
0158 DO i=iMin,iMax
73b1dccda0 Jean*0159 gV_arr(i,j) = gV_arr(i,j)
0d5d00bd7f Jean*0160 & - maskS(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)*atmPhys_dampUVfac(k)
0161 damp_dKE(i,j) =
0162 & - vVel(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)*atmPhys_dampUVfac(k)
0163 & *hFacS(i,j,k,bi,bj)*drF(k)*rUnit2mass
0164 ENDDO
0165 ENDDO
0166 #ifdef ALLOW_FRICTION_HEATING
0167 IF ( addFrictionHeating ) THEN
0168 DO j=1,sNy
0169 DO i=1,sNx
0170 frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj)
e24c9bfc82 Jean*0171 & - halfRL * ( damp_dKE( i, j)*rAs(i, j ,bi,bj)
35a4256c85 Jean*0172 & + damp_dKE(i,j+1)*rAs(i,j+1,bi,bj)
e24c9bfc82 Jean*0173 & )*recip_rA(i,j,bi,bj)
0d5d00bd7f Jean*0174 ENDDO
0175 ENDDO
0176 ENDIF
0177 #endif /* ALLOW_FRICTION_HEATING */
0178 ENDIF
0179
b2ea1d2979 Jean*0180 ENDIF
0181
0182 RETURN
0183 END
0184
0185
0186
0187
0188
0189
0190 SUBROUTINE ATM_PHYS_TENDENCY_APPLY_T(
73b1dccda0 Jean*0191 U gT_arr,
0192 I iMin,iMax,jMin,jMax, k, bi, bj,
0193 I myTime, myIter, myThid )
b2ea1d2979 Jean*0194
0195
0196
0197
0198
0199
0200 IMPLICIT NONE
0201 #include "SIZE.h"
0202 #include "GRID.h"
0203 #include "EEPARAMS.h"
73b1dccda0 Jean*0204
b2ea1d2979 Jean*0205 #include "ATM_PHYS_PARAMS.h"
0206 #include "ATM_PHYS_VARS.h"
0207
73b1dccda0 Jean*0208
0209
0210
0211
0212
0213
0214
0215
0216
0217 _RL gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0218 INTEGER iMin, iMax, jMin, jMax
0219 INTEGER k, bi, bj
0220 _RL myTime
0221 INTEGER myIter
0222 INTEGER myThid
b2ea1d2979 Jean*0223
0224
0225
0226 INTEGER i, j
0227
0228 IF ( atmPhys_addTendT ) THEN
0229 DO j=jMin,jMax
0230 DO i=iMin,iMax
73b1dccda0 Jean*0231 gT_arr(i,j) = gT_arr(i,j)
b2ea1d2979 Jean*0232 & + maskC(i,j,k,bi,bj) * atmPhys_dT(i,j,k,bi,bj)
0233 ENDDO
0234 ENDDO
0235 ENDIF
0236
0237 RETURN
0238 END
0239
0240
0241
0242
0243
0244
0245 SUBROUTINE ATM_PHYS_TENDENCY_APPLY_S(
73b1dccda0 Jean*0246 U gS_arr,
0247 I iMin,iMax,jMin,jMax, k, bi, bj,
0248 I myTime, myIter, myThid )
b2ea1d2979 Jean*0249
0250
0251
0252
0253
73b1dccda0 Jean*0254
b2ea1d2979 Jean*0255 IMPLICIT NONE
0256 #include "SIZE.h"
0257 #include "GRID.h"
0258 #include "EEPARAMS.h"
73b1dccda0 Jean*0259
b2ea1d2979 Jean*0260 #include "ATM_PHYS_PARAMS.h"
0261 #include "ATM_PHYS_VARS.h"
0262
73b1dccda0 Jean*0263
0264
0265
0266
0267
0268
0269
0270
0271
0272 _RL gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0273 INTEGER iMin, iMax, jMin, jMax
0274 INTEGER k, bi, bj
0275 _RL myTime
0276 INTEGER myIter
0277 INTEGER myThid
b2ea1d2979 Jean*0278
0279
0280
0281 INTEGER i, j
0282
0283 IF ( atmPhys_addTendS ) THEN
0284 DO j=jMin,jMax
0285 DO i=iMin,iMax
73b1dccda0 Jean*0286 gS_arr(i,j) = gS_arr(i,j)
b2ea1d2979 Jean*0287 & + maskC(i,j,k,bi,bj) * atmPhys_dQ(i,j,k,bi,bj)
0288 ENDDO
0289 ENDDO
0290 ENDIF
0291
0292 RETURN
0293 END