Context Navigation

source: codes/icosagcm/devel/src/initial/etat0.f90 @ 549

Last change on this file since 549 was 549, checked in by dubos, 7 years ago
devel : backported commit 544 from trunk
File size: 16.6 KB

Rev	Line
[12]	1	MODULE etat0_mod
[199]	2	USE icosa
[344]	3	IMPLICIT NONE
[199]	4	PRIVATE
	5
[149]	6	CHARACTER(len=255),SAVE :: etat0_type
[186]	7	!$OMP THREADPRIVATE(etat0_type)
[12]	8
[199]	9	REAL(rstd) :: etat0_temp
	10
[467]	11	PUBLIC :: etat0, init_etat0, etat0_type
[199]	12
[17]	13	CONTAINS
	14
[467]	15	SUBROUTINE init_etat0
[528]	16	USE etat0_database_mod, ONLY: init_etat0_database => init_etat0
	17	USE etat0_start_file_mod, ONLY: init_etat0_start_file => init_etat0
[549]	18	USE etat0_heldsz_mod, ONLY: init_etat0_held_suarez => init_etat0
[467]	19	IMPLICIT NONE
	20
	21	CALL getin("etat0",etat0_type)
	22
	23	SELECT CASE (TRIM(etat0_type))
	24	CASE ('isothermal')
	25	CASE ('temperature_profile')
	26	CASE ('jablonowsky06')
	27	CASE ('dcmip5')
	28	CASE ('williamson91.6')
	29	CASE ('start_file')
[483]	30	CALL init_etat0_start_file
[467]	31	CASE ('database')
	32	CALL init_etat0_database
	33	CASE ('academic')
	34	CASE ('held_suarez')
[549]	35	CALL init_etat0_held_suarez
[467]	36	CASE ('venus')
	37	CASE ('dcmip1')
	38	CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
	39	CASE ('dcmip3')
	40	CASE ('dcmip4')
[468]	41	CASE ('dcmip2016_baroclinic_wave')
	42	CASE ('dcmip2016_cyclone')
	43	CASE ('dcmip2016_supercell')
[499]	44	CASE ('bubble')
[467]	45	CASE DEFAULT
[468]	46	PRINT*, 'Bad selector for variable etat0 <',TRIM(etat0_type),'>'// &
	47	' options are <isothermal>, <temperature_profile>, <jablonowsky06>, <dcmip5>, <williamson91.6>,'&
	48	//' <start_file>, <database>, <academic>, <held_suarez>, <venus>, <dcmip1>,' &
	49	//' <dcmip2_mountain,dcmip2_schaer_noshear,dcmip2_schaer_shear>, <dcmip3>, <dcmip4>,'&
[499]	50	//' <dcmip2016_baroclinic_wave>, <dcmip2016_cyclone>, <dcmip2016_supercell>', 'bubble'
[467]	51	STOP
	52	END SELECT
	53
	54	END SUBROUTINE init_etat0
	55
[366]	56	SUBROUTINE etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_geopot,f_w, f_q)
[192]	57	USE mpipara, ONLY : is_mpi_root
[159]	58	USE disvert_mod
[345]	59	! Generic interface
[344]	60	USE etat0_dcmip1_mod, ONLY : getin_etat0_dcmip1=>getin_etat0
	61	USE etat0_dcmip2_mod, ONLY : getin_etat0_dcmip2=>getin_etat0
[346]	62	USE etat0_dcmip4_mod, ONLY : getin_etat0_dcmip4=>getin_etat0
[203]	63	USE etat0_dcmip5_mod, ONLY : getin_etat0_dcmip5=>getin_etat0
[377]	64	USE etat0_bubble_mod, ONLY : getin_etat0_bubble=>getin_etat0
[204]	65	USE etat0_williamson_mod, ONLY : getin_etat0_williamson=>getin_etat0
[327]	66	USE etat0_temperature_mod, ONLY: getin_etat0_temperature=>getin_etat0
[382]	67	USE etat0_dcmip2016_baroclinic_wave_mod, ONLY : getin_etat0_dcmip2016_baroclinic_wave=>getin_etat0
[388]	68	USE etat0_dcmip2016_cyclone_mod, ONLY : getin_etat0_dcmip2016_cyclone=>getin_etat0
	69	USE etat0_dcmip2016_supercell_mod, ONLY : getin_etat0_dcmip2016_supercell=>getin_etat0
