From 4734c0455efe24f7cd61148dd66ecdb99fe11a2d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 11 Apr 2018 14:33:54 +0200 Subject: [PATCH 1/5] Necessary modifications for comment lines exceeding 250 characters for PGI compiler --- physics/mfpbl.f | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/physics/mfpbl.f b/physics/mfpbl.f index feec08dda..3e66acfb3 100644 --- a/physics/mfpbl.f +++ b/physics/mfpbl.f @@ -4,7 +4,13 @@ !> \ingroup GFS_edmf_main !! \brief This subroutine is used for calculating the mass flux and updraft properties. !! -!! The mfpbl routines works as follows: if the PBL is convective, first, the ascending parcel entrainment rate is calculated as a function of height. Next, a surface parcel is initiated according to surface layer properties and the updraft buoyancy is calculated as a function of height. Next, using the buoyancy and entrainment values, the parcel vertical velocity is calculated using a well known steady-state budget equation. With the profile of updraft vertical velocity, the PBL height is recalculated as the height where the updraft vertical velocity returns to 0, and the entrainment profile is updated with the new PBL height. Finally, the mass flux profile is calculated using the updraft vertical velocity and assumed updraft fraction and the updraft properties are calculated using the updated entrainment profile, surface values, and environmental profiles. +!! The mfpbl routines works as follows: if the PBL is convective, first, the ascending parcel entrainment rate is calculated as a +!! function of height. Next, a surface parcel is initiated according to surface layer properties and the updraft buoyancy is calculated +!! as a function of height. Next, using the buoyancy and entrainment values, the parcel vertical velocity is calculated using a well +!! known steady-state budget equation. With the profile of updraft vertical velocity, the PBL height is recalculated as the height +!! where the updraft vertical velocity returns to 0, and the entrainment profile is updated with the new PBL height. Finally, the mass +!! flux profile is calculated using the updraft vertical velocity and assumed updraft fraction and the updraft properties are calculated +!! using the updated entrainment profile, surface values, and environmental profiles. !! \param[in] im integer, number of used points !! \param[in] ix integer, horizontal dimension !! \param[in] km integer, vertical layer dimension From 1ee04e3edda04073d53f84760fd42076af833c76 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 11 Apr 2018 14:34:15 +0200 Subject: [PATCH 2/5] Add support for PGI compiler to CMakeLists.txt files, run pgifix.py on physics caps object files --- CMakeLists.txt | 34 +++++++++++++++++++++++++++------- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 6b1914cb8..c865732b5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -166,6 +166,9 @@ set(SOURCES ./physics/precpd.f ./physics/GFS_calpreciptype.f90 ./physics/GFS_MP_generic_post.f90 +) + +set(CAPS ./physics/cnvc90_cap.F90 ./physics/lsm_noah_pre_cap.F90 ./physics/GFS_DCNV_generic_post_cap.F90 @@ -235,31 +238,34 @@ set(SOURCES ) if (${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU") - set(f_flags -ffree-line-length-none) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/rascnvv2.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -fdefault-real-8) SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/GFS_calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -ffree-form") SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fno-range-check") SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-ffree-line-length-none -fdefault-real-8 -ffree-form") SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F PROPERTIES COMPILE_FLAGS "-DNEMS_GSM -fdefault-real-8 -fdefault-double-8") elseif (${CMAKE_Fortran_COMPILER_ID} MATCHES "Intel") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/rascnvv2.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -r8) SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/GFS_calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-r8 -free") SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-r8 -ftz") SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-extend-source 132 -r8 -free") SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F PROPERTIES COMPILE_FLAGS "-DNEMS_GSM -r8") +elseif (${CMAKE_Fortran_COMPILER_ID} MATCHES "PGI") + SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/rascnvv2.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -r8) + SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/GFS_calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-r8 -Mfree") + SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-r8 -Mnofptrap") + SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-r8 -Mfree") + SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F PROPERTIES COMPILE_FLAGS "-DNEMS_GSM -r8") else (${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU") message ("CMAKE_Fortran_COMPILER full path: " ${CMAKE_Fortran_COMPILER}) message ("Fortran compiler: " ${CMAKE_Fortran_COMPILER_ID}) - message (FATAL_ERROR "This program has only been compiled with gfortran and ifort. If another compiler is needed, the appropriate flags must be added in ${GFS_PHYS_SRC}/CMakeLists.txt") + message (FATAL_ERROR "This program has only been compiled with gfortran, pgf90 and ifort. If another compiler is needed, the appropriate flags must be added in ${GFS_PHYS_SRC}/CMakeLists.txt") endif (${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU") #apply general fortran tags to all fortran source files if(${CMAKE_VERSION} LESS 3.3) string (REPLACE ";" " " f_flags_str "${f_flags}") - SET_PROPERTY(SOURCE ${GFS_phys_source_code} APPEND_STRING PROPERTY COMPILE_FLAGS " ${f_flags_str}") + SET_PROPERTY(SOURCE ${SOURCES} ${CAPS} APPEND_STRING PROPERTY COMPILE_FLAGS " ${f_flags_str}") else(${CMAKE_VERSION} LESS 3.3) add_compile_options("$<$:${f_flags}>") endif (${CMAKE_VERSION} LESS 3.3) @@ -287,10 +293,24 @@ INCLUDE_DIRECTORIES(${CMAKE_BINARY_DIR}/bacio) #) #list(APPEND SOURCES ${CMAKE_CURRENT_BINARY_DIR}/scm_test1_cap.f90) - -add_library(ccppphys ${SOURCES}) +add_library(ccppphys ${SOURCES} ${CAPS}) target_link_libraries(ccppphys LINK_PUBLIC ${LIBS} w3 sp bacio) set_target_properties(ccppphys PROPERTIES VERSION ${PROJECT_VERSION} SOVERSION ${PROJECT_VERSION_MAJOR} COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}" LINK_FLAGS "${CMAKE_Fortran_FLAGS}") +# DH* hack for PGI compiler: rename objects in scheme cap object files for ISO_C compliancy +if (${CMAKE_Fortran_COMPILER_ID} MATCHES "PGI") +set(CAPOBJS) +foreach(cap ${CAPS}) + string(REPLACE "_cap.F90" "_cap.F90.o" capobj "./${CMAKE_FILES_DIRECTORY}/ccppphys.dir/${cap}") + list(APPEND CAPOBJS ${capobj}) +endforeach(cap) + +add_custom_command(TARGET ccppphys + PRE_LINK + COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/pgifix.py --cmake ${CAPOBJS} + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + COMMENT "Running pgifix_wrapper.py over all scheme caps") +endif (${CMAKE_Fortran_COMPILER_ID} MATCHES "PGI") +# *DH end hack for PGI compiler From 41648db60ee68ab2eaf875936ea0a6acf9cfc2dc Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 11 Apr 2018 14:34:38 +0200 Subject: [PATCH 3/5] Add support for PGI compiler to CMakeLists.txt files, run pgifix.py on physics caps object files --- pgifix.py | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/pgifix.py b/pgifix.py index 42eefccb0..cc6af76d2 100755 --- a/pgifix.py +++ b/pgifix.py @@ -6,12 +6,16 @@ import sys parser = argparse.ArgumentParser(description='Fix cap objects produced by PGI compiler') -parser.add_argument("cap") +parser.add_argument("--cmake", default=False, action='store_true') +parser.add_argument("caps", nargs='+') + +FIXCMD_TEMPLATE = 'objcopy ' def parse_args(): args = parser.parse_args() - cap = args.cap - return cap + cmake = args.cmake + caps = args.caps + return (cmake, caps) def execute(cmd, debug = True, abort = True): """Runs a local command in a shell. Waits for completion and @@ -39,9 +43,14 @@ def execute(cmd, debug = True, abort = True): print message return (status, stdout.rstrip('\n'), stderr.rstrip('\n')) -def correct_cap_object_names(fixcmd, cap): +def correct_cap_object_names(fixcmd, cmake, cap): (cappath, capname) = os.path.split(cap) - pgiprefix = capname.rstrip('.o').lower() + '_' + # Determine pgi-prepended prefix to remove, different + # for cmake builds and make builds (object filename) + if cmake: + pgiprefix = capname.rstrip('.F90.o').lower() + '_' + else: + pgiprefix = capname.rstrip('.o').lower() + '_' # Get list of all symbols in cap object nmcmd = 'nm {0}'.format(cap) (status, stdout, stderr) = execute(nmcmd) @@ -74,11 +83,11 @@ def correct_object_names(fixcmd, cap): execute(mvcmd) def main(): - cap = parse_args() - fixcmd = 'objcopy ' - fixcmd = correct_cap_object_names(fixcmd, cap) - if not fixcmd == 'objcopy ': + (cmake, caps) = parse_args() + for cap in caps: + fixcmd = FIXCMD_TEMPLATE + fixcmd = correct_cap_object_names(fixcmd, cmake, cap) correct_object_names(fixcmd, cap) if __name__ == '__main__': - main() \ No newline at end of file + main() From b67e2ff6e10c93888c0312c444b55f6607810458 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 15 Apr 2018 11:03:53 +0200 Subject: [PATCH 4/5] Remove GFS_sfccycle_type from GFS_initialize_scm.F90 --- GFS_layer/GFS_initialize_scm.F90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/GFS_layer/GFS_initialize_scm.F90 b/GFS_layer/GFS_initialize_scm.F90 index ca33f3477..a56dc15d0 100644 --- a/GFS_layer/GFS_initialize_scm.F90 +++ b/GFS_layer/GFS_initialize_scm.F90 @@ -35,7 +35,6 @@ end subroutine GFS_initialize_scm_finalize !! | Cldprop | FV3-GFS_Cldprop_type | derived type GFS_cldprop_type in FV3 | DDT | 0 | GFS_cldprop_type | | inout | F | !! | Radtend | FV3-GFS_Radtend_type | derived type GFS_radtend_type in FV3 | DDT | 0 | GFS_radtend_type | | inout | F | !! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_diag_type | | inout | F | -!! | Sfccycle | FV3-GFS_Sfccycle_type | derived type GFS_sfccycle_type in FV3 | DDT | 0 | GFS_sfccycle_type | | inout | F | !! | Interstitial | FV3-GFS_Interstitial_type | derived type GFS_interstitial_type in FV3 | DDT | 0 | GFS_interstitial_type | | inout | F | !! | Init_parm | FV3-GFS_Init_type | dervied type GFS_init_type in FV3 | DDT | 0 | GFS_init_type | | in | F | !! | n_ozone_layers | vertical_dimension_of_ozone_forcing_data_from_host | number of vertical layers in ozone forcing data coming from host | count | 0 | integer | | in | F | @@ -51,7 +50,7 @@ end subroutine GFS_initialize_scm_finalize !! subroutine GFS_initialize_scm_run (Model, Statein, Stateout, Sfcprop, & Coupling, Grid, Tbd, Cldprop, Radtend, Diag, & - Sfccycle, Interstitial, Init_parm, n_ozone_lats, & + Interstitial, Init_parm, n_ozone_lats, & n_ozone_layers, n_ozone_times, n_ozone_coefficients, & ozone_lat, ozone_pres, ozone_time, ozone_forcing_in, & errmsg, errflg) @@ -63,7 +62,7 @@ subroutine GFS_initialize_scm_run (Model, Statein, Stateout, Sfcprop, GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & GFS_radtend_type, GFS_diag_type, & - GFS_sfccycle_type, GFS_interstitial_type + GFS_interstitial_type use funcphys, only: gfuncphys use module_microphysics, only: gsmconst use cldwat2m_micro, only: ini_micro @@ -82,7 +81,6 @@ subroutine GFS_initialize_scm_run (Model, Statein, Stateout, Sfcprop, type(GFS_cldprop_type), intent(inout) :: Cldprop type(GFS_radtend_type), intent(inout) :: Radtend type(GFS_diag_type), intent(inout) :: Diag - type(GFS_sfccycle_type), intent(inout) :: Sfccycle type(GFS_interstitial_type), intent(inout) :: Interstitial type(GFS_init_type), intent(in) :: Init_parm @@ -133,8 +131,7 @@ subroutine GFS_initialize_scm_run (Model, Statein, Stateout, Sfcprop, call Radtend%create(1, Model) !--- internal representation of diagnostics call Diag%create(1, Model) - !--- internal representation of sfccycle - call Sfccycle%create(1, Model) + !--- internal representation of interstitials for CCPP physics call Interstitial%create(1, Model) ! !--- populate the grid components From cd4c407c10d4b6b6ea21cf50bb52184eefa05906 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 16 Apr 2018 16:30:01 -0600 Subject: [PATCH 5/5] Use different versions of time vary steps for FV3 (runs over all blocks in one call) and SCM (runs over one block=column each time) --- CMakeLists.txt | 4 +- makefile | 4 +- ...me_vary.f90 => GFS_phys_time_vary.fv3.f90} | 0 physics/GFS_phys_time_vary.scm.f90 | 221 ++++++++++++++++++ ...ime_vary.f90 => GFS_rad_time_vary.fv3.f90} | 0 physics/GFS_rad_time_vary.scm.f90 | 109 +++++++++ 6 files changed, 334 insertions(+), 4 deletions(-) rename physics/{GFS_phys_time_vary.f90 => GFS_phys_time_vary.fv3.f90} (100%) create mode 100644 physics/GFS_phys_time_vary.scm.f90 rename physics/{GFS_rad_time_vary.f90 => GFS_rad_time_vary.fv3.f90} (100%) create mode 100644 physics/GFS_rad_time_vary.scm.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 6b1914cb8..cf340318a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -126,11 +126,11 @@ set(SOURCES ./physics/radlw_datatb.f ./physics/set_soilveg.f ./physics/namelist_soilveg.f - ./physics/GFS_phys_time_vary.f90 + ./physics/GFS_phys_time_vary.scm.f90 ./physics/ozinterp.f90 ./physics/h2ointerp.f90 ./physics/gcycle.f90 - ./physics/GFS_rad_time_vary.f90 + ./physics/GFS_rad_time_vary.scm.f90 ./physics/GFS_radupdate.f90 ./physics/GFS_suite_interstitial.ccpp.f90 ./physics/get_prs_fv3.f90 diff --git a/makefile b/makefile index 53f984c15..378905f44 100644 --- a/makefile +++ b/makefile @@ -142,7 +142,7 @@ SRCS_f90 = \ ./physics/GFS_MP_generic_post.f90 \ ./physics/GFS_MP_generic_pre.f90 \ ./physics/GFS_zhao_carr_pre.f90 \ - ./physics/GFS_rad_time_vary.f90 \ + ./physics/GFS_rad_time_vary.fv3.f90 \ ./physics/GFS_radupdate.f90 \ ./physics/cs_conv.f90 \ ./physics/funcphys.f90 \ @@ -153,7 +153,7 @@ SRCS_f90 = \ ./physics/GFS_SCNV_generic.f90 \ ./physics/GFS_PBL_generic.f90 \ $(GFS_SUITE_INTERSTITIAL) \ - ./physics/GFS_phys_time_vary.f90 \ + ./physics/GFS_phys_time_vary.fv3.f90 \ ./physics/GFS_stochastics.f90 \ ./physics/GFS_surface_generic.f90 \ ./physics/h2ointerp.f90 \ diff --git a/physics/GFS_phys_time_vary.f90 b/physics/GFS_phys_time_vary.fv3.f90 similarity index 100% rename from physics/GFS_phys_time_vary.f90 rename to physics/GFS_phys_time_vary.fv3.f90 diff --git a/physics/GFS_phys_time_vary.scm.f90 b/physics/GFS_phys_time_vary.scm.f90 new file mode 100644 index 000000000..7fce6b7f0 --- /dev/null +++ b/physics/GFS_phys_time_vary.scm.f90 @@ -0,0 +1,221 @@ +!> \file GFS_phys_time_vary.f90 +!! Contains code related to GFS physics suite setup (physics part of time_vary_step) + + module GFS_phys_time_vary_1 + + contains + + subroutine GFS_phys_time_vary_1_init () + end subroutine GFS_phys_time_vary_1_init + + subroutine GFS_phys_time_vary_1_finalize() + end subroutine GFS_phys_time_vary_1_finalize + +!> \section arg_table_GFS_phys_time_vary_1_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | +!! | Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_tbd_type | | in | F | +!! | errmsg | error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! + subroutine GFS_phys_time_vary_1_run (Model, Tbd, errmsg, errflg) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_tbd_type + + implicit none + + type(GFS_control_type), intent(inout) :: Model + type(GFS_tbd_type), intent(in) :: Tbd + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys) :: rinc(5) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (Tbd%blkno==1) then + !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 + !--- update calendars and triggers + rinc(1:5) = 0 + call w3difdat(Model%jdat,Model%idat,4,rinc) + Model%sec = rinc(4) + + Model%phour = Model%sec/con_hr + !--- set current bucket hour + Model%zhour = Model%phour + Model%fhour = (Model%sec + Model%dtp)/con_hr + Model%kdt = nint((Model%sec + Model%dtp)/Model%dtp) + + Model%ipt = 1 + Model%lprnt = .false. + Model%lssav = .true. + + !--- radiation triggers + Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + + !--- set the solar hour based on a combination of phour and time initial hour + Model%solhr = mod(Model%phour+Model%idate(1),con_24) + + if ((Model%debug) .and. (Model%me == Model%master)) then + print *,' sec ', Model%sec + print *,' kdt ', Model%kdt + print *,' nsswr ', Model%nsswr + print *,' nslwr ', Model%nslwr + print *,' nscyc ', Model%nscyc + print *,' lsswr ', Model%lsswr + print *,' lslwr ', Model%lslwr + print *,' fhour ', Model%fhour + print *,' phour ', Model%phour + print *,' solhr ', Model%solhr + endif + endif + + end subroutine GFS_phys_time_vary_1_run + + end module GFS_phys_time_vary_1 + + module GFS_phys_time_vary_2 + + contains + + subroutine GFS_phys_time_vary_2_init () + end subroutine GFS_phys_time_vary_2_init + + subroutine GFS_phys_time_vary_2_finalize() + end subroutine GFS_phys_time_vary_2_finalize + +!> \section arg_table_GFS_phys_time_vary_2_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | +!! | Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_tbd_type | | inout | F | +!! | Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | inout | F | +!! | Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields | DDT | 0 | GFS_cldprop_type | | inout | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_diag_type | | inout | F | +!! | errmsg | error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! + subroutine GFS_phys_time_vary_2_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, errmsg, errflg) + + use mersenne_twister, only: random_setseed, random_number + use machine, only: kind_phys + use physcons, only: dxmin, dxinv + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & + GFS_Tbd_type, GFS_sfcprop_type, & + GFS_cldprop_type, GFS_diag_type + + implicit none + + type(GFS_grid_type), intent(in) :: Grid + type(GFS_control_type), intent(inout) :: Model + type(GFS_tbd_type), intent(inout) :: Tbd + type(GFS_sfcprop_type), intent(inout) :: Sfcprop + type(GFS_cldprop_type), intent(inout) :: Cldprop + type(GFS_diag_type), intent(inout) :: Diag + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + + integer :: i, j, k, iseed, iskip, ix, nb + real(kind=kind_phys) :: wrk(1) + real(kind=kind_phys) :: rannie(Model%cny) + real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (Tbd%blkno==1) then + !--- switch for saving convective clouds - cnvc90.f + !--- aka Ken Campana/Yu-Tai Hou legacy + if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then + !--- initialize,accumulate,convert + Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (mod(Model%kdt,Model%nsswr) == 0) then + !--- accumulate,convert + Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (Model%lsswr) then + !--- initialize,accumulate + Model%clstp = 1100 + else + !--- accumulate + Model%clstp = 0100 + endif + endif + + !--- random number needed for RAS and old SAS and when cal_pre=.true. + if ( ((Model%imfdeepcnv <= 0) .or. (Model%cal_pre)) .and. (Model%random_clds) ) then + iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 + call random_setseed(iseed) + call random_number(wrk) + do i = 1,Model%cnx*Model%nrcm + iseed = iseed + nint(wrk(1)) * i + call random_setseed(iseed) + call random_number(rannie) + rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) + enddo + + ! DH* TODO - this could be sped up by saving jsc, jec, isc, iec in Tbd (for example) + ! and looping just over them; ix would then run from 1 to blksz(nb); one could also + ! use OpenMP to speed up this loop or the inside loops *DH + do k = 1,Model%nrcm + iskip = (k-1)*Model%cnx*Model%cny + ix = 0 + nb = 1 + do j = 1,Model%ny + do i = 1,Model%nx + ix = ix + 1 + if (ix .gt. Model%blksz(nb)) then + ix = 1 + nb = nb + 1 + endif + if (nb == Tbd%blkno) then + Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) + endif + enddo + enddo + enddo + endif ! imfdeepcnv, cal_re, random_clds + + !--- o3 interpolation + if (Model%ntoz > 0) then + call ozinterpol (Model%me, Model%blksz(Tbd%blkno), Model%idate, Model%fhour, & + Grid%jindx1_o3, Grid%jindx2_o3, Tbd%ozpl, Grid%ddy_o3) + endif + + !--- h2o interpolation + if (Model%h2o_phys) then + call h2ointerpol (Model%me, Model%blksz(Tbd%blkno), Model%idate, Model%fhour, & + Grid%jindx1_h, Grid%jindx2_h, Tbd%h2opl, Grid%ddy_h) + endif + + !--- original FV3 code, not needed for SCM; also not compatible with the way + ! the time vary steps are run (over each block) --> cannot use + !--- repopulate specific time-varying sfc properties for AMIP/forecast runs + !if (Model%nscyc > 0) then + ! if (mod(Model%kdt,Model%nscyc) == 1) THEN + ! call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) + ! endif + !endif + + !--- determine if diagnostics buckets need to be cleared + if (mod(Model%kdt,Model%nszero) == 1) then + call Diag%rad_zero (Model) + call Diag%phys_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + endif + + end subroutine GFS_phys_time_vary_2_run + + end module GFS_phys_time_vary_2 diff --git a/physics/GFS_rad_time_vary.f90 b/physics/GFS_rad_time_vary.fv3.f90 similarity index 100% rename from physics/GFS_rad_time_vary.f90 rename to physics/GFS_rad_time_vary.fv3.f90 diff --git a/physics/GFS_rad_time_vary.scm.f90 b/physics/GFS_rad_time_vary.scm.f90 new file mode 100644 index 000000000..f21e76fd1 --- /dev/null +++ b/physics/GFS_rad_time_vary.scm.f90 @@ -0,0 +1,109 @@ +!>\file GFS_rad_time_vary.f90 +!! Contains code related to GFS physics suite setup (radiation part of time_vary_step) + module GFS_rad_time_vary + contains + +!>\defgroup GFS_rad_time_vary GFS RRTMG Update +!!\ingroup RRTMG +!! @{ +!! \section arg_table_GFS_rad_time_vary_init Argument Table +!! + subroutine GFS_rad_time_vary_init + end subroutine GFS_rad_time_vary_init + +!> \section arg_table_GFS_rad_time_vary_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |-------------------|--------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | +!! | Statein | FV3-GFS_Statein_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | +!! | Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_tbd_type | | inout | F | +!! | errmsg | error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! + subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) + + use physparam, only: ipsd0, ipsdlim, iaerflg + use mersenne_twister, only: random_setseed, random_index, random_stat + use machine, only: kind_phys + use GFS_typedefs, only: GFS_statein_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_tbd_type + use GFS_radupdate, only: GFS_radupdate_run + use radcons, only: qmin, con_100 + + implicit none + + type(GFS_control_type), intent(inout) :: Model + type(GFS_statein_type), intent(in) :: Statein + type(GFS_tbd_type), intent(inout) :: Tbd + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !--- local variables + type (random_stat) :: stat + integer :: ix, nb, j, i, nblks, ipseed + integer :: numrdm(Model%cnx*Model%cny*2) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (Model%lsswr .or. Model%lslwr) then + + if (Tbd%blkno==1) then + + call GFS_radupdate_run (Model%idat, Model%jdat, Model%fhswr, Model%dtf, Model%lsswr, & + Model%me, Model%slag, Model%sdec, Model%cdec, Model%solcon, & + Model%ictm, Model%isol ) + endif + + !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) + if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then + ipseed = mod(nint(con_100*sqrt(Model%sec)), ipsdlim) + 1 + ipsd0 + call random_setseed (ipseed, stat) + call random_index (ipsdlim, numrdm, stat) + + !--- set the random seeds for each column in a reproducible way + ix = 0 + nb = 1 + ! DH* TODO - this could be sped up by saving jsc, jec, isc, iec in Tbd (for example) + ! and looping just over them; ix would then run from 1 to blksz(nb); one could also + ! use OpenMP to speed up this loop *DH + do j = 1,Model%ny + do i = 1,Model%nx + ix = ix + 1 + if (ix .gt. Model%blksz(nb)) then + ix = 1 + nb = nb + 1 + endif + if (nb == Tbd%blkno) then + !--- for testing purposes, replace numrdm with '100' + Tbd%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) + Tbd%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) + endif + enddo + enddo + endif ! isubc_lw and isubc_sw + + if (Model%num_p3d == 4) then + if (Model%kdt == 1) then + Tbd%phy_f3d(:,:,1) = Statein%tgrs + Tbd%phy_f3d(:,:,2) = max(qmin,Statein%qgrs(:,:,1)) + Tbd%phy_f3d(:,:,3) = Statein%tgrs + Tbd%phy_f3d(:,:,4) = max(qmin,Statein%qgrs(:,:,1)) + Tbd%phy_f2d(:,1) = Statein%prsi(:,1) + Tbd%phy_f2d(:,2) = Statein%prsi(:,1) + endif + endif + + endif + + end subroutine GFS_rad_time_vary_run + +!> \section arg_table_GFS_rad_time_vary_finalize Argument Table +!! + subroutine GFS_rad_time_vary_finalize() + end subroutine GFS_rad_time_vary_finalize +!! @} + end module GFS_rad_time_vary