- Timestamp:
- Mar 19, 2024, 3:34:21 PM (8 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_gas.F90
r4773 r4853 72 72 procedure :: assert_units => assert_units_gas 73 73 procedure :: get => get_gas 74 procedure :: get_scaling 74 75 procedure :: reverse => reverse_gas 75 76 procedure :: out_of_physical_bounds … … 355 356 real(jprb), optional, intent(in) :: scale_factor 356 357 357 integer :: ig358 integer :: jg 358 359 359 360 ! Scaling factor to convert from old to new … … 396 397 end if 397 398 else 398 do ig = 1,this%ntype399 call this%set_units(iunits, igas=this%icode( ig), scale_factor=new_sf)399 do jg = 1,this%ntype 400 call this%set_units(iunits, igas=this%icode(jg), scale_factor=new_sf) 400 401 end do 401 402 end if … … 403 404 end subroutine set_units_gas 404 405 405 406 407 !--------------------------------------------------------------------- 408 ! Return a vector indicating the scaling that one would need to 409 ! apply to each gas in order to obtain the dimension units in 410 ! "iunits" (which can be IVolumeMixingRatio or IMassMixingRatio) 411 subroutine get_scaling(this, iunits, scaling) 412 class(gas_type), intent(in) :: this 413 integer, intent(in) :: iunits 414 real(jprb), intent(out) :: scaling(NMaxGases) 415 integer :: jg 416 417 scaling = this%scale_factor 418 do jg = 1,NMaxGases 419 if (iunits == IMassMixingRatio .and. this%iunits(jg) == IVolumeMixingRatio) then 420 scaling(jg) = scaling(jg) * GasMolarMass(jg) / AirMolarMass 421 else if (iunits == IVolumeMixingRatio .and. this%iunits(jg) == IMassMixingRatio) then 422 scaling(jg) = scaling(jg) * AirMolarMass / GasMolarMass(jg) 423 end if 424 end do 425 426 end subroutine get_scaling 427 428 406 429 !--------------------------------------------------------------------- 407 430 ! Assert that gas mixing ratio units are "iunits", applying to gas 408 431 ! with ID "igas" if present, otherwise to all gases. Otherwise the 409 ! program will exit. Otional argument scale factor specifies any 410 ! subsequent multiplication to apply; for PPMV one would use 411 ! iunits=IVolumeMixingRatio and scale_factor=1.0e6. 412 recursive subroutine assert_units_gas(this, iunits, igas, scale_factor) 432 ! program will exit, except if the optional argument "istatus" is 433 ! provided in which case it will return true if the units are 434 ! correct and false if they are not. Optional argument scale factor 435 ! specifies any subsequent multiplication to apply; for PPMV one 436 ! would use iunits=IVolumeMixingRatio and scale_factor=1.0e6. 437 recursive subroutine assert_units_gas(this, iunits, igas, scale_factor, istatus) 413 438 414 439 use radiation_io, only : nulerr, radiation_abort 415 440 416 class(gas_type), intent(in) :: this 417 integer, intent(in) :: iunits 418 integer, optional, intent(in) :: igas 419 real(jprb), optional, intent(in) :: scale_factor 420 421 integer :: ig 441 class(gas_type), intent(in) :: this 442 integer, intent(in) :: iunits 443 integer, optional, intent(in) :: igas 444 real(jprb), optional, intent(in) :: scale_factor 445 logical, optional, intent(out) :: istatus 446 447 integer :: jg 422 448 423 449 real(jprb) :: sf … … 429 455 end if 430 456 457 if (present(istatus)) then 458 istatus = .true. 459 end if 460 431 461 if (present(igas)) then 432 462 if (this%is_present(igas)) then 433 463 if (iunits /= this%iunits(igas)) then 434 write(nulerr,'(a,a,a)') '*** Error: ', trim(GasName(igas)), & 435 & ' is not in the required units' 436 call radiation_abort() 464 if (present(istatus)) then 465 istatus = .false. 466 else 467 write(nulerr,'(a,a,a)') '*** Error: ', trim(GasName(igas)), & 468 & ' is not in the required units' 469 call radiation_abort() 470 end if 437 471 else if (sf /= this%scale_factor(igas)) then 438 write(nulerr,'(a,a,a,e12.4,a,e12.4)') '*** Error: ', GasName(igas), & 439 & ' scaling of ', this%scale_factor(igas), & 440 & ' does not match required ', sf 441 call radiation_abort() 472 if (present(istatus)) then 473 istatus = .false. 474 else 475 write(nulerr,'(a,a,a,e12.4,a,e12.4)') '*** Error: ', GasName(igas), & 476 & ' scaling of ', this%scale_factor(igas), & 477 & ' does not match required ', sf 478 call radiation_abort() 479 end if 442 480 end if 443 481 end if 444 482 else 445 do ig = 1,this%ntype446 call this%assert_units(iunits, igas=this%icode( ig), scale_factor=sf)483 do jg = 1,this%ntype 484 call this%assert_units(iunits, igas=this%icode(jg), scale_factor=sf, istatus=istatus) 447 485 end do 448 486 end if
Note: See TracChangeset
for help on using the changeset viewer.