!FDOC_TAG_GFDL module mgrp_prscr_clds_mod ! ! fil ! ! ! ! ! ! mgroup prescribed cloud properties module ! (this module runnable in SKYHI and FMS; ! zonal_clouds_mod is FMS native equivalent) ! ! ! ! ! ! use mpp_mod, only: input_nml_file use fms_mod, only: fms_init, file_exist, & open_namelist_file, & check_nml_error, close_file, & write_version_number, & mpp_pe, mpp_root_pe, stdlog, & error_mesg, FATAL use constants_mod, only: radian use rad_utilities_mod, only: rad_utilities_init, & cldrad_properties_type, & cld_specification_type !-------------------------------------------------------------------- implicit none private !-------------------------------------------------------------------- ! mgroup prescribed cloud properties module ! (this module runnable in SKYHI and FMS; ! zonal_clouds_mod is FMS native equivalent) ! !!-------------------------------------------------------------------- !--------------------------------------------------------------------- !----------- ****** VERSION NUMBER ******* --------------------------- character(len=128) :: version = '$Id: mgrp_prscr_clds.F90,v 19.0 2012/01/06 20:19:41 fms Exp $' character(len=128) :: tagname = '$Name: tikal $' !--------------------------------------------------------------------- !------- interfaces -------- public mgrp_prscr_clds_init, & mgrp_prscr_clds_end, & prscr_clds_amt, & obtain_bulk_lw_prscr, obtain_bulk_sw_prscr private cldht, cldint !--------------------------------------------------------------------- !-------- namelist --------- integer :: dummy=0 namelist /mgrp_prscr_clds_nml / & dummy !---------------------------------------------------------------------- !---- public data ------- !---------------------------------------------------------------------- !---- private data ------- !-------------------------------------------------------------------- ! these variables define cloud amounts and radiative properties ! on a global (j,k) model grid. !-------------------------------------------------------------------- logical, dimension(:,:), allocatable :: zhi_cloud_gl, zmid_cloud_gl, & zlow_cloud_gl real, dimension(:,:), allocatable :: zcamtmxo, zcamtrnd !-------------------------------------------------------------------- ! these variables define cloud tops and bottoms, amounts and rad- ! iative properties on an input (LATOBS,NOFCLDS_SP) grid. the input ! values are the original Skyhi values. !-------------------------------------------------------------------- integer, parameter :: NOFCLDS_SP=3 integer, parameter :: NOFMXOLW=1 integer, parameter :: NOFRNDLW=2 integer, parameter :: LATOBS=19 !------------------------------------------------------------------- ! default low, middle, high cloud properties ! cldem : infrared emissivity ! crfvis : visible band reflectivity ! crfir : near-ir band reflectivity ! cabir : near-ir band absorptivity !------------------------------------------------------------------- real :: cldem_hi = 1.0 real :: cldem_mid= 1.0 real :: cldem_low = 1.0 real :: crfvis_hi = 0.21 real :: crfvis_mid =0.48 real :: crfvis_low =0.69 real :: crfir_hi = 0.21 real :: crfir_mid =0.48 real :: crfir_low = 0.69 real :: cabir_hi = 0.005 real :: cabir_mid =0.02 real :: cabir_low =0.035 !------------------------------------------------------------------- ! prescribed high, mid, low cloud amounts on 19 latitudes !------------------------------------------------------------------- integer :: jj, kkc real, dimension(LATOBS) :: ccd_low, ccd_mid, ccd_hi real, dimension(LATOBS) :: cloud_lats data cloud_lats / -90., -80., -70., -60., -50., -40., -30., -20., & -10., 0.0, 10., 20., 30., 40., 50., 60., 70., 80., & 90. / data ccd_low / & & 0.360E+00, 0.401E+00, 0.439E+00, 0.447E+00, 0.417E+00, & & 0.343E+00, 0.269E+00, 0.249E+00, 0.290E+00, 0.330E+00, & & 0.290E+00, 0.249E+00, 0.269E+00, 0.343E+00, 0.417E+00, & & 0.447E+00, 0.439E+00, 0.401E+00, 0.360E+00/ data ccd_mid / & & 0.090E+00, 0.102E+00, 0.117E+00, 0.128E+00, 0.122E+00, & & 0.095E+00, 0.070E+00, 0.060E+00, 0.068E+00, 0.080E+00, & & 0.068E+00, 0.060E+00, 0.070E+00, 0.095E+00, 0.122E+00, & & 0.128E+00, 0.117E+00, 0.102E+00, 0.090E+00/ data ccd_hi / & & 0.198E+00, 0.231E+00, 0.254E+00, 0.250E+00, 0.227E+00, & & 0.192E+00, 0.159E+00, 0.168E+00, 0.205E+00, 0.241E+00, & & 0.205E+00, 0.168E+00, 0.159E+00, 0.192E+00, 0.227E+00, & & 0.250E+00, 0.254E+00, 0.231E+00, 0.198E+00/ !---------------------------------------------------------------------- !---------------------------------------------------------------------- ! NLWCLDB is the number of frequency bands for which lw ! emissitivies are defined. !---------------------------------------------------------------------- logical :: module_is_initialized = .false. !---------------------------------------------------------------------- !---------------------------------------------------------------------- contains ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! subroutine mgrp_prscr_clds_init ( pref, latb ) !------------------------------------------------------------------ real, dimension(:), intent(in) :: latb real, dimension(:,:), intent(in) :: pref !-------------------------------------------------------------------- integer :: unit, ierr, io, logunit integer :: j, k, li integer :: jdf integer, dimension ( LATOBS, NOFCLDS_SP) :: kkbh, kkth integer :: kerad integer, dimension(:), allocatable :: jindx2 if (module_is_initialized) return call fms_init call rad_utilities_init !--------------------------------------------------------------------- !----- read namelist ------ #ifdef INTERNAL_FILE_NML read (input_nml_file, nml=mgrp_prscr_clds_nml, iostat=io) ierr = check_nml_error(io,"mgrp_prscr_clds_nml") #else if (file_exist('input.nml')) then unit = open_namelist_file () ierr=1; do while (ierr /= 0) read (unit, nml=mgrp_prscr_clds_nml, iostat=io, end=10) ierr = check_nml_error (io, 'mgrp_prscr_clds_nml') enddo 10 call close_file (unit) endif #endif call write_version_number(version, tagname) logunit = stdlog() if (mpp_pe() == mpp_root_pe() ) & write (logunit, nml = mgrp_prscr_clds_nml) !-------------------------------------------------------------------- ! retrieve module variables that come from other modules !-------------------------------------------------------------------- kerad = size(pref,1) - 1 jdf = size(latb,1) - 1 allocate (jindx2 (size(latb,1)-1)) ; jindx2 = 0.0 call find_nearest_index (latb, jindx2) !--------------------------------------------------------------------- ! define the number of cloud emissivity bands for use in this module. !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! allocate space to hold the cloud radiative properties on the model ! grid (j,k) !--------------------------------------------------------------------- allocate( zcamtmxo (jdf , KERAD)) ; zcamtmxo = 0.0 allocate( zcamtrnd (jdf , KERAD)) ; zcamtrnd = 0.0 allocate( zhi_cloud_gl(jdf , kerad )) allocate( zmid_cloud_gl(jdf , kerad )) allocate( zlow_cloud_gl(jdf , kerad )) zhi_cloud_gl = .false. zmid_cloud_gl = .false. zlow_cloud_gl = .false. !--------------------------------------------------------------------- ! define index arrays for cloud tops and cloud bottoms(kkth, kkbh). ! a program courtesy of Ron Stouffer is used. cldht specifies cloud ! height data in mb for each cloud type, at 10 deg intervals from ! 90S to 90N.(ie, 19 lats). !--------------------------------------------------------------------- call cldht (pref(:,1), kkbh, kkth) !--------------------------------------------------------------------- ! perform latitude "interpolation" to the (JD) model latitudes ! in default case, no interpolation is actually done; the nearest ! latitude available (using NINT function) is used. !--------------------------------------------------------------------- zcamtmxo = 0. zcamtrnd = 0. do j=1,jdf li = jindx2(j) do k=kkth(li,1), kkbh(li,1) zlow_cloud_gl(j,k) = .true. zcamtmxo(j,k) = ccd_low(li) end do do k=kkth(li,2), kkbh(li,2) zmid_cloud_gl(j,k) = .true. zcamtrnd(j,k) = ccd_mid(li) end do do k=kkth(li,3), kkbh(li,3) zhi_cloud_gl(j,k) = .true. zcamtrnd(j,k) = ccd_hi(li) end do end do !--------------------------------------------------------------------- ! if a cloud microphysics scheme is to be employed with the cloud ! scheme, initialize the microphysics_rad module. !-------------------------------------------------------------------- module_is_initialized = .true. end subroutine mgrp_prscr_clds_init !###################################################################### ! ! ! ! ! ! ! ! ! ! subroutine mgrp_prscr_clds_end !---------------------------------------------------------------------- ! mgrp_prscr_clds_end is the destructor for mgrp_prscr_clds_mod. !---------------------------------------------------------------------- !--------------------------------------------------------------------- ! mark the module as not initialized. !--------------------------------------------------------------------- module_is_initialized = .false. !-------------------------------------------------------------------- end subroutine mgrp_prscr_clds_end !##################################################################### ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! subroutine find_nearest_index (latb, jindx2) real, dimension(:), intent(in) :: latb integer, dimension(:), intent(out) :: jindx2 integer :: jd, j, jj real :: diff_low, diff_high real, dimension(size(latb,1)-1) :: lat jd = size(latb,1) - 1 do j = 1,jd lat(j) = 0.5*(latb(j) + latb(j+1)) do jj=1, LATOBS if (lat(j)*radian >= cloud_lats(jj)) then diff_low = lat(j)*radian - cloud_lats(jj) diff_high = cloud_lats(jj+1) - lat(j)*radian if (diff_high <= diff_low) then jindx2(j) = jj+1 else jindx2(j) = jj endif endif end do end do end subroutine find_nearest_index !###################################################################### ! ! ! prscr_clds_amt defines the location, amount (cloud fraction), ! number and type (hi, mid, low) of clouds present on the model grid. ! ! ! ! prscr_clds_amt defines the location, amount (cloud fraction), ! number and type (hi, mid, low) of clouds present on the model grid. ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! subroutine prscr_clds_amt (is, ie, js, je, Cld_spec) !--------------------------------------------------------------------- ! prscr_clds_amt defines the location, amount (cloud fraction), ! number and type (hi, mid, low) of clouds present on the model grid. !---------------------------------------------------------------------- integer, intent(in) :: is, ie, js, je type(cld_specification_type), intent(inout) :: Cld_spec !-------------------------------------------------------------------- ! intent(in) variables: ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! ! intent(inout) variables: ! ! Cld_spec cld_specification_type variable containing the ! cloud specification input fields needed by the ! radiation package ! ! the following elements of Cld_spec are defined here: ! ! %cmxolw fraction of maximally overlapped clouds ! seen by the longwave radiation ! [ dimensionless ] ! %crndlw fraction of randomly overlapped clouds ! seen by the longwave radiation ! [ dimensionless ] ! %camtsw cloud fraction seen by the shortwave ! radiation; the sum of the maximally ! overlapped and randomly overlapped ! longwave cloud fractions [ dimensionless ] ! %nmxolw number of maximally overlapped longwave ! clouds in each grid column. ! %nrndlw number of randomly overlapped longwave ! clouds in each grid column. ! %ncldsw number of clouds seen by he shortwave ! radiation in each grid column. ! %hi_cld logical flag indicating the presence of ! high clouds in a grid box ! %mid_cld logical flag indicating the presence of ! middle clouds in a grid box ! %low_cld logical flag indicating the presence of ! low clouds in a grid box ! !--------------------------------------------------------------------- !------------------------------------------------------------------- ! local variables: integer :: i,j,k ! do loop indices !--------------------------------------------------------------------- ! define the number of clouds in each column. the assumption is made ! that all grid columns have NOFCLDS_SP clouds, with NOFMXOLW of ! these being maximally overlapped and the remainder (NOFRNDLW) ! randomly overlapped. The default case, corresponding to all ! previous model simulations, is 3 clouds (1 maximally overlapped, ! 2 randomly overlapped). !---------------------------------------------------------------------- Cld_spec%nmxolw(:,:) = NOFMXOLW Cld_spec%nrndlw(:,:) = NOFRNDLW Cld_spec%ncldsw(:,:) = NOFCLDS_SP !---------------------------------------------------------------------- ! define the fractions of random and maximally overlapped clouds and ! the total cloud fraction seen by the shortwave radiation. define ! the hi-mid-low cloud flag arrays based on the pre-defined latitude ! and height dependent specifications that were defined during init- ! ialization. !---------------------------------------------------------------------- do k=1,size (Cld_spec%hi_cloud,3) do j=1,size (Cld_spec%hi_cloud,2) do i=1,size (Cld_spec%hi_cloud,1) Cld_spec%cmxolw(i,j,k) = zcamtmxo(j+js-1 ,k) Cld_spec%crndlw(i,j,k) = zcamtrnd(j+js-1 ,k) Cld_spec%camtsw(i,j,k) = Cld_spec%cmxolw(i,j,k) + & Cld_spec%crndlw(i,j,k) if (Cld_spec%camtsw(i,j,k) > 0.0) then if (zhi_cloud_gl(js+j-1,k)) then Cld_spec%hi_cloud(i,j,k) = .true. else if (zmid_cloud_gl(js+j-1,k)) then Cld_spec%mid_cloud(i,j,k) = .true. else if (zlow_cloud_gl(js+j-1,k) ) then Cld_spec%low_cloud(i,j,k) = .true. else call error_mesg ('mgrp_prscr_clds_mod', & 'model level is not mapped to a cloud type', FATAL) endif endif end do end do end do !--------------------------------------------------------------------- end subroutine prscr_clds_amt !###################################################################### ! ! ! obtain_bulk_lw_prscr defines bulk longwave cloud radiative ! properties for the mgrp_prscr_clds cloud scheme. ! ! ! ! obtain_bulk_lw_prscr defines bulk longwave cloud radiative ! properties for the mgrp_prscr_clds cloud scheme. ! ! ! ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! ! ! ! ! ! ! ! ! ! ! ! ! Cld_spec cloud specification arrays defining the ! location, amount and type (hi, middle, lo) ! of clouds that are present, provides input ! to this subroutine ! [ cld_specification_type ] ! ! ! ! Cldrad_props cloud radiative properties on model grid, ! [ cldrad_properties_type ] ! ! the following components of this variable are output ! from this routine: ! ! %emrndlw longwave cloud emissivity for ! randomly overlapped clouds ! in each of the longwave ! frequency bands [ dimensionless ] ! %emmxolw longwave cloud emissivity for ! maximally overlapped clouds ! in each of the longwave ! frequency bands [ dimensionless ] ! ! ! ! subroutine obtain_bulk_lw_prscr (is, ie, js, je, Cld_spec, Cldrad_props) !--------------------------------------------------------------------- ! obtain_bulk_lw_prscr defines bulk longwave cloud radiative ! properties for the mgrp_prscr_clds cloud scheme. !--------------------------------------------------------------------- integer, intent(in) :: is, ie, js, je type(cld_specification_type), intent(inout) :: Cld_spec type(cldrad_properties_type), intent(inout) :: Cldrad_props !-------------------------------------------------------------------- ! intent(in) variables: ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! ! intent(inout) variables: ! ! Cld_spec cloud specification arrays defining the ! location, amount and type (hi, middle, lo) ! of clouds that are present, provides input ! to this subroutine ! [ cld_specification_type ] ! Cldrad_props cloud radiative properties on model grid, ! [ cldrad_properties_type ] ! ! the following components of this variable are output ! from this routine: ! ! %emrndlw longwave cloud emissivity for ! randomly overlapped clouds ! in each of the longwave ! frequency bands [ dimensionless ] ! %emmxolw longwave cloud emissivity for ! maximally overlapped clouds ! in each of the longwave ! frequency bands [ dimensionless ] ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: integer :: i,j,k ! do-loop indices !--------------------------------------------------------------------- ! assign the proper values for cloud emissivity to each grid box ! with cloudiness, dependent on whether the cloud in that box is ! defined as being high, middle or low cloud. high and middle clouds ! are assumed to be random overlap, low clouds are assume to be ! maximum overlap. !---------------------------------------------------------------------- do k=1, size(Cld_spec%hi_cloud,3) do j=1,size(Cld_spec%hi_cloud,2) do i=1,size(Cld_spec%hi_cloud,1) if (Cld_spec%hi_cloud(i,j,k)) then Cldrad_props%emrndlw(i,j,k,:,1) = cldem_hi else if (Cld_spec%mid_cloud(i,j,k)) then Cldrad_props%emrndlw(i,j,k,:,1) = cldem_mid else if (Cld_spec%low_cloud(i,j,k)) then Cldrad_props%emmxolw(i,j,k,:,1) = cldem_low endif end do end do end do !--------------------------------------------------------------------- end subroutine obtain_bulk_lw_prscr !##################################################################### ! ! ! obtain_bulk_sw_zonal defines bulk shortwave cloud radiative ! properties for the zonal cloud scheme. ! ! ! ! obtain_bulk_sw_zonal defines bulk shortwave cloud radiative ! properties for the zonal cloud scheme. ! ! ! ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! ! ! ! ! ! ! ! ! ! ! ! ! Cld_spec cloud specification arrays defining the ! location, amount and type (hi, middle, lo) ! of clouds that are present, provides input ! to this subroutine ! [ cld_specification_type ] ! ! ! ! Cldrad_props cloud radiative properties on model grid, ! [ cldrad_properties_type ] ! ! the following components of this variable are output ! from this routine: ! ! %cirabsw absorptivity of clouds in the ! infrared frequency band ! [ dimensionless ] ! %cirrfsw reflectivity of clouds in the ! infrared frequency band ! [ dimensionless ] ! %cvisrfsw reflectivity of clouds in the ! visible frequency band ! [ dimensionless ] ! ! ! ! subroutine obtain_bulk_sw_prscr (is, ie, js, je, Cld_spec, Cldrad_props) !--------------------------------------------------------------------- ! obtain_bulk_sw_zonal defines bulk shortwave cloud radiative ! properties for the zonal cloud scheme. !--------------------------------------------------------------------- integer, intent(in) :: is, ie, js, je type(cld_specification_type), intent(inout) :: Cld_spec type(cldrad_properties_type), intent(inout) :: Cldrad_props !------------------------------------------------------------------- !-------------------------------------------------------------------- ! intent(in) variables: ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! ! intent(inout) variables: ! ! Cld_spec cloud specification arrays defining the ! location, amount and type (hi, middle, lo) ! of clouds that are present, provides input ! to this subroutine ! [ cld_specification_type ] ! Cldrad_props cloud radiative properties on model grid, ! [ cldrad_properties_type ] ! ! the following components of this variable are output ! from this routine: ! ! %cirabsw absorptivity of clouds in the ! infrared frequency band ! [ dimensionless ] ! %cirrfsw reflectivity of clouds in the ! infrared frequency band ! [ dimensionless ] ! %cvisrfsw reflectivity of clouds in the ! visible frequency band ! [ dimensionless ] ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: integer :: i,j,k ! do loop indices !--------------------------------------------------------------------- ! assign the proper values for cloud absorptivity and reflectivity ! to each grid box with cloudiness, dependent on whether the cloud ! in that box is defined as being high, middle or low cloud. !---------------------------------------------------------------------- do k=1, size(Cld_spec%hi_cloud,3) do j=1,size(Cld_spec%hi_cloud,2) do i=1,size(Cld_spec%hi_cloud,1) if (Cld_spec%hi_cloud(i,j,k)) then Cldrad_props%cirabsw(i,j,k) = cabir_hi Cldrad_props%cirrfsw(i,j,k) = crfir_hi Cldrad_props%cvisrfsw(i,j,k) = crfvis_hi else if (Cld_spec%mid_cloud(i,j,k)) then Cldrad_props%cirabsw(i,j,k) = cabir_mid Cldrad_props%cirrfsw(i,j,k) = crfir_mid Cldrad_props%cvisrfsw(i,j,k) = crfvis_mid else if (Cld_spec%low_cloud(i,j,k)) then Cldrad_props%cirabsw(i,j,k) = cabir_low Cldrad_props%cirrfsw(i,j,k) = crfir_low Cldrad_props%cvisrfsw(i,j,k) = crfvis_low endif end do end do end do !---------------------------------------------------------------------- end subroutine obtain_bulk_sw_prscr !###################################################################### !################################################################## ! ! ! This subroutine computes the heights of the cloud tops ! and bottoms for the fixed cloud model. The observed data ! are from London (1954, 1957). This data is a function of 10 deg. ! latitude bands (0-10, 10-20 and etc.), season and height ! in the orginal paper and only for ! the Northern Hemisphere for various cloud types. ! Dick and Suki averaged the four seasons together to get annual ! mean cloud heights for three type of clouds (hi, middle and low). ! Somebody also interpolated the data from the 10 deg latitude ! bands to 5 deg bands. At the equator, this interpolation ! was more like an extrapolation. ! These heights were then put in pressure coordinates using ! a Skew-T diagram which assumes a "standard atmosphere". ! ! ! ! This subroutine computes the heights of the cloud tops ! and bottoms for the fixed cloud model. The observed data ! are from London (1954, 1957). This data is a function of 10 deg. ! latitude bands (0-10, 10-20 and etc.), season and height ! in the orginal paper and only for ! the Northern Hemisphere for various cloud types. ! Dick and Suki averaged the four seasons together to get annual ! mean cloud heights for three type of clouds (hi, middle and low). ! Somebody also interpolated the data from the 10 deg latitude ! bands to 5 deg bands. At the equator, this interpolation ! was more like an extrapolation. ! These heights were then put in pressure coordinates using ! a Skew-T diagram which assumes a "standard atmosphere". ! ! ! ! ! ! ! ! ! ! ! ! ! ! subroutine cldht (plevel, kkbh, kkth) real, dimension(:), intent(in) :: plevel integer, dimension(:,:), intent(out) :: kkbh, kkth !------------------------------------------------------------------ ! This subroutine computes the heights of the cloud tops ! and bottoms for the fixed cloud model. The observed data ! are from London (1954, 1957). This data is a function of 10 deg. ! latitude bands (0-10, 10-20 and etc.), season and height ! in the orginal paper and only for ! the Northern Hemisphere for various cloud types. ! Dick and Suki averaged the four seasons together to get annual ! mean cloud heights for three type of clouds (hi, middle and low). ! Somebody also interpolated the data from the 10 deg latitude ! bands to 5 deg bands. At the equator, this interpolation ! was more like an extrapolation. ! These heights were then put in pressure coordinates using ! a Skew-T diagram which assumes a "standard atmosphere". ! ! The Dick and Suki (Ron's pressures) data follow: ! ! TYPE: hi | middle | low ! | | | ctop | cbase ! Lat | ht press | ht press | ht press | ht press ! 0 | 9.80 272 | 4.35 590 | 3.00 700 | 1.40 855 ! 5 | 9.82 271 | 4.40 586 | 3.04 698 | 1.47 848 ! 10 | 10.13 259 | 4.45 581 | 3.08 693 | 1.61 836 ! 15 | 10.35 250 | 4.50 578 | 3.08 693 | 1.70 828 ! 20 | 10.50 244 | 4.50 578 | 3.01 699 | 1.72 825 ! 25 | 10.50 244 | 4.41 584 | 2.91 710 | 1.71 826 ! 30 | 10.38 248 | 4.26 595 | 2.80 719 | 1.70 828 ! 35 | 10.03 263 | 4.10 614 | 2.70 729 | 1.65 830 ! 40 | 9.44 285 | 3.92 621 | 2.60 735 | 1.58 839 ! 45 | 8.65 322 | 3.79 633 | 2.47 750 | 1.50 846 ! 50 | 7.97 357 | 3.67 647 | 2.35 760 | 1.40 859 ! 55 | 7.55 379 | 3.56 651 | 2.24 770 | 1.31 867 ! 60 | 7.29 392 | 3.51 657 | 2.17 780 | 1.25 871 ! 65 | 7.13 401 | 3.50 658 | 2.10 783 | 1.20 875 ! 70 | 7.03 406 | 3.48 659 | 2.03 788 | 1.12 881 ! 75 | 7.01 409 | 3.44 660 | 1.98 795 | 1.05 890 ! 80 | 6.99 410 | 3.43 661 | 1.91 800 | 1.02 891 ! 85 | 6.98 411 | 3.43 661 | 1.88 803 | 1.00 896 ! 90 | 6.98 411 | 3.43 661 | 1.87 804 | 1.00 896 ! ! Note that the heights are in kilometers and the pressures ! in millibars. !-------------------------------------------------------------------- real, dimension(10) :: ciht, asht, cltop, clbase integer :: n, nl, j !------------------------------------------------------------------ ! The data in the following arrays run pole to equator, ! starting at 90, 80, 70....10, 0. !------------------------------------------------------------------ ! Observed high cloud heights running pole to equator (mb) data ciht / 411, 410, 406, 392, 357, 285, 248, 244, 259, 272 / ! Observed middle cloud heights running pole to equator (mb) data asht / 661, 661, 659, 657, 647, 621, 595, 578, 581, 590 / ! Observed low cloud top heights running pole to equator (mb) ! data cltop / 804, 800, 788, 780, 760, 735, 719, 699, 693, 700 / data cltop / 804, 800, 788, 780, 766, 735, 719, 699, 693, 700 / ! The above data statement was changed so that this code would ! reproduce exactly the indexes used in the 9 level model. The 6 mb ! error should not affect the results very much....if at all. ! Observed low cloud bottom heights running pole to equator (mb) data clbase / 896, 891, 881, 871, 859, 839, 828, 825, 836, 855 / !-------------------------------------------------------------------- ! for (at present) unexplained reasons, the middle cloud ! specification does not agree with the current gcm specification. ! a glance at the telegadas and london paper suggests differences ! caused by 1) use of cldmid rather than clotop and cldbase heights ! 2) seeming errors in polar cloud height locations. for now, ! the foregoing kluge gives cloud positions in agreement with ! SKYHI, PROVIDED: ! it is realized that these indexes are the true values, which ! differ by 1 from the skyhiindices. in the gcm, a subtraction ! is done to get the indices to be correct (see radmn.F). !-------------------------------------------------------------------- do n=8,10 asht(n) = asht(n) - 25. enddo clbase = clbase *1.0E02 cltop = cltop *1.0E02 asht = asht*100. ciht = ciht*100. !------------------------------------------------------------------- ! First compute the cloud top indexes for the high clouds ! nl is the index for cloud type nl=3 => high !-------------------------------------------------------------------- nl = 3 call Cldint(plevel, ciht ,kkth, nl) !--------------------------------------------------------------------- ! Set cloud bottom height equal to cloud top height. ! This assumes cirrus clouds are one level thick. !--------------------------------------------------------------------- do j=1,latobs kkbh(j,nl) = kkth(j,nl) end do !------------------------------------------------------------------- ! Second compute the cloud top indexes for the middle clouds ! nl is the index for cloud type nl=2 => middle !------------------------------------------------------------------- nl = 2 call Cldint(plevel, asht,kkth, nl) !------------------------------------------------------------------- ! Set cloud bottom height equal to cloud top height. ! This assumes middle clouds are one level thick. !------------------------------------------------------------------- do j=1,latobs kkbh(j,nl) = kkth(j,nl) end do !------------------------------------------------------------------- ! Third compute the cloud top indexes for the low clouds ! nl is the index for cloud type nl=1 => low !------------------------------------------------------------------- nl = 1 call Cldint(plevel, cltop,kkth, nl) !------------------------------------------------------------------- ! Lastly compute the cloud bottom indexes for the low clouds ! This assumes that low clouds can be thicker than one level. ! nl is the index for cloud type nl=1 => low !------------------------------------------------------------------- nl = 1 call Cldint(plevel, clbase, kkbh, nl) end subroutine cldht !################################################################## ! ! ! This subroutine computes the indexes for the heights of the cloud ! tops and bottoms for the fixed cloud model. ! ! ! ! This subroutine computes the indexes for the heights of the cloud ! tops and bottoms for the fixed cloud model. ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! subroutine cldint(plevel, cldobs, kindex, nl) !------------------------------------------------------------------- ! This subroutine computes the indexes for the heights of the cloud ! tops and bottoms for the fixed cloud model. !------------------------------------------------------------------- real, dimension(10), intent(in) :: cldobs integer, dimension(LATOBS,NOFCLDS_SP), intent(out) :: kindex integer, intent(in) :: nl real, dimension(:), intent(in) :: plevel !------------------------------------------------------------------ real, dimension(LATOBS) :: cldlat real :: prsmid integer :: j, k integer :: kerad kerad = size(plevel(:)) - 1 !--------------------------------------------------------------------- ! Fill in Southern hemisphere cloud heights !--------------------------------------------------------------------- do j=1,10 cldlat(j) = cldobs(j) end do do j=1,9 cldlat(j+10) = cldobs(10-j) end do !------------------------------------------------------------------- ! Start latitude loop to compute index at each latitude. !------------------------------------------------------------------- do j=1,LATOBS !------------------------------------------------------------------- ! Find first place where the pressure on the model level ! is greater than the pressure of the cloud height. Starting ! from the top of the atm and going down the column. !------------------------------------------------------------------- if (plevel(KERAD) .lt. cldlat(j)) then call error_mesg ('mgrp_prscr_clds_mod', & 'no level found with pressure greater than cloud pressure', & FATAL) endif if (plevel(1) .gt. cldlat(j)) then call error_mesg ('mgrp_prscr_clds_mod', & ' cloud is above highest model level', FATAL) endif do k=1,KERAD if (plevel(k) .gt. cldlat(j)) then !------------------------------------------------------------------- ! k is the index of the first model level below the cloud height. ! compute the pressure half way between the model levels !------------------------------------------------------------------- prsmid = (plevel(k)+plevel(k-1)) *0.5 !------------------------------------------------------------------- ! If prsmid is greater than cldlat (cloud height) then the ! level above is closer to cloud height, otherwise it is the ! level below. !------------------------------------------------------------------- if (prsmid .gt. cldlat(j)) then kindex(j,nl) = k-1 else kindex(j,nl) = k endif exit endif end do end do !-------------------------------------------------------------------- end subroutine cldint !#################################################################### end module mgrp_prscr_clds_mod