Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
19 commits
Select commit Hold shift + click to select a range
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 0 additions & 7 deletions src/coupled/AM3/control/cable/CM3/cbl_canopy_type.F90
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,6 @@ MODULE cable_canopy_type_mod
REAL, ALLOCATABLE, PUBLIC :: fwet(:) ! fraction of canopy wet
REAL, ALLOCATABLE, PUBLIC :: fns_cor(:) ! correction to net rad avail to soil (W/m2)
REAL, ALLOCATABLE, PUBLIC :: ga_cor(:) ! correction to ground heat flux (W/m2)
REAL, ALLOCATABLE, PUBLIC :: evapfbl(:,:) !
REAL, ALLOCATABLE, PUBLIC :: gswx(:,:) ! stom cond for water
REAL, ALLOCATABLE, PUBLIC :: zetar(:,:) ! stability parameter (ref height)
REAL, ALLOCATABLE, PUBLIC :: zetash(:,:) ! stability parameter (shear height)
Expand Down Expand Up @@ -144,7 +143,6 @@ MODULE cable_canopy_type_mod
REAL, POINTER, PUBLIC :: fwet(:) ! fraction of canopy wet
REAL, POINTER, PUBLIC :: fns_cor(:) ! correction to net rad avail to soil (W/m2)
REAL, POINTER, PUBLIC :: ga_cor(:) ! correction to ground heat flux (W/m2)
REAL, POINTER, PUBLIC :: evapfbl(:,:) !
REAL, POINTER, PUBLIC :: gswx(:,:) ! stom cond for water
REAL, POINTER, PUBLIC :: zetar(:,:) ! stability parameter (ref height)
REAL, POINTER, PUBLIC :: zetash(:,:) ! stability parameter (shear height)
Expand Down Expand Up @@ -230,7 +228,6 @@ SUBROUTINE alloc_canopy_type(var, mp)
ALLOCATE( var% fwet(mp) )
ALLOCATE( var% fns_cor(mp) ) !REV_CORR variable
ALLOCATE( var% ga_cor(mp) ) !REV_CORR variable
ALLOCATE( var % evapfbl(mp,nsl) )
ALLOCATE( var% epot(mp) )
ALLOCATE( var% fnpp(mp) )
ALLOCATE( var% fevw_pot(mp) )
Expand Down Expand Up @@ -308,7 +305,6 @@ SUBROUTINE alloc_canopy_type(var, mp)
var % fwet(:) = 0.0
var % fns_cor(:) = 0.0
var % ga_cor(:) = 0.0
var % evapfbl(:,:) = 0.0
var % gswx(:,:) = 0.0
var % zetar(:,:) = 0.0
var % zetash(:,:) = 0.0
Expand Down Expand Up @@ -382,7 +378,6 @@ SUBROUTINE dealloc_canopy_type(var)
DEALLOCATE( var% fwet )
DEALLOCATE( var% fns_cor ) !REV_CORR variable
DEALLOCATE( var% ga_cor ) !REV_CORR variable
DEALLOCATE ( var % evapfbl )
DEALLOCATE( var% epot )
DEALLOCATE( var% fnpp )
DEALLOCATE( var% fevw_pot )
Expand Down Expand Up @@ -473,7 +468,6 @@ SUBROUTINE assoc_canopy_type(canopy, canopy_data )
canopy% fwet => canopy_data% fwet
canopy% fns_cor => canopy_data% fns_cor
canopy% ga_cor => canopy_data% ga_cor
canopy% evapfbl => canopy_data% evapfbl
canopy% gswx => canopy_data% gswx
canopy% zetar => canopy_data% zetar
canopy% zetash => canopy_data% zetash
Expand Down Expand Up @@ -557,7 +551,6 @@ SUBROUTINE nullify_canopy_cbl( var )
NULLIFY( var% fwet )
NULLIFY( var% fns_cor ) !REV_CORR variable
NULLIFY( var% ga_cor ) !REV_CORR variable
NULLIFY( var % evapfbl )
NULLIFY( var% epot )
NULLIFY( var% fnpp )
NULLIFY( var% fevw_pot )
Expand Down
4 changes: 2 additions & 2 deletions src/coupled/AM3/control/cable/CM3/ssnow_type.F90
Original file line number Diff line number Diff line change
Expand Up @@ -74,11 +74,11 @@ MODULE cable_soil_snow_type_mod
REAL, ALLOCATABLE :: tggsn (:,:) ! snow temperature in K
REAL, ALLOCATABLE :: dtmlt (:,:) ! water flux to the soil
REAL, ALLOCATABLE :: albsoilsn (:,:) ! soil + snow reflectance
REAL, ALLOCATABLE :: evapfbl (:,:) !
REAL, ALLOCATABLE :: tilefrac (:,:) ! factor for latent heat

