Switch allocatable to pointer in ecRAD derived types

driver/ecrad_driver.F90

@@ -381,6 +381,7 @@ program ecrad_driver
 #ifndef NO_OPENMP
   tstop = omp_get_wtime()
   write(nulout, '(a,g12.5,a)') 'Time elapsed in radiative transfer: ', tstop-tstart, ' seconds'
+  write(nulout, '(a,i0)') 'Columns/s : ', int((ncol*driver_config%nrepeat)/(tstop-tstart))
 #endif
 
   ! --------------------------------------------------------

driver/ecrad_driver_read_input.F90

@@ -84,8 +84,8 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
 
     ! Pressure and temperature (SI units) are on half-levels, i.e. of
     ! length (ncol,nlev+1)
-    call file%get('pressure_hl',   thermodynamics%pressure_hl)
-    call file%get('temperature_hl',thermodynamics%temperature_hl)
+    call file%get_ptr('pressure_hl',   thermodynamics%pressure_hl)
+    call file%get_ptr('temperature_hl',thermodynamics%temperature_hl)
 
     ! Extract array dimensions
     ncol = size(thermodynamics%pressure_hl,1)
@@ -135,7 +135,7 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
       end if
     else if (file%exists('cos_solar_zenith_angle')) then
       ! Single-level variables, all with dimensions (ncol)
-      call file%get('cos_solar_zenith_angle',single_level%cos_sza)
+      call file%get_ptr('cos_solar_zenith_angle',single_level%cos_sza)
     else if (.not. config%do_sw) then
       ! If cos_solar_zenith_angle not present and shortwave radiation
       ! not to be performed, we create an array of zeros as some gas
@@ -154,19 +154,19 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
       ! --------------------------------------------------------
 
       ! Read cloud descriptors with dimensions (ncol, nlev)
-      call file%get('cloud_fraction',cloud%fraction)
+      call file%get_ptr('cloud_fraction',cloud%fraction)
 
       ! Fractional standard deviation of in-cloud water content
       if (file%exists('fractional_std')) then
-        call file%get('fractional_std', cloud%fractional_std)
+        call file%get_ptr('fractional_std', cloud%fractional_std)
       end if
 
       ! Cloud water content and effective radius may be provided
       ! generically, in which case they have dimensions (ncol, nlev,
       ! ntype)
       if (file%exists('q_hydrometeor')) then
-        call file%get('q_hydrometeor',  cloud%mixing_ratio, ipermute=[2,1,3])     ! kg/kg
-        call file%get('re_hydrometeor', cloud%effective_radius, ipermute=[2,1,3]) ! m
+        call file%get_ptr('q_hydrometeor',  cloud%mixing_ratio, ipermute=[2,1,3])     ! kg/kg
+        call file%get_ptr('re_hydrometeor', cloud%effective_radius, ipermute=[2,1,3]) ! m
       else
         ! Ice and liquid properties provided in separate arrays
         allocate(cloud%mixing_ratio(ncol,nlev,2))
@@ -193,12 +193,12 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
       call single_level%init_seed_simple(1,ncol)
       ! Overwrite with user-specified values if available
       if (file%exists('iseed')) then
-        call file%get('iseed', single_level%iseed)
+        call file%get_ptr('iseed', single_level%iseed)
       end if
 
       ! Cloud overlap parameter
       if (file%exists('overlap_param')) then
-        call file%get('overlap_param', cloud%overlap_param)
+        call file%get_ptr('overlap_param', cloud%overlap_param)
       end if
 
       ! Optional scaling of liquid water mixing ratio
@@ -238,7 +238,7 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
         ! adjacent layers, stored in cloud%overlap_param
         call cloud%set_overlap_param(thermodynamics, &
              &    driver_config%overlap_decorr_length_override)
-      else if (.not. allocated(cloud%overlap_param)) then 
+      else if (.not. associated(cloud%overlap_param)) then 
         if (driver_config%iverbose >= 1) then
           write(nulout,'(a,g10.3,a)') 'Warning: overlap decorrelation length set to ', &
                &  decorr_length_default, ' m'
@@ -276,7 +276,7 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
         end if
         call cloud%create_fractional_std(ncol, nlev, &
              &  driver_config%fractional_std_override)
