Changeset 6145 for LMDZ6/trunk/libf/phylmd/physiq_mod.F90
- Timestamp:
- Mar 27, 2026, 9:18:02 PM (2 weeks ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/physiq_mod.F90
r6142 r6145 3802 3802 3803 3803 3804 3805 3804 DO k = 1, klev 3806 3805 DO i = 1, klon … … 3929 3928 ! profonde. 3930 3929 3931 !IM/FH: 2011/02/233932 ! definition des points sur lesquels ls thermiques sont actifs3933 3930 3934 3931 DO k=1,klev … … 3966 3963 ENDIF 3967 3964 3968 !===============================================================================3969 ! Interactive chemistry through coupling with INCA or REPROBUS chemistry models3970 !3971 3972 IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL3973 IF (CPPKEY_INCA) THEN3974 CALL VTe(VTphysiq)3975 CALL VTb(VTinca)3976 calday = REAL(days_elapsed + 1) + jH_cur3977 3978 CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)3979 CALL AEROSOL_METEO_CALC( &3980 calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &3981 prfl,psfl,pctsrf,cell_area, &3982 latitude_deg,longitude_deg,u10m,v10m)3983 3984 zxsnow_dummy(:) = 0.03985 ! INCA needs a cloud fraction that is not necessarily that3986 ! for radiation. Here we provide a cloud fraction calculated3987 ! the same manner as that in LMDZ5, LMDZ6 and LMDZ73988 DO k=1,klev3989 DO i=1,klon3990 cldfra_inca(i,k)=min(rneb(i,k)+rnebcon(i,k),1.)3991 ENDDO3992 ENDDO3993 3994 3995 CALL chemhook_begin (calday, &3996 days_elapsed+1, &3997 jH_cur, &3998 pctsrf(1,1), &3999 latitude_deg, &4000 longitude_deg, &4001 cell_area, &4002 paprs, &4003 pplay, &4004 coefh(1:klon,1:klev,is_ave), &4005 pphi, &4006 t_seri, &4007 u, &4008 v, &4009 rot, &4010 wo(:, :, 1), &4011 q_seri, &4012 zxtsol, &4013 zt2m, &4014 zxsnow_dummy, &4015 solsw, &4016 albsol1, &4017 rain_fall, &4018 snow_fall, &4019 itop_con, &4020 ibas_con, &4021 cldfra_inca, &4022 nbp_lon, &4023 nbp_lat-1, &4024 tr_seri(:,:,1+nqCO2:nbtr), &4025 ftsol, &4026 paprs, &4027 cdragh, &4028 cdragm, &4029 pctsrf, &4030 pdtphys, &4031 itap)4032 4033 CALL VTe(VTinca)4034 CALL VTb(VTphysiq)4035 END IF4036 ENDIF !type_trac = inca or inco4037 4038 IF (type_trac == 'repr') THEN4039 IF (CPPKEY_REPROBUS) THEN4040 CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)4041 END IF4042 ENDIF4043 4044 4045 !===============================================================================4046 ! Radiative scheme and associated aerosols4047 !4048 ! Note that the following routines are called every radpas time steps4049 4050 IF (MOD(itaprad,radpas).EQ.0) THEN4051 4052 !4053 !jq - introduce the aerosol direct and first indirect radiative forcings4054 !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)4055 IF (flag_aerosol .GT. 0) THEN4056 IF (iflag_rrtm .EQ. 0) THEN !--old radiation4057 IF (.NOT. aerosol_couple) THEN4058 !4059 CALL readaerosol_optic( &4060 debut, flag_aerosol, itap, jD_cur-jD_ref, &4061 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &4062 mass_solu_aero, mass_solu_aero_pi, &4063 tau_aero, piz_aero, cg_aero, &4064 tausum_aero, tau3d_aero)4065 ENDIF4066 ELSE IF (iflag_rrtm .EQ.1) THEN ! RRTM radiation4067 IF (aerosol_couple .AND. config_inca == 'aero' ) THEN4068 abort_message='config_inca=aero et rrtm=1 impossible'4069 CALL abort_physic(modname,abort_message,1)4070 ELSE4071 !4072 #ifdef CPP_RRTM4073 IF (NSW.EQ.6) THEN4074 !--new aerosol properties SW and LW4075 !4076 IF (CPPKEY_DUST) THEN4077 !--SPL aerosol model4078 CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &4079 tr_seri, mass_solu_aero, mass_solu_aero_pi, &4080 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &4081 tausum_aero, tau3d_aero)4082 ELSE4083 !--climatologies or INCA aerosols4084 CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &4085 flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &4086 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &4087 tr_seri, mass_solu_aero, mass_solu_aero_pi, &4088 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &4089 tausum_aero, drytausum_aero, tau3d_aero)4090 END IF4091 4092 IF (flag_aerosol .EQ. 7) THEN4093 CALL macv2sp(pphis,pplay,paprs,longitude_deg,latitude_deg, &4094 tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm,dNovrN)4095 ENDIF4096 4097 !4098 ELSE IF (NSW.EQ.2) THEN4099 !--for now we use the old aerosol properties4100 !4101 CALL readaerosol_optic( &4102 debut, flag_aerosol, itap, jD_cur-jD_ref, &4103 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &4104 mass_solu_aero, mass_solu_aero_pi, &4105 tau_aero, piz_aero, cg_aero, &4106 tausum_aero, tau3d_aero)4107 !4108 !--natural aerosols4109 tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)4110 piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)4111 cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)4112 !--all aerosols4113 tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)4114 piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)4115 cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)4116 !4117 !--no LW optics4118 tau_aero_lw_rrtm(:,:,:,:) = 1.e-154119 !4120 ELSE4121 abort_message='Only NSW=2 or 6 are possible with ' &4122 // 'aerosols and iflag_rrtm=1'4123 CALL abort_physic(modname,abort_message,1)4124 ENDIF4125 #else4126 abort_message='You should compile with -rrtm if running ' &4127 // 'with iflag_rrtm=1'4128 CALL abort_physic(modname,abort_message,1)4129 #endif4130 !4131 ENDIF4132 ELSE IF (iflag_rrtm .EQ.2) THEN ! ecrad RADIATION4133 #ifdef CPP_ECRAD4134 !--climatologies or INCA aerosols4135 CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &4136 flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &4137 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &4138 tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)4139 #else4140 abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'4141 CALL abort_physic(modname,abort_message,1)4142 #endif4143 ENDIF4144 4145 ELSE !--flag_aerosol = 04146 tausum_aero(:,:,:) = 0.4147 drytausum_aero(:,:) = 0.4148 mass_solu_aero(:,:) = 0.4149 mass_solu_aero_pi(:,:) = 0.4150 IF (iflag_rrtm .EQ. 0) THEN !--old radiation4151 tau_aero(:,:,:,:) = 1.e-154152 piz_aero(:,:,:,:) = 1.4153 cg_aero(:,:,:,:) = 0.4154 ELSE4155 tau_aero_sw_rrtm(:,:,:,:) = 1.e-154156 tau_aero_lw_rrtm(:,:,:,:) = 1.e-154157 piz_aero_sw_rrtm(:,:,:,:) = 1.04158 cg_aero_sw_rrtm(:,:,:,:) = 0.04159 ENDIF4160 ENDIF4161 !4162 !--WMO criterion to determine tropopause4163 CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)4164 !4165 !--STRAT AEROSOL4166 !--updates tausum_aero,tau_aero,piz_aero,cg_aero4167 IF (flag_aerosol_strat.GT.0) THEN4168 IF (prt_level .GE.10) THEN4169 PRINT *,'appel a readaerosolstrat', mth_cur4170 ENDIF4171 IF (iflag_rrtm.EQ.0) THEN4172 IF (flag_aerosol_strat.EQ.1) THEN4173 CALL readaerosolstrato(debut)4174 ELSE4175 abort_message='flag_aerosol_strat must equal 1 for rrtm=0'4176 CALL abort_physic(modname,abort_message,1)4177 ENDIF4178 ELSE4179 #ifdef CPP_RRTM4180 IF (.NOT. CPPKEY_STRATAER) THEN4181 !--prescribed strat aerosols4182 !--only in the case of non-interactive strat aerosols4183 IF (flag_aerosol_strat.EQ.1) THEN4184 CALL readaerosolstrato1_rrtm(debut)4185 ELSEIF (flag_aerosol_strat.EQ.2) THEN4186 CALL readaerosolstrato2_rrtm(debut, ok_volcan)4187 ELSE4188 abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'4189 CALL abort_physic(modname,abort_message,1)4190 ENDIF4191 END IF4192 #else4193 abort_message='You should compile with -rrtm if running ' &4194 // 'with iflag_rrtm=1'4195 CALL abort_physic(modname,abort_message,1)4196 #endif4197 ENDIF4198 ELSE4199 tausum_aero(:,:,id_STRAT_phy) = 0.4200 ENDIF4201 !4202 #ifdef CPP_RRTM4203 IF (CPPKEY_STRATAER) THEN4204 !--compute stratospheric mask4205 CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)4206 !--interactive strat aerosols4207 CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)4208 END IF4209 #endif4210 !--fin STRAT AEROSOL4211 !4212 3965 4213 3966 ! Calculer les parametres optiques des nuages et quelques … … 4231 3984 CALL call_cloud_optics_prop_post() 4232 3985 4233 !3986 4234 3987 !IM betaCRF 4235 3988 ! … … 4291 4044 ! 4292 4045 ENDIF 4046 4047 4048 4049 !=============================================================================== 4050 ! Interactive chemistry through coupling with INCA or REPROBUS chemistry models 4051 ! 4052 4053 IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL 4054 IF (CPPKEY_INCA) THEN 4055 CALL VTe(VTphysiq) 4056 CALL VTb(VTinca) 4057 calday = REAL(days_elapsed + 1) + jH_cur 4058 4059 CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap) 4060 CALL AEROSOL_METEO_CALC( & 4061 calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, & 4062 prfl,psfl,pctsrf,cell_area, & 4063 latitude_deg,longitude_deg,u10m,v10m) 4064 4065 zxsnow_dummy(:) = 0.0 4066 ! INCA needs a cloud fraction that is not necessarily that 4067 ! for radiation. Here we provide a cloud fraction calculated 4068 ! the same manner as that in LMDZ5, LMDZ6 and LMDZ7 4069 DO k=1,klev 4070 DO i=1,klon 4071 cldfra_inca(i,k)=min(rneb(i,k)+rnebcon(i,k),1.) 4072 ENDDO 4073 ENDDO 4074 4075 4076 CALL chemhook_begin (calday, & 4077 days_elapsed+1, & 4078 jH_cur, & 4079 pctsrf(1,1), & 4080 latitude_deg, & 4081 longitude_deg, & 4082 cell_area, & 4083 paprs, & 4084 pplay, & 4085 coefh(1:klon,1:klev,is_ave), & 4086 pphi, & 4087 t_seri, & 4088 u, & 4089 v, & 4090 rot, & 4091 wo(:, :, 1), & 4092 q_seri, & 4093 zxtsol, & 4094 zt2m, & 4095 zxsnow_dummy, & 4096 solsw, & 4097 albsol1, & 4098 rain_fall, & 4099 snow_fall, & 4100 itop_con, & 4101 ibas_con, & 4102 cldfra_inca, & 4103 nbp_lon, & 4104 nbp_lat-1, & 4105 tr_seri(:,:,1+nqCO2:nbtr), & 4106 ftsol, & 4107 paprs, & 4108 cdragh, & 4109 cdragm, & 4110 pctsrf, & 4111 pdtphys, & 4112 itap) 4113 4114 CALL VTe(VTinca) 4115 CALL VTb(VTphysiq) 4116 END IF 4117 ENDIF !type_trac = inca or inco 4118 4119 IF (type_trac == 'repr') THEN 4120 IF (CPPKEY_REPROBUS) THEN 4121 CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap) 4122 END IF 4123 ENDIF 4124 4125 4126 !=============================================================================== 4127 ! Radiative scheme and associated aerosols 4128 ! 4129 ! Note that the following routines are called every radpas time steps 4130 4131 IF (MOD(itaprad,radpas).EQ.0) THEN 4132 4133 ! 4134 !jq - introduce the aerosol direct and first indirect radiative forcings 4135 !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) 4136 IF (flag_aerosol .GT. 0) THEN 4137 IF (iflag_rrtm .EQ. 0) THEN !--old radiation 4138 IF (.NOT. aerosol_couple) THEN 4139 ! 4140 CALL readaerosol_optic( & 4141 debut, flag_aerosol, itap, jD_cur-jD_ref, & 4142 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 4143 mass_solu_aero, mass_solu_aero_pi, & 4144 tau_aero, piz_aero, cg_aero, & 4145 tausum_aero, tau3d_aero) 4146 ENDIF 4147 ELSE IF (iflag_rrtm .EQ.1) THEN ! RRTM radiation 4148 IF (aerosol_couple .AND. config_inca == 'aero' ) THEN 4149 abort_message='config_inca=aero et rrtm=1 impossible' 4150 CALL abort_physic(modname,abort_message,1) 4151 ELSE 4152 ! 4153 #ifdef CPP_RRTM 4154 IF (NSW.EQ.6) THEN 4155 !--new aerosol properties SW and LW 4156 ! 4157 IF (CPPKEY_DUST) THEN 4158 !--SPL aerosol model 4159 CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, & 4160 tr_seri, mass_solu_aero, mass_solu_aero_pi, & 4161 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & 4162 tausum_aero, tau3d_aero) 4163 ELSE 4164 !--climatologies or INCA aerosols 4165 CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, & 4166 flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, & 4167 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 4168 tr_seri, mass_solu_aero, mass_solu_aero_pi, & 4169 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & 4170 tausum_aero, drytausum_aero, tau3d_aero) 4171 END IF 4172 4173 IF (flag_aerosol .EQ. 7) THEN 4174 CALL macv2sp(pphis,pplay,paprs,longitude_deg,latitude_deg, & 4175 tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm,dNovrN) 4176 ENDIF 4177 4178 ! 4179 ELSE IF (NSW.EQ.2) THEN 4180 !--for now we use the old aerosol properties 4181 ! 4182 CALL readaerosol_optic( & 4183 debut, flag_aerosol, itap, jD_cur-jD_ref, & 4184 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 4185 mass_solu_aero, mass_solu_aero_pi, & 4186 tau_aero, piz_aero, cg_aero, & 4187 tausum_aero, tau3d_aero) 4188 ! 4189 !--natural aerosols 4190 tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:) 4191 piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:) 4192 cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:) 4193 !--all aerosols 4194 tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:) 4195 piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:) 4196 cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:) 4197 ! 4198 !--no LW optics 4199 tau_aero_lw_rrtm(:,:,:,:) = 1.e-15 4200 ! 4201 ELSE 4202 abort_message='Only NSW=2 or 6 are possible with ' & 4203 // 'aerosols and iflag_rrtm=1' 4204 CALL abort_physic(modname,abort_message,1) 4205 ENDIF 4206 #else 4207 abort_message='You should compile with -rrtm if running ' & 4208 // 'with iflag_rrtm=1' 4209 CALL abort_physic(modname,abort_message,1) 4210 #endif 4211 ! 4212 ENDIF 4213 ELSE IF (iflag_rrtm .EQ.2) THEN ! ecrad RADIATION 4214 #ifdef CPP_ECRAD 4215 !--climatologies or INCA aerosols 4216 CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, & 4217 flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, & 4218 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 4219 tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer) 4220 #else 4221 abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2' 4222 CALL abort_physic(modname,abort_message,1) 4223 #endif 4224 ENDIF 4225 4226 ELSE !--flag_aerosol = 0 4227 tausum_aero(:,:,:) = 0. 4228 drytausum_aero(:,:) = 0. 4229 mass_solu_aero(:,:) = 0. 4230 mass_solu_aero_pi(:,:) = 0. 4231 IF (iflag_rrtm .EQ. 0) THEN !--old radiation 4232 tau_aero(:,:,:,:) = 1.e-15 4233 piz_aero(:,:,:,:) = 1. 4234 cg_aero(:,:,:,:) = 0. 4235 ELSE 4236 tau_aero_sw_rrtm(:,:,:,:) = 1.e-15 4237 tau_aero_lw_rrtm(:,:,:,:) = 1.e-15 4238 piz_aero_sw_rrtm(:,:,:,:) = 1.0 4239 cg_aero_sw_rrtm(:,:,:,:) = 0.0 4240 ENDIF 4241 ENDIF 4242 ! 4243 !--WMO criterion to determine tropopause 4244 CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg) 4245 ! 4246 !--STRAT AEROSOL 4247 !--updates tausum_aero,tau_aero,piz_aero,cg_aero 4248 IF (flag_aerosol_strat.GT.0) THEN 4249 IF (prt_level .GE.10) THEN 4250 PRINT *,'appel a readaerosolstrat', mth_cur 4251 ENDIF 4252 IF (iflag_rrtm.EQ.0) THEN 4253 IF (flag_aerosol_strat.EQ.1) THEN 4254 CALL readaerosolstrato(debut) 4255 ELSE 4256 abort_message='flag_aerosol_strat must equal 1 for rrtm=0' 4257 CALL abort_physic(modname,abort_message,1) 4258 ENDIF 4259 ELSE 4260 #ifdef CPP_RRTM 4261 IF (.NOT. CPPKEY_STRATAER) THEN 4262 !--prescribed strat aerosols 4263 !--only in the case of non-interactive strat aerosols 4264 IF (flag_aerosol_strat.EQ.1) THEN 4265 CALL readaerosolstrato1_rrtm(debut) 4266 ELSEIF (flag_aerosol_strat.EQ.2) THEN 4267 CALL readaerosolstrato2_rrtm(debut, ok_volcan) 4268 ELSE 4269 abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1' 4270 CALL abort_physic(modname,abort_message,1) 4271 ENDIF 4272 END IF 4273 #else 4274 abort_message='You should compile with -rrtm if running ' & 4275 // 'with iflag_rrtm=1' 4276 CALL abort_physic(modname,abort_message,1) 4277 #endif 4278 ENDIF 4279 ELSE 4280 tausum_aero(:,:,id_STRAT_phy) = 0. 4281 ENDIF 4282 ! 4283 #ifdef CPP_RRTM 4284 IF (CPPKEY_STRATAER) THEN 4285 !--compute stratospheric mask 4286 CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg) 4287 !--interactive strat aerosols 4288 CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut) 4289 END IF 4290 #endif 4291 !--fin STRAT AEROSOL 4292 ! 4293 4293 4294 4294 !lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek
Note: See TracChangeset
for help on using the changeset viewer.