REAL(r_2), ALLOCATABLE :: wbtot (:) ! total soil water (mm)

REAL(r_2), ALLOCATABLE :: evapfbl (:,:) !
REAL(r_2), ALLOCATABLE :: gammzz (:,:) ! heat capacity for each soil layer
REAL(r_2), ALLOCATABLE :: wb (:,:) ! volumetric soil moisture (solid+liq)
REAL(r_2), ALLOCATABLE :: wbice (:,:) ! soil ice
Expand Down Expand Up @@ -209,11 +209,11 @@ MODULE cable_soil_snow_type_mod
REAL, POINTER :: tggsn (:,:) ! snow temperature in K
REAL, POINTER :: dtmlt (:,:) ! water flux to the soil
REAL, POINTER :: albsoilsn (:,:) ! soil + snow reflectance
REAL, POINTER :: evapfbl (:,:) !
REAL, POINTER :: tilefrac (:,:) ! factor for latent heat

REAL(r_2), POINTER :: wbtot (:) ! total soil water (mm)

REAL(r_2), POINTER :: evapfbl (:,:) !
REAL(r_2), POINTER :: gammzz (:,:) ! heat capacity for each soil layer
REAL(r_2), POINTER :: wb (:,:) ! volumetric soil moisture (solid+liq)
REAL(r_2), POINTER :: wbice (:,:) ! soil ice
Expand Down
2 changes: 0 additions & 2 deletions src/coupled/shared/cable_canopy_type_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,6 @@ MODULE cable_canopy_type_mod
ga_cor ! correction to ground heat flux (W/m2)

REAL, DIMENSION(:,:), POINTER :: &
evapfbl, &
gswx, & ! stom cond for water
zetar, & ! stability parameter (ref height)
! vh_js !
Expand Down Expand Up @@ -158,7 +157,6 @@ SUBROUTINE alloc_canopy_type(var, mp)
ALLOCATE( var% fwet(mp) )
ALLOCATE( var% fns_cor(mp) ) !REV_CORR variable
ALLOCATE( var% ga_cor(mp) ) !REV_CORR variable
ALLOCATE ( var % evapfbl(mp,ms) )
ALLOCATE( var% epot(mp) )
ALLOCATE( var% fnpp(mp) )
ALLOCATE( var% fevw_pot(mp) )
Expand Down
2 changes: 1 addition & 1 deletion src/coupled/shared/cable_soilsnow_type_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -72,14 +72,14 @@ MODULE cable_soil_snow_type_mod
tggsn, & ! snow temperature in K
dtmlt, & ! water flux to the soil
albsoilsn, & ! soil + snow reflectance
evapfbl, & !
tilefrac ! factor for latent heat


REAL(r_2), DIMENSION(:), POINTER :: &
wbtot ! total soil water (mm)