-      else if (.not. allocated(cloud%fractional_std)) then
+      else if (.not. associated(cloud%fractional_std)) then
         call cloud%create_fractional_std(ncol, nlev, 0.0_jprb)
         if (driver_config%iverbose >= 1) then
           write(nulout,'(a)') 'Warning: cloud optical depth fractional standard deviation set to zero'
@@ -357,12 +357,12 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
 
           is_cloud_size_scalable = .true.
 
-          call file%get('inv_cloud_effective_size', cloud%inv_cloud_effective_size)
+          call file%get_ptr('inv_cloud_effective_size', cloud%inv_cloud_effective_size)
           ! For finer control we can specify the effective size for
           ! in-cloud inhomogeneities as well
           if (file%exists('inv_inhom_effective_size')) then
             if (.not. driver_config%do_ignore_inhom_effective_size) then
-              call file%get('inv_inhom_effective_size', cloud%inv_inhom_effective_size)
+              call file%get_ptr('inv_inhom_effective_size', cloud%inv_inhom_effective_size)
             else
               if (driver_config%iverbose >= 1) then
                 write(nulout,'(a)') 'Ignoring inv_inhom_effective_size so treated as equal to inv_cloud_effective_size'
@@ -445,7 +445,7 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
           ! Scale cloud effective size
           cloud%inv_cloud_effective_size = cloud%inv_cloud_effective_size &
                &                         / driver_config%effective_size_scaling
-          if (allocated(cloud%inv_inhom_effective_size)) then
+          if (associated(cloud%inv_inhom_effective_size)) then
             if (driver_config%iverbose >= 2) then
               write(nulout, '(a,g10.3)') '  Scaling effective size of clouds and their inhomogeneities with ', &
                    &                           driver_config%effective_size_scaling
@@ -472,7 +472,7 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
 
     ! Single-level variable with dimensions (ncol)
     if (file%exists('skin_temperature')) then
-      call file%get('skin_temperature',single_level%skin_temperature) ! K
+      call file%get_ptr('skin_temperature',single_level%skin_temperature) ! K
     else
       allocate(single_level%skin_temperature(ncol))
       single_level%skin_temperature(1:ncol) = thermodynamics%temperature_hl(1:ncol,nlev+1)
@@ -499,14 +499,14 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
         ! ...but if in the NetCDF file it has only dimension (ncol), in
         ! order that nalbedobands is correctly set to 1, we need to turn
         ! off transposition
-        call file%get('sw_albedo',    single_level%sw_albedo, do_transp=.false.)
+        call file%get_ptr('sw_albedo',    single_level%sw_albedo, do_transp=.false.)
         if (file%exists('sw_albedo_direct')) then
-          call file%get('sw_albedo_direct', single_level%sw_albedo_direct, do_transp=.false.)
+          call file%get_ptr('sw_albedo_direct', single_level%sw_albedo_direct, do_transp=.false.)
         end if
       else
-        call file%get('sw_albedo',    single_level%sw_albedo, do_transp=.true.)
+        call file%get_ptr('sw_albedo',    single_level%sw_albedo, do_transp=.true.)
         if (file%exists('sw_albedo_direct')) then
-          call file%get('sw_albedo_direct', single_level%sw_albedo_direct, do_transp=.true.)
+          call file%get_ptr('sw_albedo_direct', single_level%sw_albedo_direct, do_transp=.true.)
         end if
       end if
     end if
@@ -522,9 +522,9 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
       end if
     else
       if (file%get_rank('lw_emissivity') == 1) then
-        call file%get('lw_emissivity',single_level%lw_emissivity, do_transp=.false.)
+        call file%get_ptr('lw_emissivity',single_level%lw_emissivity, do_transp=.false.)
       else
-        call file%get('lw_emissivity',single_level%lw_emissivity, do_transp=.true.)
+        call file%get_ptr('lw_emissivity',single_level%lw_emissivity, do_transp=.true.)
       end if
     end if
 
