Skip to content

Commit

Permalink
1) Add ROS subgrid variable to the "state:..." clause in package decl…
Browse files Browse the repository at this point in the history
…aration.

This fixes a situation where a 2D field with zero length dimensions was being written to WRF I/O API.  The dimensions were zero length because ROS is a subgrid-dimensioned variable but the subgrid dimensions are zero unless fire is turned on.  This caused problems for parallel NetCDF.  (Jan and Jonathan, can you check and make sure this change is okay for you, please?)  Also including a fix for netcdf and parallel NetCDF implementations of I/O API so that they handle this situation correctly (see below). 

2) Fix for CAM threading bug

A few variables defined at the top of module_ra_cam need to be declared as automatic variables inside the radcswmx routine instead for thread-safety.  This was causing very ugly failures for the NRCM runs on the Argonne BG/P, and would also cause problems for other OpenMP runs with CAM.  (Hoping we notice the set of CAM OpenMP failures in the regression tests go away too.)  Also, there is some non-thread-safe code in module_radiation_driver that I have moved up and out of the OMP loop.

3) Fix for threading error in sst_skin updating code.

This fell out in testing of NRCM on the ANL BG/P machine.  The new call to sst_skin_update needed to be inside the loop over num_tiles.

4) Fix for some missing SELECT cases for reading through pNetCDF.

Was not reading properly when the input stream was an auxinput.  Only parallel-NetCDF affected.

5) Performance mods to parallel NetCDF.

Do a parallel transpose before writing the data to the parallel file system.  Should provide better I/O performance by blocking the data.  Basically does an x-transpose (all points in x in processor) then writes to parallel-NetCDF.

6) fix problem with zero-length write requests in netcdf and pnetcdf

Added a function that checks and just returns, ignoring requests to write fields with zero length dimensions in calls to *_write_field. This can happen with subgrid arrays (like ROS, above) if the subgrid dimensions are not specfied (ie. if fire is not turned on in this case, though previous proposal will avoid that situation).

7) Change to clean command.

Added an -aa option that does what clean does but without deleting my stuff in the test/em_directory.

8) Restore regtest.csh. 

I accidentally changed this a couple commits ago. Steve noticed and gave me hell :-)
Just restoring to original state.



git-svn-id: https://svn-wrf-model.cgd.ucar.edu/trunk@4171 b0b5d27b-6f0f-0410-a2a3-cb1e977edc3d
  • Loading branch information
John Michalakes committed Feb 19, 2010
1 parent bfae60f commit 7a777f5
Show file tree
Hide file tree
Showing 10 changed files with 215 additions and 52 deletions.
2 changes: 1 addition & 1 deletion Registry/registry.fire
Expand Up @@ -8,7 +8,7 @@
#<key> <package <associated <package <associated 4d scalars>
# name> namelist choice> state vars>
#
package fire_sfire ifire==2 - state:nfuel_cat,zsf,tign_g,rthfrten,rqvfrten,grnhfx,grnqfx,canhfx,canqfx,lfn,fuel_frac,fire_area,uf,vf,fgrnhfx,fgrnqfx,fcanhfx,fcanhfx,fcanqfx,fxlong,fxlat,fuel_time,bbb,betafl,phiwc,r_0,fgip,ischap
package fire_sfire ifire==2 - state:nfuel_cat,zsf,tign_g,rthfrten,rqvfrten,grnhfx,grnqfx,canhfx,canqfx,lfn,fuel_frac,fire_area,uf,vf,fgrnhfx,fgrnqfx,fcanhfx,fcanhfx,fcanqfx,ros,fxlong,fxlat,fuel_time,bbb,betafl,phiwc,r_0,fgip,ischap

# fire variables on fire grid
#
Expand Down
24 changes: 14 additions & 10 deletions clean
Expand Up @@ -20,7 +20,9 @@ endif
( cd inc ; /bin/rm -f *.inc namelist.default )