REAL(r_2), DIMENSION(:,:), POINTER :: &
evapfbl, & !
gammzz, & ! heat capacity for each soil layer
wb, & ! volumetric soil moisture (solid+liq)
wbice, & ! soil ice
Expand Down
5 changes: 1 addition & 4 deletions src/offline/cable_define_types.F90
Original file line number Diff line number Diff line change
Expand Up @@ -278,14 +278,14 @@ MODULE cable_def_types_mod
tggsn, & ! snow temperature in K
dtmlt, & ! water flux to the soil
albsoilsn, & ! soil + snow reflectance
evapfbl, & !
tilefrac ! factor for latent heat


REAL(r_2), DIMENSION(:), POINTER :: &
wbtot ! total soil water (mm)

REAL(r_2), DIMENSION(:,:), POINTER :: &
evapfbl, & !
gammzz, & ! heat capacity for each soil layer
wb, & ! volumetric soil moisture (solid+liq)
wbice, & ! soil ice
Expand Down Expand Up @@ -493,7 +493,6 @@ MODULE cable_def_types_mod
ga_cor ! correction to ground heat flux (W/m2)

REAL, DIMENSION(:,:), POINTER :: &
evapfbl, &
gswx, & ! stom cond for water
zetar, & ! stability parameter (ref height)
! vh_js !
Expand Down Expand Up @@ -1149,7 +1148,6 @@ SUBROUTINE alloc_canopy_type(var, mp)
ALLOCATE( var% fwet(mp) )
ALLOCATE( var% fns_cor(mp) ) !REV_CORR variable
ALLOCATE( var% ga_cor(mp) ) !REV_CORR variable
ALLOCATE ( var % evapfbl(mp,ms) )
ALLOCATE( var% epot(mp) )
ALLOCATE( var% fnpp(mp) )
ALLOCATE( var% fevw_pot(mp) )
Expand Down Expand Up @@ -1783,7 +1781,6 @@ SUBROUTINE dealloc_canopy_type(var)
DEALLOCATE( var% fwet )
DEALLOCATE( var% fns_cor ) !REV_CORR variable
DEALLOCATE( var% ga_cor ) !REV_CORR variable
DEALLOCATE ( var % evapfbl )
DEALLOCATE( var% epot )
DEALLOCATE( var% fnpp )
DEALLOCATE( var% fevw_pot )
Expand Down
6 changes: 3 additions & 3 deletions src/offline/cable_mpicommon.F90
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ MODULE cable_mpicommon

! base number of input fields: must correspond to CALLS to
! MPI_address (field ) in *_mpimaster/ *_mpiworker
INTEGER, PARAMETER :: nparam = 341
INTEGER, PARAMETER :: nparam = 340

! MPI: extra params sent only if nsoilparmnew is true
INTEGER, PARAMETER :: nsoilnew = 1
Expand Down Expand Up @@ -77,7 +77,7 @@ MODULE cable_mpicommon
!INTEGER, PARAMETER :: nmat = 29
! MPI: CABLE_r491, after following up with Bernard on the new variables
! vh sli nmat + 4 36 -> 40
INTEGER, PARAMETER :: nmat = 40
INTEGER, PARAMETER :: nmat = 39

! MPI: number of contig vector parts / worker (results)
!INTEGER, PARAMETER :: nvec = 149
Expand All @@ -103,7 +103,7 @@ MODULE cable_mpicommon
! MPI: number of fields included in restart_t type for data
! that is returned only for creating a restart file at the end of the run
! MPI: gol124: canopy%rwater removed when Bernard ported to CABLE_r491
INTEGER, PARAMETER :: nrestart = 17
INTEGER, PARAMETER :: nrestart = 16
INTEGER, PARAMETER :: nsumcasaflux = 62
INTEGER, PARAMETER :: nsumcasapool = 40
INTEGER, PARAMETER :: nclimate = 30
Expand Down
27 changes: 3 additions & 24 deletions src/offline/cable_mpimaster.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1930,7 +1930,7 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,&