@@ -543,7 +543,7 @@ subroutine read_input(file, config, driver_config, ncol, nlev, &
 
     if (config%use_aerosols) then
       ! Load aerosol data
-      call file%get('aerosol_mmr', aerosol%mixing_ratio, ipermute=[2,3,1]);
+      call file%get_ptr('aerosol_mmr', aerosol%mixing_ratio, ipermute=[2,3,1]);
       ! Store aerosol level bounds
       aerosol%istartlev = lbound(aerosol%mixing_ratio, 2)
       aerosol%iendlev   = ubound(aerosol%mixing_ratio, 2)

driver/ecrad_ifs_driver.F90

@@ -322,21 +322,21 @@ program ecrad_ifs_driver
   call flux%allocate(yradiation%rad_config, 1, ncol, nlev)
 
   ! set relevant fluxes to zero
-  if(allocated(flux%lw_up)) flux%lw_up(:,:) = 0._jprb
-  if(allocated(flux%lw_dn)) flux%lw_dn(:,:) = 0._jprb
-  if(allocated(flux%sw_up)) flux%sw_up(:,:) = 0._jprb
-  if(allocated(flux%sw_dn)) flux%sw_dn(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_direct)) flux%sw_dn_direct(:,:) = 0._jprb
-  if(allocated(flux%lw_up_clear)) flux%lw_up_clear(:,:) = 0._jprb
-  if(allocated(flux%lw_dn_clear)) flux%lw_dn_clear(:,:) = 0._jprb
-  if(allocated(flux%sw_up_clear)) flux%sw_up_clear(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_clear)) flux%sw_dn_clear(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_direct_clear)) flux%sw_dn_direct_clear(:,:) = 0._jprb
-
-  if(allocated(flux%lw_dn_surf_canopy)) flux%lw_dn_surf_canopy(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_diffuse_surf_canopy)) flux%sw_dn_diffuse_surf_canopy(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_direct_surf_canopy)) flux%sw_dn_direct_surf_canopy(:,:) = 0._jprb
-  if(allocated(flux%lw_derivatives)) flux%lw_derivatives(:,:) = 0._jprb
+  if(associated(flux%lw_up)) flux%lw_up(:,:) = 0._jprb
+  if(associated(flux%lw_dn)) flux%lw_dn(:,:) = 0._jprb
+  if(associated(flux%sw_up)) flux%sw_up(:,:) = 0._jprb
+  if(associated(flux%sw_dn)) flux%sw_dn(:,:) = 0._jprb
+  if(associated(flux%sw_dn_direct)) flux%sw_dn_direct(:,:) = 0._jprb
+  if(associated(flux%lw_up_clear)) flux%lw_up_clear(:,:) = 0._jprb
+  if(associated(flux%lw_dn_clear)) flux%lw_dn_clear(:,:) = 0._jprb
+  if(associated(flux%sw_up_clear)) flux%sw_up_clear(:,:) = 0._jprb
+  if(associated(flux%sw_dn_clear)) flux%sw_dn_clear(:,:) = 0._jprb
+  if(associated(flux%sw_dn_direct_clear)) flux%sw_dn_direct_clear(:,:) = 0._jprb
+
+  if(associated(flux%lw_dn_surf_canopy)) flux%lw_dn_surf_canopy(:,:) = 0._jprb
+  if(associated(flux%sw_dn_diffuse_surf_canopy)) flux%sw_dn_diffuse_surf_canopy(:,:) = 0._jprb
+  if(associated(flux%sw_dn_direct_surf_canopy)) flux%sw_dn_direct_surf_canopy(:,:) = 0._jprb
+  if(associated(flux%lw_derivatives)) flux%lw_derivatives(:,:) = 0._jprb
 
   ! Allocate memory for additional arrays
   allocate(ccn_land(ncol))
@@ -380,7 +380,7 @@ program ecrad_ifs_driver
     cloud_q_ice = 0.0_jprb
   end if
 
-  if (allocated(aerosol%mixing_ratio)) then
+  if (associated(aerosol%mixing_ratio)) then
     aerosol_mixing_ratio => aerosol%mixing_ratio
   end if
 
@@ -492,6 +492,7 @@ program ecrad_ifs_driver
 #ifndef NO_OPENMP
   tstop = omp_get_wtime()
   write(nulout, '(a,g12.5,a)') 'Time elapsed in radiative transfer: ', tstop-tstart, ' seconds'
+  write(nulout, '(a,i0)') 'Columns/s : ', int((ncol*driver_config%nrepeat)/(tstop-tstart))
 #endif
 
   ! --------------------------------------------------------

