module radiation_diag_mod ! ! fil ! ! ! ds ! ! ! Module that provides a diagnostic output file of radiation- ! related variables in user-specified atmospheric columns for the ! sea_esf_rad radiation package. ! ! ! ! shared modules: use mpp_mod, only: input_nml_file use fms_mod, only: open_namelist_file, fms_init, & mpp_pe, mpp_root_pe, stdlog, & file_exist, write_version_number, & check_nml_error, error_mesg, & FATAL, close_file, & open_file use constants_mod, only: constants_init, radcon_mks, radian ! shared radiation package modules: use rad_utilities_mod, only: Lw_control, Sw_control,& rad_utilities_init, radiative_gases_type,& astronomy_type, atmos_input_type, & surface_type, cldrad_properties_type, & cld_specification_type, & cld_space_properties_type, & lw_diagnostics_type, lw_table_type, & sw_output_type, lw_output_type, & Rad_control !-------------------------------------------------------------------- implicit none private !--------------------------------------------------------------------- ! radiation_diag_mod provides a diagnostic output file of radiation- ! related variables in user-specified atmospheric columns for the ! sea_esf_rad radiation package. !--------------------------------------------------------------------- !--------------------------------------------------------------------- !----------- version number for this module -------------------------- character(len=128) :: version = '$Id: radiation_diag.F90,v 19.0 2012/01/06 20:22:27 fms Exp $' character(len=128) :: tagname = '$Name: tikal $' !--------------------------------------------------------------------- !------ interfaces ------ public & radiation_diag_init, & radiation_diag_driver, & radiation_diag_end private & radiag !--------------------------------------------------------------------- !---------- namelist ----- integer, parameter :: MAX_PTS = 20 integer, dimension (MAX_PTS) :: iradprt_gl=0, jradprt_gl=0 real, dimension(MAX_PTS) :: latradprt=999., lonradprt=999. integer :: num_pts_ij = 0 integer :: num_pts_latlon = 0 namelist / radiation_diag_nml / & iradprt_gl, jradprt_gl, & num_pts_ij, num_pts_latlon, & latradprt, lonradprt !---------------------------------------------------------------------- !--- public data --- !---------------------------------------------------------------------- !--- private data --- !---------------------------------------------------------------------- ! bandlo and bandhi are the lower and upper frequencies defining ! each of the nblw longwave radiation bands in the longwave spectrum ! (0 - 3000 cm-1). !---------------------------------------------------------------------- real, dimension(:), allocatable :: bandlo, bandhi !---------------------------------------------------------------------- ! bdlocm and bdhicm are the lower and upper frequencies defining ! each of the nbly frequency bands used in the exact cool-to-space ! calculation. ! -------------------------------------------------------------------- real, dimension(:), allocatable :: bdlocm, bdhicm !--------------------------------------------------------------------- ! iband is frequency band index to be used in combined band ! calculations. !--------------------------------------------------------------------- integer, dimension(:), allocatable :: iband !--------------------------------------------------------------------- ! deglon1 and deglat1 are the longitude and latitude of the columns ! at which diagnostics will be calculated (degrees). !--------------------------------------------------------------------- real, dimension(:), allocatable :: deglon1, deglat1 !--------------------------------------------------------------------- ! iradprt and jradprt are the processor-based i and j coordinates ! of the desired diagnostics columns. !--------------------------------------------------------------------- integer, dimension(:), allocatable :: jradprt, iradprt !--------------------------------------------------------------------- ! do_raddg is an array of logicals indicating which latitude rows ! belonging to the processor contain diagnostics columns. !--------------------------------------------------------------------- logical, dimension(:), allocatable :: do_raddg integer :: nbly ! number of frequency bands for exact ! cool-to-space calculation integer :: n_continuum_bands ! number of bands in the h2o continuum integer :: radiag_unit ! i/o unit to which output file is ! written integer :: num_pts ! total number of columns in which ! diagnostics are desired logical :: module_is_initialized = .false. ! module initialized ? !--------------------------------------------------------------------- !--------------------------------------------------------------------- contains !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! ! PUBLIC SUBROUTINES ! ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !##################################################################### ! ! ! Constructor of the radiation_diag_mod module ! ! ! Constructor of the radiation_diag_mod module ! ! ! ! 2d array of model latitudes at cell corners [radians] ! ! ! 2d array of model longitudes at cell corners [radians] ! ! ! lw_tables_type variable containing various longwave ! table specifiers needed by radiation_diag_mod. ! ! ! subroutine radiation_diag_init (latb, lonb, Lw_tables) !--------------------------------------------------------------------- ! radiation_diag_init is the constructor for radiation_diag_mod. !--------------------------------------------------------------------- !--------------------------------------------------------------------- real, dimension(:,:), intent(in) :: latb, lonb type(lw_table_type), intent(in) :: Lw_tables !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! intent(in) variables: ! ! latb 2d array of model latitudes at cell corners [radians] ! lonb 2d array of model longitudes at cell corners [radians] ! Lw_tables lw_tables_type variable containing various longwave ! table specifiers needed by radiation_diag_mod. ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables integer :: unit, ierr, io, logunit integer :: nn, j, i, nblw real :: dellat, dellon !-------------------------------------------------------------------- ! local variables ! ! unit ! !------------------------------------------------------------------- !-------------------------------------------------------------------- ! if routine has already been executed, return. !-------------------------------------------------------------------- if (module_is_initialized) return !------------------------------------------------------------------- ! verify that modules used by this module that are not called later ! have already been initialized. !------------------------------------------------------------------- call fms_init call constants_init call rad_utilities_init !----------------------------------------------------------------------- ! read namelist. !----------------------------------------------------------------------- #ifdef INTERNAL_FILE_NML read (input_nml_file, nml=radiation_diag_nml, iostat=io) ierr = check_nml_error(io,'radiation_diag_nml') #else if ( file_exist('input.nml')) then unit = open_namelist_file ( ) ierr=1; do while (ierr /= 0) read (unit, nml=radiation_diag_nml, iostat=io, end=10) ierr = check_nml_error(io,'radiation_diag_nml') end do 10 call close_file (unit) endif #endif !--------------------------------------------------------------------- ! write version number and namelist to logfile. !--------------------------------------------------------------------- call write_version_number(version, tagname) logunit = stdlog() if (mpp_pe() == mpp_root_pe() ) & write (logunit, nml=radiation_diag_nml) !--------------------------------------------------------------------- ! allocate and initialize a flag array which indicates the latitudes ! containing columns where radiation diagnostics are desired. !--------------------------------------------------------------------- allocate (do_raddg (size(latb,2)-1) ) do_raddg(:) = .false. !------------------------------------------------------------------- ! define the total number of points at which diagnostics are desired. ! points may be specified either by lat-lon pairs or by global index ! pairs. !------------------------------------------------------------------- num_pts = num_pts_latlon + num_pts_ij !------------------------------------------------------------------- ! continue on only if diagnostics are desired in at least one column. !------------------------------------------------------------------- if (num_pts > 0) then !------------------------------------------------------------------- ! if more points are desired than space has been reserved for, print ! a message. !------------------------------------------------------------------- if (num_pts > MAX_PTS) then call error_mesg ( 'radiation_diag_mod', & 'must reset MAX_PTS or reduce number of diagnostics points', & FATAL) endif !------------------------------------------------------------------- ! allocate space for arrays which will contain the lat and lon and ! processor-local i and j indices. !------------------------------------------------------------------- allocate ( deglon1 (num_pts)) allocate ( deglat1 (num_pts)) allocate ( jradprt (num_pts)) allocate ( iradprt (num_pts)) !--------------------------------------------------------------------- ! if any points for diagnostics are specified by (i,j) global ! indices, determine their lat-lon coordinates. assumption is made ! that the deltas of latitude and longitude are uniform over ! the globe. !--------------------------------------------------------------------- do nn=1,num_pts_ij dellat = latb(1,2) - latb(1,1) dellon = lonb(2,1) - lonb(1,1) latradprt(nn + num_pts_latlon) = & (-0.5*acos(-1.0) + (jradprt_gl(nn) - 0.5)* & dellat) * radian lonradprt(nn + num_pts_latlon) = & (iradprt_gl(nn) - 0.5)*dellon*radian end do !-------------------------------------------------------------------- ! determine if the lat/lon values are within the global grid, ! latitude between -90 and 90 degrees and longitude between 0 and ! 360 degrees. !-------------------------------------------------------------------- do nn=1,num_pts jradprt(nn) = 0 iradprt(nn) = 0 deglat1(nn) = 0.0 deglon1(nn) = 0.0 if (latradprt(nn) .ge. -90. .and. & latradprt(nn) .le. 90.) then else call error_mesg ('radiation_diag_mod', & ' invalid latitude for radiation diagnostics ', FATAL) endif if (lonradprt(nn) .ge. 0. .and. & lonradprt(nn) .le. 360.) then else call error_mesg ('radiation_diag_mod', & ' invalid longitude for radiation diagnostics ', FATAL) endif !-------------------------------------------------------------------- ! determine if the diagnostics column is within the current ! processor's domain. if so, set a logical flag indicating the ! presence of a diagnostic column on the particular row, define the ! i and j processor-coordinates and the latitude and longitude of ! the diagnostics column. !-------------------------------------------------------------------- do j=1,size(latb,2) - 1 if (latradprt(nn) .ge. latb(1,j)*radian .and. & latradprt(nn) .lt. latb(1,j+1)*radian) then do i=1,size(lonb,1) - 1 if (lonradprt(nn) .ge. lonb(i,1)*radian & .and.& lonradprt(nn) .lt. lonb(i+1,1)*radian) & then do_raddg(j) = .true. jradprt(nn) = j iradprt(nn) = i deglon1(nn) = 0.5*(lonb(i,1) + lonb(i+1,1))* & radian deglat1(nn) = 0.5*(latb(1,j) + latb(1,j+1))* & radian exit endif end do exit endif end do end do !---------------------------------------------------------------------- ! open a unit for the radiation diagnostics output. !--------------------------------------------------------------------- radiag_unit = open_file ('radiation_diag.out', action='write', & threading='multi', form='formatted') !---------------------------------------------------------------------- ! save the input fields from the lw_tables_type variable that will ! be used by this module. !---------------------------------------------------------------------- nbly = size(Lw_tables%bdlocm(:)) nblw = size(Lw_tables%bandlo(:)) n_continuum_bands = size(Lw_tables%iband(:)) allocate ( bdlocm (nbly) ) allocate ( bdhicm (nbly) ) allocate ( iband (n_continuum_bands) ) allocate ( bandlo (nblw) ) allocate ( bandhi (nblw) ) bdlocm(:) = Lw_tables%bdlocm(:) bdhicm(:) = Lw_tables%bdhicm(:) iband (:) = Lw_tables%iband(:) bandlo(:) = Lw_tables%bandlo(:) bandhi(:) = Lw_tables%bandhi(:) endif ! (num_pts > 0) !--------------------------------------------------------------------- ! set flag indicating successful initialization of module. !--------------------------------------------------------------------- module_is_initialized = .true. end subroutine radiation_diag_init !#################################################################### ! ! ! Subroutine to determine if a diagnostics column is present ! in the current physics window, and, if so, calls radiag to ! obtain the desired variables in that column and output them to ! a data file. ! ! ! Subroutine to determine if a diagnostics column is present ! in the current physics window, and, if so, calls radiag to ! obtain the desired variables in that column and output them to ! a data file. ! ! ! ! starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! ! ! atmos_input_type variable containing the atmospheric ! input fields needed by the radiation package ! ! ! Surface boundary condition to radiation package ! ! ! astronomy_type variable containing the astronomical ! input fields needed by the radiation package ! ! ! radiative_gases_type variable containing the radi- ! ative gas input fields needed by the radiation ! package ! ! ! cldrad_prperties_type variable containing the cloud radiative ! property input fields needed by the radiation package ! ! ! cld_specification_type variable containing ! cloud information relevant to the radiation package ! ! ! sw_output_type variable containing shortwave ! radiation output data ! ! ! lw_output_type variable containing longwave ! radiation output data ! ! ! lw_diagnostics_type variable containing diagnostic ! longwave output used by the radiation diagnostics ! module ! ! ! cld_space_properties_type variable containing infor- ! mation on cloud properties seen by the radiation ! package in cloud-space coordinates ! ! ! subroutine radiation_diag_driver (is, ie, js, je, Atmos_input, & Surface, Astro, Rad_gases, & Cldrad_props, Cld_spec, & Sw_output, Lw_output, Lw_diagnostics,& Cldspace_rad) !--------------------------------------------------------------------- ! radiation_diag_driver determines if a diagnostics column is present ! in the current physics window, and, if so, calls radiag to ! obtain the desired variables in that column and output them to ! a data file. !---------------------------------------------------------------------- integer, intent(in) :: is, ie, js, je type(atmos_input_type), intent(in) :: Atmos_input type(surface_type), intent(in) :: Surface type(astronomy_type), intent(in) :: Astro type(radiative_gases_type), intent(in) :: Rad_gases type(cldrad_properties_type), intent(in) :: Cldrad_props type(cld_specification_type), intent(in) :: Cld_spec type(sw_output_type), dimension(:), intent(in) :: Sw_output type(lw_output_type), dimension(:), intent(in) :: Lw_output type(lw_diagnostics_type), intent(in) :: Lw_diagnostics type(cld_space_properties_type), intent(in) :: Cldspace_rad !-------------------------------------------------------------------- ! intent(in) variables: ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! Atmos_input atmos_input_type variable containing the atmospheric ! input fields needed by the radiation package ! Surface surface_type variable containing surface variables ! needed by the radiation package ! Astro astronomy_type variable containing the astronomical ! input fields needed by the radiation package ! Rad_gases radiative_gases_type variable containing the radi- ! ative gas input fields needed by the radiation ! package ! Cldrad_props cldrad_properties_type variable containing the ! cloud radiative property input fields needed by the ! radiation package ! Cld_spec cld_specification_type variable containing the ! cloud specification input fields needed by the ! radiation package ! Sw_output sw_output_type variable containing shortwave ! radiation output data ! Lw_output lw_output_type variable containing longwave ! radiation output data ! Lw_diagnostics ! lw_diagnostics_type variable containing diagnostic ! longwave output used by the radiation diagnostics ! module ! Cldspace_rad cld_space_properties_type variable containing infor- ! mation on cloud properties seen by the radiation ! package in cloud-space coordinates ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables integer :: j ! do-loop index !--------------------------------------------------------------------- ! be sure module has been initialized. !--------------------------------------------------------------------- if (.not. module_is_initialized ) then call error_mesg ('radiation_diag_mod', & 'module has not been initialized', FATAL ) endif !--------------------------------------------------------------------- ! if this physics window includes a point at which diagnostics are ! to be calculated, call radiag to compute and write out the desired ! column data to a data file. !--------------------------------------------------------------------- do j=js,je if (do_raddg(j)) then call radiag (is, ie, js, je, j, Atmos_input, Surface, Astro, & Rad_gases, Cldrad_props, Cld_spec, Sw_output, & Lw_output, Lw_diagnostics, Cldspace_rad) endif end do !-------------------------------------------------------------------- end subroutine radiation_diag_driver !################################################################### ! ! ! radiation_diag_end is the destructor for radiation_diag_mod. ! ! ! radiation_diag_end is the destructor for radiation_diag_mod. ! ! ! ! subroutine radiation_diag_end !-------------------------------------------------------------------- ! radiation_diag_end is the destructor for radiation_diag_mod. !-------------------------------------------------------------------- deallocate ( do_raddg ) if (num_pts > 0 ) then !-------------------------------------------------------------------- ! close the radiation_diag.out file. !-------------------------------------------------------------------- call close_file (radiag_unit) !-------------------------------------------------------------------- ! deallocate module arrays. !-------------------------------------------------------------------- deallocate ( deglon1, deglat1, jradprt, iradprt, & bdlocm, bdhicm, iband, bandlo, bandhi ) endif !-------------------------------------------------------------------- module_is_initialized = .false. !--------------------------------------------------------------------- end subroutine radiation_diag_end !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! ! PRIVATE SUBROUTINES ! ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !##################################################################### ! ! ! radiag calculates and outputs radiation diagnostics in user- ! specified columns. ! ! ! radiag calculates and outputs radiation diagnostics in user- ! specified columns. ! ! ! ! starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! ! ! the current physics-window j index, which contains ! a radiation diagnostics column ! ! ! atmos_input_type variable containing the atmospheric ! input fields needed by the radiation package ! ! ! Surface boundary condition to radiation package ! ! ! astronomy_type variable containing the astronomical ! input fields needed by the radiation package ! ! ! radiative_gases_type variable containing the radi- ! ative gas input fields needed by the radiation ! package ! ! ! cldrad_prperties_type variable containing the cloud radiative ! property input fields needed by the radiation package ! ! ! cld_specification_type variable containing ! cloud information relevant to the radiation package ! ! ! sw_output_type variable containing shortwave ! radiation output data ! ! ! lw_output_type variable containing longwave ! radiation output data ! ! ! lw_diagnostics_type variable containing diagnostic ! longwave output used by the radiation diagnostics ! module ! ! ! cld_space_properties_type variable containing infor- ! mation on cloud properties seen by the radiation ! package in cloud-space coordinates ! ! ! subroutine radiag (is, ie, js, je, jrow, Atmos_input, Surface, Astro, & Rad_gases, Cldrad_props, Cld_spec, Sw_output, & Lw_output, Lw_diagnostics, Cldspace_rad) !-------------------------------------------------------------------- ! radiag calculates and outputs radiation diagnostics in user- ! specified columns. !-------------------------------------------------------------------- integer, intent(in) :: is, ie, js, je, jrow type(atmos_input_type), intent(in) :: Atmos_input type(surface_type), intent(in) :: Surface type(astronomy_type), intent(in) :: Astro type(radiative_gases_type), intent(in) :: Rad_gases type(cldrad_properties_type), intent(in) :: Cldrad_props type(cld_specification_type), intent(in) :: Cld_spec type(sw_output_type), dimension(:), intent(in) :: Sw_output type(lw_output_type), dimension(:), intent(in) :: Lw_output type(lw_diagnostics_type), intent(in) :: Lw_diagnostics type(cld_space_properties_type), intent(in) :: Cldspace_rad !-------------------------------------------------------------------- ! intent(in) variables: ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! jrow the current physics-window j index, which contains ! a radiation diagnostics column ! Atmos_input atmos_input_type variable containing the atmospheric ! input fields needed by the radiation package ! Surface surface_type variable containing surface variables ! needed by the radiation package ! Astro astronomy_type variable containing the astronomical ! input fields needed by the radiation package ! Rad_gases radiative_gases_type variable containing the radi- ! ative gas input fields needed by the radiation ! package ! Cldrad_props cldrad_properties_type variable containing the ! cloud radiative property input fields needed by the ! radiation package ! Cld_spec cld_specification_type variable containing the ! cloud specification input fields needed by the ! radiation package ! Sw_output sw_output_type variable containing shortwave ! radiation output data ! Lw_output lw_output_type variable containing longwave ! radiation output data ! Lw_diagnostics ! lw_diagnostics_type variable containing diagnostic ! longwave output used by the radiation diagnostics ! module ! Cldspace_rad cld_space_properties_type variable containing infor- ! mation on cloud properties seen by the radiation ! package in cloud-space coordinates ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: type(lw_output_type) :: Lw_output_ad type(sw_output_type) :: Sw_output_ad !--------------------------------------------------------------------- ! these variables are dimensioned by the number of layers in the ! grid: ! ! cts approximate cool-to-space heating rates for 160-560 ! and 800-990, 1070-1200 cm-1 ranges. (h2o bands) ! [ degrees K /day ] ! ctsco2 approximate cool-to-space heating rates for 560-800 ! cm-1 range. (15 micron co2 band) ! [ degrees K /day ] ! ctso3 approximate cool-to-space heating rates for 990-1070 ! cm-1 range. (9.6 micron o3 band) ! [ degrees K /day ] ! ctst approximate cool-to-space heating rates for 160-1200 ! cm-1 range (sum of above 3 variables). ! [ degrees K /day ] ! hlwsw total radiation heating rates. ! [ degrees K /day ] ! hlwswcf total radiation heating rates in the absence of clouds. ! [ degrees K /day ] ! convert factor to convert flux difference (cgs units) to ! heating rate in degrees/day. ! [ (degrees K * sec**3) / ( grams * day) ] ! cmxolw amount of maximally overlapped longwave cloud. ! [ dimensionless ] ! crndlw amount of randomly overlapped longwave cloud. ! [ dimensionless ] ! camtsw shortwave cloud amount. ! [ dimensionless ] ! htem emissivity heating rate, summed over bands 0 - 160, ! 560 - 2200 cm-1. ! [ degrees K /day ] ! htem1 emissivity heating rate for 0-160, 1200-2200 cm-1 band, ! when ch4, n2o are not active, emissivity heating rate ! for 0-160, 1400-2200 cm-1 band when ch4, n2o are ! active. ! [ degrees K /day ] ! htem2 emissivity heating rate for 560-800 cm-1 band. ! [ degrees K /day ] ! htem3 emissivity heating rate for 800-900 cm-1 band ! [ degrees K /day ] ! htem4 emissivity heating rate for 900-990 cm-1 band ! [ degrees K /day ] ! htem5 emissivity heating rate for 990-1070 cm-1 band. ! [ degrees K /day ] ! htem6 emissivity heating rate for 1070-1200 cm-1 band ! [ degrees K /day ] ! htem7t emissivity heating rate over 1200-1400 cm-1 band ! [ degrees K /day ] ! !--------------------------------------------------------------------- real, dimension (size(Atmos_input%press,3) - 1 ) :: & cts, ctsco2, ctso3, ctst, & hlwsw, hlwswcf, convert, & cmxolw, crndlw, camtsw, & htem, htem1, htem2, htem3, & htem4, htem5, htem6, htem7t !--------------------------------------------------------------------- ! these variables are dimensioned by the number of flux levels ! (number of layers + 1): ! ! flx1 net emissivity flux for 0-160, 1200-2200 cm-1 band ! when ch4, n2o not active, net emissivity flux for ! 0-160, 1400-2200 cm-1 band when ch4, n2o are active. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx2 flux for 560-800 cm-1 band (as one band). ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx3 flux for 800-900 cm-1 band. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx4 flux for 900-990 cm-1 band. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx5 flux for 990-1070 cm-1 band. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx6 flux for 1070-1200 cm-1 band. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx1cf same as flx1, but for cloud-free conditions. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx2cf same as flx2, but for cloud-free conditions. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx3cf same as flx3, but for cloud-free conditions. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx4cf same as flx4, but for cloud-free conditions. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx5cf same as flx5, but for cloud-free conditions. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx6cf same as flx6, but for cloud-free conditions. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! press pressure at data levels of model. ! [ pascals ] ! pflux pressure at flux levels of model. ! [ pascals ] ! flwsw sum of net lw and sw fluxes. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flxem sum of emissivity fluxes over bands 0 - 160, ! 560 - 2200 cm-1. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flxemch4n2o ! sum of emissivity fluxes over the nbtrge bands in the ! 1200 - 1400 cm-1 band. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flwswcf sum of net lw and sw fluxes in the absence of clouds. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! !---------------------------------------------------------------------- real, dimension (size(Atmos_input%press,3) ) :: & flx1, flx2, flx3, flx4, flx5, & flx6, flx1cf, flx2cf, flx3cf, & flx4cf, flx5cf, flx6cf, & press, pflux, flwsw, flxem, & flxemch4n2o, flwswcf !--------------------------------------------------------------------- ! these variables are dimensioned by the number of flux levels ! and the number of bands in the 1200 - 1400 cm-1 range when ch4 ! and n2o are radiatively active gases. ! flx7 when ch4, n2o are active, flux for 1200-1400 cm-1 ! band (nbtrge bands). ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! flx7cf same as flx7, but for cloud-free conditions. ! [ ergs / (cm**2 sec), or gram / sec**3 ] ! !--------------------------------------------------------------------- real, dimension (size(Atmos_input%press,3), & size (Lw_diagnostics%flx1e1f,3) ) :: flx7, flx7cf !--------------------------------------------------------------------- ! this variable is dimensioned by the number of model layers ! and the number of bands in the 1200 - 1400 cm-1 range when ch4 ! and n2o are radiatively active gases. ! htem7 emissivity heating rate for each of the nbtrge bands ! in the 1200-1400 cm-1 band ! [ degrees K /day ] ! !--------------------------------------------------------------------- real, dimension (size(Atmos_input%press,3)-1, & size (Lw_diagnostics%flx1e1f,3)) :: htem7 !--------------------------------------------------------------------- ! this variable is dimensioned by the number of model layers ! and the number of frequency bands used in the exact cool-to-space ! calculation. ! exctsn exact cool-to-space heating rates for each band. ! [ degrees K /day ] !--------------------------------------------------------------------- real, dimension (size(Atmos_input%press,3)-1, nbly) :: exctsn !--------------------------------------------------------------------- ! these variables are dimensioned by the number of frequency bands ! used in the exact cool-to-space calculation. ! ftopn total cool to space flux at toa for each of the nbly ! bands ! [ Watts / m**2 , or kg / sec**3 ] ! ftopac total cool to space flux at toa summed between band 1 ! and band n ! [ Watts / m**2 , or kg / sec**3 ] ! vsumac cool-to-space flux at the ground summed between bands ! 1 and n. ! [ Watts / m**2 , or kg / sec**3 ] !--------------------------------------------------------------------- real, dimension (nbly) :: ftopac, ftopn, vsumac !--------------------------------------------------------------------- ! various scalar variables: !--------------------------------------------------------------------- integer :: ncldsw ! number of clouds at each grid point. ! [ dimensionless ] integer :: nrndlw ! number of randomly overlapped longwave ! clouds at each grid point. ! [ dimensionless ] integer :: nmxolw ! number of maximally overlapped longwave ! clouds at each grid point. ! [ dimensionless ] real :: fdiff ! difference in fluxes (toa - grd) ! [ Watts / m**2 , or kg / sec**3 ] real :: qsum ! sum of cool-to-space fluxes through the ! column in a given band ! [ Watts / m**2 , or kg / sec**3 ] real :: ftopeft ! flux at toa summed over nbtrge bands in ! 1200- 1400 cm-1 range. ! [ Watts / m**2 , or kg / sec**3 ] real :: cldext ! exp (-cldext) = cloud sw extinction ! [ dimensionless ] real :: cldssalb ! cloud single-scattering albedo ! [ dimensionless ] real :: cvisrfgd_dir ! visible direct beam sfc albedo ! [ dimensionless ] real :: cvisrfgd_dif ! visible diffuse beam sfc albedo ! [ dimensionless ] real :: cirrfgd_dir ! infrared direct beam sfc albedo ! [ dimensionless ] real :: cirrfgd_dif ! infrared diffuse beam sfc albedo ! [ dimensionless ] real :: dfsw_nir, dfsw_nir_dir, dfsw_nir_dif ! real :: ufsw_nir, ufsw_nir_dir, ufsw_nir_dif real :: ufsw_nir, ufsw_nir_dif integer :: ks=1 ! index of top level of radiation grid integer :: ke ! index of lowest radiation grid level integer :: nlwcldb ! number of lw cloud bands integer :: nbtrge ! number of h2o bands in the 1200-1400 ! cm-1 range integer :: iloc ! physics window x coordinate of ! diagnostics column integer :: jloc ! physics window y coordinate of ! diagnostics column !--------------------------------------------------------------------- ! miscellaneous indices !--------------------------------------------------------------------- integer :: kc, nprt, ny, nx, k, nn, m, n integer :: nz if (Rad_control%do_swaerosol_forcing) then Sw_output_ad = Sw_output(Rad_control%indx_swaf) endif if (Rad_control%do_lwaerosol_forcing) then Lw_output_ad = Lw_output(Rad_control%indx_lwaf) endif !--------------------------------------------------------------------- ! define the vertical grid dimension and the number of h2o bands in ! the 1200 - 1400 cm-1 range. !--------------------------------------------------------------------- ke = size (Atmos_input%press,3) - 1 nbtrge = size (Lw_diagnostics%flx1e1f,3) !-------------------------------------------------------------------- ! check for the diagnostic point(s) in the current jrow. define the ! physics window coordinates for those points and process the ! radiation diagnostic data. !--------------------------------------------------------------------- do nn=1,num_pts if (jrow == jradprt(nn)) then if ( (iradprt(nn) >= is) .and. (iradprt(nn) <= ie) ) then iloc = iradprt(nn) - is + 1 jloc = jradprt(nn) - js + 1 !--------------------------------------------------------------------- ! write out the latitude and longitude of the model point for which ! diagnostics will be produced. !--------------------------------------------------------------------- write (radiag_unit,99000) deglon1(nn), deglat1(nn) !---------------------------------------------------------------------- ! write longwave cloud data. determine if any clouds are present ! in the column. if there are, define the number of lw cloud bands. !---------------------------------------------------------------------- write (radiag_unit,9009) nmxolw = Cld_spec%nmxolw(iloc, jloc) nrndlw = Cld_spec%nrndlw(iloc, jloc) if (nmxolw > 0 .OR. nrndlw > 0) then write (radiag_unit,9010) nmxolw, nrndlw nlwcldb = size (Cldrad_props%emmxolw,4) !---------------------------------------------------------------------- ! write longwave cloud amounts and emissivities for each cloud band. ! %emmxolw = lw cloud emissivity for maximally overlapped clouds. ! [ dimensionless ] ! %emrndlw = lw cloud emissivity for randomly overlapped clouds. ! [ dimensionless ] !---------------------------------------------------------------------- do n=1,nlwcldb write (radiag_unit,9041) n do k = ks,ke cmxolw(k) = Cld_spec%cmxolw(iloc, jloc, k) crndlw(k) = Cld_spec%crndlw(iloc, jloc, k) if (cmxolw(k) > 0.0 .or. crndlw(k) > 0.0) then write (radiag_unit,9030) k, & cmxolw(k), Cldrad_props%emmxolw(iloc,jloc,k,n,1),& crndlw(k), Cldrad_props%emrndlw(iloc,jloc,k,n,1) endif end do end do !-------------------------------------------------------------------- ! if no clouds are present, write a message. !-------------------------------------------------------------------- else write (radiag_unit, 9052) endif !---------------------------------------------------------------------- ! define the number of shortwave clouds. !---------------------------------------------------------------------- ncldsw = Cld_spec%ncldsw(iloc, jloc) write (radiag_unit, 9018) write (radiag_unit, 9019) ncldsw !---------------------------------------------------------------------- ! if clouds exist, write shortwave cloud data. !---------------------------------------------------------------------- if (ncldsw /= 0) then !--------------------------------------------------------------------- ! write out the relevant cloud-radiation variables for the lacis- ! hansen parameterization from the data in Cldspace_rad: ! %camtswkc shortwave cloud amounts. their locations are specified ! in the ktopsw/kbtmsw indices. ! [ dimensionless ] ! %cvisrfswkc reflectivity of clouds in the visible frequency band. ! [ dimensionless ] ! %cirabswkc absorptivity of clouds in the infrared frequency band. ! [ dimensionless ] ! %cirrfswkc reflectivity of clouds in the infrared frequency band. ! [ dimensionless ] ! %kbtmswkc index of flux level pressure of cloud bottom. ! %ktopswkc index of flux level pressure of cloud top. !--------------------------------------------------------------------- if (Sw_control%do_lhsw) then write (radiag_unit,9035) write (radiag_unit,9036) (kc, & Cldspace_rad%camtswkc (iloc, jloc,kc), & Cldspace_rad%ktopswkc (iloc,jloc,kc), & Cldspace_rad%kbtmswkc (iloc,jloc,kc) , & Cldspace_rad%cvisrfswkc(iloc,jloc,kc),& Cldspace_rad%cirrfswkc (iloc,jloc,kc), & Cldspace_rad%cirabswkc (iloc,jloc,kc),& kc=ncldsw,1,-1) !--------------------------------------------------------------------- ! write out the relevant cloud-radiation variables for the expo- ! nential-sum-fit parameterization from the data in Cldspace_rad: !--------------------------------------------------------------------- else if (Sw_control%do_esfsw) then !--------------------------------------------------------------------- ! for each shortwave cloud band, define an exinction factor, ! single-scattering albedo and asymmetry factor and write them ! out along with the cloud amount. use the contents of Cldrad_props, ! Cld_spec and Atmos_input for these calculations: ! %cldext cloud extinction coefficient [ km -1 ] ! %cldsct cloud scattering coefficient [ dimensionless ] ! %cldsasymm cloud asymmetry factor [ dimensionless ] ! %deltaz model vertical grid interval [ meters ] !--------------------------------------------------------------------- do n=1,size(Cldrad_props%cldext,4) write (radiag_unit,9040) n do k=ks,ke if (Cld_spec%camtsw(iloc,jloc,k) > 0.0) then cldext = Cldrad_props%cldext(iloc,jloc,k,n,1)* & Atmos_input%clouddeltaz(iloc,jloc,k)* & 1.0E-03 if (cldext > 0.0) then cldssalb = Cldrad_props%cldsct(iloc,jloc,k,n,1)/ & Cldrad_props%cldext(iloc,jloc,k,n,1) else cldssalb = 0.0 endif write (radiag_unit,9050) k, & Cld_spec%camtsw (iloc,jloc,k), & cldext, cldssalb, & Cldrad_props%cldasymm(iloc,jloc,k,n,1) endif end do end do !---------------------------------------------------------------------- ! if no shortwave scheme has been specified, abort. !---------------------------------------------------------------------- else call error_mesg ('radiation_diag_mod', & 'no shortwave clouds are activated', FATAL) endif !---------------------------------------------------------------------- ! if no clouds are present in the column, write out a message. !---------------------------------------------------------------------- else write (radiag_unit, 9053) endif !-------------------------------------------------------------------- ! if microphysics has been activated, write microphysical parameters ! at those levels where cloud is present. use variables found in ! Cld_spec. ! %lwp liquid water path [ kg / m**2 ] ! %iwp ice water path [ kg / m**2 ] ! %reff_liq_micro effective cloud drop size [ microns ] ! %reff_ice_micro effective ice crystal size [ microns ] !---------------------------------------------------------------------- if (ncldsw /= 0) then if (Lw_control%do_lwcldemiss .or. & Sw_control%do_esfsw) then write (radiag_unit, 9510) do k=ks,ke if (cmxolw(k) > 0.0 .or. crndlw(k) > 0.0) then write (radiag_unit, 9520) k, & 1.0e03*Cld_spec%lwp (iloc,jloc,k), & 1.0e03*Cld_spec%iwp (iloc,jloc,k), & Cld_spec%reff_liq_micro(iloc,jloc,k), & Cld_spec%reff_ice_micro(iloc,jloc,k) endif end do endif endif !-------------------------------------------------------------------- ! write out the visible and infrared reflectivities at the ground. ! currently these are both given the same value (Surface%asfc), ! but could be different in the future. !-------------------------------------------------------------------- ! cvisrfgd = Surface%asfc(iloc,jloc) ! cirrfgd = Surface%asfc(iloc,jloc) cvisrfgd_dir = Surface%asfc_vis_dir(iloc,jloc) cirrfgd_dir = Surface%asfc_nir_dir(iloc,jloc) cvisrfgd_dif = Surface%asfc_vis_dif(iloc,jloc) cirrfgd_dif = Surface%asfc_nir_dif(iloc,jloc) write (radiag_unit,9059) ! write (radiag_unit,9060) cvisrfgd, cirrfgd write (radiag_unit,9060) cvisrfgd_dir, cirrfgd_dir, & cvisrfgd_dif, cirrfgd_dif !---------------------------------------------------------------------- ! write out the amounts of the radiative gases that the radiation ! code sees. !-------------------------------------------------------------------- write (radiag_unit,9069) write (radiag_unit,9070) Rad_gases%rrvco2 write (radiag_unit,9071) Rad_gases%rrvf11 write (radiag_unit,9072) Rad_gases%rrvf12 write (radiag_unit,9075) Rad_gases%rrvf113 write (radiag_unit,9076) Rad_gases%rrvf22 write (radiag_unit,9073) Rad_gases%rrvch4 write (radiag_unit,9074) Rad_gases%rrvn2o !--------------------------------------------------------------------- ! define the shortwave parameterization being employed. define the ! assumption used to specify the solar zenith angle. !--------------------------------------------------------------------- write (radiag_unit, 9079) if (Sw_control%do_diurnal) then write (radiag_unit,99020) else if (Sw_control%do_annual) then write (radiag_unit,99025) else if (Sw_control%do_daily_mean) then write (radiag_unit,99030) else ! (if all 3 are false) write (radiag_unit,99040) endif !---------------------------------------------------------------------- ! write out the astronomical data used for this shortwave ! calculation. use the contents in Astro: ! %fracday fraction of averaging period that has daylight. ! [ dimensionless ] ! %cosz mean cosine of zenith angle for all longitudes. ! [ dimensionless ] ! %solar_constant solar flux at toa at mean earth-sun radius. ! [ Watts / m**2 , or kg / sec**3 ] ! %rrsun earth-sun distance relative to mean distance ! [ dimensionless ] !---------------------------------------------------------------------- write (radiag_unit,9080) & Sw_control%solar_constant*Astro%rrsun, & Astro%cosz(iloc,jloc), & Astro%fracday(iloc,jloc) if (Rad_control%hires_coszen) then write (radiag_unit, 9081) do nz = 1,Rad_control%nzens write (radiag_unit, 9082) nz write (radiag_unit,9080) & Sw_control%solar_constant*Astro%rrsun, & Astro%cosz_p(iloc,jloc,nz), & Astro%fracday_p(iloc,jloc,nz) end do endif !---------------------------------------------------------------------- ! write out atmospheric input data and longwave fluxes and heating ! rates. Use atmospheric fields from Atmos_input and Rad_gases and ! longwave data from Lw_output: ! %rh2o mass mixing ratio of h2o at model data levels. ! [ dimensionless ] ! %qo3 mass mixing ratio of o3 at model data levels. ! [ dimensionless ] ! %temp temperature at data levels of model. ! [ degrees K ] ! %heatra lw heating rate. ! [ degrees K / day ] ! %flxnet net longwave flux at model flux levels (including the ! ground and the top of the atmosphere). ! [ Watts / m**2 , or kg / sec**3 ] !---------------------------------------------------------------------- !---------------------------------------------------------------------- ! define the pressures at model and flux levels. !---------------------------------------------------------------------- do k=ks,ke+1 pflux(k) = Atmos_input%pflux(iloc,jloc,k) press(k) = Atmos_input%press(iloc,jloc,k) end do write(radiag_unit,9090) write(radiag_unit,9100) write(radiag_unit,9110) (k, press (k), & Atmos_input%temp (iloc,jloc,k),& Atmos_input%rh2o (iloc,jloc,k), & Rad_gases%qo3 (iloc,jloc,k),& Lw_output(1)%heatra (iloc,jloc,k), & Lw_output(1)%flxnet (iloc,jloc,k), & pflux (k), k=ks,ke) write(radiag_unit,9120) press (ke+1), & Atmos_input%temp (iloc,jloc,ke+1), & Lw_output(1)%flxnet (iloc,jloc,ke+1), & pflux (ke+1) !---------------------------------------------------------------------- ! write out shortwave fluxes and heating rates. use the data in ! Sw_output: ! %dfsw downward short-wave radiation ! [ Watts / m**2 , or kg / sec**3 ] ! %fsw net radiation (up-down) ! [ Watts / m**2 , or kg / sec**3 ] ! %ufsw upward short-wave radiation. ! [ Watts / m**2 , or kg / sec**3 ] ! %hsw sw radiation heating rates. ! [ degrees K / day ] !---------------------------------------------------------------------- write (radiag_unit,9130) if (Sw_control%do_esfsw) then write (radiag_unit, 99016) else if (Sw_control%do_lhsw) then write (radiag_unit, 99018) endif do nz=1,Rad_control%nzens write (radiag_unit, 9082) nz write (radiag_unit,9140) write (radiag_unit,9150) (k, press(k), & Sw_output(1)%hsw (iloc,jloc,k,nz), & Sw_output(1)%fsw (iloc,jloc,k,nz), & Sw_output(1)%dfsw (iloc,jloc,k,nz), & Sw_output(1)%ufsw (iloc,jloc,k,nz),& pflux (k), k=ks,ke) write (radiag_unit,6556) press(ke+1), & Sw_output(1)%fsw (iloc,jloc,ke+1,nz), & Sw_output(1)%dfsw (iloc,jloc,ke+1,nz), & Sw_output(1)%ufsw (iloc,jloc,ke+1,nz), & pflux (ke+1) if (Sw_control%do_esfsw) then dfsw_nir = Sw_output(1)%dfsw(iloc,jloc,ke+1,nz) - & Sw_output(1)%dfsw_vis_sfc(iloc,jloc,nz) dfsw_nir_dir = Sw_output(1)%dfsw_dir_sfc(iloc,jloc,nz) - & Sw_output(1)%dfsw_vis_sfc_dir(iloc,jloc,nz) dfsw_nir_dif = Sw_output(1)%dfsw_dif_sfc(iloc,jloc,nz) - & Sw_output(1)%dfsw_vis_sfc_dif(iloc,jloc,nz) ufsw_nir = Sw_output(1)%ufsw(iloc,jloc,ke+1,nz) - & Sw_output(1)%ufsw_vis_sfc(iloc,jloc,nz) ufsw_nir_dif = Sw_output(1)%ufsw_dif_sfc(iloc,jloc,nz) - & Sw_output(1)%ufsw_vis_sfc_dif(iloc,jloc,nz) write (radiag_unit, 99026) & Sw_output(1)%dfsw_vis_sfc(iloc,jloc,nz), & Sw_output(1)%ufsw_vis_sfc(iloc,jloc,nz), & Sw_output(1)%dfsw_vis_sfc_dir(iloc,jloc,nz), & Sw_output(1)%dfsw_vis_sfc_dif(iloc,jloc,nz), & Sw_output(1)%ufsw_vis_sfc_dif(iloc,jloc,nz), & dfsw_nir, ufsw_nir, & dfsw_nir_dir, & dfsw_nir_dif, ufsw_nir_dif endif !---------------------------------------------------------------------- ! compute and write out total radiative heating and total fluxes ! (lw + sw, up-down). !---------------------------------------------------------------------- do k=ks,ke+1 flwsw(k) = Lw_output(1)%flxnet (iloc,jloc,k) + & Sw_output(1)%fsw (iloc,jloc,k,nz) end do do k=ks,ke hlwsw(k) = Sw_output(1)%hsw (iloc,jloc,k,nz) + & Lw_output(1)%heatra (iloc,jloc,k) end do write (radiag_unit,9160) write (radiag_unit,9170) write (radiag_unit,9190) (k, press(k), & hlwsw(k), flwsw(k), & pflux(k), k=ks,ke) write (radiag_unit,9180) press(ke+1), flwsw(ke+1), & pflux(ke+1) end do if (Rad_control%do_totcld_forcing) then !---------------------------------------------------------------------- ! write out atmospheric input data and longwave fluxes and heating ! rates for the cloud-free case. use the following data from ! Lw_output: ! %heatracf lw heating rate in the absence of clouds. ! [ degrees K / day ] ! %flxnetcf net longwave flux at model flux levels (including the ! ground and the top of the atmosphere) in the absence of ! cloud. ! [ Watts / m**2 , or kg / sec**3 ] !---------------------------------------------------------------------- write (radiag_unit,9400) write (radiag_unit,9100) write (radiag_unit,9110) (k, press (k), & Atmos_input%temp (iloc,jloc,k), & Atmos_input%rh2o (iloc,jloc,k), & Rad_gases%qo3 (iloc,jloc,k), & Lw_output(1)%heatracf(iloc,jloc,k), & Lw_output(1)%flxnetcf(iloc,jloc,k), & pflux (k), k=ks,ke) write (radiag_unit,9120) press (ke+1), & Atmos_input%temp (iloc,jloc,ke+1),& Lw_output(1)%flxnetcf(iloc,jloc,ke+1),& pflux(ke+1) !---------------------------------------------------------------------- ! write out shortwave fluxes and heating rates for the cloud-free ! case. use the data in Sw_output: ! %dfswcf downward short-wave radiation in absence of clouds ! [ Watts / m**2 , or kg / sec**3 ] ! %fswcf net radiation (up-down) in absence of clouds ! [ Watts / m**2 , or kg / sec**3 ] ! %ufswcf upward short-wave radiation in absence of clouds ! [ Watts / m**2 , or kg / sec**3 ] ! %hswcf sw radiation heating rates in the absence of clouds. ! [ degrees K / day ] !---------------------------------------------------------------------- write (radiag_unit,9410) do nz=1,Rad_control%nzens write (radiag_unit, 9082) nz write (radiag_unit,9140) write (radiag_unit,9150) (k, press(k), & Sw_output(1)%hswcf (iloc,jloc,k,nz), & Sw_output(1)%fswcf (iloc,jloc,k,nz), & Sw_output(1)%dfswcf(iloc,jloc,k,nz),& Sw_output(1)%ufswcf(iloc,jloc,k,nz), & pflux(k), k=ks,ke) write (radiag_unit,6556) & press(ke+1), & Sw_output(1)%fswcf(iloc,jloc,ke+1,nz),& Sw_output(1)%dfswcf(iloc,jloc,ke+1,nz), & Sw_output(1)%ufswcf(iloc,jloc,ke+1,nz), & pflux(ke+1) !---------------------------------------------------------------------- ! compute and write out total radiative heating and total fluxes ! (lw + sw, up-down) for the cloud-free case !---------------------------------------------------------------------- do k=ks,ke+1 flwswcf(k) = Lw_output(1)%flxnetcf(iloc,jloc,k) + & Sw_output(1)%fswcf (iloc,jloc,k,nz) end do do k=ks,ke hlwswcf(k) = Sw_output(1)%hswcf (iloc,jloc,k,nz) + & Lw_output(1)%heatracf(iloc,jloc,k) end do write (radiag_unit,9420) write (radiag_unit,9170) write (radiag_unit,9190) (k, press(k), hlwswcf(k), & flwswcf(k), pflux(k), k=ks,ke) write (radiag_unit,9180) press(ke+1), flwswcf(ke+1), & pflux(ke+1) end do endif if (Rad_control%do_lwaerosol_forcing) then !---------------------------------------------------------------------- ! write out atmospheric input data and longwave fluxes and heating ! rates for the aerosol forcing case. use the following data from ! Lw_output_ad: ! %heatra lw heating rate. ! [ degrees K / day ] ! %flxnet net longwave flux at model flux levels (including the ! ground and the top of the atmosphere. ! [ Watts / m**2 , or kg / sec**3 ] ! %heatracf lw heating rate in the absence of clouds. ! [ degrees K / day ] ! %flxnetcf net longwave flux at model flux levels (including the ! ground and the top of the atmosphere) in the absence of ! cloud. ! [ Watts / m**2 , or kg / sec**3 ] !---------------------------------------------------------------------- if (Lw_control%do_lwaerosol) then ! climate includes aerosol effects, lw aerosol forcing by exclusion write (radiag_unit,9603) else ! climate includes no aerosol effects, lw aerosol forcing by inclusion write (radiag_unit,9601) endif write (radiag_unit,9100) write (radiag_unit,9110) (k, press (k), & Atmos_input%temp (iloc,jloc,k), & Atmos_input%rh2o (iloc,jloc,k), & Rad_gases%qo3 (iloc,jloc,k), & Lw_output_ad%heatra(iloc,jloc,k), & Lw_output_ad%flxnet(iloc,jloc,k), & pflux (k), k=ks,ke) write (radiag_unit,9120) press (ke+1), & Atmos_input%temp (iloc,jloc,ke+1),& Lw_output_ad%flxnet(iloc,jloc,ke+1),& pflux(ke+1) ! clear-sky results if (Lw_control%do_lwaerosol) then ! climate includes aerosol effects, lw aerosol forcing by exclusion write (radiag_unit,9604) else ! climate includes no aerosol effects, lw aerosol forcing by inclusion write (radiag_unit,9602) endif write (radiag_unit,9100) write (radiag_unit,9110) (k, press (k), & Atmos_input%temp (iloc,jloc,k), & Atmos_input%rh2o (iloc,jloc,k), & Rad_gases%qo3 (iloc,jloc,k), & Lw_output_ad%heatracf(iloc,jloc,k), & Lw_output_ad%flxnetcf(iloc,jloc,k), & pflux (k), k=ks,ke) write (radiag_unit,9120) press (ke+1), & Atmos_input%temp (iloc,jloc,ke+1),& Lw_output_ad%flxnetcf(iloc,jloc,ke+1),& pflux(ke+1) endif if (Rad_control%do_swaerosol_forcing) then !---------------------------------------------------------------------- ! write out atmospheric input data and shortwave fluxes and heating ! rates for the aerosol forcing case. use the following data from ! Sw_output_ad: ! %dfsw downward short-wave radiation ! [ Watts / m**2 , or kg / sec**3 ] ! %fsw net radiation (up-down) ! [ Watts / m**2 , or kg / sec**3 ] ! %ufsw upward short-wave radiation ! [ Watts / m**2 , or kg / sec**3 ] ! %hsw sw radiation heating rates ! [ degrees K / day ] ! %dfswcf downward short-wave radiation in absence of clouds ! [ Watts / m**2 , or kg / sec**3 ] ! %fswcf net radiation (up-down) in absence of clouds ! [ Watts / m**2 , or kg / sec**3 ] ! %ufswcf upward short-wave radiation in absence of clouds ! [ Watts / m**2 , or kg / sec**3 ] ! %hswcf sw radiation heating rates in the absence of clouds. ! [ degrees K / day ] !---------------------------------------------------------------------- if (Sw_control%do_swaerosol) then ! climate includes aerosol effects, sw aerosol forcing by exclusion write (radiag_unit,9703) else ! climate includes no aerosol effects, sw aerosol forcing by inclusion write (radiag_unit,9701) endif write (radiag_unit,9140) do nz = 1, Rad_control%nzens write (radiag_unit,9150) (k, press(k), & Sw_output_ad%hsw (iloc,jloc,k,nz), & Sw_output_ad%fsw (iloc,jloc,k,nz), & Sw_output_ad%dfsw(iloc,jloc,k,nz),& Sw_output_ad%ufsw(iloc,jloc,k,nz), & pflux(k), k=ks,ke) write (radiag_unit,6556) & press(ke+1), & Sw_output_ad%fsw(iloc,jloc,ke+1,nz),& Sw_output_ad%dfsw(iloc,jloc,ke+1,nz), & Sw_output_ad%ufsw(iloc,jloc,ke+1,nz), & pflux(ke+1) ! clear-sky results if (Sw_control%do_swaerosol) then ! climate includes aerosol effects, sw aerosol forcing by exclusion write (radiag_unit,9704) else ! climate includes no aerosol effects, sw aerosol forcing by inclusion write (radiag_unit,9702) endif write (radiag_unit,9140) write (radiag_unit,9150) (k, press(k), & Sw_output_ad%hswcf (iloc,jloc,k,nz), & Sw_output_ad%fswcf (iloc,jloc,k,nz), & Sw_output_ad%dfswcf(iloc,jloc,k,nz),& Sw_output_ad%ufswcf(iloc,jloc,k,nz), & pflux(k), k=ks,ke) write (radiag_unit,6556) & press(ke+1), & Sw_output_ad%fswcf(iloc,jloc,ke+1,nz),& Sw_output_ad%dfswcf(iloc,jloc,ke+1,nz), & Sw_output_ad%ufswcf(iloc,jloc,ke+1,nz), & pflux(ke+1) end do endif if (Rad_control%do_lwaerosol_forcing .and. & Rad_control%do_swaerosol_forcing) then do nz=1,Rad_control%nzens !---------------------------------------------------------------------- ! compute and write out total radiative heating and total fluxes ! (lw + sw, up-down) for the total-sky and cloud-free case ! with lw and sw aerosol forcing !---------------------------------------------------------------------- do k=ks,ke+1 flwsw(k) = Lw_output_ad%flxnet(iloc,jloc,k) + & Sw_output_ad%fsw (iloc,jloc,k,nz) flwswcf(k) = Lw_output_ad%flxnetcf(iloc,jloc,k) + & Sw_output_ad%fswcf (iloc,jloc,k,nz) end do do k=ks,ke hlwsw(k) = Sw_output_ad%hsw (iloc,jloc,k,nz) + & Lw_output_ad%heatra(iloc,jloc,k) hlwswcf(k) = Sw_output_ad%hswcf (iloc,jloc,k,nz) + & Lw_output_ad%heatracf(iloc,jloc,k) end do write (radiag_unit,9801) write (radiag_unit,9170) write (radiag_unit,9190) (k, press(k), & hlwsw(k), flwsw(k), & pflux(k), k=ks,ke) write (radiag_unit,9180) press(ke+1), flwsw(ke+1), & pflux(ke+1) write (radiag_unit,9802) write (radiag_unit,9170) write (radiag_unit,9190) (k, press(k), hlwswcf(k), & flwswcf(k), pflux(k), k=ks,ke) write (radiag_unit,9180) press(ke+1), flwswcf(ke+1), & pflux(ke+1) end do endif !---------------------------------------------------------------------- ! define emissivity fluxes, both the standard and cloud-free case. ! note that Lw_diagnostics%fluxn is in cgs units (ergs/(cm**2 sec). !---------------------------------------------------------------------- do k=ks,ke+1 flx1(k) = Lw_diagnostics%fluxn(iloc,jloc,k,1) flx2(k) = Lw_diagnostics%fluxn(iloc,jloc,k,2) flx3(k) = Lw_diagnostics%fluxn(iloc,jloc,k,3) flx4(k) = Lw_diagnostics%fluxn(iloc,jloc,k,4) flx5(k) = Lw_diagnostics%fluxn(iloc,jloc,k,5) flx6(k) = Lw_diagnostics%fluxn(iloc,jloc,k,6) if (Rad_control%do_totcld_forcing) then flx1cf(k) = Lw_diagnostics%fluxncf(iloc, jloc, k,1) flx2cf(k) = Lw_diagnostics%fluxncf(iloc, jloc, k,2) flx3cf(k) = Lw_diagnostics%fluxncf(iloc, jloc, k,3) flx4cf(k) = Lw_diagnostics%fluxncf(iloc, jloc, k,4) flx5cf(k) = Lw_diagnostics%fluxncf(iloc, jloc, k,5) flx6cf(k) = Lw_diagnostics%fluxncf(iloc, jloc, k,6) endif if (nbtrge > 0) then do m=1,nbtrge if (Rad_control%do_totcld_forcing) then flx7cf(k,m) = & Lw_diagnostics%fluxncf(iloc, jloc, k,6+m) endif flx7(k,m) = Lw_diagnostics%fluxn(iloc, jloc, k,6+m) end do endif end do !-------------------------------------------------------------------- ! define the factor used to convert a flux divergence in cgs units ! to a heating rate in units of degrees per day. the 1.0e-03 ! converts the fluxes (in cgs) to mks units [ (ergs/cm^2/s) X ! 1.0e-03 ---> (J/m^2/s) ]. radcon includes the conversion to ! degrees/day from degrees/second. !--------------------------------------------------------------------- do k=ks,ke convert(k) = 1.0e-03*radcon_mks* & (1.0/(pflux(k+1) - pflux(k))) end do !---------------------------------------------------------------------- ! compute emissivity heating rates in degrees K / day. !---------------------------------------------------------------------- do k=ks,ke htem1(k) = (flx1(k+1) - flx1(k))*convert(k) htem2(k) = (flx2(k+1) - flx2(k))*convert(k) htem3(k) = (flx3(k+1) - flx3(k))*convert(k) htem4(k) = (flx4(k+1) - flx4(k))*convert(k) htem5(k) = (flx5(k+1) - flx5(k))*convert(k) htem6(k) = (flx6(k+1) - flx6(k))*convert(k) end do if (nbtrge > 0) then do m=1,nbtrge do k=ks,ke htem7(k,m) = (flx7(k+1,m) - flx7(k,m))* convert(k) end do end do !-------------------------------------------------------------------- ! define the sum of the heating rates in the 1200 - 1400 cm-1 band. !-------------------------------------------------------------------- do k=ks,ke htem7t(k) = 0.0E+00 do m=1,nbtrge htem7t(k) = htem7t(k) + htem7(k,m) end do end do endif !---------------------------------------------------------------------- ! define the emissivity heating rate summed over all frequencies. !---------------------------------------------------------------------- do k=ks,ke htem(k) = htem1(k) + htem2(k) + htem3(k) + htem4(k) + & htem5(k) + htem6(k) end do if (nbtrge > 0) then do k=ks,ke htem(k) = htem(k) + htem7t(k) enddo endif !---------------------------------------------------------------------- ! write approximate emissivity heating rates. !---------------------------------------------------------------------- if (nbtrge == 0) then write (radiag_unit,9200) write (radiag_unit,9210) (k, press(k), htem1(k), & htem2(k), htem3(k), htem4(k), & htem5(k), htem6(k), htem(k), & k=ks,ke) else if (nbtrge .EQ. 1) then write (radiag_unit,9201) write (radiag_unit,9211) (k, press(k), htem1(k), & htem2(k), htem3(k), htem4(k), & htem5(k), htem6(k), & htem7(k,1), htem(k),k=ks,ke) else if (nbtrge .EQ. 2) then write (radiag_unit,9202) write (radiag_unit,9212) (k, press(k), htem1(k), & htem2(k), htem3(k), htem4(k), & htem5(k), htem6(k), & (htem7(k,n),n=1,nbtrge), & htem7t(k), htem(k),k=ks,ke) else if (nbtrge .EQ. 4) then write (radiag_unit,9203) write (radiag_unit,9213) (k, press(k), htem1(k), & htem2(k), htem3(k), htem4(k),& htem5(k), htem6(k), & (htem7(k,n),n=1,nbtrge), & htem7t(k), htem(k),k=ks,ke) else if (nbtrge .EQ. 10) then write (radiag_unit,9201) write (radiag_unit,9211) (k, press(k), htem1(k), & htem2(k), htem3(k), htem4(k), & htem5(k), htem6(k), & htem7t(k), & htem(k),k=ks,ke) else if (nbtrge .EQ. 20) then write (radiag_unit,9201) write (radiag_unit,9211) (k, press(k), htem1(k), & htem2(k), htem3(k), htem4(k), & htem5(k), htem6(k), & htem7t(k), & htem(k),k=ks,ke) endif endif !---------------------------------------------------------------------- ! compute and write out approximate cool-to-space heating rates ! for the h2o, 15 micron co2 and 9.6 micron o3 bands individually, ! and for their sum. !---------------------------------------------------------------------- do k=ks,ke ctsco2(k) = Lw_diagnostics%cts_out(iloc,jloc,k,2) ctso3(k) = Lw_diagnostics%cts_out(iloc,jloc,k,5) cts (k) = Lw_diagnostics%cts_out(iloc,jloc,k,1) cts (k) = cts(k) + & Lw_diagnostics%cts_out(iloc,jloc,k,3) cts (k) = cts(k) + & Lw_diagnostics%cts_out(iloc,jloc,k,4) cts (k) = cts(k) + & Lw_diagnostics%cts_out(iloc,jloc,k,6) end do do k=ks,ke ctst(k) = ctso3(k) + ctsco2(k) + cts(k) end do write (radiag_unit,9220) write (radiag_unit,9230) (k, press(k), cts(k), ctsco2(k), & ctso3(k), ctst(k), k=ks,ke) !---------------------------------------------------------------------- ! write out exact cool-to-space heating rates, total and for each ! individual band. ! Lw_diagnostics%excts exact cool-to-space heating rates for ! 160-1200 cm-1 range, when using ckd2.1 ! continuum, or 560 - 1200 cm-1 range ! when using Roberts continuum. ! [ degrees K / day ] !---------------------------------------------------------------------- do n=1,nbly do k=ks,ke exctsn(k,n) = Lw_diagnostics%exctsn(iloc,jloc,k,n) end do end do write (radiag_unit,9240) write (radiag_unit,9250) (k, press(k), & Lw_diagnostics%excts(iloc,jloc,k),& (exctsn(k,n), n=1,7) , k=ks,ke) write (radiag_unit,9260) write (radiag_unit,9250) (k, press(k), & (exctsn(k,n), n=8,15) , k=ks,ke) if (nbly == 48) then write (radiag_unit,9261) write (radiag_unit,9250) (k, press(k), & (exctsn(k,n), n=16,23) , k=ks,ke) write (radiag_unit,9262) write (radiag_unit,9250) (k, press(k), & (exctsn(k,n), n=24,31) , k=ks,ke) write (radiag_unit,9263) write (radiag_unit,9250) (k, press(k), & (exctsn(k,n), n=32,39) , k=ks,ke) write (radiag_unit,9264) write (radiag_unit,9250) (k, press(k), & (exctsn(k,n), n=40,47) , k=ks,ke) endif !---------------------------------------------------------------------- ! compute net flux at each level summed over all bands. !---------------------------------------------------------------------- do k=ks,ke+1 flxem(k) = flx1(k) + flx2(k) + flx3(k) + flx4(k) + & flx5(k) + flx6(k) end do if (nbtrge > 0) then flxemch4n2o(:) = 0.0E+00 do m=1,nbtrge do k=ks,ke+1 flxemch4n2o(k) = flxemch4n2o(k) + flx7(k,m) end do end do do k=ks,ke+1 flxem(k) = flxem(k) + flxemch4n2o(k) end do endif !---------------------------------------------------------------------- ! compute sum of flux through atmosphere for each band by converting ! back the heating rates. the flux at toa is the difference ! between the surface flux and this net flux through the atmosphere. ! %fctsg cool-to-space flux at the ground for each band. ! [ Watts / m**2 , or kg / sec**3 ] !-------------------------------------------------------------------- do n=1,nbly-1 qsum = 0.0E+00 do k=ks,ke qsum = qsum + 1.0e-03*exctsn(k,n)/convert(k) end do ftopn(n) = Lw_diagnostics%fctsg(iloc,jloc,n) - qsum end do ftopn(nbly) = 0.0E+00 !---------------------------------------------------------------------- ! compute the accumulated sum over bands from band 1 to band n for ! the surface and toa fluxes. !---------------------------------------------------------------------- ftopac(1) = ftopn(1) vsumac(1) = Lw_diagnostics%fctsg(iloc,jloc,1) do n=2,nbly ftopac(n) = ftopac(n-1) + ftopn(n) vsumac(n) = vsumac(n-1) + & Lw_diagnostics%fctsg(iloc,jloc,n) end do !---------------------------------------------------------------------- ! write toa and surface fluxes and the differences between them. ! %gxcts flux at top of atmosphere for 160-1200 cm-1 range. ! [ Watts / m**2 , or kg / sec**3 ] ! %flx1e1 flux at top of atmosphere for 0-160, 1200-2200 ! cm-1 range. ! [ Watts / m**2 , or kg / sec**3 ] ! %flx1e1f flux at top of atmosphere for nbtrge bands in 1200- ! 1400 cm-1 range. ! [ Watts / m**2 , or kg / sec**3 ] !---------------------------------------------------------------------- fdiff = Lw_diagnostics%gxcts(iloc,jloc) + & Lw_diagnostics%flx1e1(iloc,jloc) - & Lw_output(1)%flxnet(iloc,jloc,ke+1) write (radiag_unit,9270) & Lw_diagnostics%gxcts(iloc,jloc), & Lw_diagnostics%flx1e1(iloc,jloc), & Lw_diagnostics%gxcts(iloc,jloc)+ & Lw_diagnostics%flx1e1(iloc,jloc),& Lw_output(1)%flxnet(iloc,jloc,ke+1), & fdiff if (nbtrge > 0) then do m=1,nbtrge write (radiag_unit,9271) m, & Lw_diagnostics%flx1e1f(iloc,jloc,m) end do ftopeft = 0.0E+00 do m=1,nbtrge ftopeft = ftopeft + & Lw_diagnostics%flx1e1f(iloc,jloc,m) end do write (radiag_unit,9272) ftopeft endif !---------------------------------------------------------------------- ! write out toa and sfc fluxes for 8 combined continuum bands between ! 160-560 cm-1 when ckd2.1 is not active, toa and sfc fluxes for 40 ! combined continuum bands when ckd2.1 is active. !---------------------------------------------------------------------- write(radiag_unit,9280) do ny=1,nbly-8 nprt = 1 do nx=1,n_continuum_bands if (iband(nx) .EQ. ny) then if (nprt .EQ. 1) then write (radiag_unit,9290) ny, & bandlo(nx+16), bandhi(nx+16), & ftopn(ny), ftopac(ny), & Lw_diagnostics%fctsg(iloc,jloc,ny), vsumac(ny) nprt = 0 else write (radiag_unit,9300) bandlo(nx+16), & bandhi(nx+16) endif endif end do end do !---------------------------------------------------------------------- ! write out toa and sfc fluxes for remaining bands. !---------------------------------------------------------------------- do ny =nbly-7, nbly write (radiag_unit,9290) ny, & bdlocm(ny), bdhicm(ny), ftopn(ny),ftopac(ny), & Lw_diagnostics%fctsg(iloc,jloc,ny), vsumac(ny) end do !---------------------------------------------------------------------- ! write out emissivity fluxes. !---------------------------------------------------------------------- write (radiag_unit,9310) if (nbtrge == 0) then write (radiag_unit,9320) write (radiag_unit,9330) (k, flx1(k),flx2(k), flx3(k), & flx4(k), flx5(k), flx6(k), & flxem(k), k=ks,ke+1) else if (nbtrge .EQ. 1) then write (radiag_unit,9321) write (radiag_unit,9331) (k, flx1(k),flx2(k), & flx3(k),flx4(k), & flx5(k), flx6(k), & flxemch4n2o(k), flxem(k), & k=ks,ke+1) else if (nbtrge .EQ. 2) then write (radiag_unit,9322) write (radiag_unit,9332) (k, flx1(k),flx2(k), & flx3(k),flx4(k), & flx5(k), flx6(k), & (flx7(k,m ),m=1,nbtrge), & flxemch4n2o(k), flxem(k), & k=ks,ke+1) else if (nbtrge .EQ. 4) then write (radiag_unit,9323) write (radiag_unit,9333) (k, flx1(k),flx2(k), & flx3(k),flx4(k), & flx5(k), flx6(k),& (flx7(k,m),m=1,nbtrge),& flxemch4n2o(k), flxem(k), & k=ks,ke+1) endif endif endif endif end do ! (num_pts loop) !---------------------------------------------------------------------- ! format statements. !---------------------------------------------------------------------- 99000 format (/////' GRID POINT LOCATION (DEGREES) : LON = ', & F10.5, 2X, ' LAT = ', F10.5) 99016 format (/, ' THIS RUN USED THE EXPONENTIAL-SUM-FIT SW & &PARAMETERIZATION.',//) 99018 format (/, ' THIS RUN USED THE LACIS-HANSEN SW & &PARAMETERIZATION.',//) 99020 format (' SHORTWAVE CALCULATIONS BASED ON & &DIURNALLY VARYING ZENITH ANGLES') 99025 format (' SHORTWAVE CALCULATIONS BASED ON & &ANNUAL MEAN ZENITH ANGLES') 99026 format ( ' VISIBLE SFC SW FLUXES:', //, & ' total downward = ', F12.6, & ' total upward = ', F12.6, /, & ' downward direct = ', F12.6, & ' upward direct = NONEXISTENT', /, & ' downward diffuse = ', F12.6, & ' upward diffuse = ', F12.6, //, & ' NIR SFC SW FLUXES:', //, & ' total downward = ', F12.6, & ' total upward = ', F12.6, /, & ' downward direct = ', F12.6, & ' upward direct = NONEXISTENT', /, & ' downward diffuse = ', F12.6, & ' upward diffuse = ', F12.6) 99030 format (' SHORTWAVE CALCULATIONS BASED ON & &DIURNALLY AVERAGED ZENITH ANGLES') 99040 format (' SHORTWAVE CALCULATIONS BASED ON & &SPECIFIED ASTRONOMICAL INPUTS') 9009 format (///, ' ************ LONGWAVE CLOUD DATA ***************') 9010 format (/,' NO. MAX OVERLAP CLOUDS= ',I2, & ' NO. RANDOM OVERLAP CLOUDS= ',I2) 9018 format (///, ' ************ SHORTWAVE CLOUD DATA **************') 9019 format (/,' NO. SW CLOUDS = ',I2) 9030 format (I4,7X,4F14.6) 9035 format (22X,' SW CLOUD DATA '/,& ' CLD. NO',8X,'CLD. AMT.',2X, & 'CLD TOP INDEX',2X,'CLD BOT INDEX',2X,'VIS. REFL',3X, & ' IR REFL',4X,' IR ABS.') 9036 format (I5,7X,F12.6,I8,I15,6X,3F12.6) 9040 format (12X, & ' SW CLOUD DATA, BAND = ',i2, & /,' MDL. LVL',7X, 'CLD. AMT.',7X,'EXT OP DEP.',3X, & ' SSALB.',2X,' ASYMM. PAR.') 9041 format (27X,' LW CLOUD DATA, BAND = ',i2,/,' MDL. LVL',4X, & 'MXO CLD AMT.',2X,'MXO CLD EMIS',2X, & 'RNDO CLD AMT.',2X,'RNDO CLD EMIS') 9050 format (I5,7X,F12.6,6X,3F12.6) 9052 format (/, ' THIS LW RADIATION CALL SEES NO CLOUDS.') 9053 format (/, ' THIS SW RADIATION CALL SEES NO CLOUDS.') 9059 format (//, ' *********** SURFACE ALBEDO DATA ****************') !9060 format (/,10X,'VIS. SFC. ALBEDO=',F12.6,' IR SFC. ALBEDO=', & ! F12.6) 9060 format (/,'ALBEDO, VIS. SFC. DIRECT =',F10.6,' ALBEDO, NIR SFC. DIRECT =', & F10.6, & /,'ALBEDO, VIS. SFC. DIFFUSE=',F10.6,' ALBEDO, NIR SFC. DIFFUSE=', & F10.6) 9069 format (//, ' *********** RADIATIVE GAS DATA ****************') 9070 format (/,' CO2 VOL. MIXING RATIO = ', 6PF10.2,' ppmv') 9071 format (' F11 VOL. MIXING RATIO = ',12PF10.2,' pptv') 9072 format (' F12 VOL. MIXING RATIO = ',12PF10.2,' pptv') 9075 format (' F113 VOL. MIXING RATIO = ',12PF10.2,' pptv') 9076 format (' F22 VOL. MIXING RATIO = ',12PF10.2,' pptv') 9073 format (' CH4 VOL. MIXING RATIO = ', 9PF10.2,' ppbv') 9074 format (' N2O VOL. MIXING RATIO = ', 9PF10.2,' ppbv') 9079 format (//, ' *********** ASTRONOMICAL DATA ****************') 9080 format (/,' INCOMING SOLAR FLUX =',F12.6,' W/M**2',/, & ' COS(AZIMUTH)=',F12.6,10X,' FRACTION SUNUP=',F12.6) 9081 format (//, 'FOR THE HIRES ZENITH ANGLES OF THIS STEP:') 9082 format (/, ' ZENITH ANGLE NUMBER :', I4) 9090 format (//,'********* LW HEATING RATES AND FLUXES ***********',/) 9100 format (' LVL',' PRESSURE ',4X,' TEMP. ','H2O MMR',5X,& 'O3 MMR',7X,'HEAT RATE',2X,'NET FLUX',3X,'FLUX PRESS.') 9110 format (I4,E13.6,F12.4,2E12.5,2F12.6,E13.6) 9120 format (4X,E13.6,F12.4,36X,F12.6,E13.6) 9130 format (/,'*************** SW HEATING RATES AND FLUXES ******',/) 9140 format (' LVL',' PRESSURE ',3X,'HEAT RATE',2X,'NET FLUX', & 4X,'DN FLUX',6X,'UP FLUX',3X,'FLUX PRESS.') 6556 format (4X,E13.6,12X,3F12.6,E13.6) 9150 format (I4,E13.6,4F12.6,E13.6) 9160 format (/,'*********** COMBINED HEATING RATES AND FLUXES ****',/) 9170 format (' LVL',' PRESSURE ',4X,'HEAT RATE',2X,'NET FLUX', & 3X,'FLUX PRESS.') 9180 format (4X,E13.6,12X,F12.6,E13.6) 9190 format (I4,E13.6,2F12.6,E13.6) 9200 format (/,'**** APPROXIMATE HEATING RATES (Q(APPROX)) ****'/ & ' LVL',' PRESSURE ',5X,' 0-160,1200-2200 ', & ' 560-800 ',' 800-900 ', & ' 900-990 ', ' 990-1070 ', & ' 1070-1200 ', ' TOTAL') 9210 format (I4,E13.6,7F18.6) 9201 format (/,'**** APPROXIMATE HEATING RATES (Q(APPROX)) ****'/ & ' LVL',' PRESSURE ',5X,' 0-160,1400-2200 ', & ' 560-800 ',' 800-900 ', & ' 900-990 ', ' 990-1070 ', & ' 1070-1200 ',' 1200-1400 ', & ' TOTAL') 9211 format (I4,E13.6,8F18.6) 9202 format (/,'**** APPROXIMATE HEATING RATES (Q(APPROX)) ****'/ & ' LVL',' PRESSURE ',5X,' 0-160,1400-2200 ', & ' 560-800 ',' 800-900 ', & ' 900-990 ', ' 990-1070 ', & ' 1070-1200 ',' 1200-1300 ', & ' 1300-1400 ',' 1200-1400 ',' TOTAL') 9212 format (I4,E13.6,6F18.6,3F12.6,F18.6) 9203 format (/,'**** APPROXIMATE HEATING RATES (Q(APPROX)) ****'/ & ' LVL',' PRESSURE ',5X,' 0-160,1400-2200 ', & ' 560-800 ',' 800-900 ', & ' 900-990 ', ' 990-1070 ', & ' 1070-1200 ',' 1200-1250 ', & ' 1250-1300 ',' 1300-1350 ',' 1350-1400 ', & ' 1200-1400 ',' TOTAL') 9213 format (I4,E13.6,6F18.6,5F12.6,F18.6) 9220 format (/,'*******APPROXIMATE CTS HEATING RATES *****'/ & ' LVL',' PRESSURE',& 7X,' H2O BANDS ',' 15 UM BAND ', & ' 9.6 UM BAND ',' TOTAL') 9230 format (I4,E13.6,4F14.6) 9240 format (/,'********EXACT CTS HEATING RATES, BY BAND *******'/ & ' LVL',' PRESSURE ',' TOTAL ',5X,'1',11X, & '2',11X,'3', 11X,'4',11X,'5',11X,'6',11X,'7',/) 9250 format (I4,E13.6,8F12.6) 9260 format (' LVL PRESSURE ',7X,'8',11X,'9',10X,'10',10X,'11', & 10X,'12',10X,'13',10X,'14',10X,'15') 9261 format (' LVL PRESSURE ',6X,'16',10X,'17',10X,'18',10X,'19',& 10X,'20',10X,'21',10X,'22',10X,'23') 9262 format (' LVL PRESSURE ',6X,'24',10X,'25',10X,'26',10X,'27',& 10X,'28',10X,'29',10X,'30',10X,'31') 9263 format (' LVL PRESSURE ',6X,'32',10X,'33',10X,'34',10X,'35',& 10X,'36',10X,'37',10X,'38',10X,'39') 9264 format (' LVL PRESSURE ',6X,'40',10X,'41',10X,'42',10X,'43',& 10X,'44',10X,'45',10X,'46',10X,'47') 9270 format ( 40X,' FLUXES'/ & ' FLUX AT TOP,160-1200 CM-1 =',F14.6,' W/M**2'/ & ' FLUX AT TOP,0-160,1200-2200 CM-1=',F14.6,' W/M**2'/& ' FLUX AT TOP,0-2200 CM-1 =',F14.6,' W/M**2'/& ' NET FLUX AT GROUND,0-2200 CM-1 =',F14.6,' W/M**2'/ & ' NET FLUX DIFFERENCE,0-2200 CM-1 =',F14.6,' W/M**2') 9271 format ( /, & ' FLUX AT TOP, BAND ',I2,' 1200-1400 CM-1 RANGE =', & F14.6, ' W/M**2') 9272 format ( /, & ' FLUX AT TOP, 1200-1400 CM-1 BAND =',F14.6, & ' W/M**2') 9280 format (/,'**********CTS FLUXES **********'/ & 1X,'BAND NO',8X,'LOFREQ',9X,'HIFREQ',9X,'F(1)', & 11X,'ACCUM. F(1)',4X,'CTS F(GRD)',5X,'ACCUM. CTS F(GRD)') 9290 format (I11,6F15.6) 9300 format (11X,2F15.6) 9310 format (/,'********* EMISSIVITY FLUXES ***********') 9320 format (/,2x,' lvl ',2x, & ' h2o emiss ',' 560-800 ',' 800-900 ', & ' 900-990 ',' 990-1070 ',' 1070-1200 ',' total ') 9321 format (/,2x,' lvl ',2x, & ' h2o emiss ',' 560-800 ',' 800-900 ',' 900-990 ',& ' 990-1070 ',' 1070-1200 ',' 1200-1400 ', & ' total ') 9322 format (/,2x,' lvl ',2x, & ' h2o emiss ',' 560-800 ',' 800-900 ',' 900-990 ',& ' 990-1070 ',' 1070-1200 ',' 1200-1300 ', & ' 1300-1400 ',' 1200-1400 ',' total ') 9323 format (/,2x,' lvl ',2x, & ' h2o emiss ',' 560-800 ',' 800-900 ',' 900-990 ',& ' 990-1070 ',' 1070-1200 ',' 1200-1250 ',' 1250-1300 ',& ' 1300-1350 ',' 1350-1400 ',' 1200-1400 ', & ' total ') 9330 format (i5,-3p,7f11.5) 9331 format (i5,-3p,8f11.5) 9332 format (i5,-3p,10f11.5) 9333 format (i5,-3p,12f11.5) 9400 format (/,'***** CLEAR-SKY LW HEATING RATES AND FLUXES ******',/) 9410 format (/,'**** CLEAR-SKY SW HEATING RATES AND FLUXES******',/) 9420 format (/,'*** COMBINED CLEAR-SKY HEATING RATES AND FLUXES **',/) 9510 format (///, '********* CLOUD MICROPHYSICAL PARAMETERS ******', & /, 2x,'lyr',8x, 'liq water path', 3x, & 'ice water path',3x, 'eff diam water', ' eff diam ice') 9520 format (I5,7X,F14.6,3x,F14.6,3x,F14.6,3x,F14.6) 9601 format (/,'***** TOTAL-SKY LW HEATING RATES AND FLUXES (AEROSOLS INCLUDED) ******',/) 9602 format (/,'***** CLEAR-SKY LW HEATING RATES AND FLUXES (AEROSOLS INCLUDED) ******',/) 9603 format (/,'***** TOTAL-SKY LW HEATING RATES AND FLUXES (AEROSOLS EXCLUDED) ******',/) 9604 format (/,'***** CLEAR-SKY LW HEATING RATES AND FLUXES (AEROSOLS EXCLUDED) ******',/) 9701 format (/,'***** TOTAL-SKY SW HEATING RATES AND FLUXES (AEROSOLS INCLUDED) ******',/) 9702 format (/,'***** CLEAR-SKY SW HEATING RATES AND FLUXES (AEROSOLS INCLUDED) ******',/) 9703 format (/,'***** TOTAL-SKY SW HEATING RATES AND FLUXES (AEROSOLS EXCLUDED) ******',/) 9704 format (/,'***** CLEAR-SKY SW HEATING RATES AND FLUXES (AEROSOLS EXCLUDED) ******',/) 9801 format (/,'**** COMBINED HEATING RATES AND FLUXES -- AEROSOL FORCING ****',/) 9802 format (/,'*** COMBINED CLEAR-SKY HEATING RATES AND FLUXES -- AEROSOL FORCING **',/) !-------------------------------------------------------------------- end subroutine radiag !################################################################## end module radiation_diag_mod