if ( "$1" == '-a' ) then
set echo
set arg="$1"
if ( "$arg" == '-a' || "$arg" == '-aa' ) then
if ( -d var ) then
( cd var ; make superclean )
( cd var/obsproc ; make clean )
Expand All @@ -40,15 +42,17 @@ if ( "$1" == '-a' ) then
( cd external/atm_pom ; make clean )
( cd tools ; /bin/rm -f registry gen_comms.c fseeko_test fseeko64_test )
( cd inc; /bin/rm -f dm_comm_cpp_flags wrf_io_flags.h wrf_status_codes.h )
( cd run ; /bin/rm -f gm* out* fort* ideal* *.exe ; \
/bin/cp -f namelist.input namelist.input.backup ; \
/bin/rm -f namelist.input ) >& /dev/null
( cd test/exp_real ; /bin/rm -f gm* out* fort* real* )
( cd test ; rm -f */*.exe */ETAMPNEW_DATA */GENPARM.TBL */LANDUSE.TBL */README.namelist \
*/RRTM_DATA */SOILPARM.TBL */VEGPARM.TBL */URBPARM.TBL */grib2map.tbl \
*/CAM_ABS_DATA */CAM_AEROPT_DATA */RRTMG_LW_DATA */RRTMG_SW_DATA \
*/ozone.formatted */ozone_lat.formatted */ozone_plev.formatted \
*/gribmap.txt */tr??t?? */co2_trans) >& /dev/null
if ( "$arg" != '-aa' ) then
( cd run ; /bin/rm -f gm* out* fort* ideal* *.exe ; \
/bin/cp -f namelist.input namelist.input.backup ; \
/bin/rm -f namelist.input ) >& /dev/null
( cd test/exp_real ; /bin/rm -f gm* out* fort* real* )
( cd test ; rm -f */*.exe */ETAMPNEW_DATA */GENPARM.TBL */LANDUSE.TBL */README.namelist \
*/RRTM_DATA */SOILPARM.TBL */VEGPARM.TBL */URBPARM.TBL */grib2map.tbl \
*/CAM_ABS_DATA */CAM_AEROPT_DATA */RRTMG_LW_DATA */RRTMG_SW_DATA \
*/ozone.formatted */ozone_lat.formatted */ozone_plev.formatted \
*/gribmap.txt */tr??t?? */co2_trans) >& /dev/null
endif
endif

#cms++
Expand Down
32 changes: 32 additions & 0 deletions external/RSL_LITE/module_dm.F
Expand Up @@ -2138,6 +2138,22 @@ SUBROUTINE wrf_get_dm_communicator ( communicator )
RETURN
END SUBROUTINE wrf_get_dm_communicator

SUBROUTINE wrf_get_dm_communicator_x ( communicator )
USE module_dm , ONLY : local_communicator_x
IMPLICIT NONE
INTEGER , INTENT(OUT) :: communicator
communicator = local_communicator_x
RETURN
END SUBROUTINE wrf_get_dm_communicator_x

SUBROUTINE wrf_get_dm_communicator_y ( communicator )
USE module_dm , ONLY : local_communicator_y
IMPLICIT NONE
INTEGER , INTENT(OUT) :: communicator
communicator = local_communicator_y
RETURN
END SUBROUTINE wrf_get_dm_communicator_y

SUBROUTINE wrf_get_dm_iocommunicator ( iocommunicator )
USE module_dm , ONLY : local_iocommunicator
IMPLICIT NONE
Expand All @@ -2162,6 +2178,22 @@ SUBROUTINE wrf_set_dm_iocommunicator ( iocommunicator )
RETURN
END SUBROUTINE wrf_set_dm_iocommunicator

SUBROUTINE wrf_get_dm_ntasks_x ( retval )
USE module_dm , ONLY : ntasks_x
IMPLICIT NONE
INTEGER , INTENT(OUT) :: retval
retval = ntasks_x
RETURN
END SUBROUTINE wrf_get_dm_ntasks_x

SUBROUTINE wrf_get_dm_ntasks_y ( retval )
USE module_dm , ONLY : ntasks_y
IMPLICIT NONE
INTEGER , INTENT(OUT) :: retval
retval = ntasks_y
RETURN
END SUBROUTINE wrf_get_dm_ntasks_y