bidx = bidx + 1
CALL MPI_Get_address (ssnow%evapfbl(off,1), displs(bidx), ierr)
CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, &
CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, &
& types(bidx), ierr)
blen(bidx) = 1

Expand Down Expand Up @@ -2508,14 +2508,6 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,&
! blen(bidx) = 1
! !blen(bidx) = ms * r1len

bidx = bidx + 1
CALL MPI_Get_address (canopy%evapfbl(off,1), displs(bidx), ierr)
! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491
CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, &
& types(bidx), ierr)
blen(bidx) = 1
!blen(bidx) = ms * r2len

bidx = bidx + 1
CALL MPI_Get_address (canopy%epot(off), displs(bidx), ierr)
blen(bidx) = r1len
Expand Down Expand Up @@ -4788,12 +4780,6 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg)
! REAL(r_2)
! MPI: gol124: backport to r1134 changes r_2 to r_1
! MPI: gol124: in newest CABLE-cnp it's r_2 again
midx = midx + 1
CALL MPI_Get_address (canopy%evapfbl(off,1), maddr(midx), ierr) ! 2
! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491
CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, &
& mat_t(midx, rank), ierr)
CALL MPI_Type_commit (mat_t(midx, rank), ierr)

midx = midx + 1
CALL MPI_Get_address (canopy%gswx(off,1), maddr(midx), ierr) ! 2
Expand Down Expand Up @@ -4876,9 +4862,9 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg)
& mat_t(midx, rank), ierr)
CALL MPI_Type_commit (mat_t(midx, rank), ierr)
midx = midx + 1
! REAL(r_1)
! REAL(r_2)
CALL MPI_Get_address (ssnow%evapfbl(off,1), maddr(midx), ierr) ! 12
CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, &
CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, &
& mat_t(midx, rank), ierr)
CALL MPI_Type_commit (mat_t(midx, rank), ierr)
midx = midx + 1
Expand Down Expand Up @@ -7222,13 +7208,6 @@ SUBROUTINE master_restart_types (comm, canopy, air, bgc)
! & types(bidx), ierr)
! blocks(bidx) = 1

bidx = bidx + 1
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This change here is consistent with the intent of the PR but it highlights something missing (I think)

Since you've changed the TYPE of ssnow%evapfbl you should also need to change the length of the associated MPI declarations (should be r2len not r1len) - I don't see these changes in the changeset.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Done

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Just a check - does the blen(bidx) = r1len at line 2513 also need changing?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I believe the line 2513 you are referring to has been removed. It was for canopy%evapfbl that I removed. Line 2513 now has the MPI code for canopy%epot.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I can't find any reference to ssnow%evapfbl in mpimaster or mpiworker that is using r1len anymore.

Copy link
Collaborator

@SeanBryan51 SeanBryan51 Jul 9, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This call to MPI_Type_Create_hvector seems to be creating something (types(bidx)?) based on bidx being an r1len variable at this point in the sequence - but that's no longer valid.

I think this must have been fine since the kind was not specified for canopy%evapfbl and defaulted to r1.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@SeanBryan51 But would it be fine with the PR's changes given that bidx is pointing (not in the sense of a POINTER) to ssnow%evapfbl which is now r_2?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@har917 , bidx is only used as an array index. types is an array and we add the information for evapfbl in vector form to that array (my guess is that it stores some kind of total length in bytes). The index used for types does not change depending on the type of the variable (r_2 or r_1). types contains INTEGERs, so I'd assume the integer for a r_2 array is bigger than for a r_1 array but it's still only 1 number that only needs to be stored in one place in the types array. So bidx (the index counter for the types array) is still incrementing by one. And we only need one element of the types array types(bidx) to store the information.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

My concern isn't really bidx or types but blen(bidx) - this seems (e.g. line 5659) to be used when setting up how the workers-masters will communicate. So setting this up to have the length 1 or r1len when %evapfbl is an r2len double precision REAL seems ... odd.

