diff --git a/CMakeLists.txt b/CMakeLists.txt index f70762636..973cedddc 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -38,17 +38,19 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") endif() add_library( - cable_common_objlib - OBJECT + cable_common + STATIC src/offline/cable_abort.F90 src/offline/cable_checks.F90 src/offline/cable_cru_TRENDY.F90 src/offline/cable_define_types.F90 + src/offline/cable_driver_init.F90 src/offline/cable_initialise.F90 src/offline/cable_input.F90 src/offline/cable_iovars.F90 src/offline/cable_LUC_EXPT.F90 src/offline/cable_metutils.F90 + src/offline/cable_mpi.F90 src/offline/cable_namelist_input.F90 src/offline/cable_output.F90 src/offline/cable_parameters.F90 @@ -57,6 +59,7 @@ add_library( src/offline/cable_plume_mip.F90 src/offline/cable_read.F90 src/offline/cable_site.F90 + src/offline/cable_serial.F90 src/offline/cable_soil_params.F90 src/offline/cable_weathergenerator.F90 src/offline/cable_write.F90 @@ -150,29 +153,30 @@ add_library( src/util/cable_runtime_opts_mod.F90 src/util/masks_cbl.F90 ) -target_link_libraries(cable_common_objlib PRIVATE PkgConfig::NETCDF) - -add_executable( - cable - src/offline/cable_driver.F90 - src/offline/cable_driver_init.F90 - "$" -) -target_link_libraries(cable PRIVATE PkgConfig::NETCDF) -install(TARGETS cable RUNTIME) +target_link_libraries(cable_common PRIVATE PkgConfig::NETCDF) +if(CABLE_MPI) + target_compile_definitions(cable_common PRIVATE __MPI__) + target_link_libraries(cable_common PRIVATE MPI::MPI_Fortran) +endif() if(CABLE_MPI) add_executable( cable-mpi - src/offline/cable_driver_init.F90 src/offline/cable_mpicommon.F90 - src/offline/cable_mpidrv.F90 src/offline/cable_mpimaster.F90 src/offline/cable_mpiworker.F90 src/science/pop/pop_mpi.F90 - "$" + src/offline/cable_offline_driver.F90 ) - target_compile_definitions(cable-mpi PRIVATE __MPI__) - target_link_libraries(cable-mpi PRIVATE PkgConfig::NETCDF MPI::MPI_Fortran) + target_link_libraries(cable-mpi PRIVATE cable_common MPI::MPI_Fortran) install(TARGETS cable-mpi RUNTIME) +else() + add_executable( + cable + src/offline/cable_mpimaster_stub.F90 + src/offline/cable_mpiworker_stub.F90 + src/offline/cable_offline_driver.F90 + ) + target_link_libraries(cable PRIVATE cable_common) + install(TARGETS cable RUNTIME) endif() diff --git a/src/offline/cable_cru_TRENDY.F90 b/src/offline/cable_cru_TRENDY.F90 index 31e91c387..02b85ea0d 100644 --- a/src/offline/cable_cru_TRENDY.F90 +++ b/src/offline/cable_cru_TRENDY.F90 @@ -1260,7 +1260,7 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend, LastYearOfMet ) CRU%ktau = ktau ! ktau is the current timestep in the year. -! this only works with CANBERRA cable_driver, as ktau ! +! this only works with CANBERRA cable_serial, as ktau ! ! restarts on Jan 1 ! ! Based on the ktau timestep, calculate date and time information (the same for the whole spatial dimension.) met%hod (:) = REAL(MOD( (ktau-1) * NINT(dt), INT(SecDay)) ) / 3600. ! Hour of the day diff --git a/src/offline/cable_driver_init.F90 b/src/offline/cable_driver_init.F90 index 8136e3234..765eb60ce 100644 --- a/src/offline/cable_driver_init.F90 +++ b/src/offline/cable_driver_init.F90 @@ -29,10 +29,7 @@ MODULE cable_driver_init_mod USE cable_namelist_util, ONLY : & get_namelist_file_name, & CABLE_NAMELIST -#ifdef __MPI__ - USE mpi - USE cable_mpicommon, ONLY : comm, rank -#endif + USE cable_mpi_mod, ONLY : mpi_grp_t IMPLICIT NONE PRIVATE @@ -84,38 +81,25 @@ MODULE cable_driver_init_mod CONTAINS - SUBROUTINE cable_driver_init() + SUBROUTINE cable_driver_init(mpi_grp) + TYPE(mpi_grp_t), INTENT(IN) :: mpi_grp !! MPI group to use + !! Model initialisation routine for the CABLE offline driver. -#ifdef __MPI__ - INTEGER :: np, ierr -#endif !check to see if first argument passed to cable is !the name of the namelist file !if not use cable.nml CALL get_namelist_file_name() -#ifndef __MPI__ - WRITE(*,*) "THE NAME LIST IS ", CABLE_NAMELIST -#endif + IF (mpi_grp%rank == 0) THEN + WRITE(*,*) "THE NAME LIST IS ", CABLE_NAMELIST + END IF + ! Open, read and close the namelist file. OPEN(10, FILE=CABLE_NAMELIST, STATUS="OLD", ACTION="READ") READ(10, NML=CABLE) CLOSE(10) -#ifdef __MPI__ - CALL MPI_Init(ierr) - CALL MPI_Comm_dup(MPI_COMM_WORLD, comm, ierr) - CALL MPI_Comm_size(comm, np, ierr) - - IF (np < 2) THEN - WRITE (*,*) 'This program needs at least 2 processes to run!' - CALL MPI_Abort(comm, 0, ierr) - END IF - - CALL MPI_Comm_rank(comm, rank, ierr) -#endif - END SUBROUTINE cable_driver_init END MODULE cable_driver_init_mod diff --git a/src/offline/cable_mpi.F90 b/src/offline/cable_mpi.F90 new file mode 100644 index 000000000..0af4eaf6d --- /dev/null +++ b/src/offline/cable_mpi.F90 @@ -0,0 +1,155 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +MODULE cable_mpi_mod + !! Module for handling some common MPI operations and MPI groups +#ifdef __MPI__ + USE mpi +#endif + USE iso_fortran_env, ONLY : error_unit + IMPLICIT NONE + + PRIVATE + PUBLIC :: & + mpi_grp_t, & + mpi_mod_init, & + mpi_mod_end, & + mpi_check_error + + INTEGER, PARAMETER :: MPI_COMM_UNDEFINED = -1 + + INTEGER :: default_comm ! Default communicator to use when creating groups + + TYPE mpi_grp_t + !* Class to handle MPI groups. + ! This class stores information about the group and + ! the current proccess. + INTEGER :: comm = MPI_COMM_UNDEFINED !! Communicator + INTEGER :: rank = -1 !! Rank of the current process + INTEGER :: size = -1 !! Size of the communicator + CONTAINS + PROCEDURE :: abort => mpi_grp_abort !! Send abort signal to processes in this group + END TYPE mpi_grp_t + + INTERFACE mpi_grp_t + !* Overload the default construct for mpi_grp_t + PROCEDURE mpi_grp_constructor + END INTERFACE mpi_grp_t + +CONTAINS + + SUBROUTINE mpi_mod_init() + !* Initialise MPI and set default communicator. + ! + ! The default communicator is set to MPI_COMM_WORLD if MPI support is + ! available or to MPI_COMM_UNDEFINED if not. +#ifdef __MPI__ + INTEGER :: ierr + + CALL MPI_Init(ierr) + CALL mpi_check_error(ierr) + default_comm = MPI_COMM_WORLD +#else + default_comm = MPI_COMM_UNDEFINED +#endif + + END SUBROUTINE mpi_mod_init + + SUBROUTINE mpi_mod_end() + !* Finalise MPI. +#ifdef __MPI__ + INTEGER :: ierr + + IF (default_comm /= MPI_COMM_UNDEFINED) THEN + CALL MPI_Finalize(ierr) + CALL mpi_check_error(ierr) + END IF +#endif + + END SUBROUTINE mpi_mod_end + + + FUNCTION mpi_grp_constructor(comm) RESULT(mpi_grp) + !* Contructor for mpi_grp_t class. + ! + ! This sets the communicator of the group and gets the size of the group and + ! rank of current process. If no communicator is provided, it will use + ! the default defined when calling mpi_mod_init. + ! + ! Note that when the undefined communicator is used, the group size is 1 and + ! the rank to 0, such that the code can work in serial mode. + INTEGER, INTENT(IN), OPTIONAL :: comm !! MPI communicator + TYPE(mpi_grp_t) :: mpi_grp + + INTEGER :: ierr + + IF (PRESENT(comm)) THEN +#ifdef __MPI__ + CALL MPI_Comm_dup(comm, mpi_grp%comm, ierr) + call mpi_check_error(ierr) +#else + mpi_grp%comm = comm +#endif + ELSE +#ifdef __MPI__ + CALL MPI_Comm_dup(default_comm, mpi_grp%comm, ierr) + call mpi_check_error(ierr) +#else + mpi_grp%comm = default_comm +#endif + END IF + + IF (mpi_grp%comm /= MPI_COMM_UNDEFINED) THEN +#ifdef __MPI__ + call MPI_Comm_rank(mpi_grp%comm, mpi_grp%rank, ierr) + call mpi_check_error(ierr) + + call MPI_Comm_size(mpi_grp%comm, mpi_grp%size, ierr) + call mpi_check_error(ierr) +#else + WRITE(error_unit,*) "Error initialising mpi group: CABLE was compiled without MPI support." + STOP +#endif + ELSE + mpi_grp%rank = 0 + mpi_grp%size = 1 + END IF + + END FUNCTION mpi_grp_constructor + + SUBROUTINE mpi_grp_abort(this) + !* Class method to abort execution of an MPI group. + CLASS(mpi_grp_t), INTENT(IN) :: this + + INTEGER :: ierr + + IF (this%comm /= MPI_COMM_UNDEFINED) THEN + ! Here we use an arbitrary error code +#ifdef __MPI__ + call MPI_Abort(this%comm, 999, ierr) +#endif + call mpi_check_error(ierr) + END IF + + END SUBROUTINE mpi_grp_abort + + SUBROUTINE mpi_check_error(ierr) + !* Check if an MPI return code signaled an error. If so, print the + ! corresponding message and abort the execution. + INTEGER, INTENT(IN) :: ierr !! Error code + +#ifdef __MPI__ + CHARACTER(len=MPI_MAX_ERROR_STRING) :: msg + INTEGER :: length, tmp + + IF (ierr /= MPI_SUCCESS ) THEN + CALL MPI_Error_String(ierr, msg, length, tmp) + WRITE(error_unit,*) msg(1:length) + CALL MPI_Abort(MPI_COMM_WORLD, 1 , tmp) + END if +#endif + + END SUBROUTINE mpi_check_error + +END MODULE cable_mpi_mod diff --git a/src/offline/cable_mpicommon.F90 b/src/offline/cable_mpicommon.F90 index a048401cd..ddd0e5785 100644 --- a/src/offline/cable_mpicommon.F90 +++ b/src/offline/cable_mpicommon.F90 @@ -27,13 +27,6 @@ MODULE cable_mpicommon PUBLIC - ! MPI commicator and rank are declared as global variables (see - ! cable_driver_init_mod for their initialisation). This is done so that the comm - ! and rank variables are only accessible in cable_driver_init_mod when MPI - ! compilation is enabled. - ! TODO(Sean): revise which module to declare these variables in - INTEGER :: comm, rank - ! base number of input fields: must correspond to CALLS to ! MPI_address (field ) in *_mpimaster/ *_mpiworker INTEGER, PARAMETER :: nparam = 330 diff --git a/src/offline/cable_mpidrv.F90 b/src/offline/cable_mpidrv.F90 deleted file mode 100644 index fab9b5b06..000000000 --- a/src/offline/cable_mpidrv.F90 +++ /dev/null @@ -1,47 +0,0 @@ -!============================================================================== -! This source code is part of the -! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model. -! This work is licensed under the CSIRO Open Source Software License -! Agreement (variation of the BSD / MIT License). -! -! You may not use this file except in compliance with this License. -! A copy of the License (CSIRO_BSD_MIT_License_v2.0_CABLE.txt) is located -! in each directory containing CABLE code. -! -! ============================================================================== -! Purpose: Bare bones MPI driver for CABLE -! -! Contact: Bernard.Pak@csiro.au -! -! History: MPI wrapper developed by Maciej Golebiewski (2012) -! -! ============================================================================== -! -PROGRAM mpi_driver - - USE mpi - USE cable_driver_init_mod - - USE cable_mpicommon, ONLY : comm, rank - USE cable_mpimaster - USE cable_mpiworker - - IMPLICIT NONE - - INTEGER :: ierr - REAL :: etime ! Declare the type of etime() - - CALL cable_driver_init() - - IF (rank == 0) THEN - CALL mpidrv_master (comm) - ELSE - CALL mpidrv_worker (comm) - END IF - - CALL MPI_Finalize (ierr) - - CALL CPU_TIME(etime) - PRINT *, 'Finished. ', etime, ' seconds needed for ' - -END PROGRAM mpi_driver diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index eda3140fd..cd5bd1110 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -18,7 +18,7 @@ ! soil_snow_type now ssnow (instead of ssoil) ! ! MPI wrapper developed by Maciej Golebiewski (2012) -! Modified from cable_driver.F90 in CABLE-2.0_beta r171 by B Pak +! Modified from cable_serial.F90 in CABLE-2.0_beta r171 by B Pak ! ! ============================================================================== ! Uses: mpi diff --git a/src/offline/cable_mpimaster_stub.F90 b/src/offline/cable_mpimaster_stub.F90 new file mode 100644 index 000000000..67c6387cf --- /dev/null +++ b/src/offline/cable_mpimaster_stub.F90 @@ -0,0 +1,23 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +MODULE cable_mpimaster + !! Stub for the master driver when MPI is not available. + IMPLICIT NONE + + PRIVATE + PUBLIC :: mpidrv_master + +CONTAINS + + SUBROUTINE mpidrv_master(comm) + !! Stub for when MPI is not available + INTEGER, INTENT(IN) :: comm + + ! This should never be called! + STOP + + END SUBROUTINE mpidrv_master + +END MODULE cable_mpimaster diff --git a/src/offline/cable_mpiworker.F90 b/src/offline/cable_mpiworker.F90 index 881f579d1..a82713612 100644 --- a/src/offline/cable_mpiworker.F90 +++ b/src/offline/cable_mpiworker.F90 @@ -18,7 +18,7 @@ ! soil_snow_type now ssnow (instead of ssoil) ! ! MPI wrapper developed by Maciej Golebiewski (2012) -! Modified from cable_driver.F90 in CABLE-2.0_beta r171 by B Pak +! Modified from cable_serial.F90 in CABLE-2.0_beta r171 by B Pak ! ! ============================================================================== ! Uses: mpi diff --git a/src/offline/cable_mpiworker_stub.F90 b/src/offline/cable_mpiworker_stub.F90 new file mode 100644 index 000000000..2e5e61142 --- /dev/null +++ b/src/offline/cable_mpiworker_stub.F90 @@ -0,0 +1,23 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. + +MODULE cable_mpiworker + !! Stub for the worker driver when MPI is not available. + IMPLICIT NONE + + PRIVATE + PUBLIC :: mpidrv_worker + +CONTAINS + + SUBROUTINE mpidrv_worker(comm) + !! Stub for when MPI is not available + INTEGER, INTENT(IN) :: comm + + ! This should never be called! + STOP + + END SUBROUTINE mpidrv_worker + +END MODULE cable_mpiworker diff --git a/src/offline/cable_offline_driver.F90 b/src/offline/cable_offline_driver.F90 new file mode 100644 index 000000000..41666c479 --- /dev/null +++ b/src/offline/cable_offline_driver.F90 @@ -0,0 +1,36 @@ +! CSIRO Open Source Software License Agreement (variation of the BSD / MIT License) +! Copyright (c) 2015, Commonwealth Scientific and Industrial Research Organisation +! (CSIRO) ABN 41 687 119 230. +PROGRAM cable_offline_driver + USE cable_mpi_mod, ONLY : mpi_grp_t, mpi_mod_init, mpi_mod_end + USE cable_driver_init_mod + USE cable_serial + USE cable_mpimaster + USE cable_mpiworker + + IMPLICIT NONE + + REAL :: etime ! Declare the type of etime() + TYPE(mpi_grp_t) :: mpi_grp + + call mpi_mod_init() + mpi_grp = mpi_grp_t() + + CALL cable_driver_init(mpi_grp) + + IF (mpi_grp%size == 1) THEN + CALL serialdrv() + ELSE + IF (mpi_grp%rank == 0) THEN + CALL mpidrv_master(mpi_grp%comm) + ELSE + CALL mpidrv_worker(mpi_grp%comm) + END IF + END IF + + CALL mpi_mod_end() + + CALL CPU_TIME(etime) + PRINT *, 'Finished. ', etime, ' seconds needed for ' + +END PROGRAM cable_offline_driver diff --git a/src/offline/cable_output.F90 b/src/offline/cable_output.F90 index 93a1f9798..b7ada0c57 100644 --- a/src/offline/cable_output.F90 +++ b/src/offline/cable_output.F90 @@ -18,7 +18,7 @@ ! ! ! ============================================================================== -! CALLed from: cable_driver.F90 +! CALLed from: cable_serial.F90 ! ! MODULEs used: cable_abort_module ! cable_common_module diff --git a/src/offline/cable_plume_mip.F90 b/src/offline/cable_plume_mip.F90 index 2bafc452c..31136010d 100644 --- a/src/offline/cable_plume_mip.F90 +++ b/src/offline/cable_plume_mip.F90 @@ -951,7 +951,7 @@ SUBROUTINE PLUME_MIP_GET_MET(PLUME, MET, CurYear, ktau, kend, islast ) PLUME%CYEAR = CurYear PLUME%ktau = ktau -! this only works with CANBERRA cable_driver, as ktau ! +! this only works with CANBERRA cable_serial, as ktau ! ! restarts on Jan 1 ! met%hod (:) = REAL(MOD( (ktau-1) * NINT(dt), INT(SecDay)) ) / 3600. diff --git a/src/offline/cable_read.F90 b/src/offline/cable_read.F90 index 97ee0428f..23553be06 100644 --- a/src/offline/cable_read.F90 +++ b/src/offline/cable_read.F90 @@ -17,7 +17,7 @@ ! ! ! ============================================================================== -! CALLed from: cable_driver.f90 +! CALLed from: cable_serial.f90 ! MODULEs used: cable_abort_module ! cable_IO_vars_module ! netcdf diff --git a/src/offline/cable_driver.F90 b/src/offline/cable_serial.F90 similarity index 98% rename from src/offline/cable_driver.F90 rename to src/offline/cable_serial.F90 index 0a4a5c75b..5b89d153a 100644 --- a/src/offline/cable_driver.F90 +++ b/src/offline/cable_serial.F90 @@ -58,7 +58,8 @@ ! poolcnpOut.csv -- from CASA-CNP !============================================================================== -PROGRAM cable_offline_driver +MODULE cable_serial + !! Offline serial driver for CABLE. USE cable_driver_init_mod, ONLY : & cable_driver_init, & vegparmnew, & @@ -146,6 +147,14 @@ PROGRAM cable_offline_driver USE casa_offline_inout_module, ONLY : WRITE_CASA_RESTART_NC, WRITE_CASA_OUTPUT_NC IMPLICIT NONE + PRIVATE + PUBLIC :: serialdrv + +CONTAINS + +SUBROUTINE serialdrv() + !! Offline serial driver. + ! CABLE namelist: model configuration, runtime/user switches !CHARACTER(LEN=200), PARAMETER :: CABLE_NAMELIST='cable.nml' ! try to read in namelist from command line argument @@ -253,7 +262,7 @@ PROGRAM cable_offline_driver new_sumbal = 0.0, & new_sumfpn = 0.0, & new_sumfe = 0.0 -!For consistency w JAC + !For consistency w JAC REAL,ALLOCATABLE, SAVE :: c1(:,:) REAL,ALLOCATABLE, SAVE :: rhoch(:,:) REAL,ALLOCATABLE, SAVE :: xk(:,:) @@ -262,20 +271,18 @@ PROGRAM cable_offline_driver INTEGER :: ioerror INTEGER :: count_bal = 0 -! for landuse -integer mlon,mlat, mpx -real(r_2), dimension(:,:,:), allocatable, save :: luc_atransit -real(r_2), dimension(:,:), allocatable, save :: luc_fharvw -real(r_2), dimension(:,:,:), allocatable, save :: luc_xluh2cable -real(r_2), dimension(:), allocatable, save :: arealand -integer, dimension(:,:), allocatable, save :: landmask -integer, dimension(:), allocatable, save :: cstart,cend,nap -real(r_2), dimension(:,:,:), allocatable, save :: patchfrac_new + ! for landuse + integer mlon,mlat, mpx + real(r_2), dimension(:,:,:), allocatable, save :: luc_atransit + real(r_2), dimension(:,:), allocatable, save :: luc_fharvw + real(r_2), dimension(:,:,:), allocatable, save :: luc_xluh2cable + real(r_2), dimension(:), allocatable, save :: arealand + integer, dimension(:,:), allocatable, save :: landmask + integer, dimension(:), allocatable, save :: cstart,cend,nap + real(r_2), dimension(:,:,:), allocatable, save :: patchfrac_new ! END header - CALL cable_driver_init() - cable_runtime%offline = .TRUE. ! Open, read and close the consistency check file. @@ -1227,7 +1234,7 @@ PROGRAM cable_offline_driver CALL CPU_TIME(etime) PRINT *, 'Finished. ', etime, ' seconds needed for ', kend,' hours' -END PROGRAM cable_offline_driver +END SUBROUTINE serialdrv SUBROUTINE prepareFiles(ncciy) @@ -1363,3 +1370,5 @@ SUBROUTINE LUCdriver( casabiome,casapool, & CALL POPLUC_weights_transfer(POPLUC,POP,LUC_EXPT) END SUBROUTINE LUCdriver + +END MODULE cable_serial diff --git a/src/offline/casa_cable.F90 b/src/offline/casa_cable.F90 index 526ec9783..b85c0ea1c 100644 --- a/src/offline/casa_cable.F90 +++ b/src/offline/casa_cable.F90 @@ -12,7 +12,7 @@ ! Purpose: ! sumcflux - accumulating carbon fluxes (not required for UM) ! -! Called from: cable_driver for offline version +! Called from: cable_serial for offline version ! Not currently called/available for ACCESS version ! ! Contact: Yingping.Wang@csiro.au diff --git a/src/offline/casa_ncdf.F90 b/src/offline/casa_ncdf.F90 index 08dcda5a6..593f922b9 100644 --- a/src/offline/casa_ncdf.F90 +++ b/src/offline/casa_ncdf.F90 @@ -406,7 +406,7 @@ FUNCTION IS_CASA_TIME(iotype, yyyy, ktau, kstart, koffset, kend, ktauday, logn) USE cable_common_module, ONLY: CABLE_USER ! Correctly determine if it is time to dump-read or standard-write - ! casa output from cable_driver. + ! casa output from cable_serial. ! Writing casa-dump data is handled in casa_cable and therefore not \ ! captured here !cable_common module was intended to be unequivocally common to all diff --git a/src/offline/cbl_model_driver_offline.F90 b/src/offline/cbl_model_driver_offline.F90 index b9dab3d99..31d068b75 100644 --- a/src/offline/cbl_model_driver_offline.F90 +++ b/src/offline/cbl_model_driver_offline.F90 @@ -15,7 +15,7 @@ ! twice per timestep in the ACCESS case. Not all parts of cbm ! are executed in each of the ACCESS calls. ! -! Called from: cable_driver for offline version +! Called from: cable_serial for offline version ! cable_explicit_driver, cable_implicit_driver for ACCESS ! ! Contact: Yingping.Wang@csiro.au diff --git a/src/science/casa-cnp/casa_feedback.F90 b/src/science/casa-cnp/casa_feedback.F90 index b372838ba..ad89b01be 100644 --- a/src/science/casa-cnp/casa_feedback.F90 +++ b/src/science/casa-cnp/casa_feedback.F90 @@ -20,7 +20,7 @@ ! Purpose: bgcdriver - interface between casacnp and cable ! sumcflux - accumulating carbon fluxes (not required for UM) ! -! Called from: cable_driver for offline version +! Called from: cable_serial for offline version ! Not currently called/available for ACCESS version ! ! Contact: Yingping.Wang@csiro.au diff --git a/src/science/casa-cnp/casa_sumcflux.F90 b/src/science/casa-cnp/casa_sumcflux.F90 index fa90cb683..6257c0794 100644 --- a/src/science/casa-cnp/casa_sumcflux.F90 +++ b/src/science/casa-cnp/casa_sumcflux.F90 @@ -20,7 +20,7 @@ ! Purpose: bgcdriver - interface between casacnp and cable ! sumcflux - accumulating carbon fluxes (not required for UM) ! -! Called from: cable_driver for offline version +! Called from: cable_serial for offline version ! Not currently called/available for ACCESS version ! ! Contact: Yingping.Wang@csiro.au diff --git a/src/science/gw_hydro/cable_gw_hydro.F90 b/src/science/gw_hydro/cable_gw_hydro.F90 index 1807f29f9..fde46a4fa 100644 --- a/src/science/gw_hydro/cable_gw_hydro.F90 +++ b/src/science/gw_hydro/cable_gw_hydro.F90 @@ -1154,8 +1154,8 @@ SUBROUTINE soil_snow_gw(dels, soil, ssnow, canopy, met, bal, veg) !> 18. update variables ! MMY??? where is pudsto calculated DO i=1,mp ssnow%pudsto(i) = 0.0 !no puddle - ssnow%smelt(i) = ssnow%smelt(i)/dels !change units to mm/s. cable_driver then reverts back to mm - ssnow%runoff(i) = (ssnow%rnof1(i) + ssnow%rnof2(i))!*dels !cable_driver converts from mm/s to mm + ssnow%smelt(i) = ssnow%smelt(i)/dels !change units to mm/s. cable_serial then reverts back to mm + ssnow%runoff(i) = (ssnow%rnof1(i) + ssnow%rnof2(i))!*dels !cable_serial converts from mm/s to mm !rnof1 and rnof2 are already in mm/s ! Set weighted soil/snow surface temperature ssnow%tss(i) = (1-ssnow%isflag(i))*ssnow%tgg(i,1) + ssnow%isflag(i)*ssnow%tggsn(i,1) diff --git a/src/science/misc/cable_climate.F90 b/src/science/misc/cable_climate.F90 index 09bd32a3d..8b43ce62a 100644 --- a/src/science/misc/cable_climate.F90 +++ b/src/science/misc/cable_climate.F90 @@ -12,7 +12,7 @@ ! ============================================================================== ! Purpose: tracking climate variables for use in phenology and potential pft modules ! -! Called from: cable_driver +! Called from: cable_serial ! ! History: Vanessa Haverd Jan 2015 diff --git a/src/science/pop/POPLUC.F90 b/src/science/pop/POPLUC.F90 index d2d87858e..579551967 100644 --- a/src/science/pop/POPLUC.F90 +++ b/src/science/pop/POPLUC.F90 @@ -12,7 +12,7 @@ ! Purpose: module for land-use change which interacts with POP demography ! via secondary forest age-distribution, and updates casa stocks according to land-use transitions ! -! Called from: cable_driver or cable_mpimaster +! Called from: cable_serial or cable_mpimaster ! ! SUBROUTINES ! ZeroPOPLUC(POPLUC) diff --git a/src/science/sli/cable_sli_main.F90 b/src/science/sli/cable_sli_main.F90 index ff4827235..041784548 100644 --- a/src/science/sli/cable_sli_main.F90 +++ b/src/science/sli/cable_sli_main.F90 @@ -236,7 +236,7 @@ SUBROUTINE sli_main(ktau, dt, veg, soil, ssnow, met, canopy, air, rad, SEB_only) END WHERE h0 = ssnow%h0 - ! zero runoff here, in case error is returned to avoid excessive runoff from previous time-step. (Runoff is multipled by dt in cable_driver.F90) + ! zero runoff here, in case error is returned to avoid excessive runoff from previous time-step. (Runoff is multipled by dt in cable_serial.F90) ssnow%rnof1 = 0.0 ssnow%rnof2 = 0.0 ssnow%runoff = 0.0