!!!!!!!!!!!!!!!!!!!!!!! PATCH TO GLOBAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Expand Down
42 changes: 42 additions & 0 deletions external/io_netcdf/wrf_io.F90
Expand Up @@ -464,6 +464,42 @@ subroutine GetIndices(NDim,Start,End,i1,i2,j1,j2,k1,k2)
return
end subroutine GetIndices

logical function ZeroLengthHorzDim(MemoryOrder,Vector,Status)
use wrf_data
include 'wrf_status_codes.h'
character*(*) ,intent(in) :: MemoryOrder
integer,dimension(*) ,intent(in) :: Vector
integer ,intent(out) :: Status
integer :: NDim
integer,dimension(NVarDims) :: temp
character*3 :: MemOrd
logical zero_length

call GetDim(MemoryOrder,NDim,Status)
temp(1:NDim) = Vector(1:NDim)
call LowerCase(MemoryOrder,MemOrd)
zero_length = .false.
select case (MemOrd)
case ('xsz','xez','ysz','yez','xs','xe','ys','ye','z','c')
continue
case ('0')
continue ! NDim=0 for scalars. TBH: 20060502
case ('xzy','yzx')
zero_length = temp(1) .lt. 1 .or. temp(3) .lt. 1
case ('xy','yx','xyz','yxz')
zero_length = temp(1) .lt. 1 .or. temp(2) .lt. 1
case ('zxy','zyx')
zero_length = temp(2) .lt. 1 .or. temp(3) .lt. 1
case default
Status = WRF_WARN_BAD_MEMORYORDER
ZeroLengthHorzDim = .true.
return
end select
Status = WRF_NO_ERR
ZeroLengthHorzDim = zero_length
return
end function ZeroLengthHorzDim

subroutine ExtOrder(MemoryOrder,Vector,Status)
use wrf_data
include 'wrf_status_codes.h'
Expand Down Expand Up @@ -2360,6 +2396,12 @@ subroutine ext_ncd_write_field(DataHandle,DateStr,Var,Field,FieldTypeIn, &

Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1

IF ( ZeroLengthHorzDim(MemoryOrder,Length,Status) ) THEN
write(msg,*)'ext_ncd_write_field: zero length dimension in ',TRIM(Var),'. Ignoring'
call wrf_debug ( WARN , TRIM(msg))
return
ENDIF

call ExtOrder(MemoryOrder,Length,Status)
call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status)
if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
Expand Down
56 changes: 50 additions & 6 deletions external/io_pnetcdf/wrf_io.F90
Expand Up @@ -473,6 +473,42 @@ subroutine GetIndices(NDim,Start,End,i1,i2,j1,j2,k1,k2)
return
end subroutine GetIndices

logical function ZeroLengthHorzDim(MemoryOrder,Vector,Status)
use wrf_data_pnc
include 'wrf_status_codes.h'
character*(*) ,intent(in) :: MemoryOrder
integer,dimension(*) ,intent(in) :: Vector
integer ,intent(out) :: Status
integer :: NDim
integer,dimension(NVarDims) :: temp
character*3 :: MemOrd
logical zero_length

call GetDim(MemoryOrder,NDim,Status)
temp(1:NDim) = Vector(1:NDim)
call LowerCase(MemoryOrder,MemOrd)
zero_length = .false.
select case (MemOrd)
case ('xsz','xez','ysz','yez','xs','xe','ys','ye','z','c')
continue
case ('0')
continue ! NDim=0 for scalars. TBH: 20060502
case ('xzy','yzx')
zero_length = temp(1) .lt. 1 .or. temp(3) .lt. 1
case ('xy','yx','xyz','yxz')
zero_length = temp(1) .lt. 1 .or. temp(2) .lt. 1
case ('zxy','zyx')
zero_length = temp(2) .lt. 1 .or. temp(3) .lt. 1
case default
Status = WRF_WARN_BAD_MEMORYORDER
ZeroLengthHorzDim = .true.
return
end select
Status = WRF_NO_ERR
ZeroLengthHorzDim = zero_length
return
end function ZeroLengthHorzDim

