MODULE theta2theta_rhodz_mod USE field_mod TYPE(t_field), POINTER, SAVE :: f_p(:) TYPE(t_field), POINTER, SAVE :: f_pks(:) TYPE(t_field), POINTER, SAVE :: f_pk(:) PRIVATE :: f_p,f_pk,f_pks CONTAINS SUBROUTINE init_theta2theta_rhodz USE icosa USE field_mod IMPLICIT NONE CALL allocate_field(f_p,field_t,type_real,llm+1,name='p (theta2theta_rhodz_mod)') CALL allocate_field(f_pk,field_t,type_real,llm,name='pk (theta2theta_rhodz_mod)') CALL allocate_field(f_pks,field_t,type_real,name='pks (theta2theta_rhodz_mod)') END SUBROUTINE init_theta2theta_rhodz SUBROUTINE theta_rhodz2theta(f_ps,f_theta_rhodz,f_theta) USE icosa IMPLICIT NONE TYPE(t_field), POINTER :: f_ps(:) TYPE(t_field), POINTER :: f_theta_rhodz(:) TYPE(t_field), POINTER :: f_theta(:) REAL(rstd), POINTER :: ps(:) REAL(rstd), POINTER :: theta_rhodz(:,:) REAL(rstd), POINTER :: theta(:,:) INTEGER :: ind !$OMP BARRIER DO ind=1,ndomain IF (.NOT. assigned_domain(ind)) CYCLE CALL swap_dimensions(ind) CALL swap_geometry(ind) ps=f_ps(ind) theta_rhodz=f_theta_rhodz(ind) theta=f_theta(ind) CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0) ENDDO !$OMP BARRIER END SUBROUTINE theta_rhodz2theta SUBROUTINE theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp) USE icosa USE pression_mod USE exner_mod IMPLICIT NONE TYPE(t_field), POINTER :: f_ps(:) TYPE(t_field), POINTER :: f_theta_rhodz(:) TYPE(t_field), POINTER :: f_temp(:) REAL(rstd), POINTER :: ps(:) REAL(rstd), POINTER :: theta_rhodz(:,:) REAL(rstd), POINTER :: temp(:,:) REAL(rstd), POINTER :: p(:,:) REAL(rstd), POINTER :: pk(:,:) REAL(rstd), POINTER :: pks(:) INTEGER :: ind DO ind=1,ndomain IF (.NOT. assigned_domain(ind)) CYCLE CALL swap_dimensions(ind) CALL swap_geometry(ind) ps=f_ps(ind) p=f_p(ind) pks=f_pks(ind) pk=f_pk(ind) theta_rhodz=f_theta_rhodz(ind) temp=f_temp(ind) !$OMP BARRIER CALL compute_pression(ps,p,0) !$OMP BARRIER CALL compute_exner(ps,p,pks,pk,0) !$OMP BARRIER CALL compute_theta_rhodz2temperature(p, pk, theta_rhodz,temp,0) ENDDO !$OMP BARRIER END SUBROUTINE theta_rhodz2temperature SUBROUTINE temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz) USE icosa USE pression_mod USE exner_mod IMPLICIT NONE TYPE(t_field), POINTER :: f_ps(:) TYPE(t_field), POINTER :: f_theta_rhodz(:) TYPE(t_field), POINTER :: f_temp(:) REAL(rstd), POINTER :: ps(:) REAL(rstd), POINTER :: theta_rhodz(:,:) REAL(rstd), POINTER :: temp(:,:) REAL(rstd), POINTER :: p(:,:) REAL(rstd), POINTER :: pk(:,:) REAL(rstd), POINTER :: pks(:) INTEGER :: ind DO ind=1,ndomain IF (.NOT. assigned_domain(ind)) CYCLE CALL swap_dimensions(ind) CALL swap_geometry(ind) ps=f_ps(ind) p=f_p(ind) pks=f_pks(ind) pk=f_pk(ind) theta_rhodz=f_theta_rhodz(ind) temp=f_temp(ind) !$OMP BARRIER CALL compute_pression(ps,p,0) !$OMP BARRIER CALL compute_exner(ps,p,pks,pk,0) !$OMP BARRIER CALL compute_temperature2theta_rhodz(p, pk, temp, theta_rhodz, 0) ENDDO !$OMP BARRIER END SUBROUTINE temperature2theta_rhodz SUBROUTINE theta2theta_rhodz(f_ps,f_theta,f_theta_rhodz) USE icosa IMPLICIT NONE TYPE(t_field), POINTER :: f_ps(:) TYPE(t_field), POINTER :: f_theta(:) TYPE(t_field), POINTER :: f_theta_rhodz(:) REAL(rstd), POINTER :: ps(:) REAL(rstd), POINTER :: theta(:,:) REAL(rstd), POINTER :: theta_rhodz(:,:) INTEGER :: ind !$OMP BARRIER DO ind=1,ndomain IF (.NOT. assigned_domain(ind)) CYCLE CALL swap_dimensions(ind) CALL swap_geometry(ind) ps=f_ps(ind) theta=f_theta(ind) theta_rhodz=f_theta_rhodz(ind) CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0) ENDDO !$OMP BARRIER END SUBROUTINE theta2theta_rhodz SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset) USE icosa USE disvert_mod USE omp_para IMPLICIT NONE REAL(rstd),INTENT(IN) :: ps(iim*jjm) REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm) REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm) INTEGER,INTENT(IN) :: offset REAL(rstd) :: rhodz INTEGER :: i,j,ij,l !$OMP BARRIER DO l = ll_begin, ll_end DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g theta_rhodz(ij,l) = theta(ij,l) * rhodz ENDDO ENDDO ENDDO !$OMP BARRIER END SUBROUTINE compute_theta2theta_rhodz SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset) USE icosa USE disvert_mod USE omp_para IMPLICIT NONE REAL(rstd),INTENT(IN) :: ps(iim*jjm) REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm) REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm) INTEGER,INTENT(IN) :: offset REAL(rstd) :: rhodz INTEGER :: i,j,ij,l !$OMP BARRIER DO l = ll_begin, ll_end DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i rhodz = ( ap(l)-ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g theta(ij,l) = theta_rhodz(ij,l) / rhodz ENDDO ENDDO ENDDO !$OMP BARRIER END SUBROUTINE compute_theta_rhodz2theta SUBROUTINE compute_theta_rhodz2temperature(p,pk,theta_rhodz,temp,offset) USE icosa USE pression_mod USE exner_mod USE omp_para IMPLICIT NONE REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1) REAL(rstd),INTENT(IN) :: pk(iim*jjm,llm) REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm) REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm) INTEGER,INTENT(IN) :: offset INTEGER :: i,j,ij,l ! flush p !$OMP BARRIER DO l = ll_begin, ll_end DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk(ij,l) / cpp ENDDO ENDDO ENDDO !$OMP BARRIER END SUBROUTINE compute_theta_rhodz2temperature SUBROUTINE compute_temperature2theta_rhodz(p,pk,temp,theta_rhodz,offset) USE icosa USE pression_mod USE exner_mod USE omp_para IMPLICIT NONE REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1) REAL(rstd),INTENT(IN) :: pk(iim*jjm,llm) REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm) REAL(rstd),INTENT(IN) :: temp(iim*jjm,llm) INTEGER,INTENT(IN) :: offset INTEGER :: i,j,ij,l ! flush p !$OMP BARRIER DO l = ll_begin, ll_end DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp ) ENDDO ENDDO ENDDO !$OMP BARRIER END SUBROUTINE compute_temperature2theta_rhodz END MODULE theta2theta_rhodz_mod