[Dart-dev] DART/branches Revision: 11278

[dart at ucar.edu]

nancy at ucar.edu
2017-03-09 15:26:59 -0700 (Thu, 09 Mar 2017)
136
include the code for RTPS inflation (type 4) and
udpate the names of the mpi routines for sending
an array min/max to a specific task.




Modified: DART/branches/rma_trunk/adaptive_inflate/adaptive_inflate_mod.f90
===================================================================
--- DART/branches/rma_trunk/adaptive_inflate/adaptive_inflate_mod.f90	2017-03-09 22:22:10 UTC (rev 11277)
+++ DART/branches/rma_trunk/adaptive_inflate/adaptive_inflate_mod.f90	2017-03-09 22:26:59 UTC (rev 11278)
@@ -21,7 +21,7 @@
                                  prepare_to_read_from_vars, prepare_to_update_vars, &
                                  map_pe_to_task
 
-use mpi_utilities_mod,    only : my_task_id, send_to, receive_from, reduce_min_max
+use mpi_utilities_mod,    only : my_task_id, send_to, receive_from, send_minmax_to
 
 implicit none
 private
@@ -35,7 +35,7 @@
           output_inf_restart,         get_inflate_mean,              get_inflate_sd,     &
           get_is_prior,               get_is_posterior,              do_ss_inflate,      &
           set_inflation_mean_copy,    set_inflation_sd_copy,         get_inflation_mean_copy, &
-          get_inflation_sd_copy
+          get_inflation_sd_copy,      do_rtps_inflate
 
 
 ! version controlled file description for error handling, do not edit
@@ -163,7 +163,8 @@
 type(adaptive_inflate_type), intent(in) :: inflation
 logical :: do_ss_inflate
 
-if (do_single_ss_inflate(inflation) .or. do_varying_ss_inflate(inflation)) then
+if (do_single_ss_inflate(inflation) .or. do_varying_ss_inflate(inflation) .or. &
+    do_rtps_inflate(inflation)) then
    do_ss_inflate = .true.
 else
    do_ss_inflate = .false.
@@ -294,7 +295,20 @@
 
 end function do_single_ss_inflate
 
+!------------------------------------------------------------------
 
+function do_rtps_inflate(inflate_handle)
+
+! Returns true if this inflation type indicates posterior relaxion-to-prior-spread
+! (whitaker & Hamill, 2012)
+
+logical                                 :: do_rtps_inflate
+type(adaptive_inflate_type), intent(in) :: inflate_handle
+
+do_rtps_inflate = (inflate_handle%inflation_flavor == 4)
+
+end function do_rtps_inflate
+
 !------------------------------------------------------------------
 
 function deterministic_inflate(inflate_handle)
@@ -310,7 +324,7 @@
 
 !------------------------------------------------------------------
 
-subroutine inflate_ens(inflate_handle, ens, mean, inflate, var_in)
+subroutine inflate_ens(inflate_handle, ens, mean, inflate, var_in, fsprd, asprd)
 
 ! Inflates subset of ensemble members given mean and inflate
 ! Selects between deterministic and stochastic inflation
@@ -319,6 +333,7 @@
 real(r8),                    intent(inout) :: ens(:)
 real(r8),                    intent(in)    :: mean, inflate
 real(r8), optional,          intent(in)    :: var_in
+real(r8), optional,          intent(in)    :: fsprd, asprd
 
 integer  :: i, ens_size
 real(r8) :: rand_sd, var, sd_inflate
@@ -331,13 +346,26 @@
 endif
 
 if(inflate_handle%deterministic) then
-   ! Just spread the ensemble out linearly for deterministic
-   ! Following line can lead to inflation of 1.0 changing ens on some compilers
-   !!! ens = (ens - mean) * sqrt(inflate) + mean
-   ! Following gives 1.0 inflation having no impact on known compilers
-   sd_inflate = sqrt(inflate) 
-   ens = ens * sd_inflate + mean * (1.0_r8 - sd_inflate)
 
+   if ( do_rtps_inflate(inflate_handle)) then
+      if ( .not. present(fsprd) .or. .not. present(asprd)) then 
+         write(msgstring, *) 'missing arguments for RTPS inflation, should not happen'
+         call error_handler(E_ERR,'inflate_ens',msgstring,source,revision,revdate) 
+      endif 
+      ! only inflate if spreads are > 0
+      if ( asprd .gt. 0.0_r8 .and. fsprd .gt. 0.0_r8) &
+          ens = mean + (ens-mean) * ( inflate*((fsprd-asprd)/asprd) + 1.0_r8 )
+   else 
+
+      ! Spread the ensemble out linearly for deterministic
+      ! Following line can lead to inflation of 1.0 changing ens on some compilers
+      !!! ens = (ens - mean) * sqrt(inflate) + mean
+      ! Following gives 1.0 inflation having no impact on known compilers
+      sd_inflate = sqrt(inflate) 
+      ens = ens * sd_inflate + mean * (1.0_r8 - sd_inflate)
+
+   endif
+
 else