| [12] | 1 | MODULE theta2theta_rhodz_mod |
|---|
| [913] | 2 | USE icosa |
|---|
| [295] | 3 | USE field_mod |
|---|
| [913] | 4 | USE compute_diagnostics_mod |
|---|
| 5 | IMPLICIT NONE |
|---|
| [428] | 6 | PRIVATE |
|---|
| [913] | 7 | |
|---|
| [295] | 8 | TYPE(t_field), POINTER, SAVE :: f_p(:) |
|---|
| [12] | 9 | |
|---|
| [428] | 10 | PUBLIC :: init_theta2theta_rhodz, theta_rhodz2theta, & |
|---|
| 11 | theta_rhodz2temperature, temperature2theta_rhodz, & |
|---|
| 12 | theta2theta_rhodz, & |
|---|
| 13 | compute_theta2theta_rhodz, compute_theta_rhodz2theta |
|---|
| [295] | 14 | |
|---|
| [12] | 15 | CONTAINS |
|---|
| [15] | 16 | |
|---|
| [295] | 17 | SUBROUTINE init_theta2theta_rhodz |
|---|
| [428] | 18 | CALL allocate_field(f_p,field_t,type_real,llm+1,name='p (theta2theta_rhodz_mod)') |
|---|
| [295] | 19 | END SUBROUTINE init_theta2theta_rhodz |
|---|
| 20 | |
|---|
| 21 | |
|---|
| [15] | 22 | SUBROUTINE theta_rhodz2theta(f_ps,f_theta_rhodz,f_theta) |
|---|
| 23 | TYPE(t_field), POINTER :: f_ps(:) |
|---|
| 24 | TYPE(t_field), POINTER :: f_theta_rhodz(:) |
|---|
| 25 | TYPE(t_field), POINTER :: f_theta(:) |
|---|
| 26 | |
|---|
| 27 | REAL(rstd), POINTER :: ps(:) |
|---|
| 28 | REAL(rstd), POINTER :: theta_rhodz(:,:) |
|---|
| 29 | REAL(rstd), POINTER :: theta(:,:) |
|---|
| 30 | INTEGER :: ind |
|---|
| [12] | 31 | |
|---|
| [295] | 32 | !$OMP BARRIER |
|---|
| [15] | 33 | DO ind=1,ndomain |
|---|
| [186] | 34 | IF (.NOT. assigned_domain(ind)) CYCLE |
|---|
| [15] | 35 | CALL swap_dimensions(ind) |
|---|
| 36 | CALL swap_geometry(ind) |
|---|
| 37 | ps=f_ps(ind) |
|---|
| 38 | theta_rhodz=f_theta_rhodz(ind) |
|---|
| 39 | theta=f_theta(ind) |
|---|
| 40 | CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0) |
|---|
| 41 | ENDDO |
|---|
| [295] | 42 | !$OMP BARRIER |
|---|
| [15] | 43 | |
|---|
| 44 | END SUBROUTINE theta_rhodz2theta |
|---|
| 45 | |
|---|
| 46 | SUBROUTINE theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp) |
|---|
| 47 | TYPE(t_field), POINTER :: f_ps(:) |
|---|
| 48 | TYPE(t_field), POINTER :: f_theta_rhodz(:) |
|---|
| 49 | TYPE(t_field), POINTER :: f_temp(:) |
|---|
| 50 | |
|---|
| 51 | REAL(rstd), POINTER :: ps(:) |
|---|
| [387] | 52 | REAL(rstd), POINTER :: theta_rhodz(:,:,:) |
|---|
| [15] | 53 | REAL(rstd), POINTER :: temp(:,:) |
|---|
| [322] | 54 | REAL(rstd), POINTER :: p(:,:) |
|---|
| [15] | 55 | INTEGER :: ind |
|---|
| 56 | |
|---|
| 57 | DO ind=1,ndomain |
|---|
| [186] | 58 | IF (.NOT. assigned_domain(ind)) CYCLE |
|---|
| [15] | 59 | CALL swap_dimensions(ind) |
|---|
| 60 | CALL swap_geometry(ind) |
|---|
| 61 | ps=f_ps(ind) |
|---|
| [295] | 62 | p=f_p(ind) |
|---|
| [15] | 63 | theta_rhodz=f_theta_rhodz(ind) |
|---|
| 64 | temp=f_temp(ind) |
|---|
| [295] | 65 | |
|---|
| 66 | !$OMP BARRIER |
|---|
| 67 | CALL compute_pression(ps,p,0) |
|---|
| 68 | !$OMP BARRIER |
|---|
| [428] | 69 | CALL compute_theta_rhodz2temperature(p, theta_rhodz(:,:,1),temp,0) |
|---|
| [15] | 70 | ENDDO |
|---|
| [295] | 71 | !$OMP BARRIER |
|---|
| [15] | 72 | |
|---|
| 73 | END SUBROUTINE theta_rhodz2temperature |
|---|
| [295] | 74 | |
|---|
| 75 | SUBROUTINE temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz) |
|---|
| 76 | USE exner_mod |
|---|
| 77 | IMPLICIT NONE |
|---|
| 78 | TYPE(t_field), POINTER :: f_ps(:) |
|---|
| 79 | TYPE(t_field), POINTER :: f_theta_rhodz(:) |
|---|
| 80 | TYPE(t_field), POINTER :: f_temp(:) |
|---|
| 81 | |
|---|
| 82 | REAL(rstd), POINTER :: ps(:) |
|---|
| [387] | 83 | REAL(rstd), POINTER :: theta_rhodz(:,:,:) |
|---|
| [295] | 84 | REAL(rstd), POINTER :: temp(:,:) |
|---|
| [322] | 85 | REAL(rstd), POINTER :: p(:,:) |
|---|
| [295] | 86 | INTEGER :: ind |
|---|
| 87 | |
|---|
| 88 | DO ind=1,ndomain |
|---|
| 89 | IF (.NOT. assigned_domain(ind)) CYCLE |
|---|
| 90 | CALL swap_dimensions(ind) |
|---|
| 91 | CALL swap_geometry(ind) |
|---|
| 92 | ps=f_ps(ind) |
|---|
| 93 | p=f_p(ind) |
|---|
| 94 | theta_rhodz=f_theta_rhodz(ind) |
|---|
| 95 | temp=f_temp(ind) |
|---|
| 96 | |
|---|
| 97 | !$OMP BARRIER |
|---|
| 98 | CALL compute_pression(ps,p,0) |
|---|
| 99 | !$OMP BARRIER |
|---|
| [428] | 100 | CALL compute_temperature2theta_rhodz(p, temp, theta_rhodz(:,:,1), 0) |
|---|
| [295] | 101 | ENDDO |
|---|
| 102 | !$OMP BARRIER |
|---|
| 103 | |
|---|
| 104 | END SUBROUTINE temperature2theta_rhodz |
|---|
| 105 | |
|---|
| 106 | |
|---|
| [15] | 107 | |
|---|
| [12] | 108 | SUBROUTINE theta2theta_rhodz(f_ps,f_theta,f_theta_rhodz) |
|---|
| 109 | TYPE(t_field), POINTER :: f_ps(:) |
|---|
| 110 | TYPE(t_field), POINTER :: f_theta(:) |
|---|
| 111 | TYPE(t_field), POINTER :: f_theta_rhodz(:) |
|---|
| 112 | |
|---|
| 113 | REAL(rstd), POINTER :: ps(:) |
|---|
| 114 | REAL(rstd), POINTER :: theta(:,:) |
|---|
| 115 | REAL(rstd), POINTER :: theta_rhodz(:,:) |
|---|
| 116 | INTEGER :: ind |
|---|
| 117 | |
|---|
| [295] | 118 | !$OMP BARRIER |
|---|
| [12] | 119 | DO ind=1,ndomain |
|---|
| [186] | 120 | IF (.NOT. assigned_domain(ind)) CYCLE |
|---|
| [12] | 121 | CALL swap_dimensions(ind) |
|---|
| 122 | CALL swap_geometry(ind) |
|---|
| 123 | ps=f_ps(ind) |
|---|
| 124 | theta=f_theta(ind) |
|---|
| 125 | theta_rhodz=f_theta_rhodz(ind) |
|---|
| 126 | CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0) |
|---|
| 127 | ENDDO |
|---|
| [295] | 128 | !$OMP BARRIER |
|---|
| [12] | 129 | |
|---|
| 130 | END SUBROUTINE theta2theta_rhodz |
|---|
| 131 | |
|---|
| 132 | SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset) |
|---|
| [295] | 133 | USE disvert_mod |
|---|
| 134 | USE omp_para |
|---|
| [12] | 135 | REAL(rstd),INTENT(IN) :: ps(iim*jjm) |
|---|
| 136 | REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm) |
|---|
| 137 | REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm) |
|---|
| 138 | INTEGER,INTENT(IN) :: offset |
|---|
| [323] | 139 | REAL(rstd) :: rhodz |
|---|
| [12] | 140 | INTEGER :: i,j,ij,l |
|---|
| 141 | |
|---|
| [295] | 142 | !$OMP BARRIER |
|---|
| 143 | DO l = ll_begin, ll_end |
|---|
| [12] | 144 | DO j=jj_begin-offset,jj_end+offset |
|---|
| 145 | DO i=ii_begin-offset,ii_end+offset |
|---|
| 146 | ij=(j-1)*iim+i |
|---|
| [323] | 147 | rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g |
|---|
| 148 | theta_rhodz(ij,l) = theta(ij,l) * rhodz |
|---|
| [12] | 149 | ENDDO |
|---|
| 150 | ENDDO |
|---|
| 151 | ENDDO |
|---|
| [295] | 152 | !$OMP BARRIER |
|---|
| [15] | 153 | |
|---|
| 154 | |
|---|
| [12] | 155 | END SUBROUTINE compute_theta2theta_rhodz |
|---|
| 156 | |
|---|
| [15] | 157 | SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset) |
|---|
| [295] | 158 | USE disvert_mod |
|---|
| 159 | USE omp_para |
|---|
| [15] | 160 | REAL(rstd),INTENT(IN) :: ps(iim*jjm) |
|---|
| 161 | REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm) |
|---|
| 162 | REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm) |
|---|
| 163 | INTEGER,INTENT(IN) :: offset |
|---|
| [323] | 164 | REAL(rstd) :: rhodz |
|---|
| [15] | 165 | INTEGER :: i,j,ij,l |
|---|
| 166 | |
|---|
| [295] | 167 | !$OMP BARRIER |
|---|
| 168 | DO l = ll_begin, ll_end |
|---|
| [15] | 169 | DO j=jj_begin-offset,jj_end+offset |
|---|
| 170 | DO i=ii_begin-offset,ii_end+offset |
|---|
| 171 | ij=(j-1)*iim+i |
|---|
| [323] | 172 | rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g |
|---|
| 173 | theta(ij,l) = theta_rhodz(ij,l) / rhodz |
|---|
| [15] | 174 | ENDDO |
|---|
| 175 | ENDDO |
|---|
| 176 | ENDDO |
|---|
| [295] | 177 | !$OMP BARRIER |
|---|
| [15] | 178 | |
|---|
| 179 | |
|---|
| 180 | END SUBROUTINE compute_theta_rhodz2theta |
|---|
| 181 | |
|---|
| [295] | 182 | |
|---|
| 183 | |
|---|
| 184 | |
|---|
| 185 | |
|---|
| 186 | |
|---|
| [428] | 187 | SUBROUTINE compute_theta_rhodz2temperature(p,theta_rhodz,temp,offset) |
|---|
| [15] | 188 | USE exner_mod |
|---|
| [295] | 189 | USE omp_para |
|---|
| 190 | REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1) |
|---|
| [15] | 191 | REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm) |
|---|
| 192 | REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm) |
|---|
| 193 | INTEGER,INTENT(IN) :: offset |
|---|
| [428] | 194 | REAL(rstd) :: pk_ij |
|---|
| [15] | 195 | INTEGER :: i,j,ij,l |
|---|
| 196 | |
|---|
| [295] | 197 | ! flush p |
|---|
| 198 | !$OMP BARRIER |
|---|
| 199 | DO l = ll_begin, ll_end |
|---|
| [15] | 200 | DO j=jj_begin-offset,jj_end+offset |
|---|
| 201 | DO i=ii_begin-offset,ii_end+offset |
|---|
| 202 | ij=(j-1)*iim+i |
|---|
| [428] | 203 | pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa |
|---|
| 204 | temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk_ij |
|---|
| [15] | 205 | ENDDO |
|---|
| 206 | ENDDO |
|---|
| 207 | ENDDO |
|---|
| [295] | 208 | !$OMP BARRIER |
|---|
| [15] | 209 | |
|---|
| [295] | 210 | |
|---|
| [15] | 211 | END SUBROUTINE compute_theta_rhodz2temperature |
|---|
| [35] | 212 | |
|---|
| [428] | 213 | SUBROUTINE compute_temperature2theta_rhodz(p,temp,theta_rhodz,offset) |
|---|
| [35] | 214 | USE exner_mod |
|---|
| [295] | 215 | USE omp_para |
|---|
| 216 | REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1) |
|---|
| [35] | 217 | REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm) |
|---|
| [295] | 218 | REAL(rstd),INTENT(IN) :: temp(iim*jjm,llm) |
|---|
| [35] | 219 | INTEGER,INTENT(IN) :: offset |
|---|
| [428] | 220 | REAL(rstd) :: pk_ij |
|---|
| [35] | 221 | INTEGER :: i,j,ij,l |
|---|
| 222 | |
|---|
| 223 | |
|---|
| [295] | 224 | ! flush p |
|---|
| 225 | !$OMP BARRIER |
|---|
| 226 | |
|---|
| 227 | DO l = ll_begin, ll_end |
|---|
| [35] | 228 | DO j=jj_begin-offset,jj_end+offset |
|---|
| 229 | DO i=ii_begin-offset,ii_end+offset |
|---|
| 230 | ij=(j-1)*iim+i |
|---|
| [428] | 231 | pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa |
|---|
| 232 | theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / pk_ij |
|---|
| [35] | 233 | ENDDO |
|---|
| 234 | ENDDO |
|---|
| 235 | ENDDO |
|---|
| [295] | 236 | !$OMP BARRIER |
|---|
| [35] | 237 | |
|---|
| 238 | END SUBROUTINE compute_temperature2theta_rhodz |
|---|
| 239 | |
|---|
| [12] | 240 | END MODULE theta2theta_rhodz_mod |
|---|
![(please configure the [header_logo] section in trac.ini)](/dynamico/chrome/site/your_project_logo.png){kind=logo}
