[Dart-dev] DART/branches Revision: 12535

[dart at ucar.edu]

hendric at ucar.edu
2018-04-18 15:27:49 -0600 (Wed, 18 Apr 2018)
75

refactoring prior and posterior code to fit into a 
reusable subroutine.




Modified: DART/branches/rma_fill_inf/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.f90
===================================================================
--- DART/branches/rma_fill_inf/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.f90	2018-04-18 21:27:10 UTC (rev 12534)
+++ DART/branches/rma_fill_inf/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.f90	2018-04-18 21:27:49 UTC (rev 12535)
@@ -156,6 +156,10 @@
 file_array_input  = RESHAPE(input_state_files,  (/      1,  num_domains/))
 file_array_output = RESHAPE(output_state_files, (/num_ens,  num_domains/))
 
+if(single_file) then
+file_array_output = file_array_input
+endif
+
 ! Test the read portion.
 call io_filenames_init(file_info_input,             &
                        ncopies      = num_ens,      &
@@ -209,106 +213,73 @@
                        restart_files = file_array_output)
 
 if(write_prior_inf) then  
-   if (prior_inf_mean == MISSING_R8 .or. prior_inf_sd == MISSING_R8) then
-      write(*,*) 'you must specify both prior_inf_mean and prior_inf_sd values'
-      return
-   endif
-   ens_handle%copies(ss_inflate_index   , :) = prior_inf_mean
-   ens_handle%copies(ss_inflate_sd_index, :) = prior_inf_sd
+   call fill_inflation_files(prior_inf_mean, prior_inf_sd, 'prior')
+endif
 
-   write(my_stage,'(A)') 'prior_inflation'
-   write(my_base, '(A)') 'mean'
-   write(my_desc, '(A)') 'prior inflation mean'
-   call set_file_metadata(file_info_output,    &
-                          cnum     = 1,        &
-                          stage    = my_stage, &
-                          basename = my_base,  &
-                          desc     = my_desc)
+if(write_post_inf) then  
+   call fill_inflation_files(post_inf_mean, post_inf_sd, 'post')
+endif
 
-   call set_io_copy_flag(file_info_output,    &
-                         cnum    = 1,         &
-                         io_flag = WRITE_COPY)
+deallocate(file_array_input, file_array_output)
 
-   write(my_base, '(A)') 'sd'
-   write(my_desc, '(A)') 'prior inflation sd'
-   call set_file_metadata(file_info_output,    &
-                          cnum     = 2,        &
-                          stage    = my_stage, &
-                          basename = my_base,  &
-                          desc     = my_desc)
+call exit(0)
 
-   call set_io_copy_flag(file_info_output,    &
-                         cnum    = 2,         &
-                         io_flag = WRITE_COPY)
+!======================================================================
+contains
+!======================================================================
 
-   output_restart_files = get_stage_metadata(file_info_output)
-   
-   do idom = 1, num_domains
-      !#! do imem = 1, num_ens
-         do imem = 1,2 ! mean and sd
-         write(*, *) '- Writing Prior Inflation File : ', &
-                     trim(get_restart_filename(output_restart_files, imem, domain=idom))
-         enddo
-      !#! enddo
-   enddo
-   
-   call write_state(ens_handle, file_info_output)
+subroutine fill_inflation_files(inf_mean, inf_sd, stage)
+real(r8),         intent(in) :: inf_mean
+real(r8),         intent(in) :: inf_sd
+character(len=*), intent(in) :: stage
 
+if (inf_mean == MISSING_R8 .or. inf_sd == MISSING_R8) then
+   write(*,*) 'you must specify both inf_mean and inf_sd values'
+   write(*,*) 'you have "',trim(stage),'_inf_mean = ', inf_mean,'" and '
+   write(*,*) '         "',trim(stage),'_inf_sd   = ', inf_sd,  '"     '
+   return
 endif
+ens_handle%copies(ss_inflate_index   , :) = prior_inf_mean
+ens_handle%copies(ss_inflate_sd_index, :) = prior_inf_sd
 
+write(my_stage,'(2A)') stage, '_inflation'
+write(my_base, '(A)')  'mean'
+write(my_desc, '(2A)') stage, ' inflation mean'
+call set_file_metadata(file_info_output,    &
+                       cnum     = 1,        &
+                       stage    = my_stage, &
+                       basename = my_base,  &
+                       desc     = my_desc)
 
-! Write posterior inflation files
-if (write_post_inf) then 
-   if (post_inf_mean == MISSING_R8 .or. post_inf_sd == MISSING_R8) then
-      write(*,*) 'you must specify both post_inf_mean and post_inf_sd values'
-      return