- Timestamp:
- Nov 21, 2019, 4:43:45 PM (4 years ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
-
LMDZ6/branches/Ocean_skin/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90
r2744 r3605 2 2 ! $Id: readaerosolstrato2_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $ 3 3 ! 4 SUBROUTINE readaerosolstrato2_rrtm(debut )4 SUBROUTINE readaerosolstrato2_rrtm(debut, ok_volcan) 5 5 6 6 USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & … … 9 9 10 10 USE phys_cal_mod, ONLY : mth_cur 11 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo 12 USE mod_phys_lmdz_mpi_data , ONLY : is_mpi_root13 USE mod_phys_lmdz_omp_data , ONLY : is_omp_root11 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured 12 USE mod_phys_lmdz_mpi_data 13 USE mod_phys_lmdz_omp_data 14 14 USE mod_phys_lmdz_para 15 15 USE phys_state_var_mod … … 19 19 USE YOERAD, ONLY : NLW 20 20 USE YOMCST 21 #ifdef CPP_XIOS 22 USE xios 23 #endif 21 24 22 25 IMPLICIT NONE … … 29 32 ! Variable input 30 33 LOGICAL, INTENT(IN) :: debut 34 LOGICAL, INTENT(IN) :: ok_volcan !activate volcanic diags 31 35 32 36 ! Variables locales … … 65 69 REAL, ALLOCATABLE:: cgaerstrat_mois_glo(:, :, :) 66 70 REAL, ALLOCATABLE:: taulwaerstrat_mois_glo(:, :, :) 71 REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :, :) 72 REAL, ALLOCATABLE:: pizaerstrat_mpi(:, :, :) 73 REAL, ALLOCATABLE:: cgaerstrat_mpi(:, :, :) 74 REAL, ALLOCATABLE:: taulwaerstrat_mpi(:, :, :) 67 75 68 76 ! For NetCDF: … … 107 115 CALL nf95_gw_var(ncid_in, varid, latitude) 108 116 n_lat = size(latitude) 109 IF (n_lat.NE.nbp_lat) THEN 110 print *, 'latitude=', n_lat, nbp_lat 111 abort_message='Le nombre de lat n est pas egal a nbp_lat' 112 CALL abort_physic(modname,abort_message,1) 117 118 IF (grid_type/=unstructured) THEN 119 IF (n_lat.NE.nbp_lat) THEN 120 print *, 'latitude=', n_lat, nbp_lat 121 abort_message='Le nombre de lat n est pas egal a nbp_lat' 122 CALL abort_physic(modname,abort_message,1) 123 ENDIF 113 124 ENDIF 114 125 … … 134 145 ALLOCATE(cgaerstrat(n_lat, n_lev, n_wav, n_month)) 135 146 136 ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav))137 ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav))138 ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav))139 140 ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav))141 ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav))142 ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav))143 144 147 !--reading stratospheric aerosol tau per layer 145 148 CALL nf95_inq_varid(ncid_in, "TAU_SUN", varid) … … 159 162 CALL nf95_close(ncid_in) 160 163 164 165 IF (grid_type/=unstructured) THEN 166 ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) 167 ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) 168 ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) 169 170 ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav)) 171 ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav)) 172 ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav)) 161 173 !--select the correct month 162 174 !--and copy into 1st longitude 163 tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur)164 pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur)165 cgaerstrat_mois(1,:,:,:) = cgaerstrat(:,:,:,mth_cur)175 tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur) 176 pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur) 177 cgaerstrat_mois(1,:,:,:) = cgaerstrat(:,:,:,mth_cur) 166 178 167 179 !--copy longitudes 168 DO i=2, n_lon169 tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:)170 pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:)171 cgaerstrat_mois(i,:,:,:) = cgaerstrat_mois(1,:,:,:)172 ENDDO180 DO i=2, n_lon 181 tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:) 182 pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:) 183 cgaerstrat_mois(i,:,:,:) = cgaerstrat_mois(1,:,:,:) 184 ENDDO 173 185 174 186 !---reduce to a klon_glo grid 175 DO band=1, NSW176 CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band))177 CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band))178 CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band))179 ENDDO180 187 DO band=1, NSW 188 CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band)) 189 CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band)) 190 CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band)) 191 ENDDO 192 ENDIF 181 193 !--Now LW optical properties 182 194 ! 195 183 196 CALL nf95_open("taulwstrat.2D.nc", nf90_nowrite, ncid_in) 184 197 … … 194 207 CALL nf95_gw_var(ncid_in, varid, latitude) 195 208 n_lat = size(latitude) 196 IF (n_lat.NE.nbp_lat) THEN 197 abort_message='Le nombre de lat n est pas egal a nbp_lat' 198 CALL abort_physic(modname,abort_message,1) 199 ENDIF 200 209 210 IF (grid_type/=unstructured) THEN 211 IF (n_lat.NE.nbp_lat) THEN 212 abort_message='Le nombre de lat n est pas egal a nbp_lat' 213 CALL abort_physic(modname,abort_message,1) 214 ENDIF 215 ENDIF 216 201 217 CALL nf95_inq_varid(ncid_in, "TIME", varid) 202 218 CALL nf95_gw_var(ncid_in, varid, time) … … 217 233 218 234 ALLOCATE(taulwaerstrat(n_lat, n_lev, n_wav, n_month)) 219 ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav))220 ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav))221 235 222 236 !--reading stratospheric aerosol lw tau per layer … … 227 241 CALL nf95_close(ncid_in) 228 242 243 IF (grid_type/=unstructured) THEN 244 245 ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) 246 ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav)) 247 229 248 !--select the correct month 230 249 !--and copy into 1st longitude 231 taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur)250 taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur) 232 251 !--copy longitudes 233 DO i=2, n_lon234 taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:)235 ENDDO252 DO i=2, n_lon 253 taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:) 254 ENDDO 236 255 237 256 !---reduce to a klon_glo grid 238 DO band=1, NLW 239 CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band)) 240 ENDDO 241 257 DO band=1, NLW 258 CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band)) 259 ENDDO 260 ENDIF 261 242 262 ELSE !--proc other than mpi_root and omp_root 243 263 !--dummy allocation needed for debug mode … … 248 268 ALLOCATE(taulwaerstrat_mois_glo(1,1,1)) 249 269 270 ALLOCATE(tauaerstrat(0,0,0,12)) 271 ALLOCATE(pizaerstrat(0,0,0,12)) 272 ALLOCATE(cgaerstrat(0,0,0,12)) 273 ALLOCATE(taulwaerstrat(0,0,0,12)) 274 275 250 276 ENDIF !--is_mpi_root and is_omp_root 251 277 … … 255 281 mth_pre=mth_cur 256 282 283 IF (grid_type==unstructured) THEN 284 285 #ifdef CPP_XIOS 286 287 IF (is_omp_master) THEN 288 ALLOCATE(tauaerstrat_mpi(klon_mpi, klev, NSW)) 289 ALLOCATE(pizaerstrat_mpi(klon_mpi, klev, NSW)) 290 ALLOCATE(cgaerstrat_mpi(klon_mpi, klev, NSW)) 291 ALLOCATE(taulwaerstrat_mpi(klon_mpi, klev, NLW)) 292 293 CALL xios_send_field("tauaerstrat_in",SPREAD(tauaerstrat(:,:,:,mth_cur),1,8)) 294 CALL xios_recv_field("tauaerstrat_out",tauaerstrat_mpi) 295 CALL xios_send_field("pizaerstrat_in",SPREAD(pizaerstrat(:,:,:,mth_cur),1,8)) 296 CALL xios_recv_field("pizaerstrat_out",pizaerstrat_mpi) 297 CALL xios_send_field("cgaerstrat_in",SPREAD(cgaerstrat(:,:,:,mth_cur),1,8)) 298 CALL xios_recv_field("cgaerstrat_out",cgaerstrat_mpi) 299 CALL xios_send_field("taulwaerstrat_in",SPREAD(taulwaerstrat(:,:,:,mth_cur),1,8)) 300 CALL xios_recv_field("taulwaerstrat_out",taulwaerstrat_mpi) 301 ELSE 302 ALLOCATE(tauaerstrat_mpi(0, 0, 0)) 303 ALLOCATE(pizaerstrat_mpi(0, 0, 0)) 304 ALLOCATE(cgaerstrat_mpi(0, 0, 0)) 305 ALLOCATE(taulwaerstrat_mpi(0, 0, 0)) 306 ENDIF 307 308 CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat) 309 CALL scatter_omp(pizaerstrat_mpi,piz_aer_strat) 310 CALL scatter_omp(cgaerstrat_mpi,cg_aer_strat) 311 CALL scatter_omp(taulwaerstrat_mpi,taulw_aer_strat) 312 #endif 313 ELSE 314 257 315 !--scatter on all proc 258 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) 259 CALL scatter(pizaerstrat_mois_glo,piz_aer_strat) 260 CALL scatter(cgaerstrat_mois_glo,cg_aer_strat) 261 CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat) 316 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) 317 CALL scatter(pizaerstrat_mois_glo,piz_aer_strat) 318 CALL scatter(cgaerstrat_mois_glo,cg_aer_strat) 319 CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat) 320 IF (is_mpi_root.AND.is_omp_root) DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois, taulwaerstrat_mois) 321 322 ENDIF 262 323 263 324 IF (is_mpi_root.AND.is_omp_root) THEN 264 ! 265 DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat) 266 DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois) 267 DEALLOCATE(taulwaerstrat,taulwaerstrat_mois) 268 ! 269 ENDIF !--is_mpi_root and is_omp_root 270 271 DEALLOCATE(tauaerstrat_mois_glo,pizaerstrat_mois_glo,cgaerstrat_mois_glo) 272 DEALLOCATE(taulwaerstrat_mois_glo) 325 DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat,taulwaerstrat) 326 ENDIF 327 273 328 274 329 !$OMP BARRIER … … 290 345 ENDDO 291 346 347 IF (.NOT. ok_volcan) THEN 348 ! 349 !--this is the default case 350 !--stratospheric aerosols are added to both index 2 and 1 for double radiation calls 292 351 !--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones 293 352 DO band=1, NSW 294 353 WHERE (stratomask.GT.0.999999) 295 !-- anthropogenic aerosolsbands 1 to NSW354 !--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW 296 355 cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & 297 356 cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & … … 302 361 MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 ) 303 362 tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band) 304 !-- natural aerosolsbands 1 to NSW363 !--strat aerosols are added to index 1 : natural aerosols only for bands 1 to NSW 305 364 cg_aero_sw_rrtm(:,:,1,band) = ( cg_aero_sw_rrtm(:,:,1,band)*piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & 365 cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & 366 MAX( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & 367 piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 ) 368 piz_aero_sw_rrtm(:,:,1,band) = ( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & 369 piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & 370 MAX( tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band), 1.e-15 ) 371 tau_aero_sw_rrtm(:,:,1,band) = tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band) 372 ENDWHERE 373 ENDDO 374 ! 375 ELSE 376 ! 377 !--this is the VOLMIP case 378 !--stratospheric aerosols are only added to index 2 in this case 379 !--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones 380 DO band=1, NSW 381 WHERE (stratomask.GT.0.999999) 382 !--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW 383 cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & 306 384 cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & 307 MAX( piz_aero_sw_rrtm(:,:, 1,band)*tau_aero_sw_rrtm(:,:,1,band) + &385 MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & 308 386 piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 ) 309 piz_aero_sw_rrtm(:,:, 1,band) = ( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + &387 piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & 310 388 piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & 311 MAX( tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band), 1.e-15 ) 312 tau_aero_sw_rrtm(:,:,1,band) = tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band) 313 !--no stratospheric aerosol in index 1 for these tests 314 ! cg_aero_sw_rrtm(:,:,1,band) = cg_aero_sw_rrtm(:,:,1,band) 315 ! piz_aero_sw_rrtm(:,:,1,band) = piz_aero_sw_rrtm(:,:,1,band) 316 ! tau_aero_sw_rrtm(:,:,1,band) = tau_aero_sw_rrtm(:,:,1,band) 317 ENDWHERE 318 ENDDO 389 MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 ) 390 tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band) 391 ENDWHERE 392 ENDDO 393 ENDIF 319 394 320 395 !--total vertical aod at 10 um … … 331 406 ENDDO 332 407 408 IF (.NOT. ok_volcan) THEN 409 !--this is the default case 410 !--stratospheric aerosols are added to both index 2 and 1 333 411 DO band=1, NLW 334 412 WHERE (stratomask.GT.0.999999) 335 413 tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band) 336 414 tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,1,band) + taulw_aer_strat(:,:,band) 337 !--no stratospheric aerosols in index 1 for these tests338 ! tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,1,band)339 415 ENDWHERE 340 416 ENDDO 417 ! 418 ELSE 419 ! 420 !--this is the VOLMIP case 421 DO band=1, NLW 422 !--stratospheric aerosols are not added to index 1 423 !--and we copy index 2 in index 1 because we want the same dust aerosol LW properties as above 424 tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,2,band) 425 ! 426 WHERE (stratomask.GT.0.999999) 427 !--stratospheric aerosols are only added to index 2 428 tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band) 429 ENDWHERE 430 ENDDO 431 ENDIF 341 432 342 433 !--default SSA value if there is no aerosol
Note: See TracChangeset
for help on using the changeset viewer.
