diff --git a/cmake/LibMPI.cmake b/cmake/LibMPI.cmake new file mode 100644 index 000000000..bf43069c5 --- /dev/null +++ b/cmake/LibMPI.cmake @@ -0,0 +1,217 @@ +# This file contains CMake code related to MPI. (Taken from the +# ParallelIO project.) + +# Jim Edwards +include (CMakeParseArguments) + +# Find Valgrind to perform memory leak check +if (PIO_VALGRIND_CHECK) + find_program (VALGRIND_COMMAND NAMES valgrind) + if (VALGRIND_COMMAND) + set (VALGRIND_COMMAND_OPTIONS --leak-check=full --show-reachable=yes) + else () + message (WARNING "Valgrind not found: memory leak check could not be performed") + set (VALGRIND_COMMAND "") + endif () +endif () + +# +# - Functions for parallel testing with CTest +# + +#============================================================================== +# - Get the machine platform-specific +# +# Syntax: platform_name (RETURN_VARIABLE) +# +function (platform_name RETURN_VARIABLE) + + # Determine platform name from site name... + site_name (SITENAME) + + # hera + if (SITENAME MATCHES "^hfe01" OR + SITENAME MATCHES "^hfe02" OR + SITENAME MATCHES "^hfe03" OR + SITENAME MATCHES "^hfe04" OR + SITENAME MATCHES "^hfe05" OR + SITENAME MATCHES "^hfe06" OR + SITENAME MATCHES "^hfe07" OR + SITENAME MATCHES "^hfe08" OR + SITENAME MATCHES "^hfe09" OR + SITENAME MATCHES "^hfe10" OR + SITENAME MATCHES "^hfe11" OR + SITENAME MATCHES "^hfe12") + + set (${RETURN_VARIABLE} "hera" PARENT_SCOPE) + + # wcoss_cray (Luna) + elseif (SITENAME MATCHES "^llogin1" OR + SITENAME MATCHES "^llogin2" OR + SITENAME MATCHES "^llogin3") + + set (${RETURN_VARIABLE} "wcoss_cray" PARENT_SCOPE) + + # wcoss_cray (Surge) + elseif (SITENAME MATCHES "^slogin1" OR + SITENAME MATCHES "^slogin2" OR + SITENAME MATCHES "^slogin3") + + set (${RETURN_VARIABLE} "wcoss_cray" PARENT_SCOPE) + + # wcoss_dell_p3 (Venus) + elseif (SITENAME MATCHES "^v71a1.ncep.noaa.gov" OR + SITENAME MATCHES "^v71a2.ncep.noaa.gov" OR + SITENAME MATCHES "^v71a3.ncep.noaa.gov" OR + SITENAME MATCHES "^v72a1.ncep.noaa.gov" OR + SITENAME MATCHES "^v72a2.ncep.noaa.gov" OR + SITENAME MATCHES "^v72a3.ncep.noaa.gov") + + set (${RETURN_VARIABLE} "wcoss_dell_p3" PARENT_SCOPE) + + # wcoss_dell_p3 (Mars) + elseif (SITENAME MATCHES "^m71a1.ncep.noaa.gov" OR + SITENAME MATCHES "^m71a2.ncep.noaa.gov" OR + SITENAME MATCHES "^m71a3.ncep.noaa.gov" OR + SITENAME MATCHES "^m72a1.ncep.noaa.gov" OR + SITENAME MATCHES "^m72a2.ncep.noaa.gov" OR + SITENAME MATCHES "^m72a3.ncep.noaa.gov") + + set (${RETURN_VARIABLE} "wcoss_dell_p3" PARENT_SCOPE) + + # wcoss2 + elseif (SITENAME MATCHES "^along01" OR + SITENAME MATCHES "^alogin02") + + set (${RETURN_VARIABLE} "wcoss2" PARENT_SCOPE) + + # gaea + elseif (SITENAME MATCHES "^gaea9" OR + SITENAME MATCHES "^gaea10" OR + SITENAME MATCHES "^gaea11" OR + SITENAME MATCHES "^gaea12" OR + SITENAME MATCHES "^gaea13" OR + SITENAME MATCHES "^gaea14" OR + SITENAME MATCHES "^gaea15" OR + SITENAME MATCHES "^gaea16" OR + SITENAME MATCHES "^gaea9.ncrc.gov" OR + SITENAME MATCHES "^gaea10.ncrc.gov" OR + SITENAME MATCHES "^gaea11.ncrc.gov" OR + SITENAME MATCHES "^gaea12.ncrc.gov" OR + SITENAME MATCHES "^gaea13.ncrc.gov" OR + SITENAME MATCHES "^gaea14.ncrc.gov" OR + SITENAME MATCHES "^gaea15.ncrc.gov" OR + SITENAME MATCHES "^gaea16.ncrc.gov") + + set (${RETURN_VARIABLE} "gaea" PARENT_SCOPE) + + # jet + elseif (SITENAME MATCHES "^fe1" OR + SITENAME MATCHES "^fe2" OR + SITENAME MATCHES "^fe3" OR + SITENAME MATCHES "^fe4" OR + SITENAME MATCHES "^fe5" OR + SITENAME MATCHES "^fe6" OR + SITENAME MATCHES "^fe7" OR + SITENAME MATCHES "^fe8" OR + SITENAME MATCHES "^tfe1" OR + SITENAME MATCHES "^tfe2") + + set (${RETURN_VARIABLE} "jet" PARENT_SCOPE) + + elseif (SITENAME MATCHES "^Orion-login-1.HPC.MsState.Edu" OR + SITENAME MATCHES "^Orion-login-2.HPC.MsState.Edu" OR + SITENAME MATCHES "^Orion-login-3.HPC.MsState.Edu" OR + SITENAME MATCHES "^Orion-login-4.HPC.MsState.Edu") + + set (${RETURN_VARIABLE} "orion" PARENT_SCOPE) + + elseif (SITENAME MATCHES "^cheyenne1.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne1.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne2.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne3.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne4.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne5.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne6.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne1.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne2.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne3.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne4.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne5.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^cheyenne6.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^chadmin1.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^chadmin2.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^chadmin3.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^chadmin4.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^chadmin5.ib0.cheyenne.ucar.edu" OR + SITENAME MATCHES "^chadmin6.ib0.cheyenne.ucar.edu") + + set (${RETURN_VARIABLE} "cheyenne" PARENT_SCOPE) + elseif (SITENAME MATCHES "^login1.stampede2.tacc.utexas.edu" OR + SITENAME MATCHES "^login2.stampede2.tacc.utexas.edu" OR + SITENAME MATCHES "^login3.stampede2.tacc.utexas.edu" OR + SITENAME MATCHES "^login4.stampede2.tacc.utexas.edu") + + + set (${RETURN_VARIABLE} "stampede" PARENT_SCOPE) + + else () + + set (${RETURN_VARIABLE} "unknown" PARENT_SCOPE) + + endif () +endfunction () + +#============================================================================== +# - Add a new parallel test +# +# Syntax: add_mpi_test ( +# EXECUTABLE +# ARGUMENTS ... +# NUMPROCS +# TIMEOUT ) +function (add_mpi_test TESTNAME) + + # Parse the input arguments + set (options) + set (oneValueArgs NUMPROCS TIMEOUT EXECUTABLE) + set (multiValueArgs ARGUMENTS) + cmake_parse_arguments (${TESTNAME} "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) + + # Store parsed arguments for convenience + set (exec_file ${${TESTNAME}_EXECUTABLE}) + set (exec_args ${${TESTNAME}_ARGUMENTS}) + set (num_procs ${${TESTNAME}_NUMPROCS}) + set (timeout ${${TESTNAME}_TIMEOUT}) + + # Get the platform name + platform_name (PLATFORM) + + get_property(WITH_MPIEXEC GLOBAL PROPERTY WITH_MPIEXEC) + if (WITH_MPIEXEC) + set(MPIEXEC "${WITH_MPIEXEC}") + endif () + + # Default ("unknown" platform) execution + if (PLATFORM STREQUAL "unknown") + + # Run tests directly from the command line + set(EXE_CMD ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} ${num_procs} + ${MPIEXEC_PREFLAGS} ${VALGRIND_COMMAND} ${VALGRIND_COMMAND_OPTIONS} ${exec_file} + ${MPIEXEC_POSTFLAGS} ${exec_args}) + + else () + + # Run tests from the platform-specific executable + set (EXE_CMD ${CMAKE_SOURCE_DIR}/cmake/mpiexec.${PLATFORM} + ${num_procs} ${VALGRIND_COMMAND} ${VALGRIND_COMMAND_OPTIONS} ${exec_file} ${exec_args}) + + endif () + + # Add the test to CTest + add_test(NAME ${TESTNAME} COMMAND ${EXE_CMD}) + + # Adjust the test timeout + set_tests_properties(${TESTNAME} PROPERTIES TIMEOUT ${timeout}) + +endfunction() diff --git a/cmake/mpiexec.hera b/cmake/mpiexec.hera new file mode 100755 index 000000000..332b33e29 --- /dev/null +++ b/cmake/mpiexec.hera @@ -0,0 +1,15 @@ +#!/bin/bash +# +# Arguments: +# +# $1 - Number of MPI Tasks +# $2+ - Executable and its arguments +# + +ACCOUNT= +QOS=debug + +NP=$1 +shift + +srun -A $ACCOUNT -q $QOS -n $NP $@ diff --git a/cmake/mpiexec.jet b/cmake/mpiexec.jet new file mode 100755 index 000000000..332b33e29 --- /dev/null +++ b/cmake/mpiexec.jet @@ -0,0 +1,15 @@ +#!/bin/bash +# +# Arguments: +# +# $1 - Number of MPI Tasks +# $2+ - Executable and its arguments +# + +ACCOUNT= +QOS=debug + +NP=$1 +shift + +srun -A $ACCOUNT -q $QOS -n $NP $@ diff --git a/cmake/mpiexec.orion b/cmake/mpiexec.orion new file mode 100755 index 000000000..332b33e29 --- /dev/null +++ b/cmake/mpiexec.orion @@ -0,0 +1,15 @@ +#!/bin/bash +# +# Arguments: +# +# $1 - Number of MPI Tasks +# $2+ - Executable and its arguments +# + +ACCOUNT= +QOS=debug + +NP=$1 +shift + +srun -A $ACCOUNT -q $QOS -n $NP $@ diff --git a/sorc/grid_tools.fd/regional_esg_grid.fd/pmat4.f90 b/sorc/grid_tools.fd/regional_esg_grid.fd/pmat4.f90 index b444f9455..d56f6ace9 100644 --- a/sorc/grid_tools.fd/regional_esg_grid.fd/pmat4.f90 +++ b/sorc/grid_tools.fd/regional_esg_grid.fd/pmat4.f90 @@ -4,7 +4,6 @@ !! @author R. J. Purser @date Oct 2005 !> Module for handy vector and matrix operations in Euclidean geometry. -!! Package for handy vector and matrix operations in Euclidean geometry. !! This package is primarily intended for 3D operations and three of the !! functions (Cross_product, Triple_product and Axial) do not possess simple !! generalizations to a generic number N of dimensions. The others, while @@ -30,7 +29,7 @@ !!- Trace: Trace of given matrix !!- Identity: Identity 3*3 matrix, or identity n*n matrix for a given n !!- Sarea: Spherical area subtended by three vectors, or by lat-lon -!! increments forming a triangle or quadrilateral +!! increments forming a triangle or quadrilateral !!- Huarea: Spherical area subtended by right-angled spherical triangle !! SUBROUTINE: !!- Gram: Right-handed orthogonal basis and rank, nrank. The first @@ -111,10 +110,10 @@ module pmat4 contains -!> Doing sqrt calculation for absv_s function. +!> Return the absolute magnitude of a single precision real vector. !! -!! @param[in] a real type input value -!! @return s result +!! @param[in] a real type input vector +!! @return s result, single precision real scalar !! @author R. J. Purser function absv_s(a)result(s)! [absv] implicit none @@ -123,10 +122,10 @@ function absv_s(a)result(s)! [absv] s=sqrt(dot_product(a,a)) end function absv_s -!> Doing sqrt calculation for absv_d function. +!> Return the absolute magnitude of a double precision real vector. !! -!! @param[in] a real type input value -!! @return s result +!! @param[in] a real type input vector +!! @return s result, double precision real scalar !! @author R. J. Purser function absv_d(a)result(s)! [absv] implicit none @@ -135,10 +134,10 @@ function absv_d(a)result(s)! [absv] s=sqrt(dot_product(a,a)) end function absv_d -!> Doing calculation for normalized_s function. +!> Return the normalized version of a single precision real vector. !! -!! @param[in] a real type input value -!! @return b result +!! @param[in] a real type input vector +!! @return b result, single precision real vector !! @author R. J. Purser function normalized_s(a)result(b)! [normalized] use pietc_s, only: u0 @@ -149,10 +148,10 @@ function normalized_s(a)result(b)! [normalized] s=absv_s(a); if(s==u0)then; b=u0;else;b=a/s;endif end function normalized_s -!> Doing calculation for normalized_d function. +!> Return the normalized version of a double precision real vector. !! -!! @param[in] a real type input value -!! @return b result +!! @param[in] a real type input vector +!! @return b result, double precision real vector !! @author R. J. Purser function normalized_d(a)result(b)! [normalized] use pietc, only: u0 @@ -163,11 +162,11 @@ function normalized_d(a)result(b)! [normalized] s=absv_d(a); if(s==u0)then; b=u0;else;b=a/s;endif end function normalized_d -!> Doing calculation for orthogonalized_s function. +!> Return the part of vector a that is orthogonal to unit vector u. !! -!! @param[in] u real type input value -!! @param[in] a real type input value -!! @return b result +!! @param[in] u real type input unit vector +!! @param[in] a real type input vector +!! @return b result, single precision real vector !! @author R. J. Purser function orthogonalized_s(u,a)result(b)! [orthogonalized] implicit none @@ -178,11 +177,11 @@ function orthogonalized_s(u,a)result(b)! [orthogonalized] s=dot_product(u,a); b=a-u*s end function orthogonalized_s -!> Doing calculation for orthogonalized_d function. +!> Return the part of vector a that is orthogonal to unit vector u. !! -!! @param[in] u real type input value -!! @param[in] a real type input value -!! @return b result +!! @param[in] u real type input unit vector +!! @param[in] a real type input vector +!! @return b result, double precision real vector !! @author R. J. Purser function orthogonalized_d(u,a)result(b)! [orthogonalized] implicit none @@ -193,11 +192,11 @@ function orthogonalized_d(u,a)result(b)! [orthogonalized] s=dot_product(u,a); b=a-u*s end function orthogonalized_d -!> Doing calculation for cross_product_s function. +!> Return the cross product of two single precision real 3-vectors !! -!! @param[in] a real type input value -!! @param[in] b real type input value -!! @return c result +!! @param[in] a real type input 3-vector +!! @param[in] b real type input 3-vector +!! @return c result, single precision real 3-vector !! @author R. J. Purser function cross_product_s(a,b)result(c)! [cross_product] implicit none @@ -206,11 +205,11 @@ function cross_product_s(a,b)result(c)! [cross_product] c(1)=a(2)*b(3)-a(3)*b(2); c(2)=a(3)*b(1)-a(1)*b(3); c(3)=a(1)*b(2)-a(2)*b(1) end function cross_product_s -!> Doing calculation for cross_product_d function. +!> Return the cross product of two double precision real 3-vectors !! -!! @param[in] a real type input value -!! @param[in] b real type input value -!! @return c result +!! @param[in] a real type input 3-vector +!! @param[in] b real type input 3-vector +!! @return c result, double precision real 3-vector !! @author R. J. Purser function cross_product_d(a,b)result(c)! [cross_product] implicit none @@ -224,10 +223,10 @@ end function cross_product_d !! that ordered, {u,v,w,x} form a right-handed quartet !! in the generic case (determinant >= 0). !! -!! @param[in] u vector -!! @param[in] v vector -!! @param[in] w vector -!! @return x triple-cross-product vector +!! @param[in] u real type input 4-vector +!! @param[in] v real type input 4-vector +!! @param[in] w real type input 4-vector +!! @return x result, triple-cross-product 4-vector !! @author R. J. Purser function triple_cross_product_s(u,v,w)result(x)! [cross_product] implicit none @@ -243,12 +242,12 @@ function triple_cross_product_s(u,v,w)result(x)! [cross_product] x(4)= uv12*w(3)-uv13*w(2)+uv23*w(1) end function triple_cross_product_s -!> Doing calculation for triple_cross_product_d function. +!> Return the triple_cross_product for 4-vectors !! -!! @param[in] u vector -!! @param[in] v vector -!! @param[in] w vector -!! @return x result +!! @param[in] u real type input 4-vector +!! @param[in] v real type input 4-vector +!! @param[in] w real type input 4-vector +!! @return x result, triple-cross-product 4-vector !! @author R. J. Purser function triple_cross_product_d(u,v,w)result(x)! [cross_product] implicit none @@ -264,11 +263,11 @@ function triple_cross_product_d(u,v,w)result(x)! [cross_product] x(4)= uv12*w(3)-uv13*w(2)+uv23*w(1) end function triple_cross_product_d -!> Doing calculation for outer_product_s function. +!> Return the outer product matrix of two single precision real vectors !! -!! @param[in] a real type input value -!! @param[in] b real type input value -!! @return c result +!! @param[in] a real type input vector +!! @param[in] b real type input vector +!! @return c result, rank-1 matrix outer product !! @author R. J. Purser function outer_product_s(a,b)result(c)! [outer_product] implicit none @@ -280,11 +279,11 @@ function outer_product_s(a,b)result(c)! [outer_product] do i=1,nb; c(:,i)=a*b(i); enddo end function outer_product_s -!> Calculation for outer_product_d function. +!> Return the outer product matrix of two double precision real vectors !! -!! @param[in] a real type input value -!! @param[in] b real type input value -!! @return c result +!! @param[in] a real type input vector +!! @param[in] b real type input vector +!! @return c result, rank-1 matrix outer product !! @author R. J. Purser function outer_product_d(a,b)result(c)! [outer_product] implicit none @@ -296,11 +295,11 @@ function outer_product_d(a,b)result(c)! [outer_product] do i=1,nb; c(:,i)=a*b(i); enddo end function outer_product_d -!> Calculation for outer_product_i function. +!> Return the outer product matrix of two integer vectors !! -!! @param[in] a input value -!! @param[in] b input value -!! @return c result +!! @param[in] a integer type input vector +!! @param[in] b integer type input vector +!! @return c result, rank-1 matrix outer product !! @author R. J. Purser function outer_product_i(a,b)result(c)! [outer_product] implicit none @@ -312,12 +311,12 @@ function outer_product_i(a,b)result(c)! [outer_product] do i=1,nb; c(:,i)=a*b(i); enddo end function outer_product_i -!> Calculation for triple_product_s function. +!> Return the triple product of three single precision real 3-vectors !! -!! @param[in] a real type input value -!! @param[in] b real type input value -!! @param[in] c real type input value -!! @return tripleproduct result +!! @param[in] a real type input 3-vector +!! @param[in] b real type input 3-vector +!! @param[in] c real type input 3-vector +!! @return tripleproduct result, scalar triple product !! @author R. J. Purser function triple_product_s(a,b,c)result(tripleproduct)! [triple_product] implicit none @@ -326,12 +325,12 @@ function triple_product_s(a,b,c)result(tripleproduct)! [triple_product] tripleproduct=dot_product( cross_product(a,b),c ) end function triple_product_s -!> Calculation for triple_product_d function. +!> Return the triple product of three double precision real 3-vectors !! -!! @param[in] a real type input value -!! @param[in] b real type input value -!! @param[in] c real type input value -!! @return tripleproduct result +!! @param[in] a real type input 3-vector +!! @param[in] b real type input 3-vector +!! @param[in] c real type input 3-vector +!! @return tripleproduct result, scalar triple product !! @author R. J. Purser function triple_product_d(a,b,c)result(tripleproduct)! [triple_product] implicit none @@ -340,10 +339,10 @@ function triple_product_d(a,b,c)result(tripleproduct)! [triple_product] tripleproduct=dot_product( cross_product(a,b),c ) end function triple_product_d -!> Calculation for det_s function. +!> Return the determinant of a single precision matrix !! -!! @param[in] a real type input value -!! @return det result +!! @param[in] a real type input matrix A +!! @return det result, determinant of matrix A !! @author R. J. Purser function det_s(a)result(det)! [det] use pietc_s, only: u0 @@ -361,15 +360,15 @@ function det_s(a)result(det)! [det] endif end function det_s -!> Calculation for det_d function. +!> Return the determinant of a double precision matrix !! -!! @param[in] a real type input value -!! @return det result +!! @param[in] a real type input matrix A +!! @return det result, determinant of matrix A !! @author R. J. Purser function det_d(a)result(det)! [det] use pietc, only: u0 implicit none -real(dp),dimension(:,:),intent(IN ) ::a +real(dp),dimension(:,:),intent(IN ) :: a real(dp) :: det real(dp),dimension(size(a,1),size(a,1)):: b integer(spi) :: n,nrank @@ -382,24 +381,24 @@ function det_d(a)result(det)! [det] endif end function det_d -!> Calculation for det_i function. +!> Return the determinant of a single precision integer matrix !! -!! @param[in] a real type input value -!! @return idet result +!! @param[in] a integer type input matrix A +!! @return idet result, determinant of matrix A !! @author R. J. Purser function det_i(a)result(idet)! [det] implicit none -integer(spi), dimension(:,:),intent(IN ) :: a -integer(spi) :: idet +integer(spi), dimension(:,:),intent(IN ):: a +integer(spi) :: idet real(dp),dimension(size(a,1),size(a,2)):: b real(dp) :: bdet b=a; bdet=det(b); idet=nint(bdet) end function det_i -!> Calculation for det_id function. +!> Return the determinant of a double precision integer matrix !! -!! @param[in] a real type input value -!! @return idet result +!! @param[in] a integer type input matrix A +!! @return idet result, determinant of matrix A !! @author R. J. Purser function det_id(a)result(idet)! [det] use pkind, only: dp,dpi @@ -411,10 +410,11 @@ function det_id(a)result(idet)! [det] b=a; bdet=det(b); idet=nint(bdet) end function det_id -!> Calculation for axial3_s function. +!> Return the axial "vector", as an antisymmetric matrix, corresponding to +!! the given 3-vector assuming a right-handed correspondence. !! -!! @param[in] a real type input value -!! @return b result +!! @param[in] a real type input 3-vector A +!! @return b result, antisymmetrix "axial vector" matrix corresponding to A !! @author R. J. Purser function axial3_s(a)result(b)! [axial] use pietc_s, only: u0 @@ -424,10 +424,11 @@ function axial3_s(a)result(b)! [axial] b=u0;b(3,2)=a(1);b(1,3)=a(2);b(2,1)=a(3);b(2,3)=-a(1);b(3,1)=-a(2);b(1,2)=-a(3) end function axial3_s -!> Calculation for axial3_d function. +!> Return the axial "vector", as an antisymmetric matrix, corresponding to +!! the given 3-vector assuming a right-handed correspondence. !! -!! @param[in] a real type input value -!! @return b result +!! @param[in] a real type input 3-vector A +!! @return b result, antisymmetrix "axial vector" matrix corresponding to A !! @author R. J. Purser function axial3_d(a)result(b)! [axial] use pietc, only: u0 @@ -437,10 +438,11 @@ function axial3_d(a)result(b)! [axial] b=u0;b(3,2)=a(1);b(1,3)=a(2);b(2,1)=a(3);b(2,3)=-a(1);b(3,1)=-a(2);b(1,2)=-a(3) end function axial3_d -!> Calculation for axial33_s function. +!> Return the 3-vector corresponding to the given antisymmetric "axial vector" +!! matrix, assuming a right-handed correspondence. !! -!! @param[in] b real type input value -!! @return a result +!! @param[in] b real type input antisymmetric matrix "axial vector" B +!! @return a result, 3-vector corresponding to B !! @author R. J. Purser function axial33_s(b)result(a)! [axial] use pietc_s, only: o2 @@ -450,10 +452,11 @@ function axial33_s(b)result(a)! [axial] a(1)=(b(3,2)-b(2,3))*o2; a(2)=(b(1,3)-b(3,1))*o2; a(3)=(b(2,1)-b(1,2))*o2 end function axial33_s -!> Calculation for axial33_d function. +!> Return the 3-vector corresponding to the given antisymmetric "axial vector" +!! matrix, assuming a right-handed correspondence. !! -!! @param[in] b real type input value -!! @return a result +!! @param[in] b real type input antisymmetric matrix "axial vector" B +!! @return a result, 3-vector corresponding to B !! @author R. J. Purser function axial33_d(b)result(a)! [axial] use pietc, only: o2 @@ -463,10 +466,11 @@ function axial33_d(b)result(a)! [axial] a(1)=(b(3,2)-b(2,3))*o2; a(2)=(b(1,3)-b(3,1))*o2; a(3)=(b(2,1)-b(1,2))*o2 end function axial33_d -!> Calculation for diagn_s function. +!> Return the diagonal matrix whose elements are the given vector. +!! Single precision version. !! -!! @param[in] a real type input value -!! @return b result +!! @param[in] a real type input vector A listing the diagonal elements +!! @return b result, diagonal matrix with the elements of A !! @author R. J. Purser function diagn_s(a)result(b)! [diag] use pietc, only: u0 @@ -478,10 +482,11 @@ function diagn_s(a)result(b)! [diag] b=u0; do i=1,n; b(i,i)=a(i); enddo end function diagn_s -!> Calculation for diagn_d function. +!> Return the diagonal matrix whose elements are the given vector. +!! Double precision version !! -!! @param[in] a real type input value -!! @return b result +!! @param[in] a real type input vector A listing the diagonal elements +!! @return b result, diagonal matrix with the elements of A !! @author R. J. Purser function diagn_d(a)result(b)! [diag] use pietc, only: u0 @@ -493,10 +498,11 @@ function diagn_d(a)result(b)! [diag] b=u0; do i=1,n; b(i,i)=a(i); enddo end function diagn_d -!> Calculation for diagn_i function. +!> Return the diagonal matrix whose elements are the given vector. +!! Integer version. !! -!! @param[in] a input value -!! @return b result +!! @param[in] a integer input vector A listing the diagonal elements +!! @return b result, diagonal matrix with the elements of A !! @author R. J. Purser function diagn_i(a)result(b)! [diag] implicit none @@ -507,10 +513,11 @@ function diagn_i(a)result(b)! [diag] b=0; do i=1,n; b(i,i)=a(i); enddo end function diagn_i -!> Calculation for diagnn_s function. +!> Return the vector whose elements are the diagonal ones of a given matrix. +!! Single precision version. !! -!! @param[in] b real type input value -!! @return a result +!! @param[in] b real type input matrix +!! @return a result, vector listing the diagonal elements of the given matrix. !! @author R. J. Purser function diagnn_s(b)result(a)! [diag] implicit none @@ -521,10 +528,11 @@ function diagnn_s(b)result(a)! [diag] do i=1,n; a(i)=b(i,i); enddo end function diagnn_s -!> Calculation for diagnn_d function. +!> Return the vector whose elements are the diagonal ones of a given matrix. +!! Single precision version. !! -!! @param[in] b real type input value -!! @return a result +!! @param[in] b real type input matrix +!! @return a result, vector listing the diagonal elements of the given matrix. !! @author R. J. Purser function diagnn_d(b)result(a)! [diag] implicit none @@ -535,10 +543,11 @@ function diagnn_d(b)result(a)! [diag] do i=1,n; a(i)=b(i,i); enddo end function diagnn_d -!> Calculation for diagnn_i function. +!> Return the vector whose elements are the diagonal ones of a given matrix. +!! Integer version. !! -!! @param[in] b integer type input value -!! @return a result +!! @param[in] b integer type input matrix +!! @return a result, vector listing the diagonal elements of the given matrix. !! @author R. J. Purser function diagnn_i(b)result(a)! [diag] implicit none @@ -549,10 +558,10 @@ function diagnn_i(b)result(a)! [diag] do i=1,n; a(i)=b(i,i); enddo end function diagnn_i -!> Calculation for trace_s function. +!> Return the trace of a given single precision real matrix !! -!! @param[in] b real type input value -!! @return s result +!! @param[in] b real type input matrix B +!! @return s result, trace, or sum of diagonal elements, of B !! @author R. J. Purser function trace_s(b)result(s)! [trace] implicit none @@ -561,10 +570,10 @@ function trace_s(b)result(s)! [trace] s=sum(diag(b)) end function trace_s -!> Calculation for trace_d function. +!> Return the trace of a given double precision real matrix !! -!! @param[in] b real type input value -!! @return s result +!! @param[in] b real type input matrix B +!! @return s result, trace, or sum of diagonal elements, of B !! @author R. J. Purser function trace_d(b)result(s)! [trace] implicit none @@ -573,10 +582,10 @@ function trace_d(b)result(s)! [trace] s=sum(diag(b)) end function trace_d -!> Calculation for trace_i function. +!> Return the trace of a given integer matrix !! -!! @param[in] b input value -!! @return s result +!! @param[in] b integer type input matrix B +!! @return s result, trace, or sum of diagonal elements, of B !! @author R. J. Purser function trace_i(b)result(s)! [trace] implicit none @@ -585,10 +594,10 @@ function trace_i(b)result(s)! [trace] s=sum(diag(b)) end function trace_i -!> Calculation for identity_i function. +!> Return the integer identity matrix for a given dimensionality !! -!! @param[in] n input value -!! @return a result +!! @param[in] n input integer dimensionality +!! @return a result, identity matrix of the given dimensionality !! @author R. J. Purser function identity_i(n)result(a)! [identity] implicit none @@ -598,9 +607,9 @@ function identity_i(n)result(a)! [identity] a=0; do i=1,n; a(i,i)=1; enddo end function identity_i -!> Calculation for identity3_i function. +!> Return the 3-dimensional integer identity matrix !! -!! @return a result +!! @return a result, identity matrix in 3 dimensions. !! @author R. J. Purser function identity3_i()result(a)! [identity] implicit none @@ -610,11 +619,12 @@ function identity3_i()result(a)! [identity] end function identity3_i !> Spherical area of right-angle triangle whose orthogonal sides have -!! orthographic projection dimensions, sa and sb. +!! orthographic projection dimensions, sa and sb, sphere of unit radius. +!! Single precision version. !! -!! @param[in] sa ??? -!! @param[in] sb ??? -!! @return area +!! @param[in] sa orthographic projection of triangle's side A +!! @param[in] sb orthographic projection of triangle's side B +!! @return area (steradians) of the right-angle spherical triangle !! @author R. J. Purser function huarea_s(sa,sb)result(area)! [huarea] implicit none @@ -626,11 +636,13 @@ function huarea_s(sa,sb)result(area)! [huarea] area=asin(sa*sb/(1+ca*cb)) end function huarea_s -!> Calculation for huarea_d function. +!> Spherical area of right-angle triangle whose orthogonal sides have +!! orthographic projection dimensions, sa and sb, sphere of unit radius. +!! Double precision version. !! -!! @param[in] sa ??? -!! @param[in] sb ??? -!! @return area +!! @param[in] sa orthographic projection of triangle's side A +!! @param[in] sb orthographic projection of triangle's side B +!! @return area (steradians) of the right-angle spherical triangle !! @author R. J. Purser function huarea_d(sa,sb)result(area)! [huarea] implicit none @@ -680,11 +692,11 @@ function sarea_s(v1,v2,v3)result(area)! [sarea] contains -!> Shift switch variable. +!> Cyclically permute real vectors, u1, u2, u3, and scalars, d1, d2, d3. !! -!! @param[inout] u1 real variable to be shifted -!! @param[inout] u2 real variable to be shifted -!! @param[inout] u3 real variable to be shifted +!! @param[inout] u1 real vector to be shifted +!! @param[inout] u2 real vector to be shifted +!! @param[inout] u3 real vector to be shifted !! @param[inout] d1 real variable to be shifted !! @param[inout] d2 real variable to be shifted !! @param[inout] d3 real variable to be shifted @@ -700,11 +712,11 @@ subroutine cyclic(u1,u2,u3,d1,d2,d3) end subroutine cyclic end function sarea_s -!> Compute the area of sarea_d, {v1,v2,v3}. +!> Compute the area of the spherical triangle, {v1,v2,v3}. !! -!! @param[in] v1 area of the spherical triangle -!! @param[in] v2 area of the spherical triangle -!! @param[in] v3 area of the spherical triangle +!! @param[in] v1 unit-3-vector vertex of the spherical triangle +!! @param[in] v2 unit-3-vector vertex of the spherical triangle +!! @param[in] v3 unit-3-vector vertex of the spherical triangle !! @return area result !! @author R. J. Purser function sarea_d(v1,v2,v3)result(area)! [sarea] @@ -735,11 +747,11 @@ function sarea_d(v1,v2,v3)result(area)! [sarea] contains -!> Shift switch variable. +!> Cyclically permute real vectors, u1, u2, u3, and scalars, d1, d2, d3. !! -!! @param[inout] u1 real variable to be shifted -!! @param[inout] u2 real variable to be shifted -!! @param[inout] u3 real variable to be shifted +!! @param[inout] u1 real vector to be shifted +!! @param[inout] u2 real vector to be shifted +!! @param[inout] u3 real vector to be shifted !! @param[inout] d1 real variable to be shifted !! @param[inout] d2 real variable to be shifted !! @param[inout] d3 real variable to be shifted @@ -761,12 +773,13 @@ end function sarea_d !! The computations are designed to give a proportionately accurate area !! estimate even when the triangle is very small, provided the B-increment !! is not disproportionately small compared to the other two sides. +!! Single precision version. !! -!! @param[in] rlat latitude -!! @param[in] drlata latitudes -!! @param[in] drlona longitudes -!! @param[in] drlatb latitudes -!! @param[in] drlonb longitudes +!! @param[in] rlat latitude of reference point +!! @param[in] drlata incremental latitude of A +!! @param[in] drlona incremental longitude of A +!! @param[in] drlatb incremental latitude of B +!! @param[in] drlonb incremental longitude of B !! @return area result !! @author R. J. Purser function dtarea_s(rlat,drlata,drlona,drlatb,drlonb) result(area)! [sarea] @@ -793,13 +806,19 @@ function dtarea_s(rlat,drlata,drlona,drlatb,drlonb) result(area)! [sarea] area=huarea(-sa,sb)+huarea(sc,-sa) end function dtarea_s -!> Compute the area with dtarea_d. +!> Compute the area of the spherical triangle with a vertex at latitude +!! rlat, and two other vertices, A and B, whose incremented latitudes +!! and longitudes are drlata,drlona (for A) and drlatb,drlonb (for B). +!! The computations are designed to give a proportionately accurate area +!! estimate even when the triangle is very small, provided the B-increment +!! is not disproportionately small compared to the other two sides. +!! Double precision version. !! -!! @param[in] rlat latitude -!! @param[in] drlata latitudes -!! @param[in] drlona longitudes -!! @param[in] drlatb latitudes -!! @param[in] drlonb longitudes +!! @param[in] rlat latitude of reference point +!! @param[in] drlata incremental latitude of A +!! @param[in] drlona incremental longitude of A +!! @param[in] drlatb incremental latitude of B +!! @param[in] drlonb incremental longitude of B !! @return area result !! @author R. J. Purser function dtarea_d(rlat,drlata,drlona,drlatb,drlonb) result(area)! [sarea] @@ -827,21 +846,22 @@ function dtarea_d(rlat,drlata,drlona,drlatb,drlonb) result(area)! [sarea] end function dtarea_d !> Compute the area of the spherical quadrilateral with a vertex at latitude -!! rlat, and three other vertices at A, B, and C inturn, +!! rlat, and three other vertices at A, B, and C in turn, !! whose incremented latitudes and longitudes are drlata,drlona (for A), !! drlatb,drlonb (for B), and drlatc,drlonc (for C). !! The computations are designed to give a proportionately accurate area !! estimate even when the quadrilateral is very small, provided the !! diagonal making the B-increment is not disproportionately small compared to !! the characteristic size of the quadrilateral. -!! -!! @param[in] rlat latitude -!! @param[in] drlata latitudes -!! @param[in] drlona longitudes -!! @param[in] drlatb latitudes -!! @param[in] drlonb longitudes -!! @param[in] drlatc latitudes -!! @param[in] drlonc longitudes +!! Single precision version. +!! +!! @param[in] rlat latitude of reference point +!! @param[in] drlata incremental latitude of point A +!! @param[in] drlona incremental longitude of point A +!! @param[in] drlatb incremental latitude of point B +!! @param[in] drlonb incremental longitude of point B +!! @param[in] drlatc incremental latitude of point C +!! @param[in] drlonc incremental longitude of point C !! @return area result !! @author R. J. Purser function dqarea_s &! [sarea] @@ -853,15 +873,24 @@ function dqarea_s &! [sarea] -sarea(rlat,drlatc,drlonc,drlatb,drlonb) end function dqarea_s -!> Compute the area using dqarea_d. -!! -!! @param[in] rlat latitude -!! @param[in] drlata latitudes -!! @param[in] drlona longitudes -!! @param[in] drlatb latitudes -!! @param[in] drlonb longitudes -!! @param[in] drlatc latitudes -!! @param[in] drlonc longitudes + +!> Compute the area of the spherical quadrilateral with a vertex at latitude +!! rlat, and three other vertices at A, B, and C in turn, +!! whose incremented latitudes and longitudes are drlata,drlona (for A), +!! drlatb,drlonb (for B), and drlatc,drlonc (for C). +!! The computations are designed to give a proportionately accurate area +!! estimate even when the quadrilateral is very small, provided the +!! diagonal making the B-increment is not disproportionately small compared to +!! the characteristic size of the quadrilateral. +!! Double precision version. +!! +!! @param[in] rlat latitude of reference point +!! @param[in] drlata incremental latitude of point A +!! @param[in] drlona incremental longitude of point A +!! @param[in] drlatb incremental latitude of point B +!! @param[in] drlonb incremental longitude of point B +!! @param[in] drlatc incremental latitude of point C +!! @param[in] drlonc incremental longitude of point C !! @return area !! @author R. J. Purser function dqarea_d &! [sarea] @@ -873,7 +902,10 @@ function dqarea_d &! [sarea] -sarea(rlat,drlatc,drlonc,drlatb,drlonb) end function dqarea_d -!> Calculate dlltoxy_s. +!> From a reference latitude, and increments of latitude and longitude, +!! return the local cartesian 2-vector corresponding to the projection +!! of the increment onto the tangent plane of the reference point. +!! Single precision version. !! !! @param[in] rlat latitude !! @param[in] drlat latitude @@ -890,7 +922,10 @@ subroutine dlltoxy_s(rlat,drlat,drlon,x2)! [dlltoxy] x2=(/clata*sin(drlon),sin(drlat)+u2*sin(rlat)*clata*hav(drlon)/) end subroutine dlltoxy_s -!> Calculate dlltoxy_d. +!> From a reference latitude, and increments of latitude and longitude, +!! return the local cartesian 2-vector corresponding to the projection +!! of the increment onto the tangent plane of the reference point. +!! Double precision version. !! !! @param[in] rlat latitude !! @param[in] drlat latitude @@ -907,9 +942,9 @@ subroutine dlltoxy_d(rlat,drlat,drlon,x2)! [dlltoxy] x2=(/clata*sin(drlon),sin(drlat)+u2*sin(rlat)*clata*hav(drlon)/) end subroutine dlltoxy_d -!> Haversine function. +!> Haversine function in single precision. !! -!! @param[in] t input +!! @param[in] t input argument !! @return a result !! @author R. J. Purser function hav_s(t) result(a)! [hav] @@ -920,9 +955,9 @@ function hav_s(t) result(a)! [hav] a=(sin(t*o2))**2 end function hav_s -!> Doing hav_d function. +!> Haversine function in double precision. !! -!! @param[in] t input +!! @param[in] t input argument !! @return a result !! @author R. J. Purser function hav_d(t) result(a)! [hav] @@ -933,7 +968,7 @@ function hav_d(t) result(a)! [hav] a=(sin(t*o2))**2 end function hav_d -!> Normalize the given vector. +!> Normalize the given single precision real vector. !! !! @param[inout] v vector !! @author R. J. Purser @@ -945,7 +980,7 @@ subroutine normalize_s(v)! [normalize] s=absv(v); if(s==0)then; v=u0; v(1)=u1; else; v=v/s; endif end subroutine normalize_s -!> Doing normalize_d calculation for given vector. +!> Normalize the given double precision real vector. !! !! @param[inout] v vector !! @author R. J. Purser @@ -957,12 +992,16 @@ subroutine normalize_d(v)! [normalize] s=absv(v); if(s==u0)then; v=0; v(1)=u1; else; v=v/s; endif end subroutine normalize_d -!> ??? +!> Apply a form of Gram-Schmidt orthogonalization process to return as many +!! normalized orthogonal basis column vectors in matrix B as possible in the +!! space spanned by the columns of matrix A. The number of columns returned +!! is the rank, nrank, of A, and the determinant of the projection of A into +!! the subspace of B is returned as det. !! -!! @param[in] as ??? -!! @param[out] b ??? -!! @param[out] nrank ??? -!! @param[out] det ??? +!! @param[in] as given matrix A +!! @param[out] b matrix B containing nrank orthonormal column vectors +!! @param[out] nrank rank of A +!! @param[out] det determinant of projection of A into subspace of B !! @author R. J. Purser subroutine gram_s(as,b,nrank,det)! [gram] use pietc_s, only: u0,u1 @@ -1024,12 +1063,16 @@ subroutine gram_s(as,b,nrank,det)! [gram] enddo end subroutine gram_s -!> ??? +!> Apply a form of Gram-Schmidt orthogonalization process to return as many +!! normalized orthogonal basis column vectors in matrix B as possible in the +!! space spanned by the columns of matrix A. The number of columns returned +!! is the rank, nrank, of A, and the determinant of the projection of A into +!! the subspace of B is returned as det. !! -!! @param[in] as ??? -!! @param[out] b ??? -!! @param[out] nrank ??? -!! @param[out] det ??? +!! @param[in] as given matrix A +!! @param[out] b matrix B containing nrank orthonormal column vectors +!! @param[out] nrank rank of A +!! @param[out] det determinant of projection of A into subspace of B !! @author R. J. Purser subroutine gram_d(as,b,nrank,det)! [gram] use pietc, only: u0,u1 @@ -1097,11 +1140,11 @@ end subroutine gram_d !! as zero (instead of either +1 or -1) and ldet is then just the log of !! the nonzero factors found by the process. !! -!! @param[in] as ??? -!! @param[out] b ??? -!! @param[out] nrank ??? -!! @param[out] detsign singular determinant -!! @param[out] ldet ??? +!! @param[in] as given matrix A +!! @param[out] b matrix B of orthonormal columns +!! @param[out] nrank rank of A +!! @param[out] detsign sign of determinant +!! @param[out] ldet logarithm of absolute value of determinant !! @author R. J. Purser subroutine graml_d(as,b,nrank,detsign,ldet)! [gram] use pietc, only: u0 @@ -1175,9 +1218,10 @@ end subroutine graml_d !> A "plain" (unpivoted) version of Gram-Schmidt, for square matrices only. +!! Single precision version. !! -!! @param[inout] b matrices -!! @param[out] nrank result +!! @param[inout] b input as given matrix, output as orthogonalized vectors +!! @param[out] nrank effective rank of given matrix !! @author R. J. Purser subroutine plaingram_s(b,nrank)! [gram] use pietc_s, only: u0 @@ -1210,9 +1254,10 @@ subroutine plaingram_s(b,nrank)! [gram] end subroutine plaingram_s !> A "plain" (unpivoted) version of Gram-Schmidt, for square matrices only. +!! Double precision version. !! -!! @param[inout] b matrices -!! @param[out] nrank result +!! @param[inout] b input as given matrix, output as orthogonalized vectors +!! @param[out] nrank effective rank of given matrix !! @author R. J. Purser subroutine plaingram_d(b,nrank)! [gram] use pietc, only: u0 @@ -1258,13 +1303,13 @@ end subroutine plaingram_d !! "epsilon" value that is fixed (10**(-13)) and assumes elements of a are !! never too different in magnitude from unity, unless they are actually zero. !! -!! @param[in] m ??? -!! @param[in] n ??? -!! @param[in] a rectangular input matrix +!! @param[in] m number of rows of A +!! @param[in] n number of columns of A +!! @param[in] a rectangular input matrix A !! @param[out] ipiv pivoting sequence !! @param[out] tt row-normalization !! @param[out] b orthonormalized rows -!! @param[in] rank ??? +!! @param[in] rank effective rank of A !! @author R. J. Purser subroutine rowgram(m,n,a,ipiv,tt,b,rank)! [gram] use pietc, only: u0,u1 @@ -1344,12 +1389,12 @@ end subroutine rowgram !> Apply the row-operations, implied by ipiv and tt returned by rowgram, to !! the single column vector, v, to produce the transformed vector vv. !! -!! @param[in] m ??? -!! @param[in] n ??? -!! @param[in] ipiv ??? -!! @param[in] tt ??? -!! @param[in] v vector -!! @param[out] vv vector +!! @param[in] m number of rows of matrix tt, dimension of vectors V and VV +!! @param[in] n number of columns of matrix tt +!! @param[in] ipiv integer vector encoding the pivoting sequence +!! @param[in] tt row-normalized matrix provided by subroutine rowgram +!! @param[in] v input single column vector +!! @param[out] vv output column vector vector !! @author R. J. Purser subroutine rowops(m,n,ipiv,tt,v,vv)! [rowops] implicit none @@ -1384,13 +1429,13 @@ end subroutine rowops !! together with the rescaled matrix aa such that a = d.aa.e when d and e are !! interpreted as diagonal matrices. !! -!! @param[in] m ??? -!! @param[in] n ??? -!! @param[in] mask ??? -!! @param[in] a positive diagonals -!! @param[out] d positive diagonals -!! @param[in] aa ??? -!! @param[out] e positive diagonals +!! @param[in] m number of rows of A +!! @param[in] n number of columns of A +!! @param[in] mask logical mask +!! @param[in] a real rectangular matrix A +!! @param[out] d positive diagonal matrix of dimension m +!! @param[in] aa rescaled version of A +!! @param[out] e positive diagonal matrix of dimension n !! @author R. J. Purser subroutine corral(m,n,mask,a,d,aa,e)! [corral] use pietc, only: u0,u1 @@ -1508,10 +1553,10 @@ subroutine axtorot(ax3,orth33)! [axtorot] ax33=axial(ax3); call expmat(3,ax33,orth33,d) end subroutine axtorot -!> Go from the spinor to the quaternion representation. +!> Go from the complex spinor matrix to the unit quaternion representation. !! -!! @param[in] cspin spinor representation -!! @param[out] q quaternion representation +!! @param[in] cspin complex spinor representation +!! @param[out] q unit quaternion representation !! @author R. J. Purser subroutine spintoq(cspin,q)! [spintoq] implicit none @@ -1521,9 +1566,9 @@ subroutine spintoq(cspin,q)! [spintoq] q(2)=real(cspin(2,1)); q(1)=aimag(cspin(2,1)) end subroutine spintoq -!> Go from the quaternion to the spinor representation. +!> Go from the unit quaternion to the complex spinor representation. !! -!! @param[in] q quaternion representation +!! @param[in] q given unit quaternion representation !! @param[out] cspin spinor representation !! @author R. J. Purser subroutine qtospin(q,cspin)! [qtospin] @@ -1536,9 +1581,9 @@ subroutine qtospin(q,cspin)! [qtospin] cspin(2,2)=cmplx( q(0),-q(3)) end subroutine qtospin -!> Go from rotation matrix to quaternion representation. +!> Go from rotation matrix to a corresponding unit quaternion representation. !! -!! @param[in] rot rotation matrix +!! @param[in] rot given rotation matrix !! @param[out] q quaternion representation !! @author R. J. Purser subroutine rottoq(rot,q)! [rottoq] @@ -1632,13 +1677,14 @@ subroutine qtoax(q,v)! [qtoax] call rottoax(rot,v) end subroutine qtoax -!> ??? +!> Given the 4 components of a unit quaternion, return the associated +!! 3*3 rotation matrix !! -!! @param[in] c ??? -!! @param[in] d ??? -!! @param[in] e ??? -!! @param[in] g ??? -!! @param[in] r ??? +!! @param[in] c 0th component of given quaternion +!! @param[in] d 1st component of given quaternion +!! @param[in] e 2nd component of given quaternion +!! @param[in] g 3rd component of given quaternion +!! @param[in] r output 3*3 real rotation matrix !! @author R. J. Purser subroutine setem(c,d,e,g,r)! [setem] implicit none @@ -1655,9 +1701,9 @@ end subroutine setem !> Multiply quaternions, a*b, assuming operation performed from right to left. !! -!! @param[in] a real quaternion -!! @param[in] b real quaternion -!! @return c result +!! @param[in] a input quaternion +!! @param[in] b input quaternion +!! @return c result quaternion a*b !! @author R. J. Purser function mulqq(a,b)result(c)! [mulqq] implicit none @@ -1669,15 +1715,15 @@ function mulqq(a,b)result(c)! [mulqq] c(3)=a(0)*b(3) +a(3)*b(0) +a(1)*b(2) -a(2)*b(1) end function mulqq -!> Evaluate the exponential, b, of a matrix, a, of degree n. +!> Evaluate the exponential, B, of a matrix, A, of degree n. !! Apply the iterated squaring method, m times, to the approximation to -!! exp(a/(2**m)) obtained as a Taylor expansion of degree L +!! exp(A/(2**m)) obtained as a Taylor expansion of degree L !! See Fung, T. C., 2004, Int. J. Numer. Meth. Engng, 59, 1273--1286. !! -!! @param[in] n degree -!! @param[in] a matrix -!! @param[out] b exponential matrix of a -!! @param[out] detb ??? +!! @param[in] n order of square matrix A +!! @param[in] a input matrix A +!! @param[out] b matrix B, the exponential of matrix A +!! @param[out] detb determinant of matrix B !! @author R. J. Purser subroutine expmat(n,a,b,detb)! [expmat] use pietc, only: u0,u1,u2,o2 @@ -1710,12 +1756,12 @@ end subroutine expmat !> Like expmat, but for the 1st derivatives also. !! -!! @param[in] n degree -!! @param[in] a matrix -!! @param[out] b exponential matrix of a -!! @param[out] bd ??? -!! @param[out] detb ??? -!! @param[out] detbd ??? +!! @param[in] n order of square matrix A +!! @param[in] a input matrix A +!! @param[out] b matrix B, the exponential of matrix A +!! @param[out] bd derivative of B wrt elements of A +!! @param[out] detb determinant of matrix B +!! @param[out] detbd derivative of detb wrt elements of A !! @author R. J. Purser subroutine expmatd(n,a,b,bd,detb,detbd)! [expmat] use pietc, only: u0,u1,u2,o2 @@ -1775,14 +1821,14 @@ end subroutine expmatd !> Like expmat, but for the 1st and 2nd derivatives also. !! -!! @param[in] n degree -!! @param[in] a matrix -!! @param[out] b exponential matrix of a -!! @param[out] bd ??? -!! @param[out] bdd ??? -!! @param[out] detb ??? -!! @param[out] detbd ??? -!! @param[out] detbdd ??? +!! @param[in] n order of the matrix A +!! @param[in] a input matrix A +!! @param[out] b matrix B, exponential of matrix A +!! @param[out] bd derivative of B wrt elements of A +!! @param[out] bdd 2nd derivative of B wrt elements of A +!! @param[out] detb determinant of matrix B +!! @param[out] detbd derivative of detb wrt elements of A +!! @param[out] detbdd 2nd derivative of detb wrt elements of A !! @author R. J. Purser subroutine expmatdd(n,a,b,bd,bdd,detb,detbd,detbdd)! [expmat] use pietc, only: u0,u1,u2,o2 @@ -1864,11 +1910,12 @@ subroutine expmatdd(n,a,b,bd,bdd,detb,detbd,detbdd)! [expmat] detbdd=u0; do ki=1,n; do kj=1,n; detbdd(ki,kj)=detb; enddo; enddo end subroutine expmatdd -!> ??? +!> Evaluate, by Taylor-Maclaurin expansion, the nth-derivative of the +!! function, C(z)=cosh(sqrt(2z)), or equiavlently, of C(z)=cos(sqrt(-2z)). !! -!! @param[in] n ??? -!! @param[in] z ??? -!! @param[in] zn ??? +!! @param[in] n integer order of the derivative +!! @param[in] z real argument +!! @param[in] zn returned value of the nth derivative !! @author R. J. Purser subroutine zntay(n,z,zn)! [zntay] use pietc, only: u2 @@ -1898,14 +1945,16 @@ subroutine zntay(n,z,zn)! [zntay] print'("In zntay; full complement of iterations used")' end subroutine zntay -!> ??? +!> For a given nonnegative integer n and real argument z, evaluate the +!! nth,...,(n+3)th derivatives, wrt z, of the function C(z) = cosh(sqrt(2z)) +!! or, equivalently, of C(z) = cos(sqrt(-2z)), according to the sign of z. !! -!! @param[in] n ??? -!! @param[in] z ??? -!! @param[out] zn ??? -!! @param[out] znd ??? -!! @param[out] zndd ??? -!! @param[out] znddd ??? +!! @param[in] n integer order of the first of the returned derivatives of C. +!! @param[in] z real input argument in the function C(z) +!! @param[out] zn nth-derivative of C(z) +!! @param[out] znd (n+1)th-derivative of C(z) +!! @param[out] zndd (n+2)th-derivative of C(z) +!! @param[out] znddd (n+3)th-derivative of C(z) !! @author R. J. Purser subroutine znfun(n,z,zn,znd,zndd,znddd)! [znfun] use pietc, only: u0,u2,u3 @@ -1951,7 +2000,7 @@ subroutine znfun(n,z,zn,znd,zndd,znddd)! [znfun] endif end subroutine znfun -!> Utility code for various Mobius transformations. If aa1,bb1,cc1,dd1 are +!> Utility codes for various Mobius transformations. If aa1,bb1,cc1,dd1 are !! the coefficients for one transformation, and aa2,bb2,cc2,dd2 are the !! coefficients for a second one, then the coefficients for the mapping !! of a test point, zz, by aa1 etc to zw, followed by a mapping of zw, by @@ -1966,9 +2015,13 @@ end subroutine znfun !! !! Note that the determinant of these matrices is always +1. !! -!! @param[in] v matric -!! @param[out] z ??? -!! @param[out] infz ??? + +!> Given a cartesian 3-vector representation of a point on the Riemann +!! unit sphere, return the stereographically equivalent complex number. +!! +!! @param[in] v cartesian 3-vector representation of point on Riemann sphere +!! @param[out] z complex point stereographically equivalent to v +!! @param[out] infz logical indicator for z being the point at infinity !! @author R. J. Purser subroutine ctoz(v, z,infz)! [ctoz] use pietc, only: u0,u1 @@ -1989,11 +2042,12 @@ subroutine ctoz(v, z,infz)! [ctoz] z=z*zzpi end subroutine ctoz -!> ??? +!> Given a complex z, return the equivalent cartesian unit 3-vector +!! associated by the polar stereographic projection !! -!! @param[in] z ??? -!! @param[in] infz ??? -!! @param[in] v ??? +!! @param[in] z complex input argument +!! @param[in] infz logical indicator for z being the point at infinity +!! @param[out] v cartesian unit 3-vector position equivalent to z !! @author R. J. Purser subroutine ztoc(z,infz, v)! [ztoc] implicit none @@ -2020,10 +2074,10 @@ end subroutine ztoc !! @note The derivative for the ideal point at infinity has not been !! coded yet. !! -!! @param[in] z complex infinitesimal map displacement -!! @param[in] infz ??? -!! @param[out] v cartesian vector position -!! @param[out] vd ??? +!! @param[in] z complex input argument +!! @param[in] infz logical indicator for z being the point at infinity +!! @param[out] v cartesian unit 3-vector position equivalent to z +!! @param[out] vd derivative of cartesian v wrt z !! @author R. J. Purser subroutine ztocd(z,infz, v,vd)! [ztoc] implicit none @@ -2057,13 +2111,13 @@ end subroutine ztocd !! that takes cartesian point, xc0 to the north pole, xc1 to (lat=0,lon=0), !! xc2 to the south pole (=complex infinity). !! -!! @param[in] xc0 cartesian point -!! @param[in] xc1 cartesian point -!! @param[in] xc2 cartesian point -!! @param[out] aa Mobius transformation complex coefficients -!! @param[out] bb Mobius transformation complex coefficients -!! @param[out] cc Mobius transformation complex coefficients -!! @param[out] dd Mobius transformation complex coefficients +!! @param[in] xc0 cartesian point that will map to (0,0,1) +!! @param[in] xc1 cartesian point that will map to (1,0,0) +!! @param[in] xc2 cartesian point that will map to (0,0,-1) +!! @param[out] aa Mobius transformation complex coefficient +!! @param[out] bb Mobius transformation complex coefficient +!! @param[out] cc Mobius transformation complex coefficient +!! @param[out] dd Mobius transformation complex coefficient !! @author R. J. Purser subroutine setmobius(xc0,xc1,xc2, aa,bb,cc,dd)! [setmobius] implicit none @@ -2137,16 +2191,16 @@ end subroutine setmobius !! with the logical codes "infzn" that are TRUE if that point is itself !! the projection pole (i.e., the South Pole for a north polar stereographic). !! -!! @param[in] z0 polar stereographic point -!! @param[in] infz0 point at infinity z0 -!! @param[in] z1 polar stereographic point -!! @param[in] infz1 point at infinity z0 -!! @param[in] z2 polar stereographic point -!! @param[in] infz2 point at infinity z0 -!! @param[out] aa Mobius transformation complex coefficients -!! @param[out] bb Mobius transformation complex coefficients -!! @param[out] cc Mobius transformation complex coefficients -!! @param[out] dd Mobius transformation complex coefficients +!! @param[in] z0 complex input point that will map to (0,0) +!! @param[in] infz0 logical indicator that z0 is the point at infinity +!! @param[in] z1 complex input point that will map to (1,0) +!! @param[in] infz1 logical indicator that z1 is the point at infinity +!! @param[in] z2 complex input point that will map to infinity +!! @param[in] infz2 logical indicator that z2 is the point at infinity +!! @param[out] aa Mobius transformation complex coefficient +!! @param[out] bb Mobius transformation complex coefficient +!! @param[out] cc Mobius transformation complex coefficient +!! @param[out] dd Mobius transformation complex coefficient !! @author R. J. Purser subroutine zsetmobius(z0,infz0, z1,infz1, z2,infz2, aa,bb,cc,dd) implicit none @@ -2210,14 +2264,14 @@ end subroutine zsetmobius !! Infz is .TRUE. only when z is at complex infinity; likewise infw and w. !! For these infinite cases, it is important that numerical z==(0,0). !! -!! @param[in] aa Mobius transformation complex coefficients -!! @param[in] bb Mobius transformation complex coefficients -!! @param[in] cc Mobius transformation complex coefficients -!! @param[in] dd Mobius transformation complex coefficients -!! @param[in] z Mobius transformation complex coefficients -!! @param[in] infz point at infinity z -!! @param[out] w Mobius transformation output -!! @param[out] infw point at infinity w +!! @param[in] aa Mobius transformation complex coefficient +!! @param[in] bb Mobius transformation complex coefficient +!! @param[in] cc Mobius transformation complex coefficient +!! @param[in] dd Mobius transformation complex coefficient +!! @param[in] z complex input argument of the Mobius transformation +!! @param[in] infz logical indicator for z being a point at infinity +!! @param[out] w complex output of the Mobius transformation +!! @param[out] infw logical indicator for w being a point at infinity !! @author R. J. Purser subroutine zmobius(aa,bb,cc,dd, z,infz, w,infw)! [mobius] implicit none @@ -2247,12 +2301,12 @@ end subroutine zmobius !> Perform a complex Mobius transformation from cartesian vz to cartesian vw !! where the transformation coefficients are the standard aa,bb,cc,dd. !! -!! @param[in] aa Mobius transformation coefficients -!! @param[in] bb Mobius transformation coefficients -!! @param[in] cc Mobius transformation coefficients -!! @param[in] dd Mobius transformation coefficients -!! @param[in] vz Cartesian vaule -!! @param[out] vw Cartesian vaule +!! @param[in] aa Mobius transformation coefficient +!! @param[in] bb Mobius transformation coefficient +!! @param[in] cc Mobius transformation coefficient +!! @param[in] dd Mobius transformation coefficient +!! @param[in] vz Cartesian unit 3-vector representation of input argument +!! @param[out] vw Cartesian unit 3-vector representation of output !! @author R. J. Purser subroutine cmobius(aa,bb,cc,dd, vz,vw)! [mobius] implicit none @@ -2269,14 +2323,14 @@ end subroutine cmobius !> Perform the inverse of the mobius transformation with coefficients, !! {aa,bb,cc,dd}. !! -!! @param[in] aa Mobius transformation coefficients -!! @param[in] bb Mobius transformation coefficients -!! @param[in] cc Mobius transformation coefficients -!! @param[in] dd Mobius transformation coefficients -!! @param[out] zz ??? -!! @param[out] infz ??? -!! @param[out] zw Inversed output -!! @param[out] infw ??? +!! @param[in] aa inverse Mobius transformation coefficient +!! @param[in] bb inverse Mobius transformation coefficient +!! @param[in] cc inverse Mobius transformation coefficient +!! @param[in] dd inverse Mobius transformation coefficient +!! @param[in] zz complex input argument +!! @param[in] infz logical indicator for zz the point at infinity +!! @param[out] zw complex output argument +!! @param[out] infw logical indicator for zw the point at infinity !! @author R. J. Purser subroutine zmobiusi(aa,bb,cc,dd, zz,infz, zw,infw) ! [mobiusi] implicit none diff --git a/tests/chres_cube/CMakeLists.txt b/tests/chres_cube/CMakeLists.txt index 0d3232d68..893b0e914 100644 --- a/tests/chres_cube/CMakeLists.txt +++ b/tests/chres_cube/CMakeLists.txt @@ -3,6 +3,9 @@ # # George Gayno, Lin Gan, Ed Hartnett +# Include cmake to allow parallel I/O tests. +include (LibMPI) + if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -convert big_endian -assume byterecl") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") @@ -51,7 +54,6 @@ add_executable(ftst_program_setup "${CMAKE_SOURCE_DIR}/sorc/chgres_cube.fd/input "${CMAKE_SOURCE_DIR}/sorc/chgres_cube.fd/search_util.F90" "${CMAKE_SOURCE_DIR}/sorc/chgres_cube.fd/utils.F90" ftst_program_setup.F90) -add_test(NAME ftst_program_setup COMMAND ftst_program_setup) target_link_libraries( ftst_program_setup nemsio::nemsio @@ -69,5 +71,10 @@ if(OpenMP_Fortran_FOUND) target_link_libraries(ftst_program_setup OpenMP::OpenMP_Fortran) endif() +# Cause test to be run with MPI. +add_mpi_test(ftst_program_setup + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_program_setup + NUMPROCS 4 + TIMEOUT 60) diff --git a/tests/chres_cube/ftst_program_setup.F90 b/tests/chres_cube/ftst_program_setup.F90 index ddb6064ae..759324a38 100644 --- a/tests/chres_cube/ftst_program_setup.F90 +++ b/tests/chres_cube/ftst_program_setup.F90 @@ -3,15 +3,21 @@ ! Ed Hartnett 2/16/21 program ftst_program_setup + use mpi use esmf use netcdf use program_setup implicit none integer :: is + integer :: my_rank, nprocs + integer :: ierr - print*, "Starting test of program_setup." + call mpi_init(ierr) + call MPI_Comm_rank(MPI_COMM_WORLD, my_rank, ierr) + call MPI_Comm_size(MPI_COMM_WORLD, nprocs, ierr) - print*, "testing read_setup_namelist with file fort.41..." + if (my_rank .eq. 0) print*, "Starting test of program_setup." + if (my_rank .eq. 0) print*, "testing read_setup_namelist with file fort.41..." call read_setup_namelist() if (cycle_mon .ne. 7 .or. cycle_day .ne. 4 .or. cycle_hour .ne. 12) stop 4 if (.not. convert_atm .or. .not. convert_sfc .or. .not. convert_nst) stop 5 @@ -43,9 +49,9 @@ program ftst_program_setup tracers(is) = "NULL" tracers_input(is) = "NULL" enddo - print*, "OK" + if (my_rank .eq. 0) print*, "OK" - print*, "testing read_setup_namelist with config_fv3_tiled..." + if (my_rank .eq. 0) print*, "testing read_setup_namelist with config_fv3_tiled..." call read_setup_namelist("config_fv3_tiled.nml") if (cycle_mon .ne. 10 .or. cycle_day .ne. 3 .or. cycle_hour .ne. 0) stop 34 if (.not. convert_atm .or. .not. convert_sfc .or. .not. convert_nst) stop 35 @@ -73,14 +79,14 @@ program ftst_program_setup tracers(is) = "NULL" tracers_input(is) = "NULL" enddo - print*, "OK" + if (my_rank .eq. 0) print*, "OK" ! Reading this namelist fails for some reason. ! print*, "testing read_setup_namelist with config_fv3_tiled_warm_restart..." ! call read_setup_namelist("config_fv3_tiled_warm_restart.nml") ! print*, "OK" - print*, "testing read_setup_namelist with config_gaussian_nemsio..." + if (my_rank .eq. 0) print*, "testing read_setup_namelist with config_gaussian_nemsio..." call read_setup_namelist("config_gaussian_nemsio.nml") if (cycle_mon .ne. 7 .or. cycle_day .ne. 4 .or. cycle_hour .ne. 12) stop 74 if (.not. convert_atm .or. .not. convert_sfc .or. .not. convert_nst) stop 75 @@ -98,7 +104,6 @@ program ftst_program_setup if (atm_weight_file .ne. "NULL") stop 88 if (trim(input_type) .ne. "gaussian_nemsio") stop 89 if (trim(external_model) .ne. "GFS") stop 90 - print *,num_tracers if (num_tracers .ne. 7) stop 21 if (tracers(1) .ne. "sphum" .or. tracers(2) .ne. "liq_wat" .or. tracers(3) .ne. "o3mr" .or. & tracers(4) .ne. "ice_wat" .or. tracers(5) .ne. "rainwat" .or. tracers(6) .ne. "snowwat" .or. & @@ -113,9 +118,9 @@ program ftst_program_setup tracers(is) = "NULL" tracers_input(is) = "NULL" enddo - print*, "OK" + if (my_rank .eq. 0) print*, "OK" - print*, "testing read_setup_namelist with config_spectral_sigio..." + if (my_rank .eq. 0) print*, "testing read_setup_namelist with config_spectral_sigio..." call read_setup_namelist("config_spectral_sigio.nml") if (cycle_mon .ne. 7 .or. cycle_day .ne. 17 .or. cycle_hour .ne. 0) stop 114 if (.not. convert_atm .or. .not. convert_sfc .or. convert_nst) stop 115 @@ -143,9 +148,9 @@ program ftst_program_setup tracers(is) = "NULL" tracers_input(is) = "NULL" enddo - print*, "OK" + if (my_rank .eq. 0) print*, "OK" - print*, "testing read_setup_namelist with config_gfs_grib2..." + if (my_rank .eq. 0) print*, "testing read_setup_namelist with config_gfs_grib2..." call read_setup_namelist("config_gfs_grib2.nml") if (cycle_mon .ne. 11 .or. cycle_day .ne. 4 .or. cycle_hour .ne. 0) stop 94 if (.not. convert_atm .or. .not. convert_sfc .or. convert_nst) stop 95 @@ -177,7 +182,9 @@ program ftst_program_setup tracers(is) = "NULL" tracers_input(is) = "NULL" enddo - print*, "OK" + if (my_rank .eq. 0) print*, "OK" - print*, "SUCCESS!" + if (my_rank .eq. 0) print*, "SUCCESS!" + + call mpi_finalize(ierr) end program ftst_program_setup diff --git a/util/sub_slurm b/util/sub_slurm deleted file mode 100755 index 97e70c9e2..000000000 --- a/util/sub_slurm +++ /dev/null @@ -1,144 +0,0 @@ -#!/bin/ksh -set -x -usage="\ -Usage: $0 [options] executable [args] - where the options are: - -a account account (default: none) - -b binding run smt binding or not (default:NO) - -d dirin initial directory (default: cwd) - -e envars copy comma-separated environment variables - -g group group name - -i append standard input to command file - -j jobname specify jobname (default: executable basename) - -m machine machine on which to run (default: current) - -n write command file to stdout rather than submitting it - -o output specify output file (default: jobname.out) - -p procs[/nodes[/ppreq] - number of MPI tasks and optional nodes or Bblocking and - ppreq option (N or S) (defaults: serial, Bunlimited, S) - -q queue[/qpreq] queue name and optional requirement, e.g. dev/P - (defaults: 1 if serial or dev if parallel and none) - (queue 3 or 4 is dev or prod with twice tasks over ip) - (options: P=parallel, B=bigmem, b=batch) - -r rmem[/rcpu] resources memory and cpus/task (default: '1024 mb', 1) - -t timew wall time limit in [[hh:]mm:]ss format (default: 900) - -u userid userid to run under (default: self) - -v verbose mode - -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or - Thh[mm] (full, incremental, today or tomorrow) format - (default: now) -Function: This command submits a job to the batch queue." -subcmd="$*" -stdin=NO -nosub=NO -account="" -binding="NO" -dirin="" -envars="para" -group="" -jobname="" -machine="" -output="" -procs=0 -nodes="" -ppreq="N" -queue="" -qpreq="" -rmem="1200" -rcpu="1" -timew="900" -userid="" -verbose=NO -when="" -while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do - case $opt in - a) account="$OPTARG";; - b) binding="$OPTARG";; - d) dirin="$OPTARG";; - e) envars="$OPTARG";; - g) group="$OPTARG";; - i) stdin=YES;; - j) jobname=$OPTARG;; - m) machine="$OPTARG";; - n) nosub=YES;; - o) output=$OPTARG;; - p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; - q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; - r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);; - t) timew=$OPTARG;; - u) userid=$OPTARG;; - v) verbose=YES;; - w) when=$OPTARG;; - \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; - esac -done -shift $(($OPTIND-1)) -if [[ $# -eq 0 ]];then - echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 -fi -exec=$1 -if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then - exec=$(which $exec) -fi -shift -args="$*" -bn=$(basename $exec) -jobname=${jobname:-$bn} -output=${output:-$jobname.out} -myuser=$LOGNAME -myhost=$(hostname) - -DATA=${DATA:-/scratch4/NCEPDEV/stmp4/$LOGNAME/sub} -mkdir -p $DATA - -partition=${partition:-service} -queue=${queue:-batch} -timew=${timew:-01:20:00} -task_node=${procs:-12} -ntasks=$((nodes*task_node)) -envars=$envars - -#export TZ=GMT -export TZ="America/New_York" -cfile=$DATA/sub$$ -> $cfile -echo "#!/bin/ksh " >> $cfile -echo "#SBATCH -A $account" >> $cfile -echo "#SBATCH -o $output" >> $cfile -echo "#SBATCH -e $output" >> $cfile -echo "#SBATCH -J $jobname" >> $cfile -echo "#SBATCH -q $queue" >> $cfile -echo "#SBATCH -p $partition" >> $cfile -##echo "#SBATCH -v $envars" >> $cfile -echo "#SBATCH --nodes=$nodes --ntasks=$ntasks" >> $cfile -echo "#SBATCH -t $timew" >> $cfile -echo "/bin/ksh --login -x $exec $args" >> $cfile - -if [[ $stdin = YES ]];then - cat -fi >>$cfile -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi - -sbatch=${sbatch:-/apps/slurm/default/bin/sbatch} - -ofile=$DATA/subout$$ ->$ofile -chmod 777 $ofile -$sbatch $cfile >$ofile -rc=$? -cat $ofile -if [[ -w $SUBLOG ]];then - jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) -# date -u +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG - date +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG -fi -#exit -#rm $cfile $ofile -[[ $MKDATA = YES ]] && rmdir $DATA -exit $rc diff --git a/util/sub_wcoss_c b/util/sub_wcoss_c deleted file mode 100755 index 7bfaeeab7..000000000 --- a/util/sub_wcoss_c +++ /dev/null @@ -1,277 +0,0 @@ -#!/bin/ksh -set -x -# -# May 28, 2013 - Shrinivas Moorthi :now updated for lsf9.1.1 - should handle coupled case also -# -usage="\ -Usage: $0 [options] executable [args] - where the options are: - -a account account (default: none) - -b binding run smt binding or not (default:NO) - -d dirin initial directory (default: cwd) - -e envars copy comma-separated environment variables - -g group group name - -i append standard input to command file - -j jobname specify jobname (default: executable basename) -# -m machine machine on which to run (default: current) - -m mpiver mpi version (poe or intelmpi) (default: poe) - -n write command file to stdout rather than submitting it - -o output specify output file (default: jobname.out) - -p procs[/nodes[/ppreq] - number of MPI tasks and optional nodes or Bblocking and - ppreq option (N or S) (defaults: serial, Bunlimited, S) - -q queue[/qpreq] queue name and optional requirement, e.g. dev/P - (defaults: 1 if serial or dev if parallel and none) - (queue 3 or 4 is dev or prod with twice tasks over ip) - (options: P=parallel, B=bigmem, b=batch) - -r rmem[/rcpu[/pe_node] resources memory and cpus/task and cores per node (default: '1024 mb', 1, and 16) - -t timew wall time limit in [[hh:]mm:]ss format (default: 900) - -u userid userid to run under (default: self) - -v verbose mode - -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or - Thh[mm] (full, incremental, today or tomorrow) format - (default: now) - - You can also export variables and - \"INHERIT_ENV\" (default:-\"YES\") - Set this variable to \"NO\" and - export it if you do not want the next job to inherit current job - environment. - - Other environmental variables which can be exported from outside are: - - \"KMP_STACKSIZE\" (default:-\"1024m\") - \"MP_EUIDEVELOP\" (default:-\"NULL\") - \"F_UFMTENDIAN\" (default:-\"NULL\") - \"MPICH_ALLTOALL_THROTTLE\" (default:-\"NULL\") - \"MP_SINGLE_THREAD\" (default:-\"NULL\") - \"MP_EAGER_LIMIT\" (default:-\"NULL\") - \"MP_USE_BULK_XFER\" (default:-\"NULL\") - \"MP_COLLECTIVE_OFFLOAD\" (default:-\"NULL\") - \"MP_SHARED_MEMORY\" (default:-\"NULL\") - \"MP_MPILIB\" (default:-\"NULL\") - \"MP_LABELIO\" (default:-\"NULL\") - \"MP_STDOUTMODE\" (default:-\"NULL\") - \"DATA\" (default:-\"/stmp/$LOGNAME/sub\" - - deleted at the end if created) - -Function: This command submits a job to the batch queue." -subcmd="$*" -stdin=NO -nosub=NO -account="" -binding="NO" -dirin="" -envars="" -group="" -jobname="" -#machine="" -mpiver="" -output="" -procs=0 -nodes="" -ppreq="NONE" -queue="" -qpreq="" -rmem="1024" -rcpu="1" -pe_node=${pe_node:-16} -timew="900" -userid="" -verbose=NO -when="" -while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do - case $opt in - a) account="$OPTARG";; - b) binding="$OPTARG";; - d) dirin="$OPTARG";; - e) envars="$OPTARG";; - g) group="$OPTARG";; - i) stdin=YES;; - j) jobname=$OPTARG;; -# m) machine="$OPTARG";; - m) mpiver="$OPTARG";; - n) nosub=YES;; - o) output=$OPTARG;; - p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; - q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; - r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);pe_node=$(echo $OPTARG/|cut -d/ -f3);; - t) timew=$OPTARG;; - u) userid=$OPTARG;; - v) verbose=YES;; - w) when=$OPTARG;; - \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; - esac -done -shift $(($OPTIND-1)) -if [[ $# -eq 0 ]];then - echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 -fi -exec=$1 -if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then - exec=$(which $exec) -fi -shift -args="$*" -bn=$(basename $exec) -jobname=${jobname:-$bn} -#machine=${machine:-""} -output=${output:-$jobname.out} -myuser=$LOGNAME -myhost=$(hostname) -#mpiver=${mpiver:-poe} -envars=$envars - -#DATA=/lustre/fs/scratch/$LOGNAME/stmp -NDATE=${NDATE:-/gpfs/hps/nco/ops/nwprod/prod_util.v1.0.5/exec/ndate} -pext=${pext:-""} -#PTMP=${PREPTMP:-""}/ptmp${pext:-""} -PTMP=${PTMP:-/gpfs/hps/ptmp} -DATA=${DATA:-$PTMP/$LOGNAME/sub} -if [ -s $DATA ] ; then - MKDATA=NO -else - mkdir -p $DATA - MKDATA=YES -fi -dirin=${dirin:-$(pwd)} - -queue=${queue:-dev} -timew=${timew:-01:20} -timew=$(echo $timew |cut -d: -f1):$(echo $timew |cut -d: -f2) -threads=${rcpu:-1} -nthreads=$threads - - -max_core=${max_core:-24} -task_node=${pe_node:-${task_node:-$max_core}} - -export INHERIT_ENV=${INHERIT_ENV:-YES} -if [ $nodes -eq 1 ] ; then - task_node=$procs -fi -tot_size=$procs -max_tasks=$((max_core*nodes)) -#tot_size=$procs -if [ $((task_node*threads)) -gt $max_core ]; then - core_typ=cpu - nthreads=$threads - threads=$((2*max_core/task_node)) - echo "Hyper-threading is used - setting core_typ=$corei_typ" -fi -export core_typ=${core_typ:-core} - -export OMP_STACKSIZE=${OMP_STACKSIZE:-1024m} -export KMP_AFFINITY=${KMP_AFFINITY:-disabled} - -export TZ=GMT -cfile=$DATA/sub$$ -> $cfile - -if [ $INHERIT_ENV = YES ] ; then - echo "#!/bin/ksh" >> $cfile -else - echo "#!/bin/sh --login" >> $cfile - echo "#BSUB -L /bin/sh" >> $cfile -fi -echo "#BSUB -P $account" >> $cfile -echo "#BSUB -e $output" >> $cfile -echo "#BSUB -o $output" >> $cfile -echo "#BSUB -J $jobname" >> $cfile -#echo "#BSUB -network type=sn_all:mode=US" >> $cfile -echo "#BSUB -q $queue" >> $cfile -echo "#BSUB -W $timew" >> $cfile -##echo "#BSUB -cwd $dirin" >> $cfile -#echo "#BSUB -n $tot_size" >> $cfile -if [ $queue = dev_transfer ] ; then - echo "#BSUB -R rusage[mem=$rmem]" >> $cfile -fi -if [ $queue != dev_transfer ] ; then - echo "#BSUB -M $rmem" >> $cfile - echo "#BSUB -extsched 'CRAYLINUX[]' -R '1*{select[craylinux && !vnode]} + $max_tasks*{select[craylinux && vnode]span[ptile=24] cu[type=cabinet]}'" >> $cfile -fi - -if [[ -n $when ]];then - whena=$when - if [[ $when = +* ]];then - hr=$(echo $when|cut -c2-3) - mn=$(echo $when|cut -c4-5) - [[ -n $mn ]] || mn=00 - now=$(date -u +"%Y%m%d%H%M") - ((mn+=$(echo $now|cut -c11-12))) - [[ $mn -ge 60 ]] && ((hr+=1)) && ((mn-=60)) - [[ $mn -lt 10 ]] && mn=0$mn - whena=$($NDATE +$hr $(echo $now|cut -c1-10))$mn - elif [[ $when = t* ]];then - hr=$(echo $when|cut -c2-3) - mn=$(echo $when|cut -c4-5) - [[ -n $mn ]] || mn=00 - now=$(date -u +"%Y%m%d") - whena=$now$hr$mn - elif [[ $when = T* ]];then - hr=$(echo $when|cut -c2-3) - mn=$(echo $when|cut -c4-5) - [[ -n $mn ]] || mn=00 - now=$(date -u +"%Y%m%d%H") - whena=$($NDATE +24 $now|cut -c1-8)$hr$mn - fi - yr=$(echo $whena|cut -c1-4) - mo=$(echo $whena|cut -c5-6) - dy=$(echo $whena|cut -c7-8) - hr=$(echo $whena|cut -c9-10) - mn=$(echo $whena|cut -c11-12) - [[ -n $mn ]] || mn=00 - echo "#BSUB -b $yr:$mo:$dy:$hr:$mn" >> $cfile -fi - -#echo "source ~${LOGNAME}/.profile" >> $cfile -#echo "ulimit -s unlimited" >> $cfile -#if [ ${MP_EUIDEVICE:-NULL} = sn_all ] ; then -#echo "#BSUB -network \"type=sn_all:mode=US\" " >> $cfile -#fi -#if [ ${MP_EULIB:-NULL} != NULL ] ; then -#echo "export MP_EUILIB=$MP_EUILIB" >> $cfile -#fi - -if [ ${KMP_AFFINITY:-NULL} != NULL ] ; then - echo "export KMP_AFFINITY=$KMP_AFFINITY" >> $cfile -fi - -echo "export OMP_STACKSIZE=$OMP_STACKSIZE" >> $cfile - -if [ ${MP_LABELIO:-NULL} != NULL ] ; then - echo "export MP_LABELIO=$MP_LABELIO" >> $cfile -fi -if [ ${MP_STDOUTMODE:-NULL} != NULL ] ; then - echo "export MP_STDOUTMODE=$MP_STDOUTMODE " >> $cfile -fi -for var in $(eval echo $envars | tr , ' ') ; do - echo "export $var" >> $cfile -done -echo "$exec" >> $cfile -echo "export OMP_NUM_THREADS=$nthreads" >> $cfile - -if [[ $stdin = YES ]];then - cat -fi >>$cfile -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi -bsub=${bsub:-$LSF_BINDIR/bsub} - -ofile=$DATA/subout$$ ->$ofile -chmod 777 $ofile -$bsub < $cfile -rc=$? -cat $ofile -if [[ -w $SUBLOG ]];then - jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) - date +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG -fi -#rm $cfile $ofile -#[[ $MKDATA = YES ]] && rmdir $DATA -exit $rc diff --git a/util/sub_wcoss_d b/util/sub_wcoss_d deleted file mode 100755 index 77f0e4da8..000000000 --- a/util/sub_wcoss_d +++ /dev/null @@ -1,247 +0,0 @@ -#!/bin/ksh -set -x -# -# May 28, 2013 - Shrinivas Moorthi :now updated for lsf9.1.1 - should handle coupled case also -# -usage="\ -Usage: $0 [options] executable [args] - where the options are: - -a account account (default: none) - -b binding run smt binding or not (default:NO) - -d dirin initial directory (default: cwd) - -e envars copy comma-separated environment variables - -g group group name - -i append standard input to command file - -j jobname specify jobname (default: executable basename) -# -m machine machine on which to run (default: current) - -m mpiver mpi version (poe or intelmpi) (default: poe) - -n write command file to stdout rather than submitting it - -o output specify output file (default: jobname.out) - -p procs[/nodes[/ppreq] - number of MPI tasks and optional nodes or Bblocking and - ppreq option (N or S) (defaults: serial, Bunlimited, S) - -q queue[/qpreq] queue name and optional requirement, e.g. dev/P - (defaults: 1 if serial or dev if parallel and none) - (queue 3 or 4 is dev or prod with twice tasks over ip) - (options: P=parallel, B=bigmem, b=batch) - -r rmem[/rcpu[/pe_node] resources memory and cpus/task and cores per node (default: '1024 mb', 1, and 16) - -t timew wall time limit in [[hh:]mm:]ss format (default: 900) - -u userid userid to run under (default: self) - -v verbose mode - -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or - Thh[mm] (full, incremental, today or tomorrow) format - (default: now) - - You can also export variables and - \"INHERIT_ENV\" (default:-\"YES\") - Set this variable to \"NO\" and - export it if you do not want the next job to inherit current job - environment. - - Other environmental variables which can be exported from outside are: - - \"KMP_STACKSIZE\" (default:-\"1024m\") - \"MP_EUIDEVELOP\" (default:-\"NULL\") - \"F_UFMTENDIAN\" (default:-\"NULL\") - \"MPICH_ALLTOALL_THROTTLE\" (default:-\"NULL\") - \"MP_SINGLE_THREAD\" (default:-\"NULL\") - \"MP_EAGER_LIMIT\" (default:-\"NULL\") - \"MP_USE_BULK_XFER\" (default:-\"NULL\") - \"MP_COLLECTIVE_OFFLOAD\" (default:-\"NULL\") - \"MP_SHARED_MEMORY\" (default:-\"NULL\") - \"MP_MPILIB\" (default:-\"NULL\") - \"MP_LABELIO\" (default:-\"NULL\") - \"MP_STDOUTMODE\" (default:-\"NULL\") - \"DATA\" (default:-\"/stmp/$LOGNAME/sub\" - - deleted at the end if created) - -Function: This command submits a job to the batch queue." -subcmd="$*" -stdin=NO -nosub=NO -account="" -binding="NO" -dirin="" -envars="" -group="" -jobname="" -#machine="" -mpiver="" -output="" -procs=0 -nodes="" -ppreq="NONE" -queue="" -qpreq="" -rmem="1024" -rcpu="1" -pe_node=${pe_node:-16} -timew="900" -userid="" -verbose=NO -when="" -while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do - case $opt in - a) account="$OPTARG";; - b) binding="$OPTARG";; - d) dirin="$OPTARG";; - e) envars="$OPTARG";; - g) group="$OPTARG";; - i) stdin=YES;; - j) jobname=$OPTARG;; - m) mpiver="$OPTARG";; - n) nosub=YES;; - o) output=$OPTARG;; - p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; - q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; - r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);pe_node=$(echo $OPTARG/|cut -d/ -f3);; - t) timew=$OPTARG;; - u) userid=$OPTARG;; - v) verbose=YES;; - w) when=$OPTARG;; - \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; - esac -done -shift $(($OPTIND-1)) -if [[ $# -eq 0 ]];then - echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 -fi -exec=$1 -if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then - exec=$(which $exec) -fi -shift -args="$*" -bn=$(basename $exec) -jobname=${jobname:-$bn} -#machine=${machine:-""} -output=${output:-$jobname.out} -myuser=$LOGNAME -myhost=$(hostname) -envars=$envars - -#DATA=/lustre/fs/scratch/$LOGNAME/stmp -NDATE=${NDATE:-/gpfs/hps/nco/ops/nwprod/prod_util.v1.0.5/exec/ndate} -pext=${pext:-""} -PTMP=/gpfs/dell2/ptmp -DATA=${DATA:-$PTMP/$LOGNAME/sub} -if [ -s $DATA ] ; then - MKDATA=NO -else - mkdir -p $DATA - MKDATA=YES -fi -dirin=${dirin:-$(pwd)} - -queue=${queue:-dev} -timew=${timew:-01:20} -timew=$(echo $timew |cut -d: -f1):$(echo $timew |cut -d: -f2) -threads=${rcpu:-1} -nthreads=$threads - -max_core=${max_core:-28} -task_node=${pe_node:-${task_node:-$max_core}} - -export INHERIT_ENV=${INHERIT_ENV:-YES} -if [ $nodes -eq 1 ] ; then - task_node=$procs -fi -tot_size=$procs -max_tasks=$((max_core*nodes)) -if [ $((task_node*threads)) -gt $max_core ]; then - core_typ=cpu - nthreads=$threads - threads=$((2*max_core/task_node)) - echo "Hyper-threading is used - setting core_typ=$corei_typ" -fi -core_typ=${core_typ:-core} - -export OMP_STACKSIZE=${OMP_STACKSIZE:-1024m} -export KMP_AFFINITY=${KMP_AFFINITY:-disabled} - -export TZ=GMT -cfile=$DATA/sub$$ -> $cfile - -echo "#!/bin/bash" >> $cfile -echo "#BSUB -P $account" >> $cfile -echo "#BSUB -e $output" >> $cfile -echo "#BSUB -o $output" >> $cfile -echo "#BSUB -J $jobname" >> $cfile -echo "#BSUB -q $queue" >> $cfile -echo "#BSUB -W $timew" >> $cfile -echo "#BSUB -n $tot_size" >> $cfile -echo "#BSUB -R span[ptile=$task_node]" >> $cfile -echo "#BSUB -R affinity[core($nthreads)]" >> $cfile -echo "#BSUB -M $rmem" >> $cfile - - -if [[ -n $when ]];then - whena=$when - if [[ $when = +* ]];then - hr=$(echo $when|cut -c2-3) - mn=$(echo $when|cut -c4-5) - [[ -n $mn ]] || mn=00 - now=$(date -u +"%Y%m%d%H%M") - ((mn+=$(echo $now|cut -c11-12))) - [[ $mn -ge 60 ]] && ((hr+=1)) && ((mn-=60)) - [[ $mn -lt 10 ]] && mn=0$mn - whena=$($NDATE +$hr $(echo $now|cut -c1-10))$mn - elif [[ $when = t* ]];then - hr=$(echo $when|cut -c2-3) - mn=$(echo $when|cut -c4-5) - [[ -n $mn ]] || mn=00 - now=$(date -u +"%Y%m%d") - whena=$now$hr$mn - elif [[ $when = T* ]];then - hr=$(echo $when|cut -c2-3) - mn=$(echo $when|cut -c4-5) - [[ -n $mn ]] || mn=00 - now=$(date -u +"%Y%m%d%H") - whena=$($NDATE +24 $now|cut -c1-8)$hr$mn - fi - yr=$(echo $whena|cut -c1-4) - mo=$(echo $whena|cut -c5-6) - dy=$(echo $whena|cut -c7-8) - hr=$(echo $whena|cut -c9-10) - mn=$(echo $whena|cut -c11-12) - [[ -n $mn ]] || mn=00 - echo "#BSUB -b $yr:$mo:$dy:$hr:$mn" >> $cfile -fi - -if [ ${KMP_AFFINITY:-NULL} != NULL ] ; then - echo "export KMP_AFFINITY=$KMP_AFFINITY" >> $cfile -fi -echo "export OMP_STACKSIZE=$OMP_STACKSIZE" >> $cfile - - -for var in $(eval echo $envars | tr , ' ') ; do - echo "export $var" >> $cfile -done -echo "$exec" >> $cfile -echo "export OMP_NUM_THREADS=$nthreads" >> $cfile - -if [[ $stdin = YES ]];then - cat -fi >>$cfile -if [[ $nosub = YES ]];then - cat $cfile - exit -elif [[ $verbose = YES ]];then - set -x - cat $cfile -fi -bsub=${bsub:-$LSF_BINDIR/bsub} - -ofile=$DATA/subout$$ ->$ofile -chmod 777 $ofile -$bsub < $cfile -rc=$? -cat $ofile -if [[ -w $SUBLOG ]];then - jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) - date +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG -fi -##rm $cfile $ofile -#[[ $MKDATA = YES ]] && rmdir $DATA -exit $rc