Merge of diagnostics branch into trunk

git-svn-id: https://code.metoffice.gov.uk/svn/monc/main/trunk@271 0f676ef4-b20c-4647-9485-21614760d15f
Leeds-MONC · Nov 11, 2015 · 655a939 · 655a939
1 parent b59e865
commit 655a939
Show file tree

Hide file tree

Showing 48 changed files with 3,577 additions and 1,339 deletions.
diff --git a/components/cfltest/src/cfltest.F90 b/components/cfltest/src/cfltest.F90
@@ -54,7 +54,7 @@ end subroutine initialisation_callback
   subroutine timestep_callback(current_state)
     type(model_state_type), intent(inout), target :: current_state
 
-    real(kind=DEFAULT_PRECISION) :: cfl_number, zumin, zumax, zvmin, zvmax, abswmax
+    real(kind=DEFAULT_PRECISION) :: cfl_number
 
     if (mod(current_state%timestep, current_state%cfl_frequency) == 1 .or. &
          current_state%timestep-current_state%start_timestep .le. current_state%cfl_frequency) then

diff --git a/components/checkpointer/src/checkpointcommon.F90 b/components/checkpointer/src/checkpointcommon.F90
@@ -11,7 +11,7 @@ module checkpointer_common_mod
   character(len=*), parameter ::  X_DIM_KEY = "x_size", &                 !< X dimension/variable key
                                   Y_DIM_KEY="y_size", &                   !< Y dimension/variable key
                                   Z_DIM_KEY="z_size", &                   !< Z dimension/variable key
-				  Q_DIM_KEY="q_size",&
+                                  Q_DIM_KEY="q_size", &
                                   U_KEY = "u", &                          !< U variable NetCDF key
                                   V_KEY = "v", &                          !< V variable NetCDF key
                                   W_KEY = "w", &                          !< W variable NetCDF key

diff --git a/components/diffusion/src/diffusion.F90 b/components/diffusion/src/diffusion.F90
@@ -10,7 +10,7 @@ module diffusion_mod
   use halo_communication_mod, only : copy_buffer_to_field, perform_local_data_copy_for_field, complete_nonblocking_halo_swap, &
        copy_buffer_to_corner
   use registry_mod, only : is_component_enabled
-  use logging_mod, only : LOG_ERROR, log_master_log
+  use logging_mod, only : LOG_ERROR, LOG_WARN, log_master_log
   implicit none
 
 #ifndef TEST_MODE
@@ -93,6 +93,10 @@ subroutine initialisation_callback(current_state)
     allocate(th_diffusion(z_size))
     allocate(q_diffusion(z_size, current_state%number_q_fields))
 
+    if (.not. current_state%use_viscosity_and_diffusion) then
+      call log_master_log(LOG_WARN, &
+           "You have enabled the diffusion component, but use viscosity and diffusion is false in the configuration")
+    end if
   end subroutine initialisation_callback
 
   subroutine finalisation_callback(current_state)

diff --git a/components/fftsolver/src/pencilfft.F90 b/components/fftsolver/src/pencilfft.F90
@@ -728,7 +728,7 @@ subroutine convert_real_to_complex(real_data, complex_data)
 
     integer :: i, j, k
 
-    complex_data=cmplx(0.0d0, 0.0d0)
+    complex_data=cmplx(0.0d0, 0.0d0, kind=C_DOUBLE_COMPLEX)
 
     do i=1,size(real_data,3)
       do j=1,size(real_data,2)

diff --git a/components/flux_budget/src/flux_budget.F90 b/components/flux_budget/src/flux_budget.F90
@@ -1,8 +1,8 @@
 !> Flux budget component which produces diagnostic data for the flux aspects of the model
 module flux_budget_mod
   use datadefn_mod, only : DEFAULT_PRECISION
-  use collections_mod, only : hashmap_type, c_contains, c_put, c_size, c_key_at, c_get
-  use conversions_mod, only : conv_to_generic, conv_to_logical
+  use collections_mod, only : hashmap_type, mapentry_type, iterator_type, c_contains, c_put_logical, c_size, c_get_logical, &
+       c_get_iterator, c_has_next, c_next_mapentry
   use monc_component_mod, only : COMPONENT_ARRAY_FIELD_TYPE, COMPONENT_DOUBLE_DATA_TYPE, component_descriptor_type, &
        component_field_value_type, component_field_information_type
   use optionsdatabase_mod, only : options_get_real, options_get_integer
@@ -44,7 +44,9 @@ module flux_budget_mod
   !> Provides the descriptor back to the caller and is used in component registration
   !! @returns The flux budget component descriptor
   type(component_descriptor_type) function flux_budget_get_descriptor()
