Changeset 854 for codes/icosagcm/devel/src/dynamics
- Timestamp:
- 05/05/19 21:39:45 (5 years ago)
- Location:
- codes/icosagcm/devel/src/dynamics
- Files:
-
- 1 added
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/dynamics/caldyn_hevi.f90
r853 r854 11 11 USE compute_caldyn_slow_NH_mod, ONLY : compute_caldyn_slow_NH 12 12 USE compute_caldyn_solver_mod, ONLY : compute_caldyn_solver 13 USE compute_caldyn_fast_mod, ONLY : compute_caldyn_fast 13 14 IMPLICIT NONE 14 15 PRIVATE -
codes/icosagcm/devel/src/dynamics/caldyn_kernels_hevi.F90
r853 r854 13 13 LOGICAL, SAVE :: debug_hevi_solver = .FALSE. 14 14 15 PUBLIC :: compute_ caldyn_fast,compute_NH_geopot15 PUBLIC :: compute_NH_geopot 16 16 17 17 CONTAINS … … 183 183 END SUBROUTINE compute_NH_geopot 184 184 185 SUBROUTINE compute_caldyn_fast(tau,u,rhodz,theta,pk,geopot,du)186 REAL(rstd),INTENT(IN) :: tau ! "solve" u-tau*du/dt = rhs187 REAL(rstd),INTENT(INOUT) :: u(iim*3*jjm,llm) ! OUT if tau>0188 REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm)189 REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm,nqdyn)190 REAL(rstd),INTENT(INOUT) :: pk(iim*jjm,llm)191 REAL(rstd),INTENT(INOUT) :: geopot(iim*jjm,llm+1)192 REAL(rstd),INTENT(INOUT) :: du(iim*3*jjm,llm)193 REAL(rstd) :: berni(iim*jjm,llm) ! Bernoulli function194 REAL(rstd) :: berniv(iim*jjm,llm) ! moist Bernoulli function195 196 INTEGER :: i,j,ij,l197 REAL(rstd) :: cp_ik, qv, temp, chi, nu, due, due_right, due_lup, due_ldown198 199 CALL trace_start("compute_caldyn_fast")200 201 IF(dysl_caldyn_fast) THEN202 #include "../kernels_hex/caldyn_fast.k90"203 ELSE204 205 ! Compute Bernoulli term206 IF(boussinesq) THEN207 DO l=ll_begin,ll_end208 !DIR$ SIMD209 DO ij=ij_begin,ij_end210 berni(ij,l) = pk(ij,l)211 ! from now on pk contains the vertically-averaged geopotential212 pk(ij,l) = .5*(geopot(ij,l)+geopot(ij,l+1))213 END DO214 END DO215 ELSE ! compressible216 217 DO l=ll_begin,ll_end218 SELECT CASE(caldyn_thermo)219 CASE(thermo_theta) ! vdp = theta.dpi => B = Phi220 !DIR$ SIMD221 DO ij=ij_begin,ij_end222 berni(ij,l) = .5*(geopot(ij,l)+geopot(ij,l+1))223 END DO224 CASE(thermo_entropy) ! vdp = dG + sdT => B = Phi + G, G=h-Ts=T*(cpp-s)225 !DIR$ SIMD226 DO ij=ij_begin,ij_end227 berni(ij,l) = .5*(geopot(ij,l)+geopot(ij,l+1)) &228 + pk(ij,l)*(cpp-theta(ij,l,1)) ! pk=temperature, theta=entropy229 END DO230 CASE(thermo_moist)231 !DIR$ SIMD232 DO ij=ij_begin,ij_end233 ! du/dt = grad(Bd)+rv.grad(Bv)+s.grad(T)234 ! Bd = Phi + gibbs_d235 ! Bv = Phi + gibbs_v236 ! pk=temperature, theta=entropy237 qv = theta(ij,l,2)238 temp = pk(ij,l)239 chi = log(temp/Treff)240 nu = (chi*(cpp+qv*cppv)-theta(ij,l,1))/(Rd+qv*Rv) ! log(p/preff)241 berni(ij,l) = .5*(geopot(ij,l)+geopot(ij,l+1)) &242 + temp*(cpp*(1.-chi)+Rd*nu)243 berniv(ij,l) = .5*(geopot(ij,l)+geopot(ij,l+1)) &244 + temp*(cppv*(1.-chi)+Rv*nu)245 END DO246 END SELECT247 END DO248 249 END IF ! Boussinesq/compressible250 251 !!! u:=u+tau*du, du = -grad(B)-theta.grad(pi)252 DO l=ll_begin,ll_end253 IF(caldyn_thermo == thermo_moist) THEN254 !DIR$ SIMD255 DO ij=ij_begin,ij_end256 due_right = berni(ij+t_right,l)-berni(ij,l) &257 + 0.5*(theta(ij,l,1)+theta(ij+t_right,l,1)) &258 *(pk(ij+t_right,l)-pk(ij,l)) &259 + 0.5*(theta(ij,l,2)+theta(ij+t_right,l,2)) &260 *(berniv(ij+t_right,l)-berniv(ij,l))261 262 due_lup = berni(ij+t_lup,l)-berni(ij,l) &263 + 0.5*(theta(ij,l,1)+theta(ij+t_lup,l,1)) &264 *(pk(ij+t_lup,l)-pk(ij,l)) &265 + 0.5*(theta(ij,l,2)+theta(ij+t_lup,l,2)) &266 *(berniv(ij+t_lup,l)-berniv(ij,l))267 268 due_ldown = berni(ij+t_ldown,l)-berni(ij,l) &269 + 0.5*(theta(ij,l,1)+theta(ij+t_ldown,l,1)) &270 *(pk(ij+t_ldown,l)-pk(ij,l)) &271 + 0.5*(theta(ij,l,2)+theta(ij+t_ldown,l,2)) &272 *(berniv(ij+t_ldown,l)-berniv(ij,l))273 274 du(ij+u_right,l) = du(ij+u_right,l) - ne_right*due_right275 du(ij+u_lup,l) = du(ij+u_lup,l) - ne_lup*due_lup276 du(ij+u_ldown,l) = du(ij+u_ldown,l) - ne_ldown*due_ldown277 u(ij+u_right,l) = u(ij+u_right,l) + tau*du(ij+u_right,l)278 u(ij+u_lup,l) = u(ij+u_lup,l) + tau*du(ij+u_lup,l)279 u(ij+u_ldown,l) = u(ij+u_ldown,l) + tau*du(ij+u_ldown,l)280 END DO281 ELSE282 !DIR$ SIMD283 DO ij=ij_begin,ij_end284 due_right = 0.5*(theta(ij,l,1)+theta(ij+t_right,l,1)) &285 *(pk(ij+t_right,l)-pk(ij,l)) &286 + berni(ij+t_right,l)-berni(ij,l)287 due_lup = 0.5*(theta(ij,l,1)+theta(ij+t_lup,l,1)) &288 *(pk(ij+t_lup,l)-pk(ij,l)) &289 + berni(ij+t_lup,l)-berni(ij,l)290 due_ldown = 0.5*(theta(ij,l,1)+theta(ij+t_ldown,l,1)) &291 *(pk(ij+t_ldown,l)-pk(ij,l)) &292 + berni(ij+t_ldown,l)-berni(ij,l)293 du(ij+u_right,l) = du(ij+u_right,l) - ne_right*due_right294 du(ij+u_lup,l) = du(ij+u_lup,l) - ne_lup*due_lup295 du(ij+u_ldown,l) = du(ij+u_ldown,l) - ne_ldown*due_ldown296 u(ij+u_right,l) = u(ij+u_right,l) + tau*du(ij+u_right,l)297 u(ij+u_lup,l) = u(ij+u_lup,l) + tau*du(ij+u_lup,l)298 u(ij+u_ldown,l) = u(ij+u_ldown,l) + tau*du(ij+u_ldown,l)299 END DO300 END IF301 END DO302 303 END IF ! dysl304 CALL trace_end("compute_caldyn_fast")305 306 END SUBROUTINE compute_caldyn_fast307 308 185 END MODULE caldyn_kernels_hevi_mod
Note: See TracChangeset
for help on using the changeset viewer.