subroutine ExtOrder(MemoryOrder,Vector,Status)
use wrf_data_pnc
include 'wrf_status_codes.h'
Expand Down Expand Up @@ -1202,11 +1238,13 @@ SUBROUTINE ext_pnc_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,DataHand
DH%Times = ZeroDate
CALL get_value_pnetcdf( 'GRIDID', SysDepInfo ,idstr )
CALL get_value_pnetcdf( 'NTASKS_X', SysDepInfo ,ntasks_x_str )
CALL get_value_pnetcdf( 'LOCAL_COMMUNICATOR_X', SysDepInfo ,loccomm_str )
! CALL get_value_pnetcdf( 'LOCAL_COMMUNICATOR_X', SysDepInfo ,loccomm_str )
IF ( LEN(idstr) > 0 ) THEN
READ(idstr,'i3') gridid
READ(ntasks_x_str,*)ntasks_x
READ(loccomm_str,*)local_communicator_x
! READ(ntasks_x_str,*)ntasks_x
! READ(loccomm_str,*)local_communicator_x
CALL wrf_get_dm_communicator_x(local_communicator_x)
CALL wrf_get_dm_ntasks_x(ntasks_x)
DH%GridID = gridid
DH%ntasks_x = ntasks_x
DH%local_communicator_x = local_communicator_x
Expand Down Expand Up @@ -1323,7 +1361,7 @@ SUBROUTINE ext_pnc_open_for_write_commit(DataHandle, Status)
stat = NFMPI_ENDDEF(DH%NCID)
call netcdf_err(stat,Status)
if(Status /= WRF_NO_ERR) then
write(msg,*) 'NetCDF error in ext_pnc_open_for_write_commit ',__FILE__,', line', __LINE__
write(msg,*) 'NetCDF error (',stat,') from NFMPI_ENDDEF in ext_pnc_open_for_write_commit ',__FILE__,', line', __LINE__
call wrf_debug ( WARN , TRIM(msg))
return
endif
Expand Down Expand Up @@ -2371,6 +2409,12 @@ subroutine ext_pnc_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm, &
ENDIF
Length_global(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1

IF ( ZeroLengthHorzDim(MemoryOrder,Length_global,Status) ) THEN
write(msg,*)'ext_pnc_write_field: zero length global dimension in ',TRIM(Var),'. Ignoring'
call wrf_debug ( WARN , TRIM(msg))
return
ENDIF

call ExtOrder(MemoryOrder,Length,Status)
call ExtOrder(MemoryOrder,Length_global,Status)

Expand All @@ -2386,7 +2430,7 @@ subroutine ext_pnc_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm, &
do NVar=1,MaxVars
if(DH%VarNames(NVar) == VarName ) then
Status = WRF_WARN_2DRYRUNS_1VARIABLE
write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE in ',__FILE__,', line', __LINE__
write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE (',TRIM(VarName),') in ',__FILE__,', line', __LINE__
call wrf_debug ( WARN , TRIM(msg))
return
elseif(DH%VarNames(NVar) == NO_NAME) then
Expand Down Expand Up @@ -2418,7 +2462,7 @@ subroutine ext_pnc_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm, &
exit
elseif(i == MaxDims) then
Status = WRF_WARN_TOO_MANY_DIMS
write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
write(msg,*) 'Warning TOO MANY DIMENSIONS (',i,') in (',TRIM(VarName),') ',__FILE__,', line', __LINE__
call wrf_debug ( WARN , TRIM(msg))
return
endif
Expand Down
19 changes: 14 additions & 5 deletions frame/module_io.F
Expand Up @@ -551,6 +551,11 @@ SUBROUTINE wrf_open_for_read_begin( FileName , Comm_compute, Comm_io, SysDepInfo
CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
ENDIF
#endif
#ifdef PNETCDF
CASE ( IO_PNETCDF )
CALL ext_pnc_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
Hndl , Status )
#endif
#ifdef XXX
CASE ( IO_XXX )
CALL ext_xxx_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
Expand Down Expand Up @@ -685,6 +690,10 @@ SUBROUTINE wrf_open_for_read_commit( DataHandle , Status )
CASE ( IO_ESMF )
CALL ext_esmf_open_for_read_commit ( Hndl , Status )
#endif
#ifdef PNETCDF
CASE ( IO_PNETCDF )
CALL ext_pnc_open_for_read_commit ( Hndl , Status )
#endif
#ifdef XXX
CASE ( IO_XXX )
CALL ext_xxx_open_for_read_commit ( Hndl , Status )
Expand Down Expand Up @@ -770,16 +779,16 @@ SUBROUTINE wrf_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
ENDIF
#endif
#ifdef PHDF5
CASE ( IO_PHDF5 )
CALL ext_phdf5_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
Hndl , Status )
#endif
#ifdef PNETCDF
CASE ( IO_PNETCDF )
CALL ext_pnc_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
Hndl , Status )
#endif
#ifdef PHDF5
CASE ( IO_PHDF5 )
CALL ext_phdf5_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
Hndl , Status )
#endif
#ifdef XXX
CASE ( IO_XXX )
CALL ext_xxx_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
Expand Down
22 changes: 22 additions & 0 deletions phys/module_ra_cam.F
Expand Up @@ -22,12 +22,15 @@ MODULE module_ra_cam
data ebarl/ 0.829 , 0.794 ,0.754 ,0.826 /
data fbarl/ 2.482e-03, 4.226e-03,6.560e-03,4.353e-03/
#if 0
! moved and changed to local variables into radcswmx for thread-safety, JM 20100217
real(r8) abarli ! A coefficient for current spectral band
real(r8) bbarli ! B coefficient for current spectral band
real(r8) cbarli ! C coefficient for current spectral band
real(r8) dbarli ! D coefficient for current spectral band
real(r8) ebarli ! E coefficient for current spectral band
real(r8) fbarli ! F coefficient for current spectral band
#endif
!
! Caution... A. Slingo recommends no less than 4.0 micro-meters nor
! greater than 20 micro-meters
Expand All @@ -50,12 +53,15 @@ MODULE module_ra_cam
data ebari/ 0.7661 , 0.7730 ,0.794 ,0.9595 /
data fbari/ 5.851e-04, 5.665e-04,7.267e-04,1.076e-04/
#if 0
! moved and changed to local variables into radcswmx for thread-safety, JM 20100217
real(r8) abarii ! A coefficient for current spectral band
real(r8) bbarii ! B coefficient for current spectral band
real(r8) cbarii ! C coefficient for current spectral band
real(r8) dbarii ! D coefficient for current spectral band
real(r8) ebarii ! E coefficient for current spectral band
real(r8) fbarii ! F coefficient for current spectral band
#endif
!
real(r8) delta ! Pressure (in atm) for stratos. h2o limit
real(r8) o2mmr ! O2 mass mixing ratio:
Expand Down Expand Up @@ -6021,6 +6027,22 @@ subroutine radcswmx(jj, lchnk ,ncol ,pcols, pver, pverp, &
real(r8) fluxdn(0:pverp) ! Down flux at model interface
real(r8) wexptdn ! Direct solar beam trans. to surface

! moved to here from the module storage above, because these have to be thread-private. JM 20100217
real(r8) abarli ! A coefficient for current spectral band
real(r8) bbarli ! B coefficient for current spectral band
real(r8) cbarli ! C coefficient for current spectral band
real(r8) dbarli ! D coefficient for current spectral band
real(r8) ebarli ! E coefficient for current spectral band
real(r8) fbarli ! F coefficient for current spectral band

real(r8) abarii ! A coefficient for current spectral band
real(r8) bbarii ! B coefficient for current spectral band
real(r8) cbarii ! C coefficient for current spectral band
real(r8) dbarii ! D coefficient for current spectral band
real(r8) ebarii ! E coefficient for current spectral band
real(r8) fbarii ! F coefficient for current spectral band
! JM 20100217

!
!-----------------------------------------------------------------------
! START OF CALCULATION
Expand Down

0 comments on commit 7a777f5

Please sign in to comment.