However - some of the variables are clearly being dealt with differently - see line 1983 for veg%froot which also does the call to MPI_Type_Create_hvector then blen(bidx)=1 - so there is some consistency (even if I don't follow the why).

Perhaps what I'm really getting at here is that this probably needs a short MPI test of just the change in KIND on ssnow%evapfbl separated out from the rest of the science change (? - more work though).

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@SeanBryan51 But would it be fine with the PR's changes given that bidx is pointing (not in the sense of a POINTER) to ssnow%evapfbl which is now r_2?

Yes I think so as long as worker_cable_params is consistent with how the blocks have been organised in master_cable_params (i.e. blen and bidx) there should be no issues, and this looks to be the case.

CALL MPI_Get_address (canopy%evapfbl(off,1), displs(bidx), ierr) ! 2
! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491
CALL MPI_Type_create_hvector (ms, r1len, r1stride, MPI_BYTE, &
& types(bidx), ierr)
blocks(bidx) = 1

bidx = bidx + 1
CALL MPI_Get_address (bgc%cplant(off,1), displs(bidx), ierr)
CALL MPI_Type_create_hvector (ncp, r1len, r1stride, MPI_BYTE, &
Expand Down
26 changes: 2 additions & 24 deletions src/offline/cable_mpiworker.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1198,7 +1198,7 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,&

bidx = bidx + 1
CALL MPI_Get_address (ssnow%evapfbl, displs(bidx), ierr)
blen(bidx) = ms * r1len
blen(bidx) = ms * r2len

bidx = bidx + 1
CALL MPI_Get_address (ssnow%qstss, displs(bidx), ierr)
Expand Down Expand Up @@ -1742,11 +1742,6 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,&
! CALL MPI_Get_address (canopy%rwater, displs(bidx), ierr)
! blen(bidx) = ms * r1len

bidx = bidx + 1
CALL MPI_Get_address (canopy%evapfbl, displs(bidx), ierr)
! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491
blen(bidx) = ms * r1len

bidx = bidx + 1
CALL MPI_Get_address (canopy%epot, displs(bidx), ierr)
blen(bidx) = r1len
Expand Down Expand Up @@ -3679,18 +3674,6 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg)
! CALL MPI_Get_address (canopy%rwater(off,1), displs(bidx), ierr)
! blocks(bidx) = r1len * ms

! midx = midx + 1
! REAL(r_2)
! CALL MPI_Get_address (canopy%evapfbl(off,1), maddr(midx), ierr) ! 2
!CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, &
! & mat_t(midx, rank), ierr)

! TODO: skip, used for restart but not output
bidx = bidx + 1
CALL MPI_Get_address (canopy%evapfbl(off,1), displs(bidx), ierr)
! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491
blocks(bidx) = r1len * ms

bidx = bidx + 1
CALL MPI_Get_address (canopy%gswx(off,1), displs(bidx), ierr)
blocks(bidx) = r1len * mf
Expand Down Expand Up @@ -3797,7 +3780,7 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg)

bidx = bidx + 1
CALL MPI_Get_address (ssnow%evapfbl(off,1), displs(bidx), ierr)
blocks(bidx) = r1len * ms
blocks(bidx) = r2len * ms

!midx = midx + 1
! REAL(r_1)
Expand Down Expand Up @@ -6404,11 +6387,6 @@ SUBROUTINE worker_restart_type (comm, canopy, air, bgc)
! CALL MPI_Get_address (canopy%rwater(off,1), displs(bidx), ierr)
! blocks(bidx) = r1len * ms

bidx = bidx + 1
CALL MPI_Get_address (canopy%evapfbl(off,1), displs(bidx), ierr)
! MPI: gol124: changed to r1 when Bernard ported to CABLE_r491
blocks(bidx) = r1len * ms

bidx = bidx + 1
CALL MPI_Get_address (bgc%cplant(off,1), displs(bidx), ierr)
blocks(bidx) = r1len * ncp
Expand Down
Loading