driver/ecrad_ifs_driver_blocked.F90

@@ -324,21 +324,21 @@ program ecrad_ifs_driver
   call flux%allocate(yradiation%rad_config, 1, ncol, nlev)
 
   ! set relevant fluxes to zero
-  if(allocated(flux%lw_up)) flux%lw_up(:,:) = 0._jprb
-  if(allocated(flux%lw_dn)) flux%lw_dn(:,:) = 0._jprb
-  if(allocated(flux%sw_up)) flux%sw_up(:,:) = 0._jprb
-  if(allocated(flux%sw_dn)) flux%sw_dn(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_direct)) flux%sw_dn_direct(:,:) = 0._jprb
-  if(allocated(flux%lw_up_clear)) flux%lw_up_clear(:,:) = 0._jprb
-  if(allocated(flux%lw_dn_clear)) flux%lw_dn_clear(:,:) = 0._jprb
-  if(allocated(flux%sw_up_clear)) flux%sw_up_clear(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_clear)) flux%sw_dn_clear(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_direct_clear)) flux%sw_dn_direct_clear(:,:) = 0._jprb
-
-  if(allocated(flux%lw_dn_surf_canopy)) flux%lw_dn_surf_canopy(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_diffuse_surf_canopy)) flux%sw_dn_diffuse_surf_canopy(:,:) = 0._jprb
-  if(allocated(flux%sw_dn_direct_surf_canopy)) flux%sw_dn_direct_surf_canopy(:,:) = 0._jprb
-  if(allocated(flux%lw_derivatives)) flux%lw_derivatives(:,:) = 0._jprb
+  if(associated(flux%lw_up)) flux%lw_up(:,:) = 0._jprb
+  if(associated(flux%lw_dn)) flux%lw_dn(:,:) = 0._jprb
+  if(associated(flux%sw_up)) flux%sw_up(:,:) = 0._jprb
+  if(associated(flux%sw_dn)) flux%sw_dn(:,:) = 0._jprb
+  if(associated(flux%sw_dn_direct)) flux%sw_dn_direct(:,:) = 0._jprb
+  if(associated(flux%lw_up_clear)) flux%lw_up_clear(:,:) = 0._jprb
+  if(associated(flux%lw_dn_clear)) flux%lw_dn_clear(:,:) = 0._jprb
+  if(associated(flux%sw_up_clear)) flux%sw_up_clear(:,:) = 0._jprb
+  if(associated(flux%sw_dn_clear)) flux%sw_dn_clear(:,:) = 0._jprb
+  if(associated(flux%sw_dn_direct_clear)) flux%sw_dn_direct_clear(:,:) = 0._jprb
+
+  if(associated(flux%lw_dn_surf_canopy)) flux%lw_dn_surf_canopy(:,:) = 0._jprb
+  if(associated(flux%sw_dn_diffuse_surf_canopy)) flux%sw_dn_diffuse_surf_canopy(:,:) = 0._jprb
+  if(associated(flux%sw_dn_direct_surf_canopy)) flux%sw_dn_direct_surf_canopy(:,:) = 0._jprb
+  if(associated(flux%lw_derivatives)) flux%lw_derivatives(:,:) = 0._jprb
 
   ! Allocate memory for additional arrays
   allocate(ccn_land(ncol))
@@ -472,6 +472,7 @@ program ecrad_ifs_driver
 #ifndef NO_OPENMP
   tstop = omp_get_wtime()
   write(nulout, '(a,g12.5,a)') 'Time elapsed in radiative transfer: ', tstop-tstart, ' seconds'
+  write(nulout, '(a,i0)') 'Columns/s : ', int((ncol*driver_config%nrepeat)/(tstop-tstart))
 #endif
 
   ! --------------------------------------------------------
@@ -529,6 +530,14 @@ program ecrad_ifs_driver
     write(nulout,'(a)') '------------------------------------------------------------------------------------'
   end if
 
+  ! Clean up temporary derived types
+  call single_level%deallocate()
+  call thermodynamics%deallocate()
+  call gas%deallocate()
+  call cloud%deallocate()
+  call aerosol%deallocate()
+  call flux%deallocate()
+
   ! Finalise MPI if not done yet
 #ifdef HAVE_FIAT
   call mpl_end(ldmeminfo=.false.)

