Context Navigation

source: codes/icosagcm/trunk/src/theta_rhodz.f90 @ 405

Last change on this file since 405 was 387, checked in by dubos, 8 years ago
Infrastructure for multiple dynamical tracers - tested with JW06 and moist baroclinic wave
File size: 6.9 KB

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

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

Download in other formats: