Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update and cleanup of H2O, O3, sfc_sice and others #120

Merged
11 changes: 4 additions & 7 deletions physics/h2ointerp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ subroutine read_h2odata (h2o_phys, me, master)
return
endif

open(unit=kh2opltc,file='INPUT/global_h2oprdlos.f77', form='unformatted', convert='big_endian')
open(unit=kh2opltc,file='global_h2oprdlos.f77', form='unformatted', convert='big_endian')

!--- read in indices
!---
Expand Down Expand Up @@ -126,7 +126,7 @@ subroutine h2ointerpol(me,npts,idate,fhour,jindx1,jindx2,h2oplout,ddy)
integer idat(8),jdat(8)
!
real(kind=kind_phys) ddy(npts)
real(kind=kind_phys) h2oplout(levh2o,npts,h2o_coeff)
real(kind=kind_phys) h2oplout(npts,levh2o,h2o_coeff)
real(kind=kind_phys) rinc(5), rjday
integer jdow, jdoy, jday
real(4) rinc4(5)
Expand Down Expand Up @@ -155,23 +155,20 @@ subroutine h2ointerpol(me,npts,idate,fhour,jindx1,jindx2,h2oplout,ddy)
if (rjday < h2o_time(1)) rjday = rjday+365.
!
n2 = timeh2o + 1
do j=1,timeh2o
do j=2,timeh2o
if (rjday < h2o_time(j)) then
n2 = j
exit
endif
enddo
n1 = n2 - 1
if (n1 <= 0) n1 = n1 + timeh2o
if (n2 > timeh2o) n2 = n2 - timeh2o

!
! if (me .eq. 0) print *,' n1=',n1,' n2=',n2,' rjday=',rjday
! &,'h2o_time=',h2o_time(n1),h2o_time(n2)
!

tx1 = (h2o_time(n2) - rjday) / (h2o_time(n2) - h2o_time(n1))
tx2 = 1.0 - tx1
if (n2 > timeh2o) n2 = n2 - timeh2o
!
do nc=1,h2o_coeff
do l=1,levh2o
Expand Down
8 changes: 8 additions & 0 deletions physics/machine.F
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,11 @@ MODULE MACHINE
#ifndef SINGLE_PREC
integer, parameter :: kind_io4 = 4, kind_io8 = 8 , kind_ior = 8 &
&, kind_evod = 8, kind_dbl_prec = 8 &
#ifdef __PGI
&, kind_qdt_prec = 8 &
#else
&, kind_qdt_prec = 16 &
#endif
&, kind_rad = 8 &
&, kind_phys = 8 ,kind_taum=8 &
&, kind_grid = 8 &
Expand All @@ -15,7 +19,11 @@ MODULE MACHINE
#else
integer, parameter :: kind_io4 = 4, kind_io8 = 8 , kind_ior = 8 &
&, kind_evod = 4, kind_dbl_prec = 8 &
#ifdef __PGI
&, kind_qdt_prec = 8 &
#else
&, kind_qdt_prec = 16 &
#endif
&, kind_rad = 4 &
&, kind_phys = 4 ,kind_taum=4 &
&, kind_grid = 4 &
Expand Down
62 changes: 5 additions & 57 deletions physics/memcheck.F90
Original file line number Diff line number Diff line change
Expand Up @@ -3,11 +3,6 @@

module memcheck

#ifndef CCPP
use, intrinsic :: iso_c_binding, &
only: c_int32_t, c_char, c_null_char
#endif

use machine, only: kind_phys

implicit none
Expand All @@ -16,21 +11,6 @@ module memcheck

public memcheck_init, memcheck_run, memcheck_finalize

#ifndef CCPP
! In temporary external library libmemcheck.a
interface
integer(c_int32_t) &
function ccpp_memory_usage_c &
(mpicomm, str, lstr) &
bind(c, name='ccpp_memory_usage_c')
import :: c_char, c_int32_t
integer(c_int32_t), value, intent(in) :: mpicomm
character(kind=c_char), dimension(*) :: str
integer(c_int32_t), value, intent(in) :: lstr
end function ccpp_memory_usage_c
end interface
#endif

! Can use larger time frame to track memory leaks
real(kind_phys), parameter :: SECONDS_ELAPSED_MIN = 3500.0
real(kind_phys), parameter :: SECONDS_ELAPSED_MAX = 3700.0
Expand All @@ -48,32 +28,32 @@ end subroutine memcheck_finalize
!! |-----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------|-----------|--------|----------|
!! | seconds_elapsed | seconds_elapsed_since_model_initialization | seconds elapsed since model initialization | s | 0 | real | kind_phys | in | F |
!! | block_number | block_number | for explicit data blocking: block number of this block | index | 0 | integer | | in | F |
!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F |
!! | errmsg | error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!!
subroutine memcheck_run (seconds_elapsed, block_number, errmsg, errflg)
subroutine memcheck_run (seconds_elapsed, block_number, mpicomm, errmsg, errflg)

#ifdef MPI
use mpi
#endif
#ifdef OPENMP
use omp_lib
#endif
#ifdef CCPP
use ccpp_api, only: ccpp_memory_usage
#endif

implicit none

!--- interface variables
real(kind=kind_phys), intent(in) :: seconds_elapsed
integer, intent(in) :: block_number
integer, intent(in) :: mpicomm
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

!--- local variables
integer :: impi, ierr
integer :: mpirank, mpisize, mpicomm ! mpicomm will become input argument
integer :: mpirank, mpisize
integer :: ompthread
character(len=1024) :: memory_usage

Expand All @@ -89,11 +69,9 @@ subroutine memcheck_run (seconds_elapsed, block_number, errmsg, errflg)
#ifdef MPI
call MPI_COMM_RANK(MPI_COMM_WORLD, mpirank, ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD, mpisize, ierr)
mpicomm = MPI_COMM_WORLD
#else
mpirank = 0
mpisize = 1
mpicomm = 0
#endif

#ifdef OPENMP
Expand All @@ -106,44 +84,14 @@ subroutine memcheck_run (seconds_elapsed, block_number, errmsg, errflg)

! Output ordered by MPI rank
do impi=0,mpisize-1
if (mpirank==impi) then
if (mpirank==impi .and. ompthread==0) then
write(0,'(a)') trim(memory_usage)
end if
#ifdef MPI
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
#endif
end do

#ifndef CCPP
! Copied from ccpp_memory.F90 for non-CCPP builds

contains

function ccpp_memory_usage(mpicomm, memory_usage) result(ierr)

implicit none

! Interface variables
integer, intent(in) :: mpicomm
character(len=*), intent(out) :: memory_usage
! Function return value
integer :: ierr
! Local variables
character(len=len(memory_usage),kind=c_char) :: memory_usage_c
integer :: i

ierr = ccpp_memory_usage_c(mpicomm, memory_usage_c, len(memory_usage_c))
if (ierr /= 0) then
write(memory_usage,fmt='(a)') "An error occurred in the call to ccpp_memory_usage_c in ccpp_memory_usage"
return
end if

memory_usage = memory_usage_c(1:index(memory_usage_c, c_null_char)-1)

end function ccpp_memory_usage

#endif

end subroutine memcheck_run

end module memcheck
18 changes: 8 additions & 10 deletions physics/ozinterp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ SUBROUTINE read_o3data (ntoz, me, master)
return
endif

open(unit=kozpl,file='INPUT/global_o3prdlos.f77', form='unformatted', convert='big_endian')
open(unit=kozpl,file='global_o3prdlos.f77', form='unformatted', convert='big_endian')

!--- read in indices
!---
Expand Down Expand Up @@ -127,8 +127,7 @@ SUBROUTINE ozinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ozplout,ddy)
!

integer JINDX1(npts), JINDX2(npts)
integer me,idate(4)
integer IDAT(8),JDAT(8)
integer me, idate(4), IDAT(8),JDAT(8)
!
real(kind=kind_phys) DDY(npts)
real(kind=kind_phys) ozplout(npts,levozp,oz_coeff)
Expand Down Expand Up @@ -157,26 +156,25 @@ SUBROUTINE ozinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ozplout,ddy)
jday = 0
call w3doxdat(jdat,jdow,jdoy,jday)
rjday = jdoy + jdat(5) / 24.
IF (RJDAY .LT. oz_time(1)) RJDAY = RJDAY+365.
IF (RJDAY < oz_time(1)) RJDAY = RJDAY + 365.
!
n2 = timeoz + 1
do j=1,timeoz
if (rjday .lt. oz_time(j)) then
do j=2,timeoz
if (rjday < oz_time(j)) then
n2 = j
exit
endif
enddo
n1 = n2 - 1
if (n1 <= 0) n1 = n1 + timeoz
if (n2 > timeoz) n2 = n2 - timeoz

!
! if (me .eq. 0) print *,' n1=',n1,' n2=',n2,' rjday=',rjday
! if (me == 0) print *,' n1=',n1,' n2=',n2,' rjday=',rjday
! &,'oz_time=',oz_time(n1),oz_time(n2)
!

tx1 = (oz_time(n2) - rjday) / (oz_time(n2) - oz_time(n1))
tx2 = 1.0 - tx1

if (n2 > timeoz) n2 = n2 - timeoz
!
do nc=1,oz_coeff
DO L=1,levozp
Expand Down
17 changes: 11 additions & 6 deletions physics/set_soilveg.f
Original file line number Diff line number Diff line change
Expand Up @@ -235,10 +235,15 @@ subroutine set_soilveg(me,isot,ivet,nlunit)
& 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/)
! !!!!!!!!!!!!!! The following values in the table are NOT used
! !!!!!!!!!!!!!! and are just given for reference
DRYSMC=(/0.023, 0.028, 0.047, 0.084, 0.084, 0.066,
& 0.069, 0.120, 0.103, 0.100, 0.126, 0.135,
& 0.069, 0.028, 0.012, 0.028, 0.135, 0.012,
& 0.023, 0.000, 0.000, 0.000, 0.000, 0.000,
! DRYSMC=(/0.023, 0.028, 0.047, 0.084, 0.084, 0.066,
! & 0.069, 0.120, 0.103, 0.100, 0.126, 0.135,
! & 0.069, 0.028, 0.012, 0.028, 0.135, 0.012,
! & 0.023, 0.000, 0.000, 0.000, 0.000, 0.000,
! & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/)
DRYSMC=(/0.010, 0.025, 0.010, 0.010, 0.010, 0.010,
& 0.010, 0.010, 0.010, 0.010, 0.010, 0.010,
& 0.010, 0.010, 0.010, 0.010, 0.010, 0.010,
& 0.010, 0.000, 0.000, 0.000, 0.000, 0.000,
& 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/)
! !!!!!!!!!!!!!! The following values in the table are NOT used
! !!!!!!!!!!!!!! and are just given for reference
Expand Down Expand Up @@ -383,7 +388,7 @@ subroutine set_soilveg(me,isot,ivet,nlunit)
DO I = 1,DEFINED_SOIL
if (satdk(i) /= 0.0 .and. bb(i) > 0.0) then
SATDW(I) = BB(I)*SATDK(I)*(SATPSI(I)/MAXSMC(I))
F11(I) = ALOG10(SATPSI(I)) + BB(I)*ALOG10(MAXSMC(I)) + 2.0
F11(I) = LOG10(SATPSI(I)) + BB(I)*LOG10(MAXSMC(I)) + 2.0
REFSMC1 = MAXSMC(I)*(5.79E-9/SATDK(I))
& **(1.0/(2.0*BB(I)+3.0))
REFSMC(I) = REFSMC1 + (MAXSMC(I)-REFSMC1) / SMHIGH
Expand All @@ -394,7 +399,7 @@ subroutine set_soilveg(me,isot,ivet,nlunit)
! CURRENT VERSION DRYSMC VALUES THAT EQUATE TO WLTSMC.
! FUTURE VERSION COULD LET DRYSMC BE INDEPENDENTLY SET VIA NAMELIST.
! ----------------------------------------------------------------------
DRYSMC(I) = WLTSMC(I)
! DRYSMC(I) = WLTSMC(I)
endif
END DO

Expand Down
4 changes: 2 additions & 2 deletions physics/sfc_sice.f
Original file line number Diff line number Diff line change
Expand Up @@ -313,8 +313,8 @@ subroutine sfc_sice_run &
! qsurf - real, specific humidity at sfc im !
! snowmt - real, snow melt (m) im !
! gflux - real, soil heat flux (w/m**2) im !
! cmm - real, im !
! chh - real, im !
! cmm - real, surface exchange coeff for momentum (m/s) im !
! chh - real, surface exchange coeff heat&moisture (m/s) im !
! evap - real, evaperation from latent heat flux im !
! hflx - real, sensible heat flux im !
! !
Expand Down