diff --git a/src/offline/cable.nml b/src/offline/cable.nml index 8461e014a4..537222fcd2 100644 --- a/src/offline/cable.nml +++ b/src/offline/cable.nml @@ -23,7 +23,7 @@ output%params = .TRUE. ! input parameters used to produce run output%patch = .TRUE. ! write per patch output%balances = .TRUE. ! energy and water balances - check%ranges = 0 ! variable ranges, input and output + check%ranges = 0 ! variable ranges, input and output check%energy_bal = .TRUE. ! energy balance check%mass_bal = .TRUE. ! water/mass balance verbose = .TRUE. ! write details of every grid cell init and params to log? diff --git a/src/offline/cable_checks.F90 b/src/offline/cable_checks.F90 index c0b159b431..5d1b73a5eb 100644 --- a/src/offline/cable_checks.F90 +++ b/src/offline/cable_checks.F90 @@ -84,7 +84,7 @@ MODULE cable_checks_module ESoil = [-0.0015, 0.0015], & TVeg = [-0.0003, 0.0003], & ECanop = [-0.0003, 0.0003], & - PotEvap = [-0.0006, 0.0006], & + PotEvap = [-0.005, 0.005], & !note should encompass Evap ACond = [0.0, 1.0], & SoilWet = [-0.4, 1.2], & Albedo = [0.0, 1.0], & diff --git a/src/offline/cable_driver.F90 b/src/offline/cable_driver.F90 index f786ede8e2..5d8ec690c8 100644 --- a/src/offline/cable_driver.F90 +++ b/src/offline/cable_driver.F90 @@ -163,9 +163,8 @@ PROGRAM cable_offline_driver NRRRR, & ! ctime, & ! day count for casacnp LOY, & ! days in year - count_sum_casa, & ! number of time steps over which casa pools & + count_sum_casa ! number of time steps over which casa pools & !and fluxes are aggregated (for output) - wlogn = 10001 REAL :: dels ! time step size in seconds diff --git a/src/offline/cable_iovars.F90 b/src/offline/cable_iovars.F90 index caf7112475..a2ca5247ac 100644 --- a/src/offline/cable_iovars.F90 +++ b/src/offline/cable_iovars.F90 @@ -25,8 +25,6 @@ MODULE cable_IO_vars_module PUBLIC PRIVATE r_2, mvtype, mstype - !mrd561 debug - INTEGER :: wlogn ! ============ Timing variables ===================== REAL :: shod ! start time hour-of-day @@ -494,6 +492,7 @@ SUBROUTINE set_group_output_values output%Qsb = .TRUE. output%Evap = .TRUE. output%ECanop = .TRUE. + output%PotEvap = .TRUE. output%TVeg = .TRUE. output%ESoil = .TRUE. output%HVeg = .TRUE. diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 0c868afa3f..97ab7b30ec 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -159,7 +159,7 @@ SUBROUTINE mpidrv_master (comm) verbose, fixedCO2,output,check,patchout, & patch_type,landpt,soilparmnew,& defaultLAI, sdoy, smoy, syear, timeunits, exists, output, & - latitude,longitude, calendar + latitude,longitude, calendar, set_group_output_values USE cable_common_module, ONLY: ktau_gl, kend_gl, knode_gl, cable_user, & cable_runtime, fileName, myhome, & redistrb, wiltParam, satuParam, CurYear, & @@ -407,6 +407,10 @@ SUBROUTINE mpidrv_master (comm) ENDIF ! INITIALISATION depending on nml settings + ! Initialise flags to output individual variables according to group + ! options from the namelist file + CALL set_group_output_values() + IF (TRIM(cable_user%MetType) .EQ. 'gswp' .OR. TRIM(cable_user%MetType) .EQ. 'gswp3') THEN IF ( CABLE_USER%YearStart.EQ.0 .AND. ncciy.GT.0) THEN CABLE_USER%YearStart = ncciy diff --git a/src/offline/cable_mpiworker.F90 b/src/offline/cable_mpiworker.F90 index 0f33ede843..f240e557d1 100644 --- a/src/offline/cable_mpiworker.F90 +++ b/src/offline/cable_mpiworker.F90 @@ -111,7 +111,7 @@ MODULE cable_mpiworker INTEGER :: restart_t ! worker's logfile unit - !INTEGER :: wlogn + !INTEGER :: logn !debug moved to iovars -- easy to pass around PUBLIC :: mpidrv_worker @@ -127,13 +127,14 @@ SUBROUTINE mpidrv_worker (comm) USE cable_IO_vars_module, ONLY: logn,gswpfile,ncciy,leaps, globalMetfile, & verbose, fixedCO2,output,check,patchout, & patch_type,soilparmnew,& - defaultLAI, wlogn + defaultLAI, NO_CHECK USE cable_common_module, ONLY: ktau_gl, kend_gl, knode_gl, cable_user, & cable_runtime, filename, myhome, & redistrb, wiltParam, satuParam, CurYear, & IS_LEAPYEAR, calcsoilalbedo, & kwidth_gl, gw_params - USE casa_ncdf_module, ONLY: is_casa_time + USE cable_checks_module, ONLY: constant_check_range + USE casa_ncdf_module, ONLY: is_casa_time USE cable_input_module, ONLY: open_met_file,load_parameters, & get_met_data,close_met_file USE cable_output_module, ONLY: create_restart,open_output_file, & @@ -318,11 +319,11 @@ SUBROUTINE mpidrv_worker (comm) IF ( CABLE_USER%LogWorker ) THEN CALL MPI_Comm_rank (comm, rank, ierr) WRITE(cRank,FMT='(I4.4)')rank - wlogn = 1000+rank - OPEN(wlogn,FILE="cable_log_"//cRank,STATUS="REPLACE") + logn = 1000+rank + OPEN(logn,FILE="cable_log_"//cRank,STATUS="REPLACE") ELSE - wlogn = 1000 - OPEN(wlogn, FILE="/dev/null") + logn = 1000 + OPEN(logn, FILE="/dev/null") ENDIF ! INITIALISATION depending on nml settings @@ -458,10 +459,15 @@ SUBROUTINE mpidrv_worker (comm) & rough,rad,sum_flux,bal) !mrd561 debug - WRITE(wlogn,*) ' ssat_vec min',MINVAL(soil%ssat_vec),MINLOC(soil%ssat_vec) - WRITE(wlogn,*) ' sfc_vec min',MINVAL(soil%sfc_vec),MINLOC(soil%sfc_vec) - WRITE(wlogn,*) ' wb min',MINVAL(ssnow%wb),MINLOC(ssnow%wb) - CALL flush(wlogn) + WRITE(logn,*) ' ssat_vec min',MINVAL(soil%ssat_vec),MINLOC(soil%ssat_vec) + WRITE(logn,*) ' sfc_vec min',MINVAL(soil%sfc_vec),MINLOC(soil%sfc_vec) + WRITE(logn,*) ' wb min',MINVAL(ssnow%wb),MINLOC(ssnow%wb) + CALL flush(logn) + + IF (check%ranges /= NO_CHECK) THEN + WRITE (logn, *) "Checking parameter ranges" + CALL constant_check_range(soil, veg, 0, met) + END IF IF (cable_user%call_climate) THEN CALL worker_climate_types(comm, climate, ktauday ) @@ -501,9 +507,9 @@ SUBROUTINE mpidrv_worker (comm) IF ( CABLE_USER%CASA_DUMP_READ .OR. CABLE_USER%CASA_DUMP_WRITE ) & CALL worker_casa_dump_types(comm, casamet, casaflux, phen, climate) - WRITE(wlogn,*) 'cable_mpiworker, POPLUC: ', CABLE_USER%POPLUC + WRITE(logn,*) 'cable_mpiworker, POPLUC: ', CABLE_USER%POPLUC WRITE(*,*) 'cable_mpiworker, POPLUC: ', CABLE_USER%POPLUC - CALL flush(wlogn) + CALL flush(logn) IF ( CABLE_USER%POPLUC ) & CALL worker_casa_LUC_types( comm, casapool, casabal) @@ -536,7 +542,7 @@ SUBROUTINE mpidrv_worker (comm) IF( icycle>0 .AND. spincasa) THEN - WRITE(wlogn,*) 'EXT spincasacnp enabled with mloop= ', mloop + WRITE(logn,*) 'EXT spincasacnp enabled with mloop= ', mloop CALL worker_spincasacnp(dels,kstart,kend,mloop,veg,soil,casabiome,casapool, & casaflux,casamet,casabal,phen,POP,climate,LALLOC, icomm, ocomm) SPINconv = .FALSE. @@ -591,8 +597,8 @@ SUBROUTINE mpidrv_worker (comm) ! increment total timstep counter ktau_tot = ktau_tot + 1 - WRITE(wlogn,*) 'ktau -',ktau_tot - CALL flush(wlogn) + WRITE(logn,*) 'ktau -',ktau_tot + CALL flush(logn) ! globally (WRT code) accessible kend through USE cable_common_module ktau_gl = ktau_gl + 1 @@ -631,7 +637,7 @@ SUBROUTINE mpidrv_worker (comm) ! MPI: receive casa_dump_data for this step from the master ELSEIF ( IS_CASA_TIME("dread", yyyy, ktau, kstart, koffset, & - kend, ktauday, wlogn) ) THEN + kend, ktauday, logn) ) THEN CALL MPI_Recv (MPI_BOTTOM, 1, casa_dump_t, 0, ktau_gl, icomm, stat, ierr) END IF @@ -681,8 +687,8 @@ SUBROUTINE mpidrv_worker (comm) ! ENDIF IF ( IS_CASA_TIME("write", yyyy, ktau, kstart, & - koffset, kend, ktauday, wlogn) ) THEN - ! write(wlogn,*), 'IN IS_CASA', casapool%cplant(:,1) + koffset, kend, ktauday, logn) ) THEN + ! write(logn,*), 'IN IS_CASA', casapool%cplant(:,1) ! CALL MPI_Send (MPI_BOTTOM,1, casa_t,0,ktau_gl,ocomm,ierr) ENDIF @@ -722,15 +728,15 @@ SUBROUTINE mpidrv_worker (comm) ! ENDIF - CALL flush(wlogn) + CALL flush(logn) IF (icycle >0 .AND. cable_user%CALL_POP) THEN IF (CABLE_USER%POPLUC) THEN - WRITE(wlogn,*), 'before MPI_Send casa_LUC' + WRITE(logn,*), 'before MPI_Send casa_LUC' ! worker sends casa updates required for LUC calculations here CALL MPI_Send (MPI_BOTTOM, 1, casa_LUC_t, 0, 0, ocomm, ierr) - WRITE(wlogn,*), 'after MPI_Send casa_LUC' + WRITE(logn,*), 'after MPI_Send casa_LUC' ! master calls LUCDriver here ! worker receives casa and POP updates CALL MPI_Recv( POP%pop_grid(1), POP%np, pop_t, 0, 0, icomm, stat, ierr ) @@ -782,7 +788,7 @@ SUBROUTINE mpidrv_worker (comm) ! ! Write to screen and log file: ! WRITE(*,'(A18,I3,A24)') ' Spinning up: run ',INT(ktau_tot/kend), & ! ' of data set complete...' - ! WRITE(wlogn,'(A18,I3,A24)') ' Spinning up: run ',INT(ktau_tot/kend), & + ! WRITE(logn,'(A18,I3,A24)') ' Spinning up: run ',INT(ktau_tot/kend), & ! ' of data set complete...' ! ! ! IF not 1st run through whole dataset: @@ -877,7 +883,7 @@ SUBROUTINE mpidrv_worker (comm) ! Close log file ! MPI: closes handle to /dev/null in workers - CLOSE(wlogn) + CLOSE(logn) RETURN @@ -6792,7 +6798,7 @@ SUBROUTINE worker_restart_type (comm, canopy, air) !mcd287 CALL MPI_Reduce (tsize, tsize, 1, MPI_INTEGER, MPI_SUM, 0, comm, ierr) WRITE(*,*) 'b4 reduce wk', tsize, MPI_DATATYPE_NULL, 1, MPI_INTEGER, MPI_SUM, 0, comm, ierr CALL flush(6) - !call flush(wlogn) + !call flush(logn) CALL MPI_Reduce (tsize, MPI_DATATYPE_NULL, 1, MPI_INTEGER, MPI_SUM, 0, comm, ierr) DEALLOCATE(types) @@ -7226,7 +7232,7 @@ SUBROUTINE worker_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo USE biogeochem_mod, ONLY : biogeochem !mrd561 debug - USE cable_IO_vars_module, ONLY: wlogn + USE cable_IO_vars_module, ONLY: logn IMPLICIT NONE !CLN CHARACTER(LEN=99), INTENT(IN) :: fcnpspin @@ -7568,11 +7574,11 @@ SUBROUTINE worker_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo ENDDO ! end of nyear ENDDO ! end of nloop - WRITE(wlogn,*) 'b4 MPI_SEND' + WRITE(logn,*) 'b4 MPI_SEND' CALL MPI_Send (MPI_BOTTOM, 1, casa_t, 0, 0, ocomm, ierr) - WRITE(wlogn,*) 'after MPI_SEND' + WRITE(logn,*) 'after MPI_SEND' IF(CABLE_USER%CALL_POP) CALL worker_send_pop (POP, ocomm) - WRITE(wlogn,*) 'cplant', casapool%cplant + WRITE(logn,*) 'cplant', casapool%cplant END SUBROUTINE worker_spincasacnp @@ -7596,7 +7602,7 @@ SUBROUTINE worker_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & USE biogeochem_mod, ONLY : biogeochem !mrd561 debug - USE cable_IO_vars_module, ONLY: wlogn + USE cable_IO_vars_module, ONLY: logn IMPLICIT NONE !CLN CHARACTER(LEN=99), INTENT(IN) :: fcnpspin @@ -7695,45 +7701,45 @@ SUBROUTINE worker_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & ENDIF IF(idoy==mdyear) THEN ! end of year - WRITE(wlogn,*) 'b4 MPI_SEND,casa_LUC_t', casapool%cplant(:,2) - CALL flush(wlogn) + WRITE(logn,*) 'b4 MPI_SEND,casa_LUC_t', casapool%cplant(:,2) + CALL flush(logn) CALL MPI_Send (MPI_BOTTOM, 1, casa_LUC_t, 0, 0, ocomm, ierr) - WRITE(wlogn,*) 'after MPI_SEND,casa_LUC_t', casapool%cplant(:,2) - CALL flush(wlogn) + WRITE(logn,*) 'after MPI_SEND,casa_LUC_t', casapool%cplant(:,2) + CALL flush(logn) StemNPP(:,1) = casaflux%stemnpp StemNPP(:,2) = 0.0 CALL MPI_Comm_rank (icomm, rank, ierr) - WRITE(wlogn,*) - WRITE(wlogn,*),'rank receiving pop_grid from master', rank -!$ write(wlogn,*) 'b4 MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum -!$ write(wlogn,*) 'b4 MPI_Recv, pop_t LU: ', POP%pop_grid%LU + WRITE(logn,*) + WRITE(logn,*),'rank receiving pop_grid from master', rank +!$ write(logn,*) 'b4 MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum +!$ write(logn,*) 'b4 MPI_Recv, pop_t LU: ', POP%pop_grid%LU CALL MPI_Recv( POP%pop_grid(1), POP%np, pop_t, 0, 0, icomm, stat, ierr ) -!$ write(wlogn,*) -!$ write(wlogn,*) 'after MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum - WRITE(wlogn,*) 'after MPI_Recv, pop_t ' - CALL flush(wlogn) +!$ write(logn,*) +!$ write(logn,*) 'after MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum + WRITE(logn,*) 'after MPI_Recv, pop_t ' + CALL flush(logn) IF (cable_user%CALL_POP .AND. POP%np.GT.0) THEN ! CALL_POP - WRITE(wlogn,*), 'b4 POPdriver', POP%pop_grid%cmass_sum + WRITE(logn,*), 'b4 POPdriver', POP%pop_grid%cmass_sum CALL POPdriver(casaflux,casabal,veg, POP) ENDIF -!$ write(wlogn,*) -!$ write(wlogn,*) 'after POPstep cmass: ', POP%pop_grid%cmass_sum - WRITE(wlogn,*) 'after POPstep ', POP%pop_grid%cmass_sum - CALL flush(wlogn) +!$ write(logn,*) +!$ write(logn,*) 'after POPstep cmass: ', POP%pop_grid%cmass_sum + WRITE(logn,*) 'after POPstep ', POP%pop_grid%cmass_sum + CALL flush(logn) CALL worker_send_pop (POP, ocomm) - WRITE(wlogn,*) 'after worker_send_pop' - CALL flush(wlogn) + WRITE(logn,*) 'after worker_send_pop' + CALL flush(logn) ENDIF ENDDO ! receive updates to CASA pools resulting from LUC - WRITE(wlogn,*) - WRITE(wlogn,*) 'b4 mpi_recv casa_LUC_t ' + WRITE(logn,*) + WRITE(logn,*) 'b4 mpi_recv casa_LUC_t ' CALL MPI_Recv (MPI_BOTTOM, 1, casa_LUC_t, 0, nyear, icomm, stat, ierr) - WRITE(wlogn,*) 'after mpi_recv casa_LUC_t: ' + WRITE(logn,*) 'after mpi_recv casa_LUC_t: ' ENDDO END SUBROUTINE WORKER_CASAONLY_LUC diff --git a/src/offline/cable_output.F90 b/src/offline/cable_output.F90 index a30603432d..04cb67a439 100644 --- a/src/offline/cable_output.F90 +++ b/src/offline/cable_output.F90 @@ -57,7 +57,7 @@ MODULE cable_output_module Qmom, Qle, Qh, Qg, NEE, SWnet, & LWnet, SoilMoist, SoilTemp, Albedo, & visAlbedo, nirAlbedo, SoilMoistIce, & - Qs, Qsb, Evap, BaresoilT, SWE, SnowT, & + Qs, Qsb, Evap, PotEvap, BaresoilT, SWE, SnowT, & RadT, VegT, Ebal, Wbal, AutoResp, RootResp, & StemResp, LeafResp, HeteroResp, GPP, NPP, LAI, & ECanop, TVeg, ESoil, CanopInt, SnowDepth, & @@ -549,6 +549,13 @@ SUBROUTINE open_output_file(dels, soil, veg, bgc, rough, met) ALLOCATE(out%Evap(mp)) out%Evap = 0.0 ! initialise END IF + IF(output%PotEvap) THEN + CALL define_ovar(ncid_out, ovid%PotEvap,'PotEvap', 'kg/m^2/s', & + 'Potential evaporation', patchout%PotEvap, 'dummy', & + xID, yID, zID, landID, patchID, tID) + ALLOCATE(out%PotEvap(mp)) + out%PotEvap = 0.0 ! initialise + END IF IF(output%ECanop) THEN CALL define_ovar(ncid_out, ovid%Ecanop, 'ECanop', 'kg/m^2/s', & 'Wet canopy evaporation', patchout%ECanop, 'dummy', & @@ -1732,6 +1739,8 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss CALL generate_out_write_acc(output%Qsb, ovid%Qsb, 'Qsb', out%Qsb, REAL(ssnow%rnof2/dels, 4), ranges%Qsb, patchout%Qsb, out_settings) ! Evap: total evapotranspiration [kg/m^2/s] CALL generate_out_write_acc(output%Evap, ovid%Evap, 'Evap', out%Evap, REAL(canopy%fe/air%rlam, 4), ranges%Evap, patchout%Evap, out_settings) + ! PotEVap: potential evapotranspiration [kg/m^2/s] + CALL generate_out_write_acc(output%PotEvap, ovid%PotEvap, 'PotEvap', out%PotEvap, REAL(canopy%epot/dels, 4), ranges%PotEvap, patchout%PotEvap, out_settings) ! ECanop: interception evaporation [kg/m^2/s] CALL generate_out_write_acc(output%ECanop, ovid%ECanop, 'ECanop', out%ECanop, REAL(canopy%fevw/air%rlam, 4), ranges%ECanop, patchout%ECanop, out_settings) ! TVeg: vegetation transpiration [kg/m^2/s] diff --git a/src/offline/cable_soilparm.nml b/src/offline/cable_soilparm.nml index 23b70c05fe..2f325849fb 100644 --- a/src/offline/cable_soilparm.nml +++ b/src/offline/cable_soilparm.nml @@ -13,7 +13,7 @@ soilin%bch=4.2,7.1,11.4,5.15,10.4,10.4,7.12,5.83,7.1, soilin%clay=0.09,0.3,0.67,0.2,0.42,0.48,0.27,0.17,0.3, soilin%css=7*850,1920,2100, soilin%hyds=0.000166,0.000004,0.000001,0.000021,0.000002,0.000001,0.000006,0.0008,0.000001, -soilin%rhosoil=1600,1600,1381,1373,1476,1521,1373,1537,910, +soilin%rhosoil=1600,1600,1381,1373,1476,1521,1373,1537,917, soilin%sand=0.83,0.37,0.16,0.6,0.52,0.27,0.58,0.13,0.37, soilin%sfc=0.143,0.301,0.367,0.218,0.31,0.37,0.255,0.45,0.301, soilin%silt=0.08,0.33,0.17,0.2,0.06,0.25,0.15,0.7,0.33, diff --git a/src/offline/casa_cable.F90 b/src/offline/casa_cable.F90 index 685c90704b..526ec97835 100644 --- a/src/offline/casa_cable.F90 +++ b/src/offline/casa_cable.F90 @@ -58,9 +58,6 @@ SUBROUTINE POPdriver(casaflux,casabal,veg, POP) !! vh_js !! INTEGER, allocatable :: Iw(:) ! array of indices corresponding to woody (shrub or forest) tiles - ! INTEGER, INTENT(IN) :: wlogn - INTEGER , parameter :: wlogn=6 - if (.NOT.Allocated(LAIMax)) allocate(LAIMax(mp)) if (.NOT.Allocated(Cleafmean)) allocate(Cleafmean(mp)) if (.NOT.Allocated(Crootmean)) allocate(Crootmean(mp)) diff --git a/src/params/cable_phys_constants_mod.F90 b/src/params/cable_phys_constants_mod.F90 index f0328a6d7e..c439a5da36 100644 --- a/src/params/cable_phys_constants_mod.F90 +++ b/src/params/cable_phys_constants_mod.F90 @@ -21,27 +21,27 @@ MODULE cable_phys_constants_mod PUBLIC -REAL, PARAMETER :: tfrz = 273.16 ! Temp (K) corresp. to 0 C -REAL, PARAMETER :: sboltz = 5.67e-8 ! Stefan-Boltz. const (W/m2/K4) -REAL, PARAMETER :: emsoil = 1.0 ! soil emissivity -REAL, PARAMETER :: emleaf = 1.0 ! leaf emissivity -REAL, PARAMETER :: capp = 1004.64 ! air spec. heat (J/kg/K) -REAL, PARAMETER :: hl = 2.5014e6 ! latent heat of vaporization (J/s/m2) +REAL, PARAMETER :: tfrz = 273.16 ! Temp (K) corresp. to 0 C +REAL, PARAMETER :: sboltz = 5.67e-8 ! Stefan-Boltz. const (W/m2/K4) +REAL, PARAMETER :: emsoil = 1.0 ! soil emissivity +REAL, PARAMETER :: emleaf = 1.0 ! leaf emissivity +REAL, PARAMETER :: capp = 1004.64 ! air spec. heat (J/kg/K) +REAL, PARAMETER :: hl = 2.5014e6 ! latent heat of vaporization (J/kg) !Below are constants used in CABLE model which are not as yet used in JAC-6.2 -REAL, PARAMETER :: hlf = 0.334e6 ! latent heat of fusion -REAL, PARAMETER :: hls = 2.8350e6 ! latent heatOFsublimation (J/kg) -REAL, PARAMETER :: dheat = 21.5e-6 ! molecular diffusivity for heat -REAL, PARAMETER :: grav = 9.8086 ! gravity acceleration (m/s2) -REAL, PARAMETER :: rgas = 8.3143 ! universal gas const (J/mol/K) -REAL, PARAMETER :: rmair = 0.02897 ! molecular wt: dry air (kg/mol) -REAL, PARAMETER :: rmh2o = 0.018016 ! molecular wt: water (kg/mol) -REAL, PARAMETER :: cgsnow = 2090.0 ! specific heat for snow (J/kg/K) -REAL, PARAMETER :: cs_rho_ice = 1.9341e6 !heat capacity * density ice -REAL, PARAMETER :: cs_rho_wat = 4.218e6 ! heat capacity * density water -REAL, PARAMETER :: csice = 2.100e3 ! specific heat for ice (J/kg/K) -REAL, PARAMETER :: cswat = 4.218e3 ! specific heat for water at 0°C (J/kg/K) -REAL, PARAMETER :: density_liq = 1000.0 ! density of liquid water -REAL, PARAMETER :: density_ice = 921.0 ! denisty of ice +REAL, PARAMETER :: hlf = 0.334e6 ! latent heat of fusion (J/kg) +REAL, PARAMETER :: hls = 2.8350e6 ! latent heat of sublimation (J/kg) +REAL, PARAMETER :: dheat = 21.5e-6 ! molecular diffusivity for heat (cm2/s) +REAL, PARAMETER :: grav = 9.8086 ! gravity acceleration (m/s2) +REAL, PARAMETER :: rgas = 8.3143 ! universal gas const (J/mol/K) +REAL, PARAMETER :: rmair = 0.02897 ! molecular wt: dry air (kg/mol) +REAL, PARAMETER :: rmh2o = 0.018016 ! molecular wt: water (kg/mol) +REAL, PARAMETER :: cgsnow = 2090.0 ! specific heat for snow (J/kg/K) +REAL, PARAMETER :: cs_rho_ice = 1.9257e6 ! heat capacity * density ice +REAL, PARAMETER :: cs_rho_wat = 4.218e6 ! heat capacity * density water +REAL, PARAMETER :: csice = 2.100e3 ! specific heat for ice (J/kg/K) +REAL, PARAMETER :: cswat = 4.218e3 ! specific heat for water at 0°C (J/kg/K) +REAL, PARAMETER :: density_liq = 1000.0 ! density of liquid water +REAL, PARAMETER :: density_ice = 917.0 ! density of ice ! Teten coefficients REAL, PARAMETER :: tetena = 6.106 ! Magnus Tetans (Murray 1967) diff --git a/src/science/canopy/cable_canopy.F90 b/src/science/canopy/cable_canopy.F90 index 8514645a67..8546f17e4a 100644 --- a/src/science/canopy/cable_canopy.F90 +++ b/src/science/canopy/cable_canopy.F90 @@ -668,6 +668,10 @@ SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,clima ENDDO + ! INH #335 - we don't need to weight components of %epot by %transd + ! however coupled model uses %wetfac_cs so overwrite here before testing in ACCESS + canopy%epot = (canopy%fevw_pot + ssnow%potev/ssnow%cls) * dels/air%rlam + CALL update_zetar( mp, iterplus, NITER, canopy%zetar, iter, nrb, CVONK, CGRAV, CCAPP, & CLAI_THRESH, CZETmul, CZETPOS, CZETNEG, & cable_user%soil_struc, air%rho, met%tk, met%fsd, & @@ -746,12 +750,12 @@ SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,clima IF( zscl(j) < rough%disp(j) ) THEN - !Ticket #154 + !Ticket #154 - issue #313 !r_sc(j) = term5(j) * LOG(zscl(j)/rough%z0soilsn(j)) * & ! ( EXP(2*CCSW*canopy%rghlai(j)) - term1(j) ) / term3(j) r_sc(j) = term5(j) * LOG(zscl(j)/rough%z0soilsn(j)) * & ( EXP(2*CCSW*canopy%rghlai(j)) - term2(j) ) / term3(j) - r_sc(j) = r_sc(j) + term5(j) * LOG(rough%disp(j)/rough%z0soilsn(j)) * & + r_sc(j) = r_sc(j) + term5(j) * LOG(rough%disp(j)/zscl(j)) * & ( EXP(2*CCSW*canopy%rghlai(j)) - term1(j) ) / term3(j) ELSEIF( rough%disp(j) <= zscl(j) .AND. & diff --git a/src/science/casa-cnp/bgcdriver.F90 b/src/science/casa-cnp/bgcdriver.F90 index bb5944edc5..4678836650 100644 --- a/src/science/casa-cnp/bgcdriver.F90 +++ b/src/science/casa-cnp/bgcdriver.F90 @@ -63,8 +63,6 @@ SUBROUTINE bgcdriver(ktau,kstart,kend,dels,met,ssnow,canopy,veg,soil, & CHARACTER :: cyear*4 CHARACTER :: ncfile*99 - INTEGER , parameter :: wlogn=6 - IF ( .NOT. dump_read ) THEN ! construct casa met and flux inputs from current CABLE run IF ( TRIM(cable_user%MetType) .EQ. 'cru' ) THEN diff --git a/src/science/gw_hydro/cable_gw_hydro.F90 b/src/science/gw_hydro/cable_gw_hydro.F90 index e7cf339188..84551060f2 100644 --- a/src/science/gw_hydro/cable_gw_hydro.F90 +++ b/src/science/gw_hydro/cable_gw_hydro.F90 @@ -910,10 +910,9 @@ END SUBROUTINE smoistgw ! Output ! ssnow SUBROUTINE soil_snow_gw(dels, soil, ssnow, canopy, met, bal, veg) - USE cable_IO_vars_module, ONLY: wlogn - USE cable_common_module -USE snow_processes_soil_thermal_mod, ONLY : snow_processes_soil_thermal + USE snow_processes_soil_thermal_mod, ONLY : snow_processes_soil_thermal + REAL , INTENT(IN) :: dels ! integration time step (s) TYPE(soil_parameter_type), INTENT(INOUT) :: soil TYPE(soil_snow_type) , INTENT(INOUT) :: ssnow diff --git a/src/science/pop/POP.F90 b/src/science/pop/POP.F90 index 4c29a65994..13d726122a 100755 --- a/src/science/pop/POP.F90 +++ b/src/science/pop/POP.F90 @@ -357,7 +357,6 @@ SUBROUTINE POPStep(POP, StemNPP, disturbance_interval, disturbance_intensity,LAI INTEGER(i4b), ALLOCATABLE :: it(:) REAL(dp):: dallocW - !INTEGER, INTENT(IN) :: wlogn pop%it_pop = pop%it_pop + 1 !it = pop%it_pop(1) @@ -373,7 +372,6 @@ SUBROUTINE POPStep(POP, StemNPP, disturbance_interval, disturbance_intensity,LAI !$ !$ CALL GetPatchFrequencies(POP,it) - !call flush(wlogn) IF (PRESENT(precip)) THEN IF(PRESENT(StemNPP_av)) THEN CALL PatchAnnualDynamics(POP, StemNPP,NPPtoGPP,disturbance_interval, it, precip=precip,StemNPP_av=StemNPP_av) diff --git a/src/science/sli/cable_sli_main.F90 b/src/science/sli/cable_sli_main.F90 index c938e6adeb..ff48272356 100644 --- a/src/science/sli/cable_sli_main.F90 +++ b/src/science/sli/cable_sli_main.F90 @@ -22,11 +22,9 @@ SUBROUTINE sli_main(ktau, dt, veg, soil, ssnow, met, canopy, air, rad, SEB_only) USE sli_roots, ONLY: setroots, getrex USE sli_solve, ONLY: solve - USE cable_IO_vars_module, ONLY: wlogn, verbose + USE cable_IO_vars_module, ONLY: verbose IMPLICIT NONE - !INTEGER, INTENT(IN) :: wlogn - !INTEGER :: wlogn = 10001 !use correct value from io_vars module REAL, INTENT(IN) :: dt TYPE(veg_parameter_type), INTENT(INOUT) :: veg ! all r_1 TYPE(soil_parameter_type), INTENT(INOUT) :: soil ! all r_1 diff --git a/src/science/sli/cable_sli_solve.F90 b/src/science/sli/cable_sli_solve.F90 index d3b703ec8e..b861b02291 100644 --- a/src/science/sli/cable_sli_solve.F90 +++ b/src/science/sli/cable_sli_solve.F90 @@ -84,7 +84,7 @@ MODULE sli_solve csat, slope_csat, potential_evap, tri, setsol, zerovars, & esat_ice, slope_esat_ice, Tfrozen, rtbis_Tfrozen, GTFrozen, & JSoilLayer, esat, forcerestore, SEB - USE cable_IO_vars_module, ONLY: wlogn + USE cable_IO_vars_module, ONLY: logn IMPLICIT NONE @@ -1326,16 +1326,16 @@ SUBROUTINE update_s_t( & tmp1d4(kk) = thetalmax(tmp1d3(kk), S(i), par(i)%he, one/(par(i)%lambc*freezefac), & par(i)%thre, par(i)%the) ! liquid content at solution for Tsoil ELSE - WRITE(wlogn,*) "Found no solution for Tfrozen 1. ", kk, i - WRITE(wlogn,*) "Assume soil is totally frozen" + WRITE(logn,*) "Found no solution for Tfrozen 1. ", kk, i + WRITE(logn,*) "Assume soil is totally frozen" var(i)%thetal = 0.0_r_2 var(i)%thetai = theta IF (i.EQ.1) hice(kk) = h0(kk) tmp1d3(kk) = (tmp1d2(kk) + rhow*lambdaf*(theta*dx(i) + MERGE(h0(kk),zero,i==1)))/ & (dx(i)*par(i)%css*par(i)%rho + rhow*csice*(theta*dx(i) + & MERGE(h0(kk),zero,i==1))) - WRITE(wlogn,*) "frozen soil temperature: ", tmp1d3(kk) - WRITE(wlogn,*) nsteps(kk), S(i), Tsoil(i), dTsoil(i), h0(kk), tmp1, tmp2, tmp1d2(kk), theta, & + WRITE(logn,*) "frozen soil temperature: ", tmp1d3(kk) + WRITE(logn,*) nsteps(kk), S(i), Tsoil(i), dTsoil(i), h0(kk), tmp1, tmp2, tmp1d2(kk), theta, & JSoilLayer(Tfreezing(kk), & dx(i), theta,par(i)%css, par(i)%rho, & MERGE(h0(kk),zero,i==1), par(i)%thre, par(i)%the, & @@ -1994,16 +1994,16 @@ SUBROUTINE get_and_solve_eqn( & itmp(kk) = itmp(kk) + 1 accel(kk) = one - 0.05_r_2*REAL(MIN(10,MAX(0,itmp(kk)-4)),r_2) ! acceleration [0.5,1], start with 1 IF (itmp(kk) > 1000) THEN - WRITE(wlogn,*) "Solve: too many iterations of equation solution" - WRITE(wlogn,*) " irec, kk, S" - WRITE(wlogn,*) irec, kk, S(:) - WRITE(wlogn,*) " irec, kk, Tsoil" - WRITE(wlogn,*) irec, kk, Tsoil(:) - WRITE(wlogn,*) " irec, kk, qex" - WRITE(wlogn,*) irec, kk, iqex(:) - WRITE(wlogn,*) " irec, kk, h0, hsnow, hsnowliq" - WRITE(wlogn,*) irec, kk, h0(kk), vsnow(kk)%hsnow, vsnow(kk)%hliq - WRITE(wlogn,*) nfac1(kk), nfac2(kk), nfac3(kk), nfac4(kk), nfac5(kk), & + WRITE(logn,*) "Solve: too many iterations of equation solution" + WRITE(logn,*) " irec, kk, S" + WRITE(logn,*) irec, kk, S(:) + WRITE(logn,*) " irec, kk, Tsoil" + WRITE(logn,*) irec, kk, Tsoil(:) + WRITE(logn,*) " irec, kk, qex" + WRITE(logn,*) irec, kk, iqex(:) + WRITE(logn,*) " irec, kk, h0, hsnow, hsnowliq" + WRITE(logn,*) irec, kk, h0(kk), vsnow(kk)%hsnow, vsnow(kk)%hliq + WRITE(logn,*) nfac1(kk), nfac2(kk), nfac3(kk), nfac4(kk), nfac5(kk), & nfac6(kk), nfac7(kk), nfac8(kk), nfac9(kk), nfac10(kk), nfac11(kk), nfac12(kk) err = 1 RETURN @@ -2172,8 +2172,8 @@ SUBROUTINE get_and_solve_eqn( & ff(nns(kk):n-1), ffh(nns(kk):n-1), gg(nns(kk):n), ggh(nns(kk):n), & dy(nns(kk):n), de(nns(kk):n), condition=condition, err=err) IF (err /= 0) THEN - WRITE(wlogn,*) "Sparse matrix solution failed ", irec, kk - WRITE(wlogn,*) Tsoil(1), S(1) + WRITE(logn,*) "Sparse matrix solution failed ", irec, kk + WRITE(logn,*) Tsoil(1), S(1) RETURN ENDIF @@ -2518,7 +2518,7 @@ SUBROUTINE get_and_solve_eqn( & nsteps(kk) = nsteps(kk) + 1 !$ if ((irec.eq.8992).and.(kk.eq.1) ) then -!$ !if ((irec.eq.5).and.(kk.eq.1626) .and. wlogn == 1011) then +!$ !if ((irec.eq.5).and.(kk.eq.1626) .and. logn == 1011) then !$ write(*,*) 'writing diags', again(kk), nsteps(kk) !$ !$ ! if (.not. again(kk)) then @@ -2540,9 +2540,9 @@ SUBROUTINE get_and_solve_eqn( & !$ endif IF (nsteps(kk) > nsteps_max) THEN - WRITE(wlogn,*) "nsteps > nsteps_max ", irec, kk - WRITE(wlogn,*) Tsoil(1), S(1) - WRITE(wlogn,*) nfac1(kk), nfac2(kk), nfac3(kk), nfac4(kk), nfac5(kk), & + WRITE(logn,*) "nsteps > nsteps_max ", irec, kk + WRITE(logn,*) Tsoil(1), S(1) + WRITE(logn,*) nfac1(kk), nfac2(kk), nfac3(kk), nfac4(kk), nfac5(kk), & nfac6(kk), nfac7(kk), nfac8(kk), nfac9(kk), nfac10(kk), nfac11(kk), nfac12(kk) err = 1 RETURN @@ -3993,12 +3993,12 @@ SUBROUTINE snow_adjust(irec, mp, n, kk, ns, h0, hice, thetai, dx, vsnow, var, pa tmp1d4(kk) = thetalmax(tmp1d3(kk), S(1), par(1)%he, one/(par(1)%lambc*freezefac), & par(1)%thre, par(1)%the) ! liquid content at new Tsoil ELSE - WRITE(wlogn,*) "Found no solution for Tfrozen 2. ", kk, i - WRITE(wlogn,*) "Assume soil is totally frozen" + WRITE(logn,*) "Found no solution for Tfrozen 2. ", kk, i + WRITE(logn,*) "Assume soil is totally frozen" tmp1d3(kk) = (tmp1d2(kk) + rhow*lambdaf*(theta*dx(1) + h0(kk))) / & (dx(1)*par(1)%css*par(1)%rho + rhow*csice*(theta*dx(1) + h0(kk))) tmp1d4(kk) = 0.0_r_2 - WRITE(wlogn,*) "frozen soil temperature: ", tmp1d3(kk) + WRITE(logn,*) "frozen soil temperature: ", tmp1d3(kk) ENDIF hice_tmp(kk) = hice(kk) @@ -4165,12 +4165,12 @@ SUBROUTINE snow_adjust(irec, mp, n, kk, ns, h0, hice, thetai, dx, vsnow, var, pa tmp1d4(kk) = thetalmax(tmp1d3(kk), S(1), par(1)%he, one/(par(1)%lambc*freezefac), & par(1)%thre, par(1)%the) ! liquid content at new Tsoil ELSE - WRITE(wlogn,*) "Found no solution for Tfrozen 3. ", kk, i - WRITE(wlogn,*) "Assume soil is totally frozen" + WRITE(logn,*) "Found no solution for Tfrozen 3. ", kk, i + WRITE(logn,*) "Assume soil is totally frozen" tmp1d3(kk) = (Jsoil + rhow*lambdaf*(theta*dx(1) + h0(kk))) / & (dx(1)*par(1)%css*par(1)%rho + rhow*csice*(theta*dx(1) + h0(kk))) tmp1d4(kk) = 0.0_r_2 - WRITE(wlogn,*) "frozen soil temperature: ", tmp1d3(kk) + WRITE(logn,*) "frozen soil temperature: ", tmp1d3(kk) ENDIF var(1)%thetal = MAX(tmp1d4(kk), zero) @@ -4416,11 +4416,11 @@ SUBROUTINE snow_adjust(irec, mp, n, kk, ns, h0, hice, thetai, dx, vsnow, var, pa par(1)%thre, par(1)%the) ! liquid content at new Tsoil ELSE WRITE(*,*) "Found no solution for Tfrozen 4.", irec, qmelt(1), h0(kk) - WRITE(wlogn,*) "Assume soil is totally frozen" + WRITE(logn,*) "Assume soil is totally frozen" tmp1d3(kk) = (Jsoil + rhow*lambdaf*(theta*dx(1) + h0(kk))) / & (dx(1)*par(1)%css*par(1)%rho + rhow*csice*(theta*dx(1) + h0(kk))) tmp1d4(kk) = 0.0_r_2 - WRITE(wlogn,*) "frozen soil temperature: ", tmp1d3(kk) + WRITE(logn,*) "frozen soil temperature: ", tmp1d3(kk) ENDIF var(1)%thetal = MAX(tmp1d4(kk), zero) @@ -4554,7 +4554,7 @@ SUBROUTINE snow_adjust(irec, mp, n, kk, ns, h0, hice, thetai, dx, vsnow, var, pa ENDIF IF (vsnow(kk)%hsnow(1).LT.zero.OR.vsnow(kk)%hsnow(nsnow_max).LT.zero) THEN - WRITE(wlogn,*) "hsnow<0. Set it to 0 (irec, kk, hsnow):", irec, kk, vsnow(kk)%hsnow(1) + WRITE(logn,*) "hsnow<0. Set it to 0 (irec, kk, hsnow):", irec, kk, vsnow(kk)%hsnow(1) vsnow(kk)%hsnow(1) = zero ENDIF diff --git a/src_pop/core/biogeochem/POP.F90 b/src_pop/core/biogeochem/POP.F90 index c3c5dba5a7..a882873349 100755 --- a/src_pop/core/biogeochem/POP.F90 +++ b/src_pop/core/biogeochem/POP.F90 @@ -627,7 +627,6 @@ SUBROUTINE POPStep(POP, StemNPP, disturbance_interval, disturbance_intensity,LAI INTEGER(i4b) :: idisturb,np,g INTEGER(i4b), allocatable :: it(:) - !INTEGER, INTENT(IN) :: wlogn pop%it_pop = pop%it_pop + 1 !it = pop%it_pop(1) np = SIZE(POP%POP_grid) @@ -642,7 +641,6 @@ SUBROUTINE POPStep(POP, StemNPP, disturbance_interval, disturbance_intensity,LAI ! CALL GetPatchFrequencies(POP) - !call flush(wlogn) IF (PRESENT(precip)) THEN IF(PRESENT(StemNPP_av)) THEN CALL PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it, precip=precip, StemNPP_av=StemNPP_av) diff --git a/src_pop/core/biogeochem/POPLUC.F90 b/src_pop/core/biogeochem/POPLUC.F90 index dd17c9c7f7..a3d2a64de1 100644 --- a/src_pop/core/biogeochem/POPLUC.F90 +++ b/src_pop/core/biogeochem/POPLUC.F90 @@ -121,7 +121,7 @@ MODULE POPLUC_Module USE casavariable, ONLY: casa_pool, casa_balance, casa_flux, casa_biome USE POP_Types, ONLY: POP_TYPE USE cable_common_module, ONLY: cable_user - USE cable_IO_vars_module, ONLY: landpt, patch, wlogn + USE cable_IO_vars_module, ONLY: landpt, patch USE CABLE_LUC_EXPT, ONLY: LUC_EXPT_TYPE USE POPModule, ONLY: pop_init_single diff --git a/src_pop/core/biogeochem/casa_cnp.F90 b/src_pop/core/biogeochem/casa_cnp.F90 index 8429c73ad1..a7b25abc43 100644 --- a/src_pop/core/biogeochem/casa_cnp.F90 +++ b/src_pop/core/biogeochem/casa_cnp.F90 @@ -60,7 +60,6 @@ MODULE casa_cnp_module USE casaparm USE casavariable USE phenvariable - USE cable_IO_vars_module, ONLY: wlogn USE cable_common_module, only: cable_user ! Custom soil respiration: Ticket #42 implicit none