diff --git a/offline/cable_LUC_EXPT.F90 b/offline/cable_LUC_EXPT.F90 index a2439c995..f64fc7479 100644 --- a/offline/cable_LUC_EXPT.F90 +++ b/offline/cable_LUC_EXPT.F90 @@ -2,6 +2,7 @@ MODULE CABLE_LUC_EXPT use cable_common_module, only: is_leapyear, leap_day, handle_err, get_unit use cable_io_vars_module, only: logn, land_x, land_y, landpt, latitude, longitude + USE cable_common_module, ONLY: cable_user use cable_def_types_mod, only: mland implicit none @@ -66,13 +67,14 @@ MODULE CABLE_LUC_EXPT ! ------------------------------------------------------------------ - SUBROUTINE LUC_EXPT_INIT(LUC_EXPT) + SUBROUTINE LUC_EXPT_INIT(inMVG, LUC_EXPT) use netcdf, only: nf90_open, nf90_nowrite, nf90_inq_varid, nf90_inq_dimid, & nf90_inquire_dimension, nf90_inq_varid, nf90_get_att, nf90_get_var, nf90_close implicit none + INTEGER, INTENT(IN) :: inMVG(:, :) type(luc_expt_type), intent(inout) :: luc_expt REAL :: tmp @@ -374,6 +376,12 @@ SUBROUTINE LUC_EXPT_INIT(LUC_EXPT) PrimOnly_fID = -1 ENDIF + IF (TRIM(cable_user%MetType) .EQ. "bios") THEN + DO k = 1, mland + LUC_EXPT%biome(k) = inMVG(landpt(k)%ilon,landpt(k)%ilat) + ENDDO + END IF + ! Determine woody fraction (forest and shrub cover). call get_woody_fraction(LUC_EXPT) @@ -452,14 +460,12 @@ end subroutine luc_expt_zero subroutine get_woody_fraction(LUC_EXPT) ! Determine woody fraction (forest and shrub cover) from ancillary data. - use cable_bios_met_obs_params, only: cable_bios_load_biome use cable_common_module, only: cable_user implicit none type(LUC_EXPT_type), intent(inout) :: LUC_EXPT real :: CPC(mland) - integer :: MVG(mland) real :: projection_factor if (TRIM(cable_user%MetType) .EQ. "bios") then @@ -468,10 +474,8 @@ subroutine get_woody_fraction(LUC_EXPT) ! Woody fraction (woodfrac) is then calculated from CPC. ! read bios parameter file to NVIS Major Vegetation Group "biomes" - call cable_bios_load_biome(MVG) ! adjust fraction woody cover based on Major Vegetation Group - LUC_EXPT%biome = MVG LUC_EXPT%ivegp = 2 projection_factor = 0.65 WHERE (LUC_EXPT%biome .eq. 1) @@ -660,21 +664,17 @@ END SUBROUTINE LUC_EXPT_SET_TILES ! ------------------------------------------------------------------ - SUBROUTINE LUC_EXPT_SET_TILES_BIOS(inVeg, inPfrac, LUC_EXPT ) - - USE cable_bios_met_obs_params, ONLY: cable_bios_load_fracC4 + SUBROUTINE LUC_EXPT_SET_TILES_BIOS(inVeg, inPfrac, infracC4, LUC_EXPT ) IMPLICIT NONE INTEGER, INTENT(INOUT) :: inVeg(:,:,:) REAL, INTENT(INOUT) :: inPFrac(:,:,:) - TYPE (LUC_EXPT_TYPE), INTENT(INOUT) :: LUC_EXPT + REAL, INTENT(IN) :: infracC4(:,:) + TYPE (LUC_EXPT_TYPE), INTENT(IN) :: LUC_EXPT - REAL :: fracC4(mland) INTEGER :: k, m, n - CALL cable_bios_load_fracC4(fracC4) - DO k=1, mland m = landpt(k)%ilon n = landpt(k)%ilat @@ -686,7 +686,7 @@ SUBROUTINE LUC_EXPT_SET_TILES_BIOS(inVeg, inPfrac, LUC_EXPT ) inPFrac(m,n,2:3) = 0.0 inPFrac(m,n,1) = 1.0 if ( LUC_EXPT%grass(k) .gt. 0.01 ) then - if (fracC4(k).gt.0.5) then + if (infracC4(m, n).gt.0.5) then inVeg(m,n,2) = 7 ! C4 grass else inVeg(m,n,2) = 6 ! C3 grass @@ -699,7 +699,7 @@ SUBROUTINE LUC_EXPT_SET_TILES_BIOS(inVeg, inPfrac, LUC_EXPT ) inVeg(m,n,1) = LUC_EXPT%ivegp(k) inVeg(m,n,2) = LUC_EXPT%ivegp(k) - if (fracC4(k).gt.0.5) then + if (infracC4(m, n).gt.0.5) then inVeg(m,n,3) = 7 ! C4 grass else inVeg(m,n,3) = 6 ! C3 grass diff --git a/offline/cable_bios_met_obs_params.F90 b/offline/cable_bios_met_obs_params.F90 index f32d0d1e0..66ebd57a5 100755 --- a/offline/cable_bios_met_obs_params.F90 +++ b/offline/cable_bios_met_obs_params.F90 @@ -1352,423 +1352,6 @@ END SUBROUTINE cable_bios_read_met !****************************************************************************** -SUBROUTINE cable_bios_load_params(soil) - -USE cable_def_types_mod, ONLY: mland, soil_parameter_type - -IMPLICIT NONE - -INTEGER(i4b) :: is, ie ! Index start/end points within cable spatial vectors - ! for the current land-cell's tiles. These are just - ! aliases to improve code readability -INTEGER(i4b) :: iland ! loop counter through mland land cells -INTEGER(i4b) :: param_unit ! Unit number for reading (all) parameter files. -INTEGER(i4b) :: error_status ! Error status returned by OPENs - -TYPE(soil_parameter_type), INTENT(INOUT) :: soil - - -! Temporary soil parameter variables. Varnames match corresponding bios parameter filenames (roughly). -! Dimensions are mland, which will be mapped to the more complicated mland+tiles dimensions of the -! equivalent cable soil variables. Filenames for these variables are defined at module level -! because they are read in from bios.nml as part of the initialisation but only accessed here, -! after the default cable params are read in by cable_driver. -REAL(sp), ALLOCATABLE :: b1(:) -REAL(sp), ALLOCATABLE :: b2(:) -REAL(sp), ALLOCATABLE :: bulkdens1_kgm3(:) -REAL(sp), ALLOCATABLE :: bulkdens2_kgm3(:) -REAL(sp), ALLOCATABLE :: clayfrac1(:) -REAL(sp), ALLOCATABLE :: clayfrac2(:) -REAL(sp), ALLOCATABLE :: csoil1(:) -REAL(sp), ALLOCATABLE :: csoil2(:) -REAL(sp), ALLOCATABLE :: depth1_m(:) -REAL(sp), ALLOCATABLE :: depth2_m(:) -REAL(sp), ALLOCATABLE :: hyk1sat_ms(:) -REAL(sp), ALLOCATABLE :: hyk2sat_ms(:) -REAL(sp), ALLOCATABLE :: psie1_m(:) -REAL(sp), ALLOCATABLE :: psie2_m(:) -REAL(sp), ALLOCATABLE :: siltfrac1(:) -REAL(sp), ALLOCATABLE :: siltfrac2(:) -REAL(sp), ALLOCATABLE :: wvol1fc_m3m3(:) -REAL(sp), ALLOCATABLE :: wvol2fc_m3m3(:) -REAL(sp), ALLOCATABLE :: wvol1sat_m3m3(:) -REAL(sp), ALLOCATABLE :: wvol2sat_m3m3(:) -REAL(sp), ALLOCATABLE :: wvol1w_m3m3(:) -REAL(sp), ALLOCATABLE :: wvol2w_m3m3(:) -! REAL(sp), ALLOCATABLE :: slope_deg(:) - - -! Allocate all bios soil parameters to mland, the number of land cells. -ALLOCATE (b1(mland), b2(mland), bulkdens1_kgm3(mland), bulkdens2_kgm3(mland)) -ALLOCATE (clayfrac1(mland), clayfrac2(mland), csoil1(mland), csoil2(mland)) -ALLOCATE (depth1_m(mland), depth2_m(mland), hyk1sat_ms(mland), hyk2sat_ms(mland)) -ALLOCATE (psie1_m(mland), psie2_m(mland), siltfrac1(mland), siltfrac2(mland)) -ALLOCATE (wvol1fc_m3m3(mland), wvol2fc_m3m3(mland), wvol1sat_m3m3(mland), wvol2sat_m3m3(mland)) -ALLOCATE (wvol1w_m3m3(mland), wvol2w_m3m3(mland)) -!ALLOCATE (slope_deg(mland)) - -CALL GET_UNIT(param_unit) ! Obtain an unused unit number for file reading, reused for all soil vars. - -! Open, read, and close each soil parameter in turn, stopping for any missing file. -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(b1_file), & - ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(b1_file) ; STOP '' -ELSE - READ (param_unit) b1 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(b2_file), & - ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(b2_file) ; STOP '' -ELSE - READ (param_unit) b2 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(bulkdens1_kgm3_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(bulkdens1_kgm3_file) ; STOP '' -ELSE - READ (param_unit) bulkdens1_kgm3 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(bulkdens2_kgm3_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(bulkdens2_kgm3_file) ; STOP '' -ELSE - READ (param_unit) bulkdens2_kgm3 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(clayfrac1_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(clayfrac1_file) ; STOP '' -ELSE - READ (param_unit) clayfrac1 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(clayfrac2_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(clayfrac2_file) ; STOP '' -ELSE - READ (param_unit) clayfrac2 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(csoil1_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(csoil1_file) ; STOP '' -ELSE - READ (param_unit) csoil1 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(csoil2_file), & - ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(csoil2_file) ; STOP '' -ELSE - READ (param_unit) csoil2 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(depth1_m_file), & - ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(depth1_m_file) ; STOP '' -ELSE - READ (param_unit) depth1_m - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(depth2_m_file), & - ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(depth2_m_file) ; STOP '' -ELSE - READ (param_unit) depth2_m - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(hyk1sat_ms_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(hyk1sat_ms_file) ; STOP '' -ELSE - READ (param_unit) hyk1sat_ms - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(hyk2sat_ms_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(hyk2sat_ms_file) ; STOP '' -ELSE - READ (param_unit) hyk2sat_ms - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(psie1_m_file), & - ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(psie1_m_file); STOP '' -ELSE - READ (param_unit) psie1_m - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(psie2_m_file), & - ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(psie2_m_file); STOP '' -ELSE - READ (param_unit) psie2_m - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(siltfrac1_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(siltfrac1_file); STOP '' -ELSE - READ (param_unit) siltfrac1 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(siltfrac2_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(siltfrac2_file) ; STOP '' -ELSE - READ (param_unit) siltfrac2 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(wvol1fc_m3m3_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(wvol1fc_m3m3_file); STOP '' -ELSE - READ (param_unit) wvol1fc_m3m3 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(wvol2fc_m3m3_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(wvol2fc_m3m3_file); STOP '' -ELSE - READ (param_unit) wvol2fc_m3m3 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(wvol1sat_m3m3_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(wvol1sat_m3m3_file) ; STOP '' -ELSE - READ (param_unit) wvol1sat_m3m3 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(wvol2sat_m3m3_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(wvol2sat_m3m3_file) ; STOP '' -ELSE - READ (param_unit) wvol2sat_m3m3 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(wvol1w_m3m3_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(wvol1w_m3m3_file) ; STOP '' -ELSE - READ (param_unit) wvol1w_m3m3 - CLOSE (param_unit) -END IF - -OPEN (param_unit, FILE=TRIM(param_path)//TRIM(wvol2w_m3m3_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD', & - IOSTAT=error_status) -IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(wvol2w_m3m3_file) ; STOP '' -ELSE - READ (param_unit) wvol2w_m3m3 - CLOSE (param_unit) -END IF - -!OPEN (param_unit, FILE=TRIM(param_path)//TRIM(slope_deg_file), ACCESS='STREAM',FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) -!IF (error_status > 0) THEN -! WRITE (*,'("STOP - File not found: ", LEN_TRIM(TRIM(param_path)//TRIM(slope_deg_file)))') ; STOP '' -!ELSE -! READ (param_unit) slope_deg -! CLOSE (param_unit) -!END IF - -! Map the values of each soil parameter read from bios parameter files (one value -! for each of mland land cells) onto the equivalent CABLE parameter, overwriting -! the default values and doing unit and other conversions as required. Assign the -! same bios parameter value for each land cell to all tiles within that land cell. -! -! Explanation: CABLE parameters have multiple 'tiles' (eg. veg types) per land cell. -! The number of tiles may vary with each land cell so to save memory they -! are incorporated within the same dimension as mland. Within the larger vector -! an index keeps track of the location of the first and last tile of each land cell. -! This index is landpt, which for each of mland cells has as cstart and cend index. - -DO iland = 1,mland ! For each land cell... - is = landpt(iland)%cstart ! Index position for the first tile of this land cell. - ie = landpt(iland)%cend ! Index position for the last tile of this land cell. -!%%%%% soil%albsoil(is:ie) = albsoil(iland) - soil%bch(is:ie) = min(b1(iland),16.0) - soil%silt(is:ie) = siltfrac1(iland) - soil%clay(is:ie) = clayfrac1(iland) - soil%sand(is:ie) = 1.0 - soil%silt(is:ie) - soil%clay(is:ie) - soil%css(is:ie) = csoil1(iland) - soil%hyds(is:ie) = max(hyk1sat_ms(iland),1.0e-8) - soil%sfc(is:ie) = wvol1fc_m3m3(iland) - soil%ssat(is:ie) = max(0.4,wvol1sat_m3m3(iland)) - soil%sucs(is:ie) = max(psie1_m(iland),-2.0) - soil%swilt(is:ie) = min(0.2,wvol1w_m3m3(iland)) - soil%rhosoil(is:ie) = bulkdens1_kgm3(iland) - -! PRB: Comment this out because CABLE is not using spatial zse. The dimension is ms (soil levels), not mp. -! Remove this section when both horizons are dealt with in the commented out code below -! print *,"is, ie ",is,ie -! soil%zse(is:ie) = depth1_m(iland) -! WHERE (soil%zse(is:ie).lt.0.01) -! soil%zse(is:ie) = 0.20 ! for compatibility with AWAP -! endwhere - -!%%%%%%%%%%%%%%%%%%%%%%%%%%% CONSULT WITH VANESSA ABOUT HOW TO DEAL WITH B HORIZON - ! B horizon parameters (for use in soil-litter) - ! soil%bchB(is:ie) = min(b2(iland),16.0) - ! soil%siltB(is:ie) = siltfrac2(iland) - ! soil%clayB(is:ie) = clayfrac2(iland) - ! soil%cssB(is:ie) = csoil2(iland) - ! soil%hydsB(is:ie) = max(hyk2sat_ms(iland),1.0e-8) ! m s-1 - ! soil%ssatB(is:ie) = max(0.4,wvol2sat_m3m3(iland)) - ! soil%sucsB(is:ie) = max(psie2_m(iland),-2.0) - ! soil%swiltB(is:ie) = min(0.2,wvol2w_m3m3(iland)) - ! soil%rhosoilB(is:ie) = bulkdens2_kgm3(iland) - ! soil%sfcB(is:ie) = wvol2fc_m3m3(iland) - ! soil%depthA(is:ie) = depth1_m(iland) - ! WHERE (soil%depthA(is:ie).lt.0.01) - ! soil%depthA(is:ie) = 0.20 ! for compatibility with AWAP - ! endwhere - ! soil%depthB(is:ie) = depth2_m(iland) - ! WHERE (soil%depthB(is:ie).lt.0.01) - ! soil%depthB(is:ie) = 1.00 ! to avoid very small B-Horizon - ! endwhere -!%%%%%%%%%%%%%%%%%%%%%%%%%%% CONSULT WITH VANESSA ABOUT HOW TO DEAL WITH B HORIZON - -!%%%%%%%%%%%%%%%%%%%%%%%%%%% Assign terrain slope variable to new cable variable (tbd) here -! cablevar%slope_deg(is:ie) = slope_deg(iland) - -END DO - -! Deallocate soil parameter variables which have been copied to their CABLE equivalents. -DEALLOCATE (b1, b2, bulkdens1_kgm3, bulkdens2_kgm3) -DEALLOCATE (clayfrac1, clayfrac2, csoil1, csoil2) -DEALLOCATE (depth1_m, depth2_m, hyk1sat_ms, hyk2sat_ms) -DEALLOCATE (psie1_m, psie2_m, siltfrac1, siltfrac2) -DEALLOCATE (wvol1fc_m3m3, wvol2fc_m3m3, wvol1sat_m3m3, wvol2sat_m3m3) -DEALLOCATE (wvol1w_m3m3, wvol2w_m3m3) -!DEALLOCATE (slope_deg) - -END SUBROUTINE cable_bios_load_params - -!****************************************************************************** - -SUBROUTINE cable_bios_load_biome(MVG) - - USE cable_def_types_mod, ONLY: mland - - - IMPLICIT NONE - - INTEGER, INTENT(INOUT) :: MVG(:) ! climate variables - - INTEGER(i4b) :: param_unit ! Unit number for reading (all) parameter files. - INTEGER(i4b) :: error_status ! Error status returned by OPENs - REAL(sp), ALLOCATABLE :: tmp(:) - - ! Temporary soil parameter variables. Varnames match corresponding bios parameter filenames (roughly). - ! Dimensions are mland, which will be mapped to the more complicated mland+tiles dimensions of the - ! equivalent cable soil variables. Filenames for these variables are defined at module level - ! because they are read in from bios.nml as part of the initialisation but only accessed here, - ! after the default cable params are read in by cable_driver. - - ALLOCATE (tmp(mland)) - - CALL GET_UNIT(param_unit) ! Obtain an unused unit number for file reading, reused for all soil vars. - - ! Open, read, and close Major Veg Group file - OPEN (param_unit, FILE=TRIM(param_path)//TRIM(MVG_file), ACCESS='STREAM', & - FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) - IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(MVG_file) ; STOP '' - ELSE - READ (param_unit) tmp - CLOSE (param_unit) - END IF - - MVG = int(tmp) - -END SUBROUTINE cable_bios_load_biome - - -!****************************************************************************** - -SUBROUTINE cable_bios_load_fracC4(fracC4) - - USE cable_def_types_mod, ONLY: mland - - - IMPLICIT NONE - - REAL, INTENT(INOUT) :: fracC4(:) ! climate variables - - INTEGER(i4b) :: param_unit ! Unit number for reading (all) parameter files. - INTEGER(i4b) :: error_status ! Error status returned by OPENs - REAL(sp), ALLOCATABLE :: tmp(:) - - ! Temporary soil parameter variables. Varnames match corresponding bios parameter filenames (roughly). - ! Dimensions are mland, which will be mapped to the more complicated mland+tiles dimensions of the - ! equivalent cable soil variables. Filenames for these variables are defined at module level - ! because they are read in from bios.nml as part of the initialisation but only accessed here, - ! after the default cable params are read in by cable_driver. - - ALLOCATE (tmp(mland)) - - CALL GET_UNIT(param_unit) ! Obtain an unused unit number for file reading - - ! Open, read, and close Major Veg Group file - OPEN (param_unit, FILE=TRIM(param_path)//TRIM(c4frac_file), ACCESS='STREAM', & - FORM='UNFORMATTED', STATUS='OLD',IOSTAT=error_status) - IF (error_status > 0) THEN - WRITE (*,*) "STOP - File not found: ", TRIM(param_path)//TRIM(c4frac_file) ; STOP '' - ELSE - READ (param_unit) tmp - CLOSE (param_unit) - END IF - - fracC4 = tmp - -END SUBROUTINE cable_bios_load_fracC4 - -!****************************************************************************** SUBROUTINE cable_bios_load_climate_params(climate) USE cable_def_types_mod, ONLY: mland, climate_type diff --git a/offline/cable_driver.F90 b/offline/cable_driver.F90 index 0af2233a4..f2c691d85 100644 --- a/offline/cable_driver.F90 +++ b/offline/cable_driver.F90 @@ -130,11 +130,10 @@ PROGRAM cable_offline_driver ! BIOS only use cable_bios_met_obs_params, only: cable_bios_read_met, cable_bios_init, & - cable_bios_load_params, & cable_bios_load_climate_params ! LUC_EXPT only - use CABLE_LUC_EXPT, only: LUC_EXPT_TYPE, LUC_EXPT_INIT, close_luh2 + use CABLE_LUC_EXPT, only: LUC_EXPT_TYPE, close_luh2 #ifdef __NAG__ use F90_UNIX @@ -669,7 +668,6 @@ PROGRAM cable_offline_driver ! be chosen from a coarse global grid of veg and soil types, based on ! the lat/lon coordinates. Allocation of CABLE's main variables also here. if (CALL1) then - if (cable_user%POPLUC) call LUC_EXPT_INIT(LUC_EXPT) ! 13C call load_parameters(met, air, ssnow, veg, bgc, & @@ -694,11 +692,6 @@ PROGRAM cable_offline_driver (trim(cable_user%POPLUC_RunType) == 'static')) & cable_user%POPLUC = .false. - ! Having read the default parameters, if this is a bios run we - ! will now overwrite the subset of them required for bios. - if (trim(cable_user%MetType) .eq. 'bios') & - call cable_bios_load_params(soil) - ! Open output file if (.not. CASAONLY) then if (trim(filename%out) == '' ) then diff --git a/offline/cable_parameters.F90 b/offline/cable_parameters.F90 index d93089f9a..a3ccae5e6 100644 --- a/offline/cable_parameters.F90 +++ b/offline/cable_parameters.F90 @@ -60,7 +60,7 @@ MODULE cable_param_module USE cable_abort_module USE cable_IO_vars_module USE cable_common_module, ONLY: cable_user - USE CABLE_LUC_EXPT, ONLY: LUC_EXPT_TYPE, LUC_EXPT_SET_TILES, LUC_EXPT_SET_TILES_BIOS + USE CABLE_LUC_EXPT, ONLY: LUC_EXPT_TYPE, LUC_EXPT_INIT, LUC_EXPT_SET_TILES, LUC_EXPT_SET_TILES_BIOS IMPLICIT NONE @@ -103,6 +103,8 @@ MODULE cable_param_module REAL, DIMENSION(:, :), ALLOCATABLE :: inclay REAL, DIMENSION(:, :), ALLOCATABLE :: insilt REAL, DIMENSION(:, :), ALLOCATABLE :: insand + REAL, DIMENSION(:, :), ALLOCATABLE :: infracC4 + INTEGER, DIMENSION(:, :), ALLOCATABLE :: inMVG ! vars intro for Ticket #27 INTEGER, DIMENSION(:, :), ALLOCATABLE :: inSoilColor @@ -142,8 +144,9 @@ SUBROUTINE get_default_params(logn, vegparmnew, LUC_EXPT) ! Overwrite veg type and inital patch frac with land-use info IF (CABLE_USER%POPLUC) then CALL get_land_index(nlon, nlat) + CALL LUC_EXPT_INIT(inMVG, LUC_EXPT) IF (TRIM(cable_user%MetType) .EQ. "bios") THEN - CALL LUC_EXPT_SET_TILES_BIOS(inVeg, inPfrac, LUC_EXPT) + CALL LUC_EXPT_SET_TILES_BIOS(inVeg, inPfrac, infracC4, LUC_EXPT) ELSE CALL LUC_EXPT_SET_TILES(inVeg, inPfrac, LUC_EXPT) ENDIF @@ -306,6 +309,11 @@ SUBROUTINE read_gridinfo(nlon, nlat, npatch) endif + IF (CABLE_USER%POPLUC .AND. TRIM(CABLE_USER%MetType) .EQ. "bios") THEN + ALLOCATE (infracC4(nlon, nlat)) + ALLOCATE (inMVG(nlon, nlat)) + END IF + ok = NF90_INQ_VARID(ncid, 'longitude', varID) IF (ok /= NF90_NOERR) CALL nc_abort(ok, & 'Error finding variable longitude.') @@ -440,6 +448,20 @@ SUBROUTINE read_gridinfo(nlon, nlat, npatch) ok = NF90_GET_VAR(ncid,varID,inLAI) IF (ok /= NF90_NOERR) CALL nc_abort(ok, 'Error reading variable LAI.') + + IF (CABLE_USER%POPLUC .AND. TRIM(cable_user%MetType) .EQ. "bios") THEN + ok = NF90_INQ_VARID(ncid, 'c4frac', varID) + IF (ok /= NF90_NOERR) CALL nc_abort(ok, 'Error finding c4frac.') + ok = NF90_GET_VAR(ncid, varID, infracC4) + IF (ok /= NF90_NOERR) CALL nc_abort(ok, 'Error reading c4frac.') + + + ok = NF90_INQ_VARID(ncid, 'mvg', varID) + IF (ok /= NF90_NOERR) CALL nc_abort(ok, 'Error finding mvg.') + ok = NF90_GET_VAR(ncid, varID, inMVG) + IF (ok /= NF90_NOERR) CALL nc_abort(ok, 'Error reading mvg.') + END IF + IF (icycle > 0) THEN ! casaCNP parameters ALLOCATE( inArea(nlon, nlat) ) @@ -1499,6 +1521,8 @@ SUBROUTINE write_default_params(met, ssnow, veg, bgc, & IF (calcsoilalbedo) DEALLOCATE(inSoilColor) ! vars intro for Ticket #27 DEALLOCATE(inVeg, inPFrac, inSoil, inWB, inTGG) DEALLOCATE(inLAI, inSND, inALB) + IF (allocated(infracC4)) DEALLOCATE(infracC4) + IF (allocated(inMVG)) DEALLOCATE(inMVG) ! DEALLOCATE(soiltemp_temp,soilmoist_temp,patchfrac_temp,isoilm_temp, & ! frac4_temp,iveg_temp) ! IF(ASSOCIATED(vegtype_metfile)) DEALLOCATE(vegtype_metfile) diff --git a/offline/cable_read.F90 b/offline/cable_read.F90 index 8495dbcf1..58b2dfb30 100644 --- a/offline/cable_read.F90 +++ b/offline/cable_read.F90 @@ -44,7 +44,7 @@ MODULE cable_read_module PRIVATE - PUBLIC :: readpar, redistr_i, redistr_r, redistr_rd, redistr_r2, redistr_r2d + PUBLIC :: readpar, redistr_i, redistr_r, redistr_rd, redistr_r2, redistr_r2d, default_inq_get_nf90, check_nf90, check_settings INTEGER :: ok ! netcdf error status #ifdef __MPI__ @@ -67,8 +67,43 @@ MODULE cable_read_module ! MODULE PROCEDURE redistr_r2d ! END INTERFACE + TYPE check_settings + CHARACTER(LEN=64) :: subroutine_str + ! Optional + CHARACTER(LEN=256) :: message = "" + LOGICAL :: exit = .TRUE. + END TYPE check_settings + CONTAINS + + SUBROUTINE check_nf90(stat, settings) + INTEGER, INTENT(IN) :: stat + TYPE(check_settings), INTENT(IN) :: settings + + IF (stat /= NF90_NOERR) THEN + IF (settings%exit) THEN + CALL nc_abort(stat, settings%subroutine_str) + END IF + END IF + + END SUBROUTINE check_nf90 + + !! Note: Only works with sp type for now, can make a generic interface when other functions need it + SUBROUTINE default_inq_get_nf90(ncid, vname, array, settings) + INTEGER, INTENT(IN) :: ncid + CHARACTER(LEN=*), INTENT(IN) :: vname + !! TODO: dependency issue if using sp + REAL(KIND(1.0)), INTENT(INOUT) :: array(:) + TYPE(check_settings), INTENT(IN) :: settings + + INTEGER :: varid + + CALL check_nf90(NF90_INQ_VARID(ncid, vname, varid), settings) + CALL check_nf90(NF90_GET_VAR(ncid, varid, array), settings) + + END SUBROUTINE default_inq_get_nf90 + SUBROUTINE readpar_i(ncid, parname, completeSet, var_i, filename, & npatch, dimswitch, from_restart, INpatch) ! Subroutine for loading an integer-valued parameter diff --git a/offline/old/cable_mpimaster.F90 b/offline/old/cable_mpimaster.F90 index 8d6eefbb6..d52245daf 100644 --- a/offline/old/cable_mpimaster.F90 +++ b/offline/old/cable_mpimaster.F90 @@ -235,7 +235,7 @@ subroutine mpidrv_master(comm) ! BIOS only use cable_bios_met_obs_params, only: cable_bios_read_met, cable_bios_init, & - cable_bios_load_params, cable_bios_load_climate_params + cable_bios_load_climate_params implicit none @@ -707,11 +707,6 @@ subroutine mpidrv_master(comm) (trim(cable_user%POPLUC_RunType) == 'static')) & cable_user%POPLUC = .false. - ! Having read the default parameters, if this is a bios run we will now - ! overwrite the subset of them required for bios. - if (trim(cable_user%MetType) .eq. 'bios') & - call cable_bios_load_params(soil) - ! Open output file if (.not. CASAONLY) then if (trim(filename%out) == '') then