[345]	70	! Ad hoc interfaces
[467]	71	USE etat0_academic_mod, ONLY : etat0_academic=>etat0
	72	USE etat0_heldsz_mod, ONLY : etat0_heldsz=>etat0
	73	USE etat0_venus_mod, ONLY : etat0_venus=>etat0
	74	USE etat0_database_mod, ONLY : etat0_database=>etat0
[266]	75	USE etat0_start_file_mod, ONLY : etat0_start_file=>etat0
[149]	76
[54]	77	IMPLICIT NONE
[17]	78	TYPE(t_field),POINTER :: f_ps(:)
[159]	79	TYPE(t_field),POINTER :: f_mass(:)
[17]	80	TYPE(t_field),POINTER :: f_phis(:)
	81	TYPE(t_field),POINTER :: f_theta_rhodz(:)
	82	TYPE(t_field),POINTER :: f_u(:)
[366]	83	TYPE(t_field),POINTER :: f_geopot(:)
	84	TYPE(t_field),POINTER :: f_w(:)
[17]	85	TYPE(t_field),POINTER :: f_q(:)
[186]	86
[159]	87	REAL(rstd),POINTER :: ps(:), mass(:,:)
[366]	88	LOGICAL :: autoinit_mass, autoinit_geopot, collocated
[159]	89	INTEGER :: ind,i,j,ij,l
	90
	91	! most etat0 routines set ps and not mass
	92	! in that case and if caldyn_eta == eta_lag
	93	! the initial distribution of mass is taken to be the same
	94	! as what the mass coordinate would dictate
[366]	95	! however if etat0_XXX defines mass then the flag autoinit_mass must be set to .FALSE.
[159]	96	! otherwise mass will be overwritten
[366]	97	autoinit_mass = (caldyn_eta == eta_lag)
[159]	98
[17]	99	etat0_type='jablonowsky06'
	100	CALL getin("etat0",etat0_type)
	101
[345]	102	!------------------- Generic interface ---------------------
[344]	103	collocated=.TRUE.
[17]	104	SELECT CASE (TRIM(etat0_type))
[199]	105	CASE ('isothermal')
	106	CALL getin_etat0_isothermal
[327]	107	CASE ('temperature_profile')
	108	CALL getin_etat0_temperature
[203]	109	CASE ('jablonowsky06')
[344]	110	CASE ('dcmip1')
	111	CALL getin_etat0_dcmip1
	112	CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
	113	CALL getin_etat0_dcmip2
[345]	114	CASE ('dcmip3')
[346]	115	CASE ('dcmip4')
	116	CALL getin_etat0_dcmip4
[344]	117	CASE ('dcmip5')
[203]	118	CALL getin_etat0_dcmip5
[377]	119	CASE ('bubble')
	120	CALL getin_etat0_bubble
[168]	121	CASE ('williamson91.6')
[366]	122	autoinit_mass=.FALSE.
[204]	123	CALL getin_etat0_williamson
[382]	124	CASE ('dcmip2016_baroclinic_wave')
	125	CALL getin_etat0_dcmip2016_baroclinic_wave
[388]	126	CASE ('dcmip2016_cyclone')
	127	CALL getin_etat0_dcmip2016_cyclone
	128	CASE ('dcmip2016_supercell')
	129	CALL getin_etat0_dcmip2016_supercell
[344]	130	CASE DEFAULT
	131	collocated=.FALSE.
[366]	132	autoinit_mass = .FALSE.
[344]	133	END SELECT
	134
