<p><b>dwj07@fsu.edu</b> 2012-01-06 15:48:40 -0700 (Fri, 06 Jan 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Fixing some compilation issues that arose from merging trunk to branch.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/ocean_projects/performance/src/Makefile
===================================================================
--- branches/ocean_projects/performance/src/Makefile 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/Makefile 2012-01-06 22:48:40 UTC (rev 1317)
@@ -7,7 +7,7 @@
reg_includes:
( cd registry; make CC="$(SCC)" )
- ( cd inc; ../registry/parse ../core_$(CORE)/Registry )
+ ( cd inc; $(CPP) ../core_$(CORE)/Registry | ../registry/parse > Registry.processed)
externals:
( cd external; make FC="$(FC)" SFC="$(SFC)" CC="$(CC)" SCC="$(SCC)" FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" NETCDF="$(NETCDF)" CORE="$(CORE)" )
@@ -33,7 +33,7 @@
( cd external; make clean )
( cd framework; make clean )
( cd operators; make clean )
- ( cd inc; rm -f *.inc )
+ ( cd inc; rm -f *.inc Registry.processed )
if [ -d core_$(CORE) ] ; then \
( cd core_$(CORE); make clean ) \
fi;
Modified: branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_date_time.F
===================================================================
--- branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_date_time.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_date_time.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,10 +1,11 @@
!=============================================================================================
module mpas_atmphys_date_time
+ use mpas_kind_types
+
implicit none
private
- public:: get_current_date, &
- get_julgmt, &
+ public:: get_julgmt, &
monthly_interp_to_date, &
monthly_min_max
@@ -13,17 +14,6 @@
contains
!=============================================================================================
- subroutine get_current_date
-!=============================================================================================
-
-!temporary subroutine to provide the date at which the forecast begins.right now, that date is
-!hard-wired. This will change when the time manager is in place.
-
- current_date = '2010-10-23_00'
-
- end subroutine get_current_date
-
-!=============================================================================================
subroutine get_julgmt(date_str,julyr,julday,gmt)
!=============================================================================================
Modified: branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_driver_lsm.F
===================================================================
--- branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_driver_lsm.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_driver_lsm.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -18,10 +18,10 @@
deallocate_lsm, &
driver_lsm
- logical,parameter:: rdxmaxalb = .true. !use snow albedo from geogrid;false use table values
- logical,parameter:: myj = .false. !true if using Mellor-Yamada PBL scheme.
- logical,parameter:: frpcpn = .false.
- logical,parameter:: rdlai2d = .false.
+ logical,parameter:: rdmaxalb = .false. !use snow albedo from geogrid;false use table values
+ logical,parameter:: myj = .false. !true if using Mellor-Yamada PBL scheme.
+ logical,parameter:: frpcpn = .false.
+ logical,parameter:: rdlai2d = .false.
!urban physics: since MPAS does not plan to run the urban physics option, the two options
!below are defined locally:
Modified: branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_init.F
===================================================================
--- branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_init.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_init.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -73,8 +73,7 @@
!initialization of global surface properties. set here for now, but may be moved when time
!manager is implemented:
- if(.not. config_do_restart) &
- call landuse_init_forMPAS(dminfo,julday,mesh,diag_physics,sfc_input)
+ call landuse_init_forMPAS(dminfo,julday,mesh,diag_physics,sfc_input)
!initialization of parameterized deep convective processes:
if(config_conv_deep_scheme .ne. 'off') &
Modified: branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_initialize_real.F
===================================================================
--- branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,6 @@
!=============================================================================================
module mpas_atmphys_initialize_real
+ use mpas_kind_types
use mpas_configure, only: config_met_prefix, &
config_frac_seaice, &
config_input_sst, &
@@ -82,12 +83,12 @@
if(field % iproj == PROJ_LATLON) then
call map_set(PROJ_LATLON, proj, &
- latinc = real(field % deltalat), &
- loninc = real(field % deltalon), &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ latinc = real(field % deltalat,RKIND), &
+ loninc = real(field % deltalon,RKIND), &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
end if
!Interpolate field to each MPAS grid cell:
@@ -110,10 +111,10 @@
if(index(field % field,'SST') /= 0) then
fg % sst % array(iCell) = interp_sequence(x,y,1,slab_r8,1,field%nx, &
- 1,field%ny,1,1,-1.e30,interp_list,1)
+ 1,field%ny,1,1,-1.e30_RKIND,interp_list,1)
elseif(index(field % field,'SEAICE') /= 0) then
fg % xice % array(iCell) = interp_sequence(x,y,1,slab_r8,1,field%nx, &
- 1,field%ny,1,1,-1.e30,interp_list,1)
+ 1,field%ny,1,1,-1.e30_RKIND,interp_list,1)
endif
end do
Modified: branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_landuse.F
===================================================================
--- branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_landuse.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_landuse.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -6,7 +6,8 @@
module mpas_atmphys_landuse
use mpas_configure,only: input_landuse_data, &
config_sfc_albedo, &
- config_frac_seaice
+ config_frac_seaice, &
+ config_do_restart
use mpas_dmpar
use mpas_grid_types
@@ -184,6 +185,11 @@
DM_BCAST_MACRO(scfx)
write(0,*) '--- isice =',isice
write(0,*) '--- iswater =',iswater
+ if(config_do_restart) then
+ write(0,*) '--- config_do_restart =', config_do_restart
+ write(0,*) '--- skip the end of landuse_init_forMPAS'
+ return
+ endif
!defines the surface properties over the entire domain:
do iCell = 1, nCells
Modified: branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_vars.F
===================================================================
--- branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_vars.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_atmos_physics/mpas_atmphys_vars.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,7 @@
!=============================================================================================
module mpas_atmphys_vars
+
+ use mpas_kind_types
implicit none
public
Modified: branches/ocean_projects/performance/src/core_hyd_atmos/Registry
===================================================================
--- branches/ocean_projects/performance/src/core_hyd_atmos/Registry 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_hyd_atmos/Registry 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,6 +1,6 @@
-#
-# namelist type namelist_record name default_value
-#
+%
+% namelist type namelist_record name default_value
+%
namelist integer sw_model config_test_case 5
namelist character sw_model config_time_integration SRK3
namelist real sw_model config_dt 172.8
@@ -31,9 +31,9 @@
namelist logical restart config_do_restart false
namelist character restart config_restart_interval none
-#
-# dim type name_in_file name_in_code
-#
+%
+% dim type name_in_file name_in_code
+%
dim nCells nCells
dim nEdges nEdges
dim maxEdges maxEdges
@@ -44,14 +44,14 @@
dim FIFTEEN 15
dim TWENTYONE 21
dim R3 3
-#dim nVertLevels nVertLevels
+%dim nVertLevels nVertLevels
dim nVertLevels namelist:config_nvertlevels
-#dim nTracers nTracers
+%dim nTracers nTracers
dim nVertLevelsP1 nVertLevels+1
-#
-# var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
-#
+%
+% var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
+%
var persistent text xtime ( Time ) 2 ro xtime state - -
var persistent real latCell ( nCells ) 0 iro latCell mesh - -
@@ -102,7 +102,7 @@
var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
var persistent real h_s ( nCells ) 0 iro h_s mesh - -
-# description of the vertical grid structure
+% description of the vertical grid structure
var persistent real rdnu ( nVertLevels ) 0 iro rdnu mesh - -
var persistent real rdnw ( nVertLevels ) 0 iro rdnw mesh - -
var persistent real fnm ( nVertLevels ) 0 iro fnm mesh - -
@@ -111,16 +111,16 @@
var persistent real dnu ( nVertLevels ) 0 iro dnu mesh - -
var persistent real dnw ( nVertLevels ) 0 iro dnw mesh - -
-# Prognostic variables: read from input, saved in restart, and written to output
+% Prognostic variables: read from input, saved in restart, and written to output
var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
var persistent real theta ( nVertLevels nCells Time ) 2 iro theta state - -
var persistent real surface_pressure ( nCells Time ) 2 iro surface_pressure state - -
var persistent real qv ( nVertLevels nCells Time ) 2 iro qv state scalars moist
var persistent real qc ( nVertLevels nCells Time ) 2 iro qc state scalars moist
var persistent real qr ( nVertLevels nCells Time ) 2 iro qr state scalars moist
-#var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro state tracers - -
+%var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro state tracers - -
-# state variables diagnosed from prognostic state
+% state variables diagnosed from prognostic state
var persistent real h ( nVertLevels nCells Time ) 2 ro h state - -
var persistent real ww ( nVertLevelsP1 nCells Time ) 2 ro ww state - -
var persistent real w ( nVertLevelsP1 nCells Time ) 2 ro w state - -
@@ -128,7 +128,7 @@
var persistent real geopotential ( nVertLevelsP1 nCells Time ) 2 ro geopotential state - -
var persistent real alpha ( nVertLevels nCells Time ) 2 iro alpha state - -
-# Diagnostic fields: only written to output
+% Diagnostic fields: only written to output
var persistent real v ( nVertLevels nEdges Time ) 2 o v state - -
var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
@@ -143,7 +143,7 @@
var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 o uReconstructZonal diag - -
var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 o uReconstructMeridional diag - -
-# Tendency variables
+% Tendency variables
var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
var persistent real tend_vh ( nVertLevels nEdges Time ) 1 - vh tend - -
@@ -152,7 +152,7 @@
var persistent real tend_qc ( nVertLevels nCells Time ) 1 - qc tend scalars moist
var persistent real tend_qr ( nVertLevels nCells Time ) 1 - qr tend scalars moist
-# Other diagnostic variables: neither read nor written to any files
+% Other diagnostic variables: neither read nor written to any files
var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
@@ -174,12 +174,12 @@
var persistent real qv_old ( nVertLevels nCells ) 0 - qv_old mesh scalars_old moist_old
var persistent real qc_old ( nVertLevels nCells ) 0 - qc_old mesh scalars_old moist_old
var persistent real qr_old ( nVertLevels nCells ) 0 - qr_old mesh scalars_old moist_old
-#var persistent real tracers_old ( nTracers nVertLevels nCells ) 0 - tracers_old mesh - -
+%var persistent real tracers_old ( nTracers nVertLevels nCells ) 0 - tracers_old mesh - -
-# Space needed for advection
+% Space needed for advection
var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 o deriv_two mesh - -
var persistent integer advCells ( TWENTYONE nCells ) 0 - advCells mesh - -
-# Arrays required for reconstruction of velocity field
+% Arrays required for reconstruction of velocity field
var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
Modified: branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_advection.F
===================================================================
--- branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_advection.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_advection.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,6 @@
module atmh_advection
+ use mpas_kind_types
use mpas_grid_types
use mpas_configure
use mpas_constants
@@ -116,7 +117,7 @@
theta_abs(iCell) = pii/2. - sphere_angle( xc(1), yc(1), zc(1), &
xc(2), yc(2), zc(2), &
- 0., 0., 1. )
+ 0.0_RKIND, 0.0_RKIND, 1.0_RKIND )
! angles from cell center to neighbor centers (thetav)
@@ -335,7 +336,7 @@
! Computes the angle between arcs AB and AC, given points A, B, and C
! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
+ real (kind=RKIND) function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
implicit none
@@ -355,9 +356,9 @@
real (kind=RKIND) :: s ! Semiperimeter of the triangle
real (kind=RKIND) :: sin_angle
- a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0)) ! Eqn. (3)
- b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0)) ! Eqn. (2)
- c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0)) ! Eqn. (1)
+ a = acos(max(min(bx*cx + by*cy + bz*cz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (3)
+ b = acos(max(min(ax*cx + ay*cy + az*cz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (2)
+ c = acos(max(min(ax*bx + ay*by + az*bz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (1)
ABx = bx - ax
ABy = by - ay
@@ -373,12 +374,12 @@
s = 0.5*(a + b + c)
! sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c))) ! Eqn. (28)
- sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c))))) ! Eqn. (28)
+ sin_angle = sqrt(min(1.0_RKIND,max(0.0_RKIND,(sin(s-b)*sin(s-c))/(sin(b)*sin(c))))) ! Eqn. (28)
if ((Dx*ax + Dy*ay + Dz*az) >= 0.0) then
- sphere_angle = 2.0 * asin(max(min(sin_angle,1.0),-1.0))
+ sphere_angle = 2.0 * asin(max(min(sin_angle,1.0_RKIND),-1.0_RKIND))
else
- sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
+ sphere_angle = -2.0 * asin(max(min(sin_angle,1.0_RKIND),-1.0_RKIND))
end if
end function sphere_angle
@@ -390,7 +391,7 @@
! Computes the angle between vectors AB and AC, given points A, B, and C, and
! a vector (u,v,w) normal to the plane.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
+ real (kind=RKIND) function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
implicit none
@@ -425,9 +426,9 @@
cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
if ((Dx*u + Dy*v + Dz*w) >= 0.0) then
- plane_angle = acos(max(min(cos_angle,1.0),-1.0))
+ plane_angle = acos(max(min(cos_angle,1.0_RKIND),-1.0_RKIND))
else
- plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
+ plane_angle = -acos(max(min(cos_angle,1.0_RKIND),-1.0_RKIND))
end if
end function plane_angle
@@ -440,7 +441,7 @@
! B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
! same sphere centered at the origin.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function arc_length(ax, ay, az, bx, by, bz)
+ real (kind=RKIND) function arc_length(ax, ay, az, bx, by, bz)
implicit none
@@ -575,7 +576,7 @@
! !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
-SUBROUTine MIGS (A,N,X,INDX)
+SUBROUTINE MIGS (A,N,X,INDX)
!
! Subroutine to invert matrix A(N,N) with the inverse stored
! in X(N,N) in the output. Copyright (c) Tao Pang 2001.
@@ -617,7 +618,7 @@
X(J,I) = X(J,I)/A(INDX(J),J)
END DO
END DO
-END SUBROUTine MIGS
+END SUBROUTINE MIGS
SUBROUTINE ELGS (A,N,INDX)
@@ -646,7 +647,7 @@
DO I = 1, N
C1= 0.0
DO J = 1, N
- C1 = AMAX1(C1,ABS(A(I,J)))
+ C1 = MAX(C1,ABS(A(I,J)))
END DO
C(I) = C1
END DO
Modified: branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_test_cases.F
===================================================================
--- branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_test_cases.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_test_cases.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -258,7 +258,7 @@
if (config_test_case == 2) then
r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &
- lat_pert, lon_pert, 1.)/(pert_radius)
+ lat_pert, lon_pert, 1.0_RKIND)/(pert_radius)
u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
else if (config_test_case == 3) then
@@ -468,7 +468,7 @@
end subroutine atmh_test_case_1
- real function sphere_distance(lat1, lon1, lat2, lon2, radius)
+ real (kind=RKIND) function sphere_distance(lat1, lon1, lat2, lon2, radius)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
! sphere with given radius.
@@ -487,7 +487,7 @@
end function sphere_distance
- real function AA(theta)
+ real (kind=RKIND) function AA(theta)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! A, used in height field computation for Rossby-Haurwitz wave
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -506,7 +506,7 @@
end function AA
- real function BB(theta)
+ real (kind=RKIND) function BB(theta)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! B, used in height field computation for Rossby-Haurwitz wave
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -524,7 +524,7 @@
end function BB
- real function CC(theta)
+ real (kind=RKIND) function CC(theta)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! C, used in height field computation for Rossby-Haurwitz wave
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Modified: branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_time_integration.F
===================================================================
--- branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_time_integration.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_hyd_atmos/mpas_atmh_time_integration.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1652,9 +1652,9 @@
! add in vertical flux to get max and min estimate
s_max_update(iScalar) = s_max_update(iScalar) &
- - rdnw(k) * (max(0.,v_flux(iScalar,iCell,km0)) - min(0.,v_flux(iScalar,iCell,km1)))
+ - rdnw(k) * (max(0.0_RKIND,v_flux(iScalar,iCell,km0)) - min(0.0_RKIND,v_flux(iScalar,iCell,km1)))
s_min_update(iScalar) = s_min_update(iScalar) &
- - rdnw(k) * (min(0.,v_flux(iScalar,iCell,km0)) - max(0.,v_flux(iScalar,iCell,km1)))
+ - rdnw(k) * (min(0.0_RKIND,v_flux(iScalar,iCell,km0)) - max(0.0_RKIND,v_flux(iScalar,iCell,km1)))
end do
@@ -1671,8 +1671,8 @@
fdir = -1.0
end if
flux = -fdir * h_flux(iScalar,iEdge)/grid % areaCell % array(iCell)
- s_max_update(iScalar) = s_max_update(iScalar) + max(0.,flux)
- s_min_update(iScalar) = s_min_update(iScalar) + min(0.,flux)
+ s_max_update(iScalar) = s_max_update(iScalar) + max(0.0_RKIND,flux)
+ s_min_update(iScalar) = s_min_update(iScalar) + min(0.0_RKIND,flux)
end do
@@ -1687,9 +1687,9 @@
s_min_update (iScalar) = s_min_update (iScalar) / h_new (k,iCell)
s_upwind = s_update(iScalar,iCell,km0) / h_new(k,iCell)
if ( s_max_update(iScalar) > s_max(iScalar) .and. config_monotonic) &
- scale_in (iScalar,iCell,km0) = max(0.,(s_max(iScalar)-s_upwind)/(s_max_update(iScalar)-s_upwind+eps))
+ scale_in (iScalar,iCell,km0) = max(0.0_RKIND,(s_max(iScalar)-s_upwind)/(s_max_update(iScalar)-s_upwind+eps))
if ( s_min_update(iScalar) < s_min(iScalar) ) &
- scale_out (iScalar,iCell,km0) = max(0.,(s_upwind-s_min(iScalar))/(s_upwind-s_min_update(iScalar)+eps))
+ scale_out (iScalar,iCell,km0) = max(0.0_RKIND,(s_upwind-s_min(iScalar))/(s_upwind-s_min_update(iScalar)+eps))
end do
end do ! end loop over cells to compute scale factor
Modified: branches/ocean_projects/performance/src/core_init_nhyd_atmos/Registry
===================================================================
--- branches/ocean_projects/performance/src/core_init_nhyd_atmos/Registry 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_init_nhyd_atmos/Registry 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,6 +1,6 @@
-#
-# namelist type namelist_record name default_value
-#
+%
+% namelist type namelist_record name default_value
+%
namelist integer nhyd_model config_test_case 5
namelist integer nhyd_model config_calendar_type MPAS_GREGORIAN
namelist character nhyd_model config_start_time none
@@ -35,9 +35,9 @@
namelist real restart config_restart_time 172800.0
-#
-# dim type name_in_file name_in_code
-#
+%
+% dim type name_in_file name_in_code
+%
dim nCells nCells
dim nEdges nEdges
dim maxEdges maxEdges
@@ -56,12 +56,12 @@
dim nVertLevelsP1 nVertLevels+1
dim nMonths 12
-#
-# var type name_in_file ( dims ) iro- name_in_code super-array array_class
-#
+%
+% var type name_in_file ( dims ) iro- name_in_code super-array array_class
+%
var persistent text xtime ( Time ) 2 so xtime state - -
-# horizontal grid structure
+% horizontal grid structure
var persistent real latCell ( nCells ) 0 io latCell mesh - -
var persistent real lonCell ( nCells ) 0 io lonCell mesh - -
@@ -110,16 +110,16 @@
var persistent real fEdge ( nEdges ) 0 io fEdge mesh - -
var persistent real fVertex ( nVertices ) 0 io fVertex mesh - -
-var persistent real densityFunction ( nCells ) 0 iro densityFunction mesh - -
+var persistent real meshDensity ( nCells ) 0 iro meshDensity mesh - -
-# some solver scalar coefficients
+% some solver scalar coefficients
-# coefficients for vertical extrapolation to the surface
+% coefficients for vertical extrapolation to the surface
var persistent real cf1 ( ) 0 io cf1 mesh - -
var persistent real cf2 ( ) 0 io cf2 mesh - -
var persistent real cf3 ( ) 0 io cf3 mesh - -
-# static terrestrial fields
+% static terrestrial fields
var persistent real ter ( nCells ) 0 io ter mesh - -
var persistent integer landmask ( nCells ) 0 io landmask mesh - -
var persistent integer ivgtyp ( nCells ) 0 io lu_index mesh - -
@@ -132,7 +132,7 @@
var persistent real shdmax ( nCells ) 0 io shdmax mesh - -
var persistent real albedo12m ( nMonths nCells ) 0 io albedo12m mesh - -
-# description of the vertical grid structure
+% description of the vertical grid structure
var persistent real hx ( nVertLevelsP1 nCells ) 0 io hx mesh - -
var persistent real zgrid ( nVertLevelsP1 nCells ) 0 io zgrid mesh - -
@@ -148,11 +148,11 @@
var persistent real zb ( nVertLevelsP1 TWO nEdges ) 0 io zb mesh - -
var persistent real zb3 ( nVertLevelsP1 TWO nEdges ) 0 io zb3 mesh - -
-# W-Rayleigh-damping coefficient
+% W-Rayleigh-damping coefficient
var persistent real dss ( nVertLevels nCells ) 0 io dss mesh - -
-# Horizontally interpolated from first-guess data
+% Horizontally interpolated from first-guess data
var persistent real u_fg ( nFGLevels nEdges Time ) 1 - u fg - -
var persistent real v_fg ( nFGLevels nEdges Time ) 1 - v fg - -
var persistent real t_fg ( nFGLevels nCells Time ) 1 - t fg - -
@@ -163,15 +163,15 @@
var persistent real psfc_fg ( nCells Time ) 1 - psfc fg - -
var persistent real pmsl_fg ( nCells Time ) 1 - pmsl fg - -
-# Horizontally interpolated from first-guess data
+% Horizontally interpolated from first-guess data
var persistent real dz_fg ( nFGSoilLevels nCells Time ) 1 io dz_fg fg - -
var persistent real dzs_fg ( nFGSoilLevels nCells Time ) 1 io dzs_fg fg - -
var persistent real zs_fg ( nFGSoilLevels nCells Time ) 1 io zs_fg fg - -
var persistent real st_fg ( nFGSoilLevels nCells Time ) 1 io st_fg fg - -
var persistent real sm_fg ( nFGSoilLevels nCells Time ) 1 io sm_fg fg - -
-# Horizontally interpolated from first-guess data
-# and should be read in by model
+% Horizontally interpolated from first-guess data
+% and should be read in by model
var persistent real dz ( nSoilLevels nCells Time ) 1 io dz fg - -
var persistent real dzs ( nSoilLevels nCells Time ) 1 io dzs fg - -
var persistent real zs ( nSoilLevels nCells Time ) 1 io zs fg - -
@@ -191,7 +191,7 @@
var persistent real sfc_albbck ( nCells Time ) 1 io sfc_albbck fg - -
var persistent real xland ( nCells Time ) 1 io xland fg - -
-# Prognostic variables: read from input, saved in restart, and written to output
+% Prognostic variables: read from input, saved in restart, and written to output
var persistent real u ( nVertLevels nEdges Time ) 2 o u state - -
var persistent real w ( nVertLevelsP1 nCells Time ) 2 o w state - -
var persistent real rho_zz ( nVertLevels nCells Time ) 2 o rho_zz state - -
@@ -200,14 +200,14 @@
var persistent real qc ( nVertLevels nCells Time ) 2 o qc state scalars moist
var persistent real qr ( nVertLevels nCells Time ) 2 o qr state scalars moist
-# state variables diagnosed from prognostic state
+% state variables diagnosed from prognostic state
var persistent real pressure_p ( nVertLevels nCells Time ) 1 - pressure_p diag - -
var persistent real u_init ( nVertLevels ) 0 io u_init mesh - -
var persistent real t_init ( nVertLevels nCells ) 0 io t_init mesh - -
var persistent real qv_init ( nVertLevels ) 0 io qv_init mesh - -
-# Diagnostic fields: only written to output
+% Diagnostic fields: only written to output
var persistent real rho ( nVertLevels nCells Time ) 1 o rho diag - -
var persistent real theta ( nVertLevels nCells Time ) 1 o theta diag - -
var persistent real v ( nVertLevels nEdges Time ) 1 o v diag - -
@@ -229,20 +229,20 @@
var persistent real surface_pressure ( nCells Time ) 1 o surface_pressure diag - -
-# coupled variables needed by the solver, but not output...
+% coupled variables needed by the solver, but not output...
var persistent real ru ( nVertLevels nEdges Time ) 1 - ru diag - -
var persistent real rw ( nVertLevelsP1 nCells Time ) 1 - rw diag - -
var persistent real rtheta_p ( nVertLevels nCells Time ) 1 - rtheta_p diag - -
var persistent real rho_p ( nVertLevels nCells Time ) 1 - rho_p diag - -
-# Space needed for advection
+% Space needed for advection
var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 io deriv_two mesh - -
var persistent integer advCells ( TWENTYONE nCells ) 0 io advCells mesh - -
-# Space needed for deformation calculation weights
+% Space needed for deformation calculation weights
var persistent real defc_a ( maxEdges nCells ) 0 io defc_a mesh - -
var persistent real defc_b ( maxEdges nCells ) 0 io defc_b mesh - -
-# Arrays required for reconstruction of velocity field
+% Arrays required for reconstruction of velocity field
var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 io coeffs_reconstruct mesh - -
Modified: branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_hinterp.F
===================================================================
--- branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_hinterp.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_hinterp.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -545,10 +545,10 @@
ify = floor(yy)
icy = ceiling(yy)
- fxfy = max(0., 1.0 - sqrt((xx-real(ifx))**2+(yy-real(ify))**2))
- fxcy = max(0., 1.0 - sqrt((xx-real(ifx))**2+(yy-real(icy))**2))
- cxfy = max(0., 1.0 - sqrt((xx-real(icx))**2+(yy-real(ify))**2))
- cxcy = max(0., 1.0 - sqrt((xx-real(icx))**2+(yy-real(icy))**2))
+ fxfy = max(0.0_RKIND, 1.0 - sqrt((xx-real(ifx))**2+(yy-real(ify))**2))
+ fxcy = max(0.0_RKIND, 1.0 - sqrt((xx-real(ifx))**2+(yy-real(icy))**2))
+ cxfy = max(0.0_RKIND, 1.0 - sqrt((xx-real(icx))**2+(yy-real(ify))**2))
+ cxcy = max(0.0_RKIND, 1.0 - sqrt((xx-real(icx))**2+(yy-real(icy))**2))
! First, make sure that the point is contained in the source array
if (ifx < start_x .or. icx > end_x .or. &
@@ -744,13 +744,13 @@
if (array(ifx+3-i, ify+3-j, izz) == msgval .or. mask_array(ifx+3-i, ify+3-j) == maskval) then
weights(i,j) = 0.0
else
- weights(i,j) = max(0., 2.0 - sqrt((xx-real(ifx+3-i))**2+(yy-real(ify+3-j))**2))
+ weights(i,j) = max(0.0_RKIND, 2.0 - sqrt((xx-real(ifx+3-i))**2+(yy-real(ify+3-j))**2))
end if
else
if (array(ifx+3-i, ify+3-j, izz) == msgval) then
weights(i,j) = 0.0
else
- weights(i,j) = max(0., 2.0 - sqrt((xx-real(ifx+3-i))**2+(yy-real(ify+3-j))**2))
+ weights(i,j) = max(0.0_RKIND, 2.0 - sqrt((xx-real(ifx+3-i))**2+(yy-real(ify+3-j))**2))
end if
end if
Modified: branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_llxy.F
===================================================================
--- branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_llxy.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_llxy.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -130,6 +130,8 @@
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ USE MPAS_KIND_TYPES
+
INTEGER, PARAMETER :: HH=4, VV=5
REAL (KIND=RKIND), PARAMETER :: PI = 3.141592653589793
@@ -1154,10 +1156,10 @@
! intersects the Earth's surface at each of the distinctly different
! latitudes
IF (ABS(truelat1-truelat2) .GT. 0.1) THEN
- cone = ALOG10(COS(truelat1*rad_per_deg)) - &
- ALOG10(COS(truelat2*rad_per_deg))
- cone = cone /(ALOG10(TAN((45.0 - ABS(truelat1)/2.0) * rad_per_deg)) - &
- ALOG10(TAN((45.0 - ABS(truelat2)/2.0) * rad_per_deg)))
+ cone = LOG10(COS(truelat1*rad_per_deg)) - &
+ LOG10(COS(truelat2*rad_per_deg))
+ cone = cone /(LOG10(TAN((45.0 - ABS(truelat1)/2.0) * rad_per_deg)) - &
+ LOG10(TAN((45.0 - ABS(truelat2)/2.0) * rad_per_deg)))
ELSE
cone = SIN(ABS(truelat1)*rad_per_deg )
ENDIF
@@ -1220,9 +1222,9 @@
! Longitude
lon = proj%stdlon + deg_per_rad * ATAN2(proj%hemi*xx,yy)/proj%cone
# if ( defined (G95) && ( DA_CORE == 1 ) )
- lon = DMOD(lon+360., 360.)
+ lon = DMOD(lon+360., 360.0_RKIND)
# else
- lon = AMOD(lon+360., 360.)
+ lon = MOD(lon+360., 360.0_RKIND)
# endif
! Latitude. Latitude determined by solving an equation adapted
@@ -1323,7 +1325,7 @@
proj%rsw = 0.
IF (proj%lat1 .NE. 0.) THEN
- proj%rsw = (ALOG(TAN(0.5*((proj%lat1+90.)*rad_per_deg))))/proj%dlon
+ proj%rsw = (LOG(TAN(0.5*((proj%lat1+90.)*rad_per_deg))))/proj%dlon
ENDIF
RETURN
@@ -1347,7 +1349,7 @@
IF (deltalon .LT. -180.) deltalon = deltalon + 360.
IF (deltalon .GT. 180.) deltalon = deltalon - 360.
i = proj%knowni + (deltalon/(proj%dlon*deg_per_rad))
- j = proj%knownj + (ALOG(TAN(0.5*((lat + 90.) * rad_per_deg)))) / &
+ j = proj%knownj + (LOG(TAN(0.5*((lat + 90.) * rad_per_deg)))) / &
proj%dlon - proj%rsw
RETURN
@@ -1531,7 +1533,7 @@
! Try to determine whether this domain has global coverage
if (abs(proj%lat1 - proj%latinc/2. + 90.) < 0.001 .and. &
- abs(mod(proj%lon1 - proj%loninc/2. - proj%stdlon,360.)) < 0.001) then
+ abs(mod(proj%lon1 - proj%loninc/2. - proj%stdlon,360.0_RKIND)) < 0.001) then
global_domain = .true.
else
global_domain = .false.
Modified: branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_queue.F
===================================================================
--- branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_queue.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_queue.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -7,6 +7,9 @@
module init_atm_queue
+ use mpas_kind_types
+
+
type q_data ! The user-defined datatype to store in the queue
real (kind=RKIND) :: lat, lon
integer :: x, y
Modified: branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F
===================================================================
--- branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -166,8 +166,8 @@
integer :: eoe, j
integer, dimension(:), pointer :: nEdgesOnEdge
integer, dimension(:,:), pointer :: edgesOnEdge, CellsOnEdge
- real, dimension(:), pointer :: dvEdge, AreaCell
- real, dimension(:,:), pointer :: weightsOnEdge
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, AreaCell
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
@@ -626,7 +626,7 @@
if (config_test_case == 2) then
r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &
- lat_pert, lon_pert, 1.)/(pert_radius)
+ lat_pert, lon_pert, 1.0_RKIND)/(pert_radius)
u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
else if (config_test_case == 3) then
@@ -757,9 +757,9 @@
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
end if
end do
@@ -855,7 +855,7 @@
! renormalize for setting cell-face fluxes
do k=1,nz1
- flux_zonal(k) = sign(1.,lat2_in-lat1_in)*flux_zonal(k)*dlat*a/dvEdge/u0
+ flux_zonal(k) = sign(1.0_RKIND,lat2_in-lat1_in)*flux_zonal(k)*dlat*a/dvEdge/u0
end do
end subroutine init_atm_calc_flux_zonal
@@ -885,7 +885,7 @@
integer :: eoe, j
integer, dimension(:), pointer :: nEdgesOnEdge
integer, dimension(:,:), pointer :: edgesOnEdge
- real, dimension(:,:), pointer :: weightsOnEdge
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, cell1, cell2, nCellsSolve
integer :: index_qv
@@ -1200,7 +1200,7 @@
temp = p(k,i)*thi(k,i)
pres = p0*p(k,i)**(1./rcp)
qvs = 380.*exp(17.27*(temp-273.)/(temp-36.))/pres
- scalars(index_qv,k,i) = amin1(0.014,rh(k,i)*qvs)
+ scalars(index_qv,k,i) = min(0.014_RKIND,rh(k,i)*qvs)
end do
end do
@@ -1422,8 +1422,8 @@
integer :: eoe, j
integer, dimension(:), pointer :: nEdgesOnEdge
integer, dimension(:,:), pointer :: edgesOnEdge, CellsOnEdge
- real, dimension(:), pointer :: dvEdge, AreaCell, xCell, yCell
- real, dimension(:,:), pointer :: weightsOnEdge
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, AreaCell, xCell, yCell
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp, cell1, cell2, nCellsSolve
integer :: index_qv
@@ -1649,7 +1649,7 @@
! smoothing grid for the upper level >> but not propoer for parallel programing
dzmin=.7
do k=2,nz1
- sm = .25*min((zc(k)-zc(k-1))/dz,1.)
+ sm = .25*min((zc(k)-zc(k-1))/dz,1.0_RKIND)
do i=1,grid % nCells
hx(k,i) = hx(k-1,i)
end do
@@ -1826,7 +1826,7 @@
temp = p(k,i)*t(k,i)
pres = p0*p(k,i)**(1./rcp)
qvs = 380.*exp(17.27*(temp-273.)/(temp-36.))/pres
- scalars(index_qv,k,i) = amin1(0.014,rh(k,i)*qvs)
+ scalars(index_qv,k,i) = min(0.014_RKIND,rh(k,i)*qvs)
end do
do k=1,nz1
@@ -1949,9 +1949,9 @@
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.,ru(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.,ru(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
end if
end do
@@ -2069,7 +2069,7 @@
real (kind=RKIND), dimension(:,:), pointer :: sorted_arr
real(kind=RKIND), dimension(:), pointer :: hs, hs1
- real(kind=RKIND) :: hm, zh, dzmin, dzmina, dzminf, sm
+ real(kind=RKIND) :: hm, zh, dzmin, dzmina, dzmina_global, dzminf, sm
integer :: nsmterrain, kz, sfc_k
logical :: hybrid, smooth
@@ -2520,12 +2520,12 @@
grid % soiltemp % array(:) = 0.0
call map_set(PROJ_LATLON, proj, &
- latinc = 1.0, &
- loninc = 1.0, &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = -89.5, &
- lon1 = -179.5)
+ latinc = 1.0_RKIND, &
+ loninc = 1.0_RKIND, &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = -89.5_RKIND, &
+ lon1 = -179.5_RKIND)
write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'soiltemp_1deg/',1,'-',180,'.',1,'-',180
write(0,*) trim(fname)
@@ -2568,8 +2568,8 @@
end if
if (y < 1.0) y = 1.0
if (y > 179.0) y = 179.0
-! grid % soiltemp % array(iCell) = interp_sequence(x, y, 1, soiltemp_1deg, 1, 360, 1, 180, 1, 1, -1.e30, interp_list, 1)
- grid % soiltemp % array(iCell) = interp_sequence(x, y, 1, soiltemp_1deg, 1, 360, 1, 180, 1, 1, 0., interp_list, 1)
+! grid % soiltemp % array(iCell) = interp_sequence(x, y, 1, soiltemp_1deg, 1, 360, 1, 180, 1, 1, -1.e30_RKIND, interp_list, 1)
+ grid % soiltemp % array(iCell) = interp_sequence(x, y, 1, soiltemp_1deg, 1, 360, 1, 180, 1, 1, 0.0_RKIND, interp_list, 1)
else
grid % soiltemp % array(iCell) = 0.0
end if
@@ -2595,12 +2595,12 @@
grid % snoalb % array(:) = 0.0
call map_set(PROJ_LATLON, proj, &
- latinc = 1.0, &
- loninc = 1.0, &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = -89.5, &
- lon1 = -179.5)
+ latinc = 1.0_RKIND, &
+ loninc = 1.0_RKIND, &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = -89.5_RKIND, &
+ lon1 = -179.5_RKIND)
write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'maxsnowalb/',1,'-',180,'.',1,'-',180
write(0,*) trim(fname)
@@ -2643,8 +2643,8 @@
end if
if (y < 1.0) y = 1.0
if (y > 179.0) y = 179.0
-! grid % snoalb % array(iCell) = interp_sequence(x, y, 1, maxsnowalb, 1, 360, 1, 180, 1, 1, -1.e30, interp_list, 1)
- grid % snoalb % array(iCell) = interp_sequence(x, y, 1, maxsnowalb, 1, 360, 1, 180, 1, 1, 0., interp_list, 1)
+! grid % snoalb % array(iCell) = interp_sequence(x, y, 1, maxsnowalb, 1, 360, 1, 180, 1, 1, -1.e30_RKIND, interp_list, 1)
+ grid % snoalb % array(iCell) = interp_sequence(x, y, 1, maxsnowalb, 1, 360, 1, 180, 1, 1, 0.0_RKIND, interp_list, 1)
else
grid % snoalb % array(iCell) = 0.0
end if
@@ -2673,12 +2673,12 @@
grid % greenfrac % array(:,:) = 0.0
call map_set(PROJ_LATLON, proj, &
- latinc = 0.144, &
- loninc = 0.144, &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = -89.928, &
- lon1 = -179.928)
+ latinc = 0.144_RKIND, &
+ loninc = 0.144_RKIND, &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = -89.928_RKIND, &
+ lon1 = -179.928_RKIND)
write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'greenfrac/',1,'-',1250,'.',1,'-',1250
write(0,*) trim(fname)
@@ -2715,7 +2715,7 @@
if (y < 1.0) y = 1.0
if (y > 1249.0) y = 1249.0
do k=1,12
- grid % greenfrac % array(k,iCell) = interp_sequence(x, y, k, vegfra, 1, 2500, 1, 1250, 1, 12, -1.e30, interp_list, 1)
+ grid % greenfrac % array(k,iCell) = interp_sequence(x, y, k, vegfra, 1, 2500, 1, 1250, 1, 12, -1.e30_RKIND, interp_list, 1)
end do
else
grid % greenfrac % array(:,iCell) = 0.0
@@ -2744,12 +2744,12 @@
grid % albedo12m % array(:,:) = 0.0
call map_set(PROJ_LATLON, proj, &
- latinc = 0.144, &
- loninc = 0.144, &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = -89.928, &
- lon1 = -179.928)
+ latinc = 0.144_RKIND, &
+ loninc = 0.144_RKIND, &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = -89.928_RKIND, &
+ lon1 = -179.928_RKIND)
write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'albedo_ncep/',1,'-',1250,'.',1,'-',1250
write(0,*) trim(fname)
@@ -2786,7 +2786,7 @@
if (y < 1.0) y = 1.0
if (y > 1249.0) y = 1249.0
do k=1,12
- grid % albedo12m % array(k,iCell) = interp_sequence(x, y, k, vegfra, 1, 2500, 1, 1250, 1, 12, 0.0, interp_list, 1)
+ grid % albedo12m % array(k,iCell) = interp_sequence(x, y, k, vegfra, 1, 2500, 1, 1250, 1, 12, 0.0_RKIND, interp_list, 1)
end do
else
grid % albedo12m % array(:,iCell) = 8.0
@@ -2822,12 +2822,12 @@
if (field % iproj == PROJ_LATLON) then
call map_set(PROJ_LATLON, proj, &
- latinc = real(field % deltalat), &
- loninc = real(field % deltalon), &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ latinc = real(field % deltalat,RKIND), &
+ loninc = real(field % deltalon,RKIND), &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
end if
@@ -2848,9 +2848,9 @@
call latlon_to_ij(proj, lat, lon, x, y)
end if
if (ndims == 1) then
- destField1d(i) = interp_sequence(x, y, 1, field % slab, 1, field % nx, 1, field % ny, 1, 1, -1.e30, interp_list, 1)
+ destField1d(i) = interp_sequence(x, y, 1, field % slab, 1, field % nx, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
else if (ndims == 2) then
- destField2d(k,i) = interp_sequence(x, y, 1, field % slab, 1, field % nx, 1, field % ny, 1, 1, -1.e30, interp_list, 1)
+ destField2d(k,i) = interp_sequence(x, y, 1, field % slab, 1, field % nx, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
end if
end do
end if
@@ -3014,9 +3014,9 @@
hx(k,:) = hx(k-1,:)
dzminf = zw(k)-zw(k-1)
-! dzmin = max(.5,1.-.5*zw(k)/hm)
+! dzmin = max(0.5_RKIND,1.-.5*zw(k)/hm)
- sm = .05*min(.5*zw(k)/hm,1.)
+ sm = .05*min(0.5_RKIND*zw(k)/hm,1.0_RKIND)
do i=1,50
do iCell=1,grid %nCells
@@ -3045,10 +3045,11 @@
! dzmina = minval(hs(:)-hx(k-1,:))
dzmina = minval(zw(k)+ah(k)*hs(:)-zw(k-1)-ah(k-1)*hx(k-1,:))
+ call mpas_dmpar_min_real(dminfo, dzmina, dzmina_global)
! write(0,*) ' k,i, dzmina, dzmin, zw(k)-zw(k-1) ', k,i, dzmina, dzmin, zw(k)-zw(k-1)
- if (dzmina >= dzmin*(zw(k)-zw(k-1))) then
+ if (dzmina_global >= dzmin*(zw(k)-zw(k-1))) then
hx(k,:)=hs(:)
- dzminf = dzmina
+ dzminf = dzmina_global
else
exit
end if
@@ -3289,18 +3290,18 @@
if (field % iproj == PROJ_LATLON) then
call map_set(PROJ_LATLON, proj, &
- latinc = real(field % deltalat), &
- loninc = real(field % deltalon), &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ latinc = real(field % deltalat,RKIND), &
+ loninc = real(field % deltalon,RKIND), &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
else if (field % iproj == PROJ_GAUSS) then
call map_set(PROJ_GAUSS, proj, &
nlat = nint(field % deltalat), &
- loninc = real(field % deltalon), &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ loninc = real(field % deltalon,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
! nxmax = nint(360.0 / field % deltalon), &
end if
@@ -3736,13 +3737,13 @@
if (field % iproj == PROJ_PS) then
call map_set(PROJ_PS, proj, &
- dx = real(field % dx * 1000.0), &
- truelat1 = real(field % truelat1), &
- stdlon = real(field % xlonc), &
- knowni = real(field % nx / 2.0), &
- knownj = real(field % ny / 2.0), &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ dx = real(field % dx * 1000.0,RKIND), &
+ truelat1 = real(field % truelat1,RKIND), &
+ stdlon = real(field % xlonc,RKIND), &
+ knowni = real(field % nx / 2.0,RKIND), &
+ knownj = real(field % ny / 2.0,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
end if
if (index(field % field, 'SEAICE') /= 0) then
@@ -4083,9 +4084,9 @@
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
end if
end do
@@ -4214,18 +4215,18 @@
if (field % iproj == PROJ_LATLON) then
call map_set(PROJ_LATLON, proj, &
- latinc = real(field % deltalat), &
- loninc = real(field % deltalon), &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ latinc = real(field % deltalat,RKIND), &
+ loninc = real(field % deltalon,RKIND), &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
else if (field % iproj == PROJ_GAUSS) then
call map_set(PROJ_GAUSS, proj, &
nlat = nint(field % deltalat), &
- loninc = real(field % deltalon), &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ loninc = real(field % deltalon,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
! nxmax = nint(360.0 / field % deltalon), &
end if
@@ -4246,7 +4247,7 @@
lon = lon - 360.0
call latlon_to_ij(proj, lat, lon, x, y)
end if
- fg % sst % array(iCell) = interp_sequence(x, y, 1, slab_r8, 1, field % nx, 1, field % ny, 1, 1, -1.e30, interp_list, 1)
+ fg % sst % array(iCell) = interp_sequence(x, y, 1, slab_r8, 1, field % nx, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
end do
deallocate(slab_r8)
@@ -4271,18 +4272,18 @@
if (field % iproj == PROJ_LATLON) then
call map_set(PROJ_LATLON, proj, &
- latinc = real(field % deltalat), &
- loninc = real(field % deltalon), &
- knowni = 1.0, &
- knownj = 1.0, &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ latinc = real(field % deltalat,RKIND), &
+ loninc = real(field % deltalon,RKIND), &
+ knowni = 1.0_RKIND, &
+ knownj = 1.0_RKIND, &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
else if (field % iproj == PROJ_GAUSS) then
call map_set(PROJ_GAUSS, proj, &
nlat = nint(field % deltalat), &
- loninc = real(field % deltalon), &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
+ loninc = real(field % deltalon,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
! nxmax = nint(360.0 / field % deltalon), &
end if
@@ -4303,7 +4304,7 @@
lon = lon - 360.0
call latlon_to_ij(proj, lat, lon, x, y)
end if
- fg % xice % array(iCell) = interp_sequence(x, y, 1, slab_r8, 1, field % nx, 1, field % ny, 1, 1, -1.e30, interp_list, 1)
+ fg % xice % array(iCell) = interp_sequence(x, y, 1, slab_r8, 1, field % nx, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
end do
@@ -4389,7 +4390,7 @@
#endif
- real function sphere_distance(lat1, lon1, lat2, lon2, radius)
+ real (kind=RKIND) function sphere_distance(lat1, lon1, lat2, lon2, radius)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
! sphere with given radius.
@@ -4432,12 +4433,12 @@
do while (nearest_cell /= current_cell)
current_cell = nearest_cell
- current_distance = sphere_distance(latCell(current_cell), lonCell(current_cell), target_lat, target_lon, 1.0)
+ current_distance = sphere_distance(latCell(current_cell), lonCell(current_cell), target_lat, target_lon, 1.0_RKIND)
nearest_cell = current_cell
nearest_distance = current_distance
do i = 1, nEdgesOnCell(current_cell)
iCell = cellsOnCell(i,current_cell)
- d = sphere_distance(latCell(iCell), lonCell(iCell), target_lat, target_lon, 1.0)
+ d = sphere_distance(latCell(iCell), lonCell(iCell), target_lat, target_lon, 1.0_RKIND)
if (d < nearest_distance) then
nearest_cell = iCell
nearest_distance = d
@@ -4475,13 +4476,13 @@
do while (nearest_edge /= current_edge)
current_edge = nearest_edge
- current_distance = sphere_distance(latEdge(current_edge), lonEdge(current_edge), target_lat, target_lon, 1.0)
+ current_distance = sphere_distance(latEdge(current_edge), lonEdge(current_edge), target_lat, target_lon, 1.0_RKIND)
nearest_edge = current_edge
nearest_distance = current_distance
cell1 = cellsOnEdge(1,current_edge)
cell2 = cellsOnEdge(2,current_edge)
- cell1_dist = sphere_distance(latCell(cell1), lonCell(cell1), target_lat, target_lon, 1.0)
- cell2_dist = sphere_distance(latCell(cell2), lonCell(cell2), target_lat, target_lon, 1.0)
+ cell1_dist = sphere_distance(latCell(cell1), lonCell(cell1), target_lat, target_lon, 1.0_RKIND)
+ cell2_dist = sphere_distance(latCell(cell2), lonCell(cell2), target_lat, target_lon, 1.0_RKIND)
if (cell1_dist < cell2_dist) then
iCell = cell1
else
@@ -4489,7 +4490,7 @@
end if
do i = 1, nEdgesOnCell(iCell)
iEdge = edgesOnCell(i,iCell)
- d = sphere_distance(latEdge(iEdge), lonEdge(iEdge), target_lat, target_lon, 1.0)
+ d = sphere_distance(latEdge(iEdge), lonEdge(iEdge), target_lat, target_lon, 1.0_RKIND)
if (d < nearest_distance) then
nearest_edge = iEdge
nearest_distance = d
@@ -4500,7 +4501,7 @@
end function nearest_edge
- real function vertical_interp(target_z, nz, zf, order, extrap, surface_val, sealev_val)
+ real (kind=RKIND) function vertical_interp(target_z, nz, zf, order, extrap, surface_val, sealev_val)
implicit none
Modified: branches/ocean_projects/performance/src/core_nhyd_atmos/Registry
===================================================================
--- branches/ocean_projects/performance/src/core_nhyd_atmos/Registry 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_nhyd_atmos/Registry 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,6 +1,6 @@
-#
-# namelist type namelist_record name default_value
-#
+%
+% namelist type namelist_record name default_value
+%
namelist integer nhyd_model config_test_case 5
namelist character nhyd_model config_time_integration SRK3
namelist real nhyd_model config_dt 172.8
@@ -50,9 +50,9 @@
namelist logical restart config_do_DAcycling false
namelist character restart config_restart_interval none
-#
-# dim type name_in_file name_in_code
-#
+%
+% dim type name_in_file name_in_code
+%
dim nCells nCells
dim nEdges nEdges
dim maxEdges maxEdges
@@ -67,12 +67,12 @@
dim nVertLevels namelist:config_nvertlevels
dim nVertLevelsP1 nVertLevels+1
-#
-# var type name_in_file ( dims ) iro- name_in_code super-array array_class
-#
+%
+% var type name_in_file ( dims ) iro- name_in_code super-array array_class
+%
var persistent text xtime ( Time ) 2 iro xtime state - -
-# horizontal grid structure
+% horizontal grid structure
var persistent real latCell ( nCells ) 0 iro latCell mesh - -
var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
@@ -121,13 +121,13 @@
var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
-var persistent real densityFunction ( nCells ) 0 iro meshDensity mesh - -
+var persistent real meshDensity ( nCells ) 0 iro meshDensity mesh - -
var persistent real meshScalingDel2 ( nEdges ) 0 ro meshScalingDel2 mesh - -
var persistent real meshScalingDel4 ( nEdges ) 0 ro meshScalingDel4 mesh - -
-# some solver scalar coefficients
+% some solver scalar coefficients
-# coefficients for vertical extrapolation to the surface
+% coefficients for vertical extrapolation to the surface
var persistent real cf1 ( ) 0 iro cf1 mesh - -
var persistent real cf2 ( ) 0 iro cf2 mesh - -
var persistent real cf3 ( ) 0 iro cf3 mesh - -
@@ -135,7 +135,7 @@
var persistent real cpr ( THREE nEdges ) 0 ro cpr mesh - -
var persistent real cpl ( THREE nEdges ) 0 ro cpl mesh - -
-# description of the vertical grid structure
+% description of the vertical grid structure
var persistent real hx ( nVertLevelsP1 nCells ) 0 iro hx mesh - -
var persistent real zgrid ( nVertLevelsP1 nCells ) 0 iro zgrid mesh - -
@@ -151,8 +151,8 @@
var persistent real zb ( nVertLevelsP1 TWO nEdges ) 0 iro zb mesh - -
var persistent real zb3 ( nVertLevelsP1 TWO nEdges ) 0 iro zb3 mesh - -
-# coefficients for the vertical tridiagonal solve
-# Note: these could be local but...
+% coefficients for the vertical tridiagonal solve
+% Note: these could be local but...
var persistent real cofrz ( nVertLevels Time ) 1 - cofrz diag - -
var persistent real cofwr ( nVertLevels nCells Time ) 1 - cofwr diag - -
@@ -163,11 +163,11 @@
var persistent real alpha_tri ( nVertLevels nCells Time ) 1 - alpha_tri diag - -
var persistent real gamma_tri ( nVertLevels nCells Time ) 1 - gamma_tri diag - -
-# W-Rayleigh-damping coefficient
+% W-Rayleigh-damping coefficient
var persistent real dss ( nVertLevels nCells ) 0 iro dss mesh - -
-# Prognostic variables: read from input, saved in restart, and written to output
+% Prognostic variables: read from input, saved in restart, and written to output
var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
var persistent real w ( nVertLevelsP1 nCells Time ) 2 iro w state - -
var persistent real rho_zz ( nVertLevels nCells Time ) 2 r rho_zz state - -
@@ -181,7 +181,7 @@
var persistent real qnr ( nVertLevels nCells Time ) 2 iro qnr state scalars number
var persistent real qni ( nVertLevels nCells Time ) 2 iro qni state scalars number
-# Tendency variables
+% Tendency variables
var persistent real tend_u ( nVertLevels nEdges Time ) 1 o u tend - -
var persistent real tend_w ( nVertLevelsP1 nCells Time ) 1 o w tend - -
var persistent real tend_rho ( nVertLevels nCells Time ) 1 o rho_zz tend - -
@@ -200,17 +200,17 @@
var persistent real euler_tend_w ( nVertLevelsP1 nCells Time ) 1 - w_euler tend - -
var persistent real euler_tend_theta ( nVertLevels nCells Time ) 1 - theta_euler tend - -
-# state variables diagnosed from prognostic state
+% state variables diagnosed from prognostic state
var persistent real pressure_p ( nVertLevels nCells Time ) 1 ro pressure_p diag - -
var persistent real u_init ( nVertLevels ) 0 iro u_init mesh - -
var persistent real t_init ( nVertLevels nCells ) 0 iro t_init mesh - -
var persistent real qv_init ( nVertLevels ) 0 iro qv_init mesh - -
-# Diagnostic fields: only written to output
-# NOTE: added the "r" option to rho,theta,uReconstructZonal,and uReconstructMeridional for use of the
-# non-hydrostatic dynamical core in a data assimilation framework. NOTE that the "r" option is not
-# needed for those 4 variables to get bit for bit restart capabilities, otherwise.
+% Diagnostic fields: only written to output
+% NOTE: added the "r" option to rho,theta,uReconstructZonal,and uReconstructMeridional for use of the
+% non-hydrostatic dynamical core in a data assimilation framework. NOTE that the "r" option is not
+% needed for those 4 variables to get bit for bit restart capabilities, otherwise.
var persistent real rho ( nVertLevels nCells Time ) 1 iro rho diag - -
var persistent real theta ( nVertLevels nCells Time ) 1 iro theta diag - -
var persistent real rh ( nVertLevels nCells Time ) 1 iro rh diag - -
@@ -228,7 +228,7 @@
var persistent real uReconstructZonal ( nVertLevels nCells Time ) 1 ro uReconstructZonal diag - -
var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 1 ro uReconstructMeridional diag - -
-# Other diagnostic variables: neither read nor written to any files
+% Other diagnostic variables: neither read nor written to any files
var persistent real rv ( nVertLevels nEdges Time ) 1 r rv diag - -
var persistent real circulation ( nVertLevels nVertices Time ) 1 r circulation diag - -
var persistent real gradPVt ( nVertLevels nEdges Time ) 1 - gradPVt diag - -
@@ -248,7 +248,7 @@
var persistent real cqu ( nVertLevels nEdges Time ) 1 - cqu diag - -
var persistent real cqw ( nVertLevels nCells Time ) 1 - cqw diag - -
-# coupled variables needed by the solver, but not output...
+% coupled variables needed by the solver, but not output...
var persistent real ru ( nVertLevels nEdges Time ) 1 r ru diag - -
var persistent real ru_p ( nVertLevels nEdges Time ) 1 r ru_p diag - -
@@ -268,7 +268,7 @@
var persistent real rho_pp ( nVertLevels nCells Time ) 1 - rho_pp diag - -
var persistent real rho_p_save ( nVertLevels nCells Time ) 1 - rho_p_save diag - -
-# Space needed for advection
+% Space needed for advection
var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 ir deriv_two mesh - -
var persistent integer advCells ( TWENTYONE nCells ) 0 ir advCells mesh - -
var persistent real adv_coefs ( FIFTEEN nEdges ) 0 - adv_coefs mesh - -
@@ -277,43 +277,43 @@
var persistent integer nAdvCellsForEdge ( nEdges ) 0 - nAdvCellsForEdge mesh - -
-# Space needed for deformation calculation weights
+% Space needed for deformation calculation weights
var persistent real defc_a ( maxEdges nCells ) 0 iro defc_a mesh - -
var persistent real defc_b ( maxEdges nCells ) 0 iro defc_b mesh - -
var persistent real kdiff ( nVertLevels nCells Time ) 2 - kdiff diag - -
-# Arrays required for reconstruction of velocity field
+% Arrays required for reconstruction of velocity field
var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 iro coeffs_reconstruct mesh - -
-# ADDED DECLARATIONS MADE BY LDF:
+% ADDED DECLARATIONS MADE BY LDF:
var persistent real surface_pressure ( nCells Time ) 1 iro surface_pressure diag - -
var persistent real surface_temperature ( nCells Time ) 1 o surface_temperature diag - -
-#==================================================================================================
-# DECLARATIONS OF ALL PHYSICS VARIABLES (will need to be moved to a Physics Registry shared by the
-# hydrostatic and non-hydrostatic dynamical cores):
-#==================================================================================================
+%==================================================================================================
+% DECLARATIONS OF ALL PHYSICS VARIABLES (will need to be moved to a Physics Registry shared by the
+% hydrostatic and non-hydrostatic dynamical cores):
+%==================================================================================================
-#... NAMELIST VARIABLES ADDED FOR INITIALIZATION OF SURFACE CHARACTERISTICS:
+%... NAMELIST VARIABLES ADDED FOR INITIALIZATION OF SURFACE CHARACTERISTICS:
namelist character physics input_landuse_data USGS
namelist character physics input_soil_data STAS
namelist integer physics input_soil_temperature_lag 140
namelist integer physics num_soil_layers 4
namelist integer physics months 12
-#... NAMELIST VARIABLE NEEDED FOR THE TIME MANAGER:
+%... NAMELIST VARIABLE NEEDED FOR THE TIME MANAGER:
dim nMonths namelist:months
-#... DIMENSION NEEDED FOR NUMBER OF SOIL LAYERS:
+%... DIMENSION NEEDED FOR NUMBER OF SOIL LAYERS:
dim nSoilLevels namelist:num_soil_layers
-#... DIMENSION NEEDED FOR UPDATING THE DEEP SOIL TEMPERATURE:
+%... DIMENSION NEEDED FOR UPDATING THE DEEP SOIL TEMPERATURE:
dim nLags namelist:input_soil_temperature_lag
-#... DIMENSION NEEDED FOR OZONE AND AEROSOLS CONCENTRATIONS IN THE CAM LONGWAVE AND SHORTWAVE
-#... RADIATION PARAMETERIZATIONS.
-# noznlev : number of CAM radiation input ozone levels.
-# naerlev : number of CAM radiation input aerosol levels.
+%... DIMENSION NEEDED FOR OZONE AND AEROSOLS CONCENTRATIONS IN THE CAM LONGWAVE AND SHORTWAVE
+%... RADIATION PARAMETERIZATIONS.
+% noznlev : number of CAM radiation input ozone levels.
+% naerlev : number of CAM radiation input aerosol levels.
namelist integer physics noznlev 59
namelist integer physics naerlev 29
@@ -322,11 +322,11 @@
dim nAerLevels namelist:naerlev
dim cam_dim1 namelist:cam_dim1
-#... DIMENSION NEEDED FOR LONGWAVE AND SHORTWAVE RADIATION FLUXES TO INCLUDE AN ADDITIONAL LAYER
-#... BETWEEN THE TOP OF THE MODEL AND THE TOP OF THE ATMOSPHERE
+%... DIMENSION NEEDED FOR LONGWAVE AND SHORTWAVE RADIATION FLUXES TO INCLUDE AN ADDITIONAL LAYER
+%... BETWEEN THE TOP OF THE MODEL AND THE TOP OF THE ATMOSPHERE
dim nVertLevelsP2 nVertLevels+2
-#... NAMELIST VARIABLES ADDED FOR PHYSICS CONFIGURATION:
+%... NAMELIST VARIABLES ADDED FOR PHYSICS CONFIGURATION:
namelist logical physics config_frac_seaice false
namelist logical physics config_sfc_albedo false
namelist logical physics config_sst_update false
@@ -363,16 +363,16 @@
var persistent real east ( R3 nCells ) 0 r east mesh - -
var persistent real north ( R3 nCells ) 0 r north mesh - -
-#--------------------------------------------------------------------------------------------------
-#... ARRAYS AND VARIABLES FOR UPDATING THE DEEP SOIL TEMPERATURE:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... ARRAYS AND VARIABLES FOR UPDATING THE DEEP SOIL TEMPERATURE:
+%--------------------------------------------------------------------------------------------------
-# nsteps_accum: number of accumulated time-step in a day.
-# ndays_accum : number of accumulated days in a year.
-# tlag : daily mean surface temperature of prior days [K]
-# tday_accum : accumulated daily surface temperature for current day [K]
-# tyear_mean : annual mean surface temperature [K]
-# tyear_accum : accumulated yearly surface temperature for current year [K]
+% nsteps_accum: number of accumulated time-step in a day.
+% ndays_accum : number of accumulated days in a year.
+% tlag : daily mean surface temperature of prior days [K]
+% tday_accum : accumulated daily surface temperature for current day [K]
+% tyear_mean : annual mean surface temperature [K]
+% tyear_accum : accumulated yearly surface temperature for current year [K]
var persistent integer nsteps_accum ( nCells Time ) 1 r nsteps_accum diag_physics - -
var persistent integer ndays_accum ( nCells Time ) 1 r ndays_accum diag_physics - -
@@ -382,17 +382,17 @@
var persistent real tyear_mean ( nCells Time ) 1 r tyear_mean diag_physics - -
var persistent real tyear_accum ( nCells Time ) 1 r tyear_accum diag_physics - -
-#--------------------------------------------------------------------------------------------------
-#... PARAMETERIZATION OF CLOUD MICROPHYSICS:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... PARAMETERIZATION OF CLOUD MICROPHYSICS:
+%--------------------------------------------------------------------------------------------------
-# rainnc : accumulated total time-step grid-scale precipitation (mm)
-# rainncv : time-step total grid-scale precipitation (mm)
-# snownc : accumulated grid-scale precipitation of snow (mm)
-# snowncv : time-step grid-scale precipitation of snow (mm)
-# graupelnc : accumulated grid-scale precipitation of graupel (mm)
-# graupelncv: time-step grid-scale precipitation of graupel (mm)
-# sr : time-step ratio of frozen versus total grid-scale precipitation (-)
+% rainnc : accumulated total time-step grid-scale precipitation (mm)
+% rainncv : time-step total grid-scale precipitation (mm)
+% snownc : accumulated grid-scale precipitation of snow (mm)
+% snowncv : time-step grid-scale precipitation of snow (mm)
+% graupelnc : accumulated grid-scale precipitation of graupel (mm)
+% graupelncv: time-step grid-scale precipitation of graupel (mm)
+% sr : time-step ratio of frozen versus total grid-scale precipitation (-)
var persistent real sr ( nCells Time ) 1 ro sr diag_physics - -
var persistent real rainncv ( nCells Time ) 1 ro rainncv diag_physics - -
@@ -406,21 +406,21 @@
var persistent real qsat ( nVertLevels nCells Time ) 1 o qsat diag_physics - -
var persistent real relhum ( nVertLevels nCells Time ) 1 o relhum diag_physics - -
-#--------------------------------------------------------------------------------------------------
-#... PARAMETERIZATION OF CONVECTION:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... PARAMETERIZATION OF CONVECTION:
+%--------------------------------------------------------------------------------------------------
-# cubot : lowest level of convection (-)
-# cutop : highest level of convection (-)
-# cuprec : convective precipitation rate (mm/s)
-# rainc : accumulated time-step convective precipitation (mm)
-# raincv : time-step convective precipitation (mm)
-# rthcuten : tendency of potential temperature due to cumulus convection (K s-1)
-# rqvcuten : tendency of water vapor mixing ratio due to cumulus convection (kg/kg s-1)
-# rqccuten : tendency of cloud water mixing ratio due to cumulus convection (kg/kg s-1)
-# rqrcuten : tendency of rain mixing ratio due to cumulus convection (kg/kg s-1)
-# rqicuten : tendency of cloud ice mixing ratio due to cumulus convection (kg/kg s-1)
-# rqscuten : tendency of snow mixing ratio due to cumulus convection (kg/kg s-1)
+% cubot : lowest level of convection (-)
+% cutop : highest level of convection (-)
+% cuprec : convective precipitation rate (mm/s)
+% rainc : accumulated time-step convective precipitation (mm)
+% raincv : time-step convective precipitation (mm)
+% rthcuten : tendency of potential temperature due to cumulus convection (K s-1)
+% rqvcuten : tendency of water vapor mixing ratio due to cumulus convection (kg/kg s-1)
+% rqccuten : tendency of cloud water mixing ratio due to cumulus convection (kg/kg s-1)
+% rqrcuten : tendency of rain mixing ratio due to cumulus convection (kg/kg s-1)
+% rqicuten : tendency of cloud ice mixing ratio due to cumulus convection (kg/kg s-1)
+% rqscuten : tendency of snow mixing ratio due to cumulus convection (kg/kg s-1)
var persistent real cubot ( nCells Time ) 1 ro cubot diag_physics - -
var persistent real cutop ( nCells Time ) 1 ro cutop diag_physics - -
@@ -435,32 +435,32 @@
var persistent real rqicuten ( nVertLevels nCells Time ) 1 ro rqicuten tend_physics - -
var persistent real rqscuten ( nVertLevels nCells Time ) 1 ro rqscuten tend_physics - -
-#... KAIN_FRITSCH ONLY:
-# nca : relaxation time for KF parameterization of convection (s)
-# wavg0 : average vertical velocity (KF scheme only) (m s-1)
+%... KAIN_FRITSCH ONLY:
+% nca : relaxation time for KF parameterization of convection (s)
+% wavg0 : average vertical velocity (KF scheme only) (m s-1)
var persistent real nca ( nCells Time ) 1 ro nca diag_physics - -
var persistent real w0avg ( nVertLevels nCells Time ) 1 ro w0avg diag_physics - -
-#--------------------------------------------------------------------------------------------------
-#... PARAMETERIZATION OF PLANETARY BOUNDARY LAYER PROCESSES:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... PARAMETERIZATION OF PLANETARY BOUNDARY LAYER PROCESSES:
+%--------------------------------------------------------------------------------------------------
-# kpbl : index of PBL top (-)
-# hpbl : PBL height (m)
-# exch_h : exchange coefficient (-)
-# rublten : tendency of zonal wind due to pbl processes (m s-1)
-# rvblten : tendency of meridional wind due to pbl processes (m s-1)
-# rthblten : tendency of potential temperature due to pbl processes (K s-1)
-# rqvblten : tendency of water vapor mixing ratio due to pbl processes (kg/kg s-1)
-# rqcblten : tendency of cloud water mixing ratio due to pbl processes (kg/kg s-1)
-# rqiblten : tendency of cloud ice mixing ratio due to pbl processes (kg/kg s-1)
+% kpbl : index of PBL top (-)
+% hpbl : PBL height (m)
+% exch_h : exchange coefficient (-)
+% rublten : tendency of zonal wind due to pbl processes (m s-1)
+% rvblten : tendency of meridional wind due to pbl processes (m s-1)
+% rthblten : tendency of potential temperature due to pbl processes (K s-1)
+% rqvblten : tendency of water vapor mixing ratio due to pbl processes (kg/kg s-1)
+% rqcblten : tendency of cloud water mixing ratio due to pbl processes (kg/kg s-1)
+% rqiblten : tendency of cloud ice mixing ratio due to pbl processes (kg/kg s-1)
var persistent integer kpbl ( nCells Time ) 1 ro kpbl diag_physics - -
var persistent real hpbl ( nCells Time ) 1 ro hpbl diag_physics - -
var persistent real exch_h ( nVertLevels nCells Time ) 1 o exch_h diag_physics - -
-# TENDENCIES:
+% TENDENCIES:
var persistent real rublten ( nVertLevels nCells Time ) 1 ro rublten tend_physics - -
var persistent real rvblten ( nVertLevels nCells Time ) 1 ro rvblten tend_physics - -
var persistent real rthblten ( nVertLevels nCells Time ) 1 ro rthblten tend_physics - -
@@ -468,44 +468,44 @@
var persistent real rqcblten ( nVertLevels nCells Time ) 1 ro rqcblten tend_physics - -
var persistent real rqiblten ( nVertLevels nCells Time ) 1 ro rqiblten tend_physics - -
-#--------------------------------------------------------------------------------------------------
-#... PARAMETERIZATION OF SURFACE LAYER PROCESSES:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... PARAMETERIZATION OF SURFACE LAYER PROCESSES:
+%--------------------------------------------------------------------------------------------------
-# br :bulk richardson number [-]
-# cd :drag coefficient at 10m [-]
-# cda :drag coefficient at lowest model level [-]
-# chs :???
-# chs2 :???
-# cqs2 :???
-# ck :enthalpy exchange coefficient at 10 m [-]
-# cka :enthalpy exchange coefficient at lowest model level [-]
-# cpm :???
-# flhc :exchange coefficient for heat [-]
-# flqc :exchange coefficient for moisture [-]
-# gz1oz0 :log of z1 over z0 [-]
-# hfx :upward heat flux at the surface [W/m2/s]
-# lh :latent heat flux at the surface [W/m2]
-# mavail :surface moisture availability [-]
-# mol :T* in similarity theory [K]
-# psih :similarity theory for heat [-]
-# psim :similarity theory for momentum [-]
-# qfx :upward moisture flux at the surface [kg/m2/s]
-# qgh :???
-# qsfc :specific humidity at lower boundary [kg/kg]
-# regime :flag indicating PBL regime (stable_p,unstable_p,etc...) [-]
-# rmol :1 / Monin Ob length [-]
-# ust :u* in similarity theory [m/s]
-# ustm :u* in similarity theory without vconv [m/s]
-# zol :z/L height over Monin-Obukhov length [-]
-# znt :time-varying roughness length [m]
-# wspd :wind speed [m/s]
-# DIAGNOSTICS:
-# q2 :specific humidity at 2m [kg/kg]
-# u10 :u at 10 m [m/s]
-# v10 :v at 10 m [m/s]
-# t2m :temperature at 2m [K]
-# th2m :potential temperature at 2m [K]
+% br :bulk richardson number [-]
+% cd :drag coefficient at 10m [-]
+% cda :drag coefficient at lowest model level [-]
+% chs :???
+% chs2 :???
+% cqs2 :???
+% ck :enthalpy exchange coefficient at 10 m [-]
+% cka :enthalpy exchange coefficient at lowest model level [-]
+% cpm :???
+% flhc :exchange coefficient for heat [-]
+% flqc :exchange coefficient for moisture [-]
+% gz1oz0 :log of z1 over z0 [-]
+% hfx :upward heat flux at the surface [W/m2/s]
+% lh :latent heat flux at the surface [W/m2]
+% mavail :surface moisture availability [-]
+% mol :T* in similarity theory [K]
+% psih :similarity theory for heat [-]
+% psim :similarity theory for momentum [-]
+% qfx :upward moisture flux at the surface [kg/m2/s]
+% qgh :???
+% qsfc :specific humidity at lower boundary [kg/kg]
+% regime :flag indicating PBL regime (stable_p,unstable_p,etc...) [-]
+% rmol :1 / Monin Ob length [-]
+% ust :u* in similarity theory [m/s]
+% ustm :u* in similarity theory without vconv [m/s]
+% zol :z/L height over Monin-Obukhov length [-]
+% znt :time-varying roughness length [m]
+% wspd :wind speed [m/s]
+% DIAGNOSTICS:
+% q2 :specific humidity at 2m [kg/kg]
+% u10 :u at 10 m [m/s]
+% v10 :v at 10 m [m/s]
+% t2m :temperature at 2m [K]
+% th2m :potential temperature at 2m [K]
var persistent real hfx ( nCells Time ) 1 ro hfx diag_physics - -
var persistent real mavail ( nCells Time ) 1 ro mavail diag_physics - -
@@ -536,34 +536,34 @@
var persistent real regime ( nCells Time ) 1 ro regime diag_physics - -
var persistent real rmol ( nCells Time ) 1 ro rmol diag_physics - -
var persistent real wspd ( nCells Time ) 1 ro wspd diag_physics - -
-# DIAGNOSTICS:
+% DIAGNOSTICS:
var persistent real u10 ( nCells Time ) 1 ro u10 diag_physics - -
var persistent real v10 ( nCells Time ) 1 ro v10 diag_physics - -
var persistent real q2 ( nCells Time ) 1 ro q2 diag_physics - -
var persistent real t2m ( nCells Time ) 1 ro t2m diag_physics - -
var persistent real th2m ( nCells Time ) 1 ro th2m diag_physics - -
-#--------------------------------------------------------------------------------------------------
-#... PARAMETERIZATION OF SHORTWAVE RADIATION:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... PARAMETERIZATION OF SHORTWAVE RADIATION:
+%--------------------------------------------------------------------------------------------------
-# coszr :cosine of the solar zenith angle [-]
+% coszr :cosine of the solar zenith angle [-]
-# gsw :net shortwave flux at surface [W m-2]
-# swcf :shortwave cloud forcing at top-of-atmosphere [W m-2]
-# swdnb :all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
-# swdnbc :clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
-# swdnt :all-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
-# swdntc :clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
-# swupb :all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
-# swupbc :clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
-# swupt :all-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
-# swuptc :clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
-# swdnflx :
-# swdnflxc :
-# swupflx :
-# swupflxc :
-# rthratensw:uncoupled theta tendency due to shortwave radiation [K s-1]
+% gsw :net shortwave flux at surface [W m-2]
+% swcf :shortwave cloud forcing at top-of-atmosphere [W m-2]
+% swdnb :all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
+% swdnbc :clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
+% swdnt :all-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
+% swdntc :clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
+% swupb :all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
+% swupbc :clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
+% swupt :all-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
+% swuptc :clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
+% swdnflx :
+% swdnflxc :
+% swupflx :
+% swupflxc :
+% rthratensw:uncoupled theta tendency due to shortwave radiation [K s-1]
var persistent real coszr ( nCells Time ) 1 o coszr diag_physics - -
var persistent real swcf ( nCells Time ) 1 o swcf diag_physics - -
@@ -579,37 +579,37 @@
var persistent real rthratensw ( nVertLevels nCells Time ) 1 ro rthratensw tend_physics - -
-#... RRTMG SW ONLY:
+%... RRTMG SW ONLY:
var persistent real swdnflx ( nVertLevelsP2 nCells Time ) 1 o swdnflx diag_physics - -
var persistent real swdnflxc ( nVertLevelsP2 nCells Time ) 1 o swdnflxc diag_physics - -
var persistent real swupflx ( nVertLevelsP2 nCells Time ) 1 o swupflx diag_physics - -
var persistent real swupflxc ( nVertLevelsP2 nCells Time ) 1 o swupflxc diag_physics - -
-#--------------------------------------------------------------------------------------------------
-#... PARAMETERIZATION OF LONGWAVE RADIATION:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... PARAMETERIZATION OF LONGWAVE RADIATION:
+%--------------------------------------------------------------------------------------------------
-# note: glw is the same diagnostic as lwdnb and is used in the land-surface scheme for the calcula-
-# tion of the surface budget. glw is always an output argument to the subroutine rrtmg_lwrad.
-# in contrast,lwdnb is an optional ouput argument to the subroutine rrtmg_lwrad depending on
-# the presence of lwupt (or not).
+% note: glw is the same diagnostic as lwdnb and is used in the land-surface scheme for the calcula-
+% tion of the surface budget. glw is always an output argument to the subroutine rrtmg_lwrad.
+% in contrast,lwdnb is an optional ouput argument to the subroutine rrtmg_lwrad depending on
+% the presence of lwupt (or not).
-# glw :all-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
-# lwcf :longwave cloud forcing at top-of-atmosphere [W m-2]
-# lwdnb :all-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
-# lwdnbc :clear-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
-# lwdnt :all-sky downwelling longwave flux at top-of-atmosphere [W m-2]
-# lwdntc :clear-sky downwelling longwave flux at top-of-atmosphere [W m-2]
-# lwupb :all-sky upwelling longwave flux at bottom-of-atmosphere [W m-2]
-# lwupbc :clear-sky upwelling longwave flux at bottom-of-atmosphere [W m-2]
-# lwupt :all-sky upwelling longwave flux at top-of-atmosphere [W m-2]
-# lwuptc :clear-sky upwelling longwave flux at top-of-atmosphere [W m-2]
-# lwdnflx :
-# lwdnflxc :
-# lwupflx :
-# lwupflxc :
-# olrtoa :outgoing longwave radiation at top-of-the-atmosphere [W m-2]
-# rthratenlw:uncoupled theta tendency due to longwave radiation [K s-1]
+% glw :all-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
+% lwcf :longwave cloud forcing at top-of-atmosphere [W m-2]
+% lwdnb :all-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
+% lwdnbc :clear-sky downwelling longwave flux at bottom-of-atmosphere [W m-2]
+% lwdnt :all-sky downwelling longwave flux at top-of-atmosphere [W m-2]
+% lwdntc :clear-sky downwelling longwave flux at top-of-atmosphere [W m-2]
+% lwupb :all-sky upwelling longwave flux at bottom-of-atmosphere [W m-2]
+% lwupbc :clear-sky upwelling longwave flux at bottom-of-atmosphere [W m-2]
+% lwupt :all-sky upwelling longwave flux at top-of-atmosphere [W m-2]
+% lwuptc :clear-sky upwelling longwave flux at top-of-atmosphere [W m-2]
+% lwdnflx :
+% lwdnflxc :
+% lwupflx :
+% lwupflxc :
+% olrtoa :outgoing longwave radiation at top-of-the-atmosphere [W m-2]
+% rthratenlw:uncoupled theta tendency due to longwave radiation [K s-1]
var persistent real lwcf ( nCells Time ) 1 o lwcf diag_physics - -
var persistent real lwdnb ( nCells Time ) 1 o lwdnb diag_physics - -
@@ -625,30 +625,30 @@
var persistent real rthratenlw ( nVertLevels nCells Time ) 1 ro rthratenlw tend_physics - -
-#... RRTMG LW ONLY:
-#var persistent real lwdnflx ( nVertLevelsP2 nCells Time ) 1 o lwdnflx diag_physics - -
-#var persistent real lwdnflxc ( nVertLevelsP2 nCells Time ) 1 o lwdnflxc diag_physics - -
-#var persistent real lwupflx ( nVertLevelsP2 nCells Time ) 1 o lwupflx diag_physics - -
-#var persistent real lwupflxc ( nVertLevelsP2 nCells Time ) 1 o lwupflxc diag_physics - -
+%... RRTMG LW ONLY:
+%var persistent real lwdnflx ( nVertLevelsP2 nCells Time ) 1 o lwdnflx diag_physics - -
+%var persistent real lwdnflxc ( nVertLevelsP2 nCells Time ) 1 o lwdnflxc diag_physics - -
+%var persistent real lwupflx ( nVertLevelsP2 nCells Time ) 1 o lwupflx diag_physics - -
+%var persistent real lwupflxc ( nVertLevelsP2 nCells Time ) 1 o lwupflxc diag_physics - -
-#--------------------------------------------------------------------------------------------------
-#... ADDITIONAL "RADIATION" ARRAYS NEEDED ONLY IN THE "CAM" LW AND SW RADIATION CODES:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... ADDITIONAL "RADIATION" ARRAYS NEEDED ONLY IN THE "CAM" LW AND SW RADIATION CODES:
+%--------------------------------------------------------------------------------------------------
-#INFRARED ABSORPTION:
+%INFRARED ABSORPTION:
var persistent real absnxt ( nVertLevels cam_dim1 nCells Time ) 1 - absnxt diag_physics - -
var persistent real abstot ( nVertLevelsP1 nVertLevelsP1 nCells Time ) 1 - abstot diag_physics - -
var persistent real emstot ( nVertLevelsP1 nCells Time ) 1 - emstot diag_physics - -
-# OZONE:
+% OZONE:
var persistent real pin ( nOznLevels nCells ) 0 - pin mesh - -
var persistent real ozmixm ( nMonths nOznLevels nCells ) 0 - ozmixm mesh - -
-# AEROSOLS:
+% AEROSOLS:
var persistent real m_hybi ( nAerLevels nCells ) 0 - m_hybi mesh - -
var persistent real m_ps ( nCells Time ) 2 - m_ps state - -
-#var persistent real dummy ( nAerLevels nCells Time ) 2 - dummy state aerosols aer_cam
+%var persistent real dummy ( nAerLevels nCells Time ) 2 - dummy state aerosols aer_cam
var persistent real sul ( nAerLevels nCells Time ) 2 - sul state aerosols aer_cam
var persistent real sslt ( nAerLevels nCells Time ) 2 - sslt state aerosols aer_cam
var persistent real dust1 ( nAerLevels nCells Time ) 2 - dust1 state aerosols aer_cam
@@ -662,43 +662,43 @@
var persistent real bg ( nAerLevels nCells Time ) 2 - bg state aerosols aer_cam
var persistent real volc ( nAerLevels nCells Time ) 2 - volc state aerosols aer_cam
-#--------------------------------------------------------------------------------------------------
-#... PARAMERIZATION OF CLOUDINESS:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... PARAMERIZATION OF CLOUDINESS:
+%--------------------------------------------------------------------------------------------------
-# cldfrac :cloud fraction [-]
+% cldfrac :cloud fraction [-]
var persistent real cldfrac ( nVertLevels nCells Time ) 1 o cldfrac diag_physics - -
-#--------------------------------------------------------------------------------------------------
-#... PARAMETERIZATION OF LAND-SURFACE SCHEME:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... PARAMETERIZATION OF LAND-SURFACE SCHEME:
+%--------------------------------------------------------------------------------------------------
-# acsnom :accumulated melted snow [kg m-2]
-# acsnow :accumulated snow [kg m-2]
-# canwat :canopy water [kg m-2]
-# chklowq :surface saturation flag [-]
-# grdflx :ground heat flux [W m-2]
-# lai :leaf area index [-]
-# noahres :residual of the noah land-surface scheme energy budget [W m-2]
-# potevp :potential evaporation [W m-2]
-# qz0 :specific humidity at znt [kg kg-1]
-# rib :??
-# sfc_albedo :surface albedo [-]
-# sfc_embck :background emissivity [-]
-# sfc_emiss :surface emissivity [-]
-# sfcrunoff :surface runoff [m s-1]
-# smstav :moisture availability [-]
-# smstot :total moisture [m3 m-3]
-# snopcx :snow phase change heat flux [W m-2]
-# snotime :??
-# sstsk : skin sea-surface temperature [K]
-# sstsk_diur : skin sea-surface temperature difference [K]
-# thc :thermal inertia [Cal cm-1 K-1 s-0.5]
-# udrunoff :sub-surface runoff [m s-1]
-# xicem :ice mask from previous time-step [-]
-# z0 :background roughness length [m]
-# zs :depth of centers of soil layers [m]
+% acsnom :accumulated melted snow [kg m-2]
+% acsnow :accumulated snow [kg m-2]
+% canwat :canopy water [kg m-2]
+% chklowq :surface saturation flag [-]
+% grdflx :ground heat flux [W m-2]
+% lai :leaf area index [-]
+% noahres :residual of the noah land-surface scheme energy budget [W m-2]
+% potevp :potential evaporation [W m-2]
+% qz0 :specific humidity at znt [kg kg-1]
+% rib :??
+% sfc_albedo :surface albedo [-]
+% sfc_embck :background emissivity [-]
+% sfc_emiss :surface emissivity [-]
+% sfcrunoff :surface runoff [m s-1]
+% smstav :moisture availability [-]
+% smstot :total moisture [m3 m-3]
+% snopcx :snow phase change heat flux [W m-2]
+% snotime :??
+% sstsk : skin sea-surface temperature [K]
+% sstsk_diur : skin sea-surface temperature difference [K]
+% thc :thermal inertia [Cal cm-1 K-1 s-0.5]
+% udrunoff :sub-surface runoff [m s-1]
+% xicem :ice mask from previous time-step [-]
+% z0 :background roughness length [m]
+% zs :depth of centers of soil layers [m]
var persistent real acsnom ( nCells Time ) 1 ro acsnom diag_physics - -
var persistent real acsnow ( nCells Time ) 1 ro acsnow diag_physics - -
@@ -726,36 +726,36 @@
var persistent real z0 ( nCells Time ) 1 ro z0 diag_physics - -
var persistent real zs ( nCells Time ) 1 ro zs diag_physics - -
-#--------------------------------------------------------------------------------------------------
-#... SURFACE CHARACTERISTICS THAT NEED TO BE READ FROM GRID.NC:
-#--------------------------------------------------------------------------------------------------
+%--------------------------------------------------------------------------------------------------
+%... SURFACE CHARACTERISTICS THAT NEED TO BE READ FROM GRID.NC:
+%--------------------------------------------------------------------------------------------------
-# albedo12m :monthly climatological albedo [-]
-# greenfrac :monthly climatological greeness fraction [-]
-# isltyp :dominant soil category [-]
-# ivgtyp :dominant vegetation category [-]
-# landmask :=0 for ocean;=1 for land [-]
-# sfc_albbck :background albedo [-]
-# shdmin :minimum areal fractional coverage of annual green vegetation [-]
-# shdmax :maximum areal fractional coverage of annual green vegetation [-]
-# skintemp :skin temperature [K]
-# snoalb :annual max snow albedo [-]
-# snow :snow water equivalent [kg m-2]
-# sst :sea-surface temperature [K]
-# snowc :flag indicating snow coverage (1 for snow cover) [-]
-# snowh :physical snow depth [m]
-# ter :terrain height [-]
-# tmn :soil temperature at lower boundary [K]
-# vegfra :vegetation fraction [-]
-# seaice :sea-ice mask (=1 when xice is greater than 0; =0 otherwise) [-]
-# xice :fractional sea-ice coverage [-]
-# xland :land mask (1 for land; 2 for water) [-]
+% albedo12m :monthly climatological albedo [-]
+% greenfrac :monthly climatological greeness fraction [-]
+% isltyp :dominant soil category [-]
+% ivgtyp :dominant vegetation category [-]
+% landmask :=0 for ocean;=1 for land [-]
+% sfc_albbck :background albedo [-]
+% shdmin :minimum areal fractional coverage of annual green vegetation [-]
+% shdmax :maximum areal fractional coverage of annual green vegetation [-]
+% skintemp :skin temperature [K]
+% snoalb :annual max snow albedo [-]
+% snow :snow water equivalent [kg m-2]
+% sst :sea-surface temperature [K]
+% snowc :flag indicating snow coverage (1 for snow cover) [-]
+% snowh :physical snow depth [m]
+% ter :terrain height [-]
+% tmn :soil temperature at lower boundary [K]
+% vegfra :vegetation fraction [-]
+% seaice :sea-ice mask (=1 when xice is greater than 0; =0 otherwise) [-]
+% xice :fractional sea-ice coverage [-]
+% xland :land mask (1 for land; 2 for water) [-]
-# dzs :thickness of soil layers [m]
-# smcrel :soil moisture threshold below which transpiration begins to stress [-]
-# sh2o :soil liquid water [m3 m-3]
-# smois :soil moisture [m3 m-3]
-# tslb :soil temperature [K]
+% dzs :thickness of soil layers [m]
+% smcrel :soil moisture threshold below which transpiration begins to stress [-]
+% sh2o :soil liquid water [m3 m-3]
+% smois :soil moisture [m3 m-3]
+% tslb :soil temperature [K]
var persistent integer isltyp ( nCells ) 0 iro isltyp sfc_input - -
var persistent integer ivgtyp ( nCells ) 0 iro ivgtyp sfc_input - -
@@ -785,4 +785,4 @@
var persistent real smois ( nSoilLevels nCells Time ) 1 iro smois sfc_input - -
var persistent real tslb ( nSoilLevels nCells Time ) 1 iro tslb sfc_input - -
-#==================================================================================================
+%==================================================================================================
Modified: branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_advection.F
===================================================================
--- branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_advection.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_advection.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,6 @@
module atm_advection
+ use mpas_kind_types
use mpas_grid_types
use mpas_configure
use mpas_constants
@@ -117,7 +118,7 @@
theta_abs(iCell) = pii/2. - sphere_angle( xc(1), yc(1), zc(1), &
xc(2), yc(2), zc(2), &
- 0., 0., 1. )
+ 0.0_RKIND, 0.0_RKIND, 1.0_RKIND )
! angles from cell center to neighbor centers (thetav)
@@ -390,7 +391,7 @@
! Computes the angle between arcs AB and AC, given points A, B, and C
! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
+ real (kind=RKIND) function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
implicit none
@@ -410,9 +411,9 @@
real (kind=RKIND) :: s ! Semiperimeter of the triangle
real (kind=RKIND) :: sin_angle
- a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0)) ! Eqn. (3)
- b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0)) ! Eqn. (2)
- c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0)) ! Eqn. (1)
+ a = acos(max(min(bx*cx + by*cy + bz*cz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (3)
+ b = acos(max(min(ax*cx + ay*cy + az*cz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (2)
+ c = acos(max(min(ax*bx + ay*by + az*bz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (1)
ABx = bx - ax
ABy = by - ay
@@ -428,12 +429,12 @@
s = 0.5*(a + b + c)
! sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c))) ! Eqn. (28)
- sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c))))) ! Eqn. (28)
+ sin_angle = sqrt(min(1.0_RKIND,max(0.0_RKIND,(sin(s-b)*sin(s-c))/(sin(b)*sin(c))))) ! Eqn. (28)
if ((Dx*ax + Dy*ay + Dz*az) >= 0.0) then
- sphere_angle = 2.0 * asin(max(min(sin_angle,1.0),-1.0))
+ sphere_angle = 2.0 * asin(max(min(sin_angle,1.0_RKIND),-1.0_RKIND))
else
- sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
+ sphere_angle = -2.0 * asin(max(min(sin_angle,1.0_RKIND),-1.0_RKIND))
end if
end function sphere_angle
@@ -445,7 +446,7 @@
! Computes the angle between vectors AB and AC, given points A, B, and C, and
! a vector (u,v,w) normal to the plane.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
+ real (kind=RKIND) function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
implicit none
@@ -480,9 +481,9 @@
cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
if ((Dx*u + Dy*v + Dz*w) >= 0.0) then
- plane_angle = acos(max(min(cos_angle,1.0),-1.0))
+ plane_angle = acos(max(min(cos_angle,1.0_RKIND),-1.0_RKIND))
else
- plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
+ plane_angle = -acos(max(min(cos_angle,1.0_RKIND),-1.0_RKIND))
end if
end function plane_angle
@@ -495,7 +496,7 @@
! B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
! same sphere centered at the origin.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function arc_length(ax, ay, az, bx, by, bz)
+ real (kind=RKIND) function arc_length(ax, ay, az, bx, by, bz)
implicit none
@@ -701,7 +702,7 @@
DO I = 1, N
C1= 0.0
DO J = 1, N
- C1 = AMAX1(C1,ABS(A(I,J)))
+ C1 = MAX(C1,ABS(A(I,J)))
END DO
C(I) = C1
END DO
@@ -838,7 +839,7 @@
theta_abs(iCell) = pii/2. - sphere_angle( xc(1), yc(1), zc(1), &
xc(2), yc(2), zc(2), &
- 0., 0., 1. )
+ 0.0_RKIND, 0.0_RKIND, 1.0_RKIND )
! angles from cell center to neighbor centers (thetav)
@@ -890,10 +891,10 @@
do i=2,n-1
ip1 = i+1
if (ip1 == n) ip1 = 1
- thetat(i) = plane_angle( 0.,0.,0., &
- xp(i)-xp(i-1), yp(i)-yp(i-1), 0., &
- xp(ip1)-xp(i), yp(ip1)-yp(i), 0., &
- 0., 0., 1.)
+ thetat(i) = plane_angle( 0.0_RKIND, 0.0_RKIND, 0.0_RKIND, &
+ xp(i)-xp(i-1), yp(i)-yp(i-1), 0.0_RKIND, &
+ xp(ip1)-xp(i), yp(ip1)-yp(i), 0.0_RKIND, &
+ 0.0_RKIND, 0.0_RKIND, 1.0_RKIND)
thetat(i) = thetat(i) + thetat(i-1)
end do
Modified: branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_test_cases.F
===================================================================
--- branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_test_cases.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_test_cases.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -5,7 +5,9 @@
use mpas_constants
use mpas_dmpar
use atm_advection
+#ifdef DO_PHYSICS
use mpas_atmphys_control
+#endif
contains
@@ -94,6 +96,8 @@
stop
end if
+
+#ifdef DO_PHYSICS
!initialization of surface input variables technically not needed to run our current set of
!idealized test cases:
if (config_test_case > 0) then
@@ -105,6 +109,7 @@
end do
endif
+#endif
end subroutine atm_setup_test_case
@@ -153,8 +158,8 @@
integer :: eoe, j
integer, dimension(:), pointer :: nEdgesOnEdge
integer, dimension(:,:), pointer :: edgesOnEdge, CellsOnEdge
- real, dimension(:), pointer :: dvEdge, AreaCell
- real, dimension(:,:), pointer :: weightsOnEdge
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, AreaCell
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
@@ -666,7 +671,7 @@
if (config_test_case == 2) then
r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &
- lat_pert, lon_pert, 1.)/(pert_radius)
+ lat_pert, lon_pert, 1.0_RKIND)/(pert_radius)
u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
else if (config_test_case == 3) then
@@ -786,9 +791,9 @@
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
end if
end do
@@ -881,7 +886,7 @@
! renormalize for setting cell-face fluxes
do k=1,nz1
- flux_zonal(k) = sign(1.,lat2_in-lat1_in)*flux_zonal(k)*dlat*a/dvEdge/u0
+ flux_zonal(k) = sign(1.0_RKIND,lat2_in-lat1_in)*flux_zonal(k)*dlat*a/dvEdge/u0
end do
end subroutine atm_calc_flux_zonal
@@ -1004,7 +1009,7 @@
integer :: eoe, j
integer, dimension(:), pointer :: nEdgesOnEdge
integer, dimension(:,:), pointer :: edgesOnEdge
- real, dimension(:,:), pointer :: weightsOnEdge
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, cell1, cell2, nCellsSolve
integer :: index_qv
@@ -1320,7 +1325,7 @@
temp = p(k,i)*thi(k,i)
pres = p0*p(k,i)**(1./rcp)
qvs = 380.*exp(17.27*(temp-273.)/(temp-36.))/pres
- scalars(index_qv,k,i) = amin1(0.014,rh(k,i)*qvs)
+ scalars(index_qv,k,i) = min(0.014_RKIND,rh(k,i)*qvs)
end do
end do
@@ -1542,8 +1547,8 @@
integer :: eoe, j
integer, dimension(:), pointer :: nEdgesOnEdge
integer, dimension(:,:), pointer :: edgesOnEdge, CellsOnEdge
- real, dimension(:), pointer :: dvEdge, AreaCell, xCell, yCell
- real, dimension(:,:), pointer :: weightsOnEdge
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, AreaCell, xCell, yCell
+ real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
integer :: iCell, iCell1, iCell2 , iEdge, vtx1, vtx2, ivtx, i, k, nz, nz1, itr, itrp, cell1, cell2, nCellsSolve
integer :: index_qv
@@ -1769,7 +1774,7 @@
! smoothing grid for the upper level >> but not propoer for parallel programing
dzmin=.7
do k=2,nz1
- sm = .25*min((zc(k)-zc(k-1))/dz,1.)
+ sm = .25*min((zc(k)-zc(k-1))/dz,1.0_RKIND)
do i=1,grid % nCells
hx(k,i) = hx(k-1,i)
end do
@@ -1946,7 +1951,7 @@
temp = p(k,i)*t(k,i)
pres = p0*p(k,i)**(1./rcp)
qvs = 380.*exp(17.27*(temp-273.)/(temp-36.))/pres
- scalars(index_qv,k,i) = amin1(0.014,rh(k,i)*qvs)
+ scalars(index_qv,k,i) = min(0.014_RKIND,rh(k,i)*qvs)
end do
do k=1,nz1
@@ -2069,9 +2074,9 @@
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.,ru(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.,ru(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
end if
end do
@@ -2128,7 +2133,7 @@
!----------------------------------------------------------------------------------------------------------
- real function sphere_distance(lat1, lon1, lat2, lon2, radius)
+ real (kind=RKIND) function sphere_distance(lat1, lon1, lat2, lon2, radius)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
! sphere with given radius.
@@ -2147,10 +2152,10 @@
end function sphere_distance
!--------------------------------------------------------------------
- real function env_qv( z, temperature, pressure, rh_max )
+ real (kind=RKIND) function env_qv( z, temperature, pressure, rh_max )
implicit none
- real z, temperature, pressure, ztr, es, qvs, p0, rh_max
+ real (kind=RKIND) :: z, temperature, pressure, ztr, es, qvs, p0, rh_max
p0 = 100000.
Modified: branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_time_integration.F
===================================================================
--- branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -680,7 +680,7 @@
type (mesh_type) :: grid
integer :: iCell, iEdge, k, cell1, cell2
integer, dimension(:,:), pointer :: cellsOnEdge
- real, dimension(:,:,:), pointer :: zf, zf3
+ real (kind=RKIND), dimension(:,:,:), pointer :: zf, zf3
real (kind=RKIND), dimension(:), pointer :: fzm, fzp, dvEdge, areaCell
real (kind=RKIND) :: flux
@@ -718,9 +718,9 @@
tend % w % array(k,cell1) = tend % w % array(k,cell1) - zf(k,1,iEdge)*flux
!3rd order stencil
if (config_theta_adv_order == 3) then
- tend % w % array(k,cell2) = tend % w % array(k,cell2) + sign(1.,tend % u % array(k,iEdge)) &
+ tend % w % array(k,cell2) = tend % w % array(k,cell2) + sign(1.0_RKIND,tend % u % array(k,iEdge)) &
*config_coef_3rd_order*zf3(k,2,iEdge)*flux
- tend % w % array(k,cell1) = tend % w % array(k,cell1) - sign(1.,tend % u % array(k,iEdge)) &
+ tend % w % array(k,cell1) = tend % w % array(k,cell1) - sign(1.0_RKIND,tend % u % array(k,iEdge)) &
*config_coef_3rd_order*zf3(k,1,iEdge)*flux
end if
@@ -869,7 +869,7 @@
do k=2,nVertLevels
- kr = min(nVertLevels,k+ nint(.5-sign(.5,zx(k,iEdge)+zx(k+1,iEdge))))
+ kr = min(nVertLevels,k+ nint(.5-sign(0.5_RKIND,zx(k,iEdge)+zx(k+1,iEdge))))
kl = min(nVertLevels,2*k+1-kr)
pr = zz(k,cell2)*rtheta_pp_old(k ,cell2)+.5*(zgrid(k ,cell1) +zgrid(k +1,cell1) &
-zgrid(k ,cell2) -zgrid(k +1,cell2)) &
@@ -1167,16 +1167,16 @@
!SHP-mtn
flux = cf1*ru(1,iEdge) + cf2*ru(2,iEdge) + cf3*ru(3,iEdge)
- w(1,cell2) = w(1,cell2) - (zb(1,2,iEdge) + sign(1.,flux)*coef_3rd_order*zb3(1,2,iEdge)) &
+ w(1,cell2) = w(1,cell2) - (zb(1,2,iEdge) + sign(1.0_RKIND,flux)*coef_3rd_order*zb3(1,2,iEdge)) &
*flux/(cf1*rho_zz(1,cell2)+cf2*rho_zz(2,cell2)+cf3*rho_zz(3,cell2))
- w(1,cell1) = w(1,cell1) + (zb(1,1,iEdge) + sign(1.,flux)*coef_3rd_order*zb3(1,1,iEdge)) &
+ w(1,cell1) = w(1,cell1) + (zb(1,1,iEdge) + sign(1.0_RKIND,flux)*coef_3rd_order*zb3(1,1,iEdge)) &
*flux/(cf1*rho_zz(1,cell1)+cf2*rho_zz(2,cell1)+cf3*rho_zz(3,cell1))
do k = 2, nVertLevels
flux = (fzm(k)*ru(k,iEdge)+fzp(k)*ru(k-1,iEdge))
- w(k,cell2) = w(k,cell2) - (zb(k,2,iEdge)+sign(1.,flux)*coef_3rd_order*zb3(k,2,iEdge)) &
+ w(k,cell2) = w(k,cell2) - (zb(k,2,iEdge)+sign(1.0_RKIND,flux)*coef_3rd_order*zb3(k,2,iEdge)) &
*flux/(fzm(k)*rho_zz(k,cell2)+fzp(k)*rho_zz(k-1,cell2))
- w(k,cell1) = w(k,cell1) + (zb(k,1,iEdge)+sign(1.,flux)*coef_3rd_order*zb3(k,1,iEdge)) &
+ w(k,cell1) = w(k,cell1) + (zb(k,1,iEdge)+sign(1.0_RKIND,flux)*coef_3rd_order*zb3(k,1,iEdge)) &
*flux/(fzm(k)*rho_zz(k,cell1)+fzp(k)*rho_zz(k-1,cell1))
enddo
@@ -1298,7 +1298,7 @@
do i=1,nAdvCellsForEdge(iEdge)
iCell = advCellsForEdge(i,iEdge)
do k=1,grid % nVertLevels
- scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge)
+ scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge)
do iScalar=1,s_old % num_scalars
flux_arr(iScalar,k) = flux_arr(iScalar,k) + scalar_weight* scalar_new(iScalar,k,iCell)
end do
@@ -1633,7 +1633,7 @@
do i=1,nAdvCellsForEdge(iEdge)
iCell = advCellsForEdge(i,iEdge)
do k=1,grid % nVertLevels
- scalar_weight = uhAvg(k,iEdge)*(adv_coefs(i,iEdge) + coef_3rd_order*sign(1.,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge))
+ scalar_weight = uhAvg(k,iEdge)*(adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge))
flux_arr(k,iEdge) = flux_arr(k,iEdge) + scalar_weight* scalar_new(k,iCell)
end do
end do
@@ -1651,7 +1651,7 @@
do k = 2, nVertLevels
scalar_new(k,iCell) = scalar_old(k,iCell)*h_old(k,iCell)
- flux_upwind = dt*(max(0.,wwAvg(k,iCell))*scalar_old(k-1,iCell) + min(0.,wwAvg(k,iCell))*scalar_old(k,iCell))
+ flux_upwind = dt*(max(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k-1,iCell) + min(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k,iCell))
scalar_new(k-1,iCell) = scalar_new(k-1,iCell) - flux_upwind*rdnw(k-1)
scalar_new(k ,iCell) = scalar_new(k ,iCell) + flux_upwind*rdnw(k)
wdtn(k,iCell) = dt*wdtn(k,iCell) - flux_upwind
@@ -1661,8 +1661,8 @@
! contributions to the update: first the vertical flux component, then the horizontal
do k=1,nVertLevels
- scale_in (k,iCell) = - rdnw(k)*(min(0.,wdtn(k+1,iCell))-max(0.,wdtn(k,iCell)))
- scale_out(k,iCell) = - rdnw(k)*(max(0.,wdtn(k+1,iCell))-min(0.,wdtn(k,iCell)))
+ scale_in (k,iCell) = - rdnw(k)*(min(0.0_RKIND,wdtn(k+1,iCell))-max(0.0_RKIND,wdtn(k,iCell)))
+ scale_out(k,iCell) = - rdnw(k)*(max(0.0_RKIND,wdtn(k+1,iCell))-min(0.0_RKIND,wdtn(k,iCell)))
end do
end do
@@ -1677,15 +1677,15 @@
if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then ! only for owned cells
do k=1,grid % nVertLevels
flux_upwind = grid % dvEdge % array(iEdge) * dt * &
- (max(0.,uhAvg(k,iEdge))*scalar_old(k,cell1) + min(0.,uhAvg(k,iEdge))*scalar_old(k,cell2))
+ (max(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell1) + min(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell2))
flux_arr(k,iEdge) = dt*flux_arr(k,iEdge) - flux_upwind
scalar_new(k,cell1) = scalar_new(k,cell1) - flux_upwind / areaCell(cell1)
scalar_new(k,cell2) = scalar_new(k,cell2) + flux_upwind / areaCell(cell2)
- scale_out(k,cell1) = scale_out(k,cell1) - max(0.,flux_arr(k,iEdge)) / areaCell(cell1)
- scale_in (k,cell1) = scale_in (k,cell1) - min(0.,flux_arr(k,iEdge)) / areaCell(cell1)
- scale_out(k,cell2) = scale_out(k,cell2) + min(0.,flux_arr(k,iEdge)) / areaCell(cell2)
- scale_in (k,cell2) = scale_in (k,cell2) + max(0.,flux_arr(k,iEdge)) / areaCell(cell2)
+ scale_out(k,cell1) = scale_out(k,cell1) - max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
+ scale_in (k,cell1) = scale_in (k,cell1) - min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
+ scale_out(k,cell2) = scale_out(k,cell2) + min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
+ scale_in (k,cell2) = scale_in (k,cell2) + max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
end do
end if
@@ -1700,10 +1700,10 @@
s_upwind = scalar_new(k,iCell)/h_new(k,iCell)
scale_factor = (s_max(k,iCell)-s_upwind)/(s_max_update-s_upwind+eps)
- scale_in(k,iCell) = min( 1.0, max( 0.0, scale_factor) )
+ scale_in(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
scale_factor = (s_upwind-s_min(k,iCell))/(s_upwind-s_min_update+eps)
- scale_out(k,iCell) = min( 1.0, max( 0.0, scale_factor) )
+ scale_out(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
end do
end do
@@ -1729,8 +1729,8 @@
if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then
do k = 1, nVertLevels
flux = flux_arr(k,iEdge)
- flux = max(0.,flux) * min(scale_out(k,cell1), scale_in(k,cell2)) &
- + min(0.,flux) * min(scale_in(k,cell1), scale_out(k,cell2))
+ flux = max(0.0_RKIND,flux) * min(scale_out(k,cell1), scale_in(k,cell2)) &
+ + min(0.0_RKIND,flux) * min(scale_in(k,cell1), scale_out(k,cell2))
flux_arr(k,iEdge) = flux
end do
end if
@@ -1741,8 +1741,8 @@
do iCell=1,grid % nCells
do k = 2, nVertLevels
flux = wdtn(k,iCell)
- flux = max(0.,flux) * min(scale_out(k-1,iCell), scale_in(k ,iCell)) &
- + min(0.,flux) * min(scale_out(k ,iCell), scale_in(k-1,iCell))
+ flux = max(0.0_RKIND,flux) * min(scale_out(k-1,iCell), scale_in(k ,iCell)) &
+ + min(0.0_RKIND,flux) * min(scale_out(k ,iCell), scale_in(k-1,iCell))
wdtn(k,iCell) = flux
end do
end do
@@ -1790,7 +1790,7 @@
do iCell = 1, grid%nCells
do k=1, grid%nVertLevels
- scalar_new_in(iScalar,k,iCell) = max(0.,scalar_new(k,iCell))
+ scalar_new_in(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell))
end do
end do
@@ -2072,7 +2072,7 @@
k = 2
wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))
do k=3,nVertLevels-1
- wduz(k) = flux3( u(k-2,iEdge),u(k-1,iEdge),u(k,iEdge),u(k+1,iEdge),0.5*(rw(k,cell1)+rw(k,cell2)), 1. )
+ wduz(k) = flux3( u(k-2,iEdge),u(k-1,iEdge),u(k,iEdge),u(k+1,iEdge),0.5*(rw(k,cell1)+rw(k,cell2)), 1.0_RKIND )
end do
k = nVertLevels
wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))
@@ -2368,7 +2368,7 @@
do i=1,nAdvCellsForEdge(iEdge)
iCell = advCellsForEdge(i,iEdge)
do k=2,grid % nVertLevels
- scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.,ru_edge_w(k))*adv_coefs_3rd(i,iEdge)
+ scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,ru_edge_w(k))*adv_coefs_3rd(i,iEdge)
flux_arr(k) = flux_arr(k) + scalar_weight* w(k,iCell)
end do
end do
@@ -2582,7 +2582,7 @@
k = 2
wdwz(k) = 0.25*(rw(k,icell)+rw(k-1,iCell))*(w(k,iCell)+w(k-1,iCell))
do k=3,nVertLevels-1
- wdwz(k) = flux3( w(k-2,iCell),w(k-1,iCell),w(k,iCell),w(k+1,iCell),0.5*(rw(k,iCell)+rw(k-1,iCell)), 1. )
+ wdwz(k) = flux3( w(k-2,iCell),w(k-1,iCell),w(k,iCell),w(k+1,iCell),0.5*(rw(k,iCell)+rw(k-1,iCell)), 1.0_RKIND )
end do
k = nVertLevels
wdwz(k) = 0.25*(rw(k,icell)+rw(k-1,iCell))*(w(k,iCell)+w(k-1,iCell))
@@ -2678,7 +2678,7 @@
do i=1,nAdvCellsForEdge(iEdge)
iCell = advCellsForEdge(i,iEdge)
do k=1,grid % nVertLevels
- scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.,ru(k,iEdge))*adv_coefs_3rd(i,iEdge)
+ scalar_weight = adv_coefs(i,iEdge) + coef_3rd_order*sign(1.0_RKIND,ru(k,iEdge))*adv_coefs_3rd(i,iEdge)
flux_arr(k) = flux_arr(k) + scalar_weight* theta_m(k,iCell)
end do
end do
@@ -3324,10 +3324,10 @@
* (grid % fzp % array(k) * grid % zz % array(k-1,cell1) + grid % fzm % array(k) * grid % zz % array(k,cell1))
!3rd order! stencil
if (config_theta_adv_order ==3) then
- diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + sign(1.,flux)*config_coef_3rd_order &
+ diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + sign(1.0_RKIND,flux)*config_coef_3rd_order &
* grid % zb3 % array(k,2,iEdge)*flux &
* (grid % fzp % array(k) * grid % zz % array(k-1,cell2) + grid % fzm % array(k) * grid % zz % array(k,cell2))
- diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - sign(1.,flux)*config_coef_3rd_order &
+ diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - sign(1.0_RKIND,flux)*config_coef_3rd_order &
* grid % zb3 % array(k,1,iEdge)*flux &
* (grid % fzp % array(k) * grid % zz % array(k-1,cell1) + grid % fzm % array(k) * grid % zz % array(k,cell1))
end if
@@ -3405,11 +3405,11 @@
t(k) = state_new % theta_m % array(k,iCell)/(1. + 1.61*state_new % scalars % array(state_new % index_qv,k,iCell))
rho(k) = grid % zz % array(k,iCell)*state_new % rho_zz % array(k,iCell)
p(k) = diag % exner % array(k,iCell)
- qv(k) = max(0.,state_new % scalars % array(state_new % index_qv,k,iCell))
- qc(k) = max(0.,state_new % scalars % array(state_new % index_qc,k,iCell))
- qr(k) = max(0.,state_new % scalars % array(state_new % index_qr,k,iCell))
- qc1(k) = max(0.,state_old % scalars % array(state_old % index_qc,k,iCell))
- qr1(k) = max(0.,state_old % scalars % array(state_old % index_qr,k,iCell))
+ qv(k) = max(0.0_RKIND,state_new % scalars % array(state_new % index_qv,k,iCell))
+ qc(k) = max(0.0_RKIND,state_new % scalars % array(state_new % index_qc,k,iCell))
+ qr(k) = max(0.0_RKIND,state_new % scalars % array(state_new % index_qr,k,iCell))
+ qc1(k) = max(0.0_RKIND,state_old % scalars % array(state_old % index_qc,k,iCell))
+ qr1(k) = max(0.0_RKIND,state_old % scalars % array(state_old % index_qr,k,iCell))
dzu(k) = grid % dzu % array(k)
end do
@@ -3486,8 +3486,8 @@
do i=1,nx
do k=1,nz1
qrprod(k) = qc1t(k,i) &
- -(qc1t(k,i)-dt*amax1(ackess*(qc1(k,i)-.001), &
- 0.))/(1.+dt*ckess*qr1(k,i)**.875)
+ -(qc1t(k,i)-dt*max(ackess*(qc1(k,i)-.001), &
+ 0.0_RKIND))/(1.+dt*ckess*qr1(k,i)**.875)
velqr(k) = (qr1(k,i)*r(k))**1.1364*rhalf(k)
qvs(k) = pc(k)*exp(f2x*(pk(k)*t1t(k,i)-273.) &
/(pk(k)*t1t(k,i)- 36.))
@@ -3505,23 +3505,23 @@
artemp = 36340.*(.5*(velqr(2)+velqr(1))+veld-velu)
artot = artot+dt*artemp
do k=1,nz1
- qc1t(k,i) = amax1(qc1t(k,i)-qrprod(k),0.)
- qr1t(k,i) = amax1(qr1t(k,i)+qrprod(k),0.)
+ qc1t(k,i) = max(qc1t(k,i)-qrprod(k),0.0_RKIND)
+ qr1t(k,i) = max(qr1t(k,i)+qrprod(k),0.0_RKIND)
prod(k) = (qv1t(k,i)-qvs(k))/(1.+qvs(k)*f5 &
/(pk(k)*t1t(k,i)-36.)**2)
end do
do k=1,nz1
- ern(k) = amin1(dt*(((1.6+124.9*(r(k)*qr1t(k,i))**.2046) &
+ ern(k) = min(dt*(((1.6+124.9*(r(k)*qr1t(k,i))**.2046) &
*(r(k)*qr1t(k,i))**.525)/(2.55e6*pc(k) &
/(3.8 *qvs(k))+5.4e5))*(dim(qvs(k),qv1t(k,i)) &
/(r(k)*qvs(k))), &
- amax1(-prod(k)-qc1t(k,i),0.),qr1t(k,i))
+ max(-prod(k)-qc1t(k,i),0.0_RKIND),qr1t(k,i))
end do
do k=1,nz1
- buoycy(k) = f0(k)*(amax1(prod(k),-qc1t(k,i))-ern(k))
- qv1t(k,i) = amax1(qv1t(k,i) &
- -amax1(prod(k),-qc1t(k,i))+ern(k),0.)
- qc1t(k,i) = qc1t(k,i)+amax1(prod(k),-qc1t(k,i))
+ buoycy(k) = f0(k)*(max(prod(k),-qc1t(k,i))-ern(k))
+ qv1t(k,i) = max(qv1t(k,i) &
+ -max(prod(k),-qc1t(k,i))+ern(k),0.0_RKIND)
+ qc1t(k,i) = qc1t(k,i)+max(prod(k),-qc1t(k,i))
qr1t(k,i) = qr1t(k,i)-ern(k)
t1t (k,i) = t1t (k,i)+buoycy(k)
end do
Modified: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_mpas_core.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_mpas_core.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_mpas_core.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -355,14 +355,13 @@
block_ptr => block_ptr % next
end do
- call write_output_frame(output_obj, output_frame, domain)
+ call ocn_write_output_frame(output_obj, output_frame, domain)
block_ptr => domain % blocklist
do while (associated(block_ptr))
call ocn_time_average_init(block_ptr % state % time_levs(1) % state)
block_ptr => block_ptr % next
end do
-
end if
if (mpas_is_alarm_ringing(clock, restartAlarmID, ierr=ierr)) then
Modified: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_split.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_split.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_split.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1009,7 +1009,6 @@
call ocn_tracer_vmix_tend_implicit(block % mesh, dt, vertdifftopofcell, h, tracers, err)
end if
-
if (config_test_case == 1) then ! For case 1, wind field should be fixed
block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
Modified: branches/ocean_projects/performance/src/core_sw/Registry
===================================================================
--- branches/ocean_projects/performance/src/core_sw/Registry 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_sw/Registry 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,6 +1,6 @@
-#
-# namelist type namelist_record name default_value
-#
+%
+% namelist type namelist_record name default_value
+%
namelist integer sw_model config_test_case 5
namelist character sw_model config_time_integration RK4
namelist real sw_model config_dt 172.8
@@ -30,9 +30,9 @@
namelist logical restart config_do_restart false
namelist character restart config_restart_interval none
-#
-# dim type name_in_file name_in_code
-#
+%
+% dim type name_in_file name_in_code
+%
dim nCells nCells
dim nEdges nEdges
dim maxEdges maxEdges
@@ -46,9 +46,9 @@
dim nVertLevels nVertLevels
dim nTracers nTracers
-#
-# var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
-#
+%
+% var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
+%
var persistent text xtime ( Time ) 2 ro xtime state - -
var persistent real latCell ( nCells ) 0 iro latCell mesh - -
@@ -104,37 +104,37 @@
var persistent real fCell ( nCells ) 0 iro fCell mesh - -
var persistent real h_s ( nCells ) 0 iro h_s mesh - -
-# Space needed for advection
+% Space needed for advection
var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 o deriv_two mesh - -
var persistent integer advCells ( TWENTYONE nCells ) 0 - advCells mesh - -
-# !! NOTE: the following arrays are needed to allow the use
-# !! of the module_advection.F w/o alteration
-# Space needed for deformation calculation weights
+% !! NOTE: the following arrays are needed to allow the use
+% !! of the module_advection.F w/o alteration
+% Space needed for deformation calculation weights
var persistent real defc_a ( maxEdges nCells ) 0 - defc_a mesh - -
var persistent real defc_b ( maxEdges nCells ) 0 - defc_b mesh - -
var persistent real kdiff ( nVertLevels nCells Time ) 0 - kdiff mesh - -
-# Arrays required for reconstruction of velocity field
+% Arrays required for reconstruction of velocity field
var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
-# Boundary conditions: read from input, saved in restart and written to output
+% Boundary conditions: read from input, saved in restart and written to output
var persistent integer boundaryEdge ( nVertLevels nEdges ) 0 iro boundaryEdge mesh - -
var persistent integer boundaryVertex ( nVertLevels nVertices ) 0 iro boundaryVertex mesh - -
var persistent integer boundaryCell ( nVertLevels nCells ) 0 iro boundaryCell mesh - -
var persistent real u_src ( nVertLevels nEdges ) 0 iro u_src mesh - -
-# Prognostic variables: read from input, saved in restart, and written to output
+% Prognostic variables: read from input, saved in restart, and written to output
var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
var persistent real h ( nVertLevels nCells Time ) 2 iro h state - -
var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro tracers state - -
-# Tendency variables
+% Tendency variables
var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
var persistent real tend_tracers ( nTracers nVertLevels nCells Time ) 1 - tracers tend - -
-# Diagnostic fields: only written to output
+% Diagnostic fields: only written to output
var persistent real v ( nVertLevels nEdges Time ) 2 o v state - -
var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
@@ -150,7 +150,7 @@
var persistent real uReconstructZonal ( nVertLevels nCells Time ) 2 o uReconstructZonal state - -
var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 2 o uReconstructMeridional state - -
-# Other diagnostic variables: neither read nor written to any files
+% Other diagnostic variables: neither read nor written to any files
var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
Modified: branches/ocean_projects/performance/src/core_sw/mpas_sw_advection.F
===================================================================
--- branches/ocean_projects/performance/src/core_sw/mpas_sw_advection.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_sw/mpas_sw_advection.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,6 @@
module sw_advection
+ use mpas_kind_types
use mpas_grid_types
use mpas_configure
use mpas_constants
@@ -117,7 +118,7 @@
theta_abs(iCell) = pii/2. - sphere_angle( xc(1), yc(1), zc(1), &
xc(2), yc(2), zc(2), &
- 0., 0., 1. )
+ 0.0_RKIND, 0.0_RKIND, 1.0_RKIND )
! angles from cell center to neighbor centers (thetav)
@@ -390,7 +391,7 @@
! Computes the angle between arcs AB and AC, given points A, B, and C
! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
+ real (kind=RKIND) function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
implicit none
@@ -410,9 +411,9 @@
real (kind=RKIND) :: s ! Semiperimeter of the triangle
real (kind=RKIND) :: sin_angle
- a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0)) ! Eqn. (3)
- b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0)) ! Eqn. (2)
- c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0)) ! Eqn. (1)
+ a = acos(max(min(bx*cx + by*cy + bz*cz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (3)
+ b = acos(max(min(ax*cx + ay*cy + az*cz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (2)
+ c = acos(max(min(ax*bx + ay*by + az*bz,1.0_RKIND),-1.0_RKIND)) ! Eqn. (1)
ABx = bx - ax
ABy = by - ay
@@ -428,12 +429,12 @@
s = 0.5*(a + b + c)
! sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c))) ! Eqn. (28)
- sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c))))) ! Eqn. (28)
+ sin_angle = sqrt(min(1.0_RKIND,max(0.0_RKIND,(sin(s-b)*sin(s-c))/(sin(b)*sin(c))))) ! Eqn. (28)
if ((Dx*ax + Dy*ay + Dz*az) >= 0.0) then
- sphere_angle = 2.0 * asin(max(min(sin_angle,1.0),-1.0))
+ sphere_angle = 2.0 * asin(max(min(sin_angle,1.0_RKIND),-1.0_RKIND))
else
- sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
+ sphere_angle = -2.0 * asin(max(min(sin_angle,1.0_RKIND),-1.0_RKIND))
end if
end function sphere_angle
@@ -445,7 +446,7 @@
! Computes the angle between vectors AB and AC, given points A, B, and C, and
! a vector (u,v,w) normal to the plane.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
+ real (kind=RKIND) function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
implicit none
@@ -480,9 +481,9 @@
cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
if ((Dx*u + Dy*v + Dz*w) >= 0.0) then
- plane_angle = acos(max(min(cos_angle,1.0),-1.0))
+ plane_angle = acos(max(min(cos_angle,1.0_RKIND),-1.0_RKIND))
else
- plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
+ plane_angle = -acos(max(min(cos_angle,1.0_RKIND),-1.0_RKIND))
end if
end function plane_angle
@@ -495,7 +496,7 @@
! B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
! same sphere centered at the origin.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- real function arc_length(ax, ay, az, bx, by, bz)
+ real (kind=RKIND) function arc_length(ax, ay, az, bx, by, bz)
implicit none
@@ -838,7 +839,7 @@
theta_abs(iCell) = pii/2. - sphere_angle( xc(1), yc(1), zc(1), &
xc(2), yc(2), zc(2), &
- 0., 0., 1. )
+ 0.0_RKIND, 0.0_RKIND, 1.0_RKIND )
! angles from cell center to neighbor centers (thetav)
@@ -890,10 +891,10 @@
do i=2,n-1
ip1 = i+1
if (ip1 == n) ip1 = 1
- thetat(i) = plane_angle( 0.,0.,0., &
- xp(i)-xp(i-1), yp(i)-yp(i-1), 0., &
- xp(ip1)-xp(i), yp(ip1)-yp(i), 0., &
- 0., 0., 1.)
+ thetat(i) = plane_angle( 0.0_RKIND, 0.0_RKIND, 0.0_RKIND, &
+ xp(i)-xp(i-1), yp(i)-yp(i-1), 0.0_RKIND, &
+ xp(ip1)-xp(i), yp(ip1)-yp(i), 0.0_RKIND, &
+ 0.0_RKIND, 0.0_RKIND, 1.0_RKIND)
thetat(i) = thetat(i) + thetat(i-1)
end do
Modified: branches/ocean_projects/performance/src/core_sw/mpas_sw_time_integration.F
===================================================================
--- branches/ocean_projects/performance/src/core_sw/mpas_sw_time_integration.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/core_sw/mpas_sw_time_integration.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -123,10 +123,10 @@
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
if (config_h_mom_eddy_visc4 > 0.0) then
- call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
+ call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, provis % divergence % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
+ call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, provis % vorticity % array(:,:), &
block % mesh % nVertLevels, block % mesh % nVertices, &
block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
end if
Modified: branches/ocean_projects/performance/src/driver/mpas_subdriver.F
===================================================================
--- branches/ocean_projects/performance/src/driver/mpas_subdriver.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/driver/mpas_subdriver.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -19,15 +19,13 @@
real (kind=RKIND) :: dt
character(len=32) :: timeStamp
- call mpas_timer_start("total time")
- call mpas_timer_start("initialize")
-
-
!
! Initialize infrastructure
!
call mpas_framework_init(dminfo, domain)
+ call mpas_timer_start("total time")
+ call mpas_timer_start("initialize")
call mpas_input_state_for_domain(domain)
@@ -59,9 +57,7 @@
implicit none
- call mpas_counter_start()
call mpas_core_run(domain, output_obj, output_frame)
- call mpas_counter_stop()
end subroutine mpas_run
@@ -86,9 +82,7 @@
call mpas_timer_stop("total time")
call mpas_timer_write()
- call mpas_counter_write()
-
!
! Finalize infrastructure
!
Modified: branches/ocean_projects/performance/src/framework/Makefile
===================================================================
--- branches/ocean_projects/performance/src/framework/Makefile 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/framework/Makefile 2012-01-06 22:48:40 UTC (rev 1317)
@@ -4,7 +4,8 @@
ZOLTANOBJ = mpas_zoltan_interface.o
endif
-OBJS = mpas_framework.o \
+OBJS = mpas_kind_types.o \
+ mpas_framework.o \
mpas_timer.o \
mpas_counter.o \
mpas_timekeeping.o \
@@ -29,10 +30,18 @@
mpas_configure.o: mpas_dmpar.o
+mpas_constants.o: mpas_kind_types.o
+
mpas_grid_types.o: mpas_dmpar.o
-mpas_dmpar.o: mpas_sort.o streams.o
+mpas_dmpar.o: mpas_sort.o streams.o mpas_kind_types.o
+mpas_sort.o: mpas_kind_types.o
+
+mpas_timekeeping.o: mpas_kind_types.o
+
+mpas_timer.o: mpas_kind_types.o
+
mpas_block_decomp.o: mpas_grid_types.o mpas_hash.o mpas_configure.o
mpas_io_input.o: mpas_grid_types.o mpas_dmpar.o mpas_block_decomp.o mpas_sort.o mpas_configure.o mpas_timekeeping.o $(ZOLTANOBJ)
Modified: branches/ocean_projects/performance/src/framework/mpas_constants.F
===================================================================
--- branches/ocean_projects/performance/src/framework/mpas_constants.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/framework/mpas_constants.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,7 @@
module mpas_constants
+ use mpas_kind_types
+
real (kind=RKIND), parameter :: pii = 3.141592653589793
real (kind=RKIND), parameter :: a = 6371229.0
real (kind=RKIND), parameter :: omega = 7.29212e-5
Modified: branches/ocean_projects/performance/src/framework/mpas_dmpar.F
===================================================================
--- branches/ocean_projects/performance/src/framework/mpas_dmpar.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/framework/mpas_dmpar.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,15 +1,16 @@
module mpas_dmpar
+ use mpas_kind_types
use mpas_sort
#ifdef _MPI
include 'mpif.h'
integer, parameter :: MPI_INTEGERKIND = MPI_INTEGER
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ integer, parameter :: MPI_REALKIND = MPI_REAL
+#else
integer, parameter :: MPI_REALKIND = MPI_DOUBLE_PRECISION
-#else
- integer, parameter :: MPI_REALKIND = MPI_REAL
#endif
#endif
@@ -19,6 +20,7 @@
type dm_info
integer :: nprocs, my_proc_id, comm, info
+ logical :: using_external_comm
end type dm_info
@@ -45,23 +47,30 @@
contains
- subroutine mpas_dmpar_init(dminfo)
+ subroutine mpas_dmpar_init(dminfo, mpi_comm)
implicit none
type (dm_info), intent(inout) :: dminfo
+ integer, intent(in), optional :: mpi_comm ! Optional: externally-supplied MPI communicator
#ifdef _MPI
integer :: mpi_rank, mpi_size
integer :: mpi_ierr
+ if (present(mpi_comm)) then
+ dminfo % comm = mpi_comm
+ dminfo % using_external_comm = .true.
+ else
+ call MPI_Init(mpi_ierr)
+ dminfo % comm = MPI_COMM_WORLD
+ dminfo % using_external_comm = .false.
+ end if
+
! Find out our rank and the total number of processors
- call MPI_Init(mpi_ierr)
- call MPI_Comm_rank(MPI_COMM_WORLD, mpi_rank, mpi_ierr)
- call MPI_Comm_size(MPI_COMM_WORLD, mpi_size, mpi_ierr)
+ call MPI_Comm_rank(dminfo % comm, mpi_rank, mpi_ierr)
+ call MPI_Comm_size(dminfo % comm, mpi_size, mpi_ierr)
- dminfo % comm = MPI_COMM_WORLD
-
dminfo % nprocs = mpi_size
dminfo % my_proc_id = mpi_rank
@@ -75,6 +84,7 @@
dminfo % comm = 0
dminfo % my_proc_id = IO_NODE
dminfo % nprocs = 1
+ dminfo % using_external_comm = .false.
#endif
end subroutine mpas_dmpar_init
@@ -89,7 +99,9 @@
#ifdef _MPI
integer :: mpi_ierr
- call MPI_Finalize(mpi_ierr)
+ if (.not. dminfo % using_external_comm) then
+ call MPI_Finalize(mpi_ierr)
+ end if
#endif
end subroutine mpas_dmpar_finalize
Modified: branches/ocean_projects/performance/src/framework/mpas_io_input.F
===================================================================
--- branches/ocean_projects/performance/src/framework/mpas_io_input.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/framework/mpas_io_input.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1226,10 +1226,10 @@
#include "input_field0dreal.inc"
-#if (RKIND == 8)
+#if SINGLE_PRECISION
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+#else
nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % scalar)
-#else
- nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
#endif
end subroutine mpas_io_input_field0d_real
@@ -1261,10 +1261,10 @@
#include "input_field1dreal.inc"
-#if (RKIND == 8)
+#if SINGLE_PRECISION
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % array)
+#else
nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % array)
-#else
- nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % array)
#endif
end subroutine mpas_io_input_field1d_real
@@ -1290,10 +1290,10 @@
#include "input_field2dreal.inc"
-#if (RKIND == 8)
+#if SINGLE_PRECISION
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start2, count2, field % array)
+#else
nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start2, count2, field % array)
-#else
- nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start2, count2, field % array)
#endif
end subroutine mpas_io_input_field2d_real
@@ -1321,10 +1321,10 @@
#include "input_field3dreal.inc"
-#if (RKIND == 8)
+#if SINGLE_PRECISION
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start3, count3, field % array)
+#else
nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start3, count3, field % array)
-#else
- nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start3, count3, field % array)
#endif
end subroutine mpas_io_input_field3d_real
@@ -1348,10 +1348,10 @@
#include "input_field0dreal_time.inc"
-#if (RKIND == 8)
+#if SINGLE_PRECISION
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+#else
nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % scalar)
-#else
- nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
#endif
end subroutine mpas_io_input_field0d_real_time
@@ -1377,10 +1377,10 @@
#include "input_field1dreal_time.inc"
-#if (RKIND == 8)
+#if SINGLE_PRECISION
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start2, count2, field % array)
+#else
nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start2, count2, field % array)
-#else
- nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start2, count2, field % array)
#endif
end subroutine mpas_io_input_field1d_real_time
@@ -1408,10 +1408,10 @@
#include "input_field2dreal_time.inc"
-#if (RKIND == 8)
+#if SINGLE_PRECISION
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start3, count3, field % array)
+#else
nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start3, count3, field % array)
-#else
- nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start3, count3, field % array)
#endif
end subroutine mpas_io_input_field2d_real_time
@@ -1441,10 +1441,10 @@
#include "input_field3dreal_time.inc"
-#if (RKIND == 8)
+#if SINGLE_PRECISION
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start4, count4, field % array)
+#else
nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start4, count4, field % array)
-#else
- nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start4, count4, field % array)
#endif
end subroutine mpas_io_input_field3d_real_time
Modified: branches/ocean_projects/performance/src/framework/mpas_io_output.F
===================================================================
--- branches/ocean_projects/performance/src/framework/mpas_io_output.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/framework/mpas_io_output.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -429,10 +429,10 @@
#include "output_field0dreal.inc"
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+#else
nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#else
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
#endif
nferr = nf_sync(output_obj % wr_ncid)
@@ -458,10 +458,10 @@
#include "output_field1dreal.inc"
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ nferr = nf_put_vara_real(output_obj % wr_ncid, VarID, start1, count1, field % array)
+#else
nferr = nf_put_vara_double(output_obj % wr_ncid, VarID, start1, count1, field % array)
-#else
- nferr = nf_put_vara_real(output_obj % wr_ncid, VarID, start1, count1, field % array)
#endif
nferr = nf_sync(output_obj % wr_ncid)
@@ -489,10 +489,10 @@
#include "output_field2dreal.inc"
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
+#else
nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start2, count2, field % array)
-#else
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
#endif
nferr = nf_sync(output_obj % wr_ncid)
@@ -522,10 +522,10 @@
#include "output_field3dreal.inc"
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
+#else
nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start3, count3, field % array)
-#else
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
#endif
nferr = nf_sync(output_obj % wr_ncid)
@@ -551,10 +551,10 @@
#include "output_field0dreal_time.inc"
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+#else
nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#else
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
#endif
nferr = nf_sync(output_obj % wr_ncid)
@@ -582,10 +582,10 @@
#include "output_field1dreal_time.inc"
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
+#else
nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start2, count2, field % array)
-#else
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
#endif
nferr = nf_sync(output_obj % wr_ncid)
@@ -615,10 +615,10 @@
#include "output_field2dreal_time.inc"
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
+#else
nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start3, count3, field % array)
-#else
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
#endif
nferr = nf_sync(output_obj % wr_ncid)
@@ -650,10 +650,10 @@
#include "output_field3dreal_time.inc"
-#if (RKIND == 8)
+#ifdef SINGLE_PRECISION
+ nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start4, count4, field % array)
+#else
nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start4, count4, field % array)
-#else
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start4, count4, field % array)
#endif
nferr = nf_sync(output_obj % wr_ncid)
Copied: branches/ocean_projects/performance/src/framework/mpas_kind_types.F (from rev 1313, trunk/mpas/src/framework/mpas_kind_types.F)
===================================================================
--- branches/ocean_projects/performance/src/framework/mpas_kind_types.F (rev 0)
+++ branches/ocean_projects/performance/src/framework/mpas_kind_types.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -0,0 +1,15 @@
+module mpas_kind_types
+
+#ifdef SINGLE_PRECISION
+ integer, parameter :: RKIND = selected_real_kind(6)
+#else
+ integer, parameter :: RKIND = selected_real_kind(12)
+#endif
+
+ contains
+
+ subroutine dummy_kinds()
+
+ end subroutine dummy_kinds
+
+end module mpas_kind_types
Modified: branches/ocean_projects/performance/src/framework/mpas_sort.F
===================================================================
--- branches/ocean_projects/performance/src/framework/mpas_sort.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/framework/mpas_sort.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,7 @@
module mpas_sort
+ use mpas_kind_types
+
interface quicksort
module procedure mpas_quicksort_int
module procedure mpas_quicksort_real
Modified: branches/ocean_projects/performance/src/framework/mpas_timekeeping.F
===================================================================
--- branches/ocean_projects/performance/src/framework/mpas_timekeeping.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/framework/mpas_timekeeping.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,6 @@
module mpas_timekeeping
+ use mpas_kind_types
use ESMF_BaseMod
use ESMF_Stubs
use ESMF_CalendarMod
Modified: branches/ocean_projects/performance/src/operators/mpas_spline_interpolation.F
===================================================================
--- branches/ocean_projects/performance/src/operators/mpas_spline_interpolation.F 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/operators/mpas_spline_interpolation.F 2012-01-06 22:48:40 UTC (rev 1317)
@@ -1,5 +1,7 @@
module mpas_spline_interpolation
+ use mpas_kind_types
+
implicit none
private
Modified: branches/ocean_projects/performance/src/registry/parse.c
===================================================================
--- branches/ocean_projects/performance/src/registry/parse.c 2012-01-06 21:05:33 UTC (rev 1316)
+++ branches/ocean_projects/performance/src/registry/parse.c 2012-01-06 22:48:40 UTC (rev 1317)
@@ -19,23 +19,21 @@
struct group_list * groups;
if (argc != 2) {
- fprintf(stderr,"</font>
<font color="black">Usage: %s filename</font>
<font color="black"></font>
<font color="red">", argv[0]);
- return 1;
+ fprintf(stderr,"Reading registry file from standard input</font>
<font color="red">");
+ regfile = stdin;
}
-
- if (regfile = fopen(argv[1], "r")) {
- nls = NULL;
- dims = NULL;
- vars = NULL;
- if (parse_reg(regfile, &nls, &dims, &vars, &groups)) {
- return 1;
- }
- }
- else {
+ else if (!(regfile = fopen(argv[1], "r"))) {
fprintf(stderr,"</font>
<font color="black">Error: Could not open file %s for reading.</font>
<font color="black"></font>
<font color="gray">", argv[1]);
return 1;
}
+ nls = NULL;
+ dims = NULL;
+ vars = NULL;
+ if (parse_reg(regfile, &nls, &dims, &vars, &groups)) {
+ return 1;
+ }
+
sort_vars(vars);
sort_group_vars(groups);
@@ -244,6 +242,7 @@
dimlist_ptr = dimlist_ptr->next;
}
}
+ fprintf(stdout,"</font>
<font color="gray">");
}
nls_ptr = *nls;
@@ -274,18 +273,19 @@
do { c = getc(regfile); } while (((char)c == ' ' || (char)c == '</font>
<font color="red">' || (char)c == '\t') && c != EOF);
- while ((char)c == '#') {
+ while ((char)c == '%') {
do { c = getc(regfile); } while ((char)c != '</font>
<font color="black">' && c != EOF);
do { c = getc(regfile); } while (((char)c == ' ' || (char)c == '</font>
<font color="red">' || (char)c == '\t') && c != EOF);
};
- while((char)c != ' ' && (char)c != '</font>
<font color="blue">' && (char)c != '\t' && c != EOF && (char)c != '#') {
+ while((char)c != ' ' && (char)c != '</font>
<font color="red">' && (char)c != '\t' && c != EOF && (char)c != '%') {
word[i++] = (char)c;
c = (char)getc(regfile);
}
word[i] = '\0';
- if ((char)c == '#') do { c = getc(regfile); } while ((char)c != '</font>
<font color="blue">' && c != EOF);
+ if ((char)c == '%') do { c = getc(regfile); } while ((char)c != '</font>
<font color="blue">' && c != EOF);
+ fprintf(stdout,"%s ",word);
return c;
}
</font>
</pre>