![(please configure the [header_logo] section in trac.ini)](/dynamico/chrome/site/your_project_logo.png){kind=logo}
- Timestamp:
- 06/21/19 01:01:34 (5 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/dynamics/compute_caldyn_vert_NH.F90
r924 r928 1 MODULE c aldyn_kernels_base_mod2 USE icosa3 USE transfert_mod1 MODULE compute_caldyn_vert_NH_mod 2 USE prec, ONLY : rstd 3 USE grid_param 4 4 USE disvert_mod 5 USE caldyn_vars_mod6 5 USE omp_para 7 6 USE trace … … 10 9 SAVE 11 10 12 PUBLIC :: compute_caldyn_vert, compute_caldyn_vert_nh 11 PUBLIC :: compute_caldyn_vert_nh_manual, & 12 compute_caldyn_vert_nh_hex 13 13 14 14 CONTAINS 15 15 16 17 SUBROUTINE compute_caldyn_vert(u,theta,rhodz,convm, wflux,wwuu, dps,dtheta_rhodz,du) 18 REAL(rstd),INTENT(IN) :: u(iim*3*jjm,llm) 19 REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm,nqdyn) 20 REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm) 21 REAL(rstd),INTENT(INOUT) :: convm(iim*jjm,llm) ! mass flux convergence 22 REAL(rstd),INTENT(INOUT) :: wflux(iim*jjm,llm+1) ! vertical mass flux (kg/m2/s) 23 REAL(rstd),INTENT(INOUT) :: wwuu(iim*3*jjm,llm+1) 24 REAL(rstd),INTENT(INOUT) :: du(iim*3*jjm,llm) 25 REAL(rstd),INTENT(INOUT) :: dtheta_rhodz(iim*jjm,llm,nqdyn) 26 REAL(rstd),INTENT(OUT) :: dps(iim*jjm) 27 28 ! temporary variable 29 INTEGER :: i,j,ij,l,iq 30 REAL(rstd) :: p_ik, exner_ik, dF_deta, dFu_deta 31 INTEGER :: ij_omp_begin, ij_omp_end 32 33 CALL trace_start("compute_caldyn_vert") 34 35 !$OMP BARRIER 36 37 CALL distrib_level(ij_begin,ij_end, ij_omp_begin,ij_omp_end) 38 39 IF(dysl_caldyn_vert) THEN 40 #define mass_bl(ij,l) bp(l) 41 #define dmass_col(ij) dps(ij) 42 #include "../kernels_hex/caldyn_wflux.k90" 43 #include "../kernels_hex/caldyn_vert.k90" 44 #undef mass_bl 45 #undef dmass_col 46 ELSE 47 48 !!! cumulate mass flux convergence from top to bottom 49 DO l = llm-1, 1, -1 50 !DIR$ SIMD 51 DO ij=ij_omp_begin,ij_omp_end 52 convm(ij,l) = convm(ij,l) + convm(ij,l+1) 53 ENDDO 54 ENDDO 55 ! ENDIF 56 57 !$OMP BARRIER 58 ! FLUSH on convm 59 ! compute dmass_col 60 IF (is_omp_first_level) THEN 61 !DIR$ SIMD 62 DO ij=ij_begin,ij_end 63 ! dps/dt = -int(div flux)dz 64 dps(ij) = convm(ij,1) 65 ENDDO 66 ENDIF 67 68 !!! Compute vertical mass flux (l=1,llm+1 done by caldyn_BC) 69 DO l=ll_beginp1,ll_end 70 ! IF (caldyn_conserv==energy) CALL test_message(req_qu) 71 !DIR$ SIMD 72 DO ij=ij_begin,ij_end 73 ! w = int(z,ztop,div(flux)dz) + B(eta)dps/dt 74 ! => w>0 for upward transport 75 wflux( ij, l ) = bp(l) * convm( ij, 1 ) - convm( ij, l ) 76 ENDDO 77 ENDDO 78 79 !--> flush wflux 80 !$OMP BARRIER 81 82 DO iq=1,nqdyn 83 DO l=ll_begin,ll_endm1 84 !DIR$ SIMD 85 DO ij=ij_begin,ij_end 86 dtheta_rhodz(ij, l, iq) = dtheta_rhodz(ij, l, iq) - 0.5 * & 87 ( wflux(ij,l+1) * (theta(ij,l,iq) + theta(ij,l+1,iq))) 88 END DO 89 END DO 90 DO l=ll_beginp1,ll_end 91 !DIR$ SIMD 92 DO ij=ij_begin,ij_end 93 dtheta_rhodz(ij, l, iq) = dtheta_rhodz(ij, l, iq) + 0.5 * & 94 ( wflux(ij,l) * (theta(ij,l-1,iq) + theta(ij,l,iq) ) ) 95 END DO 96 END DO 97 END DO 98 99 ! Compute vertical transport 100 DO l=ll_beginp1,ll_end 101 !DIR$ SIMD 102 DO ij=ij_begin,ij_end 103 wwuu(ij+u_right,l) = 0.5*( wflux(ij,l) + wflux(ij+t_right,l)) * (u(ij+u_right,l) - u(ij+u_right,l-1)) 104 wwuu(ij+u_lup,l) = 0.5* ( wflux(ij,l) + wflux(ij+t_lup,l)) * (u(ij+u_lup,l) - u(ij+u_lup,l-1)) 105 wwuu(ij+u_ldown,l) = 0.5*( wflux(ij,l) + wflux(ij+t_ldown,l)) * (u(ij+u_ldown,l) - u(ij+u_ldown,l-1)) 106 ENDDO 107 ENDDO 108 109 !--> flush wwuu 110 !$OMP BARRIER 111 112 ! Add vertical transport to du 113 DO l=ll_begin,ll_end 114 !DIR$ SIMD 115 DO ij=ij_begin,ij_end 116 du(ij+u_right, l ) = du(ij+u_right,l) - (wwuu(ij+u_right,l+1)+ wwuu(ij+u_right,l)) / (rhodz(ij,l)+rhodz(ij+t_right,l)) 117 du(ij+u_lup, l ) = du(ij+u_lup,l) - (wwuu(ij+u_lup,l+1) + wwuu(ij+u_lup,l)) / (rhodz(ij,l)+rhodz(ij+t_lup,l)) 118 du(ij+u_ldown, l ) = du(ij+u_ldown,l) - (wwuu(ij+u_ldown,l+1)+ wwuu(ij+u_ldown,l)) / (rhodz(ij,l)+rhodz(ij+t_ldown,l)) 119 ENDDO 120 ENDDO 121 122 END IF ! dysl 123 124 CALL trace_end("compute_caldyn_vert") 125 126 END SUBROUTINE compute_caldyn_vert 127 128 SUBROUTINE compute_caldyn_vert_NH(mass,geopot,W,wflux, W_etadot, du,dPhi,dW) 16 SUBROUTINE compute_caldyn_vert_NH_hex(mass,geopot,W,wflux, W_etadot, du,dPhi,dW) 129 17 REAL(rstd),INTENT(IN) :: mass(iim*jjm,llm) 130 18 REAL(rstd),INTENT(IN) :: geopot(iim*jjm,llm+1) … … 144 32 CALL trace_start("compute_caldyn_vert_nh") 145 33 146 IF(dysl) THEN147 34 !$OMP BARRIER 148 35 #include "../kernels_hex/caldyn_vert_NH.k90" 149 36 !$OMP BARRIER 150 ELSE 37 CALL trace_end("compute_caldyn_vert_nh") 38 END SUBROUTINE compute_caldyn_vert_NH_hex 39 40 SUBROUTINE compute_caldyn_vert_NH_manual(mass,geopot,W,wflux, W_etadot, du,dPhi,dW) 41 REAL(rstd),INTENT(IN) :: mass(iim*jjm,llm) 42 REAL(rstd),INTENT(IN) :: geopot(iim*jjm,llm+1) 43 REAL(rstd),INTENT(IN) :: W(iim*jjm,llm+1) 44 REAL(rstd),INTENT(IN) :: wflux(iim*jjm,llm+1) 45 REAL(rstd),INTENT(INOUT) :: du(iim*3*jjm,llm) 46 REAL(rstd),INTENT(INOUT) :: dPhi(iim*jjm,llm+1) 47 REAL(rstd),INTENT(INOUT) :: dW(iim*jjm,llm+1) 48 REAL(rstd) :: W_etadot(iim*jjm,llm) ! vertical flux of vertical momentum 49 ! local arrays 50 REAL(rstd) :: eta_dot(iim*jjm, llm) ! eta_dot in full layers 51 REAL(rstd) :: wcov(iim*jjm,llm) ! covariant vertical momentum in full layers 52 ! indices and temporary values 53 INTEGER :: ij, l 54 REAL(rstd) :: wflux_ij, w_ij 55 56 CALL trace_start("compute_caldyn_vert_nh") 57 151 58 #define ETA_DOT(ij) eta_dot(ij,1) 152 59 #define WCOV(ij) wcov(ij,1) … … 196 103 #undef WCOV 197 104 198 END IF ! dysl199 105 CALL trace_end("compute_caldyn_vert_nh") 200 106 201 END SUBROUTINE compute_caldyn_vert_NH 107 END SUBROUTINE compute_caldyn_vert_NH_manual 202 108 203 END MODULE c aldyn_kernels_base_mod109 END MODULE compute_caldyn_vert_NH_mod
Note: See TracChangeset
for help on using the changeset viewer.