-    integer :: total_number_published_fields, i, current_index
+    type(iterator_type) :: iterator
+    type(mapentry_type) :: mapentry
+    integer :: current_index, total_number_published_fields
 
     flux_budget_get_descriptor%name="flux_budget"
     flux_budget_get_descriptor%version=0.1
@@ -60,36 +62,52 @@ type(component_descriptor_type) function flux_budget_get_descriptor()
     allocate(flux_budget_get_descriptor%published_fields(total_number_published_fields))
 
     current_index=1
-    do i=1, c_size(heat_flux_fields)
-      flux_budget_get_descriptor%published_fields(current_index)=c_key_at(heat_flux_fields, i)
+    iterator=c_get_iterator(heat_flux_fields)
+    do while (c_has_next(iterator))
+      mapentry=c_next_mapentry(iterator)
+      flux_budget_get_descriptor%published_fields(current_index)=mapentry%key
       current_index=current_index+1
-    end do
-    do i=1, c_size(q_flux_fields)
-      flux_budget_get_descriptor%published_fields(current_index)=c_key_at(q_flux_fields, i)
+    end do    
+    iterator=c_get_iterator(q_flux_fields)
+    do while (c_has_next(iterator))
+      mapentry=c_next_mapentry(iterator)
+      flux_budget_get_descriptor%published_fields(current_index)=mapentry%key
       current_index=current_index+1
-    end do
-    do i=1, c_size(uw_vw_fields)
-      flux_budget_get_descriptor%published_fields(current_index)=c_key_at(uw_vw_fields, i)
+    end do  
+    iterator=c_get_iterator(uw_vw_fields)
+    do while (c_has_next(iterator))
+      mapentry=c_next_mapentry(iterator)
+      flux_budget_get_descriptor%published_fields(current_index)=mapentry%key
       current_index=current_index+1
-    end do
-    do i=1, c_size(prognostic_budget_fields)
-      flux_budget_get_descriptor%published_fields(current_index)=c_key_at(prognostic_budget_fields, i)
+    end do  
+    iterator=c_get_iterator(prognostic_budget_fields)
+    do while (c_has_next(iterator))
+      mapentry=c_next_mapentry(iterator)
+      flux_budget_get_descriptor%published_fields(current_index)=mapentry%key
       current_index=current_index+1
-    end do
-    do i=1, c_size(thetal_fields)
-      flux_budget_get_descriptor%published_fields(current_index)=c_key_at(thetal_fields, i)
+    end do  
+    iterator=c_get_iterator(thetal_fields)
+    do while (c_has_next(iterator))
+      mapentry=c_next_mapentry(iterator)
+      flux_budget_get_descriptor%published_fields(current_index)=mapentry%key
       current_index=current_index+1
-    end do
-    do i=1, c_size(mse_fields)
-      flux_budget_get_descriptor%published_fields(current_index)=c_key_at(mse_fields, i)
+    end do  
+    iterator=c_get_iterator(mse_fields)
+    do while (c_has_next(iterator))
+      mapentry=c_next_mapentry(iterator)
+      flux_budget_get_descriptor%published_fields(current_index)=mapentry%key
       current_index=current_index+1
-    end do
-    do i=1, c_size(qt_fields)
-      flux_budget_get_descriptor%published_fields(current_index)=c_key_at(qt_fields, i)
+    end do  
+    iterator=c_get_iterator(qt_fields)
+    do while (c_has_next(iterator))
+      mapentry=c_next_mapentry(iterator)
+      flux_budget_get_descriptor%published_fields(current_index)=mapentry%key
       current_index=current_index+1
-    end do
-    do i=1, c_size(scalar_fields)
-      flux_budget_get_descriptor%published_fields(current_index)=c_key_at(scalar_fields, i)
+    end do 
+    iterator=c_get_iterator(scalar_fields)
+    do while (c_has_next(iterator))
+      mapentry=c_next_mapentry(iterator)
+      flux_budget_get_descriptor%published_fields(current_index)=mapentry%key
       current_index=current_index+1
     end do    
   end function flux_budget_get_descriptor 
@@ -2090,8 +2108,6 @@ subroutine set_published_field_value(field_value, real_1d_field, real_2d_field)
     real(kind=DEFAULT_PRECISION), dimension(:), optional :: real_1d_field
     real(kind=DEFAULT_PRECISION), dimension(:,:), optional :: real_2d_field
 
-    integer :: n
-
     if (present(real_1d_field)) then
       allocate(field_value%real_1d_array(size(real_1d_field)), source=real_1d_field)
     else if (present(real_2d_field)) then
