From fcdc66f15d188b42d59a99cad2861a8552549438 Mon Sep 17 00:00:00 2001 From: Timothy Brown Date: Fri, 1 Sep 2017 18:59:23 -0600 Subject: [PATCH] Bugfix. Bugfix to update the IPD driver cap to use the CCPP without crashing. --- IPD_layer/IPD_driver_cap.f90 | 54 +++++++++++++++++++++++++++--------- 1 file changed, 41 insertions(+), 13 deletions(-) diff --git a/IPD_layer/IPD_driver_cap.f90 b/IPD_layer/IPD_driver_cap.f90 index 6eacc641b..a4174caee 100644 --- a/IPD_layer/IPD_driver_cap.f90 +++ b/IPD_layer/IPD_driver_cap.f90 @@ -37,6 +37,8 @@ module IPD_driver_cap IPD_radiation_step, & IPD_physics_step1, & IPD_physics_step2 + use :: namelist_soilveg, & + only: salp_data, snupx, max_vegtyp implicit none private @@ -60,7 +62,9 @@ subroutine ipd_initialize_cap(ptr) bind(c) type(IPD_diag_type), pointer :: IPD_Diag(:) => null() type(IPD_restart_type), pointer :: IPD_Restart => null() type(IPD_init_type), pointer :: Init_parm => null() - type(c_ptr), pointer :: tmp => null() + type(c_ptr) :: tmp + real, pointer :: l_snupx(:) => null() + real, pointer :: l_salp_data => null() call c_f_pointer(ptr, cdata) @@ -103,11 +107,17 @@ subroutine ipd_initialize_cap(ptr) bind(c) deallocate(dims) end if + call ccpp_fields_get(cdata, 'salp_data', l_salp_data, ierr) + call ccpp_fields_get(cdata, 'snupx', l_snupx, ierr) + call IPD_initialize(IPD_Control=IPD_Control, & IPD_Data=IPD_Data, & IPD_Diag=IPD_Diag, & IPD_Restart=IPD_Restart, & IPD_init_parm=Init_parm) + + l_snupx = snupx + l_salp_data = salp_data end subroutine ipd_initialize_cap subroutine ipd_setup_step_cap(ptr) bind(c) @@ -121,7 +131,7 @@ subroutine ipd_setup_step_cap(ptr) bind(c) type(IPD_data_type), pointer :: IPD_Data(:) => null() type(IPD_diag_type), pointer :: IPD_Diag(:) => null() type(IPD_restart_type), pointer :: IPD_Restart => null() - type(c_ptr), pointer :: tmp => null() + type(c_ptr) :: tmp call c_f_pointer(ptr, cdata) @@ -175,11 +185,17 @@ subroutine ipd_radiation_step_cap(ptr) bind(c) type(IPD_data_type), pointer :: IPD_Data(:) => null() type(IPD_diag_type), pointer :: IPD_Diag(:) => null() type(IPD_restart_type), pointer :: IPD_Restart => null() - integer, pointer :: nblks => null() - type(c_ptr), pointer :: tmp => null() + integer, pointer :: nblks + type(c_ptr) :: tmp call c_f_pointer(ptr, cdata) + call ccpp_fields_get(cdata, 'nblks', nblks, ierr) + if (ierr /= 0) then + call ccpp_error('Unable to retrieve nblks') + return + end if + call ccpp_fields_get(cdata, 'IPD_Control', tmp, ierr) if (ierr /= 0) then call ccpp_error('Unable to retrieve IPD_Control') @@ -192,7 +208,7 @@ subroutine ipd_radiation_step_cap(ptr) bind(c) call ccpp_error('Unable to retrieve IPD_Data') return end if - call c_f_pointer(tmp, IPD_Data) + call c_f_pointer(tmp, IPD_Data, [nblks]) call ccpp_fields_get(cdata, 'IPD_Diag', tmp, ierr) if (ierr /= 0) then @@ -238,12 +254,18 @@ subroutine ipd_physics_step1_cap(ptr) bind(c) type(IPD_data_type), pointer :: IPD_Data(:) => null() type(IPD_diag_type), pointer :: IPD_Diag(:) => null() type(IPD_restart_type), pointer :: IPD_Restart => null() - integer, pointer :: nblks => null() - type(c_ptr), pointer :: tmp => null() + integer, pointer :: nblks + type(c_ptr) :: tmp call c_f_pointer(ptr, cdata) - call ccpp_fields_get_ptr(cdata, 'IPD_Control', tmp, ierr) + call ccpp_fields_get(cdata, 'nblks', nblks, ierr) + if (ierr /= 0) then + call ccpp_error('Unable to retrieve nblks') + return + end if + + call ccpp_fields_get(cdata, 'IPD_Control', tmp, ierr) if (ierr /= 0) then call ccpp_error('Unable to retrieve IPD_Control') return @@ -255,7 +277,7 @@ subroutine ipd_physics_step1_cap(ptr) bind(c) call ccpp_error('Unable to retrieve IPD_Data') return end if - call c_f_pointer(tmp, IPD_Data, dims) + call c_f_pointer(tmp, IPD_Data, [nblks]) call ccpp_fields_get(cdata, 'IPD_Diag', tmp, ierr, dims=dims) if (ierr /= 0) then @@ -301,12 +323,18 @@ subroutine ipd_physics_step2_cap(ptr) bind(c) type(IPD_data_type), pointer :: IPD_Data(:) => null() type(IPD_diag_type), pointer :: IPD_Diag(:) => null() type(IPD_restart_type), pointer :: IPD_Restart => null() - integer, pointer :: nblks => null() - type(c_ptr), pointer :: tmp => null() + integer, pointer :: nblks + type(c_ptr) :: tmp call c_f_pointer(ptr, cdata) - call ccpp_fields_get_ptr(cdata, 'IPD_Control', tmp, ierr) + call ccpp_fields_get(cdata, 'nblks', nblks, ierr) + if (ierr /= 0) then + call ccpp_error('Unable to retrieve nblks') + return + end if + + call ccpp_fields_get(cdata, 'IPD_Control', tmp, ierr) if (ierr /= 0) then call ccpp_error('Unable to retrieve IPD_Control') return @@ -318,7 +346,7 @@ subroutine ipd_physics_step2_cap(ptr) bind(c) call ccpp_error('Unable to retrieve IPD_Data') return end if - call c_f_pointer(tmp, IPD_Data, dims) + call c_f_pointer(tmp, IPD_Data, [nblks]) call ccpp_fields_get(cdata, 'IPD_Diag', tmp, ierr, dims=dims) if (ierr /= 0) then