driver/ifs_blocking.F90

@@ -389,7 +389,7 @@ subroutine ifs_copy_inputs_to_blocked ( &
         zrgp(1:il,ifs_config%iald+jalb-1,ib)  =  single_level%sw_albedo(ibeg:iend,jalb)
       enddo
 
-      if (allocated(single_level%sw_albedo_direct)) then
+      if (associated(single_level%sw_albedo_direct)) then
         do jalb=1,yderad%nsw
           zrgp(1:il,ifs_config%ialp+jalb-1,ib)  =  single_level%sw_albedo_direct(ibeg:iend,jalb)
         end do

radiation/radiation_aerosol.F90

@@ -31,15 +31,15 @@ module radiation_aerosol
      ! (ncol,istartlev:iendlev,config%n_aerosol_types), where ncol is
      ! the number of columns, istartlev:iendlev is the range of model
      ! levels where aerosols are present
-     real(jprb), allocatable, dimension(:,:,:) :: &
-          &  mixing_ratio  ! mass mixing ratio (kg/kg)
+     real(jprb), pointer, dimension(:,:,:) :: &
+          &  mixing_ratio=>null()  ! mass mixing ratio (kg/kg)
 
      ! Alternatively, if is_direct=true, the optical properties are
      ! provided directly and are dimensioned
      ! (nband,istartlev:iendlev,ncol)
-     real(jprb), allocatable, dimension(:,:,:) :: &
-          &  od_sw, ssa_sw, g_sw, & ! Shortwave optical properties
-          &  od_lw, ssa_lw, g_lw    ! Longwave optical properties
+     real(jprb), pointer, dimension(:,:,:) :: &
+          &  od_sw=>null(), ssa_sw=>null(), g_sw=>null(), & ! Shortwave optical properties
+          &  od_lw=>null(), ssa_lw=>null(), g_lw=>null()    ! Longwave optical properties
 
      ! Range of levels in which the aerosol properties are provided
      integer :: istartlev, iendlev
@@ -59,7 +59,7 @@ module radiation_aerosol
 
   !---------------------------------------------------------------------
   ! Allocate array for describing aerosols, although in the offline
-  ! code these are allocated when they are read from the NetCDF file
+  ! code these are associated when they are read from the NetCDF file
   subroutine allocate_aerosol_arrays(this, ncol, istartlev, iendlev, ntype)
 
     use yomhook,     only : lhook, dr_hook, jphook
@@ -138,13 +138,34 @@ subroutine deallocate_aerosol_arrays(this)
 
     if (lhook) call dr_hook('radiation_aerosol:deallocate',0,hook_handle)
 
-    if (allocated(this%mixing_ratio)) deallocate(this%mixing_ratio)
-    if (allocated(this%od_sw))        deallocate(this%od_sw)
-    if (allocated(this%ssa_sw))       deallocate(this%ssa_sw)
-    if (allocated(this%g_sw))         deallocate(this%g_sw)
-    if (allocated(this%od_lw))        deallocate(this%od_lw)
-    if (allocated(this%ssa_lw))       deallocate(this%ssa_lw)
-    if (allocated(this%g_lw))         deallocate(this%g_lw)
+    if (associated(this%mixing_ratio)) then
+      deallocate(this%mixing_ratio)
+      this%mixing_ratio=>null()
+    end if
+    if (associated(this%od_sw)) then
+      deallocate(this%od_sw)
+      this%od_sw=>null()
+    end if
+    if (associated(this%ssa_sw)) then
+      deallocate(this%ssa_sw)
+      this%ssa_sw=>null()
+    end if
+    if (associated(this%g_sw)) then
+      deallocate(this%g_sw)
+      this%g_sw=>null()
+    end if
+    if (associated(this%od_lw)) then
+      deallocate(this%od_lw)
+      this%od_lw=>null()
+    end if
+    if (associated(this%ssa_lw)) then
+      deallocate(this%ssa_lw)
+      this%ssa_lw=>null()
+    end if
+    if (associated(this%g_lw)) then
+      deallocate(this%g_lw)
+      this%g_lw=>null()
+    end if
 
     if (lhook) call dr_hook('radiation_aerosol:deallocate',1,hook_handle)