@@ -2107,11 +2123,8 @@ subroutine set_published_field_enabled_state(collection, field_name, enabled_sta
     type(hashmap_type), intent(inout) :: collection
     character(len=*), intent(in) :: field_name
     logical, intent(in) :: enabled_state
-
-    class(*), pointer :: generic
-    generic=>conv_to_generic(enabled_state, .true.)
 
-    call c_put(collection, field_name, generic)
+    call c_put_logical(collection, field_name, enabled_state)
   end subroutine set_published_field_enabled_state
 
   !> Retrieves whether a published field is enabled or not
@@ -2122,8 +2135,6 @@ logical function get_published_field_enabled_state(collection, field_name)
     type(hashmap_type), intent(inout) :: collection
     character(len=*), intent(in) :: field_name
 
-    class(*), pointer :: generic
-    generic=>c_get(collection, field_name)
-    get_published_field_enabled_state=conv_to_logical(generic, .false.)
+    get_published_field_enabled_state=c_get_logical(collection, field_name)
   end function get_published_field_enabled_state
 end module flux_budget_mod
diff --git a/components/forcing/src/forcing.F90 b/components/forcing/src/forcing.F90
@@ -220,10 +220,9 @@ end subroutine field_value_retrieval_callback
   subroutine init_callback(current_state)
     type(model_state_type), target, intent(inout) :: current_state
 
-    integer :: nq_subs  ! The number of q fields apply subsidence term to
     integer :: nq_force ! The number of q fields apply large-scale time-independent forcing
     integer :: nzq      ! The number of input levels for subsidence/divergence profile
-    integer :: i,j,k,n  ! loop counters
+    integer :: i,n  ! loop counters
     integer :: iq       ! temporary q varible index
 
     ! Input arrays for subsidence profile
@@ -575,7 +574,6 @@ subroutine apply_time_independent_forcing_to_theta(current_state)
 
     integer :: k
     real(kind=DEFAULT_PRECISION) :: dtm_scale
-    real(kind=DEFAULT_PRECISION) :: delta
 
     if (constant_forcing_type_theta==TENDENCY)then
       dtm_scale=current_state%dtm
@@ -606,8 +604,6 @@ subroutine apply_time_independent_forcing_to_q(current_state)
 
     integer :: n, k
     real(kind=DEFAULT_PRECISION) :: dtm_scale
-    real(kind=DEFAULT_PRECISION) :: delta
-
 
     do n=1,current_state%number_q_fields
       if (current_state%l_forceq(n))then
@@ -641,7 +637,6 @@ subroutine apply_time_independent_forcing_to_u(current_state)
 
     integer :: k
     real(kind=DEFAULT_PRECISION) :: dtm_scale
-    real(kind=DEFAULT_PRECISION) :: delta
 
     if (constant_forcing_type_u==TENDENCY)then
       dtm_scale=current_state%dtm
@@ -671,7 +666,6 @@ subroutine apply_time_independent_forcing_to_v(current_state)
 
     integer :: k
     real(kind=DEFAULT_PRECISION) :: dtm_scale
-    real(kind=DEFAULT_PRECISION) :: delta
 
     if (constant_forcing_type_v==TENDENCY)then
       dtm_scale=current_state%dtm

diff --git a/components/gridmanager/src/gridmanager.F90 b/components/gridmanager/src/gridmanager.F90
@@ -518,7 +518,7 @@ subroutine new_vertical_grid_setup(vertical_grid, kgd, kkp, zztop)
 
     real(kind=DEFAULT_PRECISION) :: a(2*kkp), r1, d1, dd, d0, a0
     logical :: first_gt=.true.
-    integer :: k, n, k0
+    integer :: k, k0
 
     r1=1.10_DEFAULT_PRECISION
     d1=10.0_DEFAULT_PRECISION
@@ -654,8 +654,6 @@ end subroutine initialise_horizontalgrid_configuration_types
   !! @param current_state The current model state
   subroutine set_anelastic_pressure(current_state)
     type(model_state_type), intent(inout) :: current_state
-
-    integer :: k
 
     if (current_state%use_anelastic_equations) then
       call compute_anelastic_pressure_profile_and_density(current_state)
@@ -679,7 +677,6 @@ subroutine compute_anelastic_pressure_profile_only(current_state)
     integer :: ipass, k
     real(kind=DEFAULT_PRECISION) ::    p0    &!pressure at z=0 adjustments made after 1st iteration so P0=PSF after 2nd iteration
         ,   ptop  &!pressure at z=ZN(KKP)
-        ,   thfactor & !factor for multiplying TH profile (if IADJANELP=2)
         , thprof(current_state%local_grid%size(Z_INDEX))