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