[345]	135	!------------------- Ad hoc interfaces --------------------
[344]	136	SELECT CASE (TRIM(etat0_type))
[467]	137	CASE ('database')
	138	CALL etat0_database(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[266]	139	CASE ('start_file')
	140	CALL etat0_start_file(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[54]	141	CASE ('academic')
	142	CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[170]	143	CASE ('held_suarez')
	144	PRINT *,"Held & Suarez (1994) test case"
[149]	145	CALL etat0_heldsz(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
[325]	146	CASE ('venus')
	147	CALL etat0_venus(f_ps, f_phis, f_theta_rhodz, f_u, f_q)
	148	PRINT *, "Venus (Lebonnois et al., 2012) test case"
[62]	149	CASE DEFAULT
[344]	150	IF(collocated) THEN
[366]	151	CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_geopot,f_W, f_q)
[344]	152	ELSE
[468]	153	PRINT*, 'Bad selector for variable etat0 <',TRIM(etat0_type),'>'// &
	154	' options are <isothermal>, <temperature_profile>, <jablonowsky06>, <dcmip5>, <williamson91.6>,'&
	155	//' <start_file>, <database>, <academic>, <held_suarez>, <venus>, <dcmip1>,' &
	156	//' <dcmip2_mountain,dcmip2_schaer_noshear,dcmip2_schaer_shear>, <dcmip3>, <dcmip4>,'&
	157	//' <dcmip2016_baroclinic_wave>, <dcmip2016_cyclone>, <dcmip2016_supercell>'
[344]	158	STOP
	159	END IF
[54]	160	END SELECT
[159]	161
[186]	162	! !$OMP BARRIER
[366]	163	IF(autoinit_mass) THEN
[159]	164	DO ind=1,ndomain
[186]	165	IF (.NOT. assigned_domain(ind)) CYCLE
[159]	166	CALL swap_dimensions(ind)
	167	CALL swap_geometry(ind)
	168	mass=f_mass(ind); ps=f_ps(ind)
[366]	169	CALL compute_rhodz(.TRUE., ps, mass) ! initialize mass distribution using ps
[159]	170	END DO
	171	END IF
[366]	172
[54]	173	END SUBROUTINE etat0
[199]	174
[366]	175	SUBROUTINE etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_geopot,f_W, f_q)
[295]	176	USE theta2theta_rhodz_mod
[199]	177	IMPLICIT NONE
	178	TYPE(t_field),POINTER :: f_ps(:)
	179	TYPE(t_field),POINTER :: f_mass(:)
	180	TYPE(t_field),POINTER :: f_phis(:)
	181	TYPE(t_field),POINTER :: f_theta_rhodz(:)
	182	TYPE(t_field),POINTER :: f_u(:)
[366]	183	TYPE(t_field),POINTER :: f_geopot(:)
	184	TYPE(t_field),POINTER :: f_W(:)
[199]	185	TYPE(t_field),POINTER :: f_q(:)
	186
[321]	187	TYPE(t_field),POINTER,SAVE :: f_temp(:)
[199]	188	REAL(rstd),POINTER :: ps(:)
	189	REAL(rstd),POINTER :: mass(:,:)
	190	REAL(rstd),POINTER :: phis(:)
[387]	191	REAL(rstd),POINTER :: theta_rhodz(:,:,:)
[295]	192	REAL(rstd),POINTER :: temp(:,:)
[199]	193	REAL(rstd),POINTER :: u(:,:)
[366]	194	REAL(rstd),POINTER :: geopot(:,:)
	195	REAL(rstd),POINTER :: W(:,:)
[199]	196	REAL(rstd),POINTER :: q(:,:,:)
	197	INTEGER :: ind
	198
[321]	199	CALL allocate_field(f_temp,field_t,type_real,llm,name='temp')
	200
[199]	201	DO ind=1,ndomain
	202	IF (.NOT. assigned_domain(ind)) CYCLE
	203	CALL swap_dimensions(ind)
	204	CALL swap_geometry(ind)
	205	ps=f_ps(ind)
	206	mass=f_mass(ind)
	207	phis=f_phis(ind)
	208	theta_rhodz=f_theta_rhodz(ind)
[295]	209	temp=f_temp(ind)
[199]	210	u=f_u(ind)
[366]	211	geopot=f_geopot(ind)
	212	w=f_w(ind)
[199]	213	q=f_q(ind)
[295]	214
[366]	215	IF( TRIM(etat0_type)=='williamson91.6' ) THEN
[387]	216	CALL compute_etat0_collocated(ps,mass, phis, theta_rhodz(:,:,1), u, geopot, W, q)
[295]	217	ELSE
[387]	218	CALL compute_etat0_collocated(ps,mass, phis, temp, u, geopot, W, q)
[295]	219	ENDIF
[401]	220
	221	IF( TRIM(etat0_type)/='williamson91.6' ) CALL compute_temperature2entropy(ps,temp,q,theta_rhodz, 1)
	222
[199]	223	ENDDO
[295]	224
[321]	225	CALL deallocate_field(f_temp)
[295]	226
[199]	227	END SUBROUTINE etat0_collocated
	228
[401]	229	SUBROUTINE compute_temperature2entropy(ps,temp,q,theta_rhodz,offset)
	230	USE icosa
	231	USE pression_mod
	232	USE exner_mod
	233	USE omp_para
	234	IMPLICIT NONE
	235	REAL(rstd),INTENT(IN) :: ps(iim*jjm)
	236	REAL(rstd),INTENT(IN) :: temp(iim*jjm,llm)
	237	REAL(rstd),INTENT(IN) :: q(iim*jjm,llm,nqtot)
	238	REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
	239	INTEGER,INTENT(IN) :: offset
	240
	241	REAL(rstd) :: p(iim*jjm,llm+1)
	242	REAL(rstd) :: cppd,Rd, mass, p_ij, q_ij,r_ij, chi,nu, entropy, theta
	243	INTEGER :: i,j,ij,l
	244
	245	cppd=cpp
	246	Rd=kappa*cppd
	247
	248	CALL compute_pression(ps,p,offset)
	249	! flush p
	250	!$OMP BARRIER
	251	DO l = ll_begin, ll_end
	252	DO j=jj_begin-offset,jj_end+offset
	253	DO i=ii_begin-offset,ii_end+offset
	254	ij=(j-1)*iim+i
	255	mass = (p(ij,l)-p(ij,l+1))/g ! dry+moist mass
	256	p_ij = .5*(p(ij,l)+p(ij,l+1)) ! pressure at full level
	257	SELECT CASE(caldyn_thermo)
	258	CASE(thermo_theta)
	259	theta = temp(ij,l)(p_ij/preff)*(-kappa)
	260	theta_rhodz(ij,l) = mass * theta
	261	CASE(thermo_entropy)
	262	nu = log(p_ij/preff)
	263	chi = log(temp(ij,l)/Treff)
	264	entropy = cppdchi-Rdnu
	265	theta_rhodz(ij,l) = mass * entropy
	266	! CASE(thermo_moist)
	267	! q_ij=q(ij,l,1)
	268	! r_ij=1.-q_ij
	269	! mass=mass*(1-q_ij) ! dry mass
	270	! nu = log(p_ij/preff)
	271	! chi = log(temp(ij,l)/Treff)
	272	! entropy = r_ij(cppdchi-Rdnu) + q_ij(cppvchi-Rvnu)
	273	! theta_rhodz(ij,l) = mass * entropy
	274	CASE DEFAULT
	275	STOP
	276	END SELECT
	277	ENDDO
	278	ENDDO
	279	ENDDO
	280	!$OMP BARRIER
	281	END SUBROUTINE compute_temperature2entropy
	282
[366]	283	SUBROUTINE compute_etat0_collocated(ps,mass,phis,temp_i,u, geopot,W, q)
[199]	284	USE wind_mod
[366]	285	USE disvert_mod
[203]	286	USE etat0_jablonowsky06_mod, ONLY : compute_jablonowsky06 => compute_etat0
[344]	287	USE etat0_dcmip1_mod, ONLY : compute_dcmip1 => compute_etat0
	288	USE etat0_dcmip2_mod, ONLY : compute_dcmip2 => compute_etat0
[345]	289	USE etat0_dcmip3_mod, ONLY : compute_dcmip3 => compute_etat0
[346]	290	USE etat0_dcmip4_mod, ONLY : compute_dcmip4 => compute_etat0
[203]	291	USE etat0_dcmip5_mod, ONLY : compute_dcmip5 => compute_etat0
[377]	292	USE etat0_bubble_mod, ONLY : compute_bubble => compute_etat0
[204]	293	USE etat0_williamson_mod, ONLY : compute_w91_6 => compute_etat0
[327]	294	USE etat0_temperature_mod, ONLY: compute_etat0_temperature => compute_etat0
[382]	295	USE etat0_dcmip2016_baroclinic_wave_mod, ONLY : compute_dcmip2016_baroclinic_wave => compute_etat0
[388]	296	USE etat0_dcmip2016_cyclone_mod, ONLY : compute_dcmip2016_cyclone => compute_etat0
	297	USE etat0_dcmip2016_supercell_mod, ONLY : compute_dcmip2016_supercell => compute_etat0
[199]	298	IMPLICIT NONE
	299	REAL(rstd),INTENT(INOUT) :: ps(iim*jjm)
	300	REAL(rstd),INTENT(INOUT) :: mass(iim*jjm,llm)
	301	REAL(rstd),INTENT(OUT) :: phis(iim*jjm)
[295]	302	REAL(rstd),INTENT(OUT) :: temp_i(iim*jjm,llm)
[199]	303	REAL(rstd),INTENT(OUT) :: u(3iimjjm,llm)
[366]	304	REAL(rstd),INTENT(OUT) :: W(iim*jjm,llm+1)
	305	REAL(rstd),INTENT(OUT) :: geopot(iim*jjm,llm+1)
[199]	306	REAL(rstd),INTENT(OUT) :: q(iim*jjm,llm,nqtot)
	307
	308	REAL(rstd) :: ulon_i(iim*jjm,llm)
	309	REAL(rstd) :: ulat_i(iim*jjm,llm)
	310
	311	REAL(rstd) :: ps_e(3iimjjm)
	312	REAL(rstd) :: mass_e(3iimjjm,llm)
	313	REAL(rstd) :: phis_e(3iimjjm)
	314	REAL(rstd) :: temp_e(3iimjjm,llm)
[366]	315	REAL(rstd) :: geopot_e(3iimjjm,llm+1)
[199]	316	REAL(rstd) :: ulon_e(3iimjjm,llm)
	317	REAL(rstd) :: ulat_e(3iimjjm,llm)
	318	REAL(rstd) :: q_e(3iimjjm,llm,nqtot)
	319
	320	INTEGER :: l,i,j,ij
[366]	321	REAL :: p_ik, v_ik, mass_ik
	322	LOGICAL :: autoinit_mass, autoinit_NH
[199]	323
[366]	324	! For NH geopotential and vertical momentum must be initialized.
[377]	325	! Unless autoinit_NH is set to .FALSE. , they will be initialized
[366]	326	! to hydrostatic geopotential and zero
	327	autoinit_mass = .TRUE.
	328	autoinit_NH = .NOT. hydrostatic
	329	w(:,:) = 0
	330
[353]	331	!$OMP BARRIER
	332
[199]	333	SELECT CASE (TRIM(etat0_type))
	334	CASE ('isothermal')
[201]	335	CALL compute_etat0_isothermal(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
	336	CALL compute_etat0_isothermal(3iimjjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
[327]	337	CASE ('temperature_profile')
	338	CALL compute_etat0_temperature(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
	339	CALL compute_etat0_temperature(3iimjjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
[201]	340	CASE('jablonowsky06')
	341	CALL compute_jablonowsky06(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i)
	342	CALL compute_jablonowsky06(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e)
[344]	343	CASE('dcmip1')
	344	CALL compute_dcmip1(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
	345	CALL compute_dcmip1(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
	346	CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
	347	CALL compute_dcmip2(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i)
	348	CALL compute_dcmip2(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e)
[345]	349	CASE('dcmip3')
[366]	350	CALL compute_dcmip3(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, geopot, q)
	351	CALL compute_dcmip3(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, geopot_e, q_e)
	352	autoinit_NH = .FALSE. ! compute_dcmip3 initializes geopot
[346]	353	CASE('dcmip4')
	354	CALL compute_dcmip4(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
	355	CALL compute_dcmip4(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
[203]	356	CASE('dcmip5')
	357	CALL compute_dcmip5(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
	358	CALL compute_dcmip5(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
[377]	359	CASE('bubble')
	360	CALL compute_bubble(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, geopot, q)
	361	CALL compute_bubble(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, geopot_e, q_e)
	362	! autoinit_NH = .FALSE. ! compute_bubble initializes geopot
[204]	363	CASE('williamson91.6')
[295]	364	CALL compute_w91_6(iim*jjm,lon_i,lat_i, phis, mass(:,1), temp_i(:,1), ulon_i(:,1), ulat_i(:,1))
[204]	365	CALL compute_w91_6(3iimjjm,lon_e,lat_e, phis_e, mass_e(:,1), temp_e(:,1), ulon_e(:,1), ulat_e(:,1))
[366]	366	autoinit_mass = .FALSE. ! do not overwrite mass
[382]	367	CASE('dcmip2016_baroclinic_wave')
	368	CALL compute_dcmip2016_baroclinic_wave(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
	369	CALL compute_dcmip2016_baroclinic_wave(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
[388]	370	CASE('dcmip2016_cyclone')
	371	CALL compute_dcmip2016_cyclone(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
	372	CALL compute_dcmip2016_cyclone(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
	373	CASE('dcmip2016_supercell')
	374	CALL compute_dcmip2016_supercell(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
	375	CALL compute_dcmip2016_supercell(3iimjjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
[199]	376	END SELECT
	377
[366]	378	IF(autoinit_mass) CALL compute_rhodz(.TRUE., ps, mass) ! initialize mass distribution using ps
	379	IF(autoinit_NH) THEN
	380	geopot(:,1) = phis(:) ! surface geopotential
	381	DO l = 1, llm
	382	DO ij=1,iim*jjm
	383	! hybrid pressure coordinate
	384	p_ik = ptop + mass_ak(l) + mass_bk(l)*ps(ij)
	385	mass_ik = (mass_dak(l) + mass_dbk(l)*ps(ij))/g
	386	! v=R.T/p, R=kappa*cpp
	387	v_ik = kappacpptemp_i(ij,l)/p_ik
	388	geopot(ij,l+1) = geopot(ij,l) + mass_ikv_ikg
	389	END DO
	390	END DO
	391	END IF
	392
[353]	393	!$OMP BARRIER
	394
[201]	395	CALL compute_wind_perp_from_lonlat_compound(ulon_e, ulat_e, u)
[199]	396
[201]	397	END SUBROUTINE compute_etat0_collocated
	398
[199]	399	!----------------------------- Resting isothermal state --------------------------------
	400
	401	SUBROUTINE getin_etat0_isothermal
[201]	402	etat0_temp=300
	403	CALL getin("etat0_isothermal_temp",etat0_temp)
[199]	404	END SUBROUTINE getin_etat0_isothermal
	405
	406	SUBROUTINE compute_etat0_isothermal(ngrid, phis, ps, temp, ulon, ulat, q)
	407	IMPLICIT NONE
	408	INTEGER, INTENT(IN) :: ngrid
	409	REAL(rstd),INTENT(OUT) :: phis(ngrid)
	410	REAL(rstd),INTENT(OUT) :: ps(ngrid)
	411	REAL(rstd),INTENT(OUT) :: temp(ngrid,llm)
	412	REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm)
	413	REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm)
	414	REAL(rstd),INTENT(OUT) :: q(ngrid,llm,nqtot)
	415	phis(:)=0
	416	ps(:)=preff
	417	temp(:,:)=etat0_temp
	418	ulon(:,:)=0
	419	ulat(:,:)=0
	420	q(:,:,:)=0
	421	END SUBROUTINE compute_etat0_isothermal
	422
[12]	423	END MODULE etat0_mod

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

Download in other formats: