diff --git a/physics/h2ointerp.f90 b/physics/h2ointerp.f90 index 5548142a8..af3021f4e 100644 --- a/physics/h2ointerp.f90 +++ b/physics/h2ointerp.f90 @@ -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 !--- @@ -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) @@ -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 diff --git a/physics/machine.F b/physics/machine.F index ce07f8c35..d39159bee 100644 --- a/physics/machine.F +++ b/physics/machine.F @@ -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 & @@ -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 & diff --git a/physics/memcheck.F90 b/physics/memcheck.F90 index 13e64b6d0..280462ea8 100644 --- a/physics/memcheck.F90 +++ b/physics/memcheck.F90 @@ -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 @@ -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 @@ -48,10 +28,11 @@ 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 @@ -59,21 +40,20 @@ subroutine memcheck_run (seconds_elapsed, block_number, errmsg, errflg) #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 @@ -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 @@ -106,7 +84,7 @@ 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 @@ -114,36 +92,6 @@ subroutine memcheck_run (seconds_elapsed, block_number, errmsg, errflg) #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 diff --git a/physics/ozinterp.f90 b/physics/ozinterp.f90 index f00927711..656bfafbe 100644 --- a/physics/ozinterp.f90 +++ b/physics/ozinterp.f90 @@ -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 !--- @@ -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) @@ -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 diff --git a/physics/set_soilveg.f b/physics/set_soilveg.f index 3137bcc8d..333748b9d 100644 --- a/physics/set_soilveg.f +++ b/physics/set_soilveg.f @@ -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 @@ -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 @@ -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 diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 615890ff0..5bd5a2ca9 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -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 ! ! !