Context Navigation

source: codes/icosagcm/trunk/src/diagnostics/theta_rhodz.f90 @ 548

Last change on this file since 548 was 548, checked in by dubos, 7 years ago
trunk : reorganize source tree
File size: 6.6 KB

Rev	Line
[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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: