diff --git a/.github/workflows/cmake.yml b/.github/workflows/cmake.yml index 81141b97..88e1fdd7 100644 --- a/.github/workflows/cmake.yml +++ b/.github/workflows/cmake.yml @@ -2,9 +2,9 @@ name: CMake on: push: - branches: [ "main" ] + branches: [ "main", "dev" ] pull_request: - branches: [ "main" ] + branches: [ "main", "dev" ] env: # Customize the CMake build type here (Release, Debug, RelWithDebInfo, etc.) diff --git a/BLAS/DGEMM.f b/BLAS/DGEMM.f index 6c6d8508..4f4af89e 100644 --- a/BLAS/DGEMM.f +++ b/BLAS/DGEMM.f @@ -3,11 +3,10 @@ SUBROUTINE DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, $ BETA, C, LDC ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE OUTA_HERE_Interface diff --git a/BLAS/DGEMV.f b/BLAS/DGEMV.f index 44294296..9da670dd 100644 --- a/BLAS/DGEMV.f +++ b/BLAS/DGEMV.f @@ -4,11 +4,10 @@ SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, $ BETA, Y, INCY ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE OUTA_HERE_Interface diff --git a/BLAS/DLAMCH.f b/BLAS/DLAMCH.f index b05ddda5..07d9778e 100644 --- a/BLAS/DLAMCH.f +++ b/BLAS/DLAMCH.f @@ -3,11 +3,10 @@ DOUBLE PRECISION FUNCTION DLAMCH( CMACH ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE OUTA_HERE_Interface diff --git a/BLAS/DLANST.f b/BLAS/DLANST.f index 3df185d3..c3fe41ae 100644 --- a/BLAS/DLANST.f +++ b/BLAS/DLANST.f @@ -3,11 +3,10 @@ DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE OUTA_HERE_Interface diff --git a/BLAS/DSCAL.f b/BLAS/DSCAL.f index 8921c100..b1baaaf4 100644 --- a/BLAS/DSCAL.f +++ b/BLAS/DSCAL.f @@ -3,11 +3,10 @@ SUBROUTINE DSCAL(N,DA,DX,INCX) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE OUTA_HERE_Interface diff --git a/BLAS/DSTEQR.f b/BLAS/DSTEQR.f index 1cf5b3dc..4bce899e 100644 --- a/BLAS/DSTEQR.f +++ b/BLAS/DSTEQR.f @@ -3,18 +3,12 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, - & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND + USE IOUNT1, ONLY : ERR, F06, SC1 + USE SCONTR, ONLY : FATAL_ERR USE LAPACK_BLAS_AUX USE OUTA_HERE_Interface - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LAPACK_BEGEND - - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: subr_name = 'DSTEQR' * * -- LAPACK routine (version 2.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., @@ -121,14 +115,6 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -522,14 +508,6 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * 190 CONTINUE -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DSTEQR diff --git a/BLAS/DSTERF.f b/BLAS/DSTERF.f index 09c02b76..35e1caba 100644 --- a/BLAS/DSTERF.f +++ b/BLAS/DSTERF.f @@ -3,20 +3,10 @@ SUBROUTINE DSTERF( N, D, E, INFO ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG - USE SCONTR, ONLY : BLNK_SUB_NAM - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, - & TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE LAPACK_LIN_EQN_DPB - USE OURTIM_Interface - - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LAPACK_BEGEND - - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: subr_name = 'DSTERF' * * -- LAPACK routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., @@ -86,14 +76,6 @@ SUBROUTINE DSTERF( N, D, E, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -386,14 +368,6 @@ SUBROUTINE DSTERF( N, D, E, INFO ) * 180 CONTINUE -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DSTERF diff --git a/BLAS/DSWAP.f b/BLAS/DSWAP.f index d342ee05..05803382 100644 --- a/BLAS/DSWAP.f +++ b/BLAS/DSWAP.f @@ -3,11 +3,10 @@ SUBROUTINE DSWAP (N,DX,INCX,DY,INCY) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE OUTA_HERE_Interface diff --git a/BLAS/DTRSM.f b/BLAS/DTRSM.f index ec1201aa..64d35ae9 100644 --- a/BLAS/DTRSM.f +++ b/BLAS/DTRSM.f @@ -4,11 +4,10 @@ SUBROUTINE DTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, $ B, LDB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE OUTA_HERE_Interface diff --git a/BLAS/DTRTRI.f b/BLAS/DTRTRI.f index 5c362ef4..94834410 100644 --- a/BLAS/DTRTRI.f +++ b/BLAS/DTRTRI.f @@ -3,17 +3,14 @@ SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE LAPACK_SYM_MAT_INV USE OURTIM_Interface - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LAPACK_BEGEND * * -- LAPACK routine (version 3.0) -- diff --git a/BLAS/ILAENV.f b/BLAS/ILAENV.f index 76c6958b..5bf60286 100644 --- a/BLAS/ILAENV.f +++ b/BLAS/ILAENV.f @@ -4,11 +4,10 @@ INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, $ N4 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE OUTA_HERE_Interface diff --git a/BLAS/XERBLA.f b/BLAS/XERBLA.f index a9c237da..98ac88d8 100644 --- a/BLAS/XERBLA.f +++ b/BLAS/XERBLA.f @@ -3,11 +3,10 @@ SUBROUTINE XERBLA( SRNAME, arg_num ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE OUTA_HERE_Interface diff --git a/CMakeLists.txt b/CMakeLists.txt index 5ad10e65..c52d5244 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -233,11 +233,13 @@ endif() # collect all fortran source files file(GLOB_RECURSE ALL_FORTRAN_FILES "${CMAKE_SOURCE_DIR}/*.f" + "${CMAKE_SOURCE_DIR}/*.F" "${CMAKE_SOURCE_DIR}/*.f90" "${CMAKE_SOURCE_DIR}/*.F90" - "${CMAKE_SOURCE_DIR}/*.F" - "${CMAKE_SOURCE_DIR}/*.F95" "${CMAKE_SOURCE_DIR}/*.f95" + "${CMAKE_SOURCE_DIR}/*.F95" + "${CMAKE_SOURCE_DIR}/*.f03" + "${CMAKE_SOURCE_DIR}/*.F03" ) # same BLAS-finding subroutine as SuperLU @@ -355,7 +357,7 @@ if(CMAKE_COMPILER_IS_GNUCC) set(CMAKE_CXX_FLAGS_DETERMINISTIC "${CMAKE_C_FLAGS_DETERMINISTIC}" ) - set(CMAKE_PROFILING_FLAGS "-O2 -g -fno-omit-frame-pointer -fno-inline-functions") + set(CMAKE_PROFILING_FLAGS "-O2 -g -fno-inline -fno-omit-frame-pointer -fno-inline-functions") set(CMAKE_C_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") set(CMAKE_CXX_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") set(CMAKE_Fortran_FLAGS_PROFILING "${CMAKE_PROFILING_FLAGS}") diff --git a/Source/ARPACK/ARPACK_INFO_MSG.f90 b/Source/ARPACK/ARPACK_INFO_MSG.f90 index 56162d65..950fc07c 100644 --- a/Source/ARPACK/ARPACK_INFO_MSG.f90 +++ b/Source/ARPACK/ARPACK_INFO_MSG.f90 @@ -28,7 +28,7 @@ SUBROUTINE ARPACK_INFO_MSG ( SUBNAME, INFO, IPARAM, LWORKL, NEV, NCV ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : PROG_NAME, FATAL_ERR, NDOFL, WARN_ERR - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : DARPACK, SUPWARN USE MODEL_STUF, ONLY : EIG_N2 diff --git a/Source/EMG/EMG1/ELMDAT1.f90 b/Source/EMG/EMG1/ELMDAT1.f90 index e0f43196..1d33f5d5 100644 --- a/Source/EMG/EMG1/ELMDAT1.f90 +++ b/Source/EMG/EMG1/ELMDAT1.f90 @@ -37,7 +37,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) ! OFFSETS : offsets for some elems USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, MEDAT0_CUSERIN, MELGP, MEMATC, MEMATR, MEPROP, METYPE, MOFFSET, MRMATLC, & MRPBAR, MRPBEAM, MRPBUSH, MRPELAS, MRPROD, MRPSHEAR, MRPUSER1, MPSOLID, BLNK_SUB_NAM, & NCORD, NGRID, SOL_NAME @@ -46,7 +46,6 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) DEDAT_Q8_THICK_KEY, DEDAT_Q8_POFFS_KEY USE PARAMS, ONLY : EPSIL, TSTM_DEF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMDAT_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONEPM4, ONE, TWO USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : AGRID, BAROFF, BUSH_CID, BUSH_OCID, BUSH_VVEC, BUSH_VVEC_OR_CID, BUSHOFF, BGRID, & @@ -93,7 +92,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG) :: NFLAG ! Row number in array DOFPIN INTEGER(LONG) :: NUM_COMPS ! No. displ components (1 for SPOINT, 6 for actual grid) INTEGER(LONG) :: NUMMAT ! No. matl properties for an element type - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMDAT_BEGEND + REAL(DOUBLE) :: DXI ! An offset distance in direction 1 REAL(DOUBLE) :: DYI ! An offset distance in direction 2 @@ -107,12 +106,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) INTRINSIC :: MOD, FLOOR -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -168,7 +162,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) ELDOF = 0 DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) ELDOF = ELDOF + NUM_COMPS ENDDO @@ -1006,7 +1000,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) DO I=1,2 ! If displ comps on CELAS1,2 entry were blank or 0, change to 1,2 ELAS_COMP(I) = EDAT(EPNTK+3+I) ! (i.e. ELAS has 2 components of displ) IF (ELAS_COMP(I) == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS > 1) THEN NUM_EMG_FATAL_ERRS = NUM_EMG_FATAL_ERRS + 1 FATAL_ERR = FATAL_ERR + 1 @@ -1058,12 +1052,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/ELMDAT2.f90 b/Source/EMG/EMG1/ELMDAT2.f90 index 71bd442f..eb04be2b 100644 --- a/Source/EMG/EMG1/ELMDAT2.f90 +++ b/Source/EMG/EMG1/ELMDAT2.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELMDAT2 ( INT_ELEM_ID, OPT, WRITE_WARN ) ! DT (1 elem temperatures) and PRESS (1 element pressure load) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, LPDAT, MPRESS, MDT, MTDAT_TEMPRB, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMDAT_BEGEND USE CONSTANTS_1, ONLY : ZERO, QUARTER, THIRD USE MODEL_STUF, ONLY : BGRID, DT, ELGP, ETYPE, GTEMP, PDATA, PPNT, PTYPE, PRESS, TDATA, TPNT, TYPE @@ -51,14 +50,9 @@ SUBROUTINE ELMDAT2 ( INT_ELEM_ID, OPT, WRITE_WARN ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IPPN ! A pointer into array PPNT INTEGER(LONG) :: ITPN ! A pointer into array TPNT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMDAT_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** TYPE = ETYPE(INT_ELEM_ID) @@ -189,12 +183,7 @@ SUBROUTINE ELMDAT2 ( INT_ELEM_ID, OPT, WRITE_WARN ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/ELMGM1.f90 b/Source/EMG/EMG1/ELMGM1.f90 index a289d400..327e7f5d 100644 --- a/Source/EMG/EMG1/ELMGM1.f90 +++ b/Source/EMG/EMG1/ELMGM1.f90 @@ -30,10 +30,9 @@ SUBROUTINE ELMGM1 ( INT_ELEM_ID, WRITE_WARN ) ! element stiffness matrix in the element system to the basic coordinate system. Calculates grid point coords in local coord system. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MELGP, MOFFSET, NCORD, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMGM1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL @@ -61,7 +60,7 @@ SUBROUTINE ELMGM1 ( INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG) :: ICID ! Internal coord sys no. corresponding to an actual coord sys no. INTEGER(LONG) :: ROWNUM ! A row number in an array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMGM1_BEGEND + REAL(DOUBLE) :: DX1(3) ! Array used in intermediate calc's REAL(DOUBLE) :: DX2(3) ! Array used in intermediate calc's @@ -78,12 +77,7 @@ SUBROUTINE ELMGM1 ( INT_ELEM_ID, WRITE_WARN ) REAL(DOUBLE) :: VZ(3) ! A vector in the elem z dir REAL(DOUBLE) :: V13(3) ! A vector from grid 1 to grid 3 (for BAR, BEAM or USER1 it is V vector) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME, TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -361,12 +355,7 @@ SUBROUTINE ELMGM1 ( INT_ELEM_ID, WRITE_WARN ) ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/ELMGM1_BUSH.f90 b/Source/EMG/EMG1/ELMGM1_BUSH.f90 index 2df5aaaf..e2fdd67e 100644 --- a/Source/EMG/EMG1/ELMGM1_BUSH.f90 +++ b/Source/EMG/EMG1/ELMGM1_BUSH.f90 @@ -30,10 +30,9 @@ SUBROUTINE ELMGM1_BUSH ( INT_ELEM_ID, WRITE_WARN ) ! element stiffness matrix in the element system to the basic coordinate system. Calculates grid point coords in local coord system. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MELGP, MOFFSET, NCORD, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMGM1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL @@ -62,7 +61,7 @@ SUBROUTINE ELMGM1_BUSH ( INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG) :: ICID ! Internal coord sys no. corresponding to an actual coord sys no. INTEGER(LONG) :: ROWNUM ! A row number in an array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMGM1_BEGEND + REAL(DOUBLE) :: DX1(3) ! Array used in intermediate calc's REAL(DOUBLE) :: DX2(3) ! Array used in intermediate calc's @@ -82,12 +81,7 @@ SUBROUTINE ELMGM1_BUSH ( INT_ELEM_ID, WRITE_WARN ) REAL(DOUBLE) :: V13(3) ! A vector from grid 1 to grid 3 (for BAR, BEAM or USER1 it is V vector) REAL(DOUBLE) :: XIB(2,3) ! Coords at ends of BUSH elem: XIB(1,J) should = XIB(2,J) for 0 len elem -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME, TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -584,12 +578,7 @@ SUBROUTINE ELMGM1_BUSH ( INT_ELEM_ID, WRITE_WARN ) CALL DEBUG_ELMGM1_FOR_BUSH ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/ELMGM2.f90 b/Source/EMG/EMG1/ELMGM2.f90 index 41eb0423..0e6ad833 100644 --- a/Source/EMG/EMG1/ELMGM2.f90 +++ b/Source/EMG/EMG1/ELMGM2.f90 @@ -34,10 +34,9 @@ SUBROUTINE ELMGM2 ( WRITE_WARN ) ! splits the angle between the diagonals. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, MEFE, MEWE, MELGP, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMGM2_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, TWO USE PARAMS, ONLY : EPSIL, QUADAXIS, SUPWARN, QUAD4TYP USE MODEL_STUF, ONLY : AGRID, BMEANT, EID, ELGP, EMG_IFE, EMG_IWE, EMG_RWE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS, & @@ -60,7 +59,7 @@ SUBROUTINE ELMGM2 ( WRITE_WARN ) INTEGER(LONG) :: IPNT ! An internal grid (1,2,3 or 4) of an elem INTEGER(LONG) :: SIDE_GRID1 ! Used for error output purposes INTEGER(LONG) :: SIDE_GRID2 ! Used for error output purposes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMGM2_BEGEND + REAL(DOUBLE) :: V12B(3) ! Vector from G.P. 1 to G.P. 2 in basic coords REAL(DOUBLE) :: V13B(3) ! Vector from G.P. 1 to G.P. 3 in basic coords (a diagonal) @@ -98,12 +97,7 @@ SUBROUTINE ELMGM2 ( WRITE_WARN ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -421,12 +415,7 @@ SUBROUTINE ELMGM2 ( WRITE_WARN ) CALL CALC_BMEANT ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/ELMGM3.f90 b/Source/EMG/EMG1/ELMGM3.f90 index 73f38cce..763439d7 100644 --- a/Source/EMG/EMG1/ELMGM3.f90 +++ b/Source/EMG/EMG1/ELMGM3.f90 @@ -30,10 +30,9 @@ SUBROUTINE ELMGM3 ( WRITE_WARN ) ! in the elem system to the basic coordinate system. Calculates grid point coords in local coord system. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE, MELGP USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMGM3_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, TWO USE PARAMS, ONLY : EPSIL, HEXAXIS USE MODEL_STUF, ONLY : EID, ELGP, EMG_IFE, ERR_SUB_NAM, HEXA_DELTA, HEXA_GAMMA, HEXA_THETA, & @@ -51,7 +50,7 @@ SUBROUTINE ELMGM3 ( WRITE_WARN ) INTEGER(LONG) :: SIDE_GRID2 ! Used for error output purposes INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: ID(3) ! ID(i) is set to 1 if the i-th diagonal of TE is 1.0 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMGM3_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare to real zero REAL(DOUBLE) :: IVEC(3) ! A vector in the elem x dir @@ -78,12 +77,7 @@ SUBROUTINE ELMGM3 ( WRITE_WARN ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -335,12 +329,7 @@ SUBROUTINE ELMGM3 ( WRITE_WARN ) WRITE(BUG,*) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/EMG.f90 b/Source/EMG/EMG1/EMG.f90 index 1228159d..45cf4b7c 100644 --- a/Source/EMG/EMG1/EMG.f90 +++ b/Source/EMG/EMG1/EMG.f90 @@ -44,7 +44,7 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) ! NOTE: may need to calc KE to get this USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MBUG, MEDAT0_CUSERIN, MELDOF, MEMATC, MOFFSET, NSUB, NTSUB USE SCONTR, ONLY : DEDAT_Q4_MATANG_KEY, DEDAT_Q4_POFFS_KEY, DEDAT_Q4_SHELL_KEY, DEDAT_Q4_THICK_KEY, & DEDAT_T3_MATANG_KEY, DEDAT_T3_POFFS_KEY, DEDAT_T3_SHELL_KEY, DEDAT_T3_THICK_KEY, & @@ -52,7 +52,6 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : SUPINFO, SUPWARN, QUAD4TYP - USE SUBR_BEGEND_LEVELS, ONLY : EMG_BEGEND USE CONSTANTS_1, ONLY : CONV_DEG_RAD, CONV_RAD_DEG, ZERO, ONE USE MODEL_STUF, ONLY : CAN_ELEM_TYPE_OFFSET, EDAT, EID, EPNT, ETYPE, ISOLID, MATANGLE, NUM_EMG_FATAL_ERRS, & PCOMP_PROPS, PLY_NUM, TE_IDENT, THETAM, TYPE, XEL, TE @@ -81,7 +80,7 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) INTEGER(LONG) :: IORD_IJ ! Integration order in the triangular plane for PENTA elements INTEGER(LONG) :: IORD_K ! Integration order in Z direction for PENTA elements INTEGER(LONG) :: INT41,INT42 ! An integer used in getting MATANGLE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EMG_BEGEND + ! ********************************************************************************************************************************** EPNTK = EPNT(INT_ELEM_ID) @@ -89,12 +88,6 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) TYPE = ETYPE(INT_ELEM_ID) CALL IS_ELEM_PCOMP_PROPS ( INT_ELEM_ID ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC,EID,TYPE, OPT - 9001 FORMAT(1X,A,' BEGN ',F10.3,5X,'Element No. ',I8,' ,Type ',A, ' OPT = ', 6A2) - ENDIF -! ********************************************************************************************************************************** NUM_EMG_FATAL_ERRS = 0 @@ -313,8 +306,6 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) IF ((OPT(1) == 'N') .AND. (OPT(2) == 'N') .AND. (OPT(3) == 'N') .AND. (OPT(4) == 'N') .AND. (OPT(5) == 'N') .AND. & (OPT(6) == 'N')) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC RETURN ENDIF @@ -431,12 +422,7 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 b/Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 index 315163c4..6d1987c3 100644 --- a/Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 +++ b/Source/EMG/EMG1/GET_ELEM_AGRID_BGRID.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_ELEM_AGRID_BGRID ( INT_ELEM_ID, CHECK_AGRID ) ! Gets element actual and internal grid numbers given the element's internal ID USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, medat0_cuserin, MELGP, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ELEM_AGRID_BGRID_BEGEND USE MODEL_STUF, ONLY : AGRID, BGRID, EDAT, EID, ELGP, EPNT, ETYPE, GRID, GRID_ID, TYPE USE GET_ELEM_AGRID_BGRID_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE GET_ELEM_AGRID_BGRID ( INT_ELEM_ID, CHECK_AGRID ) INTEGER(LONG) :: GRID_ID_ROW_NUM ! Row num in GRID_ID where AGRID(I) exists INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: DELTA ! Offset in EDAT (from 1st record for an elem) where grid no's begin - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ELEM_AGRID_BGRID_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** EPNTK = EPNT(INT_ELEM_ID) @@ -72,9 +66,6 @@ SUBROUTINE GET_ELEM_AGRID_BGRID ( INT_ELEM_ID, CHECK_AGRID ) CALL GET_ELGP ( INT_ELEM_ID ) - ! assert that the array is sorted and the binary search in GET_ARRAY_ROW_NUM will work - CALL ASSERT_ARRAY_SORTED ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID) - DO I=1,ELGP DELTA = 1 IF (TYPE == 'BUSH ') THEN ! 1st grid in EDAT for BUSH is at EPNTK+3 since "Num grids" is EPNTK+2 @@ -116,12 +107,7 @@ SUBROUTINE GET_ELEM_AGRID_BGRID ( INT_ELEM_ID, CHECK_AGRID ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/GET_ELEM_ONAME.f90 b/Source/EMG/EMG1/GET_ELEM_ONAME.f90 index b0941632..f09cd7df 100644 --- a/Source/EMG/EMG1/GET_ELEM_ONAME.f90 +++ b/Source/EMG/EMG1/GET_ELEM_ONAME.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_ELEM_ONAME ( NAME ) ! Gets element output name (used in LINK9 subr's which write elem and/or ply outputs) for a given element type USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, METYPE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ELEM_ONAME_BEGEND USE MODEL_STUF, ONLY : ELEM_ONAME, ELMTYP, TYPE USE GET_ELEM_ONAME_USE_IFs @@ -44,14 +43,9 @@ SUBROUTINE GET_ELEM_ONAME ( NAME ) CHARACTER(LEN=LEN(ELEM_ONAME)), INTENT(OUT) :: NAME ! Name of an elem for output purposes in LINK9 WRTELi subr's INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ELEM_ONAME_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** NAME = ' ' @@ -77,12 +71,7 @@ SUBROUTINE GET_ELEM_ONAME ( NAME ) 1940 FORMAT(' *ERROR 1940: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,' ELEMENT TYPE "',A,'" NOT FOUND IN ARRAY ELMTYP') -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/GET_ELGP.f90 b/Source/EMG/EMG1/GET_ELGP.f90 index 7b57503f..234443b8 100644 --- a/Source/EMG/EMG1/GET_ELGP.f90 +++ b/Source/EMG/EMG1/GET_ELGP.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_ELGP ( INT_ELEM_ID ) ! Gets number of grid points for a given element based on the element's internal ID USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE, MELGP, METYPE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ELGP_BEGEND USE MODEL_STUF, ONLY : EDAT, EID, ELGP, ELMTYP, etype, EMG_IFE, EPNT, ERR_SUB_NAM, NELGP, NUM_EMG_FATAL_ERRS, TYPE USE GET_ELGP_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE GET_ELGP ( INT_ELEM_ID ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: NG ! Number of GRID's for USERIN elem INTEGER(LONG) :: NS ! Number of SPOINT's for USERIN elem - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ELGP_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** EPNTK = EPNT(INT_ELEM_ID) @@ -130,12 +124,7 @@ SUBROUTINE GET_ELGP ( INT_ELEM_ID ) 1940 FORMAT(' *ERROR 1940: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,' ELEMENT TYPE "',A,'" NOT FOUND IN ARRAY ELMTYP') -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/GET_MATANGLE_FROM_CID.f90 b/Source/EMG/EMG1/GET_MATANGLE_FROM_CID.f90 index 8790615d..e801e261 100644 --- a/Source/EMG/EMG1/GET_MATANGLE_FROM_CID.f90 +++ b/Source/EMG/EMG1/GET_MATANGLE_FROM_CID.f90 @@ -29,13 +29,12 @@ SUBROUTINE GET_MATANGLE_FROM_CID ( ACID ) ! Calcs THETAM for plate elements that have the material angle specified via a coord sys ID (ACID here) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCORD USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : CONV_DEG_RAD, ZERO, ONE USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : CORD, EID, NUM_EMG_FATAL_ERRS, NUM_EMG_FATAL_ERRS, RCORD, TE, THETAM, TYPE, QUAD_DELTA - USE SUBR_BEGEND_LEVELS, ONLY : GET_MATANGLE_FROM_CID_BEGEND USE GET_MATANGLE_FROM_CID_USE_IFs @@ -47,7 +46,7 @@ SUBROUTINE GET_MATANGLE_FROM_CID ( ACID ) INTEGER(LONG), INTENT(IN) :: ACID ! Actual coord system ID for the sys that defines the material axes INTEGER(LONG) :: I ! DO loop indices INTEGER(LONG) :: ICID ! Internal coord sys ID for ACID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_MATANGLE_FROM_CID_BEGEND + REAL(DOUBLE) :: DOT_XM ! Dot product of VEC_XE and VEC_ME REAL(DOUBLE) :: CROSS_XM(3) ! Cross product of VEC_XE and VEC_ME @@ -60,12 +59,7 @@ SUBROUTINE GET_MATANGLE_FROM_CID ( ACID ) REAL(DOUBLE) :: VEC_ZE(3) ! Vector in z direction in element coord sys REAL(DOUBLE) :: VEC_ME(3) ! Vector proj of VEC_XM onto elem plane -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -133,12 +127,7 @@ SUBROUTINE GET_MATANGLE_FROM_CID ( ACID ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/GET_PCOMP_SECT_PROPS.f90 b/Source/EMG/EMG1/GET_PCOMP_SECT_PROPS.f90 index 5bb5a2d6..38f3d94f 100644 --- a/Source/EMG/EMG1/GET_PCOMP_SECT_PROPS.f90 +++ b/Source/EMG/EMG1/GET_PCOMP_SECT_PROPS.f90 @@ -30,12 +30,10 @@ SUBROUTINE GET_PCOMP_SECT_PROPS ( PCOMP_TM, PCOMP_IB, PCOMP_TS ) USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, MPCOMP_PLIES, MPCOMP0, MRPCOMP_PLIES, MRPCOMP0 - USE IOUNT1, ONLY : F04, WRT_LOG USE MODEL_STUF, ONLY : EPROP, INTL_PID, NUM_PLIES, RPCOMP, TPLY USE PARAMS, ONLY : PCMPTSTM USE CONSTANTS_1, ONLY : ZERO, THIRD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_PCOMP_SECT_PROPS_BEGEND USE GET_PCOMP_SECT_PROPS_USE_IFs @@ -45,7 +43,7 @@ SUBROUTINE GET_PCOMP_SECT_PROPS ( PCOMP_TM, PCOMP_IB, PCOMP_TS ) INTEGER(LONG) :: K ! DO loop index INTEGER(LONG) :: PLY_RPCOMP_INDEX ! Index in array RPCOMP where data for ply K begins - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_PCOMP_SECT_PROPS_BEGEND + REAL(DOUBLE), INTENT(OUT) :: PCOMP_TM ! Membrane thickness of PCOMP for equivalent PSHELL REAL(DOUBLE), INTENT(OUT) :: PCOMP_IB ! Bending MOI of PCOMP for equivalent PSHELL @@ -54,12 +52,6 @@ SUBROUTINE GET_PCOMP_SECT_PROPS ( PCOMP_TM, PCOMP_IB, PCOMP_TS ) REAL(DOUBLE) :: ZBK2,ZTK2 ! ZBK^2, ZTK^2 REAL(DOUBLE) :: ZBK3,ZTK3 ! ZBK^3, ZTK^3 -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF ! ********************************************************************************************************************************** ZBK = EPROP(4) @@ -84,12 +76,7 @@ SUBROUTINE GET_PCOMP_SECT_PROPS ( PCOMP_TM, PCOMP_IB, PCOMP_TS ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/GRID_ELEM_CONN_TABLE.f90 b/Source/EMG/EMG1/GRID_ELEM_CONN_TABLE.f90 index 372000d6..6747ed0e 100644 --- a/Source/EMG/EMG1/GRID_ELEM_CONN_TABLE.f90 +++ b/Source/EMG/EMG1/GRID_ELEM_CONN_TABLE.f90 @@ -34,11 +34,10 @@ SUBROUTINE GRID_ELEM_CONN_TABLE USE PENTIUM_II_KIND, ONLY : BYTE, LONG USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_ELEM_DEGREE, NELE, NGRID - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : AGRID, ELGP, ETYPE, ESORT1, ESORT2, GRID_ID, GRID_ELEM_CONN_ARRAY USE PARAMS, ONLY : PRTCONN - USE SUBR_BEGEND_LEVELS, ONLY : GRID_ELEM_CONN_TABLE_BEGEND USE GRID_ELEM_CONN_TABLE_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE GRID_ELEM_CONN_TABLE INTEGER(LONG) :: GRD_NUM_ELEM(NGRID)! Array that specifies the number of elements connected to each grid INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: IGRID ! Internal grid ID (row in array GRID_ID where an act grid num exists) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GRID_ELEM_CONN_TABLE_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** DO I=1,NGRID @@ -107,12 +101,7 @@ SUBROUTINE GRID_ELEM_CONN_TABLE ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/ROT_COMP_ELEM_AXES.f90 b/Source/EMG/EMG1/ROT_COMP_ELEM_AXES.f90 index 6c7b2c88..5b55a404 100644 --- a/Source/EMG/EMG1/ROT_COMP_ELEM_AXES.f90 +++ b/Source/EMG/EMG1/ROT_COMP_ELEM_AXES.f90 @@ -56,14 +56,13 @@ SUBROUTINE ROT_COMP_ELEM_AXES ( INT_ELEM_ID, IPLY, THETA, DIRECTION ) ! material to local via basic system since we can't go directly from material to local in that case) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEMATC, DEDAT_Q4_MATANG_KEY, DEDAT_T3_MATANG_KEY USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : CONV_DEG_RAD, ZERO, HALF, ONE, TWO, FOUR USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : ALPVEC, EB, EM, ET, EBM, INTL_MID, MTRL_TYPE, STRESS, STRAIN, T1P, T1M, T1T, T2P, T2M, & T2T, QUAD_DELTA, THETAM, TYPE, EDAT, MATANGLE, EPNT - USE SUBR_BEGEND_LEVELS, ONLY : ROT_COMP_ELEM_AXES_BEGEND USE ROT_COMP_ELEM_AXES_USE_IFs @@ -76,7 +75,7 @@ SUBROUTINE ROT_COMP_ELEM_AXES ( INT_ELEM_ID, IPLY, THETA, DIRECTION ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID INTEGER(LONG), INTENT(IN) :: IPLY ! Ply number INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROT_COMP_ELEM_AXES_BEGEND + REAL(DOUBLE), INTENT(IN) :: THETA ! Orient angle of long dir of ply i wrt matl axis for the composite elem REAL(DOUBLE) :: ALP3(3,MEMATC) ! The 3 rows of ALPVEC for membrane strains @@ -105,12 +104,7 @@ SUBROUTINE ROT_COMP_ELEM_AXES ( INT_ELEM_ID, IPLY, THETA, DIRECTION ) INTEGER(LONG) :: EPNTK ! Value from array EPNT at the row for this internal elem ID. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Calc T1P matrix from eqn 3.3-7 in Ref 1. (with order 1,2,3,4,5,6 changed to 1,2,3,6,4,5 to account for the fact that Ref (1) has @@ -355,12 +349,7 @@ SUBROUTINE ROT_COMP_ELEM_AXES ( INT_ELEM_ID, IPLY, THETA, DIRECTION ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/SHELL_ABD_MATRICES.f90 b/Source/EMG/EMG1/SHELL_ABD_MATRICES.f90 index 7be4e6ad..cfbd6867 100644 --- a/Source/EMG/EMG1/SHELL_ABD_MATRICES.f90 +++ b/Source/EMG/EMG1/SHELL_ABD_MATRICES.f90 @@ -35,7 +35,7 @@ SUBROUTINE SHELL_ABD_MATRICES ( INT_ELEM_ID, WRITE_WARN ) ! 2) To get the individual matrices for a single ply of the element used for stress/strain calcs for that ply USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEMATC, MRMATLC, MPCOMP_PLIES, MPCOMP0, MRPCOMP_PLIES, MRPCOMP0, & WARN_ERR USE TIMDAT, ONLY : TSEC @@ -49,7 +49,6 @@ SUBROUTINE SHELL_ABD_MATRICES ( INT_ELEM_ID, WRITE_WARN ) RPSHEL, RHO, RMATL, SHELL_A, SHELL_B, SHELL_D, SHELL_T, SHELL_AALP, SHELL_BALP, & SHELL_DALP, SHELL_TALP, SHELL_T_MOD, THETA_PLY, TPLY, TYPE, ULT_STRE, ULT_STRN, ZPLY, ZS - USE SUBR_BEGEND_LEVELS, ONLY : SHELL_ABD_MATRICES_BEGEND USE SHELL_ABD_MATRICES_USE_IFs @@ -62,7 +61,7 @@ SUBROUTINE SHELL_ABD_MATRICES ( INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID for which INTEGER(LONG) :: I,J,K ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHELL_ABD_MATRICES_BEGEND + REAL(DOUBLE) :: DET_SHELL_T ! Determinant of SHELL_T REAL(DOUBLE) :: EPS1 ! Small number with which to comapre zero @@ -107,12 +106,7 @@ SUBROUTINE SHELL_ABD_MATRICES ( INT_ELEM_ID, WRITE_WARN ) REAL(DOUBLE) :: ZBK2,ZTK2 ! ZBK^2, ZTK^2 REAL(DOUBLE) :: ZBK3,ZTK3 ! ZBK^3, ZTK^3 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -504,12 +498,7 @@ SUBROUTINE SHELL_ABD_MATRICES ( INT_ELEM_ID, WRITE_WARN ) SHELL_T_MOD = 'Y' ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG1/WRITE_PCOMP_EQUIV.f90 b/Source/EMG/EMG1/WRITE_PCOMP_EQUIV.f90 index 8eae32d9..2dba0161 100644 --- a/Source/EMG/EMG1/WRITE_PCOMP_EQUIV.f90 +++ b/Source/EMG/EMG1/WRITE_PCOMP_EQUIV.f90 @@ -30,7 +30,7 @@ SUBROUTINE WRITE_PCOMP_EQUIV ( PCOMP_TM, PCOMP_IB, PCOMP_TS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : TWELVE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, MEMATC, MID1_PCOMP_EQ, MID2_PCOMP_EQ, MID3_PCOMP_EQ, & MID4_PCOMP_EQ, MID1_PCOMP_EQ, MID2_PCOMP_EQ, MID3_PCOMP_EQ, MID4_PCOMP_EQ USE PARAMS, ONLY : EPSIL, PCOMPEQ, SUPINFO diff --git a/Source/EMG/EMG2/ELMOFF.f90 b/Source/EMG/EMG2/ELMOFF.f90 index 43b1b6ca..85582633 100644 --- a/Source/EMG/EMG2/ELMOFF.f90 +++ b/Source/EMG/EMG2/ELMOFF.f90 @@ -32,12 +32,11 @@ SUBROUTINE ELMOFF ( OPT, WRITE_WARN ) ! ====================================== USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_LOG, WRT_BUG, WRT_ERR + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_STRESS_POINTS, NSUB, NTSUB, MAX_ORDER_GAUSS, MEFE, NMATL, & NPSHEL USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ELMOFF_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO USE PARAMS, ONLY : K6ROT, EPSIL, QUAD4TYP USE MODEL_STUF, ONLY : CAN_ELEM_TYPE_OFFSET, ELDOF, ELGP, EID, KE, ME, NUM_EMG_FATAL_ERRS, RMATL, & @@ -60,7 +59,7 @@ SUBROUTINE ELMOFF ( OPT, WRITE_WARN ) INTEGER(LONG) :: COL ! A computed col number in the elem stiff matrix INTEGER(LONG) :: NCOL ! An input to subr MULT_OFFSET, called herein INTEGER(LONG) :: METH ! An input to subr MULT_OFFSET, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMOFF_BEGEND + REAL(DOUBLE) :: DUM3(3,3) ! An intermediate result when calculating offset SEi REAL(DOUBLE) :: DUM4(3,3) ! An intermediate result when calculating offset SEi @@ -99,12 +98,7 @@ SUBROUTINE ELMOFF ( OPT, WRITE_WARN ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, (OPT(I),I=1,6) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X,6A1) - ENDIF + ! ********************************************************************************************************************************** ! Make sure we are not here for an element that does not support offsets @@ -607,12 +601,7 @@ SUBROUTINE ELMOFF ( OPT, WRITE_WARN ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -650,10 +639,9 @@ SUBROUTINE MULT_OFFSET ( A, DX, DY, DZ, NCOLA, METH, B ) ! simplicity, A*E or E(transp)*A is calculated explicitly USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMOFF_BEGEND USE MODEL_STUF, ONLY : EMG_IFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS IMPLICIT NONE @@ -664,7 +652,7 @@ SUBROUTINE MULT_OFFSET ( A, DX, DY, DZ, NCOLA, METH, B ) INTEGER(LONG), INTENT(IN) :: METH ! = 1 if A*E is to be calculated ! = 2 if E(transp)*A is to be calculated INTEGER(LONG), INTENT(IN) :: NCOLA ! Number of cols in matrix A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMOFF_BEGEND + 1 + REAL(DOUBLE) , INTENT(IN) :: A(3,NCOLA) ! Matrix to either post-multiply E by or pre-multiply E(transp) by REAL(DOUBLE) , INTENT(IN) :: DX ! Offset distance in direction 1 @@ -672,12 +660,7 @@ SUBROUTINE MULT_OFFSET ( A, DX, DY, DZ, NCOLA, METH, B ) REAL(DOUBLE) , INTENT(IN) :: DZ ! Offset distance in direction 3 REAL(DOUBLE) , INTENT(INOUT) :: B(3,NCOLA) ! Result matrix of either A*E or E(transp)*A -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Do not initialize B. It is an output in one call and maybe is input back as A in next call @@ -710,12 +693,7 @@ SUBROUTINE MULT_OFFSET ( A, DX, DY, DZ, NCOLA, METH, B ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG2/ELMOUT.f90 b/Source/EMG/EMG2/ELMOUT.f90 index 75655621..402eacb0 100644 --- a/Source/EMG/EMG2/ELMOUT.f90 +++ b/Source/EMG/EMG2/ELMOUT.f90 @@ -29,12 +29,11 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) ! Prints elem related data (controlled by Case Control ELDATA requests and situational variable WRT_BUG(i) ). USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, BUG, F04 + USE IOUNT1, ONLY : WRT_ERR, BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_DAT1_BIT, ELDT_BUG_DAT2_BIT, ELDT_BUG_ME_BIT, ELDT_BUG_P_T_BIT, & ELDT_BUG_SE_BIT, ELDT_BUG_KE_BIT, ELDT_BUG_U_P_BIT, MBUG, MDT, MELGP, METYPE, & MEMATR, MEMATC, MEPROP, MPRESS, NSUB, NTSUB, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMOUT_BEGEND USE CONSTANTS_1, ONLY : CONV_RAD_DEG, ZERO USE PARAMS, ONLY : CBMIN3, CBMIN4, ELFORCEN, QUADAXIS, QUAD4TYP USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -67,19 +66,13 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) ! If there are 5 subcases and internal S/C 3 is the 1-st S/C to have ! thermal load and internal S/C 5 is the 2-nd to have thermal load: ! TCASE2(1-5) = 3, 5, 0, 0, 0 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMOUT_BEGEND + REAL(DOUBLE) :: OEL(6) ! Temp array for holding elem displ, node loads REAL(DOUBLE) :: SHELL_T_avg ! Average of the diag terms from transverse shear matrix SHELL_T INTRINSIC :: ABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, DUM_BUG - 9001 FORMAT(1X,A,' BEGN ',F10.3, 5X, 10I4) - ENDIF ! ********************************************************************************************************************************** ! Set GRID_TYPE @@ -88,7 +81,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) GRID_TYPE(I) = 'undefined ' ENDDO DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 1) THEN GRID_TYPE(I) = 'scalar point' ELSE IF (NUM_COMPS == 6) THEN @@ -658,7 +651,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = UEL(I2) @@ -674,7 +667,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = PEL(I2) @@ -692,7 +685,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = UEB(I2) @@ -708,7 +701,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = PEB(I2) @@ -726,7 +719,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = UEG(I2) @@ -742,7 +735,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) DO J=1,6 OEL(J) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 OEL(J) = PEG(I2) @@ -756,12 +749,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG2/ELMTLB.f90 b/Source/EMG/EMG2/ELMTLB.f90 index 996efdd1..02394078 100644 --- a/Source/EMG/EMG2/ELMTLB.f90 +++ b/Source/EMG/EMG2/ELMTLB.f90 @@ -30,10 +30,9 @@ SUBROUTINE ELMTLB ( OPT ) ! transformation matrix TE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, f06, WRT_LOG + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, MELDOF, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMTLB_BEGEND USE MODEL_STUF, ONLY : ELDOF, ELGP, KE, KED, ME, PTE, PPE, TE USE ELMTLB_USE_IFs @@ -51,19 +50,14 @@ SUBROUTINE ELMTLB ( OPT ) INTEGER(LONG) :: NCOLB ! No. cols in a matrix for subr MATMULT_FFF/MATMULT_FFF_T, called herein INTEGER(LONG), PARAMETER :: NROW = 3 ! No. rows to get/put for subrs MATGET/MATPUT, called herein INTEGER(LONG), PARAMETER :: NROWA = 3 ! No. rows in a matrix for subr MATMULT_FFF/MATMULT_FFF_T, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMTLB_BEGEND + REAL(DOUBLE) :: DUM11(3,3) ! An intermediate result when calculating transformed KE REAL(DOUBLE) :: DUM12(3,3) ! An intermediate result when calculating transformed KE REAL(DOUBLE) :: PDUM1(3,NSUB) ! An intermediate result when calculating transformed PTE, PPE REAL(DOUBLE) :: PDUM2(3,NSUB) ! An intermediate result when calculating transformed PTE, PPE -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF (OPT(1) == 'Y') THEN ! Transform ME to TE' x ME x TE @@ -158,12 +152,7 @@ SUBROUTINE ELMTLB ( OPT ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG3/BAR1.f90 b/Source/EMG/EMG3/BAR1.f90 index cde78dc4..9991bacc 100644 --- a/Source/EMG/EMG3/BAR1.f90 +++ b/Source/EMG/EMG3/BAR1.f90 @@ -35,10 +35,9 @@ SUBROUTINE BAR1 ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, NTSUB, BLNK_SUB_NAM, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BAR1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX, TEN, TWELVE USE DEBUG_PARAMETERS USE PARAMS, ONLY : EPSIL, ART_KED, ART_ROT_KED, ART_TRAN_KED @@ -57,7 +56,7 @@ SUBROUTINE BAR1 ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, INTEGER(LONG) :: I,J ! DO loop induces INTEGER(LONG) :: IERROR ! Local error indicator INTEGER(LONG) :: NUM_PFLAG_DOFS ! The number of pin flagged DOF's for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BAR1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: ALPHA ! Coefficient of thermal expansion REAL(DOUBLE) , INTENT(IN) :: AREA ! Cross-sectional area @@ -132,12 +131,7 @@ SUBROUTINE BAR1 ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, REAL(DOUBLE) :: TPRIME(5,NTSUB) ! Matrix where each col has the 5 temperature/gradients for the BAR elem -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -562,12 +556,7 @@ SUBROUTINE BAR1 ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -594,7 +583,7 @@ SUBROUTINE BAR1 ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, SUBROUTINE DEBUG_BAR1 (WHAT) USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 IMPLICIT NONE diff --git a/Source/EMG/EMG3/BART.f90 b/Source/EMG/EMG3/BART.f90 index 3d2551dd..2dca6f12 100644 --- a/Source/EMG/EMG3/BART.f90 +++ b/Source/EMG/EMG3/BART.f90 @@ -35,10 +35,9 @@ SUBROUTINE BART ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, NTSUB, BLNK_SUB_NAM, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BAR1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX, TEN, TWELVE USE DEBUG_PARAMETERS USE PARAMS, ONLY : EPSIL, ART_KED, ART_ROT_KED, ART_TRAN_KED @@ -57,7 +56,7 @@ SUBROUTINE BART ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, INTEGER(LONG) :: I,J ! DO loop induces INTEGER(LONG) :: IERROR ! Local error indicator INTEGER(LONG) :: NUM_PFLAG_DOFS ! The number of pin flagged DOF's for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BAR1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: ALPHA ! Coefficient of thermal expansion REAL(DOUBLE) , INTENT(IN) :: AREA ! Cross-sectional area @@ -116,12 +115,7 @@ SUBROUTINE BART ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, REAL(DOUBLE) :: TPRIME(5,NTSUB) ! Matrix where each col has the 5 temperature/gradients for the BAR elem -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -499,12 +493,7 @@ SUBROUTINE BART ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -531,7 +520,7 @@ SUBROUTINE BART ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, SUBROUTINE DEBUG_BART (WHAT) USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 IMPLICIT NONE diff --git a/Source/EMG/EMG3/BEAM.f90 b/Source/EMG/EMG3/BEAM.f90 index 90b3dab5..a3b6b1ec 100644 --- a/Source/EMG/EMG3/BEAM.f90 +++ b/Source/EMG/EMG3/BEAM.f90 @@ -27,25 +27,19 @@ SUBROUTINE BEAM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : NUM_EMG_FATAL_ERRS - USE SUBR_BEGEND_LEVELS, ONLY : BEAM_BEGEND USE BEAM_USE_IFs IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'BEAM' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BEAM_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** FATAL_ERR = FATAL_ERR + 1 @@ -53,12 +47,7 @@ SUBROUTINE BEAM WRITE(ERR,1) WRITE(F06,1) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG3/BREL1.f90 b/Source/EMG/EMG3/BREL1.f90 index 44d7dabc..e5190615 100644 --- a/Source/EMG/EMG3/BREL1.f90 +++ b/Source/EMG/EMG3/BREL1.f90 @@ -35,10 +35,9 @@ SUBROUTINE BREL1 ( OPT, WRITE_WARN ) ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BREL1_BEGEND USE CONSTANTS_1, ONLY : TWO USE PARAMS, ONLY : EPSIL USE DEBUG_PARAMETERS @@ -53,7 +52,7 @@ SUBROUTINE BREL1 ( OPT, WRITE_WARN ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BREL1_BEGEND + REAL(DOUBLE) :: ALPHA ! Coefficient of thermal expansion REAL(DOUBLE) :: AREA ! Cross-sectional area @@ -72,12 +71,7 @@ SUBROUTINE BREL1 ( OPT, WRITE_WARN ) REAL(DOUBLE) :: RHO ! Material density REAL(DOUBLE) :: TREF ! Element reference temperature -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -179,12 +173,7 @@ SUBROUTINE BREL1 ( OPT, WRITE_WARN ) ! ********************************************************************************************************************************** 1963 FORMAT(' *ERROR 1962: TIMOSHENKO BAR ELEMENT ',A,' CANNOT HAVE NONZERO I12. IT WILL BE SET TO I12 = 0.') -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG3/BUSH.f90 b/Source/EMG/EMG3/BUSH.f90 index 9c1edb97..7c7bc4ae 100644 --- a/Source/EMG/EMG3/BUSH.f90 +++ b/Source/EMG/EMG3/BUSH.f90 @@ -32,12 +32,11 @@ SUBROUTINE BUSH ( INT_ELEM_ID, OPT, WRITE_WARN ) ! 2) SE1, STE1 = element stress data recovery matrices if OPT(3) = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : BE1, BE2, BUSH_DXA, BUSH_DXB, BUSH_DY, BUSH_DZ, EPROP, KE, OFFDIS_GA_GB, SE1, SE2 - USE SUBR_BEGEND_LEVELS, ONLY : BUSH_BEGEND USE BUSH_USE_IFs @@ -47,7 +46,7 @@ SUBROUTINE BUSH ( INT_ELEM_ID, OPT, WRITE_WARN ) CHARACTER(LEN=*) , INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUSH_BEGEND + INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID INTEGER(LONG) :: I,J ! DO loop indices @@ -57,12 +56,7 @@ SUBROUTINE BUSH ( INT_ELEM_ID, OPT, WRITE_WARN ) REAL(DOUBLE) :: STRE_RCV(2) ! Two stress recovery values REAL(DOUBLE) :: STRN_RCV(2) ! Two strain recovery values -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize: @@ -182,12 +176,7 @@ SUBROUTINE BUSH ( INT_ELEM_ID, OPT, WRITE_WARN ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG3/ELAS1.f90 b/Source/EMG/EMG3/ELAS1.f90 index 1b4b741b..d104d8a6 100644 --- a/Source/EMG/EMG3/ELAS1.f90 +++ b/Source/EMG/EMG3/ELAS1.f90 @@ -32,11 +32,10 @@ SUBROUTINE ELAS1 ( OPT, WRITE_WARN ) ! 2) KE = Element stiffness matrix in element coord's if OPT(4) = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELAS1_BEGEND - USE MODEL_STUF, ONLY : AGRID, ELAS_COMP, EID, EPROP, FCONV, KE, SE1, TYPE + USE MODEL_STUF, ONLY : AGRID, BGRID, ELAS_COMP, EID, EPROP, FCONV, KE, SE1, TYPE USE ELAS1_USE_IFs @@ -49,17 +48,12 @@ SUBROUTINE ELAS1 ( OPT, WRITE_WARN ) INTEGER(LONG) :: I1 ! The component no (1-6) at end A that this elem is connected to INTEGER(LONG) :: I2 ! The component no (1-6) at end B that this elem is connected to INTEGER(LONG) :: NUM_COMPS_GRID_1 ! No. displ components (1 for SPOINT, 6 for actual grid) for 1st grid - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELAS1_BEGEND + REAL(DOUBLE) :: K ! Spring stiffness REAL(DOUBLE) :: GE ! Material damping coeff -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Set element property and material constants @@ -72,7 +66,7 @@ SUBROUTINE ELAS1 ( OPT, WRITE_WARN ) FCONV(1) = 1.D0 ENDIF I1 = ELAS_COMP(1) - CALL GET_GRID_NUM_COMPS ( AGRID(1), NUM_COMPS_GRID_1, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(1), NUM_COMPS_GRID_1, SUBR_NAME ) I2 = NUM_COMPS_GRID_1 + ELAS_COMP(2) ! ********************************************************************************************************************************** @@ -93,12 +87,7 @@ SUBROUTINE ELAS1 ( OPT, WRITE_WARN ) SE1(1,I1,1) = -SE1(1,I2,1) ENDIF -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG3/KUSER1.f90 b/Source/EMG/EMG3/KUSER1.f90 index b8bf5bed..63ec0a84 100644 --- a/Source/EMG/EMG3/KUSER1.f90 +++ b/Source/EMG/EMG3/KUSER1.f90 @@ -29,10 +29,9 @@ SUBROUTINE KUSER1 ( OPT, WRITE_WARN ) ! Calc's matrices for user supplied subroutine elements USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : KUSER1_BEGEND USE MODEL_STUF, ONLY : TYPE USE KUSER1_USE_IFs @@ -43,14 +42,9 @@ SUBROUTINE KUSER1 ( OPT, WRITE_WARN ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = KUSER1_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** WRITE(ERR,1934) SUBR_NAME,TYPE @@ -58,12 +52,7 @@ SUBROUTINE KUSER1 ( OPT, WRITE_WARN ) FATAL_ERR = FATAL_ERR + 1 CALL OUTA_HERE ( 'Y' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG3/PINFLG.f90 b/Source/EMG/EMG3/PINFLG.f90 index 82842c4b..81b6eb2e 100644 --- a/Source/EMG/EMG3/PINFLG.f90 +++ b/Source/EMG/EMG3/PINFLG.f90 @@ -29,10 +29,9 @@ SUBROUTINE PINFLG ( NUM_PFLAG_DOFS ) ! Processes element pin flags to modify stiffness matrix USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PINFLG_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : EID, ELDOF, NUM_EMG_FATAL_ERRS, KE, DOFPIN, TYPE @@ -51,18 +50,13 @@ SUBROUTINE PINFLG ( NUM_PFLAG_DOFS ) INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: IERROR ! Count of errors. Error occurs if a diag KE for a pinflaged DOF is zero INTEGER(LONG) :: PDOF ! A DOF component number (1 digit) from array DOFPIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PINFLG_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare for real zero INTRINSIC DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -123,12 +117,7 @@ SUBROUTINE PINFLG ( NUM_PFLAG_DOFS ) ENDDO i_do -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG3/ROD1.f90 b/Source/EMG/EMG3/ROD1.f90 index 90196671..47377c1d 100644 --- a/Source/EMG/EMG3/ROD1.f90 +++ b/Source/EMG/EMG3/ROD1.f90 @@ -34,10 +34,9 @@ SUBROUTINE ROD1 ( OPT, L, AREA, JTOR, SCOEFF, E, G, ALPHA, TREF ) ! 4) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NTSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ROD1_BEGEND USE CONSTANTS_1, ONLY : TWO USE MODEL_STUF, ONLY : DT, KE, KED, PEL, PTE, SE1, STE1, UEL @@ -48,7 +47,7 @@ SUBROUTINE ROD1 ( OPT, L, AREA, JTOR, SCOEFF, E, G, ALPHA, TREF ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ROD1' CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices INTEGER(LONG) :: J ! Do loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROD1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: ALPHA ! Coefficient of thermal expansion REAL(DOUBLE) , INTENT(IN) :: AREA ! Cross-sectional area @@ -65,12 +64,7 @@ SUBROUTINE ROD1 ( OPT, L, AREA, JTOR, SCOEFF, E, G, ALPHA, TREF ) REAL(DOUBLE) :: KD0 ! Intermediate variable used in calc KED REAL(DOUBLE) :: TBAR ! Average elem temperature -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Determine element thermal loads. @@ -135,12 +129,7 @@ SUBROUTINE ROD1 ( OPT, L, AREA, JTOR, SCOEFF, E, G, ALPHA, TREF ) KED( 9, 9) = KED( 3, 3) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG3/USERIN.f90 b/Source/EMG/EMG3/USERIN.f90 index a6da46ab..43dca07b 100644 --- a/Source/EMG/EMG3/USERIN.f90 +++ b/Source/EMG/EMG3/USERIN.f90 @@ -45,7 +45,7 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) ! entry was read USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN4, IN4_MSG, IN4FIL, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN4, IN4_MSG, IN4FIL USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEDAT0_CUSERIN, MELDOF, NDOFG, NGRID, NSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO @@ -60,7 +60,6 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) USERIN_NUM_BDY_DOF, USERIN_NUM_ACT_GRDS, USERIN_NUM_SPOINTS, & USERIN_MASS_MAT_NAME, USERIN_LOAD_MAT_NAME, USERIN_RBM0_MAT_NAME, USERIN_STIF_MAT_NAME - USE SUBR_BEGEND_LEVELS, ONLY : USERIN_BEGEND USE USERIN_USE_IFs @@ -88,7 +87,7 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) ! Array that has USERIN grid num in col 1 and comp number in remaining 7 ! cols (1 col has all comps, others each indiv comp) for USERIN bdy DOF's INTEGER(LONG) :: USERIN_CID0_ICID ! Internal coordinate system ID for USERIN_CID0 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = USERIN_BEGEND + REAL(DOUBLE) :: DX ! X offset of USERIN elem CG from overall model basic sys origin REAL(DOUBLE) :: DY ! Y offset of USERIN elem CG from overall model basic sys origin @@ -112,12 +111,7 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) ! Matrix to transform MRRcb to 6x6 RB mass rel to GRDPNT REAL(DOUBLE) :: TB6(USERIN_NUM_BDY_DOF,6) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** OUNT(1) = ERR @@ -196,7 +190,7 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) ! Open the IN4 file containing the mass and stiff matrices for this elem CALL FILE_OPEN ( IN4, IN4FIL(USERIN_IN4_INDEX), OUNT, 'OLD', IN4_MSG, 'NEITHER', 'UNFORMATTED', 'READ', 'REWIND', & - 'Y', 'N', 'Y' ) + 'Y', 'N' ) ! If OPT(1) is 'Y', get the elem mass matrix from the IN4 file and expand it from boundary DOF size to ELDOF size (6 comps/grid). @@ -327,16 +321,11 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) CALL DEALLOCATE_IN4_FILES ( 'IN4_COL_MAP' ) CALL DEALLOCATE_IN4_FILES ( 'IN4_MAT' ) - CALL FILE_CLOSE ( IN4, IN4FIL(USERIN_IN4_INDEX), 'KEEP', 'Y' ) + CALL FILE_CLOSE ( IN4, IN4FIL(USERIN_IN4_INDEX), 'KEEP' ) IF (DEBUG(180) > 0) CALL DEB_USERIN ( 99 ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -359,7 +348,7 @@ SUBROUTINE GET_TN_TRANSFORM_MAT ( USERIN_CID0_ICID, TN ) USE PENTIUM_II_KIND USE SCONTR, ONLY : FATAL_ERR, NCORD - USE IOUNT1, ONLY : ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : CORD, NUM_EMG_FATAL_ERRS, RCORD, USERIN_CID0 @@ -419,7 +408,7 @@ SUBROUTINE TRANSFORM_USERIN_RBM0 ( USERIN_CID0_ICID, TN, RBM66, DX, DY, DZ, R66, ! (2) Translate from USERIN basic coord sys origin to overall model basic coord sys origin. Final result is USERIN_RBM0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - use iount1, only : err, f04, f06 + use iount1, only : err, f06 USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : RCORD, USERIN_RBM0 diff --git a/Source/EMG/EMG4/CALC_PHI_SQ.f90 b/Source/EMG/EMG4/CALC_PHI_SQ.f90 index 7c9c2f99..98cfa2e6 100644 --- a/Source/EMG/EMG4/CALC_PHI_SQ.f90 +++ b/Source/EMG/EMG4/CALC_PHI_SQ.f90 @@ -53,9 +53,8 @@ SUBROUTINE CALC_PHI_SQ ( IERROR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CALC_PHI_SQ_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWELVE USE PARAMS, ONLY : CBMIN3, CBMIN4, CBMIN4T, EPSIL, PCMPTSTM, QUAD4TYP USE MODEL_STUF, ONLY : BENSUM, EID, EMG_IFE, EMG_RFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS, INTL_MID, PHI_SQ, & @@ -67,7 +66,7 @@ SUBROUTINE CALC_PHI_SQ ( IERROR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'CALC_PHI_SQ' INTEGER(LONG), INTENT(OUT) :: IERROR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_PHI_SQ_BEGEND + REAL(DOUBLE) :: CBMIN = ZERO ! Either CBMIN3 or CBMIN4 REAL(DOUBLE) :: DEN ! Denominator term in calculating PHI_SQ @@ -78,12 +77,7 @@ SUBROUTINE CALC_PHI_SQ ( IERROR ) REAL(DOUBLE) :: PLY_IB ! Bending MOI of a ply REAL(DOUBLE) :: PLY_TS ! Transv shear thick of a ply -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IERROR = 0 @@ -166,12 +160,7 @@ SUBROUTINE CALC_PHI_SQ ( IERROR ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/GET_ELEM_NUM_PLIES.f90 b/Source/EMG/EMG4/GET_ELEM_NUM_PLIES.f90 index 00e5791e..46577517 100644 --- a/Source/EMG/EMG4/GET_ELEM_NUM_PLIES.f90 +++ b/Source/EMG/EMG4/GET_ELEM_NUM_PLIES.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_ELEM_NUM_PLIES ( INT_ELEM_ID ) ! Gets shell element number of plies (1 unless elem uses PCOMP props) given the element's internal ID USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, DEDAT_Q4_SHELL_KEY, DEDAT_T3_SHELL_KEY, NPCOMP, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ELEM_NUM_PLIES_BEGEND USE MODEL_STUF, ONLY : EDAT, EID, EPNT, ETYPE, INTL_PID, NUM_PLIES, PCOMP, TYPE USE GET_ELEM_NUM_PLIES_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE GET_ELEM_NUM_PLIES ( INT_ELEM_ID ) ! row number in array EDAT where data begins for this element. INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: I1 ! Index into EDAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ELEM_NUM_PLIES_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** NUM_PLIES = 1 @@ -81,12 +75,7 @@ SUBROUTINE GET_ELEM_NUM_PLIES ( INT_ELEM_ID ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/QDEL1.f90 b/Source/EMG/EMG4/QDEL1.f90 index 6ab33ab6..50d66af3 100644 --- a/Source/EMG/EMG4/QDEL1.f90 +++ b/Source/EMG/EMG4/QDEL1.f90 @@ -36,10 +36,9 @@ SUBROUTINE QDEL1 ( OPT, INT_ELEM_ID, WRITE_WARN ) ! 6) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MEFE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QDEL1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, FOUR, TWELVE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL, IORQ1B, IORQ1M, IORQ1S, IORQ2B, QUAD4TYP @@ -67,7 +66,7 @@ SUBROUTINE QDEL1 ( OPT, INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG), PARAMETER :: IORD_PCOMP = 2 ! Int order for nonsym layup PCOMP must be 2 (checked in subr ! SHELL_ABD_MATRICES) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QDEL1_BEGEND + REAL(DOUBLE) :: AREA ! Elem area REAL(DOUBLE) :: AR ! Elem aspect ratio @@ -101,12 +100,7 @@ SUBROUTINE QDEL1 ( OPT, INT_ELEM_ID, WRITE_WARN ) INTRINSIC DSQRT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -360,12 +354,7 @@ SUBROUTINE QDEL1 ( OPT, INT_ELEM_ID, WRITE_WARN ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/QMEM1.f90 b/Source/EMG/EMG4/QMEM1.f90 index a4347ebb..d5e849ad 100644 --- a/Source/EMG/EMG4/QMEM1.f90 +++ b/Source/EMG/EMG4/QMEM1.f90 @@ -41,11 +41,10 @@ SUBROUTINE QMEM1 ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, AREA, XSD, YSD, BIG_BM ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MAX_STRESS_POINTS, MEFE, NSUB, NTSUB, & MRPCOMP_PLIES, MRPCOMP0 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QMEM1_BEGEND USE CONSTANTS_1, ONLY : ZERO, FOUR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : ALPVEC, BE1, BMEANT, DT, EID, ELDOF, ELGP, EM, ERR_SUB_NAM, HBAR, KE, KED, MXWARP, & @@ -98,7 +97,7 @@ SUBROUTINE QMEM1 ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, AREA, XSD, YSD, BIG_BM ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - INTEGER(LONG), PARAMETER :: NUM_NODES = 4 ! Quad has 4 nodes ! Indicator of no output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QMEM1_BEGEND + INTEGER(LONG) :: PLY_RPCOMP_INDEX ! Index in array RPCOMP where data for ply K begins REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area @@ -153,12 +152,7 @@ SUBROUTINE QMEM1 ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, AREA, XSD, YSD, BIG_BM REAL(DOUBLE) :: SUMD ! An intermediate variable used in calc B matrix for reduced integration REAL(DOUBLE) :: TBAR ! Average elem temperature -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, OPT - 9001 FORMAT(1X,A,' BEGN ',F10.3, ' OPT = ', 6A2) - ENDIF + ! ********************************************************************************************************************************** ! Generate BM matrices. Dimensions 1 and 2 of BM store a element BM matrix for 1 Gauss point. The 3rd dimension has BM for all other @@ -663,12 +657,7 @@ SUBROUTINE QMEM1 ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, AREA, XSD, YSD, BIG_BM ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/QPLT1.f90 b/Source/EMG/EMG4/QPLT1.f90 index e82ac26c..bbef3788 100644 --- a/Source/EMG/EMG4/QPLT1.f90 +++ b/Source/EMG/EMG4/QPLT1.f90 @@ -40,10 +40,8 @@ SUBROUTINE QPLT1 ( OPT, AREA, XSD, YSD ) ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_ORDER_GAUSS, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QPLT1_BEGEND USE CONSTANTS_1, ONLY : ZERO, FOUR USE PARAMS, ONLY : IORQ2B USE MODEL_STUF, ONLY : ALPVEC, BE2, DT, EB, EID, KE, PRESS, PPE, PTE, SE2, STE2, SHELL_D, SHELL_DALP @@ -78,7 +76,7 @@ SUBROUTINE QPLT1 ( OPT, AREA, XSD, YSD ) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - INTEGER(LONG), PARAMETER :: NUM_NODES = 8 ! DKQ element has 8 nodes (4 are internal) ! Indicator of no output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QPLT1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords @@ -105,12 +103,7 @@ SUBROUTINE QPLT1 ( OPT, AREA, XSD, YSD ) REAL(DOUBLE) :: SSS(MAX_ORDER_GAUSS) ! An output from subr ORDER, called herein. Gauss abscissa's. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Quad side lengths @@ -287,12 +280,7 @@ SUBROUTINE QPLT1 ( OPT, AREA, XSD, YSD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/QPLT2.f90 b/Source/EMG/EMG4/QPLT2.f90 index a815869f..bb43dd67 100644 --- a/Source/EMG/EMG4/QPLT2.f90 +++ b/Source/EMG/EMG4/QPLT2.f90 @@ -40,10 +40,9 @@ SUBROUTINE QPLT2 ( OPT, AREA, XSD, YSD, BIG_BB ) ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_ORDER_GAUSS, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QPLT2_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, FOUR USE PARAMS, ONLY : EPSIL, IORQ2B, IORQ2T USE MODEL_STUF, ONLY : ALPVEC, BE2, BE3, BENSUM, DT, EID, ELDOF, EB, ET, & @@ -93,7 +92,7 @@ SUBROUTINE QPLT2 ( OPT, AREA, XSD, YSD, BIG_BB ) INTEGER(LONG) :: IORDXX ! Gaussian integration order to use when subr ORDER is called INTEGER(LONG), PARAMETER :: NUM_NODES = 4 ! Quad has 4 nodes ! Indicator of no output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QPLT2_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords @@ -138,12 +137,7 @@ SUBROUTINE QPLT2 ( OPT, AREA, XSD, YSD, BIG_BB ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Determine element thermal loads. @@ -585,12 +579,7 @@ SUBROUTINE QPLT2 ( OPT, AREA, XSD, YSD, BIG_BB ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/QPLT3.f90 b/Source/EMG/EMG4/QPLT3.f90 index 2dfc9169..73a6b8df 100644 --- a/Source/EMG/EMG4/QPLT3.f90 +++ b/Source/EMG/EMG4/QPLT3.f90 @@ -67,10 +67,9 @@ SUBROUTINE QPLT3 ( OPT, AREA_QUAD, XSD, YSD, BIG_BB ) ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE, MIN4T_QUAD4_TRIA_NO, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QPLT3_BEGEND USE CONSTANTS_1, ONLY : ZERO, QUARTER, HALF, ONE, TWO, FOUR, CONV_RAD_DEG, PI USE PARAMS, ONLY : MIN4TRED USE MACHINE_PARAMS, ONLY : MACH_SFMIN @@ -123,7 +122,7 @@ SUBROUTINE QPLT3 ( OPT, AREA_QUAD, XSD, YSD, BIG_BB ) INTEGER(LONG) :: PROG_ERR = 0 ! Local error indicator INTEGER(LONG) :: TRIA_NUM ! 1, 2, 3, or 4 designator of a subtriangle of the quad - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QPLT3_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA_QUAD ! Element area REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords @@ -261,12 +260,7 @@ SUBROUTINE QPLT3 ( OPT, AREA_QUAD, XSD, YSD, BIG_BB ) REAL(DOUBLE) :: V12(2) ! Components of a vector along side 1-2 of a sub-triangle REAL(DOUBLE) :: V13(2) ! Components of a vector along side 1-3 of a sub-triangle -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -884,12 +878,7 @@ SUBROUTINE QPLT3 ( OPT, AREA_QUAD, XSD, YSD, BIG_BB ) ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/QSHEAR.f90 b/Source/EMG/EMG4/QSHEAR.f90 index 0416041a..c9523559 100644 --- a/Source/EMG/EMG4/QSHEAR.f90 +++ b/Source/EMG/EMG4/QSHEAR.f90 @@ -39,10 +39,9 @@ SUBROUTINE QSHEAR ( OPT, IORD, RED_INT_SHEAR, XSD, YSD ) ! 4) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MAX_STRESS_POINTS, MEFE, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QSHEAR_BEGEND USE CONSTANTS_1, ONLY : ZERO, FOUR USE MODEL_STUF, ONLY : ALPVEC, BE1, BMEANT, DT, EID, ELDOF, ELGP, EM, ERR_SUB_NAM, HBAR, KE, MXWARP, & NUM_EMG_FATAL_ERRS, PCOMP_LAM, PCOMP_PROPS, PPE, PRESS, PTE, & @@ -85,7 +84,7 @@ SUBROUTINE QSHEAR ( OPT, IORD, RED_INT_SHEAR, XSD, YSD ) INTEGER(LONG), PARAMETER :: NUM_NODES = 4 ! Quad has 4 nodes ! Indicator of no output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QSHEAR_BEGEND + REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords REAL(DOUBLE) , INTENT(IN) :: YSD(4) ! Diffs in y coords of quad sides in local coords @@ -120,12 +119,7 @@ SUBROUTINE QSHEAR ( OPT, IORD, RED_INT_SHEAR, XSD, YSD ) REAL(DOUBLE) :: SUMB ! An intermediate variable used in calc B matrix for reduced integration REAL(DOUBLE) :: SUMD ! An intermediate variable used in calc B matrix for reduced integration -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Generate BM matrices. Dimensions 1 and 2 of BM store a element BM matrix for 1 Gauss point. The 3rd dimension has BM for all other @@ -282,12 +276,7 @@ SUBROUTINE QSHEAR ( OPT, IORD, RED_INT_SHEAR, XSD, YSD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/TMEM1.f90 b/Source/EMG/EMG4/TMEM1.f90 index dcc6277e..a1838c38 100644 --- a/Source/EMG/EMG4/TMEM1.f90 +++ b/Source/EMG/EMG4/TMEM1.f90 @@ -37,10 +37,9 @@ SUBROUTINE TMEM1 ( OPT, AREA, X2E, X3E, Y3E, WRT_BUG_THIS_TIME, BIG_BM ) ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, BUG, F04, WRT_BUG, WRT_LOG, F06 + USE IOUNT1, ONLY : ERR, BUG, WRT_BUG, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BCHK_BIT, ELDT_BUG_BMAT_BIT, NSUB, NTSUB, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TMEM1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, THREE USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : ALPVEC, BE1, EID, DT, EM, ELDOF, KE, PCOMP_LAM, PCOMP_PROPS, PRESS, PPE, PTE, SE1, STE1, & @@ -58,7 +57,7 @@ SUBROUTINE TMEM1 ( OPT, AREA, X2E, X3E, Y3E, WRT_BUG_THIS_TIME, BIG_BM ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: ID(18) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TMEM1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: X2E ! x coord of elem node 2 @@ -93,12 +92,7 @@ SUBROUTINE TMEM1 ( OPT, AREA, X2E, X3E, Y3E, WRT_BUG_THIS_TIME, BIG_BM ) REAL(DOUBLE) :: FORCExy ! Engineering force in the elem xy direction -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Determine element strain-displacement matrix. @@ -341,12 +335,7 @@ SUBROUTINE TMEM1 ( OPT, AREA, X2E, X3E, Y3E, WRT_BUG_THIS_TIME, BIG_BM ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/TPLT1.f90 b/Source/EMG/EMG4/TPLT1.f90 index 27af407b..71cf49da 100644 --- a/Source/EMG/EMG4/TPLT1.f90 +++ b/Source/EMG/EMG4/TPLT1.f90 @@ -40,10 +40,9 @@ SUBROUTINE TPLT1 ( OPT, AREA, X2E, X3E, Y3E ) ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TPLT1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, THREE, FOUR, SIX, TWELVE USE MODEL_STUF, ONLY : ALPVEC, BE2, DT, EB, KE, PRESS, PPE, PTE, SHELL_DALP, SHELL_D, SHELL_PROP_ALP, SE2, STE2 @@ -59,7 +58,7 @@ SUBROUTINE TPLT1 ( OPT, AREA, X2E, X3E, Y3E ) INTEGER(LONG) :: I2 ! Part of a computed index into array S INTEGER(LONG) :: J1 ! A computed index into array KE INTEGER(LONG) :: K1 ! A computed index into array KE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TPLT1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: X2E ! x coord of elem node 2 @@ -102,12 +101,7 @@ SUBROUTINE TPLT1 ( OPT, AREA, X2E, X3E, Y3E ) REAL(DOUBLE) :: Y23 ! Diff in y coords of elem nodes 2 and 3 REAL(DOUBLE) :: Y31 ! Diff in y coords of elem nodes 3 and 1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Generate element parameters @@ -472,12 +466,7 @@ SUBROUTINE TPLT1 ( OPT, AREA, X2E, X3E, Y3E ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -500,15 +489,13 @@ SUBROUTINE ATRA ( A1, A2, SL1, SL2, SL3, D ) ! other terms are 1.0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TPLT1_BEGEND IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ATRA' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TPLT1_BEGEND + 1 + REAL(DOUBLE) , INTENT(IN) :: A1(3,3) ! ALPHA-mi matrix REAL(DOUBLE) , INTENT(IN) :: A2(3,3) ! ALPHA-kj matrix @@ -526,12 +513,7 @@ SUBROUTINE ATRA ( A1, A2, SL1, SL2, SL3, D ) REAL(DOUBLE) :: W32 ! Intermediate variable used in calculating array D REAL(DOUBLE) :: W33 ! Intermediate variable used in calculating array D -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Wij are the values in ALPHA-mi (transpose) times R @@ -562,12 +544,7 @@ SUBROUTINE ATRA ( A1, A2, SL1, SL2, SL3, D ) D(3,2) = W31*A2(1,2) + W32*A2(2,2) + W33*A2(3,2) D(3,3) = W31*A2(1,3) + W32*A2(2,3) + W33*A2(3,3) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/TPLT2.f90 b/Source/EMG/EMG4/TPLT2.f90 index 8823da0a..d35dde4c 100644 --- a/Source/EMG/EMG4/TPLT2.f90 +++ b/Source/EMG/EMG4/TPLT2.f90 @@ -40,10 +40,9 @@ SUBROUTINE TPLT2(OPT, AREA, X2E, X3E, Y3E, CALC_EMATS, IERROR, KV, PTV, PPV, B2V ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MEMATC, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TPLT2_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, THREE, FOUR, SIX, EIGHT, TWELVE, CONV_RAD_DEG USE MODEL_STUF, ONLY : ALPVEC, BE2, BE3, BENSUM, DT, EB, EBM, EID, ET, ELDOF, FCONV, KE, & MTRL_TYPE, PCOMP_LAM, PCOMP_PROPS, PHI_SQ, PPE, PRESS, PTE, SE2, SE3, SHELL_B, SHELL_DALP,& @@ -72,7 +71,7 @@ SUBROUTINE TPLT2(OPT, AREA, X2E, X3E, Y3E, CALC_EMATS, IERROR, KV, PTV, PPV, B2V 5, & ! ID(7) = 5 means virgin 9x9 elem DOF 7 is MYSTRAN 18x18 elem DOF 5 11, & ! ID(8) = 11 means virgin 9x9 elem DOF 8 is MYSTRAN 18x18 elem DOF 11 17 /) ! ID(9) = 17 means virgin 9x9 elem DOF 9 is MYSTRAN 18x18 elem DOF 17 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TPLT2_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: PSI ! Angle to rotate orthotropic mat'l matrix of a sub-tria to align w QUAD @@ -160,12 +159,7 @@ SUBROUTINE TPLT2(OPT, AREA, X2E, X3E, Y3E, CALC_EMATS, IERROR, KV, PTV, PPV, B2V INTRINSIC DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -720,12 +714,7 @@ SUBROUTINE TPLT2(OPT, AREA, X2E, X3E, Y3E, CALC_EMATS, IERROR, KV, PTV, PPV, B2V ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG4/TREL1.f90 b/Source/EMG/EMG4/TREL1.f90 index 5bbe344a..e3533ae3 100644 --- a/Source/EMG/EMG4/TREL1.f90 +++ b/Source/EMG/EMG4/TREL1.f90 @@ -36,10 +36,9 @@ SUBROUTINE TREL1 ( OPT, WRITE_WARN ) ! 6) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, MEWE, NSUB, NTSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TREL1_BEGEND USE CONSTANTS_1, ONLY : ZERO, TENTH, ONE, TWO, THREE, TWELVE USE PARAMS, ONLY : SUPWARN USE MODEL_STUF, ONLY : EID, ELDOF, EMG_IWE, EMG_RWE, INTL_MID, KE, MASS_PER_UNIT_AREA, ME, & @@ -56,7 +55,7 @@ SUBROUTINE TREL1 ( OPT, WRITE_WARN ) INTEGER(LONG) :: IERROR ! Local error indicator from one of the subrs called INTEGER(LONG) :: K,L ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TREL1_BEGEND + REAL(DOUBLE) :: AR ! Elem aspect ratio REAL(DOUBLE) :: AREA ! Elem area @@ -95,12 +94,7 @@ SUBROUTINE TREL1 ( OPT, WRITE_WARN ) INTEGER(LONG) , PARAMETER :: TRIA_NUM = 1 REAL(DOUBLE) , PARAMETER :: PSI = 0.0D0 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -237,12 +231,7 @@ SUBROUTINE TREL1 ( OPT, WRITE_WARN ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG5/HEXA.f90 b/Source/EMG/EMG5/HEXA.f90 index 83e64fb7..e1f85336 100644 --- a/Source/EMG/EMG5/HEXA.f90 +++ b/Source/EMG/EMG5/HEXA.f90 @@ -38,12 +38,11 @@ SUBROUTINE HEXA ( OPT, INT_ELEM_ID,IORD, RED_INT_SHEAR, WRITE_WARN ) ! 6) KED = element differen stiff matrix calc , if OPT(6) = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MELDOF, MPLOAD4_3D_DATA, NPLOAD4_3D, NSUB, NTSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : QUARTER, HALF, ZERO, ONE USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : HEXA_BEGEND USE PARAMS, ONLY : EPSIL USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : AGRID, ALPVEC, BE1, BE2, DT, EID, ELGP, NUM_EMG_FATAL_ERRS, ES, KE, KED, ME, & @@ -86,7 +85,7 @@ SUBROUTINE HEXA ( OPT, INT_ELEM_ID,IORD, RED_INT_SHEAR, WRITE_WARN ) INTEGER(LONG) :: K1,K2,K3,K4 ! Array indices INTEGER(LONG) :: K5,K6,K7,K8 ! Array indices ! Indicator of no output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = HEXA_BEGEND + INTEGER(LONG) :: STR_PT_NUM ! Stress point number. 1 is center, 2+ are element nodes 1+. REAL(DOUBLE) :: ALP(6) ! First col of ALPVEC @@ -147,12 +146,7 @@ SUBROUTINE HEXA ( OPT, INT_ELEM_ID,IORD, RED_INT_SHEAR, WRITE_WARN ) REAL(DOUBLE) :: SSI,SSJ,SSK ! Isoparametric coordinates of a point. REAL(DOUBLE) :: M_1DOF(ELGP,ELGP) ! Consistent mass matrix with 1 DOF per node. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -766,12 +760,7 @@ SUBROUTINE HEXA ( OPT, INT_ELEM_ID,IORD, RED_INT_SHEAR, WRITE_WARN ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -852,7 +841,7 @@ SUBROUTINE PRESS_FACE_GRIDS ( IERR ) USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 IMPLICIT NONE @@ -1007,7 +996,7 @@ END SUBROUTINE CALC_FACE_AREA SUBROUTINE PRESS_LOAD_DEBUG ( WHAT ) USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 IMPLICIT NONE diff --git a/Source/EMG/EMG5/PENTA.f90 b/Source/EMG/EMG5/PENTA.f90 index dc5a2aff..baeae577 100644 --- a/Source/EMG/EMG5/PENTA.f90 +++ b/Source/EMG/EMG5/PENTA.f90 @@ -37,12 +37,11 @@ SUBROUTINE PENTA ( OPT, INT_ELEM_ID, IORD_IJ, IORD_K, RED_INT_SHEAR, WRITE_WARN ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_TRIA, MAX_ORDER_GAUSS, NTSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : HALF, THIRD, ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : PENTA_BEGEND USE PARAMS, ONLY : EPSIL USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : ALPVEC, BE1, BE2, DT, EID, ELGP, NUM_EMG_FATAL_ERRS, ES, KE, KED, ME, PTE, RHO, & @@ -69,7 +68,7 @@ SUBROUTINE PENTA ( OPT, INT_ELEM_ID, IORD_IJ, IORD_K, RED_INT_SHEAR, WRITE_WARN INTEGER(LONG) :: II,JJ ! Counters INTEGER(LONG) :: ID(3*ELGP) ! Array which shows equivalence of DOF's in virgin element with the ! 6 DOF/grid of the final element stiffness matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PENTA_BEGEND + INTEGER(LONG) :: STR_PT_NUM ! Stress point number. 1 is center, 2+ are element nodes 1+. REAL(DOUBLE) :: ALP(6) ! First col of ALPVEC @@ -128,12 +127,7 @@ SUBROUTINE PENTA ( OPT, INT_ELEM_ID, IORD_IJ, IORD_K, RED_INT_SHEAR, WRITE_WARN REAL(DOUBLE) :: SSI,SSJ,SSK ! Isoparametric coordinates of a point. REAL(DOUBLE) :: M_1DOF(ELGP,ELGP) ! Consistent mass matrix with 1 DOF per node. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -605,12 +599,7 @@ SUBROUTINE PENTA ( OPT, INT_ELEM_ID, IORD_IJ, IORD_K, RED_INT_SHEAR, WRITE_WARN ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG5/TETRA.f90 b/Source/EMG/EMG5/TETRA.f90 index 961f4c75..14b3570f 100644 --- a/Source/EMG/EMG5/TETRA.f90 +++ b/Source/EMG/EMG5/TETRA.f90 @@ -37,12 +37,11 @@ SUBROUTINE TETRA ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, WRITE_WARN ) ! 5) KED = element differen stiff matrix calc , if OPT(6) = 'Y' = 'Y' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_TETRA, NTSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : HALF, QUARTER, ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : TETRA_BEGEND USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : ALPVEC, BE1, BE2, DT, EID, ELGP, NUM_EMG_FATAL_ERRS, ES, KE, KED, ME, PTE, RHO, & @@ -67,7 +66,7 @@ SUBROUTINE TETRA ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, WRITE_WARN ) INTEGER(LONG) :: ID(3*ELGP) ! Array which shows equivalence of DOF's in virgin element with the ! 6 DOF/grid of the final element stiffness matrix ! Indicator of no output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TETRA_BEGEND + INTEGER(LONG) :: STR_PT_NUM ! Stress point number. 1 is center, 2+ are element nodes 1+. REAL(DOUBLE) :: ALP(6) ! First col of ALPVEC @@ -119,12 +118,7 @@ SUBROUTINE TETRA ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, WRITE_WARN ) REAL(DOUBLE) :: SSI,SSJ,SSK ! Isoparametric coordinates of a point. REAL(DOUBLE) :: M_1DOF(ELGP,ELGP) ! Consistent mass matrix with 1 DOF per node. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -476,12 +470,7 @@ SUBROUTINE TETRA ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, WRITE_WARN ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/B3D_ISOPARAMETRIC.f90 b/Source/EMG/EMG6/B3D_ISOPARAMETRIC.f90 index 36293196..6b048022 100644 --- a/Source/EMG/EMG6/B3D_ISOPARAMETRIC.f90 +++ b/Source/EMG/EMG6/B3D_ISOPARAMETRIC.f90 @@ -29,10 +29,9 @@ SUBROUTINE B3D_ISOPARAMETRIC ( DPSHX, GAUSS_PT, IGAUS, JGAUS, KGAUS, MESSAG, WRT ! Generates strain/displ matrix BMAT for solid 3D elements. Called by HEXA, PENTA and TETRA subroutines USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, F04 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : B3D_ISOPARAMETRIC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : EID, ELGP, TYPE USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -53,18 +52,13 @@ SUBROUTINE B3D_ISOPARAMETRIC ( DPSHX, GAUSS_PT, IGAUS, JGAUS, KGAUS, MESSAG, WRT INTEGER(LONG) :: II,JJ ! Counters INTEGER(LONG) :: ID(3*ELGP) ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NR = 6 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = B3D_ISOPARAMETRIC_BEGEND + REAL(DOUBLE) , INTENT(IN) :: DPSHX(3,ELGP) ! Derivatives of the 4 node bilinear isopar interps wrt elem x and y REAL(DOUBLE) , INTENT(OUT) :: BMAT(6,3*ELGP) ! Output strain-displ matrix for this elem REAL(DOUBLE) :: BW(6,12) ! Output from subr BCHECK (matrix of 3 elem strains for 14 various elem ! rigid body motions/constant strain distortions) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -139,12 +133,7 @@ SUBROUTINE B3D_ISOPARAMETRIC ( DPSHX, GAUSS_PT, IGAUS, JGAUS, KGAUS, MESSAG, WRT ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/BBDKQ.f90 b/Source/EMG/EMG6/BBDKQ.f90 index d12d04a3..d3826fe8 100644 --- a/Source/EMG/EMG6/BBDKQ.f90 +++ b/Source/EMG/EMG6/BBDKQ.f90 @@ -29,10 +29,9 @@ SUBROUTINE BBDKQ ( DPSHX, XSD, YSD, SLN, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME ! Calculate BB strain/displacement matrix for DKQ bending quadrilateral element. Called by subr QPLT1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BBDKQ_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO, THREE, FOUR USE MODEL_STUF, ONLY : EID, TYPE, XEB, XEL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -51,7 +50,7 @@ SUBROUTINE BBDKQ ( DPSHX, XSD, YSD, SLN, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME INTEGER(LONG) :: ID(12) ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NR = 3 ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NC = 12 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BBDKQ_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SLN(4) ! Quad side lengths REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Array of 4 diffs of X dim. of sides @@ -72,12 +71,6 @@ SUBROUTINE BBDKQ ( DPSHX, XSD, YSD, SLN, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME REAL(DOUBLE) :: XB(4,3) ! First 4 rows of XEB REAL(DOUBLE) :: XL(4,3) ! First 4 rows of XEL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF ! ********************************************************************************************************************************** ! Initialize outputs @@ -218,12 +211,7 @@ SUBROUTINE BBDKQ ( DPSHX, XSD, YSD, SLN, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/BBMIN3.f90 b/Source/EMG/EMG6/BBMIN3.f90 index 879f27ee..98fac8ff 100644 --- a/Source/EMG/EMG6/BBMIN3.f90 +++ b/Source/EMG/EMG6/BBMIN3.f90 @@ -29,10 +29,9 @@ SUBROUTINE BBMIN3 ( A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BB ) ! Calculate BB bending strain/displacement matrix for MIN3 triangle. Called by subr TPLT2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT, MIN4T_QUAD4_TRIA_NO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BBMIN3_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE MODEL_STUF, ONLY : EID, TYPE, XTB, XTL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -50,7 +49,7 @@ SUBROUTINE BBMIN3 ( A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BB ) INTEGER(LONG) :: ID(9) ! An input to subr BCHECK, called herein if INTEGER(LONG), PARAMETER :: NR = 3 ! An input to subr BCHECK, called herein if INTEGER(LONG), PARAMETER :: NC = 9 ! An input to subr BCHECK, called herein if - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BBMIN3_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(3) ! Diffs in x coords of elem REAL(DOUBLE) , INTENT(IN) :: B(3) ! Diffs in y coords of elem @@ -59,12 +58,6 @@ SUBROUTINE BBMIN3 ( A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BB ) REAL(DOUBLE) :: BW(3,14) ! Output from subr BCHECK (matrix of 3 elem strains for 14 various elem ! rigid body motions/constant strain distortions) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF ! ********************************************************************************************************************************** ! Initialize outputs @@ -130,12 +123,7 @@ SUBROUTINE BBMIN3 ( A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BB ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/BBMIN4.f90 b/Source/EMG/EMG6/BBMIN4.f90 index f6b73d66..06ce2633 100644 --- a/Source/EMG/EMG6/BBMIN4.f90 +++ b/Source/EMG/EMG6/BBMIN4.f90 @@ -29,10 +29,9 @@ SUBROUTINE BBMIN4 ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BB ) ! Calculate BB bending strain/displacement matrix for MIN4 quad. Called by subr QPLT2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BBMIN4_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : EID, TYPE, XEB, XEL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -52,7 +51,7 @@ SUBROUTINE BBMIN4 ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BB ) INTEGER(LONG) :: ID(8) ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NR = 3 ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NC = 8 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BBMIN4_BEGEND + REAL(DOUBLE) , INTENT(IN) :: DPSHX(2,4) ! Derivatives of the 4 node bilinear isopar interps wrt elem x and y REAL(DOUBLE) , INTENT(OUT) :: BB(3,8) ! Output strain-displ matrix for this elem @@ -62,12 +61,7 @@ SUBROUTINE BBMIN4 ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BB ) REAL(DOUBLE) :: XB(4,3) ! First 4 rows of XEB REAL(DOUBLE) :: XL(4,3) ! First 4 rows of XEL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -135,12 +129,7 @@ SUBROUTINE BBMIN4 ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BB ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/BCHECK_2D.f90 b/Source/EMG/EMG6/BCHECK_2D.f90 index 85d0b0f0..1e2e35cf 100644 --- a/Source/EMG/EMG6/BCHECK_2D.f90 +++ b/Source/EMG/EMG6/BCHECK_2D.f90 @@ -30,10 +30,9 @@ SUBROUTINE BCHECK_2D ( B, BTYPE, ID, NROWB, NCOLB, NUM_GRIDS, XB, XL, BW ) ! (6 DOF per grid point and up to 4 grid points) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_LOG + USE IOUNT1, ONLY : BUG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BCHECK_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE MODEL_STUF, ONLY : ELDOF, NELGP, TE USE MODEL_STUF, ONLY : AGRID, ELGP @@ -53,7 +52,7 @@ SUBROUTINE BCHECK_2D ( B, BTYPE, ID, NROWB, NCOLB, NUM_GRIDS, XB, XL, BW ) ! 4 grids for a 4 node plate bending elem INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: KK ! A computed index into array W - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BCHECK_BEGEND + REAL(DOUBLE) , INTENT(IN) :: B(NROWB,NCOLB) ! Strain-displ matrix REAL(DOUBLE) , INTENT(IN) :: XB(NUM_GRIDS,3) ! Basic coords of elem grids (diff than XEB for TPLT2's in a MIN4T QUAD4) @@ -65,12 +64,7 @@ SUBROUTINE BCHECK_2D ( B, BTYPE, ID, NROWB, NCOLB, NUM_GRIDS, XB, XL, BW ) REAL(DOUBLE) :: RB_DISP(6,6) ! 6 x 6 RB matrix for one grid for this element REAL(DOUBLE) :: W(24,14) ! Displs for the 14 modes of elem deformation (6 RB + 8 constant strain) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -212,12 +206,7 @@ SUBROUTINE BCHECK_2D ( B, BTYPE, ID, NROWB, NCOLB, NUM_GRIDS, XB, XL, BW ) ENDIF WRITE(BUG,*) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/BCHECK_3D.f90 b/Source/EMG/EMG6/BCHECK_3D.f90 index 5a44a057..255231ef 100644 --- a/Source/EMG/EMG6/BCHECK_3D.f90 +++ b/Source/EMG/EMG6/BCHECK_3D.f90 @@ -29,10 +29,9 @@ SUBROUTINE BCHECK_3D ( B, NUM_GRIDS, ID, NROWB, NCOLB, BW ) ! Checks strain-displacement matrices for rigid body motion and constant strain for 3-D solid elements USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, BUG, F04 + USE IOUNT1, ONLY : WRT_ERR, BUG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BCHECK_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE MODEL_STUF, ONLY : AGRID, TE, XEB, XEL @@ -51,7 +50,7 @@ SUBROUTINE BCHECK_3D ( B, NUM_GRIDS, ID, NROWB, NCOLB, BW ) ! 4 grids for a 4 node plate bending elem INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: KK ! A computed index into array W - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BCHECK_BEGEND + REAL(DOUBLE) , INTENT(IN) :: B(NROWB,NCOLB) ! Strain-displ matrix REAL(DOUBLE) , INTENT(OUT) :: BW(NROWB,12) ! Output from subr BCHECK_3D (matrix of NROWB elem strains for various @@ -63,12 +62,7 @@ SUBROUTINE BCHECK_3D ( B, NUM_GRIDS, ID, NROWB, NCOLB, BW ) REAL(DOUBLE) :: TE6(6,6) ! 6 x 6 transformation matrix with TE as 2 diagonal 3 x 3 matrices REAL(DOUBLE) :: W(6*NUM_GRIDS,12) ! Displs for the 14 modes of elem deformation (6 RB + 6 constant strain) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -203,12 +197,7 @@ SUBROUTINE BCHECK_3D ( B, NUM_GRIDS, ID, NROWB, NCOLB, BW ) WRITE(BUG,*) WRITE(BUG,9901) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/BMQMEM.f90 b/Source/EMG/EMG6/BMQMEM.f90 index 3bf8b41f..5033dd99 100644 --- a/Source/EMG/EMG6/BMQMEM.f90 +++ b/Source/EMG/EMG6/BMQMEM.f90 @@ -29,10 +29,9 @@ SUBROUTINE BMQMEM ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BM ) ! Calculate BM strain/displ matrix for 4 node membrane isoparametric element (quadratic). Called by subrs QMEM1, QSHEAR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BMQMEM_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : BMEANT, EID, HBAR, MXWARP, TYPE, XEB, XEL @@ -70,7 +69,7 @@ SUBROUTINE BMQMEM ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BM ) 19, & ! ID2(10)= 19 20, & ! ID2(11)= 20 21 /) ! ID2(12)= 21 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BMQMEM_BEGEND + REAL(DOUBLE) , INTENT(IN) :: DPSHX(2,4) ! Derivatives of the 4 node bilinear isopar interps wrt elem x and y REAL(DOUBLE) , INTENT(OUT) :: BM(3,8) ! Output strain-displ matrix for this elem @@ -81,12 +80,7 @@ SUBROUTINE BMQMEM ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BM ) REAL(DOUBLE) :: XB(4,3) ! First 4 rows of XEB REAL(DOUBLE) :: XL(4,3) ! First 4 rows of XEL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -149,12 +143,7 @@ SUBROUTINE BMQMEM ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BM ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/BSMIN3.f90 b/Source/EMG/EMG6/BSMIN3.f90 index ab749de6..3fb65466 100644 --- a/Source/EMG/EMG6/BSMIN3.f90 +++ b/Source/EMG/EMG6/BSMIN3.f90 @@ -29,10 +29,9 @@ SUBROUTINE BSMIN3 ( XI, A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BS ) ! Calculate BS shear strain/displacement matrix for MIN3 triangle. Called by subr TPLT2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT, MIN4T_QUAD4_TRIA_NO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BSMIN3_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE MODEL_STUF, ONLY : EID, TYPE, XTB, XTL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -49,7 +48,7 @@ SUBROUTINE BSMIN3 ( XI, A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BS ) INTEGER(LONG) :: ID(9) ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NR = 2 ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NC = 9 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BSMIN3_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(3) ! Vector of x coord differences REAL(DOUBLE) , INTENT(IN) :: AREA ! Elem area @@ -59,12 +58,7 @@ SUBROUTINE BSMIN3 ( XI, A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BS ) REAL(DOUBLE) :: A4 ! Constant for this elem REAL(DOUBLE) :: BW(2,14) ! Output from subr BCHECK (matrix of 2 elem strains for 14 various elem ! rigid body motions/constant strain distortions) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -137,12 +131,7 @@ SUBROUTINE BSMIN3 ( XI, A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BS ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG6/BSMIN4.f90 b/Source/EMG/EMG6/BSMIN4.f90 index 9459c2b7..ea15b308 100644 --- a/Source/EMG/EMG6/BSMIN4.f90 +++ b/Source/EMG/EMG6/BSMIN4.f90 @@ -29,11 +29,10 @@ SUBROUTINE BSMIN4 ( PSH, DPSHX, DNXSHX, DNYSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_TH ! Calculate BS shear starin/displacement matrix for MIN4 quad. Called by subr QPLT2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : BSMIN4_BEGEND USE MODEL_STUF, ONLY : EID, TYPE, XEB, XEL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -52,7 +51,7 @@ SUBROUTINE BSMIN4 ( PSH, DPSHX, DNXSHX, DNYSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_TH INTEGER(LONG) :: ID(12) ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NR = 2 ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NC = 12 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BSMIN4_BEGEND + REAL(DOUBLE) , INTENT(IN) :: PSH(4) ! 4 node bilinear isopar interp functions (used for bending) REAL(DOUBLE) , INTENT(IN) :: DPSHX(2,4) ! Derivatives of PSH shape functions wrt x and y @@ -63,12 +62,7 @@ SUBROUTINE BSMIN4 ( PSH, DPSHX, DNXSHX, DNYSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_TH REAL(DOUBLE) :: XB(4,3) ! First 4 rows of XEB REAL(DOUBLE) :: XL(4,3) ! First 4 rows of XEL ! rigid body motions/constant strain distortions) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -142,12 +136,7 @@ SUBROUTINE BSMIN4 ( PSH, DPSHX, DNXSHX, DNYSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_TH ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG7/MIN4SH.f90 b/Source/EMG/EMG7/MIN4SH.f90 index 58798adc..7fba490d 100644 --- a/Source/EMG/EMG7/MIN4SH.f90 +++ b/Source/EMG/EMG7/MIN4SH.f90 @@ -30,10 +30,9 @@ SUBROUTINE MIN4SH ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, NXSH, NYSH, DNXSHG, D ! QPLT2. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, F06, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, F06, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MIN4SH_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, EIGHT USE MIN4SH_USE_IFs @@ -45,7 +44,7 @@ SUBROUTINE MIN4SH ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, NXSH, NYSH, DNXSHG, D CHARACTER( 1*BYTE), INTENT(IN) :: WRT_BUG_THIS_TIME ! If 'Y' then write to BUG file if WRT_BUG array says to INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MIN4SH_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point coordinate REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point coordinate @@ -74,12 +73,7 @@ SUBROUTINE MIN4SH ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, NXSH, NYSH, DNXSHG, D REAL(DOUBLE) :: YP ! Intermediate variable used in calculating outputs REAL(DOUBLE) :: Y2M ! Intermediate variable used in calculating outputs -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -219,12 +213,7 @@ SUBROUTINE MIN4SH ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, NXSH, NYSH, DNXSHG, D ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG7/ORDER_GAUSS.f90 b/Source/EMG/EMG7/ORDER_GAUSS.f90 index ffeb60a0..cbf392fa 100644 --- a/Source/EMG/EMG7/ORDER_GAUSS.f90 +++ b/Source/EMG/EMG7/ORDER_GAUSS.f90 @@ -29,10 +29,9 @@ SUBROUTINE ORDER_GAUSS ( KORDER, SSS, HHH ) ! Calculates abscissa and weight coefficients for Gaussian integration of order KORDER = 1 to 10. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MEFE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ORDER_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE CONSTANTS_GAUSS, ONLY : HHV, SSV USE MODEL_STUF, ONLY : EMG_IFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS @@ -52,19 +51,14 @@ SUBROUTINE ORDER_GAUSS ( KORDER, SSS, HHH ) INTEGER(LONG) :: MM ! A computed index into SSS, HHH arrays INTEGER(LONG) :: NN ! A term in a computed index into SSS, HHH arrays INTEGER(LONG) :: IBEGIN(11) = (/0, 1, 2, 4, 6, 9,12,16,20,25,30/) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ORDER_BEGEND + REAL(DOUBLE) ,INTENT(OUT) :: SSS(MAX_ORDER_GAUSS) ! Gauss abscissa's REAL(DOUBLE) ,INTENT(OUT) :: HHH(MAX_ORDER_GAUSS) ! Gauss weight coeffs INTRINSIC MOD -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -121,12 +115,7 @@ SUBROUTINE ORDER_GAUSS ( KORDER, SSS, HHH ) CALL OUTA_HERE ( 'Y' ) ! Coding error, so quit ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG7/ORDER_TETRA.f90 b/Source/EMG/EMG7/ORDER_TETRA.f90 index 2e6975b9..a05a2020 100644 --- a/Source/EMG/EMG7/ORDER_TETRA.f90 +++ b/Source/EMG/EMG7/ORDER_TETRA.f90 @@ -29,10 +29,9 @@ SUBROUTINE ORDER_TETRA ( KORDER, SSS_I, SSS_J, SSS_K, HHH_IJK ) ! Calculates abscissa and weight coefficients for triangular integration for the TETRA element USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_TETRA USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ORDER_BEGEND USE CONSTANTS_1, ONLY : ZERO, SIXTH, QUARTER, HALF, ONE, TWO, TWELVE USE ORDER_TETRA_USE_IFs @@ -42,7 +41,7 @@ SUBROUTINE ORDER_TETRA ( KORDER, SSS_I, SSS_J, SSS_K, HHH_IJK ) INTEGER(LONG), INTENT(IN) :: KORDER ! Triangular integration order to use INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ORDER_BEGEND + REAL(DOUBLE) , INTENT(OUT) :: SSS_I (MAX_ORDER_TETRA) ! Gauss abscissa's REAL(DOUBLE) , INTENT(OUT) :: SSS_J (MAX_ORDER_TETRA) ! Gauss abscissa's @@ -51,12 +50,7 @@ SUBROUTINE ORDER_TETRA ( KORDER, SSS_I, SSS_J, SSS_K, HHH_IJK ) REAL(DOUBLE) , PARAMETER :: ALPHA = .58541020D0 ! Intermediate constant REAL(DOUBLE) , PARAMETER :: BETA = .13819660D0 ! Intermediate constant -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO I=1,MAX_ORDER_TETRA @@ -86,12 +80,7 @@ SUBROUTINE ORDER_TETRA ( KORDER, SSS_I, SSS_J, SSS_K, HHH_IJK ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG7/ORDER_TRIA.f90 b/Source/EMG/EMG7/ORDER_TRIA.f90 index c9d9b07b..8e7b574b 100644 --- a/Source/EMG/EMG7/ORDER_TRIA.f90 +++ b/Source/EMG/EMG7/ORDER_TRIA.f90 @@ -29,10 +29,9 @@ SUBROUTINE ORDER_TRIA ( KORDER, SS_I, SS_J, HH_IJ ) ! Calculates abscissa and weight coefficients for triangular integration for the PENTA element USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_TRIA USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ORDER_BEGEND USE CONSTANTS_1, ONLY : ZERO, SIXTH, THIRD, HALF, TWO USE ORDER_TRIA_USE_IFs @@ -42,7 +41,7 @@ SUBROUTINE ORDER_TRIA ( KORDER, SS_I, SS_J, HH_IJ ) INTEGER(LONG), INTENT(IN) :: KORDER ! Triangular integration order to use INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ORDER_BEGEND + REAL(DOUBLE) ,INTENT(OUT) :: SS_I(MAX_ORDER_TRIA) ! Triangular integration abscissa's REAL(DOUBLE) ,INTENT(OUT) :: SS_J(MAX_ORDER_TRIA) ! Triangular integration abscissa's @@ -55,12 +54,7 @@ SUBROUTINE ORDER_TRIA ( KORDER, SS_I, SS_J, HH_IJ ) REAL(DOUBLE) , PARAMETER :: W2 = .0661970763D0 ! Intermediate constant REAL(DOUBLE) , PARAMETER :: W3 = .0629695902D0 ! Intermediate constant -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO I=1,MAX_ORDER_TRIA @@ -98,12 +92,7 @@ SUBROUTINE ORDER_TRIA ( KORDER, SS_I, SS_J, HH_IJ ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG7/SHP2DQ.f90 b/Source/EMG/EMG7/SHP2DQ.f90 index 1d706791..57fc3f1d 100644 --- a/Source/EMG/EMG7/SHP2DQ.f90 +++ b/Source/EMG/EMG7/SHP2DQ.f90 @@ -45,10 +45,9 @@ SUBROUTINE SHP2DQ ( IGAUS, JGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI ! 1 . . . . . 5 . . . . . 2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, MEFE, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, FOUR USE MODEL_STUF, ONLY : EID, EMG_IFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS, TYPE @@ -69,7 +68,7 @@ SUBROUTINE SHP2DQ ( IGAUS, JGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: NODES_4 = 4 ! Number of nodes for one type of element INTEGER(LONG) :: NODES_8 = 8 ! Number of nodes for one type of element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHP_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point location component REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point location component @@ -81,12 +80,7 @@ SUBROUTINE SHP2DQ ( IGAUS, JGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI REAL(DOUBLE) :: XI2 ! Squares of xi coords REAL(DOUBLE) :: ET2 ! Squares of eta coords -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -228,12 +222,7 @@ SUBROUTINE SHP2DQ ( IGAUS, JGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG7/SHP3DH.f90 b/Source/EMG/EMG7/SHP3DH.f90 index 8e4f3d6e..4f8c7033 100644 --- a/Source/EMG/EMG7/SHP3DH.f90 +++ b/Source/EMG/EMG7/SHP3DH.f90 @@ -86,10 +86,9 @@ SUBROUTINE SHP3DH ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZ USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, FOUR, EIGHT USE MODEL_STUF, ONLY : EID, TYPE @@ -112,7 +111,7 @@ SUBROUTINE SHP3DH ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZ INTEGER(LONG) :: NODE(4) ! Node numbers for sets of 4 corner nodes for 20 node HEX element INTEGER(LONG) :: NODES_8 = 8 ! Number of nodes for one type of element INTEGER(LONG) :: NODES_20 = 20 ! Number of nodes for one type of element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHP_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point location component 1 REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point location component 2 @@ -123,12 +122,7 @@ SUBROUTINE SHP3DH ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZ REAL(DOUBLE) :: ET(NUM_NODES) ! Elem node location in isoparametric coord direction 2 REAL(DOUBLE) :: ZI(NUM_NODES) ! Elem node location in isoparametric coord direction 3 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -388,12 +382,7 @@ SUBROUTINE SHP3DH ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZ ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG7/SHP3DP.f90 b/Source/EMG/EMG7/SHP3DP.f90 index f880e6da..39f31c34 100644 --- a/Source/EMG/EMG7/SHP3DP.f90 +++ b/Source/EMG/EMG7/SHP3DP.f90 @@ -73,10 +73,9 @@ SUBROUTINE SHP3DP ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, INT_ USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, HALF USE MODEL_STUF, ONLY : EID, TYPE @@ -99,7 +98,7 @@ SUBROUTINE SHP3DP ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, INT_ INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: NODES_6 = 6 ! Number of nodes for one type of element INTEGER(LONG) :: NODES_15 = 15 ! Number of nodes for one type of element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHP_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point location component 1 REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point location component 2 @@ -108,12 +107,7 @@ SUBROUTINE SHP3DP ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, INT_ REAL(DOUBLE) , INTENT(OUT) :: DPSHG(3,NUM_NODES)! Derivatives of PSH with respect to xi, eta, zi. REAL(DOUBLE) :: PHI ! Intermediate variable in calculating DPSHG -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -270,12 +264,7 @@ SUBROUTINE SHP3DP ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, INT_ ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG7/SHP3DT.f90 b/Source/EMG/EMG7/SHP3DT.f90 index c7c11dd5..c944e89a 100644 --- a/Source/EMG/EMG7/SHP3DT.f90 +++ b/Source/EMG/EMG7/SHP3DT.f90 @@ -68,10 +68,9 @@ SUBROUTINE SHP3DT ( GAUSS_PT, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI, SS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, FOUR USE MODEL_STUF, ONLY : EID, TYPE @@ -91,7 +90,7 @@ SUBROUTINE SHP3DT ( GAUSS_PT, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI, SS INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: NODES_4 = 4 ! Number of nodes for one type of element INTEGER(LONG) :: NODES_10 = 10 ! Number of nodes for one type of element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHP_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point location component 1 REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point location component 2 @@ -100,12 +99,7 @@ SUBROUTINE SHP3DT ( GAUSS_PT, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI, SS REAL(DOUBLE) , INTENT(OUT) :: DPSHG(3,NUM_NODES)! Derivatives of PSH with respect to xi, eta, zi. REAL(DOUBLE) :: PHI ! Intermediate variable in calculating DPSHG -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -252,12 +246,7 @@ SUBROUTINE SHP3DT ( GAUSS_PT, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI, SS ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG8/JAC2D.f90 b/Source/EMG/EMG8/JAC2D.f90 index 3f94e539..1400a4f9 100644 --- a/Source/EMG/EMG8/JAC2D.f90 +++ b/Source/EMG/EMG8/JAC2D.f90 @@ -31,10 +31,9 @@ SUBROUTINE JAC2D ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) ! uses mid side nodes for intermediate calculations) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, MEFE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : JACOBIAN_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, FOUR USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : EID, EMG_IFE, EMG_RFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS, TYPE @@ -47,7 +46,7 @@ SUBROUTINE JAC2D ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) CHARACTER( 1*BYTE), INTENT(IN) :: WRT_BUG_THIS_TIME ! If 'Y' then write to BUG file if WRT_BUG array says to INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = JACOBIAN_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! A Gauss point coord. REAL(DOUBLE) , INTENT(IN) :: SSJ ! A Gauss point coord. @@ -58,12 +57,7 @@ SUBROUTINE JAC2D ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) REAL(DOUBLE) , INTENT(OUT) :: JACI(2,2) ! 2 x 2 inverse of JAC REAL(DOUBLE) :: EPS1 ! A small number to compare real zero -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -133,12 +127,7 @@ SUBROUTINE JAC2D ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG8/JAC3D.f90 b/Source/EMG/EMG8/JAC3D.f90 index cd387320..ae7504db 100644 --- a/Source/EMG/EMG8/JAC3D.f90 +++ b/Source/EMG/EMG8/JAC3D.f90 @@ -29,10 +29,9 @@ SUBROUTINE JAC3D ( SSI, SSJ, SSK, DPSHG, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) ! Computes Jacobian for 3D elements. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : JACOBIAN_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : EID, ELGP, NUM_EMG_FATAL_ERRS, TYPE, XEL @@ -46,7 +45,7 @@ SUBROUTINE JAC3D ( SSI, SSJ, SSK, DPSHG, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) CHARACTER( 1*BYTE), INTENT(IN) :: WRT_BUG_THIS_TIME ! If 'Y' then write to BUG file if WRT_BUG array says to INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = JACOBIAN_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! A Gauss point coord. REAL(DOUBLE) , INTENT(IN) :: SSJ ! A Gauss point coord. @@ -61,12 +60,7 @@ SUBROUTINE JAC3D ( SSI, SSJ, SSK, DPSHG, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) REAL(DOUBLE) :: XL(ELGP,3) ! Array of local element coords for the element (note: cannot use XEL ! directly since it is dimensioned MELGP x 3, not ELGP x 3) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, WRT_BUG_THIS_TIME, WRT_BUG(7), WRT_BUG(8), WRT_BUG(9) - 9001 FORMAT(1X,A,' BEGN ',F10.3, 3X, A1, 3(I3)) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -154,12 +148,7 @@ SUBROUTINE JAC3D ( SSI, SSJ, SSK, DPSHG, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG8/MATERIAL_PROPS_2D.f90 b/Source/EMG/EMG8/MATERIAL_PROPS_2D.f90 index 5c4f4a8d..a13af07d 100644 --- a/Source/EMG/EMG8/MATERIAL_PROPS_2D.f90 +++ b/Source/EMG/EMG8/MATERIAL_PROPS_2D.f90 @@ -30,10 +30,9 @@ SUBROUTINE MATERIAL_PROPS_2D ( WRITE_WARN ) ! properties (membrane, bending, transverse shear, bending/membrane coupling) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, MEFE, MEMATC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATERIAL_PROPS_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, QUAD4TYP USE MODEL_STUF, ONLY : ALPVEC, EID, EMG_IFE, EMG_RFE, ERR_SUB_NAM, EB, EBM, EM, ET, NUM_EMG_FATAL_ERRS, EMAT, & @@ -51,7 +50,7 @@ SUBROUTINE MATERIAL_PROPS_2D ( WRITE_WARN ) INTEGER(LONG) :: IERROR = 0 ! Local error indicator meaning some calcs cannot be done INTEGER(LONG) :: PROG_ERR = 0 ! Coding error indicator for invalid material type INTEGER(LONG) :: I,j ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATERIAL_PROPS_BEGEND + REAL(DOUBLE) :: ALPHA ! Isotropic coefficient of thermal expansion REAL(DOUBLE) :: ALPHA1 ! Orthotropic/Anisotropic coeff of thermal expansion in direction 1 @@ -72,12 +71,7 @@ SUBROUTINE MATERIAL_PROPS_2D ( WRITE_WARN ) REAL(DOUBLE) :: NU21 ! Orthotropic Poisson's ratio 21 INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -948,12 +942,7 @@ SUBROUTINE MATERIAL_PROPS_2D ( WRITE_WARN ) IF (IERROR > 0) RETURN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG8/MATERIAL_PROPS_3D.f90 b/Source/EMG/EMG8/MATERIAL_PROPS_3D.f90 index e43c0cfe..eb099070 100644 --- a/Source/EMG/EMG8/MATERIAL_PROPS_3D.f90 +++ b/Source/EMG/EMG8/MATERIAL_PROPS_3D.f90 @@ -29,10 +29,9 @@ SUBROUTINE MATERIAL_PROPS_3D ( WRITE_WARN ) ! Calculates material stress/strain matrices for isotropic or anisotropic 3-D solid elements USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATERIAL_PROPS_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : ALPVEC, EID, ES, EMAT, NUM_EMG_FATAL_ERRS, MTRL_TYPE, RHO, ULT_STRE, ULT_STRN, TREF, TYPE @@ -47,7 +46,7 @@ SUBROUTINE MATERIAL_PROPS_3D ( WRITE_WARN ) INTEGER(LONG) :: IERROR = 0 ! Local error indicator INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: K ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATERIAL_PROPS_BEGEND + REAL(DOUBLE) :: ALPHA ! Isotropic coefficient of thermal expansion REAL(DOUBLE) :: DEN1 ! An intermaediate variable in calculating outputs @@ -61,12 +60,7 @@ SUBROUTINE MATERIAL_PROPS_3D ( WRITE_WARN ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -211,12 +205,7 @@ SUBROUTINE MATERIAL_PROPS_3D ( WRITE_WARN ) IF (IERROR > 0) RETURN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG8/MATGET.f90 b/Source/EMG/EMG8/MATGET.f90 index 10bdd2e9..08a17efa 100644 --- a/Source/EMG/EMG8/MATGET.f90 +++ b/Source/EMG/EMG8/MATGET.f90 @@ -29,11 +29,9 @@ SUBROUTINE MATGET ( A, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, B ) ! Gets a NROW x NCOL partition of a matrix starting at row BEG_ROW and column BEG_COL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATGET_BEGEND USE MATGET_USE_IFs @@ -51,17 +49,12 @@ SUBROUTINE MATGET ( A, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, B ) INTEGER(LONG) :: ICNT ! A computed index into array A INTEGER(LONG) :: ICNT0 ! Part of ICNT INTEGER(LONG) :: II ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATGET_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NROWA*NCOLA) ! Input matrix from which a partition will be extracted REAL(DOUBLE) , INTENT(OUT) :: B(NROW*NCOL) ! Output matrix, which is the partition extracted from A -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -81,12 +74,7 @@ SUBROUTINE MATGET ( A, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, B ) ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG8/MATL_TRANSFORM_MATRIX.f90 b/Source/EMG/EMG8/MATL_TRANSFORM_MATRIX.f90 index 521a581a..2b968dbc 100644 --- a/Source/EMG/EMG8/MATL_TRANSFORM_MATRIX.f90 +++ b/Source/EMG/EMG8/MATL_TRANSFORM_MATRIX.f90 @@ -107,16 +107,15 @@ SUBROUTINE MATL_TRANSFORM_MATRIX ( T21, TS ) ! ---------------------------------------------------------------------------------------------------------------------------------- USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATL_TRANSFORM_MATRIX_BEGEND IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'MATL_TRANSFORM_MATRIX' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATL_TRANSFORM_MATRIX_BEGEND + REAL(DOUBLE), INTENT(IN) :: T21(3,3) ! 3x3 matrix that transforms a vector in coord sys 1 to coord sys 2 REAL(DOUBLE), INTENT(OUT) :: TS(6,6) ! 6x6 stress transformation matrix @@ -124,12 +123,7 @@ SUBROUTINE MATL_TRANSFORM_MATRIX ( T21, TS ) REAL(DOUBLE) :: A21,A22,A23 ! Coefficients from matrix TME REAL(DOUBLE) :: A31,A32,A33 ! Coefficients from matrix TME -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Formulate 6x6 matrix TS from terms in 3x3 matrix T12 @@ -170,12 +164,7 @@ SUBROUTINE MATL_TRANSFORM_MATRIX ( T21, TS ) TS(6,1)= A13*A11 ; TS(6,2)= A23*A21 ; TS(6,3)= A33*A31; TS(6,4)= A13*A21+A23*A11 ; TS(6,5)= A23*A31+A33*A21 ; TS(6,6)= A13*A31+A33*A11 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG8/MATPUT.f90 b/Source/EMG/EMG8/MATPUT.f90 index 36ef2e2b..1b8ef889 100644 --- a/Source/EMG/EMG8/MATPUT.f90 +++ b/Source/EMG/EMG8/MATPUT.f90 @@ -29,10 +29,8 @@ SUBROUTINE MATPUT ( B, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, A ) ! Puts a NROW x NCOL partition of a matrix into another matrix starting at row BEG_ROW and column BEG_COL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATPUT_BEGEND USE MATPUT_USE_IFs @@ -50,17 +48,12 @@ SUBROUTINE MATPUT ( B, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, A ) INTEGER(LONG) :: ICNT ! A computed index into array A INTEGER(LONG) :: ICNT0 ! Part of ICNT INTEGER(LONG) :: II ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATPUT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: B(NROW*NCOL) ! Input matrix that will be put into A REAL(DOUBLE) , INTENT(INOUT) :: A(NROWA*NCOLA) ! Output matrix, containing inserted terms from B -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ICNT0 = NROWA*(BEG_COL-2) + BEG_ROW - 1 @@ -74,12 +67,7 @@ SUBROUTINE MATPUT ( B, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, A ) ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/EMG/EMG8/ROT_AXES_MATL_TO_LOC.f90 b/Source/EMG/EMG8/ROT_AXES_MATL_TO_LOC.f90 index 1d38d802..64c67524 100644 --- a/Source/EMG/EMG8/ROT_AXES_MATL_TO_LOC.f90 +++ b/Source/EMG/EMG8/ROT_AXES_MATL_TO_LOC.f90 @@ -29,7 +29,7 @@ SUBROUTINE ROT_AXES_MATL_TO_LOC ( WRITE_WARN ) ! Rotates material and CTE matrices from the material axes (specified on connection entry) to element local axes USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEMATC, NCORD USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE, TWO @@ -37,7 +37,6 @@ SUBROUTINE ROT_AXES_MATL_TO_LOC ( WRITE_WARN ) RCORD, TE, THETAM, TYPE USE PARAMS, ONLY : EPSIL USE DEBUG_PARAMETERS - USE SUBR_BEGEND_LEVELS, ONLY : ROT_AXES_MATL_TO_LOC_BEGEND USE ROT_AXES_MATL_TO_LOC_USE_IFs @@ -47,7 +46,7 @@ SUBROUTINE ROT_AXES_MATL_TO_LOC ( WRITE_WARN ) CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y' write warning messages, otherwise do not CHARACTER( 1*BYTE) :: FOUND ! If 'Y' we found something we were looking for - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROT_AXES_MATL_TO_LOC_BEGEND + INTEGER(LONG) :: CORDM ! Actual coord system ID (CORDM on PSOLID Bulk Data entry) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: ICORD ! Internal coord system ID for CORDM @@ -74,12 +73,7 @@ SUBROUTINE ROT_AXES_MATL_TO_LOC ( WRITE_WARN ) REAL(DOUBLE) :: ES0(6,6) ! 3D stress matl matrix before coord transformation REAL(DOUBLE) :: ET0(2,2) ! 2D transverse shear matl matrix before coord transformation -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -223,12 +217,7 @@ SUBROUTINE ROT_AXES_MATL_TO_LOC ( WRITE_WARN ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/Interfaces/ALLOCATED_MEMORY_Interface.f90 b/Source/Interfaces/ALLOCATED_MEMORY_Interface.f90 index cfc4d1d2..ac865570 100644 --- a/Source/Interfaces/ALLOCATED_MEMORY_Interface.f90 +++ b/Source/Interfaces/ALLOCATED_MEMORY_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE ALLOCATED_MEMORY ( ARRAY_NAME, MB_ALLOCATED, WHAT, WRITE_TABLE, CURRE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : SUPINFO diff --git a/Source/Interfaces/ALLOCATE_CB_ELM_OTM_Interface.f90 b/Source/Interfaces/ALLOCATE_CB_ELM_OTM_Interface.f90 index 9ac411a7..84e12faa 100644 --- a/Source/Interfaces/ALLOCATE_CB_ELM_OTM_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_CB_ELM_OTM_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, & ELOUT_ELFE_BIT, ELOUT_ELFN_BIT, ELOUT_STRE_BIT, ELOUT_STRN_BIT, & @@ -46,13 +46,12 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC USE OUTPUT4_MATRICES, ONLY : OTM_ELFE, OTM_ELFN, OTM_STRE, OTM_STRN, TXT_ELFE, TXT_ELFN, TXT_STRE, TXT_STRN USE PARAMS, ONLY : OTMSKIP - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_CB_ELM_OTM_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME_IN ! Array name of the matrix to be allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_CB_ELM_OTM_BEGEND + END SUBROUTINE ALLOCATE_CB_ELM_OTM diff --git a/Source/Interfaces/ALLOCATE_CB_GRD_OTM_Interface.f90 b/Source/Interfaces/ALLOCATE_CB_GRD_OTM_Interface.f90 index d4961748..cff0a187 100644 --- a/Source/Interfaces/ALLOCATE_CB_GRD_OTM_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_CB_GRD_OTM_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC, & GROUT_ACCE_BIT, GROUT_DISP_BIT, GROUT_SPCF_BIT, GROUT_MPCF_BIT, & IBIT, NDOFR, NGRID, NUM_CB_DOFS, NVEC, & @@ -43,13 +43,12 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) USE PARAMS, ONLY : OTMSKIP USE MODEL_STUF, ONLY : GRID, GROUT USE OUTPUT4_MATRICES, ONLY : OTM_ACCE, OTM_DISP, OTM_MPCF, OTM_SPCF, TXT_ACCE, TXT_DISP, TXT_MPCF, TXT_SPCF - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_CB_GRD_OTM_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME_IN ! Array name of the matrix to be allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_CB_GRD_OTM_BEGEND + END SUBROUTINE ALLOCATE_CB_GRD_OTM diff --git a/Source/Interfaces/ALLOCATE_COL_VEC_Interface.f90 b/Source/Interfaces/ALLOCATE_COL_VEC_Interface.f90 index 46441a51..b7003855 100644 --- a/Source/Interfaces/ALLOCATE_COL_VEC_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_COL_VEC_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_COL_VEC ( NAME, NROWS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_COL_VEC_BEGEND USE OUTPUT4_MATRICES, ONLY : OU4_MAT_COL_GRD_COMP, OU4_MAT_ROW_GRD_COMP USE COL_VECS, ONLY : UG_COL, UN_COL, UM_COL, UF_COL, US_COL, UA_COL, UO_COL, UO0_COL, UR_COL, UL_COL, YSe, & FG_COL, FN_COL, FM_COL, FF_COL, FS_COL, FA_COL, FO_COL, FL_COL, FR_COL, & @@ -53,7 +52,7 @@ SUBROUTINE ALLOCATE_COL_VEC ( NAME, NROWS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows for matrix NAME INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_COL_VEC_BEGEND + END SUBROUTINE ALLOCATE_COL_VEC diff --git a/Source/Interfaces/ALLOCATE_DOF_TABLES_Interface.f90 b/Source/Interfaces/ALLOCATE_DOF_TABLES_Interface.f90 index fc7b25fa..4b5a713f 100644 --- a/Source/Interfaces/ALLOCATE_DOF_TABLES_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_DOF_TABLES_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_DOF_TABLES ( NAME, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, SIX, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LDOFG, LGRID, MTDOF, MTSET, NUM_USET, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_DOF_TABLES_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START, TDOFI, TSET, USET IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE ALLOCATE_DOF_TABLES ( NAME, CALLING_SUBR ) CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_DOF_TABLES_BEGEND + END SUBROUTINE ALLOCATE_DOF_TABLES diff --git a/Source/Interfaces/ALLOCATE_EIGEN1_MAT_Interface.f90 b/Source/Interfaces/ALLOCATE_EIGEN1_MAT_Interface.f90 index ef232719..3f570944 100644 --- a/Source/Interfaces/ALLOCATE_EIGEN1_MAT_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_EIGEN1_MAT_Interface.f90 @@ -34,10 +34,9 @@ SUBROUTINE ALLOCATE_EIGEN1_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_EIGEN1_MAT_BEGEND USE EIGEN_MATRICES_1 , ONLY : EIGEN_VAL, EIGEN_VEC, GEN_MASS, MODE_NUM, MEFFMASS, MPFACTOR_N6, MPFACTOR_NR IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE ALLOCATE_EIGEN1_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows to allocate to matrix NAME INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols to allocate to matrix NAME - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_EIGEN1_MAT_BEGEND + END SUBROUTINE ALLOCATE_EIGEN1_MAT diff --git a/Source/Interfaces/ALLOCATE_EMS_ARRAYS_Interface.f90 b/Source/Interfaces/ALLOCATE_EMS_ARRAYS_Interface.f90 index 078efcc2..a6f438c1 100644 --- a/Source/Interfaces/ALLOCATE_EMS_ARRAYS_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_EMS_ARRAYS_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, TWO, ONEPP6 - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO, LTERM_MGGE, NDOFG, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE EMS_ARRAYS, ONLY : EMS, EMSCOL, EMSKEY, EMSPNT - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_EMS_ARRAYS_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER( 6*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_EMS_ARRAYS_BEGEND + END SUBROUTINE ALLOCATE_EMS_ARRAYS diff --git a/Source/Interfaces/ALLOCATE_FEMAP_DATA_Interface.f90 b/Source/Interfaces/ALLOCATE_FEMAP_DATA_Interface.f90 index ee5a7d76..7c3a3a1b 100644 --- a/Source/Interfaces/ALLOCATE_FEMAP_DATA_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_FEMAP_DATA_Interface.f90 @@ -34,9 +34,8 @@ SUBROUTINE ALLOCATE_FEMAP_DATA ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_FEMAP_COLS, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_FEMAP_DATA_BEGEND USE FEMAP_ARRAYS, ONLY : FEMAP_EL_VECS, FEMAP_EL_NUMS IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE ALLOCATE_FEMAP_DATA ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in array INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in array FEMAP_EL_VECS - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_FEMAP_DATA_BEGEND + END SUBROUTINE ALLOCATE_FEMAP_DATA diff --git a/Source/Interfaces/ALLOCATE_FULL_MAT_Interface.f90 b/Source/Interfaces/ALLOCATE_FULL_MAT_Interface.f90 index 249ffbe6..1c3b65d9 100644 --- a/Source/Interfaces/ALLOCATE_FULL_MAT_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_FULL_MAT_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_FULL_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_FULL_MAT_BEGEND USE FULL_MATRICES, ONLY : KNN_FULL, KNM_FULL, KMM_FULL, MNN_FULL, MNM_FULL, MMM_FULL, PN_FULL, PM_FULL, & KFF_FULL, KFS_FULL, KSS_FULL, MFF_FULL, MFS_FULL, MSS_FULL, PF_FULL, PS_FULL, & KAA_FULL, KAO_FULL, KOO_FULL, MAA_FULL, MAO_FULL, MOO_FULL, PA_FULL, PO_FULL, & @@ -52,7 +51,7 @@ SUBROUTINE ALLOCATE_FULL_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Nunber of rows in array NAME being allocated INTEGER(LONG), INTENT(IN) :: NCOLS ! Nunber of cols in array NAME being allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_FULL_MAT_BEGEND + END SUBROUTINE ALLOCATE_FULL_MAT diff --git a/Source/Interfaces/ALLOCATE_IN4_FILES_Interface.f90 b/Source/Interfaces/ALLOCATE_IN4_FILES_Interface.f90 index ed796a52..18d54007 100644 --- a/Source/Interfaces/ALLOCATE_IN4_FILES_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_IN4_FILES_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN4FIL, IN4FIL_NUM, LNUM_IN4_FILES, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN4FIL, IN4FIL_NUM, LNUM_IN4_FILES, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE INPUTT4_MATRICES, ONLY : IN4_COL_MAP, IN4_MAT - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_IN4_FILES_BEGEND IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Nunber of rows in array NAME_IN being allocated INTEGER(LONG), INTENT(IN) :: NCOLS ! Nunber of cols in array NAME_IN being allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_IN4_FILES_BEGEND + END SUBROUTINE ALLOCATE_IN4_FILES diff --git a/Source/Interfaces/ALLOCATE_L1_MGG_Interface.f90 b/Source/Interfaces/ALLOCATE_L1_MGG_Interface.f90 index c5ddb1dc..ce37ee29 100644 --- a/Source/Interfaces/ALLOCATE_L1_MGG_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_L1_MGG_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NTERM_MGG, NTERM_MGGC, NTERM_MGGE, NTERM_MGGS, & TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_L1_MGG_BEGEND USE SPARSE_MATRICES, ONLY : I_MGG, I2_MGG, J_MGG, MGG, I_MGGC, J_MGGC, MGGC, I_MGGE, J_MGGE, MGGE, I_MGGS, J_MGGS, MGGS IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(6*BYTE) :: NAMEO ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_L1_MGG_BEGEND + END SUBROUTINE ALLOCATE_L1_MGG diff --git a/Source/Interfaces/ALLOCATE_L2_GMN_2_Interface.f90 b/Source/Interfaces/ALLOCATE_L2_GMN_2_Interface.f90 index 404b8431..4903ede7 100644 --- a/Source/Interfaces/ALLOCATE_L2_GMN_2_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_L2_GMN_2_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_L2_GMN_2 ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFM, NTERM_GMN, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_L2_GMN_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_GMN IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE ALLOCATE_L2_GMN_2 ( CALLING_SUBR ) CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_L2_GMN_2_BEGEND + END SUBROUTINE ALLOCATE_L2_GMN_2 diff --git a/Source/Interfaces/ALLOCATE_L2_GOA_2_Interface.f90 b/Source/Interfaces/ALLOCATE_L2_GOA_2_Interface.f90 index d853d5eb..3e2b5250 100644 --- a/Source/Interfaces/ALLOCATE_L2_GOA_2_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_L2_GOA_2_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_L2_GOA_2 ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NTERM_GOA, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_L2_GOA_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_GOA IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE ALLOCATE_L2_GOA_2 ( CALLING_SUBR ) CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_L2_GOA_2_BEGEND + END SUBROUTINE ALLOCATE_L2_GOA_2 diff --git a/Source/Interfaces/ALLOCATE_L6_2_Interface.f90 b/Source/Interfaces/ALLOCATE_L6_2_Interface.f90 index 7dae6833..11fb4437 100644 --- a/Source/Interfaces/ALLOCATE_L6_2_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_L6_2_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_L6_2 ( NAME, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NTERM_DLR, NTERM_PHIZL1, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_L6_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_DLR, I2_DLRt, I2_PHIZL1, I2_PHIZL1t IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE ALLOCATE_L6_2 ( NAME, CALLING_SUBR ) CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_L6_2_BEGEND + END SUBROUTINE ALLOCATE_L6_2 diff --git a/Source/Interfaces/ALLOCATE_LAPACK_MAT_Interface.f90 b/Source/Interfaces/ALLOCATE_LAPACK_MAT_Interface.f90 index 837aa9dd..cb627642 100644 --- a/Source/Interfaces/ALLOCATE_LAPACK_MAT_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_LAPACK_MAT_Interface.f90 @@ -33,12 +33,11 @@ SUBROUTINE ALLOCATE_LAPACK_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE, ONEPP6 - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : WINAMEM - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_LAPACK_MAT_BEGEND USE ARPACK_MATRICES_1 , ONLY : IWORK, RFAC, RESID, SELECT, VBAS, WORKD, WORKL USE LAPACK_DPB_MATRICES, ONLY : ABAND, BBAND, LAPACK_S, RES @@ -50,7 +49,7 @@ SUBROUTINE ALLOCATE_LAPACK_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in array to be allocated INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in array to be allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_LAPACK_MAT_BEGEND + END SUBROUTINE ALLOCATE_LAPACK_MAT diff --git a/Source/Interfaces/ALLOCATE_LINK9_STUF_Interface.f90 b/Source/Interfaces/ALLOCATE_LINK9_STUF_Interface.f90 index 3c66ecbb..7db1b04c 100644 --- a/Source/Interfaces/ALLOCATE_LINK9_STUF_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_LINK9_STUF_Interface.f90 @@ -34,9 +34,8 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, TWO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MELGP, MMSPRNT, MOGEL, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_LINK9_STUF_BEGEND USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, EID_OUT_ARRAY, FTNAME, MAXREQ, MSPRNT, OGEL, POLY_FIT_ERR, & POLY_FIT_ERR_INDEX @@ -45,7 +44,7 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_LINK9_STUF_BEGEND + END SUBROUTINE ALLOCATE_LINK9_STUF diff --git a/Source/Interfaces/ALLOCATE_MISC_MAT_Interface.f90 b/Source/Interfaces/ALLOCATE_MISC_MAT_Interface.f90 index 1d7d249e..51f4c397 100644 --- a/Source/Interfaces/ALLOCATE_MISC_MAT_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_MISC_MAT_Interface.f90 @@ -34,11 +34,10 @@ SUBROUTINE ALLOCATE_MISC_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE MISC_MATRICES, ONLY : UG_T123_MAT - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_MISC_MAT_BEGEND IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE ALLOCATE_MISC_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows to allocate to matrix NAME INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols to allocate to matrix NAME - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_MISC_MAT_BEGEND + END SUBROUTINE ALLOCATE_MISC_MAT diff --git a/Source/Interfaces/ALLOCATE_MODEL_STUF_Interface.f90 b/Source/Interfaces/ALLOCATE_MODEL_STUF_Interface.f90 index c844b6fa..196139e2 100644 --- a/Source/Interfaces/ALLOCATE_MODEL_STUF_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_MODEL_STUF_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, TWO, THREE, SIX, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE SCONTR, ONLY : LBAROFF, LBUSHOFF, LCMASS, LCONM2, LCORD, LEDAT, LELE, LFORCE, LGRAV, LGRID, & LIND_GRDS_MPCS, LLOADC, LLOADR, LMATANGLE, LMATL, LMPC, LMPCADDC, LMPCADDR, LPBAR, LPBEAM,& @@ -49,7 +49,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) USE SCONTR, ONLY : NDOFG, NGRID, NMPC, NPCOMP, NPLOAD4_3D, NRBAR, NRBE1, NRBE2, NSPC, NTSUB, NUM_MPCSIDS, & NUM_SPCSIDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_MODEL_STUF_BEGEND USE MODEL_STUF, ONLY : AGRID, BE1, BE2, BE3, BGRID, DOFPIN, DT, ME, OFFDIS, OFFDIS_B, OFFSET, KE, KED, KEM, & PEB, PEG, PEL, PPE, PRESS, PTE, SE1, SE2, SE3, STE1, STE2, STE3, UEB, UEG, UEL, UGG, & @@ -85,7 +84,7 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(31*BYTE) :: NAME ! Specific array name used for output error message - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_MODEL_STUF_BEGEND + END SUBROUTINE ALLOCATE_MODEL_STUF diff --git a/Source/Interfaces/ALLOCATE_NL_PARAMS_Interface.f90 b/Source/Interfaces/ALLOCATE_NL_PARAMS_Interface.f90 index 106be54d..500d4f5f 100644 --- a/Source/Interfaces/ALLOCATE_NL_PARAMS_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_NL_PARAMS_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE ALLOCATE_NL_PARAMS ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LSUB, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : NL_SID - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_NL_PARAMS_BEGEND IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE ALLOCATE_NL_PARAMS ( CALLING_SUBR ) CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_NL_PARAMS_BEGEND + END SUBROUTINE ALLOCATE_NL_PARAMS diff --git a/Source/Interfaces/ALLOCATE_RBGLOBAL_Interface.f90 b/Source/Interfaces/ALLOCATE_RBGLOBAL_Interface.f90 index 1854aa06..988cc310 100644 --- a/Source/Interfaces/ALLOCATE_RBGLOBAL_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_RBGLOBAL_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_RBGLOBAL ( SET, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFG, NDOFN, NDOFF, NDOFA, NDOFL, NDOFR, BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_RBGLOBAL_BEGEND USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_NSET, RBGLOBAL_FSET, RBGLOBAL_ASET, RBGLOBAL_LSET, & TR6_CG, TR6_MEFM, TR6_0 @@ -48,7 +47,7 @@ SUBROUTINE ALLOCATE_RBGLOBAL ( SET, CALLING_SUBR ) CHARACTER(14*BYTE) :: NAME ! Specific array name used for output error message INTEGER(LONG), PARAMETER :: NCOLS = 6 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_RBGLOBAL_BEGEND + END SUBROUTINE ALLOCATE_RBGLOBAL diff --git a/Source/Interfaces/ALLOCATE_SCR_CCS_MAT_Interface.f90 b/Source/Interfaces/ALLOCATE_SCR_CCS_MAT_Interface.f90 index 48d9ca85..872dc666 100644 --- a/Source/Interfaces/ALLOCATE_SCR_CCS_MAT_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_SCR_CCS_MAT_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_SCR_CCS_MAT ( NAME, NCOLS, NTERMS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_SCR_CCS_MAT_BEGEND USE SCRATCH_MATRICES , ONLY : I_CCS1, J_CCS1, CCS1, I_CCS2, J_CCS2, CCS2, I_CCS3, J_CCS3, CCS3 IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE ALLOCATE_SCR_CCS_MAT ( NAME, NCOLS, NTERMS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols for matrix CCSi INTEGER(LONG), INTENT(IN) :: NTERMS ! Number of nonzero terms that will be in matrix CCSi - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_SCR_CCS_MAT_BEGEND + END SUBROUTINE ALLOCATE_SCR_CCS_MAT diff --git a/Source/Interfaces/ALLOCATE_SCR_CRS_MAT_Interface.f90 b/Source/Interfaces/ALLOCATE_SCR_CRS_MAT_Interface.f90 index 088e9371..da69cbdd 100644 --- a/Source/Interfaces/ALLOCATE_SCR_CRS_MAT_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_SCR_CRS_MAT_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_SCR_CRS_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_SCR_CRS_MAT_BEGEND USE SCRATCH_MATRICES , ONLY : I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CRS3, J_CRS3, CRS3 IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE ALLOCATE_SCR_CRS_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows for matrix CRSi INTEGER(LONG), INTENT(IN) :: NTERMS ! Number of nonzero terms that will be in matrix CRSi - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_SCR_CRS_MAT_BEGEND + END SUBROUTINE ALLOCATE_SCR_CRS_MAT diff --git a/Source/Interfaces/ALLOCATE_SPARSE_ALG_Interface.f90 b/Source/Interfaces/ALLOCATE_SPARSE_ALG_Interface.f90 index 126e5709..96f1fb27 100644 --- a/Source/Interfaces/ALLOCATE_SPARSE_ALG_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_SPARSE_ALG_Interface.f90 @@ -34,10 +34,9 @@ SUBROUTINE ALLOCATE_SPARSE_ALG ( NAME, NROW1, NROW2, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_SPARSE_ALG_BEGEND USE SPARSE_ALG_ARRAYS, ONLY : ALG, AROW, J_AROW, LOGICAL_VEC, REAL_VEC IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE ALLOCATE_SPARSE_ALG ( NAME, NROW1, NROW2, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROW1 ! Number of rows, or starting row num, to allocate to matrix NAME INTEGER(LONG), INTENT(IN) :: NROW2 ! End row number in allocation INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_SPARSE_ALG_BEGEND + END SUBROUTINE ALLOCATE_SPARSE_ALG diff --git a/Source/Interfaces/ALLOCATE_SPARSE_MAT_Interface.f90 b/Source/Interfaces/ALLOCATE_SPARSE_MAT_Interface.f90 index 15805429..f0f51340 100644 --- a/Source/Interfaces/ALLOCATE_SPARSE_MAT_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_SPARSE_MAT_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE ALLOCATE_SPARSE_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFM, NDOFO, NDOFS, NDOFR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_SPARSE_MAT_BEGEND USE SPARSE_MATRICES , ONLY : I_KGG , J_KGG , KGG , I_MGG , J_MGG , MGG , I_PG , J_PG , PG , & I_KGGD , J_KGGD , KGGD , & @@ -96,7 +95,7 @@ SUBROUTINE ALLOCATE_SPARSE_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows for matrix NAME INTEGER(LONG), INTENT(IN) :: NTERMS ! Number of nonzero terms that will be in matrix NAME - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_SPARSE_MAT_BEGEND + END SUBROUTINE ALLOCATE_SPARSE_MAT diff --git a/Source/Interfaces/ALLOCATE_STF_ARRAYS_Interface.f90 b/Source/Interfaces/ALLOCATE_STF_ARRAYS_Interface.f90 index e8627f33..f1555947 100644 --- a/Source/Interfaces/ALLOCATE_STF_ARRAYS_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_STF_ARRAYS_Interface.f90 @@ -33,14 +33,13 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, TWO, ONEPP6 - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO, LTERM_KGG, LTERM_KGGD, NDOFG, SOL_NAME, & TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE PARAMS, ONLY : MEMAFAC, MXALLOCA, SUPINFO, WINAMEM USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE STF_ARRAYS, ONLY : STF, STFCOL, STFKEY, STFPNT, STF3 - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_STF_ARRAYS_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_STF_ARRAYS_BEGEND + END SUBROUTINE ALLOCATE_STF_ARRAYS diff --git a/Source/Interfaces/ALLOCATE_TEMPLATE_Interface.f90 b/Source/Interfaces/ALLOCATE_TEMPLATE_Interface.f90 index 743daf2f..0d1de7d5 100644 --- a/Source/Interfaces/ALLOCATE_TEMPLATE_Interface.f90 +++ b/Source/Interfaces/ALLOCATE_TEMPLATE_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE ALLOCATE_TEMPLATE ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_TEMPLATE_BEGEND USE STF_TEMPLATE_ARRAYS, ONLY : CROW, TEMPLATE IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE ALLOCATE_TEMPLATE ( CALLING_SUBR ) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_TEMPLATE_BEGEND + END SUBROUTINE ALLOCATE_TEMPLATE diff --git a/Source/Interfaces/ARPACK_INFO_MSG_Interface.f90 b/Source/Interfaces/ARPACK_INFO_MSG_Interface.f90 index 93dbc481..1f5ccd3a 100644 --- a/Source/Interfaces/ARPACK_INFO_MSG_Interface.f90 +++ b/Source/Interfaces/ARPACK_INFO_MSG_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE ARPACK_INFO_MSG ( SUBNAME, INFO, IPARAM, LWORKL, NEV, NCV ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : PROG_NAME, FATAL_ERR, NDOFL, WARN_ERR - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : DARPACK, SUPWARN USE MODEL_STUF, ONLY : EIG_N2 diff --git a/Source/Interfaces/ARRAY_SIZE_ERROR_1_Interface.f90 b/Source/Interfaces/ARRAY_SIZE_ERROR_1_Interface.f90 index 8ccb07ef..e0ef72a9 100644 --- a/Source/Interfaces/ARRAY_SIZE_ERROR_1_Interface.f90 +++ b/Source/Interfaces/ARRAY_SIZE_ERROR_1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ARRAY_SIZE_ERROR_1 ( INP_SUBR_NAME, NTERM_VAL, MATIN_NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ARRAY_SIZE_ERROR_1_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE ARRAY_SIZE_ERROR_1 ( INP_SUBR_NAME, NTERM_VAL, MATIN_NAME ) CHARACTER(LEN=*), INTENT(IN) :: MATIN_NAME ! Name of matrix (for output message purposes) INTEGER(LONG), INTENT(IN) :: NTERM_VAL ! Size of the array that was exceeded - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ARRAY_SIZE_ERROR_1_BEGEND + END SUBROUTINE ARRAY_SIZE_ERROR_1 diff --git a/Source/Interfaces/AUTOSPC_SUMMARY_MSGS_Interface.f90 b/Source/Interfaces/AUTOSPC_SUMMARY_MSGS_Interface.f90 index f719fcc2..b36335d4 100644 --- a/Source/Interfaces/AUTOSPC_SUMMARY_MSGS_Interface.f90 +++ b/Source/Interfaces/AUTOSPC_SUMMARY_MSGS_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE AUTOSPC_SUMMARY_MSGS ( ASPC_SUM_MSG1, ASPC_SUM_MSG2, ASPC_SUM_MSG3, W USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE PARAMS, ONLY : AUTOSPC_RAT IMPLICIT NONE diff --git a/Source/Interfaces/B3D_ISOPARAMETRIC_Interface.f90 b/Source/Interfaces/B3D_ISOPARAMETRIC_Interface.f90 index 2755ba6e..80618b72 100644 --- a/Source/Interfaces/B3D_ISOPARAMETRIC_Interface.f90 +++ b/Source/Interfaces/B3D_ISOPARAMETRIC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE B3D_ISOPARAMETRIC ( DPSHX, GAUSS_PT, IGAUS, JGAUS, KGAUS, MESSAG, WRT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, F04 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : B3D_ISOPARAMETRIC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : EID, ELGP, TYPE USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -50,7 +49,7 @@ SUBROUTINE B3D_ISOPARAMETRIC ( DPSHX, GAUSS_PT, IGAUS, JGAUS, KGAUS, MESSAG, WRT INTEGER(LONG), INTENT(IN) :: JGAUS ! J index of Gaus point (needed for some optional output) INTEGER(LONG), INTENT(IN) :: KGAUS ! K index of Gaus point (needed for some optional output) INTEGER(LONG), PARAMETER :: NR = 6 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = B3D_ISOPARAMETRIC_BEGEND + REAL(DOUBLE) , INTENT(IN) :: DPSHX(3,ELGP) ! Derivatives of the 4 node bilinear isopar interps wrt elem x and y REAL(DOUBLE) , INTENT(OUT) :: BMAT(6,3*ELGP) ! Output strain-displ matrix for this elem diff --git a/Source/Interfaces/BANDGEN_LAPACK_DGB_Interface.f90 b/Source/Interfaces/BANDGEN_LAPACK_DGB_Interface.f90 index 8fbed8a2..19ab4816 100644 --- a/Source/Interfaces/BANDGEN_LAPACK_DGB_Interface.f90 +++ b/Source/Interfaces/BANDGEN_LAPACK_DGB_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE BANDGEN_LAPACK_DGB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SPARSTOR - USE SUBR_BEGEND_LEVELS, ONLY : BANDGEN_BEGEND IMPLICIT NONE @@ -50,7 +49,7 @@ SUBROUTINE BANDGEN_LAPACK_DGB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN INTEGER(LONG), INTENT(IN) :: I_MATIN(N+1) ! Array of row no's for terms in matrix MATIN INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERM_MATIN) ! Array of col no's for terms in matrix MATIN INTEGER(LONG), INTENT(IN) :: KD ! Number of sub (or super) diagonals in matrix MATIN. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BANDGEN_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM_MATIN) ! Array of terms in sparse matrix MATIN REAL(DOUBLE) , INTENT(INOUT) :: MATOUT(3*KD+1,N) ! Array of terms in band matrix MATOUT diff --git a/Source/Interfaces/BANDGEN_LAPACK_DPB_Interface.f90 b/Source/Interfaces/BANDGEN_LAPACK_DPB_Interface.f90 index 25493aca..f8c2b9c4 100644 --- a/Source/Interfaces/BANDGEN_LAPACK_DPB_Interface.f90 +++ b/Source/Interfaces/BANDGEN_LAPACK_DPB_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE BANDGEN_LAPACK_DPB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SPARSTOR - USE SUBR_BEGEND_LEVELS, ONLY : BANDGEN_BEGEND IMPLICIT NONE @@ -50,7 +49,7 @@ SUBROUTINE BANDGEN_LAPACK_DPB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN INTEGER(LONG), INTENT(IN) :: I_MATIN(N+1) ! Array of row no's for terms in matrix MATIN INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERM_MATIN) ! Array of col no's for terms in matrix MATIN INTEGER(LONG), INTENT(IN) :: KD ! Number of sub (or super) diagonals in matrix MATIN. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BANDGEN_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM_MATIN) ! Array of terms in sparse matrix MATIN REAL(DOUBLE) , INTENT(INOUT) :: MATOUT(KD+1,N) ! Array of terms in band matrix MATOUT diff --git a/Source/Interfaces/BANDSIZ_Interface.f90 b/Source/Interfaces/BANDSIZ_Interface.f90 index 673062a6..e3cbf168 100644 --- a/Source/Interfaces/BANDSIZ_Interface.f90 +++ b/Source/Interfaces/BANDSIZ_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BANDSIZ ( N, NTERM_MATIN, I_MATIN, J_MATIN, KD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BANDSIZ_BEGEND IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BANDSIZ ( N, NTERM_MATIN, I_MATIN, J_MATIN, KD ) INTEGER(LONG), INTENT(IN) :: I_MATIN(N+1) ! Array of row no's for terms in matrix MATIN INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERM_MATIN) ! Array of col no's for terms in matrix MATIN INTEGER(LONG), INTENT(OUT) :: KD ! Number of sub (or super) diagonals in matrix MATIN. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BANDSIZ_BEGEND + END SUBROUTINE BANDSIZ diff --git a/Source/Interfaces/BAR1_Interface.f90 b/Source/Interfaces/BAR1_Interface.f90 index 9ef53c1b..aa5e629c 100644 --- a/Source/Interfaces/BAR1_Interface.f90 +++ b/Source/Interfaces/BAR1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BAR1 ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, NTSUB, BLNK_SUB_NAM, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BAR1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX, TEN, TWELVE USE DEBUG_PARAMETERS USE PARAMS, ONLY : EPSIL, ART_KED, ART_ROT_KED, ART_TRAN_KED @@ -48,7 +47,7 @@ SUBROUTINE BAR1 ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BAR1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: ALPHA ! Coefficient of thermal expansion REAL(DOUBLE) , INTENT(IN) :: AREA ! Cross-sectional area diff --git a/Source/Interfaces/BART_Interface.f90 b/Source/Interfaces/BART_Interface.f90 index b2b69f59..71b1d70f 100644 --- a/Source/Interfaces/BART_Interface.f90 +++ b/Source/Interfaces/BART_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BART ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, NTSUB, BLNK_SUB_NAM, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BAR1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX, TEN, TWELVE USE DEBUG_PARAMETERS USE PARAMS, ONLY : EPSIL, ART_KED, ART_ROT_KED, ART_TRAN_KED @@ -48,7 +47,7 @@ SUBROUTINE BART ( OPT, L, AREA, I1, I2, JTOR, SCOEFF, K1, K2, I12, E, G, ALPHA, CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BAR1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: ALPHA ! Coefficient of thermal expansion REAL(DOUBLE) , INTENT(IN) :: AREA ! Cross-sectional area diff --git a/Source/Interfaces/BAR_MARGIN_Interface.f90 b/Source/Interfaces/BAR_MARGIN_Interface.f90 index aec4678f..131669f0 100644 --- a/Source/Interfaces/BAR_MARGIN_Interface.f90 +++ b/Source/Interfaces/BAR_MARGIN_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BAR_MARGIN ( ICOL, S1, S2, S3, S4, S5, MS1, MS2, MS3, MSP1, MSP2, MSP USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BAR_MARGIN_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, ONEPM6, ONEPM15, ONEPP10 USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : ULT_STRE @@ -47,7 +46,7 @@ SUBROUTINE BAR_MARGIN ( ICOL, S1, S2, S3, S4, S5, MS1, MS2, MS3, MSP1, MSP2, MSP CHARACTER(LEN=*), INTENT(OUT) :: MSP3 ! If '1', print margins in F06 file. If '0', do not print. INTEGER(LONG), INTENT(IN) :: ICOL ! Column no. from ULT_STRE to get max allow. stresses - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BAR_MARGIN_BEGEND + REAL(DOUBLE), INTENT(OUT) :: MS1 ! Calculated margin of safety REAL(DOUBLE), INTENT(OUT) :: MS2 ! Calculated margin of safety diff --git a/Source/Interfaces/BBDKQ_Interface.f90 b/Source/Interfaces/BBDKQ_Interface.f90 index bc62e9a8..88baced8 100644 --- a/Source/Interfaces/BBDKQ_Interface.f90 +++ b/Source/Interfaces/BBDKQ_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BBDKQ ( DPSHX, XSD, YSD, SLN, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BBDKQ_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO, THREE, FOUR USE MODEL_STUF, ONLY : EID, TYPE, XEB, XEL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -49,7 +48,7 @@ SUBROUTINE BBDKQ ( DPSHX, XSD, YSD, SLN, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME INTEGER(LONG), INTENT(IN) :: JGAUS ! J index of Gaus point (needed for some optional output) INTEGER(LONG), PARAMETER :: NR = 3 ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NC = 12 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BBDKQ_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SLN(4) ! Quad side lengths REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Array of 4 diffs of X dim. of sides diff --git a/Source/Interfaces/BBMIN3_Interface.f90 b/Source/Interfaces/BBMIN3_Interface.f90 index 21b1d4c3..3f8ea47f 100644 --- a/Source/Interfaces/BBMIN3_Interface.f90 +++ b/Source/Interfaces/BBMIN3_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BBMIN3 ( A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT, MIN4T_QUAD4_TRIA_NO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BBMIN3_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE MODEL_STUF, ONLY : EID, TYPE, XTB, XTL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -47,7 +46,7 @@ SUBROUTINE BBMIN3 ( A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BB ) INTEGER(LONG), PARAMETER :: NR = 3 ! An input to subr BCHECK, called herein if INTEGER(LONG), PARAMETER :: NC = 9 ! An input to subr BCHECK, called herein if - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BBMIN3_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(3) ! Diffs in x coords of elem REAL(DOUBLE) , INTENT(IN) :: B(3) ! Diffs in y coords of elem diff --git a/Source/Interfaces/BBMIN4_Interface.f90 b/Source/Interfaces/BBMIN4_Interface.f90 index f0202c7c..5e4aef91 100644 --- a/Source/Interfaces/BBMIN4_Interface.f90 +++ b/Source/Interfaces/BBMIN4_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BBMIN4 ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BBMIN4_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : EID, TYPE, XEB, XEL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -49,7 +48,7 @@ SUBROUTINE BBMIN4 ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BB ) INTEGER(LONG), INTENT(IN) :: JGAUS ! J index of Gaus point (needed for some optional output) INTEGER(LONG), PARAMETER :: NR = 3 ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NC = 8 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BBMIN4_BEGEND + REAL(DOUBLE) , INTENT(IN) :: DPSHX(2,4) ! Derivatives of the 4 node bilinear isopar interps wrt elem x and y REAL(DOUBLE) , INTENT(OUT) :: BB(3,8) ! Output strain-displ matrix for this elem diff --git a/Source/Interfaces/BCHECK_2D_Interface.f90 b/Source/Interfaces/BCHECK_2D_Interface.f90 index d4ef0762..f32de0b0 100644 --- a/Source/Interfaces/BCHECK_2D_Interface.f90 +++ b/Source/Interfaces/BCHECK_2D_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BCHECK_2D ( B, BTYPE, ID, NROWB, NCOLB, NUM_GRIDS, XB, XL, BW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_LOG + USE IOUNT1, ONLY : BUG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BCHECK_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE MODEL_STUF, ONLY : ELDOF, NELGP, TE USE MODEL_STUF, ONLY : AGRID, ELGP @@ -48,7 +47,7 @@ SUBROUTINE BCHECK_2D ( B, BTYPE, ID, NROWB, NCOLB, NUM_GRIDS, XB, XL, BW ) INTEGER(LONG), INTENT(IN) :: NCOLB ! Number of cols in the input B matrix INTEGER(LONG), INTENT(IN) :: NUM_GRIDS ! Number of grids for the input B matrix INTEGER(LONG), INTENT(IN) :: ID(NCOLB) ! List of elem DOF's for each of the elem grids (e.g 3,4,5 for each of - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BCHECK_BEGEND + REAL(DOUBLE) , INTENT(IN) :: B(NROWB,NCOLB) ! Strain-displ matrix REAL(DOUBLE) , INTENT(IN) :: XB(NUM_GRIDS,3) ! Basic coords of elem grids (diff than XEB for TPLT2's in a MIN4T QUAD4) diff --git a/Source/Interfaces/BCHECK_3D_Interface.f90 b/Source/Interfaces/BCHECK_3D_Interface.f90 index 6dbbf54d..85191534 100644 --- a/Source/Interfaces/BCHECK_3D_Interface.f90 +++ b/Source/Interfaces/BCHECK_3D_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BCHECK_3D ( B, NUM_GRIDS, ID, NROWB, NCOLB, BW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, BUG, F04 + USE IOUNT1, ONLY : WRT_ERR, BUG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BCHECK_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE MODEL_STUF, ONLY : AGRID, TE, XEB, XEL @@ -45,7 +44,7 @@ SUBROUTINE BCHECK_3D ( B, NUM_GRIDS, ID, NROWB, NCOLB, BW ) INTEGER(LONG), INTENT(IN) :: NROWB ! Number of rows in the input B matrix INTEGER(LONG), INTENT(IN) :: NUM_GRIDS ! Number of grids that this solid element has. INTEGER(LONG), INTENT(IN) :: ID(NCOLB) ! List of elem DOF's for each of the elem grids (e.g 3,4,5 for each of - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BCHECK_BEGEND + REAL(DOUBLE) , INTENT(IN) :: B(NROWB,NCOLB) ! Strain-displ matrix REAL(DOUBLE) , INTENT(OUT) :: BW(NROWB,12) ! Output from subr BCHECK_3D (matrix of NROWB elem strains for various diff --git a/Source/Interfaces/BD_ASET1_Interface.f90 b/Source/Interfaces/BD_ASET1_Interface.f90 index bb4d15c2..cfd3af46 100644 --- a/Source/Interfaces/BD_ASET1_Interface.f90 +++ b/Source/Interfaces/BD_ASET1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_ASET1 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1N + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1N USE SCONTR, ONLY : FATAL_ERR, IERRFL, JCARD_LEN, JF, NAOCARD, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_ASET1_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_ASET1 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_ASET1_BEGEND + END SUBROUTINE BD_ASET1 diff --git a/Source/Interfaces/BD_ASET_Interface.f90 b/Source/Interfaces/BD_ASET_Interface.f90 index 88556c15..b5cc738b 100644 --- a/Source/Interfaces/BD_ASET_Interface.f90 +++ b/Source/Interfaces/BD_ASET_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_ASET ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1N + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1N USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NAOCARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_ASET_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_ASET ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_ASET_BEGEND + END SUBROUTINE BD_ASET diff --git a/Source/Interfaces/BD_BAROR0_Interface.f90 b/Source/Interfaces/BD_BAROR0_Interface.f90 index 464bbcf4..9ea2d61e 100644 --- a/Source/Interfaces/BD_BAROR0_Interface.f90 +++ b/Source/Interfaces/BD_BAROR0_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_BAROR0 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, LVVEC, NBAROR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_BAROR0_BEGEND USE MODEL_STUF, ONLY : BAROR_PID, BAROR_G0, BAROR_VV, BAROR_VVEC_TYPE, JBAROR IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_BAROR0_BEGEND + END SUBROUTINE BD_BAROR0 diff --git a/Source/Interfaces/BD_BAROR_Interface.f90 b/Source/Interfaces/BD_BAROR_Interface.f90 index dd3159ff..55cf570c 100644 --- a/Source/Interfaces/BD_BAROR_Interface.f90 +++ b/Source/Interfaces/BD_BAROR_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE BD_BAROR ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LVVEC, NBAROR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : BD_BAROR_BEGEND USE MODEL_STUF, ONLY : BAROR_VVEC_TYPE, BAROR_G0, BAROR_VV, BAROR_PID IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_BAROR_BEGEND + END SUBROUTINE BD_BAROR diff --git a/Source/Interfaces/BD_BEAMOR0_Interface.f90 b/Source/Interfaces/BD_BEAMOR0_Interface.f90 index 3f7b21be..e421c853 100644 --- a/Source/Interfaces/BD_BEAMOR0_Interface.f90 +++ b/Source/Interfaces/BD_BEAMOR0_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_BEAMOR0 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, LVVEC, NBEAMOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_BEAMOR0_BEGEND USE MODEL_STUF, ONLY : BEAMOR_PID, BEAMOR_G0, BEAMOR_VV, BEAMOR_VVEC_TYPE, JBEAMOR IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_BEAMOR0_BEGEND + END SUBROUTINE BD_BEAMOR0 diff --git a/Source/Interfaces/BD_BEAMOR_Interface.f90 b/Source/Interfaces/BD_BEAMOR_Interface.f90 index 95e56f0c..dd73de2c 100644 --- a/Source/Interfaces/BD_BEAMOR_Interface.f90 +++ b/Source/Interfaces/BD_BEAMOR_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE BD_BEAMOR ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LVVEC, NBEAMOR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : BD_BEAMOR_BEGEND USE MODEL_STUF, ONLY : BEAMOR_VVEC_TYPE, BEAMOR_G0, BEAMOR_VV, BEAMOR_PID IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_BEAMOR_BEGEND + END SUBROUTINE BD_BEAMOR diff --git a/Source/Interfaces/BD_CBAR0_Interface.f90 b/Source/Interfaces/BD_CBAR0_Interface.f90 index b4931a97..9b55644d 100644 --- a/Source/Interfaces/BD_CBAR0_Interface.f90 +++ b/Source/Interfaces/BD_CBAR0_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE BD_CBAR0 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, LBAROFF, LVVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CBAR0_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CBAR0_BEGEND + END SUBROUTINE BD_CBAR0 diff --git a/Source/Interfaces/BD_CBAR_Interface.f90 b/Source/Interfaces/BD_CBAR_Interface.f90 index c7726c34..2adba512 100644 --- a/Source/Interfaces/BD_CBAR_Interface.f90 +++ b/Source/Interfaces/BD_CBAR_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_CBAR ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LBAROFF, LVVEC, MEDAT_CBAR, & MEDAT_CBEAM, NBAROFF, NBAROR, NBEAMOR, NCBAR, NCBEAM, NEDAT, NELE, NVVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CBAR_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : BAROFF, BAROR_G0, BEAMOR_G0, BAROR_PID, BEAMOR_PID, BAROR_VVEC_TYPE, BEAMOR_VVEC_TYPE, & @@ -48,7 +47,7 @@ SUBROUTINE BD_CBAR ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CBAR_BEGEND + END SUBROUTINE BD_CBAR diff --git a/Source/Interfaces/BD_CBUSH0_Interface.f90 b/Source/Interfaces/BD_CBUSH0_Interface.f90 index d6c820fe..8d9bc567 100644 --- a/Source/Interfaces/BD_CBUSH0_Interface.f90 +++ b/Source/Interfaces/BD_CBUSH0_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE BD_CBUSH0 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, LBUSHOFF, LVVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CBUSH0_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CBUSH0_BEGEND + END SUBROUTINE BD_CBUSH0 diff --git a/Source/Interfaces/BD_CBUSH_Interface.f90 b/Source/Interfaces/BD_CBUSH_Interface.f90 index 3c21e3d8..22494a15 100644 --- a/Source/Interfaces/BD_CBUSH_Interface.f90 +++ b/Source/Interfaces/BD_CBUSH_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_CBUSH ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LBUSHOFF, LVVEC, MEDAT_CBUSH,& NBUSHOFF, NCBUSH, NEDAT, NELE, NVVEC, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CBUSH_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : BUSHOFF, EDAT, ETYPE, VVEC @@ -46,7 +45,7 @@ SUBROUTINE BD_CBUSH ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CBUSH_BEGEND + END SUBROUTINE BD_CBUSH diff --git a/Source/Interfaces/BD_CELAS1_Interface.f90 b/Source/Interfaces/BD_CELAS1_Interface.f90 index c7267b20..3e1c651a 100644 --- a/Source/Interfaces/BD_CELAS1_Interface.f90 +++ b/Source/Interfaces/BD_CELAS1_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CELAS1 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEDAT_CELAS1, NCELAS1, NELE, NEDAT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CELAS_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CELAS_BEGEND + END SUBROUTINE BD_CELAS1 diff --git a/Source/Interfaces/BD_CELAS2_Interface.f90 b/Source/Interfaces/BD_CELAS2_Interface.f90 index 2ae2a18e..9364e46a 100644 --- a/Source/Interfaces/BD_CELAS2_Interface.f90 +++ b/Source/Interfaces/BD_CELAS2_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CELAS2 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEDAT_CELAS2, NCELAS2, NELE, NEDAT, NPELAS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CELAS_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE, PELAS, RPELAS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CELAS_BEGEND + END SUBROUTINE BD_CELAS2 diff --git a/Source/Interfaces/BD_CELAS3_Interface.f90 b/Source/Interfaces/BD_CELAS3_Interface.f90 index d7060e3c..4ef5a272 100644 --- a/Source/Interfaces/BD_CELAS3_Interface.f90 +++ b/Source/Interfaces/BD_CELAS3_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CELAS3 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEDAT_CELAS3, NCELAS3, NELE, NEDAT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CELAS_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CELAS_BEGEND + END SUBROUTINE BD_CELAS3 diff --git a/Source/Interfaces/BD_CELAS4_Interface.f90 b/Source/Interfaces/BD_CELAS4_Interface.f90 index cd672738..2f34cda0 100644 --- a/Source/Interfaces/BD_CELAS4_Interface.f90 +++ b/Source/Interfaces/BD_CELAS4_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CELAS4 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEDAT_CELAS4, NCELAS4, NELE, NEDAT, NPELAS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CELAS_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE, PELAS, RPELAS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CELAS_BEGEND + END SUBROUTINE BD_CELAS4 diff --git a/Source/Interfaces/BD_CHEXA0_Interface.f90 b/Source/Interfaces/BD_CHEXA0_Interface.f90 index 0b2aa6ed..72a0066e 100644 --- a/Source/Interfaces/BD_CHEXA0_Interface.f90 +++ b/Source/Interfaces/BD_CHEXA0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CHEXA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, MEDAT_CHEXA8, MEDAT_CHEXA20 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CHEXA0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_CHEXA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: DELTA_LEDAT ! Delta number of words to add to LEDAT for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CHEXA0_BEGEND + END SUBROUTINE BD_CHEXA0 diff --git a/Source/Interfaces/BD_CHEXA_Interface.f90 b/Source/Interfaces/BD_CHEXA_Interface.f90 index 73ca23f0..e2a447fd 100644 --- a/Source/Interfaces/BD_CHEXA_Interface.f90 +++ b/Source/Interfaces/BD_CHEXA_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CHEXA ( CARD, LARGE_FLD_INP, NUM_GRD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN, NCHEXA8, NCHEXA20, NEDAT, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CHEXA_BEGEND USE MODEL_STUF, ONLY : ETYPE IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_CHEXA ( CARD, LARGE_FLD_INP, NUM_GRD ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: NUM_GRD ! Number of GRID's + SPOINT's for the elem - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CHEXA_BEGEND + END SUBROUTINE BD_CHEXA diff --git a/Source/Interfaces/BD_CMASS1_Interface.f90 b/Source/Interfaces/BD_CMASS1_Interface.f90 index d2e6644c..ea8a58ea 100644 --- a/Source/Interfaces/BD_CMASS1_Interface.f90 +++ b/Source/Interfaces/BD_CMASS1_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CMASS1 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NCMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CMASS_BEGEND USE MODEL_STUF, ONLY : CMASS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CMASS_BEGEND + END SUBROUTINE BD_CMASS1 diff --git a/Source/Interfaces/BD_CMASS2_Interface.f90 b/Source/Interfaces/BD_CMASS2_Interface.f90 index ea0f1f7d..6a27db45 100644 --- a/Source/Interfaces/BD_CMASS2_Interface.f90 +++ b/Source/Interfaces/BD_CMASS2_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CMASS2 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NCMASS, NPMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CMASS_BEGEND USE MODEL_STUF, ONLY : CMASS, PMASS, RPMASS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CMASS_BEGEND + END SUBROUTINE BD_CMASS2 diff --git a/Source/Interfaces/BD_CMASS3_Interface.f90 b/Source/Interfaces/BD_CMASS3_Interface.f90 index 8bdf9b0f..cf9246d5 100644 --- a/Source/Interfaces/BD_CMASS3_Interface.f90 +++ b/Source/Interfaces/BD_CMASS3_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CMASS3 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NCMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CMASS_BEGEND USE MODEL_STUF, ONLY : CMASS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CMASS_BEGEND + END SUBROUTINE BD_CMASS3 diff --git a/Source/Interfaces/BD_CMASS4_Interface.f90 b/Source/Interfaces/BD_CMASS4_Interface.f90 index 7a875d98..5b683178 100644 --- a/Source/Interfaces/BD_CMASS4_Interface.f90 +++ b/Source/Interfaces/BD_CMASS4_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CMASS4 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NCMASS, NPMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CMASS_BEGEND USE MODEL_STUF, ONLY : CMASS, PMASS, RPMASS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CMASS_BEGEND + END SUBROUTINE BD_CMASS4 diff --git a/Source/Interfaces/BD_CONM2_Interface.f90 b/Source/Interfaces/BD_CONM2_Interface.f90 index c714657f..71fdbd1c 100644 --- a/Source/Interfaces/BD_CONM2_Interface.f90 +++ b/Source/Interfaces/BD_CONM2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CONM2 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LCONM2, NCONM2, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CONM2_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SUPWARN USE MODEL_STUF, ONLY : CONM2, RCONM2 @@ -45,7 +44,7 @@ SUBROUTINE BD_CONM2 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CONM2_BEGEND + END SUBROUTINE BD_CONM2 diff --git a/Source/Interfaces/BD_CONROD_Interface.f90 b/Source/Interfaces/BD_CONROD_Interface.f90 index 9fd8065c..cc98d7c6 100644 --- a/Source/Interfaces/BD_CONROD_Interface.f90 +++ b/Source/Interfaces/BD_CONROD_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CONROD ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, MEDAT_CROD, NCROD, NELE, NEDAT, NPROD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CONROD_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE, PROD, RPROD IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CONROD_BEGEND + END SUBROUTINE BD_CONROD diff --git a/Source/Interfaces/BD_CORD_Interface.f90 b/Source/Interfaces/BD_CORD_Interface.f90 index b9131a5c..05b598f1 100644 --- a/Source/Interfaces/BD_CORD_Interface.f90 +++ b/Source/Interfaces/BD_CORD_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CORD ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, IERRFL, JCARD_LEN, JF, LCORD, NCORD, NCORD1, NCORD2, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CORD_BEGEND USE MODEL_STUF, ONLY : CORD, RCORD IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_CORD ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CORD_BEGEND + END SUBROUTINE BD_CORD diff --git a/Source/Interfaces/BD_CPENTA0_Interface.f90 b/Source/Interfaces/BD_CPENTA0_Interface.f90 index 015743cf..e5cc33f8 100644 --- a/Source/Interfaces/BD_CPENTA0_Interface.f90 +++ b/Source/Interfaces/BD_CPENTA0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CPENTA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, MEDAT_CPENTA6, MEDAT_CPENTA15 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CPENTA0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_CPENTA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: DELTA_LEDAT ! Delta number of words to add to LEDAT for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CPENTA0_BEGEND + END SUBROUTINE BD_CPENTA0 diff --git a/Source/Interfaces/BD_CPENTA_Interface.f90 b/Source/Interfaces/BD_CPENTA_Interface.f90 index 66b51e19..46ddcaaf 100644 --- a/Source/Interfaces/BD_CPENTA_Interface.f90 +++ b/Source/Interfaces/BD_CPENTA_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CPENTA ( CARD, LARGE_FLD_INP, NUM_GRD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, JCARD_LEN, NCPENTA6, NCPENTA15, NEDAT, NELE, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CPENTA_BEGEND USE MODEL_STUF, ONLY : ETYPE IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_CPENTA ( CARD, LARGE_FLD_INP, NUM_GRD ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: NUM_GRD ! Number of GRID's + SPOINT's for the elem - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CPENTA_BEGEND + END SUBROUTINE BD_CPENTA diff --git a/Source/Interfaces/BD_CQUAD0_Interface.f90 b/Source/Interfaces/BD_CQUAD0_Interface.f90 index 3d092e12..c75ee643 100644 --- a/Source/Interfaces/BD_CQUAD0_Interface.f90 +++ b/Source/Interfaces/BD_CQUAD0_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CQUAD0 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, LMATANGLE, LPLATEOFF, LPLATETHICK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CQUAD0_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CQUAD0_BEGEND + END SUBROUTINE BD_CQUAD0 diff --git a/Source/Interfaces/BD_CQUAD_Interface.f90 b/Source/Interfaces/BD_CQUAD_Interface.f90 index 0ba83999..7d42b58b 100644 --- a/Source/Interfaces/BD_CQUAD_Interface.f90 +++ b/Source/Interfaces/BD_CQUAD_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_CQUAD ( CARD, LARGE_FLD_INP, NUM_GRD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, FATAL_ERR, JCARD_LEN, JF, LMATANGLE, LPLATEOFF, LPLATETHICK, & MEDAT_CQUAD, NCQUAD4K, NCQUAD4, NEDAT, NELE, NMATANGLE, NPLATEOFF, NPLATETHICK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CQUAD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : EDAT, ETYPE, MATANGLE, PLATEOFF, PLATETHICK @@ -47,7 +46,7 @@ SUBROUTINE BD_CQUAD ( CARD, LARGE_FLD_INP, NUM_GRD ) INTEGER(LONG), INTENT(OUT) :: NUM_GRD ! Number of GRID's + SPOINT's for the elem INTEGER(LONG) :: INT41,INT42 ! An integer used in getting MATANGLE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CQUAD_BEGEND + END SUBROUTINE BD_CQUAD diff --git a/Source/Interfaces/BD_CROD_Interface.f90 b/Source/Interfaces/BD_CROD_Interface.f90 index f1578f1c..09271c27 100644 --- a/Source/Interfaces/BD_CROD_Interface.f90 +++ b/Source/Interfaces/BD_CROD_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CROD ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, MEDAT_CROD, NCROD, NEDAT, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CROD_BEGEND USE MODEL_STUF, ONLY : ETYPE IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CROD_BEGEND + END SUBROUTINE BD_CROD diff --git a/Source/Interfaces/BD_CSHEAR_Interface.f90 b/Source/Interfaces/BD_CSHEAR_Interface.f90 index 65559350..48e46ed5 100644 --- a/Source/Interfaces/BD_CSHEAR_Interface.f90 +++ b/Source/Interfaces/BD_CSHEAR_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CSHEAR ( CARD, NUM_GRD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, MEDAT_CSHEAR, NCSHEAR, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CSHEAR_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_CSHEAR ( CARD, NUM_GRD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG), INTENT(OUT) :: NUM_GRD ! Number of GRID's + SPOINT's for the elem - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CSHEAR_BEGEND + END SUBROUTINE BD_CSHEAR diff --git a/Source/Interfaces/BD_CTETRA0_Interface.f90 b/Source/Interfaces/BD_CTETRA0_Interface.f90 index c8b595cf..17189c5a 100644 --- a/Source/Interfaces/BD_CTETRA0_Interface.f90 +++ b/Source/Interfaces/BD_CTETRA0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CTETRA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, MEDAT_CTETRA4, MEDAT_CTETRA10 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CTETRA0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_CTETRA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: DELTA_LEDAT ! Delta number of words to add to LEDAT for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CTETRA0_BEGEND + END SUBROUTINE BD_CTETRA0 diff --git a/Source/Interfaces/BD_CTETRA_Interface.f90 b/Source/Interfaces/BD_CTETRA_Interface.f90 index 6e95de33..7d6338ca 100644 --- a/Source/Interfaces/BD_CTETRA_Interface.f90 +++ b/Source/Interfaces/BD_CTETRA_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CTETRA ( CARD, LARGE_FLD_INP, NUM_GRD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, FATAL_ERR, NCTETRA4, NCTETRA10, NEDAT, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CTETRA_BEGEND USE MODEL_STUF, ONLY : ETYPE IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_CTETRA ( CARD, LARGE_FLD_INP, NUM_GRD ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: NUM_GRD ! Number of GRID's + SPOINT's for the elem - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CTETRA_BEGEND + END SUBROUTINE BD_CTETRA diff --git a/Source/Interfaces/BD_CTRIA0_Interface.f90 b/Source/Interfaces/BD_CTRIA0_Interface.f90 index 82ed1c6e..65a06b4b 100644 --- a/Source/Interfaces/BD_CTRIA0_Interface.f90 +++ b/Source/Interfaces/BD_CTRIA0_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_CTRIA0 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, LMATANGLE, LPLATEOFF, LPLATETHICK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CTRIA0_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CTRIA0_BEGEND + END SUBROUTINE BD_CTRIA0 diff --git a/Source/Interfaces/BD_CTRIA_Interface.f90 b/Source/Interfaces/BD_CTRIA_Interface.f90 index ea0b3578..6d9e623a 100644 --- a/Source/Interfaces/BD_CTRIA_Interface.f90 +++ b/Source/Interfaces/BD_CTRIA_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_CTRIA ( CARD, LARGE_FLD_INP, NUM_GRD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, FATAL_ERR, JCARD_LEN, JF, LMATANGLE, LPLATEOFF, LPLATETHICK, & MEDAT_CTRIA, NCTRIA3K, NCTRIA3, NEDAT, NELE, NMATANGLE, NPLATEOFF, NPLATETHICK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CTRIA_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : EDAT, ETYPE, MATANGLE, PLATEOFF, PLATETHICK @@ -47,7 +46,7 @@ SUBROUTINE BD_CTRIA ( CARD, LARGE_FLD_INP, NUM_GRD ) INTEGER(LONG), INTENT(OUT) :: NUM_GRD ! Number of GRID's + SPOINT's for the elem INTEGER(LONG) :: INT41,INT42 ! An integer used in getting MATANGLE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CTRIA_BEGEND + END SUBROUTINE BD_CTRIA diff --git a/Source/Interfaces/BD_CUSER1_Interface.f90 b/Source/Interfaces/BD_CUSER1_Interface.f90 index ca1d641f..c44afb08 100644 --- a/Source/Interfaces/BD_CUSER1_Interface.f90 +++ b/Source/Interfaces/BD_CUSER1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CUSER1 ( CARD, LARGE_FLD_INP, NUM_GRD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, JF, MEDAT_CUSER1, NCUSER1, NEDAT, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CUSER1_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE BD_CUSER1 ( CARD, LARGE_FLD_INP, NUM_GRD ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: NUM_GRD ! Number of GRID's + SPOINT's for the elem - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CUSER1_BEGEND + END SUBROUTINE BD_CUSER1 diff --git a/Source/Interfaces/BD_CUSERIN0_Interface.f90 b/Source/Interfaces/BD_CUSERIN0_Interface.f90 index 422f4e71..3ae4b3dc 100644 --- a/Source/Interfaces/BD_CUSERIN0_Interface.f90 +++ b/Source/Interfaces/BD_CUSERIN0_Interface.f90 @@ -32,10 +32,8 @@ SUBROUTINE BD_CUSERIN0 ( CARD, NG, NS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CUSERIN0_BEGEND IMPLICIT NONE @@ -44,7 +42,7 @@ SUBROUTINE BD_CUSERIN0 ( CARD, NG, NS ) INTEGER(LONG), INTENT(OUT) :: NG ! Number of GRID's INTEGER(LONG), INTENT(OUT) :: NS ! Number of SPOINT's - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CUSERIN0_BEGEND + END SUBROUTINE BD_CUSERIN0 diff --git a/Source/Interfaces/BD_CUSERIN_Interface.f90 b/Source/Interfaces/BD_CUSERIN_Interface.f90 index 182a338e..a08d62e1 100644 --- a/Source/Interfaces/BD_CUSERIN_Interface.f90 +++ b/Source/Interfaces/BD_CUSERIN_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE BD_CUSERIN ( CARD, LARGE_FLD_INP, NG, NS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LGUSERIN, LSUSERIN, MEDAT0_CUSERIN, & NCUSERIN, NEDAT, NELE, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : BD_CUSERIN_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE IMPLICIT NONE @@ -58,7 +57,7 @@ SUBROUTINE BD_CUSERIN ( CARD, LARGE_FLD_INP, NG, NS ) ! Array of displ components on the CUSERIN entry (for USERIN_GRIDS) INTEGER(LONG) :: USERIN_COMPS(LGUSERIN) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CUSERIN_BEGEND + END SUBROUTINE BD_CUSERIN diff --git a/Source/Interfaces/BD_DEBUG0_Interface.f90 b/Source/Interfaces/BD_DEBUG0_Interface.f90 index 4f9425ea..edc593fe 100644 --- a/Source/Interfaces/BD_DEBUG0_Interface.f90 +++ b/Source/Interfaces/BD_DEBUG0_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE BD_DEBUG0 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, IERRFL, JCARD_LEN, JF, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN diff --git a/Source/Interfaces/BD_DEBUG_Interface.f90 b/Source/Interfaces/BD_DEBUG_Interface.f90 index 62bc60da..1e8f6e96 100644 --- a/Source/Interfaces/BD_DEBUG_Interface.f90 +++ b/Source/Interfaces/BD_DEBUG_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_DEBUG ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, IERRFL, JCARD_LEN, JF, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : BD_DEBUG_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG, NDEBUG IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE BD_DEBUG ( CARD ) INTEGER(LONG), PARAMETER :: LOWER = 1 ! Lower allowable value for an integer parameter INTEGER(LONG) :: UPPER = NDEBUG ! Upper allowable value for an integer parameter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_DEBUG_BEGEND + END SUBROUTINE BD_DEBUG diff --git a/Source/Interfaces/BD_EIGRL_Interface.f90 b/Source/Interfaces/BD_EIGRL_Interface.f90 index 75712512..a24ad574 100644 --- a/Source/Interfaces/BD_EIGRL_Interface.f90 +++ b/Source/Interfaces/BD_EIGRL_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1M + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1M USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONEPM4 - USE SUBR_BEGEND_LEVELS, ONLY : BD_EIG_BEGEND USE MODEL_STUF, ONLY : CC_EIGR_SID, EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_LANCZOS_NEV_DELT, & EIG_METH, EIG_MSGLVL, EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, & EIG_SID, EIG_SIGMA, EIG_VECS, MAXMIJ, MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT @@ -48,7 +47,7 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) CHARACTER(1*BYTE), INTENT(INOUT):: EIGFND ! ='Y' if this EIGR card is the one called for in Case Control CHARACTER( 1*BYTE) :: USE_THIS_EIG ! ='Y' if this is the EIGR meth requested in CC - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_EIG_BEGEND + END SUBROUTINE BD_EIGRL diff --git a/Source/Interfaces/BD_EIGR_Interface.f90 b/Source/Interfaces/BD_EIGR_Interface.f90 index 3edea25b..3c626385 100644 --- a/Source/Interfaces/BD_EIGR_Interface.f90 +++ b/Source/Interfaces/BD_EIGR_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1M + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1M USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : BD_EIG_BEGEND USE MODEL_STUF, ONLY : CC_EIGR_SID USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_CRIT_DEF, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_METH, EIG_MSGLVL, & EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, EIG_SID, EIG_SIGMA, & @@ -49,7 +48,7 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) CHARACTER(1*BYTE), INTENT(INOUT):: EIGFND ! ='Y' if this EIGR card is the one called for in Case Control CHARACTER( 1*BYTE) :: USE_THIS_EIG ! ='Y' if this is the EIGR meth requested in CC - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_EIG_BEGEND + END SUBROUTINE BD_EIGR diff --git a/Source/Interfaces/BD_FORMOM_Interface.f90 b/Source/Interfaces/BD_FORMOM_Interface.f90 index 73e8c9c3..b33ff1e3 100644 --- a/Source/Interfaces/BD_FORMOM_Interface.f90 +++ b/Source/Interfaces/BD_FORMOM_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_FORMOM ( CARD, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1I + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1I USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LFORCE, LSUB, NFORCE, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_FORMOM_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : FORMOM_SIDS, SUBLOD @@ -45,7 +44,7 @@ SUBROUTINE BD_FORMOM ( CARD, CC_LOAD_FND ) CHARACTER(LEN=*),INTENT(IN) :: CARD ! A Bulk Data card CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2) ! 'Y' if B.D load/temp card w/ same set ID (SID) as C.C. LOAD = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_FORMOM_BEGEND + END SUBROUTINE BD_FORMOM diff --git a/Source/Interfaces/BD_GRAV_Interface.f90 b/Source/Interfaces/BD_GRAV_Interface.f90 index 0fb2f801..8a09ff18 100644 --- a/Source/Interfaces/BD_GRAV_Interface.f90 +++ b/Source/Interfaces/BD_GRAV_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_GRAV ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1P + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1P USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LGRAV, LSUB, NGRAV, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_GRAV_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : GRAV_SIDS, SUBLOD @@ -45,7 +44,7 @@ SUBROUTINE BD_GRAV ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2)! 'Y' if B.D load/temp card w/ same set ID (SID) as C.C. LOAD = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_GRAV_BEGEND + END SUBROUTINE BD_GRAV diff --git a/Source/Interfaces/BD_GRDSET0_Interface.f90 b/Source/Interfaces/BD_GRDSET0_Interface.f90 index 3d8a0d6e..4e5df3cb 100644 --- a/Source/Interfaces/BD_GRDSET0_Interface.f90 +++ b/Source/Interfaces/BD_GRDSET0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_GRDSET0 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, JF, IERRFL, NGRDSET USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_GRDSET0_BEGEND USE MODEL_STUF, ONLY : GRDSET3, GRDSET7, GRDSET8 IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_GRDSET0 ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_GRDSET0_BEGEND + END SUBROUTINE BD_GRDSET0 diff --git a/Source/Interfaces/BD_GRDSET_Interface.f90 b/Source/Interfaces/BD_GRDSET_Interface.f90 index 81c5a870..3ff2b477 100644 --- a/Source/Interfaces/BD_GRDSET_Interface.f90 +++ b/Source/Interfaces/BD_GRDSET_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_GRDSET ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NGRDSET USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_GRDSET_BEGEND USE MODEL_STUF, ONLY : GRDSET3, GRDSET7, GRDSET8 IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_GRDSET ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_GRDSET_BEGEND + END SUBROUTINE BD_GRDSET diff --git a/Source/Interfaces/BD_GRID_Interface.f90 b/Source/Interfaces/BD_GRID_Interface.f90 index 06dc4e26..3e558935 100644 --- a/Source/Interfaces/BD_GRID_Interface.f90 +++ b/Source/Interfaces/BD_GRID_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_GRID ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LGRID, NGRID, NGRDSET USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_GRID_BEGEND USE MODEL_STUF, ONLY : GRID, RGRID, GRDSET3, GRDSET7, GRDSET8 IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_GRID ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_GRID_BEGEND + END SUBROUTINE BD_GRID diff --git a/Source/Interfaces/BD_IMBEDDED_BLANK_Interface.f90 b/Source/Interfaces/BD_IMBEDDED_BLANK_Interface.f90 index 2df16bd1..8be13dcd 100644 --- a/Source/Interfaces/BD_IMBEDDED_BLANK_Interface.f90 +++ b/Source/Interfaces/BD_IMBEDDED_BLANK_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_IMBEDDED_BLANK ( JCARD, CF2, CF3, CF4, CF5, CF6, CF7, CF8, CF9 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_IMBEDDED_BLANK_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE BD_IMBEDDED_BLANK ( JCARD, CF2, CF3, CF4, CF5, CF6, CF7, CF8, CF9 ) INTEGER(LONG), INTENT(IN) :: CF7 ! = 7 if field 7 is to be checked, or 0 otherwise INTEGER(LONG), INTENT(IN) :: CF8 ! = 8 if field 8 is to be checked, or 0 otherwise INTEGER(LONG), INTENT(IN) :: CF9 ! = 9 if field 9 is to be checked, or 0 otherwise - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_IMBEDDED_BLANK_BEGEND + END SUBROUTINE BD_IMBEDDED_BLANK diff --git a/Source/Interfaces/BD_LOAD0_Interface.f90 b/Source/Interfaces/BD_LOAD0_Interface.f90 index b618fccd..1b878205 100644 --- a/Source/Interfaces/BD_LOAD0_Interface.f90 +++ b/Source/Interfaces/BD_LOAD0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_LOAD0 ( CARD, LARGE_FLD_INP, ILOAD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_LOAD0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_LOAD0 ( CARD, LARGE_FLD_INP, ILOAD ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: ILOAD ! Count of no. real load factors on this card. Starts with 1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_LOAD0_BEGEND + END SUBROUTINE BD_LOAD0 diff --git a/Source/Interfaces/BD_LOAD_Interface.f90 b/Source/Interfaces/BD_LOAD_Interface.f90 index cd166083..f4f683a7 100644 --- a/Source/Interfaces/BD_LOAD_Interface.f90 +++ b/Source/Interfaces/BD_LOAD_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_LOAD ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LLOADR, LSUB, NLOAD, LLOADC, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_LOAD_BEGEND USE MODEL_STUF, ONLY : LOAD_SIDS, LOAD_FACS, SUBLOD IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_LOAD ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2) ! 'Y' if B.D load/temp card w/ same set ID (SID) as C.C. LOAD = SID CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_LOAD_BEGEND + END SUBROUTINE BD_LOAD diff --git a/Source/Interfaces/BD_MAT1_Interface.f90 b/Source/Interfaces/BD_MAT1_Interface.f90 index d1fd6a62..6cdef9f7 100644 --- a/Source/Interfaces/BD_MAT1_Interface.f90 +++ b/Source/Interfaces/BD_MAT1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_MAT1 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMATL, MRMATLC, NMATL, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MATL_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, TWO USE PARAMS, ONLY : EPSIL, SUPINFO, SUPWARN USE MODEL_STUF, ONLY : MATL, RMATL @@ -45,7 +44,7 @@ SUBROUTINE BD_MAT1 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MATL_BEGEND + END SUBROUTINE BD_MAT1 diff --git a/Source/Interfaces/BD_MAT2_Interface.f90 b/Source/Interfaces/BD_MAT2_Interface.f90 index bea8aa5b..3de4bb94 100644 --- a/Source/Interfaces/BD_MAT2_Interface.f90 +++ b/Source/Interfaces/BD_MAT2_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_MAT2 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMATL, MRMATLC, NMATL, WARN_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : BD_MATL_BEGEND USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : MATL, RMATL @@ -45,7 +44,7 @@ SUBROUTINE BD_MAT2 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MATL_BEGEND + END SUBROUTINE BD_MAT2 diff --git a/Source/Interfaces/BD_MAT8_Interface.f90 b/Source/Interfaces/BD_MAT8_Interface.f90 index d2784048..ff938405 100644 --- a/Source/Interfaces/BD_MAT8_Interface.f90 +++ b/Source/Interfaces/BD_MAT8_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_MAT8 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMATL, MRMATLC, NMATL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MATL_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : MATL, RMATL @@ -45,7 +44,7 @@ SUBROUTINE BD_MAT8 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MATL_BEGEND + END SUBROUTINE BD_MAT8 diff --git a/Source/Interfaces/BD_MAT9_Interface.f90 b/Source/Interfaces/BD_MAT9_Interface.f90 index 019d8047..f26650bb 100644 --- a/Source/Interfaces/BD_MAT9_Interface.f90 +++ b/Source/Interfaces/BD_MAT9_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_MAT9 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMATL, MRMATLC, NMATL, WARN_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : BD_MATL_BEGEND USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : MATL, RMATL @@ -45,7 +44,7 @@ SUBROUTINE BD_MAT9 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MATL_BEGEND + END SUBROUTINE BD_MAT9 diff --git a/Source/Interfaces/BD_MPC0_Interface.f90 b/Source/Interfaces/BD_MPC0_Interface.f90 index 503d71ca..c4129013 100644 --- a/Source/Interfaces/BD_MPC0_Interface.f90 +++ b/Source/Interfaces/BD_MPC0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_MPC0 ( CARD, LARGE_FLD_INP, IMPC ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MPC0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_MPC0 ( CARD, LARGE_FLD_INP, IMPC ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: IMPC ! Count of number of grid/comp/coeff triplets on this MPC logical card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MPC0_BEGEND + END SUBROUTINE BD_MPC0 diff --git a/Source/Interfaces/BD_MPCADD0_Interface.f90 b/Source/Interfaces/BD_MPCADD0_Interface.f90 index 5a701221..d7f29efc 100644 --- a/Source/Interfaces/BD_MPCADD0_Interface.f90 +++ b/Source/Interfaces/BD_MPCADD0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_MPCADD0 ( CARD, LARGE_FLD_INP, IMPCADD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MPCADD0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_MPCADD0 ( CARD, LARGE_FLD_INP, IMPCADD ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: IMPCADD ! Count of number of MPC set ID's defined on the MPCADD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MPCADD0_BEGEND + END SUBROUTINE BD_MPCADD0 diff --git a/Source/Interfaces/BD_MPCADD_Interface.f90 b/Source/Interfaces/BD_MPCADD_Interface.f90 index b15ebd90..6f20fbd7 100644 --- a/Source/Interfaces/BD_MPCADD_Interface.f90 +++ b/Source/Interfaces/BD_MPCADD_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_MPCADD ( CARD, LARGE_FLD_INP, CC_MPC_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMPCADDR, LSUB, NMPCADD, LMPCADDC, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MPCADD_BEGEND USE MODEL_STUF, ONLY : MPCADD_SIDS, MPCSET, SUBLOD IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE BD_MPCADD ( CARD, LARGE_FLD_INP, CC_MPC_FND ) CHARACTER( 3*BYTE) :: NAME1 = 'MPC' ! Name for output error message use CHARACTER( 6*BYTE) :: NAME2 = 'MPCADD'! Name for output error message use - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MPCADD_BEGEND + END SUBROUTINE BD_MPCADD diff --git a/Source/Interfaces/BD_MPC_Interface.f90 b/Source/Interfaces/BD_MPC_Interface.f90 index 5541c081..07c22c3f 100644 --- a/Source/Interfaces/BD_MPC_Interface.f90 +++ b/Source/Interfaces/BD_MPC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_MPC ( CARD, LARGE_FLD_INP, CC_MPC_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1S + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1S USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMPC, LSUB, MMPC, NMPC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MPC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : MPCSET, MPC_SIDS @@ -45,7 +44,7 @@ SUBROUTINE BD_MPC ( CARD, LARGE_FLD_INP, CC_MPC_FND ) CHARACTER( 1*BYTE),INTENT(INOUT):: CC_MPC_FND ! ='Y' if this MPC is a set requested in Case Control CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MPC_BEGEND + END SUBROUTINE BD_MPC diff --git a/Source/Interfaces/BD_NLPARM_Interface.f90 b/Source/Interfaces/BD_NLPARM_Interface.f90 index 5aa54b78..53e65e3e 100644 --- a/Source/Interfaces/BD_NLPARM_Interface.f90 +++ b/Source/Interfaces/BD_NLPARM_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE BD_NLPARM ( CARD, CC_NLSID_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB USE TIMDAT, ONLY : TSEC USE NONLINEAR_PARAMS, ONLY : NL_MAXITER, NL_NUM_LOAD_STEPS, NL_SID - USE SUBR_BEGEND_LEVELS, ONLY : BD_NLPARM_BEGEND IMPLICIT NONE CHARACTER(LEN=*),INTENT(IN) :: CARD ! A Bulk Data card CHARACTER( 1*BYTE),INTENT(INOUT):: CC_NLSID_FND(LSUB)! 'Y' if B.D NLPARM card w/ same set ID (SID) as C.C. NLPARM = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_NLPARM_BEGEND + END SUBROUTINE BD_NLPARM diff --git a/Source/Interfaces/BD_PARAM0_Interface.f90 b/Source/Interfaces/BD_PARAM0_Interface.f90 index b73f8d2c..267fc254 100644 --- a/Source/Interfaces/BD_PARAM0_Interface.f90 +++ b/Source/Interfaces/BD_PARAM0_Interface.f90 @@ -33,16 +33,15 @@ SUBROUTINE BD_PARAM0 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, EPSIL1_SET, IERRFL, JCARD_LEN, JF, MEPSIL, MPBARLU - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL, GRIDSEQ, PBARLDEC, PBARLSHR - USE SUBR_BEGEND_LEVELS, ONLY : BD_PARAM0_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PARAM0_BEGEND + END SUBROUTINE BD_PARAM0 diff --git a/Source/Interfaces/BD_PARAM_Interface.f90 b/Source/Interfaces/BD_PARAM_Interface.f90 index ae81734f..3d2bd94f 100644 --- a/Source/Interfaces/BD_PARAM_Interface.f90 +++ b/Source/Interfaces/BD_PARAM_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE BD_PARAM ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEPSIL, MPBARLU, NUM_USETSTR, & WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PARAM_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE MACHINE_PARAMS, ONLY : MACH_PREC USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -81,7 +80,7 @@ SUBROUTINE BD_PARAM ( CARD ) INTEGER(LONG) :: LOWER ! Lower allowable value for an integer parameter INTEGER(LONG) :: UPPER ! Upper allowable value for an integer parameter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PARAM_BEGEND + END SUBROUTINE BD_PARAM diff --git a/Source/Interfaces/BD_PARVEC1_Interface.f90 b/Source/Interfaces/BD_PARVEC1_Interface.f90 index b4e207a1..f80df47d 100644 --- a/Source/Interfaces/BD_PARVEC1_Interface.f90 +++ b/Source/Interfaces/BD_PARVEC1_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_PARVEC1 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1V + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1V USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_PARTVEC_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES - USE SUBR_BEGEND_LEVELS, ONLY : BD_PARVEC1_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -46,7 +45,7 @@ SUBROUTINE BD_PARVEC1 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PARVEC1_BEGEND + END SUBROUTINE BD_PARVEC1 diff --git a/Source/Interfaces/BD_PARVEC_Interface.f90 b/Source/Interfaces/BD_PARVEC_Interface.f90 index 533ba8ea..edee9d3d 100644 --- a/Source/Interfaces/BD_PARVEC_Interface.f90 +++ b/Source/Interfaces/BD_PARVEC_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_PARVEC ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1V + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1V USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_PARTVEC_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES - USE SUBR_BEGEND_LEVELS, ONLY : BD_PARVEC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SUPWARN USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -46,7 +45,7 @@ SUBROUTINE BD_PARVEC ( CARD ) CHARACTER(LEN=*),INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG) :: IDUM ! Dummy arg in subr IP6CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PARVEC_BEGEND + END SUBROUTINE BD_PARVEC diff --git a/Source/Interfaces/BD_PBARL_Interface.f90 b/Source/Interfaces/BD_PBARL_Interface.f90 index 6d4e13ba..cb121ceb 100644 --- a/Source/Interfaces/BD_PBARL_Interface.f90 +++ b/Source/Interfaces/BD_PBARL_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE BD_PBARL ( CARD, LARGE_FLD_INP, PBARL_TYPE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE DERIVED_DATA_TYPES, ONLY : CHAR1_INT1 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, IERRFL, FATAL_ERR, JCARD_LEN, JF, LPBAR, NPBAR, NPBARL USE PARAMS, ONLY : EPSIL, PBARLSHR, SUPINFO USE CONSTANTS_1, ONLY : PI, ZERO, QUARTER, THIRD, HALF, ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, & @@ -41,7 +41,6 @@ SUBROUTINE BD_PBARL ( CARD, LARGE_FLD_INP, PBARL_TYPE ) USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : PBAR, RPBAR - USE SUBR_BEGEND_LEVELS, ONLY : BD_PBARL_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE BD_PBARL ( CARD, LARGE_FLD_INP, PBARL_TYPE ) CHARACTER(LEN=*), INTENT(OUT) :: PBARL_TYPE ! Name of the cross-section (e.g. I, BAR, etc) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PBARL_BEGEND + END SUBROUTINE BD_PBARL diff --git a/Source/Interfaces/BD_PBAR_Interface.f90 b/Source/Interfaces/BD_PBAR_Interface.f90 index b8ee86f0..f41e6878 100644 --- a/Source/Interfaces/BD_PBAR_Interface.f90 +++ b/Source/Interfaces/BD_PBAR_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE BD_PBAR ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : EPSIL, SUPINFO USE SCONTR, ONLY : BLNK_SUB_NAM, BARTOR, IERRFL, FATAL_ERR, JCARD_LEN, JF, LPBAR, NPBAR USE CONSTANTS_1, ONLY : ZERO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PBAR_BEGEND USE MODEL_STUF, ONLY : PBAR, RPBAR IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE BD_PBAR ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PBAR_BEGEND + END SUBROUTINE BD_PBAR diff --git a/Source/Interfaces/BD_PBEAM_Interface.f90 b/Source/Interfaces/BD_PBEAM_Interface.f90 index 08b2f84b..8b12c98a 100644 --- a/Source/Interfaces/BD_PBEAM_Interface.f90 +++ b/Source/Interfaces/BD_PBEAM_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE BD_PBEAM ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : EPSIL USE SCONTR, ONLY : BLNK_SUB_NAM, BEAMTOR, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPBEAM, NPBEAM USE CONSTANTS_1, ONLY : ZERO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PBEAM_BEGEND USE MODEL_STUF, ONLY : PBEAM, RPBEAM USE PARAMS, ONLY : SUPINFO @@ -46,7 +45,7 @@ SUBROUTINE BD_PBEAM ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PBEAM_BEGEND + END SUBROUTINE BD_PBEAM diff --git a/Source/Interfaces/BD_PBUSH_Interface.f90 b/Source/Interfaces/BD_PBUSH_Interface.f90 index 56bf543c..ce6684f1 100644 --- a/Source/Interfaces/BD_PBUSH_Interface.f90 +++ b/Source/Interfaces/BD_PBUSH_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE BD_PBUSH ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : EPSIL USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPBUSH, NPBUSH, WARN_ERR USE CONSTANTS_1, ONLY : ZERO, ONE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PBUSH_BEGEND USE MODEL_STUF, ONLY : PBUSH, RPBUSH IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE BD_PBUSH ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PBUSH_BEGEND + END SUBROUTINE BD_PBUSH diff --git a/Source/Interfaces/BD_PCOMP0_Interface.f90 b/Source/Interfaces/BD_PCOMP0_Interface.f90 index 828362dc..192d5d61 100644 --- a/Source/Interfaces/BD_PCOMP0_Interface.f90 +++ b/Source/Interfaces/BD_PCOMP0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PCOMP0 ( CARD, LARGE_FLD_INP, IPLIES ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PCOMP0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_PCOMP0 ( CARD, LARGE_FLD_INP, IPLIES ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: IPLIES ! Count of number of plies defined by this PCOMP - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PCOMP0_BEGEND + END SUBROUTINE BD_PCOMP0 diff --git a/Source/Interfaces/BD_PCOMP10_Interface.f90 b/Source/Interfaces/BD_PCOMP10_Interface.f90 index c719313f..c457cf07 100644 --- a/Source/Interfaces/BD_PCOMP10_Interface.f90 +++ b/Source/Interfaces/BD_PCOMP10_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PCOMP10 ( CARD, LARGE_FLD_INP, IPLIES ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PCOMP10_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_PCOMP10 ( CARD, LARGE_FLD_INP, IPLIES ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: IPLIES ! Count of number of plies defined by this PCOMP1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PCOMP10_BEGEND + END SUBROUTINE BD_PCOMP10 diff --git a/Source/Interfaces/BD_PCOMP1_Interface.f90 b/Source/Interfaces/BD_PCOMP1_Interface.f90 index 64431c68..2306be7f 100644 --- a/Source/Interfaces/BD_PCOMP1_Interface.f90 +++ b/Source/Interfaces/BD_PCOMP1_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE BD_PCOMP1 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPCOMP_PLIES, LPCOMP, MPCOMP0, MRPCOMP0, & MPCOMP_PLIES, MRPCOMP_PLIES, NPCOMP USE TIMDAT, ONLY : TSEC @@ -40,14 +40,13 @@ SUBROUTINE BD_PCOMP1 ( CARD, LARGE_FLD_INP ) USE CONSTANTS_1, ONLY : ZERO, HALF, TWO USE MODEL_STUF, ONLY : PCOMP, RPCOMP USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : BD_PCOMP1_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PCOMP1_BEGEND + END SUBROUTINE BD_PCOMP1 diff --git a/Source/Interfaces/BD_PCOMP_Interface.f90 b/Source/Interfaces/BD_PCOMP_Interface.f90 index f946cc56..d4797edd 100644 --- a/Source/Interfaces/BD_PCOMP_Interface.f90 +++ b/Source/Interfaces/BD_PCOMP_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE BD_PCOMP ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPCOMP, MPCOMP0, MRPCOMP0, MPCOMP_PLIES, & MRPCOMP_PLIES, NPCOMP USE TIMDAT, ONLY : TSEC @@ -40,14 +40,13 @@ SUBROUTINE BD_PCOMP ( CARD, LARGE_FLD_INP ) USE CONSTANTS_1, ONLY : ZERO, HALF, TWO USE MODEL_STUF, ONLY : PCOMP, RPCOMP USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : BD_PCOMP_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PCOMP_BEGEND + END SUBROUTINE BD_PCOMP diff --git a/Source/Interfaces/BD_PELAS_Interface.f90 b/Source/Interfaces/BD_PELAS_Interface.f90 index 519164d2..ed231a5f 100644 --- a/Source/Interfaces/BD_PELAS_Interface.f90 +++ b/Source/Interfaces/BD_PELAS_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_PELAS ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPELAS, NPELAS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PELAS_BEGEND USE MODEL_STUF, ONLY : PELAS, RPELAS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PELAS_BEGEND + END SUBROUTINE BD_PELAS diff --git a/Source/Interfaces/BD_PLOAD2_Interface.f90 b/Source/Interfaces/BD_PLOAD2_Interface.f90 index 04253539..9275203b 100644 --- a/Source/Interfaces/BD_PLOAD2_Interface.f90 +++ b/Source/Interfaces/BD_PLOAD2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PLOAD2 ( CARD, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1Q + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1Q USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPLOAD, LSUB, NPCARD, NPLOAD, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PLOAD2_BEGEND USE MODEL_STUF, ONLY : PRESS_SIDS, SUBLOD IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_PLOAD2 ( CARD, CC_LOAD_FND ) CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2)! 'Y' if B.D load/temp card w/ same set ID (SID) as C.C. LOAD = SID INTEGER(LONG) :: PLOAD_ELID(6) ! Elem ID's on parent card if "THRU" not used for input - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PLOAD2_BEGEND + END SUBROUTINE BD_PLOAD2 diff --git a/Source/Interfaces/BD_PLOAD4_Interface.f90 b/Source/Interfaces/BD_PLOAD4_Interface.f90 index b2045a09..cc5ea867 100644 --- a/Source/Interfaces/BD_PLOAD4_Interface.f90 +++ b/Source/Interfaces/BD_PLOAD4_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_PLOAD4 ( CARD, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1Q + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1Q USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPLOAD, LSUB, NPCARD, NPLOAD, & NPLOAD4_3D, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PLOAD4_BEGEND USE MODEL_STUF, ONLY : PRESS_SIDS, SUBLOD IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_PLOAD4 ( CARD, CC_LOAD_FND ) CHARACTER(LEN=*),INTENT(IN) :: CARD ! A Bulk Data card CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2)! 'Y' if B.D load/temp card w/ same set ID (SID) as C.C. LOAD = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PLOAD4_BEGEND + END SUBROUTINE BD_PLOAD4 diff --git a/Source/Interfaces/BD_PLOTEL_Interface.f90 b/Source/Interfaces/BD_PLOTEL_Interface.f90 index dbef4cff..27be2f59 100644 --- a/Source/Interfaces/BD_PLOTEL_Interface.f90 +++ b/Source/Interfaces/BD_PLOTEL_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_PLOTEL ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04, F06 + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, MEDAT_PLOTEL, NELE, NPLOTEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PLOTEL_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PLOTEL_BEGEND + END SUBROUTINE BD_PLOTEL diff --git a/Source/Interfaces/BD_PMASS_Interface.f90 b/Source/Interfaces/BD_PMASS_Interface.f90 index 6a817791..5306aa05 100644 --- a/Source/Interfaces/BD_PMASS_Interface.f90 +++ b/Source/Interfaces/BD_PMASS_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_PMASS ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NPMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PMASS_BEGEND USE MODEL_STUF, ONLY : PMASS, RPMASS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PMASS_BEGEND + END SUBROUTINE BD_PMASS diff --git a/Source/Interfaces/BD_PROD_Interface.f90 b/Source/Interfaces/BD_PROD_Interface.f90 index cb8853dd..8500d208 100644 --- a/Source/Interfaces/BD_PROD_Interface.f90 +++ b/Source/Interfaces/BD_PROD_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_PROD ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPROD, NPROD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PROD_BEGEND USE MODEL_STUF, ONLY : PROD, RPROD IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PROD_BEGEND + END SUBROUTINE BD_PROD diff --git a/Source/Interfaces/BD_PSHEAR_Interface.f90 b/Source/Interfaces/BD_PSHEAR_Interface.f90 index 2f3c359c..a5329f0e 100644 --- a/Source/Interfaces/BD_PSHEAR_Interface.f90 +++ b/Source/Interfaces/BD_PSHEAR_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_PSHEAR ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MPSHEAR, MRPSHEAR, NPSHEAR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PSHEAR_BEGEND USE MODEL_STUF, ONLY : PSHEAR, RPSHEAR IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PSHEAR_BEGEND + END SUBROUTINE BD_PSHEAR diff --git a/Source/Interfaces/BD_PSHEL_Interface.f90 b/Source/Interfaces/BD_PSHEL_Interface.f90 index e7691c9f..b71f2060 100644 --- a/Source/Interfaces/BD_PSHEL_Interface.f90 +++ b/Source/Interfaces/BD_PSHEL_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PSHEL ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR, JCARD_LEN, JF, LPSHEL, NPSHEL, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PSHEL_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : PSHEL, RPSHEL @@ -45,7 +44,7 @@ SUBROUTINE BD_PSHEL ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PSHEL_BEGEND + END SUBROUTINE BD_PSHEL diff --git a/Source/Interfaces/BD_PSOLID_Interface.f90 b/Source/Interfaces/BD_PSOLID_Interface.f90 index 44f18608..87d013d9 100644 --- a/Source/Interfaces/BD_PSOLID_Interface.f90 +++ b/Source/Interfaces/BD_PSOLID_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_PSOLID ( CARD, IOR3D ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPSOLID, NPSOLID, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : BD_PSOLID_BEGEND USE MODEL_STUF, ONLY : PSOLID IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_PSOLID ( CARD, IOR3D ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG), INTENT(OUT) :: IOR3D ! Integration order for this PSOLID entry - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PSOLID_BEGEND + END SUBROUTINE BD_PSOLID diff --git a/Source/Interfaces/BD_PUSER1_Interface.f90 b/Source/Interfaces/BD_PUSER1_Interface.f90 index e79d3235..0b78aba7 100644 --- a/Source/Interfaces/BD_PUSER1_Interface.f90 +++ b/Source/Interfaces/BD_PUSER1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PUSER1 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPUSER1, NPUSER1 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PUSER1_BEGEND USE MODEL_STUF, ONLY : PUSER1, RPUSER1 IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_PUSER1 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! A Bulk Data card CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PUSER1_BEGEND + END SUBROUTINE BD_PUSER1 diff --git a/Source/Interfaces/BD_PUSERIN_Interface.f90 b/Source/Interfaces/BD_PUSERIN_Interface.f90 index bbc1b91d..a128f0ad 100644 --- a/Source/Interfaces/BD_PUSERIN_Interface.f90 +++ b/Source/Interfaces/BD_PUSERIN_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PUSERIN ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NUM_IN4_FILES + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NUM_IN4_FILES USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPUSERIN, NPUSERIN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PUSERIN_BEGEND USE MODEL_STUF, ONLY : PUSERIN, USERIN_MAT_NAMES IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_PUSERIN ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG) :: IN4_NUM ! IN4 file number read from field 3 of RPUSERIN entry - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PUSERIN_BEGEND + END SUBROUTINE BD_PUSERIN diff --git a/Source/Interfaces/BD_RBAR_Interface.f90 b/Source/Interfaces/BD_RBAR_Interface.f90 index 9d134f41..59949a56 100644 --- a/Source/Interfaces/BD_RBAR_Interface.f90 +++ b/Source/Interfaces/BD_RBAR_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RBAR ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRIGEL, NRBAR, NRIGEL, NRECARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBAR_BEGEND USE MODEL_STUF, ONLY : RIGID_ELEM_IDS IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_RBAR ( CARD ) CHARACTER( 8*BYTE), PARAMETER :: RTYPE = 'RBAR '! Rigid element type INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBAR_BEGEND + END SUBROUTINE BD_RBAR diff --git a/Source/Interfaces/BD_RBE1_Interface.f90 b/Source/Interfaces/BD_RBE1_Interface.f90 index b07faa0d..4a66f891 100644 --- a/Source/Interfaces/BD_RBE1_Interface.f90 +++ b/Source/Interfaces/BD_RBE1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RBE1 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRIGEL, NRBE1, NRIGEL, NRECARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBE1_BEGEND USE MODEL_STUF, ONLY : RIGID_ELEM_IDS IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE BD_RBE1 ( CARD, LARGE_FLD_INP ) CHARACTER( 8*BYTE), PARAMETER :: RTYPE = 'RBE1 '! Rigid element type INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBE1_BEGEND + END SUBROUTINE BD_RBE1 diff --git a/Source/Interfaces/BD_RBE2_Interface.f90 b/Source/Interfaces/BD_RBE2_Interface.f90 index e0bab75d..5313dfb0 100644 --- a/Source/Interfaces/BD_RBE2_Interface.f90 +++ b/Source/Interfaces/BD_RBE2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RBE2 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRIGEL, NRBE2, NRIGEL, NRECARD, NTERM_RMG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBE2_BEGEND USE MODEL_STUF, ONLY : RIGID_ELEM_IDS IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE BD_RBE2 ( CARD, LARGE_FLD_INP ) CHARACTER( 8*BYTE), PARAMETER :: RTYPE = 'RBE2 '! Rigid element type INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBE2_BEGEND + END SUBROUTINE BD_RBE2 diff --git a/Source/Interfaces/BD_RBE30_Interface.f90 b/Source/Interfaces/BD_RBE30_Interface.f90 index d6239060..01881993 100644 --- a/Source/Interfaces/BD_RBE30_Interface.f90 +++ b/Source/Interfaces/BD_RBE30_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RBE30 ( CARD, LARGE_FLD_INP, IRBE3 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBE30_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_RBE30 ( CARD, LARGE_FLD_INP, IRBE3 ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: IRBE3 ! Count of number of grid/comp/coeff triplets on this RBE3 logical card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBE30_BEGEND + END SUBROUTINE BD_RBE30 diff --git a/Source/Interfaces/BD_RBE3_Interface.f90 b/Source/Interfaces/BD_RBE3_Interface.f90 index bcfc813f..3a6854b3 100644 --- a/Source/Interfaces/BD_RBE3_Interface.f90 +++ b/Source/Interfaces/BD_RBE3_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RBE3 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRIGEL, MRBE3, NRECARD, NRIGEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBE3_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : RIGID_ELEM_IDS @@ -45,7 +44,7 @@ SUBROUTINE BD_RBE3 ( CARD, LARGE_FLD_INP ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format CHARACTER( 8*BYTE), PARAMETER :: RTYPE = 'RBE3 '! Rigid element type - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBE3_BEGEND + END SUBROUTINE BD_RBE3 diff --git a/Source/Interfaces/BD_RFORCE_Interface.f90 b/Source/Interfaces/BD_RFORCE_Interface.f90 index ca59fc23..3b677735 100644 --- a/Source/Interfaces/BD_RFORCE_Interface.f90 +++ b/Source/Interfaces/BD_RFORCE_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RFORCE ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1U + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1U USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRFORCE, LSUB, NRFORCE, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RFORCE_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : RFORCE_SIDS, SUBLOD @@ -45,7 +44,7 @@ SUBROUTINE BD_RFORCE ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2)! 'Y' if B.D load/temp card w/ same set ID (SID) as C.C. LOAD = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RFORCE_BEGEND + END SUBROUTINE BD_RFORCE diff --git a/Source/Interfaces/BD_RSPLINE0_Interface.f90 b/Source/Interfaces/BD_RSPLINE0_Interface.f90 index 40d518b5..910159cc 100644 --- a/Source/Interfaces/BD_RSPLINE0_Interface.f90 +++ b/Source/Interfaces/BD_RSPLINE0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RSPLINE0 ( CARD, LARGE_FLD_INP, IRSPLINE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RSPLINE0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE BD_RSPLINE0 ( CARD, LARGE_FLD_INP, IRSPLINE ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: IRSPLINE ! Count of number of grid/comp doublets on this RSPLINE logical card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RSPLINE0_BEGEND + END SUBROUTINE BD_RSPLINE0 diff --git a/Source/Interfaces/BD_RSPLINE_Interface.f90 b/Source/Interfaces/BD_RSPLINE_Interface.f90 index 6d4ad0e9..6e04f31d 100644 --- a/Source/Interfaces/BD_RSPLINE_Interface.f90 +++ b/Source/Interfaces/BD_RSPLINE_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RSPLINE ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MRSPLINE, NRSPLINE, NRECARD, NRIGEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RSPLINE_BEGEND USE MODEL_STUF, ONLY : RIGID_ELEM_IDS IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE BD_RSPLINE ( CARD, LARGE_FLD_INP ) CHARACTER( 8*BYTE), PARAMETER :: RTYPE = 'RSPLINE '! Rigid element type - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RSPLINE_BEGEND + END SUBROUTINE BD_RSPLINE diff --git a/Source/Interfaces/BD_SEQGP_Interface.f90 b/Source/Interfaces/BD_SEQGP_Interface.f90 index 05e1c40a..d8eef3c5 100644 --- a/Source/Interfaces/BD_SEQGP_Interface.f90 +++ b/Source/Interfaces/BD_SEQGP_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_SEQGP ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN, JF, LSEQ, NSEQ USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SEQGP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : SEQ1, SEQ2 @@ -43,7 +42,7 @@ SUBROUTINE BD_SEQGP ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SEQGP_BEGEND + END SUBROUTINE BD_SEQGP diff --git a/Source/Interfaces/BD_SLOAD0_Interface.f90 b/Source/Interfaces/BD_SLOAD0_Interface.f90 index 65ab634e..0bac28c4 100644 --- a/Source/Interfaces/BD_SLOAD0_Interface.f90 +++ b/Source/Interfaces/BD_SLOAD0_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE BD_SLOAD0 ( CARD, NUM_PAIRS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SLOAD0_BEGEND IMPLICIT NONE CHARACTER(LEN=*),INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG), INTENT(OUT) :: NUM_PAIRS ! Number of pairs of SPOINT/force MAG on a SLOAD entry (can be up to 3) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SLOAD0_BEGEND + END SUBROUTINE BD_SLOAD0 diff --git a/Source/Interfaces/BD_SLOAD_Interface.f90 b/Source/Interfaces/BD_SLOAD_Interface.f90 index 39a65c71..4687d7a2 100644 --- a/Source/Interfaces/BD_SLOAD_Interface.f90 +++ b/Source/Interfaces/BD_SLOAD_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_SLOAD ( CARD, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1W + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1W USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LFORCE, LSUB, NFORCE, NSLOAD, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SLOAD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : SLOAD_SIDS, SUBLOD @@ -45,7 +44,7 @@ SUBROUTINE BD_SLOAD ( CARD, CC_LOAD_FND ) CHARACTER(LEN=*),INTENT(IN) :: CARD ! A Bulk Data card CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2) ! 'Y' if B.D SLOAD card w/ same set ID (SID) as C.C. LOAD = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SLOAD_BEGEND + END SUBROUTINE BD_SLOAD diff --git a/Source/Interfaces/BD_SPC1_Interface.f90 b/Source/Interfaces/BD_SPC1_Interface.f90 index ad084538..45df5dc7 100644 --- a/Source/Interfaces/BD_SPC1_Interface.f90 +++ b/Source/Interfaces/BD_SPC1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_SPC1 ( CARD, LARGE_FLD_INP, CC_SPC_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1O + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1O USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSPC1, NSPC1, NUM_SPC1_RECORDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPC1_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TSET_CHR_LEN USE MODEL_STUF, ONLY : SPC1_SIDS, SPCSET @@ -47,7 +46,7 @@ SUBROUTINE BD_SPC1 ( CARD, LARGE_FLD_INP, CC_SPC_FND ) CHARACTER( 1*BYTE),INTENT(INOUT):: CC_SPC_FND ! ='Y' if this SPC is a set requested in Case Control INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPC1_BEGEND + REAL(DOUBLE) , PARAMETER :: RSPCJ = ZERO ! Enforced displ value (always zero on SPC1). Included for file LINK1O END SUBROUTINE BD_SPC1 diff --git a/Source/Interfaces/BD_SPCADD0_Interface.f90 b/Source/Interfaces/BD_SPCADD0_Interface.f90 index fd657cd9..215b4dcd 100644 --- a/Source/Interfaces/BD_SPCADD0_Interface.f90 +++ b/Source/Interfaces/BD_SPCADD0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_SPCADD0 ( CARD, LARGE_FLD_INP, ISPCADD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPCADD0_BEGEND USE MODEL_STUF, ONLY : SPCADD_SIDS IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_SPCADD0 ( CARD, LARGE_FLD_INP, ISPCADD ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG), INTENT(OUT) :: ISPCADD ! Count of number of SPC or SPC1 set ID's defined on the SPCADD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPCADD0_BEGEND + END SUBROUTINE BD_SPCADD0 diff --git a/Source/Interfaces/BD_SPCADD_Interface.f90 b/Source/Interfaces/BD_SPCADD_Interface.f90 index 54451e3f..2245e5ca 100644 --- a/Source/Interfaces/BD_SPCADD_Interface.f90 +++ b/Source/Interfaces/BD_SPCADD_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_SPCADD ( CARD, LARGE_FLD_INP, CC_SPC_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSPCADDR, LSUB, NSPCADD, LSPCADDC, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPCADD_BEGEND USE MODEL_STUF, ONLY : SPCADD_SIDS, SPCSET, SUBLOD IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE BD_SPCADD ( CARD, LARGE_FLD_INP, CC_SPC_FND ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format CHARACTER( 1*BYTE),INTENT(INOUT):: CC_SPC_FND ! 'Y' if B.D card w/ same set ID as C.C. SPC = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPCADD_BEGEND + END SUBROUTINE BD_SPCADD diff --git a/Source/Interfaces/BD_SPC_Interface.f90 b/Source/Interfaces/BD_SPC_Interface.f90 index 0b92fc98..1b0392d7 100644 --- a/Source/Interfaces/BD_SPC_Interface.f90 +++ b/Source/Interfaces/BD_SPC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_SPC ( CARD, CC_SPC_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1O + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1O USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSPC, NSPC, NUM_SPC_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SUPWARN USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -47,7 +46,7 @@ SUBROUTINE BD_SPC ( CARD, CC_SPC_FND ) CHARACTER( 1*BYTE),INTENT(INOUT):: CC_SPC_FND ! ='Y' if this SPC is a set requested in Case Control INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPC_BEGEND + END SUBROUTINE BD_SPC diff --git a/Source/Interfaces/BD_SPOINT0_Interface.f90 b/Source/Interfaces/BD_SPOINT0_Interface.f90 index 1d67640a..e9febf97 100644 --- a/Source/Interfaces/BD_SPOINT0_Interface.f90 +++ b/Source/Interfaces/BD_SPOINT0_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE BD_SPOINT0 ( CARD, DELTA_SPOINT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPOINT0_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG), INTENT(OUT) :: DELTA_SPOINT ! Number of SPOINT's defined on this B.D. SPOINT entry - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPOINT0_BEGEND + END SUBROUTINE BD_SPOINT0 diff --git a/Source/Interfaces/BD_SPOINT_Interface.f90 b/Source/Interfaces/BD_SPOINT_Interface.f90 index 01b43249..7fa4f60b 100644 --- a/Source/Interfaces/BD_SPOINT_Interface.f90 +++ b/Source/Interfaces/BD_SPOINT_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_SPOINT ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NGRID USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : GRID - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPOINT_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPOINT_BEGEND + END SUBROUTINE BD_SPOINT diff --git a/Source/Interfaces/BD_SUPORT_Interface.f90 b/Source/Interfaces/BD_SUPORT_Interface.f90 index 3a6120e4..9641283d 100644 --- a/Source/Interfaces/BD_SUPORT_Interface.f90 +++ b/Source/Interfaces/BD_SUPORT_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BD_SUPORT ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1T + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1T USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_SUPT_CARDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SUPORT_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SUPORT_BEGEND + END SUBROUTINE BD_SUPORT diff --git a/Source/Interfaces/BD_TEMPD_Interface.f90 b/Source/Interfaces/BD_TEMPD_Interface.f90 index b3fbd55d..8ba2986c 100644 --- a/Source/Interfaces/BD_TEMPD_Interface.f90 +++ b/Source/Interfaces/BD_TEMPD_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_TEMPD ( CARD, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1K + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1K USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, NSUB, NTCARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_TEMPD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : SUBLOD @@ -43,7 +42,7 @@ SUBROUTINE BD_TEMPD ( CARD, CC_LOAD_FND ) CHARACTER(LEN=*),INTENT(IN) :: CARD ! A Bulk Data card CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2) ! 'Y' if B.D load/temp card w/ same set ID (SID) as C.C. LOAD = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_TEMPD_BEGEND + END SUBROUTINE BD_TEMPD diff --git a/Source/Interfaces/BD_TEMPRP_Interface.f90 b/Source/Interfaces/BD_TEMPRP_Interface.f90 index af9c66bf..ffea1611 100644 --- a/Source/Interfaces/BD_TEMPRP_Interface.f90 +++ b/Source/Interfaces/BD_TEMPRP_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_TEMPRP ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1K + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1K USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, MTDAT_TEMPRB, MTDAT_TEMPP1, NSUB, & NTCARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_TEMPRP_BEGEND USE MODEL_STUF, ONLY : SUBLOD IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE BD_TEMPRP ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) CHARACTER(LEN=*), INTENT(IN) :: LARGE_FLD_INP ! If 'Y', CARD is large field format INTEGER(LONG) :: CONT_CARD_NUM = 0 ! Count of continuation cards (used for output error messages) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_TEMPRP_BEGEND + END SUBROUTINE BD_TEMPRP diff --git a/Source/Interfaces/BD_TEMP_Interface.f90 b/Source/Interfaces/BD_TEMP_Interface.f90 index 53f42665..34c16295 100644 --- a/Source/Interfaces/BD_TEMP_Interface.f90 +++ b/Source/Interfaces/BD_TEMP_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_TEMP ( CARD, CC_LOAD_FND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1K + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1K USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, NSUB, NTCARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_TEMP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : SUBLOD @@ -44,7 +43,7 @@ SUBROUTINE BD_TEMP ( CARD, CC_LOAD_FND ) CHARACTER(LEN=*),INTENT(IN) :: CARD ! A Bulk Data card CHARACTER( 1*BYTE),INTENT(INOUT):: CC_LOAD_FND(LSUB,2) ! 'Y' if B.D load/temp card w/ same set ID (SID) as C.C. LOAD = SID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_TEMP_BEGEND + END SUBROUTINE BD_TEMP diff --git a/Source/Interfaces/BD_USET1_Interface.f90 b/Source/Interfaces/BD_USET1_Interface.f90 index 6e1502a7..3e4da6c5 100644 --- a/Source/Interfaces/BD_USET1_Interface.f90 +++ b/Source/Interfaces/BD_USET1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_USET1 ( CARD, LARGE_FLD_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1X + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1X USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_USET_RECORDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_USET1_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -49,7 +48,7 @@ SUBROUTINE BD_USET1 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: GRIDJ1 = 0 ! Grid ID on USET1 card INTEGER(LONG) :: GRIDJ2 = 0 ! Grid ID on USET1 card INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_USET1_BEGEND + END SUBROUTINE BD_USET1 diff --git a/Source/Interfaces/BD_USET_Interface.f90 b/Source/Interfaces/BD_USET_Interface.f90 index 1f7cd593..40051a1f 100644 --- a/Source/Interfaces/BD_USET_Interface.f90 +++ b/Source/Interfaces/BD_USET_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_USET ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1X + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1X USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_USET_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_USET_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SUPWARN USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -48,7 +47,7 @@ SUBROUTINE BD_USET ( CARD ) INTEGER(LONG) :: GRIDJ = 0 ! Grid ID on USET card INTEGER(LONG) :: IDUM ! Dummy arg in subr IP6CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_USET_BEGEND + END SUBROUTINE BD_USET diff --git a/Source/Interfaces/BEAM_Interface.f90 b/Source/Interfaces/BEAM_Interface.f90 index 8a77a57c..a6320da9 100644 --- a/Source/Interfaces/BEAM_Interface.f90 +++ b/Source/Interfaces/BEAM_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE BEAM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : NUM_EMG_FATAL_ERRS - USE SUBR_BEGEND_LEVELS, ONLY : BEAM_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BEAM_BEGEND + END SUBROUTINE BEAM diff --git a/Source/Interfaces/BMQMEM_Interface.f90 b/Source/Interfaces/BMQMEM_Interface.f90 index b20ae043..e33e1456 100644 --- a/Source/Interfaces/BMQMEM_Interface.f90 +++ b/Source/Interfaces/BMQMEM_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BMQMEM ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BMQMEM_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : BMEANT, EID, HBAR, MXWARP, TYPE, XEB, XEL @@ -68,7 +67,7 @@ SUBROUTINE BMQMEM ( DPSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_THIS_TIME, BM ) 19, & ! ID2(10)= 19 20, & ! ID2(11)= 20 21 /) ! ID2(12)= 21 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BMQMEM_BEGEND + REAL(DOUBLE) , INTENT(IN) :: DPSHX(2,4) ! Derivatives of the 4 node bilinear isopar interps wrt elem x and y REAL(DOUBLE) , INTENT(OUT) :: BM(3,8) ! Output strain-displ matrix for this elem diff --git a/Source/Interfaces/BREL1_Interface.f90 b/Source/Interfaces/BREL1_Interface.f90 index be24a6ae..f79f898d 100644 --- a/Source/Interfaces/BREL1_Interface.f90 +++ b/Source/Interfaces/BREL1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BREL1 ( OPT, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BREL1_BEGEND USE CONSTANTS_1, ONLY : TWO USE PARAMS, ONLY : EPSIL USE DEBUG_PARAMETERS @@ -47,7 +46,7 @@ SUBROUTINE BREL1 ( OPT, WRITE_WARN ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BREL1_BEGEND + REAL(DOUBLE) :: K1 ! Shear constant for plane 1 (used in K1*AREA*G) REAL(DOUBLE) :: K2 ! Shear constant for plane 2 (used in K1*AREA*G) diff --git a/Source/Interfaces/BSMIN3_Interface.f90 b/Source/Interfaces/BSMIN3_Interface.f90 index c34d1dc2..b0aceaac 100644 --- a/Source/Interfaces/BSMIN3_Interface.f90 +++ b/Source/Interfaces/BSMIN3_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BSMIN3 ( XI, A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT, MIN4T_QUAD4_TRIA_NO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BSMIN3_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE MODEL_STUF, ONLY : EID, TYPE, XTB, XTL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -47,7 +46,7 @@ SUBROUTINE BSMIN3 ( XI, A, B, AREA, MESSAG, WRT_BUG_THIS_TIME, BS ) INTEGER(LONG), PARAMETER :: NR = 2 ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NC = 9 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BSMIN3_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(3) ! Vector of x coord differences REAL(DOUBLE) , INTENT(IN) :: AREA ! Elem area diff --git a/Source/Interfaces/BSMIN4_Interface.f90 b/Source/Interfaces/BSMIN4_Interface.f90 index 16f4faee..cbd66a7f 100644 --- a/Source/Interfaces/BSMIN4_Interface.f90 +++ b/Source/Interfaces/BSMIN4_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE BSMIN4 ( PSH, DPSHX, DNXSHX, DNYSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_TH USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BMAT_BIT, ELDT_BUG_BCHK_BIT USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : BSMIN4_BEGEND USE MODEL_STUF, ONLY : EID, TYPE, XEB, XEL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -49,7 +48,7 @@ SUBROUTINE BSMIN4 ( PSH, DPSHX, DNXSHX, DNYSHX, IGAUS, JGAUS, MESSAG, WRT_BUG_TH INTEGER(LONG), INTENT(IN) :: JGAUS ! J index of Gaus point (needed for some optional output) INTEGER(LONG), PARAMETER :: NR = 2 ! An input to subr BCHECK, called herein INTEGER(LONG), PARAMETER :: NC = 12 ! An input to subr BCHECK, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BSMIN4_BEGEND + REAL(DOUBLE) , INTENT(IN) :: PSH(4) ! 4 node bilinear isopar interp functions (used for bending) REAL(DOUBLE) , INTENT(IN) :: DPSHX(2,4) ! Derivatives of PSH shape functions wrt x and y diff --git a/Source/Interfaces/BUILD_A_LR_Interface.f90 b/Source/Interfaces/BUILD_A_LR_Interface.f90 index cf03c4bd..459eae52 100644 --- a/Source/Interfaces/BUILD_A_LR_Interface.f90 +++ b/Source/Interfaces/BUILD_A_LR_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BUILD_A_LR ( COL_NUM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFL, NDOFA, NDOFR, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BUILD_A_LR_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : PRTDISP USE COL_VECS, ONLY : UL_COL, UA_COL, UR_COL @@ -43,7 +42,7 @@ SUBROUTINE BUILD_A_LR ( COL_NUM ) IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: COL_NUM - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUILD_A_LR_BEGEND + END SUBROUTINE BUILD_A_LR diff --git a/Source/Interfaces/BUILD_F_AO_Interface.f90 b/Source/Interfaces/BUILD_F_AO_Interface.f90 index 94eaa965..a6bccbd5 100644 --- a/Source/Interfaces/BUILD_F_AO_Interface.f90 +++ b/Source/Interfaces/BUILD_F_AO_Interface.f90 @@ -32,10 +32,8 @@ SUBROUTINE BUILD_F_AO USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFA, NDOFF, NDOFO, NTERM_GOA, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BUILD_F_AO_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : PRTDISP USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -45,7 +43,7 @@ SUBROUTINE BUILD_F_AO IMPLICIT NONE INTEGER(LONG), PARAMETER :: NUMCOLS = 1 ! Variable for number of cols of an array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUILD_F_AO_BEGEND + END SUBROUTINE BUILD_F_AO diff --git a/Source/Interfaces/BUILD_G_NM_Interface.f90 b/Source/Interfaces/BUILD_G_NM_Interface.f90 index 59126103..8bc84cf5 100644 --- a/Source/Interfaces/BUILD_G_NM_Interface.f90 +++ b/Source/Interfaces/BUILD_G_NM_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE BUILD_G_NM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFG, NDOFM, NDOFN, NTERM_GMN, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BUILD_G_NM_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : PRTDISP USE SPARSE_MATRICES, ONLY : I_GMN, J_GMN, GMN, SYM_GMN @@ -44,7 +43,7 @@ SUBROUTINE BUILD_G_NM IMPLICIT NONE INTEGER(LONG), PARAMETER :: NUMCOLS = 1 ! Variable for number of cols of an array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUILD_G_NM_BEGEND + END SUBROUTINE BUILD_G_NM diff --git a/Source/Interfaces/BUILD_N_FS_Interface.f90 b/Source/Interfaces/BUILD_N_FS_Interface.f90 index a4f8e336..2628c41e 100644 --- a/Source/Interfaces/BUILD_N_FS_Interface.f90 +++ b/Source/Interfaces/BUILD_N_FS_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE BUILD_N_FS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFF, NDOFN, NDOFS, NDOFSE, NDOFSZ, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BUILD_N_FS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : PRTDISP USE COL_VECS, ONLY : UF_COL, UN_COL, US_COL, YSe IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUILD_N_FS_BEGEND + END SUBROUTINE BUILD_N_FS diff --git a/Source/Interfaces/BUSH_Interface.f90 b/Source/Interfaces/BUSH_Interface.f90 index a058cca4..f47009b6 100644 --- a/Source/Interfaces/BUSH_Interface.f90 +++ b/Source/Interfaces/BUSH_Interface.f90 @@ -32,21 +32,20 @@ SUBROUTINE BUSH ( INT_ELEM_ID, OPT, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NCORD USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, HALF, QUARTER USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : BE1, BE2, BUSH_OCID, BUSHOFF, BUSH_DXA, BUSH_DXB, BUSH_DY, BUSH_DZ, CORD, EOFF, EPROP, KE,& ELEM_LEN_12, OFFDIS_B, RCORD, SE1, SE2, TE, XEB - USE SUBR_BEGEND_LEVELS, ONLY : BUSH_BEGEND IMPLICIT NONE CHARACTER(LEN=*) , INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUSH_BEGEND + INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID END SUBROUTINE BUSH diff --git a/Source/Interfaces/CALC_CB_MEFM_MPF_Interface.f90 b/Source/Interfaces/CALC_CB_MEFM_MPF_Interface.f90 index b3de2d40..50f0558e 100644 --- a/Source/Interfaces/CALC_CB_MEFM_MPF_Interface.f90 +++ b/Source/Interfaces/CALC_CB_MEFM_MPF_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE CALC_CB_MEFM_MPF USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, & NDOFL, NDOFR, NTERM_MPF0 , NVEC USE TIMDAT, ONLY : TSEC USE CONSTANTs_1, ONLY : ZERO, ONE USE PARAMS, ONLY : MPFOUT - USE SUBR_BEGEND_LEVELS, ONLY : CALC_CB_MEFM_MPF_BEGEND USE RIGID_BODY_DISP_MATS, ONLY : TR6_MEFM USE SPARSE_MATRICES, ONLY : I_MPF0 , J_MPF0 , MPF0 , SYM_MPF0 USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1 @@ -46,7 +45,7 @@ SUBROUTINE CALC_CB_MEFM_MPF IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_CB_MEFM_MPF_BEGEND + END SUBROUTINE CALC_CB_MEFM_MPF diff --git a/Source/Interfaces/CALC_ELEM_NODE_FORCES_Interface.f90 b/Source/Interfaces/CALC_ELEM_NODE_FORCES_Interface.f90 index 9838fc6e..4003ff46 100644 --- a/Source/Interfaces/CALC_ELEM_NODE_FORCES_Interface.f90 +++ b/Source/Interfaces/CALC_ELEM_NODE_FORCES_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE CALC_ELEM_NODE_FORCES USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, INT_SC_NUM, JTSUB, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CALC_ELEM_NODE_FORCES_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : AGRID, ELAS_COMP, ELDOF, KE, PEL, PTE, UEL, TYPE, SUBLOD IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_ELEM_NODE_FORCES_BEGEND + END SUBROUTINE CALC_ELEM_NODE_FORCES diff --git a/Source/Interfaces/CALC_ELEM_STRAINS_Interface.f90 b/Source/Interfaces/CALC_ELEM_STRAINS_Interface.f90 index 6e12044d..fd1f939d 100644 --- a/Source/Interfaces/CALC_ELEM_STRAINS_Interface.f90 +++ b/Source/Interfaces/CALC_ELEM_STRAINS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE CALC_ELEM_STRAINS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL, USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : TYPE - USE SUBR_BEGEND_LEVELS, ONLY : CALC_ELEM_STRAINS_BEGEND USE CONSTANTS_1, ONLY : ZERO IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE CALC_ELEM_STRAINS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL, INTEGER(LONG), INTENT(IN) :: SIZE_ALLOCATED ! No. of rows allocated to array that will be written to in a subr INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_ELEM_STRAINS_BEGEND + END SUBROUTINE CALC_ELEM_STRAINS diff --git a/Source/Interfaces/CALC_ELEM_STRESSES_Interface.f90 b/Source/Interfaces/CALC_ELEM_STRESSES_Interface.f90 index 273fc2a1..d5a7565a 100644 --- a/Source/Interfaces/CALC_ELEM_STRESSES_Interface.f90 +++ b/Source/Interfaces/CALC_ELEM_STRESSES_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE CALC_ELEM_STRESSES ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : TYPE - USE SUBR_BEGEND_LEVELS, ONLY : CALC_ELEM_STRESSES_BEGEND USE CONSTANTS_1, ONLY : ZERO IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE CALC_ELEM_STRESSES ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL INTEGER(LONG), INTENT(IN) :: SIZE_ALLOCATED ! No. of rows allocated to array that will be written to in a subr INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_ELEM_STRESSES_BEGEND + END SUBROUTINE CALC_ELEM_STRESSES diff --git a/Source/Interfaces/CALC_GEN_MASS_Interface.f90 b/Source/Interfaces/CALC_GEN_MASS_Interface.f90 index af715d75..f92de6e5 100644 --- a/Source/Interfaces/CALC_GEN_MASS_Interface.f90 +++ b/Source/Interfaces/CALC_GEN_MASS_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE CALC_GEN_MASS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFL, NTERM_KLLDn, NTERM_MLLn, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : CALC_GEN_MASS_BEGEND USE EIGEN_MATRICES_1, ONLY : GEN_MASS, EIGEN_VEC USE MODEL_STUF, ONLY : EIG_CRIT, MAXMIJ, MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT USE SPARSE_MATRICES, ONLY : I_KLLDn, J_KLLDn, KLLDn, I_MLLn, J_MLLn, MLLn @@ -49,7 +48,7 @@ SUBROUTINE CALC_GEN_MASS CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_GEN_MASS_BEGEND + REAL(DOUBLE) :: MAX ! Temporary variable used in finding MAXMIJ REAL(DOUBLE) :: MIJ ! The i,j-th value from gen. mass matrix. Used to find MAXMIJ diff --git a/Source/Interfaces/CALC_KRRcb_Interface.f90 b/Source/Interfaces/CALC_KRRcb_Interface.f90 index 8e7b8fcd..573467f7 100644 --- a/Source/Interfaces/CALC_KRRcb_Interface.f90 +++ b/Source/Interfaces/CALC_KRRcb_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE CALC_KRRcb USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KRRcb_SDIA, & NDOFL, NDOFR, NTERM_DLR, NTERM_KRL, NTERM_KRR, NTERM_KRRcb, NTERM_KRRcbs USE TIMDAT, ONLY : TSEC @@ -44,11 +44,10 @@ SUBROUTINE CALC_KRRcb I_KRRcb, J_KRRcb, KRRcb, I_KRRcbs, J_KRRcbs, KRRcbs USE SCRATCH_MATRICES USE LAPACK_DPB_MATRICES, ONLY : ABAND - USE SUBR_BEGEND_LEVELS, ONLY : CALC_KRRcb_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_KRRcb_BEGEND + END SUBROUTINE CALC_KRRcb diff --git a/Source/Interfaces/CALC_MRN_Interface.f90 b/Source/Interfaces/CALC_MRN_Interface.f90 index 3f44a5ad..218aae5f 100644 --- a/Source/Interfaces/CALC_MRN_Interface.f90 +++ b/Source/Interfaces/CALC_MRN_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE CALC_MRN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, & NDOFL, NDOFR, NTERM_DLR, NTERM_MLL, NTERM_MLLn, NTERM_MPF0, NTERM_MRL, NTERM_MRN, & NUM_MLL_DIAG_ZEROS, NVEC @@ -48,11 +48,10 @@ SUBROUTINE CALC_MRN I_MPF0, J_MPF0, MPF0 USE SCRATCH_MATRICES, ONLY : I_CCS1, J_CCS1, CCS1, I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CRS3, J_CRS3, CRS3 - USE SUBR_BEGEND_LEVELS, ONLY : CALC_MRN_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_MRN_BEGEND + END SUBROUTINE CALC_MRN diff --git a/Source/Interfaces/CALC_MRRcb_Interface.f90 b/Source/Interfaces/CALC_MRRcb_Interface.f90 index bd24eaab..ed6857d5 100644 --- a/Source/Interfaces/CALC_MRRcb_Interface.f90 +++ b/Source/Interfaces/CALC_MRRcb_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE CALC_MRRcb USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFL, NDOFR, NTERM_DLR, NTERM_MLL, NTERM_MRL, NTERM_MRR, & NTERM_MRRcb, NTERM_MRRcbn USE TIMDAT, ONLY : TSEC @@ -47,11 +47,10 @@ SUBROUTINE CALC_MRRcb SYM_MRRcb USE SCRATCH_MATRICES - USE SUBR_BEGEND_LEVELS, ONLY : CALC_MRRcb_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_MRRcb_BEGEND + END SUBROUTINE CALC_MRRcb diff --git a/Source/Interfaces/CALC_PHIZL_Interface.f90 b/Source/Interfaces/CALC_PHIZL_Interface.f90 index 75809999..35ff540e 100644 --- a/Source/Interfaces/CALC_PHIZL_Interface.f90 +++ b/Source/Interfaces/CALC_PHIZL_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE CALC_PHIZL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFL, NDOFR, & NTERM_DLR, NTERM_PHIZL, NTERM_PHIZL1, NTERM_PHIZL2 , NTERM_MLL, NTERM_MLR, NTERM_MRL, & NUM_CB_DOFS, NVEC @@ -48,11 +48,10 @@ SUBROUTINE CALC_PHIZL USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CRS3, J_CRS3, CRS3, I_CCS1, J_CCS1, CCS1 - USE SUBR_BEGEND_LEVELS, ONLY : CALC_PHIZL_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_PHIZL_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/CALC_PHI_SQ_Interface.f90 b/Source/Interfaces/CALC_PHI_SQ_Interface.f90 index 9f3faab7..ec5d2b0f 100644 --- a/Source/Interfaces/CALC_PHI_SQ_Interface.f90 +++ b/Source/Interfaces/CALC_PHI_SQ_Interface.f90 @@ -33,9 +33,8 @@ SUBROUTINE CALC_PHI_SQ ( IERROR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CALC_PHI_SQ_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWELVE USE PARAMS, ONLY : CBMIN3, CBMIN4, CBMIN4T, EPSIL, PCMPTSTM, QUAD4TYP USE MODEL_STUF, ONLY : BENSUM, EID, EMG_IFE, EMG_RFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS, INTL_MID, PHI_SQ, & @@ -43,7 +42,7 @@ SUBROUTINE CALC_PHI_SQ ( IERROR ) IMPLICIT NONE INTEGER(LONG), INTENT(OUT) :: IERROR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_PHI_SQ_BEGEND + END SUBROUTINE CALC_PHI_SQ diff --git a/Source/Interfaces/CALC_TDOF_ROW_START_Interface.f90 b/Source/Interfaces/CALC_TDOF_ROW_START_Interface.f90 index f2a16302..d8f0764f 100644 --- a/Source/Interfaces/CALC_TDOF_ROW_START_Interface.f90 +++ b/Source/Interfaces/CALC_TDOF_ROW_START_Interface.f90 @@ -33,18 +33,17 @@ SUBROUTINE CALC_TDOF_ROW_START ( PRTDEB ) USE PENTIUM_II_KIND, ONLY : LONG USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOF_ROW_START USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : GRID_ID - USE SUBR_BEGEND_LEVELS, ONLY : CALC_TDOF_ROW_START_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: PRTDEB ! If 'Y' then print debug info if DEBUG(183) also > 0 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_TDOF_ROW_START_BEGEND + END SUBROUTINE CALC_TDOF_ROW_START diff --git a/Source/Interfaces/CALC_VEC_SORT_ORDER_Interface.f90 b/Source/Interfaces/CALC_VEC_SORT_ORDER_Interface.f90 index c693ec9d..a3a4966e 100644 --- a/Source/Interfaces/CALC_VEC_SORT_ORDER_Interface.f90 +++ b/Source/Interfaces/CALC_VEC_SORT_ORDER_Interface.f90 @@ -32,16 +32,14 @@ SUBROUTINE CALC_VEC_SORT_ORDER ( VEC, SORT_ORDER, SORT_INDICES ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CALC_VEC_SORT_ORDER_BEGEND IMPLICIT NONE CHARACTER( 5*BYTE), INTENT(OUT) :: SORT_ORDER ! Order in which the VX(i) have been sorted. If none of the tests below INTEGER(LONG), INTENT(OUT) :: SORT_INDICES(3) ! Indices of VEC in the order from lowest value component to highest - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_VEC_SORT_ORDER_BEGEND + REAL(DOUBLE), INTENT(IN) :: VEC(3) ! A 3 component vector diff --git a/Source/Interfaces/CARD_FLDS_NOT_BLANK_Interface.f90 b/Source/Interfaces/CARD_FLDS_NOT_BLANK_Interface.f90 index 4116b31c..aa8684ee 100644 --- a/Source/Interfaces/CARD_FLDS_NOT_BLANK_Interface.f90 +++ b/Source/Interfaces/CARD_FLDS_NOT_BLANK_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE CARD_FLDS_NOT_BLANK ( JCARD, FLD2, FLD3, FLD4, FLD5, FLD6, FLD7, FLD8 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CARD_FLDS_NOT_BLANK_BEGEND IMPLICIT NONE @@ -50,7 +49,7 @@ SUBROUTINE CARD_FLDS_NOT_BLANK ( JCARD, FLD2, FLD3, FLD4, FLD5, FLD6, FLD7, FLD8 INTEGER(LONG), INTENT(IN) :: FLD7 ! Refers to field 7 of a B.D. card. If /= 0, then check this field INTEGER(LONG), INTENT(IN) :: FLD8 ! Refers to field 8 of a B.D. card. If /= 0, then check this field INTEGER(LONG), INTENT(IN) :: FLD9 ! Refers to field 9 of a B.D. card. If /= 0, then check this field - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CARD_FLDS_NOT_BLANK_BEGEND + END SUBROUTINE CARD_FLDS_NOT_BLANK diff --git a/Source/Interfaces/CC_ACCE_Interface.f90 b/Source/Interfaces/CC_ACCE_Interface.f90 index 019a0dcd..80493a37 100644 --- a/Source/Interfaces/CC_ACCE_Interface.f90 +++ b/Source/Interfaces/CC_ACCE_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE CC_ACCE ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_ACCE_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : ACCE_OUT USE MODEL_STUF, ONLY : SC_ACCE @@ -43,7 +42,7 @@ SUBROUTINE CC_ACCE ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ACCE_BEGEND + END SUBROUTINE CC_ACCE diff --git a/Source/Interfaces/CC_DISP_Interface.f90 b/Source/Interfaces/CC_DISP_Interface.f90 index f9a5494d..da73aed2 100644 --- a/Source/Interfaces/CC_DISP_Interface.f90 +++ b/Source/Interfaces/CC_DISP_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE CC_DISP ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_DISP_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : DISP_OUT USE MODEL_STUF, ONLY : SC_DISP @@ -43,7 +42,7 @@ SUBROUTINE CC_DISP ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_DISP_BEGEND + END SUBROUTINE CC_DISP diff --git a/Source/Interfaces/CC_ECHO_Interface.f90 b/Source/Interfaces/CC_ECHO_Interface.f90 index 646eb846..9d44269d 100644 --- a/Source/Interfaces/CC_ECHO_Interface.f90 +++ b/Source/Interfaces/CC_ECHO_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CC_ECHO ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_ECHO_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ECHO_BEGEND + END SUBROUTINE CC_ECHO diff --git a/Source/Interfaces/CC_ELDA_Interface.f90 b/Source/Interfaces/CC_ELDA_Interface.f90 index 63e8bf37..7e26c9a8 100644 --- a/Source/Interfaces/CC_ELDA_Interface.f90 +++ b/Source/Interfaces/CC_ELDA_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE CC_ELDA ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, WARN_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_ELDA_BEGEND USE MODEL_STUF, ONLY : CCELDT IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE CC_ELDA ( CARD ) INTEGER(LONG), PARAMETER :: IOUTMAX_BUG = 9 ! Max val of IOUT (=1,2,3,4,5,6,7,8,9 are the ELDATA print options) INTEGER(LONG), PARAMETER :: IOUTMIN_FIJ = 2 ! Min val of IOUT (=1,2,3,4,5,6,7,8,9 are the ELDATA file options) INTEGER(LONG), PARAMETER :: IOUTMAX_FIJ = 6 ! Max val of IOUT (=1,2,3,4,5,6,7,8,9 are the ELDATA file options) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ELDA_BEGEND + END SUBROUTINE CC_ELDA diff --git a/Source/Interfaces/CC_ELFO_Interface.f90 b/Source/Interfaces/CC_ELFO_Interface.f90 index 92b366b1..99df487b 100644 --- a/Source/Interfaces/CC_ELFO_Interface.f90 +++ b/Source/Interfaces/CC_ELFO_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CC_ELFO ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, err + USE IOUNT1, ONLY : err USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NCCCD, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_ELFO_BEGEND USE MODEL_STUF, ONLY : SC_ELFE, SC_ELFN IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ELFO_BEGEND + END SUBROUTINE CC_ELFO diff --git a/Source/Interfaces/CC_ENFO_Interface.f90 b/Source/Interfaces/CC_ENFO_Interface.f90 index 9106d20b..ab310e18 100644 --- a/Source/Interfaces/CC_ENFO_Interface.f90 +++ b/Source/Interfaces/CC_ENFO_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CC_ENFO ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ENFFIL, ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ENFFIL, ERR, F06 USE SCONTR, ONLY : WARN_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_ENFO_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ENFO_BEGEND + END SUBROUTINE CC_ENFO diff --git a/Source/Interfaces/CC_GPFO_Interface.f90 b/Source/Interfaces/CC_GPFO_Interface.f90 index 5a0224eb..285f0baf 100644 --- a/Source/Interfaces/CC_GPFO_Interface.f90 +++ b/Source/Interfaces/CC_GPFO_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE CC_GPFO ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, LSUB, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_GPFO_BEGEND USE MODEL_STUF, ONLY : SC_GPFO IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_GPFO_BEGEND + END SUBROUTINE CC_GPFO diff --git a/Source/Interfaces/CC_LABE_Interface.f90 b/Source/Interfaces/CC_LABE_Interface.f90 index a3bdf27a..9a57a440 100644 --- a/Source/Interfaces/CC_LABE_Interface.f90 +++ b/Source/Interfaces/CC_LABE_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE CC_LABE ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : WARN_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_LABE_BEGEND USE MODEL_STUF, ONLY : LABEL IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_LABE_BEGEND + END SUBROUTINE CC_LABE diff --git a/Source/Interfaces/CC_LOAD_Interface.f90 b/Source/Interfaces/CC_LOAD_Interface.f90 index 5766e5a4..fb5b0c71 100644 --- a/Source/Interfaces/CC_LOAD_Interface.f90 +++ b/Source/Interfaces/CC_LOAD_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CC_LOAD ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_LOAD_BEGEND USE MODEL_STUF, ONLY : SUBLOD IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_LOAD_BEGEND + END SUBROUTINE CC_LOAD diff --git a/Source/Interfaces/CC_METH_Interface.f90 b/Source/Interfaces/CC_METH_Interface.f90 index 1449f8e5..87e83116 100644 --- a/Source/Interfaces/CC_METH_Interface.f90 +++ b/Source/Interfaces/CC_METH_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE CC_METH ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : WARN_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_METH_BEGEND USE MODEL_STUF, ONLY : CC_EIGR_SID IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_METH_BEGEND + END SUBROUTINE CC_METH diff --git a/Source/Interfaces/CC_MPCF_Interface.f90 b/Source/Interfaces/CC_MPCF_Interface.f90 index 277d796f..f5e6aa75 100644 --- a/Source/Interfaces/CC_MPCF_Interface.f90 +++ b/Source/Interfaces/CC_MPCF_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE CC_MPCF ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_MPCF_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : MPCF_OUT USE MODEL_STUF, ONLY : SC_MPCF @@ -43,7 +42,7 @@ SUBROUTINE CC_MPCF ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_MPCF_BEGEND + END SUBROUTINE CC_MPCF diff --git a/Source/Interfaces/CC_MPC_Interface.f90 b/Source/Interfaces/CC_MPC_Interface.f90 index 61e05972..b9af85f3 100644 --- a/Source/Interfaces/CC_MPC_Interface.f90 +++ b/Source/Interfaces/CC_MPC_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CC_MPC ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_MPC_BEGEND USE MODEL_STUF, ONLY : MPCSETS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_MPC_BEGEND + END SUBROUTINE CC_MPC diff --git a/Source/Interfaces/CC_NLPARM_Interface.f90 b/Source/Interfaces/CC_NLPARM_Interface.f90 index 5fbdd97b..3944e145 100644 --- a/Source/Interfaces/CC_NLPARM_Interface.f90 +++ b/Source/Interfaces/CC_NLPARM_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CC_NLPARM ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LSUB, NSUB, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_NLPARM_BEGEND USE NONLINEAR_PARAMS, ONLY : NL_SID IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_NLPARM_BEGEND + END SUBROUTINE CC_NLPARM diff --git a/Source/Interfaces/CC_OLOA_Interface.f90 b/Source/Interfaces/CC_OLOA_Interface.f90 index 7c74e0f9..0d9f23fb 100644 --- a/Source/Interfaces/CC_OLOA_Interface.f90 +++ b/Source/Interfaces/CC_OLOA_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE CC_OLOA ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_OLOA_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : OLOA_OUT USE MODEL_STUF, ONLY : SC_OLOA @@ -43,7 +42,7 @@ SUBROUTINE CC_OLOA ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_OLOA_BEGEND + END SUBROUTINE CC_OLOA diff --git a/Source/Interfaces/CC_OUTPUTS_Interface.f90 b/Source/Interfaces/CC_OUTPUTS_Interface.f90 index 1eeec82a..b1dc0958 100644 --- a/Source/Interfaces/CC_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/CC_OUTPUTS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE CC_OUTPUTS ( CARD, WHAT, SETID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NCCCD, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_OUTPUTS_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE CC_OUTPUTS ( CARD, WHAT, SETID ) CHARACTER(LEN=*), INTENT(IN) :: WHAT ! Which CC type output to process (e.g., DISP, SPCF, etc) INTEGER(LONG), INTENT(OUT) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_OUTPUTS_BEGEND + END SUBROUTINE CC_OUTPUTS diff --git a/Source/Interfaces/CC_SET0_Interface.f90 b/Source/Interfaces/CC_SET0_Interface.f90 index 6b0b0777..629ec902 100644 --- a/Source/Interfaces/CC_SET0_Interface.f90 +++ b/Source/Interfaces/CC_SET0_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE CC_SET0 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, LSETLN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_SET0_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SET0_BEGEND + END SUBROUTINE CC_SET0 diff --git a/Source/Interfaces/CC_SET_Interface.f90 b/Source/Interfaces/CC_SET_Interface.f90 index d94aee1f..c7b7c344 100644 --- a/Source/Interfaces/CC_SET_Interface.f90 +++ b/Source/Interfaces/CC_SET_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE CC_SET ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : CC_ENTRY_LEN, FATAL_ERR, LSETS, LSETLN, MAX_TOKEN_LEN, NSETS, SETLEN, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_SET_BEGEND USE MODEL_STUF, ONLY : ALL_SETS_ARRAY, SETS_IDS IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE CC_SET ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card CHARACTER( 3*BYTE), PARAMETER :: CARD_NAME = 'SET' ! Name of the C.C. card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SET_BEGEND + END SUBROUTINE CC_SET diff --git a/Source/Interfaces/CC_SPCF_Interface.f90 b/Source/Interfaces/CC_SPCF_Interface.f90 index eeb8423f..75c320e8 100644 --- a/Source/Interfaces/CC_SPCF_Interface.f90 +++ b/Source/Interfaces/CC_SPCF_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE CC_SPCF ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_SPCF_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : SPCF_OUT USE MODEL_STUF, ONLY : SC_SPCF @@ -43,7 +42,7 @@ SUBROUTINE CC_SPCF ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SPCF_BEGEND + END SUBROUTINE CC_SPCF diff --git a/Source/Interfaces/CC_SPC_Interface.f90 b/Source/Interfaces/CC_SPC_Interface.f90 index 38a807dd..8c2bf40e 100644 --- a/Source/Interfaces/CC_SPC_Interface.f90 +++ b/Source/Interfaces/CC_SPC_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE CC_SPC ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_SPC_BEGEND USE MODEL_STUF, ONLY : SPCSETS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SPC_BEGEND + END SUBROUTINE CC_SPC diff --git a/Source/Interfaces/CC_STRE_Interface.f90 b/Source/Interfaces/CC_STRE_Interface.f90 index fa0cbd7b..d6571016 100644 --- a/Source/Interfaces/CC_STRE_Interface.f90 +++ b/Source/Interfaces/CC_STRE_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE CC_STRE ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, LSUB, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_STRE_BEGEND USE MODEL_STUF, ONLY : SC_STRE IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_STRE_BEGEND + END SUBROUTINE CC_STRE diff --git a/Source/Interfaces/CC_STRN_Interface.f90 b/Source/Interfaces/CC_STRN_Interface.f90 index 5e8a1e04..ba62cb9f 100644 --- a/Source/Interfaces/CC_STRN_Interface.f90 +++ b/Source/Interfaces/CC_STRN_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE CC_STRN ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, LSUB, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_STRN_BEGEND USE MODEL_STUF, ONLY : SC_STRN IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_STRN_BEGEND + END SUBROUTINE CC_STRN diff --git a/Source/Interfaces/CC_SUBC_Interface.f90 b/Source/Interfaces/CC_SUBC_Interface.f90 index 1209fe46..e4c0b544 100644 --- a/Source/Interfaces/CC_SUBC_Interface.f90 +++ b/Source/Interfaces/CC_SUBC_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CC_SUBC ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : CC_ENTRY_LEN, FATAL_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_SUBC_BEGEND USE MODEL_STUF, ONLY : SCNUM IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SUBC_BEGEND + END SUBROUTINE CC_SUBC diff --git a/Source/Interfaces/CC_SUBT_Interface.f90 b/Source/Interfaces/CC_SUBT_Interface.f90 index aaf72f20..493c6c3f 100644 --- a/Source/Interfaces/CC_SUBT_Interface.f90 +++ b/Source/Interfaces/CC_SUBT_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE CC_SUBT ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : WARN_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_SUBT_BEGEND USE MODEL_STUF, ONLY : STITLE IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SUBT_BEGEND + END SUBROUTINE CC_SUBT diff --git a/Source/Interfaces/CC_TEMP_Interface.f90 b/Source/Interfaces/CC_TEMP_Interface.f90 index 252dc75c..67d8436d 100644 --- a/Source/Interfaces/CC_TEMP_Interface.f90 +++ b/Source/Interfaces/CC_TEMP_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CC_TEMP ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : LSUB, NSUB, NTSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_TEMP_BEGEND USE MODEL_STUF, ONLY : SUBLOD IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_TEMP_BEGEND + END SUBROUTINE CC_TEMP diff --git a/Source/Interfaces/CC_TITL_Interface.f90 b/Source/Interfaces/CC_TITL_Interface.f90 index a13a708a..44d8637d 100644 --- a/Source/Interfaces/CC_TITL_Interface.f90 +++ b/Source/Interfaces/CC_TITL_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE CC_TITL ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : WARN_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_TITL_BEGEND USE MODEL_STUF, ONLY : TITLE IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_TITL_BEGEND + END SUBROUTINE CC_TITL diff --git a/Source/Interfaces/CHAR_FLD_Interface.f90 b/Source/Interfaces/CHAR_FLD_Interface.f90 index 7303faf6..cd54a4e9 100644 --- a/Source/Interfaces/CHAR_FLD_Interface.f90 +++ b/Source/Interfaces/CHAR_FLD_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE CHAR_FLD ( JCARDI, IFLD, CHAR_INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR IMPLICIT NONE diff --git a/Source/Interfaces/CHECK_BAR_MOIs_Interface.f90 b/Source/Interfaces/CHECK_BAR_MOIs_Interface.f90 index 1abb991d..a7ec4861 100644 --- a/Source/Interfaces/CHECK_BAR_MOIs_Interface.f90 +++ b/Source/Interfaces/CHECK_BAR_MOIs_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE CHECK_BAR_MOIs ( NAME, ID, I1, I2, I12, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL, SUPINFO USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : CHECK_BAR_MOIs_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE CHECK_BAR_MOIs ( NAME, ID, I1, I2, I12, IERR ) CHARACTER(LEN=*), INTENT(IN) :: ID ! Character value of the bar's ID INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CHECK_BAR_MOIs_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: I1 ! MOI of the bar or beam REAL(DOUBLE), INTENT(INOUT) :: I2 ! MOI of the bar or beam diff --git a/Source/Interfaces/CHK_CC_CMD_DESCRIBERS_Interface.f90 b/Source/Interfaces/CHK_CC_CMD_DESCRIBERS_Interface.f90 index e08df49f..062c75c1 100644 --- a/Source/Interfaces/CHK_CC_CMD_DESCRIBERS_Interface.f90 +++ b/Source/Interfaces/CHK_CC_CMD_DESCRIBERS_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE CHK_CC_CMD_DESCRIBERS ( WHAT, NUM_WORDS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, ECHO, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRN_OPT, STRE_LOC, STRE_OPT USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CHK_CC_CMD_DESCRIBERS_BEGEND IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE CHK_CC_CMD_DESCRIBERS ( WHAT, NUM_WORDS ) CHARACTER(LEN=*), INTENT(IN) :: WHAT ! What Case Control output is this call for (e.g. 'DISP') INTEGER(LONG), INTENT(IN) :: NUM_WORDS ! Number of words we need to check in CC_CMD_DESCRIBERS - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CHK_CC_CMD_DESCRIBERS_BEGEND + END SUBROUTINE CHK_CC_CMD_DESCRIBERS diff --git a/Source/Interfaces/CLOSE_LIJFILES_Interface.f90 b/Source/Interfaces/CLOSE_LIJFILES_Interface.f90 index 3931017d..6aef68e0 100644 --- a/Source/Interfaces/CLOSE_LIJFILES_Interface.f90 +++ b/Source/Interfaces/CLOSE_LIJFILES_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE CLOSE_LIJFILES ( CLOSE_STAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, RESTART - USE IOUNT1, ONLY : MOU4, WRT_ERR, WRT_LOG, ERR, F06, & + USE IOUNT1, ONLY : MOU4, WRT_ERR, ERR, F06, & L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, L1K, & L1L, L1M, L1N, L1O, L1P, L1Q, L1R, L1S, L1T, L1U, & L1V, L1W, L1X, L1Y, L1Z, & @@ -41,7 +41,7 @@ SUBROUTINE CLOSE_LIJFILES ( CLOSE_STAT ) L2K, L2L, L2M, L2N, L2O, L2P, L2Q, L2R, L2S, L2T, & L3A, L4A, L4B, L4C, L4D, L5A, L5B, OU4 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, & + USE IOUNT1, ONLY : WRT_ERR, & LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, LINK1K, & LINK1L, LINK1M, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1R, LINK1S, LINK1T, LINK1U, & LINK1V, LINK1W, LINK1X, LINK1Y, LINK1Z, & @@ -49,7 +49,7 @@ SUBROUTINE CLOSE_LIJFILES ( CLOSE_STAT ) LINK2K, LINK2L, LINK2M, LINK2N, LINK2O, LINK2P, LINK2Q, LINK2R, LINK2S, LINK2T, & LINK3A, LINK4A, LINK4B, LINK4C, LINK4D, LINK5A, LINK5B, OU4FIL - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, & + USE IOUNT1, ONLY : WRT_ERR, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1JSTAT, L1KSTAT, & L1LSTAT, L1MSTAT, L1NSTAT, L1OSTAT, L1PSTAT, L1QSTAT, L1RSTAT, L1SSTAT, L1TSTAT, L1USTAT, & L1VSTAT, L1WSTAT, L1XSTAT, L1YSTAT, L1ZSTAT, & diff --git a/Source/Interfaces/CLOSE_OUTFILES_Interface.f90 b/Source/Interfaces/CLOSE_OUTFILES_Interface.f90 index d5eddf51..a5e28124 100644 --- a/Source/Interfaces/CLOSE_OUTFILES_Interface.f90 +++ b/Source/Interfaces/CLOSE_OUTFILES_Interface.f90 @@ -28,18 +28,17 @@ MODULE CLOSE_OUTFILES_Interface INTERFACE - SUBROUTINE CLOSE_OUTFILES ( BUG_CLOSE_STAT, ERR_CLOSE_STAT, F04_CLOSE_STAT, OP2_CLOSE_STAT, PCH_CLOSE_STAT ) + SUBROUTINE CLOSE_OUTFILES ( BUG_CLOSE_STAT, ERR_CLOSE_STAT, OP2_CLOSE_STAT, PCH_CLOSE_STAT ) USE PENTIUM_II_KIND, ONLY : BYTE - USE IOUNT1, ONLY : BUG , ERR , F04 , F06 , OP2 , PCH ,SC1, WRT_LOG, & - BUGFIL, ERRFIL, F04FIL, F06FIL, OP2FIL, PCHFIL + USE IOUNT1, ONLY : BUG , ERR , F06 , OP2 , PCH ,SC1, & + BUGFIL, ERRFIL, F06FIL, OP2FIL, PCHFIL IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: BUG_CLOSE_STAT ! Input value for close status for BUG CHARACTER(LEN=*), INTENT(IN) :: ERR_CLOSE_STAT ! Input value for close status for ERR - CHARACTER(LEN=*), INTENT(IN) :: F04_CLOSE_STAT ! Input value for close status for F04 CHARACTER(LEN=*), INTENT(IN) :: OP2_CLOSE_STAT ! Input value for close status for OP2 CHARACTER(LEN=*), INTENT(IN) :: PCH_CLOSE_STAT ! Input value for close status for PCH diff --git a/Source/Interfaces/CNT_NONZ_IN_FULL_MAT_Interface.f90 b/Source/Interfaces/CNT_NONZ_IN_FULL_MAT_Interface.f90 index f728175a..3d4b68a3 100644 --- a/Source/Interfaces/CNT_NONZ_IN_FULL_MAT_Interface.f90 +++ b/Source/Interfaces/CNT_NONZ_IN_FULL_MAT_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE CNT_NONZ_IN_FULL_MAT ( MATIN_NAME, MATIN, NROWS, NCOLS, SYM, NTERM_NO USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL, SUPINFO, TINY USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : CNT_NONZ_IN_FULL_MAT_BEGEND IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE CNT_NONZ_IN_FULL_MAT ( MATIN_NAME, MATIN, NROWS, NCOLS, SYM, NTERM_NO INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in the matrix INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in the matrix INTEGER(LONG), INTENT(OUT) :: NTERM_NONZERO ! Number of nonzero (or significant) values in the matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CNT_NONZ_IN_FULL_MAT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NROWS,NCOLS)! Input full matrix REAL(DOUBLE) , INTENT(OUT) :: SMALL ! Filter for small terms diff --git a/Source/Interfaces/COND_NUM_Interface.f90 b/Source/Interfaces/COND_NUM_Interface.f90 index 83a5bf3c..98b42b0b 100644 --- a/Source/Interfaces/COND_NUM_Interface.f90 +++ b/Source/Interfaces/COND_NUM_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE COND_NUM ( MATIN_NAME, N, KD, K_INORM, MATIN_FAC, RCOND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : ITMAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : COND_NUM_BEGEND USE LAPACK_LIN_EQN_DPB IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE COND_NUM ( MATIN_NAME, N, KD, K_INORM, MATIN_FAC, RCOND ) INTEGER(LONG), INTENT(IN) :: N ! No. cols in array MATIN_FAC INTEGER(LONG), INTENT(IN) :: KD ! No. of superdiagonals of KAA - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = COND_NUM_BEGEND + REAL(DOUBLE), INTENT(IN) :: K_INORM ! The infinity-norm of the matrix whose name is MATIN_NAME REAL(DOUBLE), INTENT(IN) :: MATIN_FAC(KD+1,N) ! The upper triangular factor of the matrix whose name is MATIN_NAME diff --git a/Source/Interfaces/CONM2_PROC_1_Interface.f90 b/Source/Interfaces/CONM2_PROC_1_Interface.f90 index 17faf4d1..c0a40f37 100644 --- a/Source/Interfaces/CONM2_PROC_1_Interface.f90 +++ b/Source/Interfaces/CONM2_PROC_1_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE CONM2_PROC_1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1Y + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1Y USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, FATAL_ERR, MCMASS, MCONM2, MPMASS, MRCONM2, MRPMASS, NCMASS, & NCONM2, NCORD, NGRID, NPMASS, WARN_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CONM2_PROC_1_BEGEND USE MODEL_STUF, ONLY : CMASS, CONM2, PMASS, RCONM2, RPMASS, GRID, GRID_ID, CORD USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -47,7 +46,7 @@ SUBROUTINE CONM2_PROC_1 CHARACTER(8*BYTE), PARAMETER :: NAME = 'CONM2 ' INTEGER(LONG) :: NUM_RCONM2_RESET ! No. RCONM2's reset to zero because they are connected to SPOINT's - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CONM2_PROC_1_BEGEND + END SUBROUTINE CONM2_PROC_1 diff --git a/Source/Interfaces/CONM2_PROC_2_Interface.f90 b/Source/Interfaces/CONM2_PROC_2_Interface.f90 index b835a07f..fdd4b8a3 100644 --- a/Source/Interfaces/CONM2_PROC_2_Interface.f90 +++ b/Source/Interfaces/CONM2_PROC_2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE CONM2_PROC_2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCONM2, NCORD, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CONM2_PROC_2_BEGEND USE MODEL_STUF, ONLY : CONM2, RCONM2, GRID, GRID_ID, CORD USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -43,7 +42,7 @@ SUBROUTINE CONM2_PROC_2 CHARACTER(8*BYTE), PARAMETER :: NAME = 'CONM2 ' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CONM2_PROC_2_BEGEND + END SUBROUTINE CONM2_PROC_2 diff --git a/Source/Interfaces/CONVERT_INT_TO_CHAR_Interface.f90 b/Source/Interfaces/CONVERT_INT_TO_CHAR_Interface.f90 index e85b48a6..401d3b85 100644 --- a/Source/Interfaces/CONVERT_INT_TO_CHAR_Interface.f90 +++ b/Source/Interfaces/CONVERT_INT_TO_CHAR_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE CONVERT_INT_TO_CHAR ( INT_NUM, CHAR_VALUE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CONVERT_INT_TO_CHAR_BEGEND IMPLICIT NONE CHARACTER(1*BYTE), INTENT(OUT) :: CHAR_VALUE ! If INT_NUM = 1, then CHAR_VALUE = '1', etc INTEGER(LONG), INTENT(IN) :: INT_NUM ! Integer 1, 2, 3, 4, 5 O5 6 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CONVERT_INT_TO_CHAR_BEGEND + END SUBROUTINE CONVERT_INT_TO_CHAR diff --git a/Source/Interfaces/CONVERT_VEC_COORD_SYS_Interface.f90 b/Source/Interfaces/CONVERT_VEC_COORD_SYS_Interface.f90 index f411e15a..cefa674d 100644 --- a/Source/Interfaces/CONVERT_VEC_COORD_SYS_Interface.f90 +++ b/Source/Interfaces/CONVERT_VEC_COORD_SYS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NCORD, NDOFG, NGRID USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : CORD, RCORD, GRID, GRID_ID, INV_GRID_SEQ - USE SUBR_BEGEND_LEVELS, ONLY : CONVERT_VEC_COORD_SYS_BEGEND IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) INTEGER(LONG), INTENT(IN) :: NCID ! Actual coord system number. INPUT_VEC is to be transformed to this sys. INTEGER(LONG) :: JFLD ! Used in error message to indicate a coord sys ID undefined - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CONVERT_VEC_COORD_SYS_BEGEND + REAL(DOUBLE), INTENT(IN) :: INPUT_VEC(NDOFG) ! G-set input vector to be transformed from global to NCID REAL(DOUBLE), INTENT(OUT) :: OUTPUT_VEC(NDOFG) ! Transformed output vector diff --git a/Source/Interfaces/CORD_PROC_Interface.f90 b/Source/Interfaces/CORD_PROC_Interface.f90 index 02d5134e..9ee7e2dd 100644 --- a/Source/Interfaces/CORD_PROC_Interface.f90 +++ b/Source/Interfaces/CORD_PROC_Interface.f90 @@ -33,16 +33,15 @@ SUBROUTINE CORD_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE80, PI, CONV_DEG_RAD - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NCORD, NCORD1, NCORD2, NGRID, FATAL_ERR USE PARAMS, ONLY : EPSIL, PRTCORD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CORD_PROC_BEGEND USE MODEL_STUF, ONLY : CORD, GRID, RCORD, RGRID, TN IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CORD_PROC_BEGEND + END SUBROUTINE CORD_PROC diff --git a/Source/Interfaces/CRDERR_Interface.f90 b/Source/Interfaces/CRDERR_Interface.f90 index c6aea7ce..0303bc29 100644 --- a/Source/Interfaces/CRDERR_Interface.f90 +++ b/Source/Interfaces/CRDERR_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE CRDERR ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, IERRFL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CRDERR_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CRDERR_BEGEND + END SUBROUTINE CRDERR diff --git a/Source/Interfaces/CROSS_Interface.f90 b/Source/Interfaces/CROSS_Interface.f90 index 746a9cd6..5fedb212 100644 --- a/Source/Interfaces/CROSS_Interface.f90 +++ b/Source/Interfaces/CROSS_Interface.f90 @@ -32,14 +32,12 @@ SUBROUTINE CROSS ( A, B, C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CROSS_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CROSS_BEGEND + REAL(DOUBLE), INTENT(IN) :: A(3) ! Components of input vector A REAL(DOUBLE), INTENT(IN) :: B(3) ! Components of input vector B diff --git a/Source/Interfaces/CRS_NONSYM_TO_CRS_SYM_Interface.f90 b/Source/Interfaces/CRS_NONSYM_TO_CRS_SYM_Interface.f90 index c568e816..9254de8c 100644 --- a/Source/Interfaces/CRS_NONSYM_TO_CRS_SYM_Interface.f90 +++ b/Source/Interfaces/CRS_NONSYM_TO_CRS_SYM_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE CRS_NONSYM_TO_CRS_SYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : CRS_NONSYM_TO_CRS_SYM_BEGEND IMPLICIT NONE @@ -50,7 +49,7 @@ SUBROUTINE CRS_NONSYM_TO_CRS_SYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, INTEGER(LONG), INTENT(IN) :: J_A(NTERM_A) ! Col numbers for nonzero terms in A INTEGER(LONG), INTENT(OUT) :: I_B(NROW_A+1) ! I_B(I+1) - I_B(I) are the num of nonzeros in B row I INTEGER(LONG), INTENT(OUT) :: J_B(NTERM_B) ! Col numbers for nonzero terms in B - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CRS_NONSYM_TO_CRS_SYM_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NTERM_A) ! Real nonzero values in input matrix A REAL(DOUBLE) , INTENT(OUT) :: B(NTERM_B) ! Real nonzero values in output matrix B diff --git a/Source/Interfaces/CRS_SYM_TO_CRS_NONSYM_Interface.f90 b/Source/Interfaces/CRS_SYM_TO_CRS_NONSYM_Interface.f90 index d9c1f52c..f1aa904a 100644 --- a/Source/Interfaces/CRS_SYM_TO_CRS_NONSYM_Interface.f90 +++ b/Source/Interfaces/CRS_SYM_TO_CRS_NONSYM_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE CRS_SYM_TO_CRS_NONSYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : CRS_SYM_TO_CRS_NONSYM_BEGEND IMPLICIT NONE @@ -52,7 +51,7 @@ SUBROUTINE CRS_SYM_TO_CRS_NONSYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, INTEGER(LONG), INTENT(IN) :: J_A(NTERM_A) ! Col numbers for nonzero terms in A INTEGER(LONG), INTENT(OUT) :: I_B(NROW_A+1) ! I_B(I+1) - I_B(I) are the num of nonzeros in B row I INTEGER(LONG), INTENT(OUT) :: J_B(NTERM_B) ! Col numbers for nonzero terms in B - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CRS_SYM_TO_CRS_NONSYM_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NTERM_A) ! Real nonzero values in input matrix A REAL(DOUBLE) , INTENT(OUT) :: B(NTERM_B) ! Real nonzero values in output matrix B diff --git a/Source/Interfaces/CSHIFT_Interface.f90 b/Source/Interfaces/CSHIFT_Interface.f90 index f097142c..06b38abd 100644 --- a/Source/Interfaces/CSHIFT_Interface.f90 +++ b/Source/Interfaces/CSHIFT_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE CSHIFT ( CARD_IN, CHAR, CARD_SHIFTED, CHAR_COL, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CSHIFT_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE CSHIFT ( CARD_IN, CHAR, CARD_SHIFTED, CHAR_COL, IERR ) INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator. If CHAR not found, IERR set to 1 INTEGER(LONG), INTENT(OUT) :: CHAR_COL ! Column number on CARD where character CHAR is found - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CSHIFT_BEGEND + END SUBROUTINE CSHIFT diff --git a/Source/Interfaces/DATA_SET_NAME_ERROR_Interface.f90 b/Source/Interfaces/DATA_SET_NAME_ERROR_Interface.f90 index 2b08e1ed..d0235a76 100644 --- a/Source/Interfaces/DATA_SET_NAME_ERROR_Interface.f90 +++ b/Source/Interfaces/DATA_SET_NAME_ERROR_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE DATA_SET_NAME_ERROR ( DATA_NAME_ShouldBe, FILNAM, DATA_NAME_Is ) USE PENTIUM_II_KIND, ONLY : LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR IMPLICIT NONE diff --git a/Source/Interfaces/DATA_SET_SIZE_ERROR_Interface.f90 b/Source/Interfaces/DATA_SET_SIZE_ERROR_Interface.f90 index 8751b7b9..1a324981 100644 --- a/Source/Interfaces/DATA_SET_SIZE_ERROR_Interface.f90 +++ b/Source/Interfaces/DATA_SET_SIZE_ERROR_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE DATA_SET_SIZE_ERROR ( FILNAM, DATA_SET_NAME, DATA_NAME, INT1, INT2 ) USE PENTIUM_II_KIND, ONLY : LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06, LINK1A + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, LINK1A USE SCONTR, ONLY : FATAL_ERR IMPLICIT NONE diff --git a/Source/Interfaces/DEALLOCATE_CB_ELM_OTM_Interface.f90 b/Source/Interfaces/DEALLOCATE_CB_ELM_OTM_Interface.f90 index 31d6f123..07a06b1c 100644 --- a/Source/Interfaces/DEALLOCATE_CB_ELM_OTM_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_CB_ELM_OTM_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE DEALLOCATE_CB_ELM_OTM ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_CB_ELM_OTM_BEGEND USE OUTPUT4_MATRICES IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_CB_ELM_OTM_BEGEND + END SUBROUTINE DEALLOCATE_CB_ELM_OTM diff --git a/Source/Interfaces/DEALLOCATE_CB_GRD_OTM_Interface.f90 b/Source/Interfaces/DEALLOCATE_CB_GRD_OTM_Interface.f90 index eeb0aba6..a763d784 100644 --- a/Source/Interfaces/DEALLOCATE_CB_GRD_OTM_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_CB_GRD_OTM_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE DEALLOCATE_CB_GRD_OTM ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_CB_GRD_OTM_BEGEND USE OUTPUT4_MATRICES, ONLY : OTM_ACCE, OTM_DISP, OTM_MPCF, OTM_SPCF IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_CB_GRD_OTM_BEGEND + END SUBROUTINE DEALLOCATE_CB_GRD_OTM diff --git a/Source/Interfaces/DEALLOCATE_COL_VEC_Interface.f90 b/Source/Interfaces/DEALLOCATE_COL_VEC_Interface.f90 index e548d1e9..78a64702 100644 --- a/Source/Interfaces/DEALLOCATE_COL_VEC_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_COL_VEC_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE DEALLOCATE_COL_VEC ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_COL_VEC_BEGEND USE OUTPUT4_MATRICES, ONLY : OU4_MAT_COL_GRD_COMP, OU4_MAT_ROW_GRD_COMP USE COL_VECS, ONLY : UG_COL, UN_COL, UM_COL, UF_COL, US_COL, UA_COL, UO_COL, UO0_COL, UR_COL, UL_COL, YSe, & FG_COL, FN_COL, FM_COL, FF_COL, FS_COL, FA_COL, FO_COL, FL_COL, FR_COL, & @@ -50,7 +49,7 @@ SUBROUTINE DEALLOCATE_COL_VEC ( NAME ) CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_COL_VEC_BEGEND + END SUBROUTINE DEALLOCATE_COL_VEC diff --git a/Source/Interfaces/DEALLOCATE_DOF_TABLES_Interface.f90 b/Source/Interfaces/DEALLOCATE_DOF_TABLES_Interface.f90 index ca511f6d..8f27378f 100644 --- a/Source/Interfaces/DEALLOCATE_DOF_TABLES_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_DOF_TABLES_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE DEALLOCATE_DOF_TABLES ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_DOF_TABLES_BEGEND USE DOF_TABLES, ONLY : TDOFI, TDOF_ROW_START, TDOF, TSET IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_DOF_TABLES_BEGEND + END SUBROUTINE DEALLOCATE_DOF_TABLES diff --git a/Source/Interfaces/DEALLOCATE_EIGEN1_MAT_Interface.f90 b/Source/Interfaces/DEALLOCATE_EIGEN1_MAT_Interface.f90 index 3623cbec..2174c8ed 100644 --- a/Source/Interfaces/DEALLOCATE_EIGEN1_MAT_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_EIGEN1_MAT_Interface.f90 @@ -33,18 +33,17 @@ SUBROUTINE DEALLOCATE_EIGEN1_MAT ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_EIGEN1_MAT_BEGEND USE EIGEN_MATRICES_1 , ONLY : EIGEN_VAL, EIGEN_VEC, GEN_MASS, MODE_NUM, MEFFMASS, MPFACTOR_N6, MPFACTOR_NR IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_EIGEN1_MAT_BEGEND + END SUBROUTINE DEALLOCATE_EIGEN1_MAT diff --git a/Source/Interfaces/DEALLOCATE_EMS_ARRAYS_Interface.f90 b/Source/Interfaces/DEALLOCATE_EMS_ARRAYS_Interface.f90 index 26cf6ef6..1a3d607d 100644 --- a/Source/Interfaces/DEALLOCATE_EMS_ARRAYS_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_EMS_ARRAYS_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE DEALLOCATE_EMS_ARRAYS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_EMS_ARRAYS_BEGEND USE EMS_ARRAYS, ONLY : EMSCOL, EMSKEY, EMSPNT, EMS IMPLICIT NONE CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_EMS_ARRAYS_BEGEND + END SUBROUTINE DEALLOCATE_EMS_ARRAYS diff --git a/Source/Interfaces/DEALLOCATE_FEMAP_DATA_Interface.f90 b/Source/Interfaces/DEALLOCATE_FEMAP_DATA_Interface.f90 index d911986a..c64c1d7d 100644 --- a/Source/Interfaces/DEALLOCATE_FEMAP_DATA_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_FEMAP_DATA_Interface.f90 @@ -33,17 +33,16 @@ SUBROUTINE DEALLOCATE_FEMAP_DATA USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_FEMAP_DATA_BEGEND USE FEMAP_ARRAYS, ONLY : FEMAP_EL_VECS, FEMAP_EL_NUMS IMPLICIT NONE CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_FEMAP_DATA_BEGEND + END SUBROUTINE DEALLOCATE_FEMAP_DATA diff --git a/Source/Interfaces/DEALLOCATE_FULL_MAT_Interface.f90 b/Source/Interfaces/DEALLOCATE_FULL_MAT_Interface.f90 index 9bf2681f..ccdff5e5 100644 --- a/Source/Interfaces/DEALLOCATE_FULL_MAT_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_FULL_MAT_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE DEALLOCATE_FULL_MAT ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_FULL_MAT_BEGEND USE FULL_MATRICES, ONLY : KNN_FULL, KNM_FULL, KMM_FULL, MNN_FULL, MNM_FULL, MMM_FULL, PN_FULL, PM_FULL, & KFF_FULL, KFS_FULL, KSS_FULL, MFF_FULL, MFS_FULL, MSS_FULL, PF_FULL, PS_FULL, & KAA_FULL, KAO_FULL, KOO_FULL, MAA_FULL, MAO_FULL, MOO_FULL, PA_FULL, PO_FULL, & @@ -49,7 +48,7 @@ SUBROUTINE DEALLOCATE_FULL_MAT ( NAME ) CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_FULL_MAT_BEGEND + END SUBROUTINE DEALLOCATE_FULL_MAT diff --git a/Source/Interfaces/DEALLOCATE_IN4_FILES_Interface.f90 b/Source/Interfaces/DEALLOCATE_IN4_FILES_Interface.f90 index 983a343e..d75f1fce 100644 --- a/Source/Interfaces/DEALLOCATE_IN4_FILES_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_IN4_FILES_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE DEALLOCATE_IN4_FILES ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN4FIL, IN4FIL_NUM, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN4FIL, IN4FIL_NUM, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO USE INPUTT4_MATRICES, ONLY : IN4_COL_MAP, IN4_MAT - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_IN4_FILES_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_IN4_FILES_BEGEND + END SUBROUTINE DEALLOCATE_IN4_FILES diff --git a/Source/Interfaces/DEALLOCATE_L1_MGG_Interface.f90 b/Source/Interfaces/DEALLOCATE_L1_MGG_Interface.f90 index 4cf8c5d7..23379cc3 100644 --- a/Source/Interfaces/DEALLOCATE_L1_MGG_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_L1_MGG_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_L1_MGG_BEGEND USE SPARSE_MATRICES, ONLY : I_MGG, I2_MGG, J_MGG, MGG, I_MGGC, J_MGGC, MGGC, I_MGGE, J_MGGE, MGGE, I_MGGS, J_MGGS, MGGS IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME_IN ! Name of matrix to be allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_L1_MGG_BEGEND + END SUBROUTINE DEALLOCATE_L1_MGG diff --git a/Source/Interfaces/DEALLOCATE_L2_GMN_2_Interface.f90 b/Source/Interfaces/DEALLOCATE_L2_GMN_2_Interface.f90 index e95f5d0c..dd28730b 100644 --- a/Source/Interfaces/DEALLOCATE_L2_GMN_2_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_L2_GMN_2_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE DEALLOCATE_L2_GMN_2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_L2_GMN_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_GMN IMPLICIT NONE CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_L2_GMN_2_BEGEND + END SUBROUTINE DEALLOCATE_L2_GMN_2 diff --git a/Source/Interfaces/DEALLOCATE_L2_GOA_2_Interface.f90 b/Source/Interfaces/DEALLOCATE_L2_GOA_2_Interface.f90 index 971c5a0d..2e06c3ae 100644 --- a/Source/Interfaces/DEALLOCATE_L2_GOA_2_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_L2_GOA_2_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE DEALLOCATE_L2_GOA_2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_L2_GOA_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_GOA IMPLICIT NONE CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_L2_GOA_2_BEGEND + END SUBROUTINE DEALLOCATE_L2_GOA_2 diff --git a/Source/Interfaces/DEALLOCATE_L6_2_Interface.f90 b/Source/Interfaces/DEALLOCATE_L6_2_Interface.f90 index f111b704..05b8a589 100644 --- a/Source/Interfaces/DEALLOCATE_L6_2_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_L6_2_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE DEALLOCATE_L6_2 ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_L6_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_DLR, I2_DLRt, I2_PHIZL1, I2_PHIZL1t IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_L6_2_BEGEND + END SUBROUTINE DEALLOCATE_L6_2 diff --git a/Source/Interfaces/DEALLOCATE_LAPACK_MAT_Interface.f90 b/Source/Interfaces/DEALLOCATE_LAPACK_MAT_Interface.f90 index b3288dc3..f5863f70 100644 --- a/Source/Interfaces/DEALLOCATE_LAPACK_MAT_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_LAPACK_MAT_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE DEALLOCATE_LAPACK_MAT ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_LAPACK_MAT_BEGEND USE ARPACK_MATRICES_1 , ONLY : IWORK, RFAC, RESID, SELECT, VBAS, WORKD, WORKL USE LAPACK_DPB_MATRICES, ONLY : ABAND, BBAND, LAPACK_S, RES @@ -45,7 +44,7 @@ SUBROUTINE DEALLOCATE_LAPACK_MAT ( NAME ) CHARACTER(LEN=*), INTENT(IN) :: NAME ! Name of matrix to be allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_LAPACK_MAT_BEGEND + END SUBROUTINE DEALLOCATE_LAPACK_MAT diff --git a/Source/Interfaces/DEALLOCATE_LINK9_STUF_Interface.f90 b/Source/Interfaces/DEALLOCATE_LINK9_STUF_Interface.f90 index f4acdee6..c86c7b9f 100644 --- a/Source/Interfaces/DEALLOCATE_LINK9_STUF_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_LINK9_STUF_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE DEALLOCATE_LINK9_STUF USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_LINK9_STUF_BEGEND USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, EID_OUT_ARRAY, FTNAME, MSPRNT, OGEL, POLY_FIT_ERR, & POLY_FIT_ERR_INDEX @@ -44,7 +43,7 @@ SUBROUTINE DEALLOCATE_LINK9_STUF CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_LINK9_STUF_BEGEND + END SUBROUTINE DEALLOCATE_LINK9_STUF diff --git a/Source/Interfaces/DEALLOCATE_MISC_MAT_Interface.f90 b/Source/Interfaces/DEALLOCATE_MISC_MAT_Interface.f90 index 4d676110..3f51c12d 100644 --- a/Source/Interfaces/DEALLOCATE_MISC_MAT_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_MISC_MAT_Interface.f90 @@ -33,18 +33,17 @@ SUBROUTINE DEALLOCATE_MISC_MAT ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO USE MISC_MATRICES, ONLY : UG_T123_MAT - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_MISC_MAT_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_MISC_MAT_BEGEND + END SUBROUTINE DEALLOCATE_MISC_MAT diff --git a/Source/Interfaces/DEALLOCATE_MODEL_STUF_Interface.f90 b/Source/Interfaces/DEALLOCATE_MODEL_STUF_Interface.f90 index 70cb0b9a..c3dcab5e 100644 --- a/Source/Interfaces/DEALLOCATE_MODEL_STUF_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_MODEL_STUF_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_MODEL_STUF_BEGEND USE MODEL_STUF, ONLY : AGRID, BE1, BE2, BE3, BGRID, DOFPIN, DT, KE, KED, KEM, ME, OFFDIS, OFFDIS_B, OFFSET, & PEB, PEG, PEL, PPE, PRESS, PTE, SE1, SE2, SE3, STE1, STE2, STE3, UEB, UEG, UEL, UGG, & @@ -71,7 +70,7 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) CHARACTER(LEN=*), INTENT(IN) :: NAME_IN ! Name of group of arrays to allocate CHARACTER(31*BYTE) :: NAME ! Specific array name used for output error message - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_MODEL_STUF_BEGEND + END SUBROUTINE DEALLOCATE_MODEL_STUF diff --git a/Source/Interfaces/DEALLOCATE_NL_PARAMS_Interface.f90 b/Source/Interfaces/DEALLOCATE_NL_PARAMS_Interface.f90 index dab36364..a70e0ac6 100644 --- a/Source/Interfaces/DEALLOCATE_NL_PARAMS_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_NL_PARAMS_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE DEALLOCATE_NL_PARAMS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LSUB, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO USE NONLINEAR_PARAMS, ONLY : NL_SID - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_NL_PARAMS_BEGEND IMPLICIT NONE CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_NL_PARAMS_BEGEND + END SUBROUTINE DEALLOCATE_NL_PARAMS diff --git a/Source/Interfaces/DEALLOCATE_RBGLOBAL_Interface.f90 b/Source/Interfaces/DEALLOCATE_RBGLOBAL_Interface.f90 index 1039065a..56b046e5 100644 --- a/Source/Interfaces/DEALLOCATE_RBGLOBAL_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_RBGLOBAL_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE DEALLOCATE_RBGLOBAL ( SET ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_RBGLOBAL_BEGEND USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_NSET, RBGLOBAL_FSET, RBGLOBAL_ASET, RBGLOBAL_LSET, & TR6_CG, TR6_MEFM, TR6_0 @@ -46,7 +45,7 @@ SUBROUTINE DEALLOCATE_RBGLOBAL ( SET ) CHARACTER(LEN=*), INTENT(IN) :: SET ! Set name of the displ matrix CHARACTER(13*BYTE) :: NAME ! Specific array name used for output error message - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_RBGLOBAL_BEGEND + END SUBROUTINE DEALLOCATE_RBGLOBAL diff --git a/Source/Interfaces/DEALLOCATE_SCR_MAT_Interface.f90 b/Source/Interfaces/DEALLOCATE_SCR_MAT_Interface.f90 index 7774ef46..e519ea4b 100644 --- a/Source/Interfaces/DEALLOCATE_SCR_MAT_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_SCR_MAT_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_SCR_MAT_BEGEND USE SCRATCH_MATRICES , ONLY : I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CRS3, J_CRS3, CRS3, & I_CCS1, J_CCS1, CCS1, I_CCS2, J_CCS2, CCS2, I_CCS3, J_CCS3, CCS3 @@ -45,7 +44,7 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) CHARACTER(LEN=*), INTENT(IN) :: NAME_IN ! Array name (used for output error message) CHARACTER(6*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_SCR_MAT_BEGEND + END SUBROUTINE DEALLOCATE_SCR_MAT diff --git a/Source/Interfaces/DEALLOCATE_SPARSE_ALG_Interface.f90 b/Source/Interfaces/DEALLOCATE_SPARSE_ALG_Interface.f90 index babafa42..3c9838b0 100644 --- a/Source/Interfaces/DEALLOCATE_SPARSE_ALG_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_SPARSE_ALG_Interface.f90 @@ -33,18 +33,17 @@ SUBROUTINE DEALLOCATE_SPARSE_ALG ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_SPARSE_ALG_BEGEND USE SPARSE_ALG_ARRAYS, ONLY : ALG, AROW, J_AROW, LOGICAL_VEC, REAL_VEC IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_SPARSE_ALG_BEGEND + END SUBROUTINE DEALLOCATE_SPARSE_ALG diff --git a/Source/Interfaces/DEALLOCATE_SPARSE_MAT_Interface.f90 b/Source/Interfaces/DEALLOCATE_SPARSE_MAT_Interface.f90 index 34da00cb..6d978dd2 100644 --- a/Source/Interfaces/DEALLOCATE_SPARSE_MAT_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_SPARSE_MAT_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_SPARSE_MAT_BEGEND USE SPARSE_MATRICES , ONLY : I_KGG , J_KGG , KGG , I_MGG , J_MGG , MGG , I_PG , J_PG , PG , & I_KGGD , J_KGGD , KGGD , & @@ -91,7 +90,7 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) CHARACTER(LEN=*), INTENT(IN) :: NAME_IN ! Array name (used for output error message) CHARACTER(6*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_SPARSE_MAT_BEGEND + END SUBROUTINE DEALLOCATE_SPARSE_MAT diff --git a/Source/Interfaces/DEALLOCATE_STF_ARRAYS_Interface.f90 b/Source/Interfaces/DEALLOCATE_STF_ARRAYS_Interface.f90 index 1d4bf8f1..7c77b16d 100644 --- a/Source/Interfaces/DEALLOCATE_STF_ARRAYS_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_STF_ARRAYS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_STF_ARRAYS_BEGEND USE STF_ARRAYS, ONLY : STFCOL, STFKEY, STFPNT, STF, STF3 IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_STF_ARRAYS_BEGEND + END SUBROUTINE DEALLOCATE_STF_ARRAYS diff --git a/Source/Interfaces/DEALLOCATE_TEMPLATE_Interface.f90 b/Source/Interfaces/DEALLOCATE_TEMPLATE_Interface.f90 index 405c383e..328fadc2 100644 --- a/Source/Interfaces/DEALLOCATE_TEMPLATE_Interface.f90 +++ b/Source/Interfaces/DEALLOCATE_TEMPLATE_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE DEALLOCATE_TEMPLATE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_TEMPLATE_BEGEND USE STF_TEMPLATE_ARRAYS, ONLY : CROW, TEMPLATE IMPLICIT NONE CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_TEMPLATE_BEGEND + END SUBROUTINE DEALLOCATE_TEMPLATE diff --git a/Source/Interfaces/DOF_PROC_Interface.f90 b/Source/Interfaces/DOF_PROC_Interface.f90 index bb6cd15d..4cac4eca 100644 --- a/Source/Interfaces/DOF_PROC_Interface.f90 +++ b/Source/Interfaces/DOF_PROC_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE DOF_PROC ( TDOF_MSG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFSE, NUM_USETSTR, SOL_NAME USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: TDOF_MSG ! Message to be printed out regarding at what point in the run the TDOF,I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + END SUBROUTINE DOF_PROC diff --git a/Source/Interfaces/DSBAND_PREFAC_Interface.f90 b/Source/Interfaces/DSBAND_PREFAC_Interface.f90 index aad48102..aff47eac 100644 --- a/Source/Interfaces/DSBAND_PREFAC_Interface.f90 +++ b/Source/Interfaces/DSBAND_PREFAC_Interface.f90 @@ -35,13 +35,12 @@ SUBROUTINE DSBAND_PREFAC ( RVEC, HOWMNY, SELECT, D, Z, LDZ, & & LWORKL, IWORK, INFO, INFO_LAPACK, DTBSV_MSG, PITERS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, SOL_NAME, & & NTERM_KLLDn, NTERM_MLLn, & & NTERM_KMSMn, NTERM_ALL USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : EIG_MSGLVL, EIG_LAP_MAT_TYPE - USE SUBR_BEGEND_LEVELS, ONLY : ARPACK_BEGEND USE SuperLU_STUF, ONLY : SLU_FACTORS, SLU_INFO USE PARAMS, ONLY : SOLLIB USE SPARSE_MATRICES, ONLY : I_KLLDn, J_KLLDn, KLLDn, & diff --git a/Source/Interfaces/EC_IN4FIL_Interface.f90 b/Source/Interfaces/EC_IN4FIL_Interface.f90 index f0ca26ab..3b7dd27a 100644 --- a/Source/Interfaces/EC_IN4FIL_Interface.f90 +++ b/Source/Interfaces/EC_IN4FIL_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE EC_IN4FIL ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, FILE_NAM_MAXLEN, IN4FIL, IN4FIL_NUM, NUM_IN4_FILES + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, FILE_NAM_MAXLEN, IN4FIL, IN4FIL_NUM, NUM_IN4_FILES USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_TOKEN_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : EC_IN4FIL_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EC_IN4FIL_BEGEND + END SUBROUTINE EC_IN4FIL diff --git a/Source/Interfaces/EC_OUTPUT4_Interface.f90 b/Source/Interfaces/EC_OUTPUT4_Interface.f90 index 67615d64..4207ec67 100644 --- a/Source/Interfaces/EC_OUTPUT4_Interface.f90 +++ b/Source/Interfaces/EC_OUTPUT4_Interface.f90 @@ -33,8 +33,7 @@ SUBROUTINE EC_OUTPUT4 ( CARD1, IERR, ANY_OU4_NAME_BAD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN - USE SUBR_BEGEND_LEVELS, ONLY : EC_OUTPUT4_BEGEND - USE IOUNT1, ONLY : ERR, F04, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1 USE DEBUG_PARAMETERS, ONLY : DEBUG USE OUTPUT4_MATRICES, ONLY : NUM_OU4_VALID_NAMES, TAPE_ACTION_MAX_VAL, TAPE_ACTION_MIN_VAL, NUM_OU4_REQUESTS, & OU4_FILE_UNITS, OU4_TAPE_ACTION, ACT_OU4_MYSTRAN_NAMES, ACT_OU4_OUTPUT_NAMES, & @@ -48,7 +47,7 @@ SUBROUTINE EC_OUTPUT4 ( CARD1, IERR, ANY_OU4_NAME_BAD ) CHARACTER(LEN=*), INTENT(OUT) :: ANY_OU4_NAME_BAD ! 'Y'/'N' if requested OUTPUT4 matrix name is valid INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator. If CHAR not found, IERR set to 1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EC_OUTPUT4_BEGEND + END SUBROUTINE EC_OUTPUT4 diff --git a/Source/Interfaces/EC_PARTN_Interface.f90 b/Source/Interfaces/EC_PARTN_Interface.f90 index ea73a527..3253a05b 100644 --- a/Source/Interfaces/EC_PARTN_Interface.f90 +++ b/Source/Interfaces/EC_PARTN_Interface.f90 @@ -33,8 +33,7 @@ SUBROUTINE EC_PARTN ( CARD1, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN - USE SUBR_BEGEND_LEVELS, ONLY : EC_PARTN_BEGEND - USE IOUNT1, ONLY : ERR, F04, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1 USE DEBUG_PARAMETERS, ONLY : DEBUG USE OUTPUT4_MATRICES, ONLY : NUM_OU4_REQUESTS, NUM_PARTN_REQUESTS, OU4_PART_VEC_NAMES, OU4_PART_MAT_NAMES, & ACT_OU4_MYSTRAN_NAMES, ACT_OU4_OUTPUT_NAMES, & @@ -47,7 +46,7 @@ SUBROUTINE EC_PARTN ( CARD1, IERR ) CHARACTER(LEN=*), INTENT(IN) :: CARD1 ! Card read in LOADE and shifted to begin in col 1 INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator. If CHAR not found, IERR set to 1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EC_PARTN_BEGEND + END SUBROUTINE EC_PARTN diff --git a/Source/Interfaces/EIG_GIV_MGIV_Interface.f90 b/Source/Interfaces/EIG_GIV_MGIV_Interface.f90 index 6967ef42..ef3eaf53 100644 --- a/Source/Interfaces/EIG_GIV_MGIV_Interface.f90 +++ b/Source/Interfaces/EIG_GIV_MGIV_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE EIG_GIV_MGIV USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KLL_SDIA, KLLD_SDIA, MLL_SDIA, NDOFL, NTERM_KLL, NTERM_KLLD, & NTERM_MLL, NUM_EIGENS, NUM_KLLD_DIAG_ZEROS, NUM_MLL_DIAG_ZEROS, NVEC, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : BAILOUT, EPSIL, SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : EIG_GIV_MGIV_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, PI USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, EIGEN_VEC, MODE_NUM USE MODEL_STUF, ONLY : EIG_FRQ1, EIG_FRQ2, EIG_METH, EIG_N1, EIG_N2, EIG_VECS @@ -51,7 +50,7 @@ SUBROUTINE EIG_GIV_MGIV CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG) :: IWORK(8*NDOFL) ! Integer workspace used by LAPACK. INTEGER(LONG) :: NUM1 ! Number to use for max no. of eigens to find. Must be NUM1 <= NDOFL - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_GIV_MGIV_BEGEND + REAL(DOUBLE) :: Q(NDOFL,NDOFL) ! Matrix used in LAPACK reduction of eigen problem to standard form. diff --git a/Source/Interfaces/EIG_INV_PWR_Interface.f90 b/Source/Interfaces/EIG_INV_PWR_Interface.f90 index 72a8fe40..9eb59e8e 100644 --- a/Source/Interfaces/EIG_INV_PWR_Interface.f90 +++ b/Source/Interfaces/EIG_INV_PWR_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE EIG_INV_PWR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KMSM_SDIA, LINKNO, NDOFL, NTERM_KLL, NTERM_KLLD, NTERM_KMSM, & NTERM_KMSMs, NTERM_MLL, NUM_EIGENS, NVEC, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : BAILOUT, EPSIL, KLLRAT, MXITERI, SOLLIB, SPARSE_FLAVOR, SPARSTOR, SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : EIG_INV_PWR_BEGEND USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, EIGEN_VEC, MODE_NUM USE MODEL_STUF, ONLY : EIG_N2, EIG_SIGMA USE SPARSE_MATRICES, ONLY : I_KLL, J_KLL, KLL, I_KLLD, J_KLLD, KLLD, I_MLL, J_MLL, MLL, & @@ -51,7 +50,7 @@ SUBROUTINE EIG_INV_PWR CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_INV_PWR_BEGEND + END SUBROUTINE EIG_INV_PWR diff --git a/Source/Interfaces/EIG_LANCZOS_ARPACK_ADAPTIVE_Interface.f90 b/Source/Interfaces/EIG_LANCZOS_ARPACK_ADAPTIVE_Interface.f90 index 699375bd..48500a35 100644 --- a/Source/Interfaces/EIG_LANCZOS_ARPACK_ADAPTIVE_Interface.f90 +++ b/Source/Interfaces/EIG_LANCZOS_ARPACK_ADAPTIVE_Interface.f90 @@ -32,7 +32,7 @@ MODULE EIG_LANCZOS_ARPACK_ADAPTIVE_Interface SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KMSM_SDIA, LINKNO, NDOFL, NTERM_KLL, NTERM_KMSM, & NTERM_KMSMn, NTERM_MLL, NUM_EIGENS, NUM_MLL_DIAG_ZEROS, NVEC, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC @@ -40,7 +40,6 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : ARP_TOL, BAILOUT, EPSIL, MXITERL, SOLLIB, SPARSTOR, SUPINFO, SUPWARN USE DOF_TABLES, ONLY : TDOFI - USE SUBR_BEGEND_LEVELS, ONLY : EIG_LANCZOS_ARPACK_BEGEND USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, EIGEN_VEC, MODE_NUM USE MODEL_STUF, ONLY : EIG_FRQ1, EIG_FRQ2, EIG_LAP_MAT_TYPE, EIG_N2, EIG_NCVFACL USE ARPACK_MATRICES_1, ONLY : IWORK, RESID, RFAC, SELECT, VBAS, WORKD, WORKL @@ -52,7 +51,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_LANCZOS_ARPACK_BEGEND + END SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE diff --git a/Source/Interfaces/EIG_LANCZOS_ARPACK_Interface.f90 b/Source/Interfaces/EIG_LANCZOS_ARPACK_Interface.f90 index 5d09f04d..d5714c8c 100644 --- a/Source/Interfaces/EIG_LANCZOS_ARPACK_Interface.f90 +++ b/Source/Interfaces/EIG_LANCZOS_ARPACK_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KMSM_SDIA, LINKNO, NDOFL, NTERM_KLL, NTERM_KLLD, NTERM_KMSM, & NTERM_KMSMn, NTERM_KMSMs, NTERM_MLL, NTERM_ULL, NUM_EIGENS, NUM_KLLD_DIAG_ZEROS, & NUM_MLL_DIAG_ZEROS, NVEC, SOL_NAME, WARN_ERR @@ -42,7 +42,6 @@ SUBROUTINE EIG_LANCZOS_ARPACK USE PARAMS, ONLY : ARP_TOL, BAILOUT, DARPACK, EIGESTL, EPSIL, MXITERL, SOLLIB, SPARSTOR, SUPINFO, & SUPWARN USE DOF_TABLES, ONLY : TDOFI - USE SUBR_BEGEND_LEVELS, ONLY : EIG_LANCZOS_ARPACK_BEGEND USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, EIGEN_VEC, MODE_NUM USE MODEL_STUF, ONLY : EIG_FRQ1, EIG_FRQ2, EIG_LANCZOS_NEV_DELT, EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, & EIG_NCVFACL, EIG_SIGMA @@ -57,7 +56,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG) :: LWORKL ! Used to dimension a work array INTEGER(LONG) :: NUM1 ! Number to use for max no. of eigens to find. Must be NUM1 <= NDOFL - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_LANCZOS_ARPACK_BEGEND + END SUBROUTINE EIG_LANCZOS_ARPACK diff --git a/Source/Interfaces/EIG_SUMMARY_Interface.f90 b/Source/Interfaces/EIG_SUMMARY_Interface.f90 index 2f67c1f3..046fe2ed 100644 --- a/Source/Interfaces/EIG_SUMMARY_Interface.f90 +++ b/Source/Interfaces/EIG_SUMMARY_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE EIG_SUMMARY USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ANS, ANSFIL, ANS_MSG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFL, NUM_EIGENS, NVEC, NUM_KLLD_DIAG_ZEROS, NUM_MLL_DIAG_ZEROS, SOL_NAME, & WARN_ERR USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : ART_MASS, ART_ROT_MASS, ART_TRAN_MASS, DARPACK, SOLLIB, SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : EIG_SUMMARY_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO, PI USE EIGEN_MATRICES_1, ONLY : GEN_MASS, MODE_NUM, EIGEN_VAL USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_GRID, EIG_LAP_MAT_TYPE, EIG_METH, EIG_MODE, EIG_N2, EIG_NORM, & @@ -48,7 +47,7 @@ SUBROUTINE EIG_SUMMARY CHARACTER( 1*BYTE) :: ASTERISK = '*' ! Used for denoting negative eigenvalues - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_SUMMARY_BEGEND + END SUBROUTINE EIG_SUMMARY diff --git a/Source/Interfaces/ELAS1_Interface.f90 b/Source/Interfaces/ELAS1_Interface.f90 index 6ebd6228..7c38df5a 100644 --- a/Source/Interfaces/ELAS1_Interface.f90 +++ b/Source/Interfaces/ELAS1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELAS1 ( OPT, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELAS1_BEGEND USE MODEL_STUF, ONLY : AGRID, ELAS_COMP, EID, EPROP, FCONV, KE, SE1, TYPE IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE ELAS1 ( OPT, WRITE_WARN ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELAS1_BEGEND + END SUBROUTINE ELAS1 diff --git a/Source/Interfaces/ELEM_PROP_MATL_IIDS_Interface.f90 b/Source/Interfaces/ELEM_PROP_MATL_IIDS_Interface.f90 index c67f343d..53a697e3 100644 --- a/Source/Interfaces/ELEM_PROP_MATL_IIDS_Interface.f90 +++ b/Source/Interfaces/ELEM_PROP_MATL_IIDS_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE ELEM_PROP_MATL_IIDS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN4FIL_NUM, NUM_IN4_FILES, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN4FIL_NUM, NUM_IN4_FILES USE SCONTR, ONLY : BLNK_SUB_NAM, DEDAT_Q4_SHELL_KEY, DEDAT_T3_SHELL_KEY, DEDAT_Q8_SHELL_KEY, FATAL_ERR, & MPCOMP0, MPCOMP_PLIES, NCMASS, NELE, NMATL, NPBAR, NPBEAM, & NPBUSH, NPCOMP, NPELAS, NPMASS, NPROD, npshear, NPSHEL, NPSOLID, NPUSER1, NPUSERIN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELEM_PROP_MATL_IIDS_BEGEND USE MODEL_STUF, ONLY : CMASS, ETYPE, EPNT, EDAT, PELAS, PROD, PBAR, PBEAM, PBUSH, PCOMP, PMASS, PSHEAR, & PSHEL, PSOLID, PUSER1, PUSERIN, MATL @@ -48,7 +47,7 @@ SUBROUTINE ELEM_PROP_MATL_IIDS CHARACTER( 1*BYTE) :: FOUND_PSHEL ! Used to indicate if a PSHELL prop ID was found CHARACTER( 8*BYTE) :: NAME = 'MATERIAL' ! Used for output error message - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELEM_PROP_MATL_IIDS_BEGEND + END SUBROUTINE ELEM_PROP_MATL_IIDS diff --git a/Source/Interfaces/ELEM_STRE_STRN_ARRAYS_Interface.f90 b/Source/Interfaces/ELEM_STRE_STRN_ARRAYS_Interface.f90 index 2b24d0e8..8cc617b1 100644 --- a/Source/Interfaces/ELEM_STRE_STRN_ARRAYS_Interface.f90 +++ b/Source/Interfaces/ELEM_STRE_STRN_ARRAYS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELEM_STRE_STRN_ARRAYS ( STR_PT_NUM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, INT_SC_NUM, JTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELEM_STRE_STRN_ARRAYS_BEGEND USE CONSTANTS_1, ONLY : ZERO, one, four USE MODEL_STUF, ONLY : ALPVEC, BE1, BE2, BE3, DT, EM, EB, ES, ET, ELDOF, PEL, PHI_SQ, STRAIN, STRESS, SUBLOD, & TREF, TYPE, UEL, SE1, SE2, SE3, STE1, STE2, STE3 @@ -45,7 +44,7 @@ SUBROUTINE ELEM_STRE_STRN_ARRAYS ( STR_PT_NUM ) IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: STR_PT_NUM ! Which point (3rd index in SEi matrices) this call is for - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELEM_STRE_STRN_ARRAYS_BEGEND + REAL(DOUBLE) :: DUM31(3) ! Array used in an intermediate calc REAL(DOUBLE) :: DUM32(3) ! Array used in an intermediate calc diff --git a/Source/Interfaces/ELEM_TRANSFORM_LBG_Interface.f90 b/Source/Interfaces/ELEM_TRANSFORM_LBG_Interface.f90 index 4325945a..b397b000 100644 --- a/Source/Interfaces/ELEM_TRANSFORM_LBG_Interface.f90 +++ b/Source/Interfaces/ELEM_TRANSFORM_LBG_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELEM_TRANSFORM_LBG ( WHICH, ZE, QE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MELDOF, NCORD, NGRID, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELEM_TRANSFORM_LBG_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : ELDOF, GRID, GRID_ID, CORD, AGRID, TE_IDENT, TYPE USE MODEL_STUF, ONLY : ELGP @@ -47,7 +46,7 @@ SUBROUTINE ELEM_TRANSFORM_LBG ( WHICH, ZE, QE ) INTEGER(LONG), PARAMETER :: NCOLA = 3 ! An input to subr MATMULT_FFF/MATMULT_FFF_T, called herein INTEGER(LONG), PARAMETER :: NROW_GET = 3 ! An input to subr MATGET/MATPUT (no. rows to get/put) INTEGER(LONG), PARAMETER :: NROWA = 3 ! An input to subr MATMULT_FFF/MATMULT_FFF_T, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELEM_TRANSFORM_LBG_BEGEND + REAL(DOUBLE) , INTENT(INOUT) :: QE(MELDOF,NSUB) ! PTE or PPE if WHICH = 'PTE' or 'PPE' REAL(DOUBLE) , INTENT(INOUT) :: ZE(MELDOF,MELDOF) ! Either the mass or stiff matrix of the element diff --git a/Source/Interfaces/ELEPRO_Interface.f90 b/Source/Interfaces/ELEPRO_Interface.f90 index 7d07b438..b09c8401 100644 --- a/Source/Interfaces/ELEPRO_Interface.f90 +++ b/Source/Interfaces/ELEPRO_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE ELEPRO ( INCR_NELE, JCARD, NFIELD, NMORE, CHK_FLD2, CHK_FLD3, CHK_FLD4, CHK_FLD5, CHK_FLD6, CHK_FLD7, CHK_FLD8, CHK_FLD9 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR, JF, LEDAT, LELE, NEDAT, NELE, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELEPRO_BEGEND USE MODEL_STUF, ONLY : EDAT, EPNT IMPLICIT NONE @@ -54,7 +53,7 @@ SUBROUTINE ELEPRO ( INCR_NELE, JCARD, NFIELD, NMORE, INTEGER(LONG), INTENT(IN) :: NFIELD ! Number of card fields to read from JCARD (start w/ field 2) INTEGER(LONG), INTENT(IN) :: NMORE ! Number of terms that have to be written to EDAT for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELEPRO_BEGEND + END SUBROUTINE ELEPRO diff --git a/Source/Interfaces/ELESORT_Interface.f90 b/Source/Interfaces/ELESORT_Interface.f90 index 7585d8e5..cf6322f2 100644 --- a/Source/Interfaces/ELESORT_Interface.f90 +++ b/Source/Interfaces/ELESORT_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE ELESORT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, ELESORT_RUN, NELE, NRIGEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELESORT_BEGEND USE MODEL_STUF, ONLY : EDAT, EOFF, EPNT, ESORT1, ESORT2, ETYPE, RIGID_ELEM_IDS USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELESORT_BEGEND + END SUBROUTINE ELESORT diff --git a/Source/Interfaces/ELMDAT1_Interface.f90 b/Source/Interfaces/ELMDAT1_Interface.f90 index fbc6d951..56bbd05a 100644 --- a/Source/Interfaces/ELMDAT1_Interface.f90 +++ b/Source/Interfaces/ELMDAT1_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, MEDAT0_CUSERIN, MELGP, MEMATC, MEMATR, MEPROP, METYPE, MOFFSET, MRMATLC, & MRPBAR, MRPBEAM, MRPBUSH, MRPELAS, MRPROD, MRPSHEAR, MRPUSER1, MPSOLID, BLNK_SUB_NAM, & NCORD, NGRID @@ -41,7 +41,6 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) DEDAT_Q8_THICK_KEY, DEDAT_Q8_POFFS_KEY USE PARAMS, ONLY : EPSIL, TSTM_DEF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMDAT_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONEPM4, ONE, TWO USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : AGRID, BAROFF, BUSH_CID, BUSH_OCID, BUSH_VVEC, BUSH_VVEC_OR_CID, BUSHOFF, BGRID, & @@ -88,7 +87,7 @@ SUBROUTINE ELMDAT1 ( INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG) :: NFLAG ! Row number in array DOFPIN INTEGER(LONG) :: NUM_COMPS ! No. displ components (1 for SPOINT, 6 for actual grid) INTEGER(LONG) :: NUMMAT ! No. matl properties for an element type - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMDAT_BEGEND + REAL(DOUBLE) :: DXI ! An offset distance in direction 1 REAL(DOUBLE) :: DYI ! An offset distance in direction 2 diff --git a/Source/Interfaces/ELMDAT2_Interface.f90 b/Source/Interfaces/ELMDAT2_Interface.f90 index 91162e1d..0c2f4117 100644 --- a/Source/Interfaces/ELMDAT2_Interface.f90 +++ b/Source/Interfaces/ELMDAT2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELMDAT2 ( INT_ELEM_ID, OPT, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, LPDAT, MPRESS, MDT, MTDAT_TEMPRB, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMDAT_BEGEND USE CONSTANTS_1, ONLY : ZERO, QUARTER, THIRD USE MODEL_STUF, ONLY : BGRID, DT, ELGP, ETYPE, GTEMP, PDATA, PPNT, PTYPE, PRESS, TDATA, TPNT, TYPE @@ -45,7 +44,7 @@ SUBROUTINE ELMDAT2 ( INT_ELEM_ID, OPT, WRITE_WARN ) CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID for which - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMDAT_BEGEND + END SUBROUTINE ELMDAT2 diff --git a/Source/Interfaces/ELMDIS_Interface.f90 b/Source/Interfaces/ELMDIS_Interface.f90 index 2a9977f0..c5d7fd74 100644 --- a/Source/Interfaces/ELMDIS_Interface.f90 +++ b/Source/Interfaces/ELMDIS_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE ELMDIS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, meldof, MELGP, NCORD, NGRID USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START - USE SUBR_BEGEND_LEVELS, ONLY : ELMDIS_BEGEND USE MODEL_STUF, ONLY : AGRID, CAN_ELEM_TYPE_OFFSET, GRID, CORD, BGRID, ELGP, ELDOF, GRID_ID, OFFSET, OFFDIS, & TE, TYPE, UEB, UEG, UEL, UGG USE COL_VECS, ONLY : UG_COL @@ -51,7 +50,7 @@ SUBROUTINE ELMDIS INTEGER(LONG), PARAMETER :: NROW = 3 ! An input to subr MATPUT, MATGET called herein INTEGER(LONG), PARAMETER :: NCOL = 1 ! An input to subr MATPUT, MATGET called herein INTEGER(LONG), PARAMETER :: PCOL = 1 ! An input to subr MATPUT, MATGET called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMDIS_BEGEND + REAL(DOUBLE) :: THETAD,PHID ! Returns from subr GEN_T0L (not used here) diff --git a/Source/Interfaces/ELMDIS_PLY_Interface.f90 b/Source/Interfaces/ELMDIS_PLY_Interface.f90 index afd24080..275af529 100644 --- a/Source/Interfaces/ELMDIS_PLY_Interface.f90 +++ b/Source/Interfaces/ELMDIS_PLY_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE ELMDIS_PLY USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM USE CONSTANTS_1, ONLY : CONV_DEG_RAD USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : ELGP, ELDOF, UEL, ZPLY - USE SUBR_BEGEND_LEVELS, ONLY : ELMDIS_PLY_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMDIS_PLY_BEGEND + END SUBROUTINE ELMDIS_PLY diff --git a/Source/Interfaces/ELMGM1_Interface.f90 b/Source/Interfaces/ELMGM1_Interface.f90 index ae7e1343..c73238aa 100644 --- a/Source/Interfaces/ELMGM1_Interface.f90 +++ b/Source/Interfaces/ELMGM1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELMGM1 ( INT_ELEM_ID, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MELGP, MOFFSET, NCORD, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMGM1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL @@ -50,7 +49,7 @@ SUBROUTINE ELMGM1 ( INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID for which INTEGER(LONG) :: I3_IN(3) ! Integer array used in sorting VX. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMGM1_BEGEND + REAL(DOUBLE) :: V13(3) ! A vector from grid 1 to grid 3 (for BAR, BEAM or USER1 it is V vector) diff --git a/Source/Interfaces/ELMGM2_Interface.f90 b/Source/Interfaces/ELMGM2_Interface.f90 index 97970802..92387c6b 100644 --- a/Source/Interfaces/ELMGM2_Interface.f90 +++ b/Source/Interfaces/ELMGM2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELMGM2 ( WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, MEFE, MEWE, MELGP, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMGM2_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, TWO USE PARAMS, ONLY : EPSIL, QUADAXIS, SUPWARN USE MODEL_STUF, ONLY : AGRID, BMEANT, EID, ELGP, EMG_IFE, EMG_IWE, EMG_RWE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS, & @@ -50,7 +49,7 @@ SUBROUTINE ELMGM2 ( WRITE_WARN ) INTEGER(LONG) :: DIAG_GRID2 ! Used for error output purposes INTEGER(LONG) :: SIDE_GRID1 ! Used for error output purposes INTEGER(LONG) :: SIDE_GRID2 ! Used for error output purposes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMGM2_BEGEND + END SUBROUTINE ELMGM2 diff --git a/Source/Interfaces/ELMGM3_Interface.f90 b/Source/Interfaces/ELMGM3_Interface.f90 index f1754db0..cc544ba8 100644 --- a/Source/Interfaces/ELMGM3_Interface.f90 +++ b/Source/Interfaces/ELMGM3_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELMGM3 ( WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE, MELGP USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMGM3_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, TWO USE PARAMS, ONLY : EPSIL, HEXAXIS USE MODEL_STUF, ONLY : EID, ELGP, EMG_IFE, ERR_SUB_NAM, HEXA_DELTA, HEXA_GAMMA, HEXA_THETA, & @@ -48,7 +47,7 @@ SUBROUTINE ELMGM3 ( WRITE_WARN ) INTEGER(LONG) :: SIDE_GRID1 ! Used for error output purposes INTEGER(LONG) :: SIDE_GRID2 ! Used for error output purposes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMGM3_BEGEND + REAL(DOUBLE) :: HEXA_HBAR ! Warp of HEXA element (only used in calc initial x direction along END SUBROUTINE ELMGM3 diff --git a/Source/Interfaces/ELMOFF_Interface.f90 b/Source/Interfaces/ELMOFF_Interface.f90 index 064d7606..2dc77f2b 100644 --- a/Source/Interfaces/ELMOFF_Interface.f90 +++ b/Source/Interfaces/ELMOFF_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELMOFF ( OPT, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_STRESS_POINTS, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMOFF_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : CAN_ELEM_TYPE_OFFSET, ELDOF, ELGP, EID, KE, ME, NUM_EMG_FATAL_ERRS, & OFFDIS, OFFSET, PPE, PTE, SE1, SE2, SE3, TYPE @@ -45,7 +44,7 @@ SUBROUTINE ELMOFF ( OPT, WRITE_WARN ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMOFF_BEGEND + END SUBROUTINE ELMOFF diff --git a/Source/Interfaces/ELMOUT_Interface.f90 b/Source/Interfaces/ELMOUT_Interface.f90 index 0cb272fa..de8f061f 100644 --- a/Source/Interfaces/ELMOUT_Interface.f90 +++ b/Source/Interfaces/ELMOUT_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, BUG, F04 + USE IOUNT1, ONLY : WRT_ERR, BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_DAT1_BIT, ELDT_BUG_DAT2_BIT, ELDT_BUG_ME_BIT, ELDT_BUG_P_T_BIT, & ELDT_BUG_SE_BIT, ELDT_BUG_KE_BIT, ELDT_BUG_U_P_BIT, MBUG, MDT, MELGP, METYPE, & MEMATR, MEMATC, MEPROP, MPRESS, NSUB, NTSUB, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMOUT_BEGEND USE CONSTANTS_1, ONLY : CONV_RAD_DEG, ZERO USE PARAMS, ONLY : CBMIN3, CBMIN4, ELFORCEN, QUADAXIS, QUAD4TYP USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -58,7 +57,7 @@ SUBROUTINE ELMOUT ( INT_ELEM_ID, DUM_BUG, CASE_NUM, OPT ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID for which INTEGER(LONG), INTENT(IN) :: CASE_NUM ! Can be subcase number (e.g. for UEL, PEL output) INTEGER(LONG), INTENT(IN) :: DUM_BUG(0:MBUG-1) ! Indicator for output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMOUT_BEGEND + END SUBROUTINE ELMOUT diff --git a/Source/Interfaces/ELMTLB_Interface.f90 b/Source/Interfaces/ELMTLB_Interface.f90 index 81d8bd53..f67bef1d 100644 --- a/Source/Interfaces/ELMTLB_Interface.f90 +++ b/Source/Interfaces/ELMTLB_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ELMTLB ( OPT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, f06, WRT_LOG + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, MELDOF, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELMTLB_BEGEND USE MODEL_STUF, ONLY : ELDOF, ELGP, KE, KED, ME, PTE, PPE, TE IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE ELMTLB ( OPT ) INTEGER(LONG), PARAMETER :: NCOLA = 3 ! No. cols in a matrix for subr MATMULT_FFF/MATMULT_FFF_T, called herein INTEGER(LONG), PARAMETER :: NROW = 3 ! No. rows to get/put for subrs MATGET/MATPUT, called herein INTEGER(LONG), PARAMETER :: NROWA = 3 ! No. rows in a matrix for subr MATMULT_FFF/MATMULT_FFF_T, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMTLB_BEGEND + END SUBROUTINE ELMTLB diff --git a/Source/Interfaces/ELSAVE_Interface.f90 b/Source/Interfaces/ELSAVE_Interface.f90 index 86a40abd..dcb1cd97 100644 --- a/Source/Interfaces/ELSAVE_Interface.f90 +++ b/Source/Interfaces/ELSAVE_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE ELSAVE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1G + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1G USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, MMATL, MPBAR, MPBEAM, MPBUSH, MPELAS, MPROD, MPSHEL, & MPSOLID, MPUSER1,MPUSERIN, MRMATLC, MRPBAR, MRPBEAM, MRPBUSH, MRPELAS, MRPROD, MPSHEAR, & MRPSHEAR, MRPSHEL, MRPUSER1, NBAROFF, NBUSHOFF, NEDAT, NELE, NMATANGLE, NMATL, MPCOMP0, & @@ -40,14 +40,13 @@ SUBROUTINE ELSAVE NPELAS, NPLATEOFF, NPLATETHICK, NPROD, NPSHEAR, NPSHEL, NPSOLID, NPUSER1, NPUSERIN, NVVEC USE PARAMS, ONLY : CBMIN3, CBMIN4, IORQ1M, IORQ1S, IORQ1B, IORQ2B, IORQ2T USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELSAVE_BEGEND USE MODEL_STUF, ONLY : BAROFF, BUSHOFF, EDAT, EOFF, EPNT, ESORT1, ESORT2, ETYPE, MATANGLE, MATL, RMATL,PBAR, & RPBAR, PBEAM, RPBEAM, PBUSH, RPBUSH, PCOMP, RPCOMP, PELAS, RPELAS, PROD, RPROD, PSHEAR, & RPSHEAR, PSHEL, RPSHEL, PSOLID, PUSER1, RPUSER1, PUSERIN, PLATEOFF, PLATETHICK, & USERIN_MAT_NAMES, VVEC IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELSAVE_BEGEND + END SUBROUTINE ELSAVE diff --git a/Source/Interfaces/EMG_Interface.f90 b/Source/Interfaces/EMG_Interface.f90 index 32d1405a..9aa1a217 100644 --- a/Source/Interfaces/EMG_Interface.f90 +++ b/Source/Interfaces/EMG_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MBUG, MEDAT0_CUSERIN, MELDOF, MEMATC, MOFFSET, NSUB, NTSUB USE SCONTR, ONLY : DEDAT_Q4_MATANG_KEY, DEDAT_Q4_POFFS_KEY, DEDAT_Q4_SHELL_KEY, DEDAT_Q4_THICK_KEY, & DEDAT_T3_MATANG_KEY, DEDAT_T3_POFFS_KEY, DEDAT_T3_SHELL_KEY, DEDAT_T3_THICK_KEY, & @@ -40,7 +40,6 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : EMG_BEGEND USE CONSTANTS_1, ONLY : CONV_DEG_RAD, CONV_RAD_DEG, ZERO USE MODEL_STUF, ONLY : CAN_ELEM_TYPE_OFFSET, EDAT, EID, EPNT, ETYPE, ISOLID, MATANGLE, NUM_EMG_FATAL_ERRS, & PCOMP_PROPS, PLY_NUM, TE_IDENT, THETAM, TYPE, XEL @@ -55,7 +54,7 @@ SUBROUTINE EMG ( INT_ELEM_ID, OPT, WRITE_WARN, CALLING_SUBR, WRT_BUG_THIS_TIME ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID for which INTEGER(LONG) :: INT41,INT42 ! An integer used in getting MATANGLE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EMG_BEGEND + END SUBROUTINE EMG diff --git a/Source/Interfaces/EMP0_Interface.f90 b/Source/Interfaces/EMP0_Interface.f90 index 6dc3fdde..1b26c3d2 100644 --- a/Source/Interfaces/EMP0_Interface.f90 +++ b/Source/Interfaces/EMP0_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE EMP0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : LTERM_MGGE, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : GRIDSEQ, SETLKTM, USR_LTERM_MGG - USE SUBR_BEGEND_LEVELS, ONLY : EMP0_BEGEND IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EMP0_BEGEND + END SUBROUTINE EMP0 diff --git a/Source/Interfaces/EMP_Interface.f90 b/Source/Interfaces/EMP_Interface.f90 index 84e43717..ceabebfb 100644 --- a/Source/Interfaces/EMP_Interface.f90 +++ b/Source/Interfaces/EMP_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE EMP USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, F22, F22FIL, F22_MSG, SC1, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, F22, F22FIL, F22_MSG, SC1, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_ME_BIT, ELDT_F22_ME_BIT, FATAL_ERR, IBIT, LINKNO, LTERM_MGGE, & MBUG, MELDOF, NDOFG, NELE, NGRID, NTERM_MGGE, NSUB USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SPARSTOR - USE SUBR_BEGEND_LEVELS, ONLY : EMP_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : AGRID, ELDT, ELDOF, ELGP, GRID_ID, NUM_EMG_FATAL_ERRS, ME, OELDT, PLY_NUM, TYPE USE EMS_ARRAYS, ONLY : EMS, EMSCOL, EMSKEY, EMSPNT @@ -51,7 +50,7 @@ SUBROUTINE EMP INTEGER(LONG) :: IDUM ! Dummy variable used when flipping DOF's INTEGER(LONG) :: KSTART ! Used in deciding whether to process all elem mass terms or only INTEGER(LONG) :: MAX_NUM ! MAX of NTERM_MGGE/NDOFG (used for DEBUG printout) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EMP_BEGEND + END SUBROUTINE EMP diff --git a/Source/Interfaces/EPSCALC_Interface.f90 b/Source/Interfaces/EPSCALC_Interface.f90 index edb399c0..14e4669a 100644 --- a/Source/Interfaces/EPSCALC_Interface.f90 +++ b/Source/Interfaces/EPSCALC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE EPSCALC ( ISUB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFL, NTERM_KLl, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : EPSCALC_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : EPSIL, SUPINFO, SUPWARN USE MACHINE_PARAMS, ONLY : MACH_SFMIN @@ -48,7 +47,7 @@ SUBROUTINE EPSCALC ( ISUB ) IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: ISUB ! Internal subcase no. (1 to NSUB) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EPSCALC_BEGEND + REAL(DOUBLE) , PARAMETER :: ALPHA = ONE ! Scalar multiplier for KLL in calc'ing residual vector, RES REAL(DOUBLE) , PARAMETER :: BETA = -ONE ! Scalar multiplier for PL in calc'ing residual vector, RES diff --git a/Source/Interfaces/EPTL_Interface.f90 b/Source/Interfaces/EPTL_Interface.f90 index c86ee4cd..0595092c 100644 --- a/Source/Interfaces/EPTL_Interface.f90 +++ b/Source/Interfaces/EPTL_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE EPTL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, F21, F21FIL, F21_MSG, SC1, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, F21, F21FIL, F21_MSG, SC1, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_P_T_BIT, ELDT_F21_P_T_BIT, IBIT, LINKNO, MBUG, MELDOF, NCORD, & NELE, NGRID, NSUB, NTSUB USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START - USE SUBR_BEGEND_LEVELS, ONLY : EPTL_BEGEND USE MODEL_STUF, ONLY : ELDOF, ELDT, GRID, GRID_ID, CORD, AGRID, ELGP, NUM_EMG_FATAL_ERRS, OELDT, PLY_NUM, PPE, & PTE, SYS_LOAD, TYPE, SUBLOD @@ -48,7 +47,7 @@ SUBROUTINE EPTL CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG) :: I1 ! Intermediate variable used in setting WRT_BUG(3) and OUT10 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EPTL_BEGEND + END SUBROUTINE EPTL diff --git a/Source/Interfaces/ESP0_FINAL_Interface.f90 b/Source/Interfaces/ESP0_FINAL_Interface.f90 index 8fc64d8b..25e802ea 100644 --- a/Source/Interfaces/ESP0_FINAL_Interface.f90 +++ b/Source/Interfaces/ESP0_FINAL_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE ESP0_FINAL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IBIT, LTERM_KGG, MELDOF, NELE, NGRID, NTERM_KGG, NSUB USE PARAMS, ONLY : EPSIL, SPARSTOR, SUPINFO USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : ESP0_FINAL_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : AGRID, ELDT, ELDOF, ELGP, GRID_ID, NUM_EMG_FATAL_ERRS, PLY_NUM, KE, TYPE USE STF_ARRAYS, ONLY : STFKEY, STF3 @@ -49,7 +48,7 @@ SUBROUTINE ESP0_FINAL INTEGER(LONG) :: IDUM ! Dummy variable used when flipping DOF's INTEGER(LONG) :: KSTART ! Used in deciding whether to process all elem stiffness terms or only - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP0_FINAL_BEGEND + END SUBROUTINE ESP0_FINAL diff --git a/Source/Interfaces/ESP0_Interface.f90 b/Source/Interfaces/ESP0_Interface.f90 index 48b49ed9..6b3f2e26 100644 --- a/Source/Interfaces/ESP0_Interface.f90 +++ b/Source/Interfaces/ESP0_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE ESP0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, KMAT_BW, KMAT_DEN, LTERM_KGG, LTERM_KGGD, SOL_NAME USE PARAMS, ONLY : GRIDSEQ, SETLKTK, SUPINFO, USR_LTERM_KGG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : ESP0_BEGEND IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP0_BEGEND + END SUBROUTINE ESP0 diff --git a/Source/Interfaces/ESP_Interface.f90 b/Source/Interfaces/ESP_Interface.f90 index 7e3f4fd5..247b7761 100644 --- a/Source/Interfaces/ESP_Interface.f90 +++ b/Source/Interfaces/ESP_Interface.f90 @@ -32,8 +32,8 @@ SUBROUTINE ESP USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, F23, F23FIL, F23_MSG, F24, F24FIL, F24_MSG, FILE_NAM_MAXLEN, SC1, SCR, & - WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, F23, F23FIL, F23_MSG, F24, F24FIL, F24_MSG, FILE_NAM_MAXLEN, SC1, SCR, & + WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_KE_BIT, ELDT_BUG_SE_BIT, & ELDT_F23_KE_BIT, ELDT_F24_SE_BIT, ELDT_BUG_BCHK_BIT, ELDT_BUG_BMAT_BIT, ELDT_BUG_SHPJ_BIT,& FATAL_ERR, IBIT, LINKNO, LTERM_KGG, LTERM_KGGD, MBUG, MELDOF, NDOFG, NELE, NGRID, & @@ -41,7 +41,6 @@ SUBROUTINE ESP USE PARAMS, ONLY : EPSIL, SPARSTOR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : ESP_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : AGRID, ELDT, ELDOF, ELGP, GRID_ID, NUM_EMG_FATAL_ERRS, PLY_NUM, OELDT, KE, KED, TYPE @@ -57,7 +56,7 @@ SUBROUTINE ESP INTEGER(LONG) :: IDUM ! Dummy variable used when flipping DOF's INTEGER(LONG) :: KSTART ! Used in deciding whether to process all elem stiffness terms or only INTEGER(LONG) :: MAX_NUM ! MAX of NTERM_KGG/NDOFG (used for DEBUG printout) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP_BEGEND + END SUBROUTINE ESP diff --git a/Source/Interfaces/EXPAND_PHIXA_TO_PHIXG_Interface.f90 b/Source/Interfaces/EXPAND_PHIXA_TO_PHIXG_Interface.f90 index 62579c6e..2d2dbe07 100644 --- a/Source/Interfaces/EXPAND_PHIXA_TO_PHIXG_Interface.f90 +++ b/Source/Interfaces/EXPAND_PHIXA_TO_PHIXG_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE EXPAND_PHIXA_TO_PHIXG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ONE - USE IOUNT1, ONLY : ERR, F04, F06, L5B, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L5B, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, LINKNO, NDOFA, NDOFF, NDOFG, NDOFM, NDOFN, NDOFO, NDOFR, NDOFS, NTERM_PHIXA,& NTERM_PHIXG, NVEC, SOL_NAME USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC @@ -41,10 +41,9 @@ SUBROUTINE EXPAND_PHIXA_TO_PHIXG USE PARAMS, ONLY : EPSIL, TINY USE DEBUG_PARAMETERS, ONLY : DEBUG USE SPARSE_MATRICES, ONLY : I_PHIXA, J_PHIXA, PHIXA, I_PHIXG, J_PHIXG, PHIXG - USE SUBR_BEGEND_LEVELS, ONLY : EXPAND_PHIXA_TO_PHIXG_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EXPAND_PHIXA_TO_PHIXG_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/FBS_LAPACK_Interface.f90 b/Source/Interfaces/FBS_LAPACK_Interface.f90 index ad497560..2875694d 100644 --- a/Source/Interfaces/FBS_LAPACK_Interface.f90 +++ b/Source/Interfaces/FBS_LAPACK_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE FBS_LAPACK ( EQUED, NROWS, MATIN_SDIA, EQUIL_SCALE_FACS, INOUT_COL ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE CONSTANTS_1, ONLY : ZERO @@ -41,7 +41,6 @@ SUBROUTINE FBS_LAPACK ( EQUED, NROWS, MATIN_SDIA, EQUIL_SCALE_FACS, INOUT_COL ) USE DEBUG_PARAMETERS, ONLY : DEBUG, NDEBUG USE MACHINE_PARAMS, ONLY : MACH_EPS, MACH_SFMIN USE LAPACK_LIN_EQN_DPB - USE SUBR_BEGEND_LEVELS, ONLY : FBS_LAPACK_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE FBS_LAPACK ( EQUED, NROWS, MATIN_SDIA, EQUIL_SCALE_FACS, INOUT_COL ) INTEGER(LONG), INTENT(IN) :: MATIN_SDIA ! No. of superdiags in the MATIN upper triangle INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in sparse matrix MATIN INTEGER(LONG), PARAMETER :: NUM_COLS = 1 ! Number of vectors to solve in this call - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FBS_LAPACK_BEGEND + REAL(DOUBLE) , INTENT(IN) :: EQUIL_SCALE_FACS(NROWS) diff --git a/Source/Interfaces/FBS_SUPRLU_Interface.f90 b/Source/Interfaces/FBS_SUPRLU_Interface.f90 index 598b1d09..6071f74e 100644 --- a/Source/Interfaces/FBS_SUPRLU_Interface.f90 +++ b/Source/Interfaces/FBS_SUPRLU_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE FBS_SUPRLU ( CALLING_SUBR, MATIN_NAME, NROWS, NTERMS, I_MATIN, J_MATI USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : CRS_CCS USE SCRATCH_MATRICES, ONLY : I_CCS1, J_CCS1, CCS1 - USE SUBR_BEGEND_LEVELS, ONLY : FBS_SUPRLU_BEGEND USE SuperLU_STUF, ONLY : SLU_FACTORS IMPLICIT NONE @@ -53,7 +52,7 @@ SUBROUTINE FBS_SUPRLU ( CALLING_SUBR, MATIN_NAME, NROWS, NTERMS, I_MATIN, J_MATI INTEGER(LONG), INTENT(INOUT) :: INFO ! Output from SuperLU routine - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FBS_SUPRLU_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERMS) ! A small number to compare real zero REAL(DOUBLE) , INTENT(IN) :: RHS_COL(NROWS) ! RHS column for which the FBS is solving diff --git a/Source/Interfaces/FFIELD2_Interface.f90 b/Source/Interfaces/FFIELD2_Interface.f90 index 20895428..bc8c0deb 100644 --- a/Source/Interfaces/FFIELD2_Interface.f90 +++ b/Source/Interfaces/FFIELD2_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE FFIELD2 ( CARD1, CARD2, CARD, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, BD_ENTRY_LEN, ECHO, FATAL_ERR, IMB_BLANK, JCARD_LEN USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : FFIELD2_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE FFIELD2 ( CARD1, CARD2, CARD, IERR ) CHARACTER(LEN=*), INTENT(OUT) :: CARD ! Card with 10 fields of 16 cols each with the data from CARD1, CARD2 INTEGER(LONG), INTENT(OUT) :: IERR ! = 1 if a field is longer than 8 chars on a free field card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FFIELD2_BEGEND + END SUBROUTINE FFIELD2 diff --git a/Source/Interfaces/FFIELD_Interface.f90 b/Source/Interfaces/FFIELD_Interface.f90 index 6f4188eb..4134c78a 100644 --- a/Source/Interfaces/FFIELD_Interface.f90 +++ b/Source/Interfaces/FFIELD_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE FFIELD ( CARD, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, BD_ENTRY_LEN, FATAL_ERR, IMB_BLANK, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FFIELD_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(INOUT):: CARD ! INTEGER(LONG), INTENT(OUT) :: IERR ! = 1 if a field is longer than 8 chars on a free field card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FFIELD_BEGEND + END SUBROUTINE FFIELD diff --git a/Source/Interfaces/FILERR_Interface.f90 b/Source/Interfaces/FILERR_Interface.f90 index d5d428f5..cad9b805 100644 --- a/Source/Interfaces/FILERR_Interface.f90 +++ b/Source/Interfaces/FILERR_Interface.f90 @@ -28,21 +28,16 @@ MODULE FILERR_Interface INTERFACE - SUBROUTINE FILERR ( OUNT, WRITE_F04 ) + SUBROUTINE FILERR ( OUNT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM - USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FILERR_BEGEND + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 IMPLICIT NONE - - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FILERR_BEGEND + END SUBROUTINE FILERR diff --git a/Source/Interfaces/FILE_CLOSE_Interface.f90 b/Source/Interfaces/FILE_CLOSE_Interface.f90 index 8eaf63d4..5a5229b6 100644 --- a/Source/Interfaces/FILE_CLOSE_Interface.f90 +++ b/Source/Interfaces/FILE_CLOSE_Interface.f90 @@ -28,24 +28,20 @@ MODULE FILE_CLOSE_Interface INTERFACE - SUBROUTINE FILE_CLOSE ( UNIT, FILNAM, CLOSE_STAT, WRITE_F04 ) + SUBROUTINE FILE_CLOSE ( UNIT, FILNAM, CLOSE_STAT ) - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, F04, SC1 - USE SCONTR, ONLY : BLNK_SUB_NAM - USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FILE_OPEN_BEGEND + USE PENTIUM_II_KIND, ONLY : BYTE, LONG + USE IOUNT1, ONLY : SC1 IMPLICIT NONE CHARACTER(LEN=*) , INTENT(IN) :: FILNAM ! File name CHARACTER(LEN=*) , INTENT(IN) :: CLOSE_STAT ! Status for close - CHARACTER(LEN=*) , INTENT(IN) :: WRITE_F04 ! If 'Y' write to F04, otherwise do not INTEGER(LONG), INTENT(IN) :: UNIT ! File unit number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FILE_OPEN_BEGEND + END SUBROUTINE FILE_CLOSE diff --git a/Source/Interfaces/FILE_INQUIRE_Interface.f90 b/Source/Interfaces/FILE_INQUIRE_Interface.f90 index eab8eeac..de25a8ed 100644 --- a/Source/Interfaces/FILE_INQUIRE_Interface.f90 +++ b/Source/Interfaces/FILE_INQUIRE_Interface.f90 @@ -32,9 +32,9 @@ SUBROUTINE FILE_INQUIRE ( MESSAGE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, MOT4, MOU4, OU4_EXT, OT4_EXT, WRT_LOG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, MOT4, MOU4, OU4_EXT, OT4_EXT - USE IOUNT1, ONLY : ANS, BUG, EIN, ENF, ERR, F04, F06, IN0, IN1, NEU, & + USE IOUNT1, ONLY : BUG, EIN, ENF, ERR, F06, IN0, IN1, NEU, & PCH, SEQ, SC1, SPC, & F21, F22, F23, F24, F25, & L1A, L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, & @@ -45,7 +45,7 @@ SUBROUTINE FILE_INQUIRE ( MESSAGE ) L3A, L4A, L4B, L4C, L4D, L5A, L5B, OP2, OT4, OU4, & MAX_FIL - USE IOUNT1, ONLY : ANSFIL, BUGFIL, EINFIL, ENFFIL, ERRFIL, F04FIL, F06FIL, IN0FIL, INFILE, NEUFIL, & + USE IOUNT1, ONLY : BUGFIL, EINFIL, ENFFIL, ERRFIL, F06FIL, IN0FIL, INFILE, NEUFIL, & PCHFIL, SEQFIL, SPCFIL, & F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, & LINK1A, LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, & @@ -57,13 +57,12 @@ SUBROUTINE FILE_INQUIRE ( MESSAGE ) USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FILE_INQUIRE_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: MESSAGE ! Message written when this subr is called - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FILE_INQUIRE_BEGEND + END SUBROUTINE FILE_INQUIRE diff --git a/Source/Interfaces/FILE_OPEN_Interface.f90 b/Source/Interfaces/FILE_OPEN_Interface.f90 index defb1535..03656d74 100644 --- a/Source/Interfaces/FILE_OPEN_Interface.f90 +++ b/Source/Interfaces/FILE_OPEN_Interface.f90 @@ -28,17 +28,16 @@ MODULE FILE_OPEN_Interface INTERFACE - SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTION, POSITION, WRITE_L1A, WRITE_VER, WRITE_F04) + SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTION, POSITION, WRITE_L1A, WRITE_VER) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ANS, F04, F06, IN1, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : F06, IN1, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, PROG_NAME USE TIMDAT, ONLY : STIME, TSEC USE DEBUG_PARAMETERS USE MYSTRAN_Version, ONLY : MYSTRAN_VER_NUM, MYSTRAN_VER_MONTH, MYSTRAN_VER_DAY, MYSTRAN_VER_YEAR, MYSTRAN_AUTHOR, & MYSTRAN_COMMENT - USE SUBR_BEGEND_LEVELS, ONLY : FILE_OPEN_BEGEND IMPLICIT NONE @@ -49,13 +48,12 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI CHARACTER(LEN=*), INTENT(IN) :: POSITION ! File description CHARACTER(LEN=*), INTENT(IN) :: STATUS ! File status indicator (NEW, OLD, REPLACE) CHARACTER(LEN=*), INTENT(IN) :: RW_STIME ! Indicator of whether to read or write STIME - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) CHARACTER(LEN=*), INTENT(IN) :: WRITE_L1A ! 'Y'/'N' Arg passed to subr OUTA_HERE CHARACTER(LEN=*), INTENT(IN) :: WRITE_VER ! 'Y'/'N' Arg to tell whether to write MYSTRAN version info INTEGER(LONG), INTENT(IN) :: UNIT ! Unit number file is attached to INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to. Input to subr FILE_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FILE_OPEN_BEGEND + END SUBROUTINE FILE_OPEN diff --git a/Source/Interfaces/FORCE_MOM_PROC_Interface.f90 b/Source/Interfaces/FORCE_MOM_PROC_Interface.f90 index 1fa5baa7..f91c97af 100644 --- a/Source/Interfaces/FORCE_MOM_PROC_Interface.f90 +++ b/Source/Interfaces/FORCE_MOM_PROC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE FORCE_MOM_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, SCR, L1I, LINK1I, L1I_MSG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, SCR, L1I, LINK1I, L1I_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LLOADC, NCORD, NFORCE, NGRID, NLOAD, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FORCE_MOM_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, SUPWARN USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -43,7 +42,7 @@ SUBROUTINE FORCE_MOM_PROC IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FORCE_MOM_PROC_BEGEND + END SUBROUTINE FORCE_MOM_PROC diff --git a/Source/Interfaces/FULL_TO_SPARSE_CRS_Interface.f90 b/Source/Interfaces/FULL_TO_SPARSE_CRS_Interface.f90 index 770ff904..18da5158 100644 --- a/Source/Interfaces/FULL_TO_SPARSE_CRS_Interface.f90 +++ b/Source/Interfaces/FULL_TO_SPARSE_CRS_Interface.f90 @@ -33,12 +33,11 @@ SUBROUTINE FULL_TO_SPARSE_CRS ( MATIN_NAME, N, M, MATIN_FULL, NTERM_ALLOC, SMALL I_MATOUT, J_MATOUT, MATOUT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : FULL_TO_SPARSE_CRS_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE FULL_TO_SPARSE_CRS ( MATIN_NAME, N, M, MATIN_FULL, NTERM_ALLOC, SMALL INTEGER(LONG), INTENT(IN) :: NTERM_ALLOC ! Number of nonzero terms allocated to MATOUT in calling subr INTEGER(LONG), INTENT(OUT) :: I_MATOUT(N+1) ! I_MATOUT(I+1) - I_MATOUT(I) = number of nonzeros in MATOUT row I INTEGER(LONG), INTENT(OUT) :: J_MATOUT(NTERM_ALLOC)! Col numbers for nonzero terms in MATOUT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FULL_TO_SPARSE_CRS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN_FULL(N,M) ! Real nonzero values in input matrix MATIN REAL(DOUBLE) , INTENT(IN) :: SMALL ! Terms < SMALL are filtered out (both here and in calling subr) diff --git a/Source/Interfaces/GEN_T0L_Interface.f90 b/Source/Interfaces/GEN_T0L_Interface.f90 index d9431802..e8fad39e 100644 --- a/Source/Interfaces/GEN_T0L_Interface.f90 +++ b/Source/Interfaces/GEN_T0L_Interface.f90 @@ -33,18 +33,17 @@ SUBROUTINE GEN_T0L (RGRID_ROW, ICORD, THETAD, PHID, T0L ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE, ONE80, PI - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, f06 + USE IOUNT1, ONLY : WRT_ERR, f06 USE SCONTR, ONLY : BLNK_SUB_NAM USE PARAMS, ONLY : EPSIL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GEN_T0L_BEGEND USE MODEL_STUF, ONLY : RGRID, CORD, RCORD IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: RGRID_ROW ! Row number in array RGRID where the RGRID data is stored for the grid INTEGER(LONG), INTENT(IN) :: ICORD ! Internal coord ID for coord sys L - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GEN_T0L_BEGEND + REAL(DOUBLE), INTENT(OUT) :: THETAD,PHID ! Azimuth and elevation angles (deg) for cylindrical/spherical coord sys REAL(DOUBLE), INTENT(OUT) :: T0L(3,3) ! 3 x 3 coord transformation matrix described above diff --git a/Source/Interfaces/GET_ANSID_Interface.f90 b/Source/Interfaces/GET_ANSID_Interface.f90 index 49e0d30b..0322f24b 100644 --- a/Source/Interfaces/GET_ANSID_Interface.f90 +++ b/Source/Interfaces/GET_ANSID_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE GET_ANSID ( CARD, SETID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : CC_ENTRY_LEN, FATAL_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ANSID_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Case Control card (can be modified by subr CSHIFT, called herein) INTEGER(LONG), INTENT(OUT) :: SETID ! Set ID read from CARD after '=', if CARD contains an integer here. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ANSID_BEGEND + END SUBROUTINE GET_ANSID diff --git a/Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90 b/Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90 index 11c8f375..14cb391a 100644 --- a/Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90 +++ b/Source/Interfaces/GET_ARRAY_ROW_NUM_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE GET_ARRAY_ROW_NUM ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY, EXT_ID, R USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, f06 + USE IOUNT1, ONLY : WRT_ERR, ERR, f06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE, TWO - USE SUBR_BEGEND_LEVELS, ONLY : GET_ARRAY_ROW_NUM_BEGEND IMPLICIT NONE @@ -48,28 +47,10 @@ SUBROUTINE GET_ARRAY_ROW_NUM ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY, EXT_ID, R INTEGER(LONG), INTENT(IN) :: EXT_ID ! External (actual) ID to find in ARRAY INTEGER(LONG), INTENT(OUT) :: ROW_NUM ! Internal ID (row in ARRAY) where EXT_ID exists INTEGER(LONG) :: HI, LO ! Used to bound the range of N where EXT_ID is expected to be found - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ARRAY_ROW_NUM_BEGEND + END SUBROUTINE GET_ARRAY_ROW_NUM - - SUBROUTINE ASSERT_ARRAY_SORTED ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY) - - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, f06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - - USE GET_ARRAY_ROW_NUM_USE_IFs - - IMPLICIT NONE - - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ASSERT_ARRAY_SORTED' - CHARACTER(LEN=*), INTENT(IN) :: ARRAY_NAME ! Name of array to be searched - CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Name of subr that called this one - - INTEGER(LONG), INTENT(IN) :: ASIZE ! Size of ARRAY - INTEGER(LONG), INTENT(IN) :: ARRAY(ASIZE) ! Array to search - INTEGER(LONG) :: N ! Loop index - END SUBROUTINE ASSERT_ARRAY_SORTED + END INTERFACE END MODULE GET_ARRAY_ROW_NUM_Interface diff --git a/Source/Interfaces/GET_CHAR_STRING_END_Interface.f90 b/Source/Interfaces/GET_CHAR_STRING_END_Interface.f90 index f8d07a26..32495516 100644 --- a/Source/Interfaces/GET_CHAR_STRING_END_Interface.f90 +++ b/Source/Interfaces/GET_CHAR_STRING_END_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE GET_CHAR_STRING_END ( CHAR_STRING, IEND ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_CHAR_STRING_END_BEGEND IMPLICIT NONE CHARACTER(LEN=*) , INTENT(IN) :: CHAR_STRING ! String to get ending of INTEGER(LONG) , INTENT(OUT) :: IEND ! Col where CHAR_STRING stops having non blanks - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_CHAR_STRING_END_BEGEND + END SUBROUTINE GET_CHAR_STRING_END diff --git a/Source/Interfaces/GET_COMP_SHELL_ALLOWS_Interface.f90 b/Source/Interfaces/GET_COMP_SHELL_ALLOWS_Interface.f90 index 703d6318..e9506933 100644 --- a/Source/Interfaces/GET_COMP_SHELL_ALLOWS_Interface.f90 +++ b/Source/Interfaces/GET_COMP_SHELL_ALLOWS_Interface.f90 @@ -32,16 +32,14 @@ SUBROUTINE GET_COMP_SHELL_ALLOWS ( STRE_ALLOWABLES, STRN_ALLOWABLES ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE TIMDAT, ONLY : TSEC USE SCONTR, ONLY : BLNK_SUB_NAM USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM USE MODEL_STUF, ONLY : ULT_STRE, ULT_STRN - USE SUBR_BEGEND_LEVELS, ONLY : GET_COMP_SHELL_ALLOWS_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_COMP_SHELL_ALLOWS_BEGEND + REAL(DOUBLE), INTENT(OUT) :: STRE_ALLOWABLES(9)! Stress allowables for the material REAL(DOUBLE), INTENT(OUT) :: STRN_ALLOWABLES(9)! Strain allowables for the material diff --git a/Source/Interfaces/GET_ELEM_AGRID_BGRID_Interface.f90 b/Source/Interfaces/GET_ELEM_AGRID_BGRID_Interface.f90 index d3298221..7185795d 100644 --- a/Source/Interfaces/GET_ELEM_AGRID_BGRID_Interface.f90 +++ b/Source/Interfaces/GET_ELEM_AGRID_BGRID_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE GET_ELEM_AGRID_BGRID ( INT_ELEM_ID, CHECK_AGRID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, medat0_cuserin, MELGP, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ELEM_AGRID_BGRID_BEGEND USE MODEL_STUF, ONLY : AGRID, BGRID, EDAT, EID, ELGP, EPNT, ETYPE, GRID, GRID_ID, TYPE IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE GET_ELEM_AGRID_BGRID ( INT_ELEM_ID, CHECK_AGRID ) CHARACTER(LEN=*), INTENT(IN) :: CHECK_AGRID ! If 'Y' perform check on AGRID's to see if appropriate type INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID for which - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ELEM_AGRID_BGRID_BEGEND + END SUBROUTINE GET_ELEM_AGRID_BGRID diff --git a/Source/Interfaces/GET_ELEM_NUM_PLIES_Interface.f90 b/Source/Interfaces/GET_ELEM_NUM_PLIES_Interface.f90 index 8a1ebc85..a100e619 100644 --- a/Source/Interfaces/GET_ELEM_NUM_PLIES_Interface.f90 +++ b/Source/Interfaces/GET_ELEM_NUM_PLIES_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE GET_ELEM_NUM_PLIES ( INT_ELEM_ID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, DEDAT_Q4_SHELL_KEY, DEDAT_T3_SHELL_KEY, NPCOMP, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ELEM_NUM_PLIES_BEGEND USE MODEL_STUF, ONLY : EDAT, EID, EPNT, ETYPE, INTL_PID, NUM_PLIES, PCOMP, TYPE IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID for which - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ELEM_NUM_PLIES_BEGEND + END SUBROUTINE GET_ELEM_NUM_PLIES diff --git a/Source/Interfaces/GET_ELEM_ONAME_Interface.f90 b/Source/Interfaces/GET_ELEM_ONAME_Interface.f90 index ac51fc5b..58597a27 100644 --- a/Source/Interfaces/GET_ELEM_ONAME_Interface.f90 +++ b/Source/Interfaces/GET_ELEM_ONAME_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE GET_ELEM_ONAME ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, METYPE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ELEM_ONAME_BEGEND USE MODEL_STUF, ONLY : ELEM_ONAME, ELMTYP, TYPE IMPLICIT NONE CHARACTER(LEN=LEN(ELEM_ONAME)), INTENT(OUT) :: NAME ! Name of an elem for output purposes in LINK9 WRTELi subr's - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ELEM_ONAME_BEGEND + END SUBROUTINE GET_ELEM_ONAME diff --git a/Source/Interfaces/GET_ELGP_Interface.f90 b/Source/Interfaces/GET_ELGP_Interface.f90 index 8a0b83b0..818f5eb1 100644 --- a/Source/Interfaces/GET_ELGP_Interface.f90 +++ b/Source/Interfaces/GET_ELGP_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE GET_ELGP ( INT_ELEM_ID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE, MELGP, METYPE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ELGP_BEGEND USE MODEL_STUF, ONLY : EDAT, EID, ELGP, ELMTYP, etype, EMG_IFE, EPNT, ERR_SUB_NAM, NELGP, NUM_EMG_FATAL_ERRS, TYPE IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE GET_ELGP ( INT_ELEM_ID ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID INTEGER(LONG) :: NG ! Number of GRID's for USERIN elem INTEGER(LONG) :: NS ! Number of SPOINT's for USERIN elem - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ELGP_BEGEND + END SUBROUTINE GET_ELGP diff --git a/Source/Interfaces/GET_FORMATTED_INTEGER_Interface.f90 b/Source/Interfaces/GET_FORMATTED_INTEGER_Interface.f90 index c076db04..28f8fb38 100644 --- a/Source/Interfaces/GET_FORMATTED_INTEGER_Interface.f90 +++ b/Source/Interfaces/GET_FORMATTED_INTEGER_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE GET_FORMATTED_INTEGER ( INT, CHAR_INT, NUM_CHARS, NUM_DIGITS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_FORMATTED_INTEGER_BEGEND IMPLICIT NONE INTEGER(LONG), PARAMETER :: WORD_LEN = 13 ! Length of character string that INT will be entered into CHARACTER(WORD_LEN*BYTE), INTENT(OUT) :: CHAR_INT ! Integer formatted to have comma's (36879 becomes 36,879) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_FORMATTED_INTEGER_BEGEND + INTEGER(LONG), INTENT(IN) :: INT ! Integer to be converted to formated value in CHAR_INT INTEGER(LONG), INTENT(OUT) :: NUM_CHARS ! Num of non blank chars in CHAR_INT after formatting w/ commas INTEGER(LONG), INTENT(OUT) :: NUM_DIGITS ! Number of digits in INT diff --git a/Source/Interfaces/GET_GRID_6X6_MASS_Interface.f90 b/Source/Interfaces/GET_GRID_6X6_MASS_Interface.f90 index 7283518e..e1e495aa 100644 --- a/Source/Interfaces/GET_GRID_6X6_MASS_Interface.f90 +++ b/Source/Interfaces/GET_GRID_6X6_MASS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE GET_GRID_6X6_MASS ( AGRID, IGRID, FOUND, GRID_MGG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID, NTERM_MGG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_GRID_6X6_MASS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TDOF USE SPARSE_MATRICES, ONLY : I2_MGG, J_MGG, MGG @@ -46,7 +45,7 @@ SUBROUTINE GET_GRID_6X6_MASS ( AGRID, IGRID, FOUND, GRID_MGG ) INTEGER(LONG), INTENT(IN) :: AGRID ! Actual grid number of grid for which we want the 6 x 6 mass matrix INTEGER(LONG), INTENT(IN) :: IGRID ! Internal grid number of grid for which we want the 6 x 6 mass matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_GRID_6X6_MASS_BEGEND + REAL(DOUBLE), INTENT(OUT) :: GRID_MGG(6,6) ! 6 x 6 mass matrix for internal grid IGRID diff --git a/Source/Interfaces/GET_GRID_AND_COMP_Interface.f90 b/Source/Interfaces/GET_GRID_AND_COMP_Interface.f90 index f002b5bd..b9849b23 100644 --- a/Source/Interfaces/GET_GRID_AND_COMP_Interface.f90 +++ b/Source/Interfaces/GET_GRID_AND_COMP_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE GET_GRID_AND_COMP ( X_SET, DOF_NUM, GRIDV, COMPV ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_GRID_AND_COMP_BEGEND USE DOF_TABLES, ONLY : TDOFI IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE GET_GRID_AND_COMP ( X_SET, DOF_NUM, GRIDV, COMPV ) INTEGER(LONG), INTENT(IN) :: DOF_NUM ! DOF number in TDOF INTEGER(LONG), INTENT(OUT) :: COMPV ! Comp. num corresponding to DOF_NUM in array TDOFI, col X_SET_COL_NUM INTEGER(LONG), INTENT(OUT) :: GRIDV ! Grid num corresponding to DOF_NUM in array TDOFI, col X_SET_COL_NUM - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_GRID_AND_COMP_BEGEND + END SUBROUTINE GET_GRID_AND_COMP diff --git a/Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90 b/Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90 index 56c342a6..6f43f706 100644 --- a/Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90 +++ b/Source/Interfaces/GET_GRID_NUM_COMPS_Interface.f90 @@ -28,26 +28,22 @@ MODULE GET_GRID_NUM_COMPS_Interface INTERFACE - SUBROUTINE GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, CALLING_SUBR ) + SUBROUTINE GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, CALLING_SUBR ) - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID - USE TIMDAT, ONLY : TSEC + USE PENTIUM_II_KIND, ONLY : LONG USE MODEL_STUF, ONLY : GRID - USE SUBR_BEGEND_LEVELS, ONLY : GET_GRID_NUM_COMPS_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Subr that called this one - INTEGER(LONG), INTENT(IN) :: GRID_NUM ! A grid number (calling subr checked that it is an actual grid) + INTEGER(LONG), INTENT(IN) :: IGRID ! An internal grid number INTEGER(LONG), INTENT(OUT) :: NUM_COMPS ! 6 if GRID_NUM is an physical grid, 1 if an SPOINT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_GRID_NUM_COMPS_BEGEND - - END SUBROUTINE GET_GRID_NUM_COMPS + END SUBROUTINE GET_GRID_NUM_COMPS + + END INTERFACE END MODULE GET_GRID_NUM_COMPS_Interface diff --git a/Source/Interfaces/GET_I2_MAT_FROM_I_MAT_Interface.f90 b/Source/Interfaces/GET_I2_MAT_FROM_I_MAT_Interface.f90 index d9bcd409..b94be5b8 100644 --- a/Source/Interfaces/GET_I2_MAT_FROM_I_MAT_Interface.f90 +++ b/Source/Interfaces/GET_I2_MAT_FROM_I_MAT_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE GET_I2_MAT_FROM_I_MAT ( MAT_NAME, NROWS, NTERMS, I_MAT, I2_MAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_I2_MAT_FROM_I_MAT_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE GET_I2_MAT_FROM_I_MAT ( MAT_NAME, NROWS, NTERMS, I_MAT, I2_MAT ) INTEGER(LONG), INTENT(IN) :: NTERMS ! Number of matrix terms that should be in MAT INTEGER(LONG), INTENT(IN) :: I_MAT(NROWS+1) ! Row indicators for terms in matrix MAT INTEGER(LONG), INTENT(OUT) :: I2_MAT(NTERMS) ! Row numbers for terms in matrix MAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_I2_MAT_FROM_I_MAT_BEGEND + END SUBROUTINE GET_I2_MAT_FROM_I_MAT diff --git a/Source/Interfaces/GET_INI_FILNAM_Interface.f90 b/Source/Interfaces/GET_INI_FILNAM_Interface.f90 index 76dab8e7..816ae238 100644 --- a/Source/Interfaces/GET_INI_FILNAM_Interface.f90 +++ b/Source/Interfaces/GET_INI_FILNAM_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE GET_INI_FILNAM ( MYSTRAN_DIR, MYSTRAN_DIR_LEN, INIFIL_NAME_LEN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, F04, INIFIL, WRT_LOG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, INIFIL USE SCONTR, ONLY : BLNK_SUB_NAM, PROG_NAME USE TIMDAT, ONLY : TSEC diff --git a/Source/Interfaces/GET_I_MAT_FROM_I2_MAT_Interface.f90 b/Source/Interfaces/GET_I_MAT_FROM_I2_MAT_Interface.f90 index 187acc1d..d752ef3d 100644 --- a/Source/Interfaces/GET_I_MAT_FROM_I2_MAT_Interface.f90 +++ b/Source/Interfaces/GET_I_MAT_FROM_I2_MAT_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE GET_I_MAT_FROM_I2_MAT ( MAT_NAME, NROWS, NTERMS, I2_MAT, I_MAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_I_MAT_FROM_I2_MAT_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE GET_I_MAT_FROM_I2_MAT ( MAT_NAME, NROWS, NTERMS, I2_MAT, I_MAT ) INTEGER(LONG), INTENT(IN) :: NTERMS ! Number of matrix terms that should be in MAT INTEGER(LONG), INTENT(IN) :: I2_MAT(NTERMS) ! Row numbers for terms in matrix MAT INTEGER(LONG), INTENT(OUT) :: I_MAT(NROWS+1) ! Row numbers for terms in matrix MAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_I_MAT_FROM_I2_MAT_BEGEND + END SUBROUTINE GET_I_MAT_FROM_I2_MAT diff --git a/Source/Interfaces/GET_MACHINE_PARAMS_Interface.f90 b/Source/Interfaces/GET_MACHINE_PARAMS_Interface.f90 index f0cdcfc2..7020020b 100644 --- a/Source/Interfaces/GET_MACHINE_PARAMS_Interface.f90 +++ b/Source/Interfaces/GET_MACHINE_PARAMS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE GET_MACHINE_PARAMS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE - USE SUBR_BEGEND_LEVELS, ONLY : GET_MACHINE_PARAMS_BEGEND USE MACHINE_PARAMS, ONLY : MACH_BASE, MACH_EMAX, MACH_EMIN, MACH_EPS, MACH_PREC, MACH_RMAX, MACH_RMIN, MACH_RND, & MACH_SFMIN, MACH_T, MACH_LARGE_NUM USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -44,7 +43,7 @@ SUBROUTINE GET_MACHINE_PARAMS IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_MACHINE_PARAMS_BEGEND + END SUBROUTINE GET_MACHINE_PARAMS diff --git a/Source/Interfaces/GET_MATANGLE_FROM_CID_Interface.f90 b/Source/Interfaces/GET_MATANGLE_FROM_CID_Interface.f90 index ad7ee3a5..0798250b 100644 --- a/Source/Interfaces/GET_MATANGLE_FROM_CID_Interface.f90 +++ b/Source/Interfaces/GET_MATANGLE_FROM_CID_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE GET_MATANGLE_FROM_CID ( ACID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCORD USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : CONV_DEG_RAD, ZERO, ONE USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : CORD, EID, NUM_EMG_FATAL_ERRS, NUM_EMG_FATAL_ERRS, RCORD, TE, THETAM, TYPE - USE SUBR_BEGEND_LEVELS, ONLY : GET_MATANGLE_FROM_CID_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: ACID ! Actual coord system ID for the sys that defines the material axes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_MATANGLE_FROM_CID_BEGEND + END SUBROUTINE GET_MATANGLE_FROM_CID diff --git a/Source/Interfaces/GET_MATRIX_DIAG_STATS_Interface.f90 b/Source/Interfaces/GET_MATRIX_DIAG_STATS_Interface.f90 index 25d6d6ab..ee8f6eb2 100644 --- a/Source/Interfaces/GET_MATRIX_DIAG_STATS_Interface.f90 +++ b/Source/Interfaces/GET_MATRIX_DIAG_STATS_Interface.f90 @@ -34,13 +34,12 @@ SUBROUTINE GET_MATRIX_DIAG_STATS ( MAT_NAME, INPUT_SET, NROWS, NTERM, I_KIN, J_K USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NGRID - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : AUTOSPC_RAT, EPSIL USE DOF_TABLES, ONLY : TDOFI USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : GET_MATRIX_DIAG_STATS_BEGEND IMPLICIT NONE @@ -53,7 +52,7 @@ SUBROUTINE GET_MATRIX_DIAG_STATS ( MAT_NAME, INPUT_SET, NROWS, NTERM, I_KIN, J_K INTEGER(LONG), INTENT(IN) :: J_KIN(NTERM) ! Col numbers of terms in KIN INTEGER(LONG), INTENT(IN) :: WRITE_WHAT ! 1 write diagonal, 2 write summary stats, 3 write both INTEGER(LONG) :: AGRID_OLD ! Actual grid number (used to add blank line bet grids when write diags) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_MATRIX_DIAG_STATS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: KIN(NTERM) ! Nonzero terms in the stiffness matrix REAL(DOUBLE) , INTENT(OUT) :: KIN_DIAG(NROWS) ! Diagonal terms from KIN diff --git a/Source/Interfaces/GET_MAX_MIN_ABS_STR_Interface.f90 b/Source/Interfaces/GET_MAX_MIN_ABS_STR_Interface.f90 index 832d1527..1b3b8870 100644 --- a/Source/Interfaces/GET_MAX_MIN_ABS_STR_Interface.f90 +++ b/Source/Interfaces/GET_MAX_MIN_ABS_STR_Interface.f90 @@ -33,12 +33,10 @@ SUBROUTINE GET_MAX_MIN_ABS_STR ( NUM_ROWS, NUM_COLS, SECOND_LINE, MAX_ANS, MIN_A USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM - USE IOUNT1, ONLY : F04, WRT_LOG USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM USE LINK9_STUFF, ONLY : OGEL - USE SUBR_BEGEND_LEVELS, ONLY : GET_MAX_MIN_ABS_STR_BEGEND IMPLICIT NONE @@ -46,7 +44,7 @@ SUBROUTINE GET_MAX_MIN_ABS_STR ( NUM_ROWS, NUM_COLS, SECOND_LINE, MAX_ANS, MIN_A INTEGER(LONG) , INTENT(IN) :: NUM_ROWS ! Number of stress or strain rows in OGEL INTEGER(LONG) , INTENT(IN) :: NUM_COLS ! Number of MAX, MIN, ABS to calc (number of cols in OGEL) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_MAX_MIN_ABS_STR_BEGEND + REAL(DOUBLE) , INTENT(OUT) :: ABS_ANS(NUM_COLS) ! Max ABS for all grids output for each of the 6 disp components REAL(DOUBLE) , INTENT(OUT) :: MAX_ANS(NUM_COLS) ! Max for all grids output for each of the 6 disp components diff --git a/Source/Interfaces/GET_PCOMP_SECT_PROPS_Interface.f90 b/Source/Interfaces/GET_PCOMP_SECT_PROPS_Interface.f90 index 4398ed51..1b4ed4fd 100644 --- a/Source/Interfaces/GET_PCOMP_SECT_PROPS_Interface.f90 +++ b/Source/Interfaces/GET_PCOMP_SECT_PROPS_Interface.f90 @@ -33,16 +33,14 @@ SUBROUTINE GET_PCOMP_SECT_PROPS ( PCOMP_TM, PCOMP_IB, PCOMP_TS ) USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, MPCOMP_PLIES, MPCOMP0, MRPCOMP_PLIES, MRPCOMP0 - USE IOUNT1, ONLY : F04, WRT_LOG USE MODEL_STUF, ONLY : EPROP, INTL_PID, NUM_PLIES, RPCOMP, TPLY USE PARAMS, ONLY : PCMPTSTM USE CONSTANTS_1, ONLY : ZERO, THIRD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_PCOMP_SECT_PROPS_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_PCOMP_SECT_PROPS_BEGEND + REAL(DOUBLE), INTENT(OUT) :: PCOMP_TM ! Membrane thickness of PCOMP for equivalent PSHELL REAL(DOUBLE), INTENT(OUT) :: PCOMP_IB ! Bending MOI of PCOMP for equivalent PSHELL diff --git a/Source/Interfaces/GET_SETID_Interface.f90 b/Source/Interfaces/GET_SETID_Interface.f90 index 9b690133..f1a0193b 100644 --- a/Source/Interfaces/GET_SETID_Interface.f90 +++ b/Source/Interfaces/GET_SETID_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE GET_SETID ( CARD, SETID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : CC_ENTRY_LEN, FATAL_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_SETID_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Case Control card (can be modified by subr CSHIFT, called herein) INTEGER(LONG), INTENT(OUT) :: SETID ! Set ID read from CARD after '=', if CARD contains an integer here. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_SETID_BEGEND + END SUBROUTINE GET_SETID diff --git a/Source/Interfaces/GET_SPARSE_CRS_COL_Interface.f90 b/Source/Interfaces/GET_SPARSE_CRS_COL_Interface.f90 index ea1b1667..e7383a12 100644 --- a/Source/Interfaces/GET_SPARSE_CRS_COL_Interface.f90 +++ b/Source/Interfaces/GET_SPARSE_CRS_COL_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE GET_SPARSE_CRS_COL ( MATIN_NAME, COL_NUM, NTERM, NROWS, NCOLS, I_MATI USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : GET_SPARSE_CRS_COL_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE GET_SPARSE_CRS_COL ( MATIN_NAME, COL_NUM, NTERM, NROWS, NCOLS, I_MATI INTEGER(LONG), INTENT(IN ) :: J_MATIN(NTERM) ! Col numbers for terms in MATIN INTEGER(LONG), INTENT(IN ) :: NCOLS ! No. cols in MATIN INTEGER(LONG), INTENT(IN ) :: COL_NUM ! Col number for the col to get in MATIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_SPARSE_CRS_COL_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM) ! Nonzero terms in matrix MATIN REAL(DOUBLE) , INTENT(IN) :: BETA ! Scalar multiplier for row from MATIN diff --git a/Source/Interfaces/GET_SPARSE_CRS_ROW_Interface.f90 b/Source/Interfaces/GET_SPARSE_CRS_ROW_Interface.f90 index 9cad979f..ca1346e8 100644 --- a/Source/Interfaces/GET_SPARSE_CRS_ROW_Interface.f90 +++ b/Source/Interfaces/GET_SPARSE_CRS_ROW_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE GET_SPARSE_CRS_ROW ( MATIN_NAME, ROW_NUM, NTERM, NROWS, NCOLS, I_MATI USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : GET_SPARSE_CRS_ROW_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE GET_SPARSE_CRS_ROW ( MATIN_NAME, ROW_NUM, NTERM, NROWS, NCOLS, I_MATI INTEGER(LONG), INTENT(IN ) :: I_MATIN(NROWS+1) ! Starting locations in MATIN for each row INTEGER(LONG), INTENT(IN ) :: J_MATIN(NTERM) ! Col numbers for terms in MATIN INTEGER(LONG), INTENT(IN ) :: ROW_NUM ! Row number for the row to get in MATIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_SPARSE_CRS_ROW_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM) ! Nonzero terms in matrix MATIN REAL(DOUBLE) , INTENT(IN) :: BETA ! Scalar multiplier for row from MATIN diff --git a/Source/Interfaces/GET_SPARSE_MAT_TERM_Interface.f90 b/Source/Interfaces/GET_SPARSE_MAT_TERM_Interface.f90 index 55bbb46b..286dbb43 100644 --- a/Source/Interfaces/GET_SPARSE_MAT_TERM_Interface.f90 +++ b/Source/Interfaces/GET_SPARSE_MAT_TERM_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE GET_SPARSE_MAT_TERM ( MATIN_NAME, I_MATIN, J_MATIN, MATIN, IROW, JCOL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : GET_SPARSE_MAT_TERM_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE GET_SPARSE_MAT_TERM ( MATIN_NAME, I_MATIN, J_MATIN, MATIN, IROW, JCOL INTEGER(LONG), INTENT(IN) :: JCOL ! Col index of the term to retrieve from sparse MATIN INTEGER(LONG), INTENT(IN) :: I_MATIN(N+1) ! Indices of the beginning terms in each row for MATIN values INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERMS) ! Col numbers of nonzero term in MATIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_SPARSE_MAT_TERM_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERMS) ! Real vals in sparse matrix MATIN REAL(DOUBLE) , INTENT(OUT) :: MATIN_VAL diff --git a/Source/Interfaces/GET_UG_123_IN_GRD_ORD_Interface.f90 b/Source/Interfaces/GET_UG_123_IN_GRD_ORD_Interface.f90 index 4aa145af..241b0992 100644 --- a/Source/Interfaces/GET_UG_123_IN_GRD_ORD_Interface.f90 +++ b/Source/Interfaces/GET_UG_123_IN_GRD_ORD_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NGRID USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : GRID_ID USE DOF_TABLES, ONLY : TDOFI USE COL_VECS, ONLY : UG_COL USE MISC_MATRICES, ONLY : UG_T123_MAT - USE SUBR_BEGEND_LEVELS, ONLY : GET_UG_123_IN_GRD_ORD_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_UG_123_IN_GRD_ORD_BEGEND + INTEGER(LONG), INTENT(OUT) :: IERR ! Local error indicator END SUBROUTINE GET_UG_123_IN_GRD_ORD diff --git a/Source/Interfaces/GET_VEC_MIN_MAX_ABS_Interface.f90 b/Source/Interfaces/GET_VEC_MIN_MAX_ABS_Interface.f90 index f74e0dae..7c796d0b 100644 --- a/Source/Interfaces/GET_VEC_MIN_MAX_ABS_Interface.f90 +++ b/Source/Interfaces/GET_VEC_MIN_MAX_ABS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE GET_VEC_MIN_MAX_ABS ( NROWS, ID_LIST, VECTOR, VEC_MIN, VEC_MAX, VEC_A USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04 + USE IOUNT1, ONLY : WRT_ERR, ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_VEC_MIN_MAX_ABS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM @@ -45,7 +44,7 @@ SUBROUTINE GET_VEC_MIN_MAX_ABS ( NROWS, ID_LIST, VECTOR, VEC_MIN, VEC_MAX, VEC_A INTEGER(LONG), INTENT(IN) :: ID_LIST(NROWS) ! The ID (grid or elem) numbers corresponding to rows in VECTOR INTEGER(LONG), INTENT(OUT) :: ID_MAX ! ID where vector is max INTEGER(LONG), INTENT(OUT) :: ID_MIN ! ID where vector is min - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_VEC_MIN_MAX_ABS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: VECTOR(NROWS) ! Values to scan for MIN, MAX, ABS REAL(DOUBLE) , INTENT(OUT) :: VEC_ABS ! Abs value in vector diff --git a/Source/Interfaces/GPWG_Interface.f90 b/Source/Interfaces/GPWG_Interface.f90 index a591558d..382cae61 100644 --- a/Source/Interfaces/GPWG_Interface.f90 +++ b/Source/Interfaces/GPWG_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE GPWG ( WHICH ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_ME_BIT, IBIT, MBUG, NCONM2, NCORD, NELE, NGRID, SOL_NAME, WARN_ERR USE PARAMS, ONLY : EPSIL, GRDPNT, MEFMGRID, MEFMLOC, SUPWARN, WTMASS USE DEBUG_PARAMETERS, ONLY : DEBUG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GPWG_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : AGRID, BGRID, CONM2, CORD, CAN_ELEM_TYPE_OFFSET, ELDT, ELGP, NUM_EMG_FATAL_ERRS, & GRID, GRID_ID, MCG, ME, MEFFMASS_CALC, MEFM_RB_MASS, & @@ -49,7 +48,7 @@ SUBROUTINE GPWG ( WHICH ) CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(12*BYTE), INTENT(IN) :: WHICH ! Whether to get mass props for INTEGER(LONG) :: JDOF ! Array index used in getting mass terms from the elem mass matrix, ME - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GPWG_BEGEND + REAL(DOUBLE) :: M0 ! An intermediate variable used in calc model mass props diff --git a/Source/Interfaces/GPWG_PMOI_Interface.f90 b/Source/Interfaces/GPWG_PMOI_Interface.f90 index 8a07456c..2ae1faf2 100644 --- a/Source/Interfaces/GPWG_PMOI_Interface.f90 +++ b/Source/Interfaces/GPWG_PMOI_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE GPWG_PMOI (MOI1, Q, INFO ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : SUPWARN, WTMASS USE LAPACK_STD_EIG_1 - USE SUBR_BEGEND_LEVELS, ONLY : GPWG_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE GPWG_PMOI (MOI1, Q, INFO ) INTEGER(LONG), INTENT(OUT) :: INFO ! = 0: successful exit INTEGER(LONG), PARAMETER :: N = 3 ! Order of matrix MOI1 INTEGER(LONG), PARAMETER :: LWORK = 3*N-1 ! Size of array WORK - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GPWG_BEGEND + 1 + REAL(DOUBLE) , INTENT(INOUT) :: MOI1(3,3) ! On entry, the MOI's about c.g. in basic coords REAL(DOUBLE) , INTENT(OUT) :: Q(3,3) ! Transformation from basic to principal directions diff --git a/Source/Interfaces/GPWG_USERIN_Interface.f90 b/Source/Interfaces/GPWG_USERIN_Interface.f90 index 4c93d6c0..970bd152 100644 --- a/Source/Interfaces/GPWG_USERIN_Interface.f90 +++ b/Source/Interfaces/GPWG_USERIN_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE GPWG_USERIN ( IEID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID, SOL_NAME, WARN_ERR USE PARAMS, ONLY : EPSIL, GRDPNT, MEFMGRID, SUPWARN, WTMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GPWG_USERIN_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : NUM_EMG_FATAL_ERRS, EID, GRID_ID, ME, PLY_NUM, RGRID, USERIN_RBM0 @@ -45,7 +44,7 @@ SUBROUTINE GPWG_USERIN ( IEID ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'GPWG_USERIN' INTEGER(LONG), INTENT(IN) :: IEID ! Internal element ID for the USERIN element to process - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GPWG_USERIN_BEGEND + REAL(DOUBLE) :: M0 ! An intermediate variable used in calc model mass props diff --git a/Source/Interfaces/GP_FORCE_BALANCE_PROC_Interface.f90 b/Source/Interfaces/GP_FORCE_BALANCE_PROC_Interface.f90 index adae8e00..1865932c 100644 --- a/Source/Interfaces/GP_FORCE_BALANCE_PROC_Interface.f90 +++ b/Source/Interfaces/GP_FORCE_BALANCE_PROC_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHDR ) USE PENTIUM_II_KIND, ONLY : BYTE, SHORT, LONG, DOUBLE - USE IOUNT1, ONLY : ANS, ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, GROUT_GPFO_BIT, IBIT, INT_SC_NUM, JTSUB, NDOFG, NDOFM, MELDOF, NDOFO, NDOFR,& NELE, NGRID, NUM_CB_DOFS, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GP_FORCE_BALANCE_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE_HUNDRED USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -54,7 +53,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHDR ) INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG) :: IB ! Intermediate value used in determining NREQ - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GP_FORCE_BALANCE_PROC_BEGEND + END SUBROUTINE GP_FORCE_BALANCE_PROC diff --git a/Source/Interfaces/GRAV_PROC_Interface.f90 b/Source/Interfaces/GRAV_PROC_Interface.f90 index 63a1408c..e4c1be2e 100644 --- a/Source/Interfaces/GRAV_PROC_Interface.f90 +++ b/Source/Interfaces/GRAV_PROC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE GRAV_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, ERR, F04, F06, SCR, L1P, LINK1P, L1P_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, ERR, F06, SCR, L1P, LINK1P, L1P_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LLOADC, NCORD, NGRAV, NGRID, NLOAD, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GRAV_PROC_BEGEND USE PARAMS, ONLY : SUPWARN USE CONSTANTS_1, ONLY : ZERO, ONE USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -46,7 +45,7 @@ SUBROUTINE GRAV_PROC CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG), PARAMETER :: ACID_0 = 0 ! Basic coord system - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GRAV_PROC_BEGEND + END SUBROUTINE GRAV_PROC diff --git a/Source/Interfaces/GRID_ELEM_CONN_TABLE_Interface.f90 b/Source/Interfaces/GRID_ELEM_CONN_TABLE_Interface.f90 index 87c94b08..a0af2a92 100644 --- a/Source/Interfaces/GRID_ELEM_CONN_TABLE_Interface.f90 +++ b/Source/Interfaces/GRID_ELEM_CONN_TABLE_Interface.f90 @@ -33,15 +33,14 @@ SUBROUTINE GRID_ELEM_CONN_TABLE USE PENTIUM_II_KIND, ONLY : BYTE, LONG USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_ELEM_DEGREE, NELE, NGRID - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : AGRID, ELGP, ETYPE, ESORT1, ESORT2, GRID_ID, GRID_ELEM_CONN_ARRAY USE PARAMS, ONLY : PRTCONN - USE SUBR_BEGEND_LEVELS, ONLY : GRID_ELEM_CONN_TABLE_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GRID_ELEM_CONN_TABLE_BEGEND + END SUBROUTINE GRID_ELEM_CONN_TABLE diff --git a/Source/Interfaces/GRID_PROC_Interface.f90 b/Source/Interfaces/GRID_PROC_Interface.f90 index d740fe87..006dfc01 100644 --- a/Source/Interfaces/GRID_PROC_Interface.f90 +++ b/Source/Interfaces/GRID_PROC_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE GRID_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : CONV_DEG_RAD - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1B, OP2, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1B, OP2, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, FATAL_ERR, MCORD, MRCORD, MGRID, MRGRID, NCORD, NGRID USE PARAMS, ONLY : PRTBASIC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GRID_PROC_BEGEND USE MODEL_STUF, ONLY : GRID, RGRID, GRID_ID, GRID_SEQ, CORD, RCORD, TN IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE GRID_PROC CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG) :: JFLD ! Used in error message to indicate a coord sys ID undefined - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GRID_PROC_BEGEND + END SUBROUTINE GRID_PROC diff --git a/Source/Interfaces/HEXA_Interface.f90 b/Source/Interfaces/HEXA_Interface.f90 index 384fdf7b..3a98c782 100644 --- a/Source/Interfaces/HEXA_Interface.f90 +++ b/Source/Interfaces/HEXA_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE HEXA ( OPT, INT_ELEM_ID,IORD, RED_INT_SHEAR, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MELDOF, MPLOAD4_3D_DATA, NPLOAD4_3D, NSUB, NTSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : QUARTER, HALF, ZERO, ONE, EIGHT USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : HEXA_BEGEND USE PARAMS, ONLY : EPSIL USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : AGRID, ALPVEC, BE1, BE2, DT, EID, ELGP, NUM_EMG_FATAL_ERRS, ES, KE, KED, ME, & @@ -55,7 +54,7 @@ SUBROUTINE HEXA ( OPT, INT_ELEM_ID,IORD, RED_INT_SHEAR, WRITE_WARN ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID INTEGER(LONG), INTENT(IN) :: IORD ! Gaussian integration order for element INTEGER(LONG) :: GAUSS_PT ! Gauss point number (used for DEBUG output in subr SHP3DH - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = HEXA_BEGEND + REAL(DOUBLE) :: CBAR(3,3*ELGP) ! Derivatives of shape fcns wrt x,y,z used in diff stiff matrix REAL(DOUBLE) :: DUM0(3*ELGP) ! Intermediate matrix used in solving for elem matrices diff --git a/Source/Interfaces/I4FLD_Interface.f90 b/Source/Interfaces/I4FLD_Interface.f90 index 5fa64a3f..0c49ce24 100644 --- a/Source/Interfaces/I4FLD_Interface.f90 +++ b/Source/Interfaces/I4FLD_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE I4FLD ( JCARDI, IFLD, I4INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR, JCARD_LEN, MAX_INTEGER_LEN IMPLICIT NONE diff --git a/Source/Interfaces/INDEP_FAILURE_INDEX_Interface.f90 b/Source/Interfaces/INDEP_FAILURE_INDEX_Interface.f90 index 6ecb7bf2..cc14bd6c 100644 --- a/Source/Interfaces/INDEP_FAILURE_INDEX_Interface.f90 +++ b/Source/Interfaces/INDEP_FAILURE_INDEX_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE INDEP_FAILURE_INDEX ( STREi, STRNi, STRE_ALLOWABLES, STRN_ALLOWABLES, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO @@ -40,11 +40,10 @@ SUBROUTINE INDEP_FAILURE_INDEX ( STREi, STRNi, STRE_ALLOWABLES, STRN_ALLOWABLES, USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : FAILURE_THEORY - USE SUBR_BEGEND_LEVELS, ONLY : INDEP_FAILURE_INDEX_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = INDEP_FAILURE_INDEX_BEGEND + REAL(DOUBLE), INTENT(IN) :: STRE_ALLOWABLES(9)! Allowable stresses (incl tension and compr for normal stresses) REAL(DOUBLE), INTENT(IN) :: STRN_ALLOWABLES(9)! Allowable strains (incl tension and compr for normal stresses) diff --git a/Source/Interfaces/INTERFACE_FORCE_LTM_Interface.f90 b/Source/Interfaces/INTERFACE_FORCE_LTM_Interface.f90 index e8277ce8..02ae6c83 100644 --- a/Source/Interfaces/INTERFACE_FORCE_LTM_Interface.f90 +++ b/Source/Interfaces/INTERFACE_FORCE_LTM_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE INTERFACE_FORCE_LTM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NTERM_KRRcb, NTERM_KRRcbn, NTERM_MRRcbn, NTERM_MRN , & NTERM_IF_LTM , NVEC USE PARAMS, ONLY : PRTIFLTM, SPARSTOR @@ -46,11 +46,10 @@ SUBROUTINE INTERFACE_FORCE_LTM USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1 - USE SUBR_BEGEND_LEVELS, ONLY : INTERFACE_FORCE_LTM_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = INTERFACE_FORCE_LTM_BEGEND + END SUBROUTINE INTERFACE_FORCE_LTM diff --git a/Source/Interfaces/INVERT_EIGENS_Interface.f90 b/Source/Interfaces/INVERT_EIGENS_Interface.f90 index 3e296751..f7378a44 100644 --- a/Source/Interfaces/INVERT_EIGENS_Interface.f90 +++ b/Source/Interfaces/INVERT_EIGENS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE INVERT_EIGENS ( MLAM, N, W, Z, EIG_NUM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : INVERT_EIGENS_BEGEND USE CONSTANTS_1, ONLY : ONE USE MACHINE_PARAMS, ONLY : MACH_SFMIN, MACH_LARGE_NUM USE MODEL_STUF, ONLY : EIG_SIGMA @@ -47,7 +46,7 @@ SUBROUTINE INVERT_EIGENS ( MLAM, N, W, Z, EIG_NUM ) INTEGER(LONG), INTENT(IN) :: N ! Size of eigenvectors. INTEGER(LONG), INTENT(INOUT) :: EIG_NUM(MLAM) ! Eigenvector numbers. INTEGER(LONG) :: PM,QM ! Indices used in reording the W and Z - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = INVERT_EIGENS_BEGEND + REAL(DOUBLE) , INTENT(INOUT) :: W(MLAM) ! Eigenvalues REAL(DOUBLE) , INTENT(INOUT) :: Z(N,NVEC) ! Eigenvectors diff --git a/Source/Interfaces/INVERT_FF_MAT_Interface.f90 b/Source/Interfaces/INVERT_FF_MAT_Interface.f90 index 5bb23a88..908e4b8d 100644 --- a/Source/Interfaces/INVERT_FF_MAT_Interface.f90 +++ b/Source/Interfaces/INVERT_FF_MAT_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE INVERT_FF_MAT ( CALLING_SUBR, MAT_A_NAME, A, NROWS, INFO ) USE PENTIUM_II_KIND, ONLY : DOUBLE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : INVERT_FF_MAT_BEGEND USE LAPACK_SYM_MAT_INV IMPLICIT NONE @@ -45,7 +44,6 @@ SUBROUTINE INVERT_FF_MAT ( CALLING_SUBR, MAT_A_NAME, A, NROWS, INFO ) INTEGER(LONG) , INTENT(IN) :: NROWS ! Row/col size of input matrix A INTEGER(LONG) , INTENT(OUT) :: INFO ! Output from LAPACK routines to do factorization of Lapack band matrix - INTEGER(LONG) , PARAMETER :: SUBR_BEGEND = INVERT_FF_MAT_BEGEND REAL(DOUBLE) , INTENT(INOUT) :: A(NROWS,NROWS) ! Matrix to invert. Inverted matrix returned in A diff --git a/Source/Interfaces/IP6CHK_Interface.f90 b/Source/Interfaces/IP6CHK_Interface.f90 index 33d4c0ac..f3865031 100644 --- a/Source/Interfaces/IP6CHK_Interface.f90 +++ b/Source/Interfaces/IP6CHK_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE IP6CHK ( JCARDI, JCARDO, IP6TYP, TOTAL_NUM_DIGITS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : IP6CHK_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE IP6CHK ( JCARDI, JCARDO, IP6TYP, TOTAL_NUM_DIGITS ) CHARACTER(LEN(JCARDI)), INTENT(OUT) :: JCARDO ! Output 8 character field, described above INTEGER(LONG), INTENT(OUT) :: TOTAL_NUM_DIGITS ! Total of NUM_DIGITS(I) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = IP6CHK_BEGEND + END SUBROUTINE IP6CHK diff --git a/Source/Interfaces/JAC2D_Interface.f90 b/Source/Interfaces/JAC2D_Interface.f90 index 32e1e088..950d5836 100644 --- a/Source/Interfaces/JAC2D_Interface.f90 +++ b/Source/Interfaces/JAC2D_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE JAC2D ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, MEFE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : JACOBIAN_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, FOUR USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : EID, EMG_IFE, EMG_RFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS, TYPE @@ -44,7 +43,7 @@ SUBROUTINE JAC2D ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) CHARACTER( 1*BYTE), INTENT(IN) :: WRT_BUG_THIS_TIME ! If 'Y' then write to BUG file if WRT_BUG array says to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = JACOBIAN_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! A Gauss point coord. REAL(DOUBLE) , INTENT(IN) :: SSJ ! A Gauss point coord. diff --git a/Source/Interfaces/JAC3D_Interface.f90 b/Source/Interfaces/JAC3D_Interface.f90 index d28270ad..06b60583 100644 --- a/Source/Interfaces/JAC3D_Interface.f90 +++ b/Source/Interfaces/JAC3D_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE JAC3D ( SSI, SSJ, SSK, DPSHG, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : JACOBIAN_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : EID, ELGP, NUM_EMG_FATAL_ERRS, TYPE, XEL @@ -45,7 +44,7 @@ SUBROUTINE JAC3D ( SSI, SSJ, SSK, DPSHG, WRT_BUG_THIS_TIME, JAC, JACI, DETJ ) CHARACTER( 1*BYTE), INTENT(IN) :: WRT_BUG_THIS_TIME ! If 'Y' then write to BUG file if WRT_BUG array says to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = JACOBIAN_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! A Gauss point coord. REAL(DOUBLE) , INTENT(IN) :: SSJ ! A Gauss point coord. diff --git a/Source/Interfaces/KGG_SINGULARITY_PROC_Interface.f90 b/Source/Interfaces/KGG_SINGULARITY_PROC_Interface.f90 index 60fe1afc..ae2379ca 100644 --- a/Source/Interfaces/KGG_SINGULARITY_PROC_Interface.f90 +++ b/Source/Interfaces/KGG_SINGULARITY_PROC_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE KGG_SINGULARITY_PROC ( AGRID, KGRD, NUM_ASPC_BY_COMP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SPC + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SPC USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFSA, NGRID, NUM_PCHD_SPC1 USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : AUTOSPC, AUTOSPC_INFO, AUTOSPC_RAT, EPSIL, PCHSPC1, SPC1SID, SUPINFO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : KGG_SINGULARITY_PROC_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START, TDOFI, TSET USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : GRID_ID @@ -47,7 +46,7 @@ SUBROUTINE KGG_SINGULARITY_PROC ( AGRID, KGRD, NUM_ASPC_BY_COMP ) INTEGER(LONG), INTENT(IN) :: AGRID ! Actual grid ID for IGRID INTEGER(LONG), INTENT(INOUT) :: NUM_ASPC_BY_COMP(6)! The number of DOF's AUTOSPC'd for each displ component INTEGER(LONG) :: EIGENVAL_NUM(6) ! Array to hold the eigenvalue number used in finding a SINGLR_COMP - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = KGG_SINGULARITY_PROC_BEGEND + REAL(DOUBLE) , INTENT(IN) :: KGRD(6,6) ! 6x6 diagonal stiffness matrix for grid point AGRID REAL(DOUBLE) :: FAC ! Multipling factor used in an intermediate calc diff --git a/Source/Interfaces/KUSER1_Interface.f90 b/Source/Interfaces/KUSER1_Interface.f90 index 278f8449..1d8669a8 100644 --- a/Source/Interfaces/KUSER1_Interface.f90 +++ b/Source/Interfaces/KUSER1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE KUSER1 ( OPT, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : KUSER1_BEGEND USE MODEL_STUF, ONLY : TYPE IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE KUSER1 ( OPT, WRITE_WARN ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = KUSER1_BEGEND + END SUBROUTINE KUSER1 diff --git a/Source/Interfaces/LEFT_ADJ_BDFLD_Interface.f90 b/Source/Interfaces/LEFT_ADJ_BDFLD_Interface.f90 index b4078a9e..e6bc772c 100644 --- a/Source/Interfaces/LEFT_ADJ_BDFLD_Interface.f90 +++ b/Source/Interfaces/LEFT_ADJ_BDFLD_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE LEFT_ADJ_BDFLD ( CHR_FLD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LEFT_ADJ_BDFLD_BEGEND IMPLICIT NONE CHARACTER(LEN=JCARD_LEN), INTENT(INOUT):: CHR_FLD ! Char field to left adjust and return - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LEFT_ADJ_BDFLD_BEGEND + END SUBROUTINE LEFT_ADJ_BDFLD diff --git a/Source/Interfaces/LINK0_Interface.f90 b/Source/Interfaces/LINK0_Interface.f90 index ed1a7e3b..e12e0cdc 100644 --- a/Source/Interfaces/LINK0_Interface.f90 +++ b/Source/Interfaces/LINK0_Interface.f90 @@ -33,11 +33,11 @@ SUBROUTINE LINK0 USE PENTIUM_II_KIND, ONLY : BYTE, SHORT, LONG, SINGLE, DOUBLE, QUAD - USE IOUNT1, ONLY : MOU4, SC1, WRT_BUG, WRT_LOG - USE IOUNT1, ONLY : ANS, BUG, ERR, F06, F21, F22, F23, F24, F25, IN1, L1B, L1C, L1D, L1F, L1G, L1H, L1I, L1K, & + USE IOUNT1, ONLY : MOU4, SC1, WRT_BUG + USE IOUNT1, ONLY : BUG, ERR, F06, F21, F22, F23, F24, F25, IN1, L1B, L1C, L1D, L1F, L1G, L1H, L1I, L1K, & L1L, L1N, L1O, L1P, L1Q, L1S, L1T, L1U, L1V, L1W, L1X, L1Y, OP2, OU4, SEQ - USE IOUNT1, ONLY : ANSFIL, F04, F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, INFILE, LINK1B, LINK1C, LINK1D, & + USE IOUNT1, ONLY : F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, INFILE, LINK1B, LINK1C, LINK1D, & LINK1F, LINK1H, LINK1I, LINK1K, LINK1L, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1S, LINK1T, & LINK1U, LINK1V, LINK1W, LINK1X, LINK1Y, OP2FIL, OU4FIL, SEQFIL diff --git a/Source/Interfaces/LINK1_Interface.f90 b/Source/Interfaces/LINK1_Interface.f90 index 86efce9f..f7e277a3 100644 --- a/Source/Interfaces/LINK1_Interface.f90 +++ b/Source/Interfaces/LINK1_Interface.f90 @@ -33,9 +33,7 @@ SUBROUTINE LINK1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG - - USE IOUNT1, ONLY : ERR, F04, F06, F21, F22, F23, F24, L1C, L1F, L1I, L1G, L1J, L1P, L1S, L1U, L1W, SC1 + USE IOUNT1, ONLY : ERR, F06, F21, F22, F23, F24, L1C, L1F, L1I, L1G, L1J, L1P, L1S, L1U, L1W, SC1 USE IOUNT1, ONLY : F21FIL, F22FIL, F23FIL, F24FIL, LINK1C, LINK1F, LINK1I, LINK1G, LINK1J, LINK1P, LINK1S, & LINK1U, LINK1W diff --git a/Source/Interfaces/LINK1_RESTART_DATA_Interface.f90 b/Source/Interfaces/LINK1_RESTART_DATA_Interface.f90 index 7658d265..eb722f25 100644 --- a/Source/Interfaces/LINK1_RESTART_DATA_Interface.f90 +++ b/Source/Interfaces/LINK1_RESTART_DATA_Interface.f90 @@ -32,11 +32,11 @@ SUBROUTINE LINK1_RESTART_DATA USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06 , FILE_NAM_MAXLEN, & + USE IOUNT1, ONLY : ERR, F06 , FILE_NAM_MAXLEN, & L1B , L1G , L1K , L1Q , L1Y , & LINK1B , LINK1G , LINK1K , LINK1Q, LINK1Y , & L1B_MSG, L1G_MSG, L1K_MSG, L1Q_MSG, L1Y_MSG, & - L1BSTAT, L1GSTAT, L1KSTAT, L1YSTAT, WRT_LOG + L1BSTAT, L1GSTAT, L1KSTAT, L1YSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, MCORD, MRCORD, MGRID, MRGRID, NBAROFF, NCORD, & NCONM2, NEDAT, NELE, NGRID, NMATANGLE, NMATL, NPBAR, NPBEAM, NPDAT, NPELAS,NPROD, NPSHEL, & @@ -48,7 +48,6 @@ SUBROUTINE LINK1_RESTART_DATA MPCOMP_PLIES, MRPCOMP0, MRPCOMP_PLIES, MPUSERIN, MUSERIN_MAT_NAMES USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LINK1_RESTART_DATA_BEGEND USE PARAMS, ONLY : CBMIN3, CBMIN4, IORQ1M, IORQ1S, IORQ1B, IORQ2B, IORQ2T USE MODEL_STUF, ONLY : CORD, RCORD USE MODEL_STUF, ONLY : CONM2, RCONM2 @@ -61,7 +60,7 @@ SUBROUTINE LINK1_RESTART_DATA IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LINK1_RESTART_DATA_BEGEND + END SUBROUTINE LINK1_RESTART_DATA diff --git a/Source/Interfaces/LINK2_Interface.f90 b/Source/Interfaces/LINK2_Interface.f90 index ff011e72..127c776a 100644 --- a/Source/Interfaces/LINK2_Interface.f90 +++ b/Source/Interfaces/LINK2_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE LINK2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06, L1A, ERRSTAT, SC1 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06, L1A, ERRSTAT, SC1 USE IOUNT1, ONLY : L2G, L2H , L2I , L2O , L2P , L2Q USE IOUNT1, ONLY : LINK2G, LINK2H , LINK2I , LINK2O , LINK2P , LINK2Q USE IOUNT1, ONLY : L2G_MSG, L2H_MSG, L2I_MSG, L2O_MSG, L2P_MSG, L2Q_MSG diff --git a/Source/Interfaces/LINK3_Interface.f90 b/Source/Interfaces/LINK3_Interface.f90 index 9db56650..22e8b6fd 100644 --- a/Source/Interfaces/LINK3_Interface.f90 +++ b/Source/Interfaces/LINK3_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE LINK3 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06, L3A, SC1, LINK3A, L3A_MSG + USE IOUNT1, ONLY : WRT_BUG, ERR, F06, L3A, SC1, LINK3A, L3A_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, KLL_SDIA, LINKNO, MBUG, NDOFL, NSUB, & NTERM_KLL, NTERM_PL, RESTART, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC diff --git a/Source/Interfaces/LINK4_Interface.f90 b/Source/Interfaces/LINK4_Interface.f90 index ad78dd41..bd1ad425 100644 --- a/Source/Interfaces/LINK4_Interface.f90 +++ b/Source/Interfaces/LINK4_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE LINK4 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, ERRSTAT, F04, F06, L1M, L3A, SC1 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, ERRSTAT, F06, L1M, L3A, SC1 USE IOUNT1, ONLY : LINK1M, LINK2I, LINK3A, L1M_MSG, L3A_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, LINKNO, MBUG, NDOFL, & NTERM_KLL, NTERM_KLLD, NTERM_KLLDn, & diff --git a/Source/Interfaces/LINK5_Interface.f90 b/Source/Interfaces/LINK5_Interface.f90 index 70771282..a578ec5b 100644 --- a/Source/Interfaces/LINK5_Interface.f90 +++ b/Source/Interfaces/LINK5_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE LINK5 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, F04, F06, L1H, L2A, L2E, L2F, L3A, L5A, L5B, SC1 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06, L1H, L2A, L2E, L2F, L3A, L5A, L5B, SC1 USE IOUNT1, ONLY : LINK1H, LINK2A, LINK2E, LINK2F, LINK3A, LINK5A, LINK5B USE IOUNT1, ONLY : L1H_MSG, L2A_MSG, L2E_MSG, L2F_MSG, L3A_MSG, L5A_MSG, L5B_MSG USE IOUNT1, ONLY : ERRSTAT, L1HSTAT, L2ESTAT, L2FSTAT, L3ASTAT diff --git a/Source/Interfaces/LINK6_Interface.f90 b/Source/Interfaces/LINK6_Interface.f90 index 94f98c52..23134dc2 100644 --- a/Source/Interfaces/LINK6_Interface.f90 +++ b/Source/Interfaces/LINK6_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE LINK6 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, F04, F06, ERRSTAT, MOU4, SC1, & + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06, ERRSTAT, MOU4, SC1, & L2I , L2K , L2L , L2M , L2N , L3A ,OU4, & LINK2I , LINK2K , LINK2L , LINK2M , LINK2N , LINK3A ,OU4FIL, & L2I_MSG, L2K_MSG, L2L_MSG, L2M_MSG, L2N_MSG, L3A_MSG, & diff --git a/Source/Interfaces/LINK9S_Interface.f90 b/Source/Interfaces/LINK9S_Interface.f90 index 93b80d4b..ec458c30 100644 --- a/Source/Interfaces/LINK9S_Interface.f90 +++ b/Source/Interfaces/LINK9S_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE LINK9S USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, & + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, & L1D , L1G , L1K , L1Q , & LINK1D , LINK1G , LINK1K , LINK1Q , & L1D_MSG, L1G_MSG, L1K_MSG, L1Q_MSG, & @@ -49,7 +49,6 @@ SUBROUTINE LINK9S USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : CBMIN3, CBMIN4, IORQ1M, IORQ1S, IORQ1B, IORQ2B, IORQ2T - USE SUBR_BEGEND_LEVELS, ONLY : LINK9S_BEGEND USE MODEL_STUF, ONLY : BAROFF, BUSHOFF, EDAT, EOFF, EPNT, ESORT1, ESORT2, ETYPE, PLATEOFF, PLATETHICK, VVEC USE MODEL_STUF, ONLY : MATANGLE, MATL, RMATL, PBAR, RPBAR, PBEAM, RPBEAM, PBUSH, RPBUSH, PCOMP, RPCOMP, PELAS, & @@ -62,7 +61,7 @@ SUBROUTINE LINK9S ANY_GPFO_OUTPUT, ANY_ELFE_OUTPUT, ANY_ELFN_OUTPUT, ANY_STRE_OUTPUT IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LINK9S_BEGEND + END SUBROUTINE LINK9S diff --git a/Source/Interfaces/LINK9_Interface.f90 b/Source/Interfaces/LINK9_Interface.f90 index f56dfc66..65067da0 100644 --- a/Source/Interfaces/LINK9_Interface.f90 +++ b/Source/Interfaces/LINK9_Interface.f90 @@ -32,19 +32,19 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR - USE IOUNT1, ONLY : ANS, ERR, F04, F06, F25, L1E, L1M, L1R, L2A, L2B, L2C, L2D, L2I, L2J, L2R, L2S, & + USE IOUNT1, ONLY : ERR, F06, F25, L1E, L1M, L1R, L2A, L2B, L2C, L2D, L2I, L2J, L2R, L2S, & L5A, L5B, NEU, OT4, OU4, PCH, SC1 - USE IOUNT1, ONLY : ANSFIL, F06FIL, F25FIL, LINK1B, LINK1E, LINK1M, LINK1R, LINK2A, LINK2B, LINK2C, LINK2D, & + USE IOUNT1, ONLY : F06FIL, F25FIL, LINK1B, LINK1E, LINK1M, LINK1R, LINK2A, LINK2B, LINK2C, LINK2D, & LINK2I, LINK2J, LINK2R, LINK2S, LINK5A, LINK5B, MOT4 , MOU4 , NEUFIL, OT4FIL, OU4FIL, & PCHFIL USE IOUNT1, ONLY : L1ASTAT, L1ESTAT, L1MSTAT, L1RSTAT, L2ASTAT, L2BSTAT, L2CSTAT, L2ISTAT, L2JSTAT, L2RSTAT, & L2SSTAT, OT4STAT, OU4STAT, PCHSTAT - USE IOUNT1, ONLY : ANS_MSG, F25_MSG, L1E_MSG, L1M_MSG, L1R_MSG, L2A_MSG, L2B_MSG, L2C_MSG, L2D_MSG, L2I_MSG, & + USE IOUNT1, ONLY : F25_MSG, L1E_MSG, L1M_MSG, L1R_MSG, L2A_MSG, L2B_MSG, L2C_MSG, L2D_MSG, L2I_MSG, & L2J_MSG, L2R_MSG, L2S_MSG, L5A_MSG, L5B_MSG, NEU_MSG, PCH_MSG, & OT4_MSG, OU4_MSG, OT4_GRD_OTM, OT4_ELM_OTM, OU4_GRD_OTM, OU4_ELM_OTM @@ -65,7 +65,6 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) USE CC_OUTPUT_DESCRIBERS, ONLY : DISP_OUT USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LINK9_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, MPFOUT, POST, SUPINFO, SUPWARN, WTMASS USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -101,7 +100,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) INTEGER(LONG), INTENT(IN) :: LK9_PROC_NUM ! 2 if this is the LINK9 call for the linear buckling step of INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LINK9_BEGEND + 1 + END SUBROUTINE LINK9 diff --git a/Source/USE_IFs/FILERR_USE_IFs.f90 b/Source/Interfaces/LINK_MESSAGE_Interface.f90 similarity index 75% rename from Source/USE_IFs/FILERR_USE_IFs.f90 rename to Source/Interfaces/LINK_MESSAGE_Interface.f90 index 276d1d47..e940da70 100644 --- a/Source/USE_IFs/FILERR_USE_IFs.f90 +++ b/Source/Interfaces/LINK_MESSAGE_Interface.f90 @@ -1,3 +1,4 @@ +! ################################################################################################################################## ! Begin MIT license text. ! _______________________________________________________________________________________________________ @@ -22,11 +23,33 @@ ! _______________________________________________________________________________________________________ ! End MIT license text. + +MODULE LINK_MESSAGE_Interface - MODULE FILERR_USE_IFs + INTERFACE + -! USE Interface statements for all subroutines called by SUBROUTINE FILERR + SUBROUTINE LINK_MESSAGE(MODNAM) + + IMPLICIT NONE - USE OURTIM_Interface + CHARACTER(LEN=*), INTENT(IN) :: MODNAM ! Name to write to screen to describe module being run - END MODULE FILERR_USE_IFs + END SUBROUTINE LINK_MESSAGE + + + SUBROUTINE LINK_MESSAGE_I(MODNAM, I) + + USE PENTIUM_II_KIND, ONLY : LONG + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: MODNAM ! Name to write to screen to describe module being run + INTEGER(LONG), INTENT(IN) :: I ! A number displayed after the string + + END SUBROUTINE LINK_MESSAGE_I + + + END INTERFACE + +END MODULE LINK_MESSAGE_Interface diff --git a/Source/Interfaces/LOADB0_Interface.f90 b/Source/Interfaces/LOADB0_Interface.f90 index 7fb60032..2d5746a6 100644 --- a/Source/Interfaces/LOADB0_Interface.f90 +++ b/Source/Interfaces/LOADB0_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE LOADB0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, FATAL_ERR, LCMASS, LDOFG, LELE, & LEDAT, LFORCE, LCONM2, LCORD, LGRAV, LGRID, LGUSERIN, LLOADC, LLOADR, & LMATL, LMPC, LMPCADDC, LMPCADDR, LPBAR, LPBEAM, LPBUSH, LPCOMP, LPCOMP_PLIES, LPDAT, & @@ -44,7 +44,6 @@ SUBROUTINE LOADB0 MPDAT_PLOAD2, MPDAT_PLOAD4, MEDAT_PLOTEL, MRBE3, MRSPLINE, MTDAT_TEMPRB, MTDAT_TEMPP1, & NPBARL, NSPOINT, PROG_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LOADB0_BEGEND USE MODEL_STUF, ONLY : GRDSET3, GRDSET7, GRDSET8 USE PARAMS, ONLY : GRIDSEQ @@ -54,7 +53,7 @@ SUBROUTINE LOADB0 INTEGER(LONG) :: NG_USERIN ! Number of grids found on USERIN elems (not incl SPOINT's) INTEGER(LONG) :: NS_USERIN ! Number of SPOINT's found on USERIN elems - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADB0_BEGEND + END SUBROUTINE LOADB0 diff --git a/Source/Interfaces/LOADB_Interface.f90 b/Source/Interfaces/LOADB_Interface.f90 index 09b1b420..44f9eae6 100644 --- a/Source/Interfaces/LOADB_Interface.f90 +++ b/Source/Interfaces/LOADB_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE LOADB USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, IMB_BLANK, JF, LIND_GRDS_MPCS, & LSUB, LLOADC, LMPCADDC, LSPCADDC, MDT, MTDAT_TEMPP1, MTDAT_TEMPRB, & MAX_GAUSS_POINTS, MAX_STRESS_POINTS, & @@ -45,7 +45,6 @@ SUBROUTINE LOADB USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : GRIDSEQ, IORQ1M, IORQ1S, IORQ1B, IORQ2B, IORQ2T, QUADAXIS, SUPINFO, SUPWARN USE OUTPUT4_MATRICES, ONLY : NUM_PARTN_REQUESTS - USE SUBR_BEGEND_LEVELS, ONLY : LOADB_BEGEND USE MODEL_STUF, ONLY : FORMOM_SIDS, GRAV_SIDS, IOR3D_MAX, LOAD_SIDS, & MPCSET, MPC_SIDS, MPCSIDS, MPCADD_SIDS, PBAR, RPCOMP, PRESS_SIDS, RFORCE_SIDS, & RPBAR, SLOAD_SIDS, SPC_SIDS, SPC1_SIDS, SPCADD_SIDS, SPCSET, CC_EIGR_SID, SCNUM, SUBLOD @@ -59,7 +58,7 @@ SUBROUTINE LOADB INTEGER(LONG) :: NG ! Actual num grids on CUSERIN (not incl SPOINT's) INTEGER(LONG) :: NS ! Actual num SPOINT'ss on CUSERIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADB_BEGEND + END SUBROUTINE LOADB diff --git a/Source/Interfaces/LOADB_RESTART_Interface.f90 b/Source/Interfaces/LOADB_RESTART_Interface.f90 index a15717c3..1965b027 100644 --- a/Source/Interfaces/LOADB_RESTART_Interface.f90 +++ b/Source/Interfaces/LOADB_RESTART_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE LOADB_RESTART USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, JCARD_LEN, JF, PROG_NAME, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : LOADB_RESTART_BEGEND IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE LOADB_RESTART CHARACTER( 7*BYTE), PARAMETER :: END_CARD = 'ENDDATA' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADB_RESTART_BEGEND + END SUBROUTINE LOADB_RESTART diff --git a/Source/Interfaces/LOADC0_Interface.f90 b/Source/Interfaces/LOADC0_Interface.f90 index c38c61e0..348f5bdb 100644 --- a/Source/Interfaces/LOADC0_Interface.f90 +++ b/Source/Interfaces/LOADC0_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE LOADC0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : ERR, F06, IN1 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, FATAL_ERR, LSETS, LSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LOADC0_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADC0_BEGEND + END SUBROUTINE LOADC0 diff --git a/Source/Interfaces/LOADC_Interface.f90 b/Source/Interfaces/LOADC_Interface.f90 index 9b67add8..586e8335 100644 --- a/Source/Interfaces/LOADC_Interface.f90 +++ b/Source/Interfaces/LOADC_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE LOADC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUGOUT, ERR, F04, F06, IN1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUGOUT, ERR, F06, IN1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, ENFORCED, FATAL_ERR, WARN_ERR, NSUB, NTSUB, PROG_NAME, & RESTART, SOL_NAME USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : LOADC_BEGEND USE MODEL_STUF, ONLY : CC_EIGR_SID, MEFFMASS_CALC, MPCSET, MPCSETS, MPFACTOR_CALC, SCNUM, SPCSET, SPCSETS, SUBLOD USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC @@ -45,7 +44,7 @@ SUBROUTINE LOADC CHARACTER(10*BYTE), PARAMETER :: END_CARD = 'BEGIN BULK' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADC_BEGEND + END SUBROUTINE LOADC diff --git a/Source/Interfaces/LOADE0_Interface.f90 b/Source/Interfaces/LOADE0_Interface.f90 index 15b3c327..1f0f6a26 100644 --- a/Source/Interfaces/LOADE0_Interface.f90 +++ b/Source/Interfaces/LOADE0_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE LOADE0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, FILE_NAM_MAXLEN, IN0, IN1, INC, LEN_INPUT_FNAME, INFILE, & - LEN_RESTART_FNAME, LNUM_IN4_FILES, RESTART_FILNAM, SCR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, FILE_NAM_MAXLEN, IN0, IN1, INC, LEN_INPUT_FNAME, INFILE, & + LEN_RESTART_FNAME, LNUM_IN4_FILES, RESTART_FILNAM, SCR USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, FATAL_ERR, RESTART USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LOADE0_BEGEND IMPLICIT NONE CHARACTER( 4*BYTE), PARAMETER :: END_CARD = 'CEND' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADE0_BEGEND + END SUBROUTINE LOADE0 diff --git a/Source/Interfaces/LOADE_Interface.f90 b/Source/Interfaces/LOADE_Interface.f90 index 0a3950fd..ee891eef 100644 --- a/Source/Interfaces/LOADE_Interface.f90 +++ b/Source/Interfaces/LOADE_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE LOADE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, CHKPNT, FATAL_ERR, WARN_ERR, JCARD_LEN, JF, & PROG_NAME, SOL_NAME, RESTART USE TIMDAT, ONLY : TSEC @@ -42,14 +42,13 @@ SUBROUTINE LOADE USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES, ACT_OU4_OUTPUT_NAMES, ALLOW_OU4_MYSTRAN_NAMES, & ALLOW_OU4_OUTPUT_NAMES, OU4_PART_MAT_NAMES, OU4_PART_VEC_NAMES, NUM_OU4_VALID_NAMES - USE SUBR_BEGEND_LEVELS, ONLY : LOADE_BEGEND IMPLICIT NONE CHARACTER(LEN=JCARD_LEN) :: CHARFLD ! Character field used when suvr I4FLD is called CHARACTER( 4*BYTE), PARAMETER :: END_CARD = 'CEND' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADE_BEGEND + END SUBROUTINE LOADE diff --git a/Source/Interfaces/MATADD_FFF_Interface.f90 b/Source/Interfaces/MATADD_FFF_Interface.f90 index 72e536c5..4d1d456e 100644 --- a/Source/Interfaces/MATADD_FFF_Interface.f90 +++ b/Source/Interfaces/MATADD_FFF_Interface.f90 @@ -32,20 +32,19 @@ SUBROUTINE MATADD_FFF ( A, B, NROW, NCOL, ALPHA, BETA, ITRNSPB, C) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : MATADD_FFF_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: NROW ! Number of rows in matrces A, B, C INTEGER(LONG), INTENT(IN) :: NCOL ! Number of cols in matrces A, B, C INTEGER(LONG), INTENT(IN) :: ITRNSPB ! Transpose indicator for matrix B - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATADD_FFF_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NROW,NCOL) ! Input matrix A REAL(DOUBLE) , INTENT(IN) :: B(NROW,NCOL) ! Input matrix B diff --git a/Source/Interfaces/MATADD_SSS_Interface.f90 b/Source/Interfaces/MATADD_SSS_Interface.f90 index b4e6b3f4..81abd46f 100644 --- a/Source/Interfaces/MATADD_SSS_Interface.f90 +++ b/Source/Interfaces/MATADD_SSS_Interface.f90 @@ -28,25 +28,20 @@ MODULE MATADD_SSS_Interface INTERFACE - SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, MAT_B_NAME, NTERM_B, I_B, J_B, B, BETA, & - + SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, & + MAT_B_NAME, NTERM_B, I_B, J_B, B, BETA, & MAT_C_NAME, NTERM_C, I_C, J_C, C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE CONSTANTS_1, ONLY : ZERO - USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SPARSE_ALG_ARRAYS, ONLY : LOGICAL_VEC, REAL_VEC - USE SUBR_BEGEND_LEVELS, ONLY : MATADD_SSS_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: MAT_A_NAME ! Name of matrix A CHARACTER(LEN=*), INTENT(IN) :: MAT_B_NAME ! Name of matrix B CHARACTER(LEN=*), INTENT(IN) :: MAT_C_NAME ! Name of matrix C - CHARACTER( 2*BYTE) :: ALG ! Which algorithm is used in solving for the terms in a row of C INTEGER(LONG), INTENT(IN ) :: NROWS ! Number of rows in input matrices A and B INTEGER(LONG), INTENT(IN ) :: NTERM_A ! Number of nonzero terms in input matrix A @@ -58,7 +53,7 @@ SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, MAT_B_NA INTEGER(LONG), INTENT(IN ) :: J_B(NTERM_B) ! Col no's for nonzero terms in matrix B INTEGER(LONG), INTENT(OUT) :: I_C(NROWS+1) ! I_C(I+1) - I_C(I) = no. terms in row I of matrix C INTEGER(LONG), INTENT(OUT) :: J_C(NTERM_C) ! Col no's for nonzero terms in matrix C - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATADD_SSS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero terms in matrix A REAL(DOUBLE) , INTENT(IN ) :: B(NTERM_B) ! Nonzero terms in matrix B diff --git a/Source/Interfaces/MATADD_SSS_NTERM_Interface.f90 b/Source/Interfaces/MATADD_SSS_NTERM_Interface.f90 index 1124a55d..7658dd9f 100644 --- a/Source/Interfaces/MATADD_SSS_NTERM_Interface.f90 +++ b/Source/Interfaces/MATADD_SSS_NTERM_Interface.f90 @@ -28,18 +28,14 @@ MODULE MATADD_SSS_NTERM_Interface INTERFACE - SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, MAT_B_NAME, NTERM_B, I_B, J_B, SYM_B, & - + SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, & + MAT_B_NAME, NTERM_B, I_B, J_B, SYM_B, & MAT_C_NAME, NTERM_C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, WARN_ERR + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 + USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE PARAMS, ONLY : SUPWARN - USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SPARSE_ALG_ARRAYS, ONLY : LOGICAL_VEC - USE SUBR_BEGEND_LEVELS, ONLY : MATADD_SSS_NTERM_BEGEND IMPLICIT NONE @@ -48,7 +44,6 @@ SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, MAT_B CHARACTER(LEN=*), INTENT(IN) :: MAT_C_NAME ! Name of matrix C CHARACTER(LEN=*), INTENT(IN) :: SYM_A ! Flag for whether matrix A is stored sym (terms on and above diag) CHARACTER(LEN=*), INTENT(IN) :: SYM_B ! Flag for whether matrix B is stored sym (terms on and above diag) - CHARACTER( 2*BYTE) :: ALG ! Which algorithm is used in solving for the terms in a row of C INTEGER(LONG), INTENT(IN ) :: NROWS ! Number of rows in input matrices A and B INTEGER(LONG), INTENT(IN ) :: NTERM_A ! Number of nonzero terms in input matrix A @@ -58,7 +53,7 @@ SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, MAT_B INTEGER(LONG), INTENT(IN ) :: J_A(NTERM_A) ! Col no's for nonzero terms in matrix A INTEGER(LONG), INTENT(IN ) :: J_B(NTERM_B) ! Col no's for nonzero terms in matrix B INTEGER(LONG), INTENT(OUT) :: NTERM_C ! Number of nonzero terms in output matrix C - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATADD_SSS_NTERM_BEGEND + END SUBROUTINE MATADD_SSS_NTERM diff --git a/Source/Interfaces/MATERIAL_PROPS_2D_Interface.f90 b/Source/Interfaces/MATERIAL_PROPS_2D_Interface.f90 index 12969a87..1dfb9386 100644 --- a/Source/Interfaces/MATERIAL_PROPS_2D_Interface.f90 +++ b/Source/Interfaces/MATERIAL_PROPS_2D_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE MATERIAL_PROPS_2D ( WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, MEFE, MEMATC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATERIAL_PROPS_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, QUAD4TYP USE MODEL_STUF, ONLY : ALPVEC, EID, EMG_IFE, EMG_RFE, ERR_SUB_NAM, EB, EBM, EM, ET, NUM_EMG_FATAL_ERRS, EMAT, & @@ -46,7 +45,7 @@ SUBROUTINE MATERIAL_PROPS_2D ( WRITE_WARN ) CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATERIAL_PROPS_BEGEND + END SUBROUTINE MATERIAL_PROPS_2D diff --git a/Source/Interfaces/MATERIAL_PROPS_3D_Interface.f90 b/Source/Interfaces/MATERIAL_PROPS_3D_Interface.f90 index f28d3a6f..96dd12ac 100644 --- a/Source/Interfaces/MATERIAL_PROPS_3D_Interface.f90 +++ b/Source/Interfaces/MATERIAL_PROPS_3D_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE MATERIAL_PROPS_3D ( WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATERIAL_PROPS_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : ALPVEC, EID, ES, EMAT, NUM_EMG_FATAL_ERRS, MTRL_TYPE, RHO, ULT_STRE, ULT_STRN, TREF, TYPE @@ -44,7 +43,7 @@ SUBROUTINE MATERIAL_PROPS_3D ( WRITE_WARN ) CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATERIAL_PROPS_BEGEND + END SUBROUTINE MATERIAL_PROPS_3D diff --git a/Source/Interfaces/MATGET_Interface.f90 b/Source/Interfaces/MATGET_Interface.f90 index d89addef..1e8c41a9 100644 --- a/Source/Interfaces/MATGET_Interface.f90 +++ b/Source/Interfaces/MATGET_Interface.f90 @@ -32,11 +32,9 @@ SUBROUTINE MATGET ( A, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, B ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATGET_BEGEND IMPLICIT NONE @@ -46,7 +44,7 @@ SUBROUTINE MATGET ( A, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, B ) INTEGER(LONG), INTENT(IN) :: NROWA ! Number of rows in input matrix INTEGER(LONG), INTENT(IN) :: NCOL ! No. of cols to get from input matrix INTEGER(LONG), INTENT(IN) :: NROW ! No. of rows to get from input matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATGET_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NROWA*NCOLA) ! Input matrix from which a partition will be extracted REAL(DOUBLE) , INTENT(OUT) :: B(NROW*NCOL) ! Output matrix, which is the partition extracted from A diff --git a/Source/Interfaces/MATL_TRANSFORM_MATRIX_Interface.f90 b/Source/Interfaces/MATL_TRANSFORM_MATRIX_Interface.f90 index 0c0586e0..6efe82dc 100644 --- a/Source/Interfaces/MATL_TRANSFORM_MATRIX_Interface.f90 +++ b/Source/Interfaces/MATL_TRANSFORM_MATRIX_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE MATL_TRANSFORM_MATRIX ( T21, TS ) USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATL_TRANSFORM_MATRIX_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATL_TRANSFORM_MATRIX_BEGEND + REAL(DOUBLE), INTENT(IN) :: T21(3,3) ! 3x3 matrix that transforms a vector in coord sys 1 to coord sys 2 REAL(DOUBLE), INTENT(OUT) :: TS(6,6) ! 6x6 stress transformation matrix diff --git a/Source/Interfaces/MATMULT_FFF_Interface.f90 b/Source/Interfaces/MATMULT_FFF_Interface.f90 index 2fa819d6..548f9909 100644 --- a/Source/Interfaces/MATMULT_FFF_Interface.f90 +++ b/Source/Interfaces/MATMULT_FFF_Interface.f90 @@ -32,18 +32,16 @@ SUBROUTINE MATMULT_FFF ( A, B, NROWA, NCOLA, NCOLB, C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_FFF_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: NROWA ! No. rows in input matrix A INTEGER(LONG), INTENT(IN) :: NCOLA ! No. cols in input matrix A INTEGER(LONG), INTENT(IN) :: NCOLB ! No. cols in input matrix B - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_FFF_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NROWA,NCOLA) ! Input matrix A REAL(DOUBLE) , INTENT(IN) :: B(NCOLA,NCOLB) ! Input matrix B diff --git a/Source/Interfaces/MATMULT_FFF_T_Interface.f90 b/Source/Interfaces/MATMULT_FFF_T_Interface.f90 index 5e124922..b6c46359 100644 --- a/Source/Interfaces/MATMULT_FFF_T_Interface.f90 +++ b/Source/Interfaces/MATMULT_FFF_T_Interface.f90 @@ -32,18 +32,16 @@ SUBROUTINE MATMULT_FFF_T ( A, B, NROWA, NCOLA, NCOLB, C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_FFF_T_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: NROWA ! No. rows in input matrix A (NOT A') INTEGER(LONG), INTENT(IN) :: NCOLA ! No. cols in input matrix A (NOT A') INTEGER(LONG), INTENT(IN) :: NCOLB ! No. cols in input matrix B - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_FFF_T_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NROWA,NCOLA) ! Input matrix A REAL(DOUBLE) , INTENT(IN) :: B(NROWA,NCOLB) ! Input matrix B diff --git a/Source/Interfaces/MATMULT_SFF_Interface.f90 b/Source/Interfaces/MATMULT_SFF_Interface.f90 index 92915345..c762c347 100644 --- a/Source/Interfaces/MATMULT_SFF_Interface.f90 +++ b/Source/Interfaces/MATMULT_SFF_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE MATMULT_SFF ( MAT_A_NAME, NROWS_A, NCOLS_A, NTERM_A, SYM_A, I_A, J_A, WRITE_SC1, MAT_C_NAME, CONS, C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SFF_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -58,7 +57,7 @@ SUBROUTINE MATMULT_SFF ( MAT_A_NAME, NROWS_A, NCOLS_A, NTERM_A, SYM_A, I_A, J_A, INTEGER(LONG), INTENT(IN ) :: NTERM_A ! Number of nonzero terms in input matrix A INTEGER(LONG), INTENT(IN ) :: I_A(NROWS_A+1) ! I_A(I+1) - I_A(I) = num nonzeros in row I of matrix A (CRS) INTEGER(LONG), INTENT(IN ) :: J_A(NTERM_A) ! Col no's for nonzero terms in matrix A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SFF_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero values in matrix A REAL(DOUBLE) , INTENT(IN ) :: B(NROWS_B,NCOLS_B)! Real values in matrix B diff --git a/Source/Interfaces/MATMULT_SFS_Interface.f90 b/Source/Interfaces/MATMULT_SFS_Interface.f90 index 15da05df..c1f71dc0 100644 --- a/Source/Interfaces/MATMULT_SFS_Interface.f90 +++ b/Source/Interfaces/MATMULT_SFS_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE MATMULT_SFS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, MAT_B_ AROW_MAX_TERMS, MAT_C_NAME, CONS, NTERM_C, I_C, J_C, C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SFS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -58,7 +57,7 @@ SUBROUTINE MATMULT_SFS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, MAT_B_ INTEGER(LONG), INTENT(IN ) :: J_A(NTERM_A) ! Col no's for nonzero terms in matrix A INTEGER(LONG), INTENT(OUT) :: I_C(NROW_A+1) ! I_C(I+1) - I_C(I) = num nonzeros in row I of matrix C (CRS) INTEGER(LONG), INTENT(OUT) :: J_C(NTERM_C) ! Col no's for nonzero terms in matrix C - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SFS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: CONS ! Constant multiplier in cons*A*B to get C REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero values in matrix A diff --git a/Source/Interfaces/MATMULT_SFS_NTERM_Interface.f90 b/Source/Interfaces/MATMULT_SFS_NTERM_Interface.f90 index f9de2fb1..33d1c7a6 100644 --- a/Source/Interfaces/MATMULT_SFS_NTERM_Interface.f90 +++ b/Source/Interfaces/MATMULT_SFS_NTERM_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE MATMULT_SFS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, MAT AROW_MAX_TERMS, MAT_C_NAME, NTERM_C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SFS_NTERM_BEGEND USE PARAMS, ONLY : EPSIL USE SPARSE_ALG_ARRAYS, ONLY : J_AROW USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -56,7 +55,7 @@ SUBROUTINE MATMULT_SFS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, MAT INTEGER(LONG), INTENT(IN ) :: J_A(NTERM_A) ! Col no's for nonzero terms in matrix A INTEGER(LONG), INTENT(OUT) :: AROW_MAX_TERMS ! Max number of terms in any row of A INTEGER(LONG), INTENT(OUT) :: NTERM_C ! Number of nonzero terms in output matrix C - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SFS_NTERM_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: B(NROW_B,NCOL_B) ! Real values in matrix B diff --git a/Source/Interfaces/MATMULT_SSS_Interface.f90 b/Source/Interfaces/MATMULT_SSS_Interface.f90 index c33b1687..5370fe49 100644 --- a/Source/Interfaces/MATMULT_SSS_Interface.f90 +++ b/Source/Interfaces/MATMULT_SSS_Interface.f90 @@ -34,11 +34,10 @@ SUBROUTINE MATMULT_SSS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, NTERM_C, I_C, J_C, C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SSS_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -61,7 +60,7 @@ SUBROUTINE MATMULT_SSS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, INTEGER(LONG), INTENT(IN ) :: I_B(NTERM_B) ! Row no's for nonzero terms in matrix B INTEGER(LONG), INTENT(OUT) :: I_C(NROW_A+1) ! I_C(I+1) - I_C(I) = num nonzeros in row I of matrix C (CRS format) INTEGER(LONG), INTENT(OUT) :: J_C(NTERM_C) ! Col no's for nonzero terms in matrix C - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SSS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: CONS ! Constant multiplier in cons*A*B to get C REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero values in matrix A diff --git a/Source/Interfaces/MATMULT_SSS_NTERM_Interface.f90 b/Source/Interfaces/MATMULT_SSS_NTERM_Interface.f90 index 862be833..71274130 100644 --- a/Source/Interfaces/MATMULT_SSS_NTERM_Interface.f90 +++ b/Source/Interfaces/MATMULT_SSS_NTERM_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE MATMULT_SSS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, MAT_B_NAME, NCOL_B, NTERM_B, SYM_B, J_B, I_B, AROW_MAX_TERMS, MAT_C_NAME, NTERM_C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SSS_NTERM_BEGEND USE SPARSE_ALG_ARRAYS, ONLY : J_AROW USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -58,7 +57,7 @@ SUBROUTINE MATMULT_SSS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, INTEGER(LONG), INTENT(IN ) :: I_B(NTERM_B) ! Row no's for nonzero terms in matrix B INTEGER(LONG), INTENT(OUT) :: AROW_MAX_TERMS ! Max number of terms in any row of A INTEGER(LONG), INTENT(OUT) :: NTERM_C ! Number of nonzero terms in output matrix C - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SSS_NTERM_BEGEND + END SUBROUTINE MATMULT_SSS_NTERM diff --git a/Source/Interfaces/MATPUT_Interface.f90 b/Source/Interfaces/MATPUT_Interface.f90 index f5ffc06e..a06b69ae 100644 --- a/Source/Interfaces/MATPUT_Interface.f90 +++ b/Source/Interfaces/MATPUT_Interface.f90 @@ -32,10 +32,8 @@ SUBROUTINE MATPUT ( B, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, A ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATPUT_BEGEND IMPLICIT NONE @@ -45,7 +43,7 @@ SUBROUTINE MATPUT ( B, NROWA, NCOLA, BEG_ROW, BEG_COL, NROW, NCOL, A ) INTEGER(LONG), INTENT(IN) :: NROWA ! Number of rows in input matrix INTEGER(LONG), INTENT(IN) :: NCOL ! No. of cols to get from input matrix INTEGER(LONG), INTENT(IN) :: NROW ! No. of rows to get from input matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATPUT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: B(NROW*NCOL) ! Input matrix that will be put into A REAL(DOUBLE) , INTENT(INOUT) :: A(NROWA*NCOLA) ! Output matrix, containing inserted terms from B diff --git a/Source/Interfaces/MATTRNSP_SS_Interface.f90 b/Source/Interfaces/MATTRNSP_SS_Interface.f90 index e95c103a..d0058745 100644 --- a/Source/Interfaces/MATTRNSP_SS_Interface.f90 +++ b/Source/Interfaces/MATTRNSP_SS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE MATTRNSP_SS ( NROWA, NCOLA, NTERM, MAT_A_NAME, I_A, J_A, A, MAT_AT_NA USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATTRNSP_SS_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE MATTRNSP_SS ( NROWA, NCOLA, NTERM, MAT_A_NAME, I_A, J_A, A, MAT_AT_NA INTEGER(LONG), INTENT(IN) :: J_A(NTERM) ! Col numbers for nonzero terms in A INTEGER(LONG), INTENT(OUT) :: I_AT(NCOLA+1) ! I_AT(I+1) - I_AT(I) are the num of nonzeros in AT row I INTEGER(LONG), INTENT(OUT) :: J_AT(NTERM) ! Col numbers for nonzero terms in AT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATTRNSP_SS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NTERM) ! Real nonzero values in input matrix A REAL(DOUBLE) , INTENT(OUT) :: AT(NTERM) ! Real nonzero values in output matrix AT diff --git a/Source/Interfaces/MAXREQ_OGEL_Interface.f90 b/Source/Interfaces/MAXREQ_OGEL_Interface.f90 index baba87a7..84e248ad 100644 --- a/Source/Interfaces/MAXREQ_OGEL_Interface.f90 +++ b/Source/Interfaces/MAXREQ_OGEL_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE MAXREQ_OGEL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IBIT, LSUB, NDOFG, NELE, NGRID, METYPE, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MAXREQ_OGEL_BEGEND USE MODEL_STUF, ONLY : ELMTYP, ELOUT, ESORT2, ETYPE, GROUT, MEFFMASS_CALC, MPFACTOR_CALC, NELGP, NUM_PLIES, & PCOMP_PROPS, SCNUM, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC @@ -45,7 +44,7 @@ SUBROUTINE MAXREQ_OGEL IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MAXREQ_OGEL_BEGEND + END SUBROUTINE MAXREQ_OGEL diff --git a/Source/Interfaces/MERGE_COL_VECS_Interface.f90 b/Source/Interfaces/MERGE_COL_VECS_Interface.f90 index ec55bc02..ec888177 100644 --- a/Source/Interfaces/MERGE_COL_VECS_Interface.f90 +++ b/Source/Interfaces/MERGE_COL_VECS_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE MERGE_COL_VECS ( IN1_COL, IN1_NDOF, UIN1, IN2_COL, IN2_NDOF, UIN2 & ,OUT_COL, OUT_NDOF, UOUT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_COL_VECS_BEGEND USE DOF_TABLES, ONLY : TDOFI IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE MERGE_COL_VECS ( IN1_COL, IN1_NDOF, UIN1, IN2_COL, IN2_NDOF, UIN2 & INTEGER(LONG), INTENT(IN ) :: IN1_NDOF ! Size of array UIN1 INTEGER(LONG), INTENT(IN ) :: IN2_NDOF ! Size of array UIN2 INTEGER(LONG), INTENT(IN ) :: OUT_NDOF ! Size of array UOUT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_COL_VECS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: UIN1(IN1_NDOF) ! Input vector for IN1_COL displ set REAL(DOUBLE) , INTENT(IN ) :: UIN2(IN2_NDOF) ! Input vector for IN2_COL displ set diff --git a/Source/Interfaces/MERGE_KXX_Interface.f90 b/Source/Interfaces/MERGE_KXX_Interface.f90 index 7bdb00b7..ff97792b 100644 --- a/Source/Interfaces/MERGE_KXX_Interface.f90 +++ b/Source/Interfaces/MERGE_KXX_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE MERGE_KXX USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFR, NTERM_KRRcb, NTERM_KXX , NVEC USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : PRTKXX USE EIGEN_MATRICES_1, ONLY : GEN_MASS, EIGEN_VAL USE SPARSE_MATRICES , ONLY : I_KRRcb, J_KRRcb, KRRcb, I_KXX , J_KXX , KXX - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_KXX_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_KXX_BEGEND + END SUBROUTINE MERGE_KXX diff --git a/Source/Interfaces/MERGE_LTM_Interface.f90 b/Source/Interfaces/MERGE_LTM_Interface.f90 index 95340df6..44504ca9 100644 --- a/Source/Interfaces/MERGE_LTM_Interface.f90 +++ b/Source/Interfaces/MERGE_LTM_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE MERGE_LTM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NTERM_CG_LTM, NTERM_IF_LTM, NTERM_LTM, NUM_CB_DOFS USE TIMDAT, ONLY : TSEC USE SPARSE_MATRICES, ONLY : I_CG_LTM, J_CG_LTM, CG_LTM, I_IF_LTM, J_IF_LTM, IF_LTM, I_LTM, J_LTM, LTM - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_LTM_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_LTM_BEGEND + END SUBROUTINE MERGE_LTM diff --git a/Source/Interfaces/MERGE_MAT_COLS_SSS_Interface.f90 b/Source/Interfaces/MERGE_MAT_COLS_SSS_Interface.f90 index c3dddf1a..639d5e1f 100644 --- a/Source/Interfaces/MERGE_MAT_COLS_SSS_Interface.f90 +++ b/Source/Interfaces/MERGE_MAT_COLS_SSS_Interface.f90 @@ -34,12 +34,11 @@ SUBROUTINE MERGE_MAT_COLS_SSS ( MAT_A_NAME, NTERM_A, I_A, J_A, A, SYM_A, NCOL_A, MAT_C_NAME, I_C, J_C, C, SYM_C ) USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_MAT_COLS_SSS_BEGEND IMPLICIT NONE @@ -59,7 +58,6 @@ SUBROUTINE MERGE_MAT_COLS_SSS ( MAT_A_NAME, NTERM_A, I_A, J_A, A, SYM_A, NCOL_A, INTEGER(LONG) , INTENT(IN) :: J_B(NTERM_B) ! Col no's for nonzero terms in matrix B INTEGER(LONG) , INTENT(OUT) :: I_C(NROWS+1) ! I_C(I+1) - I_C(I) = no. terms in row I of matrix C INTEGER(LONG) , INTENT(OUT) :: J_C(NTERM_A+NTERM_B) ! Col no's for nonzero terms in matrix C - INTEGER(LONG) , PARAMETER :: SUBR_BEGEND = MERGE_MAT_COLS_SSS_BEGEND REAL(DOUBLE) , INTENT(IN) :: A(NTERM_A) ! Nonzero terms in matrix A REAL(DOUBLE) , INTENT(IN) :: B(NTERM_B) ! Nonzero terms in matrix B diff --git a/Source/Interfaces/MERGE_MAT_ROWS_SSS_Interface.f90 b/Source/Interfaces/MERGE_MAT_ROWS_SSS_Interface.f90 index fc9acea4..d48da553 100644 --- a/Source/Interfaces/MERGE_MAT_ROWS_SSS_Interface.f90 +++ b/Source/Interfaces/MERGE_MAT_ROWS_SSS_Interface.f90 @@ -34,13 +34,12 @@ SUBROUTINE MERGE_MAT_ROWS_SSS ( MAT_A_NAME, NROW_A, NTERM_A, I_A, J_A, A, MERGE_ MAT_C_NAME, I_C, J_C, C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE SPARSE_ALG_ARRAYS, ONLY : LOGICAL_VEC, REAL_VEC - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_MAT_ROWS_SSS_BEGEND IMPLICIT NONE @@ -61,7 +60,7 @@ SUBROUTINE MERGE_MAT_ROWS_SSS ( MAT_A_NAME, NROW_A, NTERM_A, I_A, J_A, A, MERGE_ INTEGER(LONG), INTENT(IN ) :: MERGE_VEC_VALS_B ! Values in MERGE_VEC corresponding to rows in matrix B INTEGER(LONG), INTENT(OUT) :: I_C(NROW_A+NROW_B+1) ! I_C(I+1) - I_C(I) = no. terms in row I of matrix C INTEGER(LONG), INTENT(OUT) :: J_C(NTERM_A+NTERM_B) ! Col no's for nonzero terms in matrix C - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_MAT_ROWS_SSS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero terms in matrix A REAL(DOUBLE) , INTENT(IN ) :: B(NTERM_B) ! Nonzero terms in matrix B diff --git a/Source/Interfaces/MERGE_MXX_Interface.f90 b/Source/Interfaces/MERGE_MXX_Interface.f90 index 811b6936..dec57c57 100644 --- a/Source/Interfaces/MERGE_MXX_Interface.f90 +++ b/Source/Interfaces/MERGE_MXX_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE MERGE_MXX USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NVEC, NTERM_MRRcb, NTERM_MRRcbn, NTERM_MRN, NTERM_MXX, & NTERM_MXXn USE TIMDAT, ONLY : TSEC @@ -41,11 +41,10 @@ SUBROUTINE MERGE_MXX USE SPARSE_MATRICES, ONLY : SYM_MRRcbn, SYM_MRN , SYM_MXX , SYM_MXXn USE SPARSE_MATRICES, ONLY : I_MRRcb, J_MRRcb, MRRcb, I_MRRcbn, J_MRRcbn, MRRcbn, I_MRN , J_MRN , MRN , & I_MXX , J_MXX , MXX , I_MXXn , J_MXXn , MXXn - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_MXX_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_MXX_BEGEND + END SUBROUTINE MERGE_MXX diff --git a/Source/Interfaces/MERGE_PHIXA_Interface.f90 b/Source/Interfaces/MERGE_PHIXA_Interface.f90 index 04e25362..2c37c4db 100644 --- a/Source/Interfaces/MERGE_PHIXA_Interface.f90 +++ b/Source/Interfaces/MERGE_PHIXA_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE MERGE_PHIXA ( PART_VEC_A_LR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFR, NVEC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE EIGEN_MATRICES_1, ONLY : EIGEN_VEC USE SPARSE_MATRICES, ONLY : I_DLR , J_DLR , DLR , I_IRR , J_IRR , IRR , I_PHIXA, J_PHIXA, PHIXA - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_PHIXA_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: PART_VEC_A_LR(NDOFA)! Partitioning vector (N set into F and S sets) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_PHIXA_BEGEND + END SUBROUTINE MERGE_PHIXA diff --git a/Source/Interfaces/MGGC_MASS_MATRIX_Interface.f90 b/Source/Interfaces/MGGC_MASS_MATRIX_Interface.f90 index 2fd77d60..369d27fb 100644 --- a/Source/Interfaces/MGGC_MASS_MATRIX_Interface.f90 +++ b/Source/Interfaces/MGGC_MASS_MATRIX_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE MGGC_MASS_MATRIX USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : NGRID, NTERM_MGGC, BLNK_SUB_NAM USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SPARSTOR, WTMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MGGC_MASS_MATRIX_BEGEND USE MODEL_STUF, ONLY : AGRID, GRID_ID, INV_GRID_SEQ USE SPARSE_MATRICES, ONLY : I_MGGC, J_MGGC, MGGC @@ -46,7 +45,7 @@ SUBROUTINE MGGC_MASS_MATRIX CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG) :: KSTART ! Used in deciding whether to process all elem mass terms or only - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MGGC_MASS_MATRIX_BEGEND + END SUBROUTINE MGGC_MASS_MATRIX diff --git a/Source/Interfaces/MGGS_MASS_MATRIX_Interface.f90 b/Source/Interfaces/MGGS_MASS_MATRIX_Interface.f90 index 2f543f55..da4051a2 100644 --- a/Source/Interfaces/MGGS_MASS_MATRIX_Interface.f90 +++ b/Source/Interfaces/MGGS_MASS_MATRIX_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE MGGS_MASS_MATRIX USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, NCMASS, NDOFG, NGRID, NPMASS, NTERM_MGGS, BLNK_SUB_NAM USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -41,11 +41,10 @@ SUBROUTINE MGGS_MASS_MATRIX USE DOF_TABLES, ONLY : TDOF USE MODEL_STUF, ONLY : CMASS, GRID_ID, PMASS, RPMASS USE SPARSE_MATRICES, ONLY : I_MGGS, J_MGGS, MGGS - USE SUBR_BEGEND_LEVELS, ONLY : MGGS_MASS_MATRIX_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MGGS_MASS_MATRIX_BEGEND + END SUBROUTINE MGGS_MASS_MATRIX diff --git a/Source/Interfaces/MIN4SH_Interface.f90 b/Source/Interfaces/MIN4SH_Interface.f90 index da543aed..57245b58 100644 --- a/Source/Interfaces/MIN4SH_Interface.f90 +++ b/Source/Interfaces/MIN4SH_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE MIN4SH ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, NXSH, NYSH, DNXSHG, D USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, F06, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, F06, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MIN4SH_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, EIGHT IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE MIN4SH ( SSI, SSJ, XSD, YSD, WRT_BUG_THIS_TIME, NXSH, NYSH, DNXSHG, D CHARACTER(17*BYTE) :: NAME(2) ! Used for BUG output annotation CHARACTER( 1*BYTE), INTENT(IN) :: WRT_BUG_THIS_TIME ! If 'Y' then write to BUG file if WRT_BUG array says to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MIN4SH_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point coordinate REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point coordinate diff --git a/Source/Interfaces/MPC_PROC_Interface.f90 b/Source/Interfaces/MPC_PROC_Interface.f90 index 6a7730a8..634214f8 100644 --- a/Source/Interfaces/MPC_PROC_Interface.f90 +++ b/Source/Interfaces/MPC_PROC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE MPC_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1J, L1S, LINK1S, L1S_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1J, L1S, LINK1S, L1S_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LMPCADDC, NGRID, NMPC, NMPCADD, NUM_MPCSIDS, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MPC_PROC_BEGEND USE MODEL_STUF, ONLY : GRID_ID, MPCSET, MPCSIDS USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -44,7 +43,7 @@ SUBROUTINE MPC_PROC CHARACTER( 1*BYTE) :: MPC_SET_USED ! 'Y'/'N' indicator if an MPC set in B.D. is used - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MPC_PROC_BEGEND + END SUBROUTINE MPC_PROC diff --git a/Source/Interfaces/MYSTRAN_FILES_Interface.f90 b/Source/Interfaces/MYSTRAN_FILES_Interface.f90 index 6289ad20..27a8e358 100644 --- a/Source/Interfaces/MYSTRAN_FILES_Interface.f90 +++ b/Source/Interfaces/MYSTRAN_FILES_Interface.f90 @@ -33,12 +33,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, MOT4, MOU4, WRT_BUG, WRT_ERR, WRT_LOG, LEN_INPUT_FNAME, & + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, MOT4, MOU4, WRT_BUG, WRT_ERR, LEN_INPUT_FNAME, & LEN_RESTART_FNAME, RESTART_FILNAM USE IOUNT1, ONLY : OU4_EXT, OT4_EXT - USE IOUNT1, ONLY : ANS, BUG, EIN, ENF, ERR, F04, F06, IN0, PCH, SC1, & + USE IOUNT1, ONLY : BUG, EIN, ENF, ERR, F06, IN0, PCH, SC1, & SEQ, SPC, & L1A, L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, & L1K, L1L, L1M, L1N, L1O, L1P, L1Q, L1R, L1S, L1T, & @@ -48,7 +48,7 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START L3A, L4A, L4B, L4C, L4D, L5A, L5B, & NEU, F21, F22, F23, F24, F25, OP2, OT4, OU4 - USE IOUNT1, ONLY : ANSFIL, BUGFIL, EINFIL, ENFFIL, ERRFIL, F04FIL, F06FIL, IN0FIL, INFILE, PCHFIL, & + USE IOUNT1, ONLY : BUGFIL, EINFIL, ENFFIL, ERRFIL, F06FIL, IN0FIL, INFILE, PCHFIL, & OT4FIL, SEQFIL, SPCFIL, & LINK1A, LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, & LINK1K, LINK1L, LINK1M, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1R, LINK1S, LINK1T, & @@ -58,7 +58,7 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START LINK3A, LINK4A, LINK4B, LINK4C, LINK4D, LINK5A, LINK5B, & NEUFIL, F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, OP2FIL, OT4FIL, OU4FIL - USE IOUNT1, ONLY : ANS_MSG, BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F04_MSG, F06_MSG, IN0_MSG, OT4_MSG, PCH_MSG, & + USE IOUNT1, ONLY : BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F06_MSG, IN0_MSG, OT4_MSG, PCH_MSG, & SEQ_MSG, L1A_MSG, L1B_MSG, L1C_MSG, L1D_MSG, L1E_MSG, L1F_MSG, L1G_MSG, L1H_MSG, L1I_MSG, & L1J_MSG, L1K_MSG, L1L_MSG, L1M_MSG, L1N_MSG, L1O_MSG, L1P_MSG, L1Q_MSG, L1R_MSG, L1S_MSG, & L1T_MSG, L1U_MSG, L1V_MSG, L1W_MSG, L1X_MSG, L1Y_MSG, L1Z_MSG, & @@ -69,11 +69,10 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START USE SCONTR, ONLY : BLNK_SUB_NAM, RESTART USE TIMDAT, ONLY : TSEC, stime - USE SUBR_BEGEND_LEVELS, ONLY : MYSTRAN_FILES_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MYSTRAN_FILES_BEGEND + INTEGER(LONG), INTENT(IN) :: START_HOUR ! The hour when MYSTRAN started. INTEGER(LONG), INTENT(IN) :: START_MINUTE ! The minute when MYSTRAN started. INTEGER(LONG), INTENT(IN) :: START_SEC ! The second when MYSTRAN started. diff --git a/Source/Interfaces/NET_CG_LOADS_LTM_Interface.f90 b/Source/Interfaces/NET_CG_LOADS_LTM_Interface.f90 index 33b96937..fe5244b6 100644 --- a/Source/Interfaces/NET_CG_LOADS_LTM_Interface.f90 +++ b/Source/Interfaces/NET_CG_LOADS_LTM_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE NET_CG_LOADS_LTM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NTERM_MRRcbn, NTERM_MRN, NTERM_CG_LTM, NUM_CB_DOFS USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE @@ -46,11 +46,10 @@ SUBROUTINE NET_CG_LOADS_LTM USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CCS1, J_CCS1, CCS1 - USE SUBR_BEGEND_LEVELS, ONLY : NET_CG_LOADS_LTM_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NET_CG_LOADS_LTM_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/NEXTC0_Interface.f90 b/Source/Interfaces/NEXTC0_Interface.f90 index 9a7d4978..d3ea40db 100644 --- a/Source/Interfaces/NEXTC0_Interface.f90 +++ b/Source/Interfaces/NEXTC0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE NEXTC0 ( CARD, ICONT, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1, INFILE + USE IOUNT1, ONLY : ERR, F06, IN1, INFILE USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : NEXTC0_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE NEXTC0 ( CARD, ICONT, IERR ) INTEGER(LONG), INTENT(OUT) :: ICONT ! =1 if next card is current card's continuation or =0 if not INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator from subr FFIELD, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NEXTC0_BEGEND + END SUBROUTINE NEXTC0 diff --git a/Source/Interfaces/NEXTC20_Interface.f90 b/Source/Interfaces/NEXTC20_Interface.f90 index 7ca1e72c..00ef3527 100644 --- a/Source/Interfaces/NEXTC20_Interface.f90 +++ b/Source/Interfaces/NEXTC20_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE NEXTC20 ( PARENT, ICONT, IERR, CHILD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1, INFILE + USE IOUNT1, ONLY : ERR, F06, IN1, INFILE USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : NEXTC20_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE NEXTC20 ( PARENT, ICONT, IERR, CHILD ) INTEGER(LONG), INTENT(OUT) :: ICONT ! =1 if next card is current card's continuation or =0 if not INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator from subr FFIELD, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NEXTC20_BEGEND + END SUBROUTINE NEXTC20 diff --git a/Source/Interfaces/NEXTC2_Interface.f90 b/Source/Interfaces/NEXTC2_Interface.f90 index 76c5772e..0d1a3b8a 100644 --- a/Source/Interfaces/NEXTC2_Interface.f90 +++ b/Source/Interfaces/NEXTC2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE NEXTC2 ( PARENT, ICONT, IERR, CHILD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1, INFILE + USE IOUNT1, ONLY : ERR, F06, IN1, INFILE USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : NEXTC2_BEGEND IMPLICIT NONE @@ -45,7 +44,7 @@ SUBROUTINE NEXTC2 ( PARENT, ICONT, IERR, CHILD ) INTEGER(LONG), INTENT(OUT) :: ICONT ! =1 if next card is current card's continuation or =0 if not INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator from subr FFIELD, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NEXTC2_BEGEND + END SUBROUTINE NEXTC2 diff --git a/Source/Interfaces/NEXTC_Interface.f90 b/Source/Interfaces/NEXTC_Interface.f90 index a5a139a7..88395d54 100644 --- a/Source/Interfaces/NEXTC_Interface.f90 +++ b/Source/Interfaces/NEXTC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE NEXTC ( CARD, ICONT, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1, INFILE + USE IOUNT1, ONLY : ERR, F06, IN1, INFILE USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : NEXTC_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE NEXTC ( CARD, ICONT, IERR ) INTEGER(LONG), INTENT(OUT) :: ICONT ! =1 if next card is current card's continuation or =0 if not INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator from subr FFIELD, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NEXTC_BEGEND + END SUBROUTINE NEXTC diff --git a/Source/Interfaces/OFP1_Interface.f90 b/Source/Interfaces/OFP1_Interface.f90 index 139fe04d..7a0b1123 100644 --- a/Source/Interfaces/OFP1_Interface.f90 +++ b/Source/Interfaces/OFP1_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, OT4 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OT4 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, GROUT_ACCE_BIT, GROUT_DISP_BIT, GROUT_OLOA_BIT, IBIT, INT_SC_NUM,& MELGP, MOGEL, NGRID, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP1_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : OTMSKIP, POST USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -59,7 +58,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N INTEGER(LONG), INTENT(INOUT) :: ITABLE ! LOGICAL, INTENT(INOUT) :: NEW_RESULT ! is this the first result of a table INTEGER(LONG) :: NREQ ! Number of user requested outputs of displ/force - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP1_BEGEND + END SUBROUTINE OFP1 diff --git a/Source/Interfaces/OFP2_Interface.f90 b/Source/Interfaces/OFP2_Interface.f90 index b72ef446..fc4c9ecd 100644 --- a/Source/Interfaces/OFP2_Interface.f90 +++ b/Source/Interfaces/OFP2_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, OT4 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OT4 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, GROUT_SPCF_BIT, GROUT_MPCF_BIT, GROUT_GPFO_BIT, IBIT, INT_SC_NUM,& MELGP, MOGEL, NGRID, NDOFF, NDOFG, NDOFM, NDOFN, NDOFS, NDOFSA, NTERM_GMN, & NTERM_HMN, NTERM_KFS, NTERM_KFSD, NTERM_LMN, NTERM_MFS, NTERM_QS, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP2_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START, TDOFI USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, GEN_MASS, MEFFMASS, MPFACTOR_N6 @@ -73,7 +72,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 INTEGER(LONG), INTENT(INOUT) :: ITABLE ! LOGICAL, INTENT(INOUT) :: NEW_RESULT ! is this the first result of a table INTEGER(LONG) :: NREQ ! Number of user requested outputs of displ/force - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP2_BEGEND + END SUBROUTINE OFP2 diff --git a/Source/Interfaces/OFP3_ELFE_1D_Interface.f90 b/Source/Interfaces/OFP3_ELFE_1D_Interface.f90 index 2383e702..caecc649 100644 --- a/Source/Interfaces/OFP3_ELFE_1D_Interface.f90 +++ b/Source/Interfaces/OFP3_ELFE_1D_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE OFP3_ELFE_1D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_ELFE_BIT, FATAL_ERR, IBIT, INT_SC_NUM, MBUG, MOGEL,& NELE, NCBAR, NCBUSH, NCELAS1, NCELAS2, NCELAS3, NCELAS4, NCROD, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_ELFE_1D_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS USE PARAMS, ONLY : OTMSKIP, POST @@ -53,7 +52,7 @@ SUBROUTINE OFP3_ELFE_1D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: ITE ! Unit number for text files for OTM row descriptors INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_ELFE_1D_BEGEND + END SUBROUTINE OFP3_ELFE_1D diff --git a/Source/Interfaces/OFP3_ELFE_2D_Interface.f90 b/Source/Interfaces/OFP3_ELFE_2D_Interface.f90 index 57008e4b..15ea1a53 100644 --- a/Source/Interfaces/OFP3_ELFE_2D_Interface.f90 +++ b/Source/Interfaces/OFP3_ELFE_2D_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE OFP3_ELFE_2D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_ELFE_BIT, FATAL_ERR, IBIT, INT_SC_NUM, MBUG, MOGEL, & WARN_ERR, NELE, NCQUAD4, NCQUAD4K, NCSHEAR, NCTRIA3, NCTRIA3K, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_ELFE_2D_BEGEND USE CONSTANTS_1, ONLY : ZERO USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS USE PARAMS, ONLY : OTMSKIP, POST @@ -55,7 +54,7 @@ SUBROUTINE OFP3_ELFE_2D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors integer(long) :: num_pcomp_elems ! number of elements that are composites (used to prevent output of engr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_ELFE_2D_BEGEND + END SUBROUTINE OFP3_ELFE_2D diff --git a/Source/Interfaces/OFP3_ELFN_Interface.f90 b/Source/Interfaces/OFP3_ELFN_Interface.f90 index c9b2a1d6..36ab2dda 100644 --- a/Source/Interfaces/OFP3_ELFN_Interface.f90 +++ b/Source/Interfaces/OFP3_ELFN_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE OFP3_ELFN ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_BUG, WRT_FIJ, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_FIJ, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_ELFN_BIT, ELDT_BUG_U_P_BIT, ELDT_F25_U_P_BIT, FATAL_ERR,NELE, IBIT, & INT_SC_NUM, MBUG, MOGEL, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_ELFN_BEGEND USE PARAMS, ONLY : ELFORCEN, OTMSKIP USE MODEL_STUF, ONLY : EDAT, EPNT, ETYPE, AGRID, EID, ELDT, ELGP, ELMTYP, ELOUT, METYPE, NUM_EMG_FATAL_ERRS, & PEB, PEG, PEL, PLY_NUM, TYPE, SCNUM @@ -52,7 +51,7 @@ SUBROUTINE OFP3_ELFN ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: ITE ! Unit number for text files for OTM row descriptors INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_ELFN_BEGEND + END SUBROUTINE OFP3_ELFN diff --git a/Source/Interfaces/OFP3_Interface.f90 b/Source/Interfaces/OFP3_Interface.f90 index 7188f0e4..88bb781d 100644 --- a/Source/Interfaces/OFP3_Interface.f90 +++ b/Source/Interfaces/OFP3_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE OFP3 ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_FIJ, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_FIJ USE SCONTR, ONLY : BLNK_SUB_NAM, MFIJ, MOGEL USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : ANY_ELFE_OUTPUT, ANY_ELFN_OUTPUT, ANY_STRE_OUTPUT, ANY_STRN_OUTPUT USE LINK9_STUFF, ONLY : MAXREQ, OGEL - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_BEGEND IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE OFP3 ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors INTEGER(LONG), PARAMETER :: MERROR = 6 ! Number of error indicators used - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_BEGEND + END SUBROUTINE OFP3 diff --git a/Source/Interfaces/OFP3_STRE_NO_PCOMP_Interface.f90 b/Source/Interfaces/OFP3_STRE_NO_PCOMP_Interface.f90 index 6e0120fb..4a182fdf 100644 --- a/Source/Interfaces/OFP3_STRE_NO_PCOMP_Interface.f90 +++ b/Source/Interfaces/OFP3_STRE_NO_PCOMP_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE OFP3_STRE_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_STRE_BIT, FATAL_ERR, IBIT, INT_SC_NUM, & MAX_STRESS_POINTS, MBUG, MOGEL, & NELE, NCBAR, NCBUSH, NCELAS1, NCELAS2, NCELAS3, NCELAS4, NCHEXA8, NCHEXA20, NCPENTA6, & NCPENTA15,NCTETRA4, NCTETRA10, NCQUAD4, NCQUAD4K, NCROD, NCSHEAR, NCTRIA3, NCTRIA3K, & SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_STRE_NO_PCOMP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS USE PARAMS, ONLY : OTMSKIP, POST @@ -58,7 +57,7 @@ SUBROUTINE OFP3_STRE_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors INTEGER(LONG) :: NDUM ! Value initialized to zero and used in call to CALC_ELEM_STRESSES - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_STRE_NO_PCOMP_BEGEND + ! Array of %errs from subr POLYNOM_FIT_STRE_STRN (only NUM_PTS vals used) diff --git a/Source/Interfaces/OFP3_STRE_PCOMP_Interface.f90 b/Source/Interfaces/OFP3_STRE_PCOMP_Interface.f90 index b5701832..fff5deda 100644 --- a/Source/Interfaces/OFP3_STRE_PCOMP_Interface.f90 +++ b/Source/Interfaces/OFP3_STRE_PCOMP_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE OFP3_STRE_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_STRE_BIT, FATAL_ERR, IBIT, INT_SC_NUM, MBUG, MOGEL, & NELE, NCQUAD4, NCSHEAR, NCTRIA3, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_STRE_PCOMP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS USE PARAMS, ONLY : OTMSKIP, POST @@ -53,7 +52,7 @@ SUBROUTINE OFP3_STRE_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: ITE ! Unit number for text files for OTM row descriptors INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_STRE_PCOMP_BEGEND + END SUBROUTINE OFP3_STRE_PCOMP diff --git a/Source/Interfaces/OFP3_STRN_NO_PCOMP_Interface.f90 b/Source/Interfaces/OFP3_STRN_NO_PCOMP_Interface.f90 index feecc06f..3b79c660 100644 --- a/Source/Interfaces/OFP3_STRN_NO_PCOMP_Interface.f90 +++ b/Source/Interfaces/OFP3_STRN_NO_PCOMP_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE OFP3_STRN_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_STRN_BIT, FATAL_ERR, IBIT, INT_SC_NUM, & MAX_STRESS_POINTS, MBUG, MOGEL, & NELE, NCBUSH, NCHEXA8, NCHEXA20, NCPENTA6, NCPENTA15, NCTETRA4, NCTETRA10, NCQUAD4, & NCQUAD4K, NCSHEAR, NCTRIA3, NCTRIA3K, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_STRN_NO_PCOMP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS USE PARAMS, ONLY : OTMSKIP, POST @@ -56,7 +55,7 @@ SUBROUTINE OFP3_STRN_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: ITE ! Unit number for text files for OTM row descriptors INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_STRN_NO_PCOMP_BEGEND + ! Array of %errs from subr POLYNOM_FIT_STRE_STRN (only NUM_PTS vals used) diff --git a/Source/Interfaces/OFP3_STRN_PCOMP_Interface.f90 b/Source/Interfaces/OFP3_STRN_PCOMP_Interface.f90 index 72aadf96..f9aaf495 100644 --- a/Source/Interfaces/OFP3_STRN_PCOMP_Interface.f90 +++ b/Source/Interfaces/OFP3_STRN_PCOMP_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE OFP3_STRN_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_STRN_BIT, FATAL_ERR, IBIT, INT_SC_NUM, MBUG, MOGEL, & NELE, NCQUAD4, NCSHEAR, NCTRIA3, SOL_NAME, WARN_ERR, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_STRN_PCOMP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS USE PARAMS, ONLY : OTMSKIP, POST @@ -53,7 +52,7 @@ SUBROUTINE OFP3_STRN_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: ITE ! Unit number for text files for OTM row descriptors INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_STRN_PCOMP_BEGEND + END SUBROUTINE OFP3_STRN_PCOMP diff --git a/Source/Interfaces/ONE_D_STRAIN_OUTPUTS_Interface.f90 b/Source/Interfaces/ONE_D_STRAIN_OUTPUTS_Interface.f90 index 91ccbb90..3fe3c5bf 100644 --- a/Source/Interfaces/ONE_D_STRAIN_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/ONE_D_STRAIN_OUTPUTS_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE ONE_D_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO @@ -40,7 +40,6 @@ SUBROUTINE ONE_D_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE LINK9_STUFF, ONLY : MSPRNT, OGEL USE FEMAP_ARRAYS, ONLY : FEMAP_EL_VECS USE PARAMS, ONLY : PRTNEU - USE SUBR_BEGEND_LEVELS, ONLY : ONE_D_STRAIN_OUTPUTS_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE ONE_D_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: SIZE_ALLOCATED ! No. of rows allocated to array that will be written to INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ONE_D_STRAIN_OUTPUTS_BEGEND + END SUBROUTINE ONE_D_STRAIN_OUTPUTS diff --git a/Source/Interfaces/ONE_D_STRESS_OUTPUTS_Interface.f90 b/Source/Interfaces/ONE_D_STRESS_OUTPUTS_Interface.f90 index 6abd44f4..27b3da26 100644 --- a/Source/Interfaces/ONE_D_STRESS_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/ONE_D_STRESS_OUTPUTS_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE ONE_D_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO @@ -40,7 +40,6 @@ SUBROUTINE ONE_D_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE LINK9_STUFF, ONLY : MSPRNT, OGEL USE FEMAP_ARRAYS, ONLY : FEMAP_EL_VECS USE PARAMS, ONLY : PRTNEU - USE SUBR_BEGEND_LEVELS, ONLY : ONE_D_STRESS_OUTPUTS_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE ONE_D_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: SIZE_ALLOCATED ! No. of rows allocated to array that will be written to INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ONE_D_STRESS_OUTPUTS_BEGEND + END SUBROUTINE ONE_D_STRESS_OUTPUTS diff --git a/Source/Interfaces/OPEN_OUTFILES_Interface.f90 b/Source/Interfaces/OPEN_OUTFILES_Interface.f90 index 2324737a..e209238e 100644 --- a/Source/Interfaces/OPEN_OUTFILES_Interface.f90 +++ b/Source/Interfaces/OPEN_OUTFILES_Interface.f90 @@ -32,9 +32,9 @@ SUBROUTINE OPEN_OUTFILES USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG , ERR , F04 , F06 , SC1, BUGOUT, FILE_NAM_MAXLEN, & - BUGFIL , ERRFIL , F04FIL , F06FIL , & - BUG_MSG, ERR_MSG, F04_MSG, F06_MSG + USE IOUNT1, ONLY : BUG , ERR , F06 , SC1, BUGOUT, FILE_NAM_MAXLEN, & + BUGFIL , ERRFIL , F06FIL , & + BUG_MSG, ERR_MSG, F06_MSG USE TIMDAT, ONLY : STIME, TSEC IMPLICIT NONE diff --git a/Source/Interfaces/OPNERR_Interface.f90 b/Source/Interfaces/OPNERR_Interface.f90 index 45a0bce4..183b0e34 100644 --- a/Source/Interfaces/OPNERR_Interface.f90 +++ b/Source/Interfaces/OPNERR_Interface.f90 @@ -28,23 +28,19 @@ MODULE OPNERR_Interface INTERFACE - SUBROUTINE OPNERR ( IOCHK, FILNAM, OUNT, WRITE_F04 ) + SUBROUTINE OPNERR ( IOCHK, FILNAM, OUNT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F04FIL - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, RESTART - USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OPNERR_BEGEND + USE SCONTR, ONLY : FATAL_ERR, RESTART IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: FILNAM ! File name - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG), INTENT(IN) :: IOCHK ! IOSTAT error number when opening/reading a file INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OPNERR_BEGEND + END SUBROUTINE OPNERR diff --git a/Source/Interfaces/ORDER_GAUSS_Interface.f90 b/Source/Interfaces/ORDER_GAUSS_Interface.f90 index 39bb76f0..5197ee9c 100644 --- a/Source/Interfaces/ORDER_GAUSS_Interface.f90 +++ b/Source/Interfaces/ORDER_GAUSS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ORDER_GAUSS ( KORDER, SSS, HHH ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MEFE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ORDER_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO USE CONSTANTS_GAUSS, ONLY : HHV, SSV USE MODEL_STUF, ONLY : EMG_IFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS @@ -43,7 +42,7 @@ SUBROUTINE ORDER_GAUSS ( KORDER, SSS, HHH ) IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: KORDER ! Gaussian integration order to use - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ORDER_BEGEND + REAL(DOUBLE) ,INTENT(OUT) :: SSS(MAX_ORDER_GAUSS) ! Gauss abscissa's REAL(DOUBLE) ,INTENT(OUT) :: HHH(MAX_ORDER_GAUSS) ! Gauss weight coeffs diff --git a/Source/Interfaces/ORDER_TETRA_Interface.f90 b/Source/Interfaces/ORDER_TETRA_Interface.f90 index ddd765ca..a36a1685 100644 --- a/Source/Interfaces/ORDER_TETRA_Interface.f90 +++ b/Source/Interfaces/ORDER_TETRA_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE ORDER_TETRA ( KORDER, SSS_I, SSS_J, SSS_K, HHH_IJK ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_TETRA USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ORDER_BEGEND USE CONSTANTS_1, ONLY : ZERO, SIXTH, QUARTER, HALF, ONE, TWO, TWELVE IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: KORDER ! Triangular integration order to use - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ORDER_BEGEND + REAL(DOUBLE) , INTENT(OUT) :: SSS_I (MAX_ORDER_TETRA) ! Gauss abscissa's REAL(DOUBLE) , INTENT(OUT) :: SSS_J (MAX_ORDER_TETRA) ! Gauss abscissa's diff --git a/Source/Interfaces/ORDER_TRIA_Interface.f90 b/Source/Interfaces/ORDER_TRIA_Interface.f90 index 69c8736f..8c39faad 100644 --- a/Source/Interfaces/ORDER_TRIA_Interface.f90 +++ b/Source/Interfaces/ORDER_TRIA_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE ORDER_TRIA ( KORDER, SS_I, SS_J, HH_IJ ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_TRIA USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ORDER_BEGEND USE CONSTANTS_1, ONLY : ZERO, SIXTH, THIRD, HALF, TWO IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: KORDER ! Triangular integration order to use - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ORDER_BEGEND + REAL(DOUBLE) ,INTENT(OUT) :: SS_I(MAX_ORDER_TRIA) ! Triangular integration abscissa's REAL(DOUBLE) ,INTENT(OUT) :: SS_J(MAX_ORDER_TRIA) ! Triangular integration abscissa's diff --git a/Source/Interfaces/OU4_PARTVEC_PROC_Interface.f90 b/Source/Interfaces/OU4_PARTVEC_PROC_Interface.f90 index 007c77a6..2cb44261 100644 --- a/Source/Interfaces/OU4_PARTVEC_PROC_Interface.f90 +++ b/Source/Interfaces/OU4_PARTVEC_PROC_Interface.f90 @@ -33,12 +33,11 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO VAL_ROWS, VAL_COLS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L1V, L1V_MSG, LINK1V + USE IOUNT1, ONLY : ERR, F06, L1V, L1V_MSG, LINK1V USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MTSET, NDOFG, NGRID, NUM_PARTVEC_RECORDS, WARN_ERR USE CONSTANTS_1, ONLY : ZERO, ONE, TWO USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : OU4_PARTVEC_PROC_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN, TDOF, TDOFI, TDOF_ROW_START USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES, OU4_PART_VEC_NAMES, OU4_PARTVEC_COL, OU4_PARTVEC_ROW, & OU4_MAT_ROW_GRD_COMP, OU4_MAT_COL_GRD_COMP @@ -69,7 +68,7 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO INTEGER(LONG), INTENT(OUT) :: VAL_COLS ! Number to enter into PARTVEC_COL for a col that is to be partitioned INTEGER(LONG), INTENT(OUT) :: VAL_ROWS ! Number to enter into PARTVEC_ROW for a row that is to be partitioned - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OU4_PARTVEC_PROC_BEGEND + END SUBROUTINE OU4_PARTVEC_PROC diff --git a/Source/Interfaces/OUTA_HERE_Interface.f90 b/Source/Interfaces/OUTA_HERE_Interface.f90 index 9f54e1ca..8097df81 100644 --- a/Source/Interfaces/OUTA_HERE_Interface.f90 +++ b/Source/Interfaces/OUTA_HERE_Interface.f90 @@ -33,20 +33,19 @@ SUBROUTINE OUTA_HERE ( WRITE_TO_L1A ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUGOUT, F04, F06FIL, SC1, WRT_LOG, & - BUGSTAT, BUGSTAT_OLD, ERRSTAT, ERRSTAT_OLD, F04STAT, F04STAT_OLD, & + USE IOUNT1, ONLY : BUGOUT, F06FIL, SC1, & + BUGSTAT, BUGSTAT_OLD, ERRSTAT, ERRSTAT_OLD, & OP2STAT, PCHSTAT, L1ASTAT USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : OUTA_HERE_BEGEND IMPLICIT NONE CHARACTER( 1*BYTE), INTENT(IN) :: WRITE_TO_L1A ! Y/N indicator of whether to call subr WRITE_L1A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OUTA_HERE_BEGEND + END SUBROUTINE OUTA_HERE diff --git a/Source/Interfaces/OUTPUT4_PROC_Interface.f90 b/Source/Interfaces/OUTPUT4_PROC_Interface.f90 index 8956bf5e..40cd470b 100644 --- a/Source/Interfaces/OUTPUT4_PROC_Interface.f90 +++ b/Source/Interfaces/OUTPUT4_PROC_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE OUTPUT4_PROC ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, MOU4, OU4, OU4_MSG, OU4FIL, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, MOU4, OU4, OU4_MSG, OU4FIL USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR , & NTERM_CG_LTM, NTERM_DLR , NTERM_IF_LTM, NTERM_KLL , & @@ -95,13 +95,12 @@ SUBROUTINE OUTPUT4_PROC ( CALLING_SUBR ) I_PA , J_PA , PA , I_PG , J_PG , PG , I_PL , J_PL , PL USE FULL_MATRICES, ONLY : PHIZG_FULL - USE SUBR_BEGEND_LEVELS, ONLY : OUTPUT4_PROC_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Subr that called this one - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OUTPUT4_PROC_BEGEND + END SUBROUTINE OUTPUT4_PROC diff --git a/Source/Interfaces/PARAM_CORDS_ACT_CORDS_Interface.f90 b/Source/Interfaces/PARAM_CORDS_ACT_CORDS_Interface.f90 index de9b1238..8f61dcfa 100644 --- a/Source/Interfaces/PARAM_CORDS_ACT_CORDS_Interface.f90 +++ b/Source/Interfaces/PARAM_CORDS_ACT_CORDS_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE PARAM_CORDS_ACT_CORDS ( NROW, IORD, XEP, XEA ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : TYPE, XEL - USE SUBR_BEGEND_LEVELS, ONLY : PARAM_CORDS_ACT_CORDS_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: IORD ! Gaussian integration order to be used in obtaining the PSH shape fcns INTEGER(LONG), INTENT(IN) :: NROW ! Number of rows in XEP, XEA - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARAM_CORDS_ACT_CORDS_BEGEND + REAL(DOUBLE), INTENT(IN) :: XEP(NROW,3) ! Parametric coords of NCOL points REAL(DOUBLE), INTENT(OUT) :: XEA(NROW,3) ! Actual local element coords corresponding to XEP diff --git a/Source/Interfaces/PARSE_CHAR_STRING_Interface.f90 b/Source/Interfaces/PARSE_CHAR_STRING_Interface.f90 index 8ace661e..56166fb1 100644 --- a/Source/Interfaces/PARSE_CHAR_STRING_Interface.f90 +++ b/Source/Interfaces/PARSE_CHAR_STRING_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE PARSE_CHAR_STRING ( CHAR_STRING, STRING_LEN, MAX_WORDS, MWLEN, NUM_WO USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, WARN_ERR USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS - USE SUBR_BEGEND_LEVELS, ONLY : PARSE_CHAR_STRING_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE PARSE_CHAR_STRING ( CHAR_STRING, STRING_LEN, MAX_WORDS, MWLEN, NUM_WO INTEGER(LONG), INTENT(IN) :: STRING_LEN ! Length, in characters, of CHAR_STRING INTEGER(LONG), INTENT(OUT) :: IERR ! Error designator INTEGER(LONG), INTENT(OUT) :: NUM_WORDS ! Number of distinct words in CHAR_STRING - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARSE_CHAR_STRING_BEGEND + END SUBROUTINE PARSE_CHAR_STRING diff --git a/Source/Interfaces/PARTITION_FF_Interface.f90 b/Source/Interfaces/PARTITION_FF_Interface.f90 index a8d9d7af..8e660ce1 100644 --- a/Source/Interfaces/PARTITION_FF_Interface.f90 +++ b/Source/Interfaces/PARTITION_FF_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE PARTITION_FF ( MAT_A_NAME, NROW_A, NCOL_A, A, ROW_PART_VEC, COL_PART_ MAT_B_NAME, NROW_B, NCOL_B, B ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : PARTITION_FF_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -52,7 +51,6 @@ SUBROUTINE PARTITION_FF ( MAT_A_NAME, NROW_A, NCOL_A, A, ROW_PART_VEC, COL_PART_ INTEGER(LONG) , INTENT(IN) :: VAL_COLS ! Value in COL_PART_VEC to look for for partitioning cols INTEGER(LONG) , INTENT(IN) :: NCOL_B ! No. cols in B INTEGER(LONG) , INTENT(IN) :: NROW_B ! No. rows in B - INTEGER(LONG) , PARAMETER :: SUBR_BEGEND = PARTITION_FF_BEGEND REAL(DOUBLE) , INTENT(IN ) :: A(NROW_A,NCOL_A) ! Input matrix diff --git a/Source/Interfaces/PARTITION_SS_Interface.f90 b/Source/Interfaces/PARTITION_SS_Interface.f90 index d5117e09..bf0754e7 100644 --- a/Source/Interfaces/PARTITION_SS_Interface.f90 +++ b/Source/Interfaces/PARTITION_SS_Interface.f90 @@ -34,11 +34,10 @@ SUBROUTINE PARTITION_SS ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, J_A, , MAT_B_NAME, NTERM_B, NROW_B, SYM_B, I_B, J_B, B ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : PARTITION_SS_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -64,7 +63,7 @@ SUBROUTINE PARTITION_SS ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, J_A, INTEGER(LONG), INTENT(IN ) :: VAL_COLS ! Value in COL_PART_VEC to look for for partitioning cols INTEGER(LONG), INTENT(OUT) :: I_B(NROW_B+1) ! Starting locations in B for each row INTEGER(LONG), INTENT(OUT) :: J_B(NTERM_B) ! Col number for each B output matrix term - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARTITION_SS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Input matrix nonzero terms REAL(DOUBLE) , INTENT(OUT) :: B(NTERM_B) ! Output matrix nonzero terms diff --git a/Source/Interfaces/PARTITION_SS_NTERM_Interface.f90 b/Source/Interfaces/PARTITION_SS_NTERM_Interface.f90 index 6085c006..c728453f 100644 --- a/Source/Interfaces/PARTITION_SS_NTERM_Interface.f90 +++ b/Source/Interfaces/PARTITION_SS_NTERM_Interface.f90 @@ -34,12 +34,11 @@ SUBROUTINE PARTITION_SS_NTERM ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, , MAT_B_NAME, NTERM_B, SYM_B ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE SPARSE_ALG_ARRAYS, ONLY : ALG, J_AROW USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : PARTITION_SS_NTERM_BEGEND IMPLICIT NONE @@ -61,7 +60,7 @@ SUBROUTINE PARTITION_SS_NTERM ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, INTEGER(LONG), INTENT(IN ) :: COL_PART_VEC(NCOL_A) ! Col partitioning vector (1's and 2's) INTEGER(LONG), INTENT(OUT) :: AROW_MAX_TERMS ! Max number of terms in any row of A INTEGER(LONG), INTENT(OUT) :: NTERM_B ! No. terms that go into MATOUT (from subr PARTITION_SS_NTERM) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARTITION_SS_NTERM_BEGEND + END SUBROUTINE PARTITION_SS_NTERM diff --git a/Source/Interfaces/PARTITION_VEC_Interface.f90 b/Source/Interfaces/PARTITION_VEC_Interface.f90 index a6615302..d6e24c43 100644 --- a/Source/Interfaces/PARTITION_VEC_Interface.f90 +++ b/Source/Interfaces/PARTITION_VEC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE PARTITION_VEC ( NDOF_X, CSET_X, CSET_1, CSET_2, PART_VEC ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PARTITION_VEC_BEGEND USE DOF_TABLES, ONLY : TDOFI IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE PARTITION_VEC ( NDOF_X, CSET_X, CSET_1, CSET_2, PART_VEC ) INTEGER(LONG), INTENT(IN ) :: NDOF_X ! No. DOF's in CSET_X displ set INTEGER(LONG), INTENT(OUT) :: PART_VEC(NDOF_X) ! The partitioning vector described above - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARTITION_VEC_BEGEND + END SUBROUTINE PARTITION_VEC diff --git a/Source/Interfaces/PENTA_Interface.f90 b/Source/Interfaces/PENTA_Interface.f90 index 98e22279..ad897bbf 100644 --- a/Source/Interfaces/PENTA_Interface.f90 +++ b/Source/Interfaces/PENTA_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE PENTA ( OPT, INT_ELEM_ID, IORD_IJ, IORD_K, RED_INT_SHEAR, WRITE_WARN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_TRIA, MAX_ORDER_GAUSS, NTSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : HALF, THIRD, ZERO, SIX USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : PENTA_BEGEND USE PARAMS, ONLY : EPSIL USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : ALPVEC, BE1, BE2, DT, EID, ELGP, NUM_EMG_FATAL_ERRS, ES, KE, KED, ME, PTE, RHO, & @@ -54,7 +53,7 @@ SUBROUTINE PENTA ( OPT, INT_ELEM_ID, IORD_IJ, IORD_K, RED_INT_SHEAR, WRITE_WARN INTEGER(LONG), INTENT(IN) :: IORD_IJ ! Integration order in the triangular plane INTEGER(LONG), INTENT(IN) :: IORD_K ! Integration order in Z direction INTEGER(LONG) :: GAUSS_PT ! Gauss point number (used for DEBUG output in subr SHP3DP - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PENTA_BEGEND + REAL(DOUBLE) :: CBAR(3,3*ELGP) ! Derivatives of shape fcns wrt x,y,z used in diff stiff matrix REAL(DOUBLE) :: DUM0(3*ELGP) ! Intermediate matrix used in solving for elem matrices diff --git a/Source/Interfaces/PINFLG_Interface.f90 b/Source/Interfaces/PINFLG_Interface.f90 index 50d484a3..9084df47 100644 --- a/Source/Interfaces/PINFLG_Interface.f90 +++ b/Source/Interfaces/PINFLG_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE PINFLG ( NUM_PFLAG_DOFS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PINFLG_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : EID, ELDOF, NUM_EMG_FATAL_ERRS, KE, DOFPIN, TYPE @@ -44,7 +43,7 @@ SUBROUTINE PINFLG ( NUM_PFLAG_DOFS ) INTEGER(LONG), INTENT(IN) :: NUM_PFLAG_DOFS ! The number of pin flagged DOF's for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PINFLG_BEGEND + END SUBROUTINE PINFLG diff --git a/Source/Interfaces/PLANE_COORD_TRANS_21_Interface.f90 b/Source/Interfaces/PLANE_COORD_TRANS_21_Interface.f90 index a15f6afa..e7ab3475 100644 --- a/Source/Interfaces/PLANE_COORD_TRANS_21_Interface.f90 +++ b/Source/Interfaces/PLANE_COORD_TRANS_21_Interface.f90 @@ -32,17 +32,15 @@ SUBROUTINE PLANE_COORD_TRANS_21 ( THETA, T21, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE, ZERO - USE SUBR_BEGEND_LEVELS, ONLY : PLANE_COORD_TRANS_21_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Subr that called this one - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PLANE_COORD_TRANS_21_BEGEND + REAL(DOUBLE), INTENT(IN) :: THETA ! Angle from x axis of system 1 to x axis of system 2 REAL(DOUBLE), INTENT(OUT) :: T21(3,3) ! Transformation matrix which will transform a vector, U1, in coord sys diff --git a/Source/Interfaces/POLYNOM_FIT_STRE_STRN_Interface.f90 b/Source/Interfaces/POLYNOM_FIT_STRE_STRN_Interface.f90 index 14ad30b5..85199eca 100644 --- a/Source/Interfaces/POLYNOM_FIT_STRE_STRN_Interface.f90 +++ b/Source/Interfaces/POLYNOM_FIT_STRE_STRN_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE POLYNOM_FIT_STRE_STRN ( STR_IN, NROW, NCOL, STR_OUT, STR_OUT_PCT_ERR, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MAX_STRESS_POINTS USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, TWO, THREE USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : EID, ELGP, TYPE, XEL USE PARAMS, ONLY : Q4SURFIT, QUAD4TYP - USE SUBR_BEGEND_LEVELS, ONLY : POLYNOM_FIT_STRE_STRN_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE POLYNOM_FIT_STRE_STRN ( STR_IN, NROW, NCOL, STR_OUT, STR_OUT_PCT_ERR, INTEGER(LONG), INTENT(OUT) :: STR_OUT_ERR_INDEX(MAX_STRESS_POINTS) INTEGER(LONG), PARAMETER :: IORD = 2 ! Gaussian integration order - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = POLYNOM_FIT_STRE_STRN_BEGEND + REAL(DOUBLE), INTENT(IN) :: STR_IN(NROW,NCOL) ! Input stress/strain vals. NROW are num of diff stress/strain vals and REAL(DOUBLE), INTENT(OUT) :: STR_OUT(NROW,NCOL) ! Output stress/strain vals. NROW are num of diff stress/strain vals diff --git a/Source/Interfaces/POLY_FAILURE_INDEX_Interface.f90 b/Source/Interfaces/POLY_FAILURE_INDEX_Interface.f90 index 7d355241..e7f58151 100644 --- a/Source/Interfaces/POLY_FAILURE_INDEX_Interface.f90 +++ b/Source/Interfaces/POLY_FAILURE_INDEX_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE POLY_FAILURE_INDEX ( STREi, STRE_ALLOWABLES, FAILURE_INDEX ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, TWO @@ -40,11 +40,10 @@ SUBROUTINE POLY_FAILURE_INDEX ( STREi, STRE_ALLOWABLES, FAILURE_INDEX ) USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : FAILURE_THEORY - USE SUBR_BEGEND_LEVELS, ONLY : POLY_FAILURE_INDEX_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = POLY_FAILURE_INDEX_BEGEND + REAL(DOUBLE), INTENT(IN) :: STRE_ALLOWABLES(9)! Allowable stresses (incl tension and compr for normal stresses) REAL(DOUBLE), INTENT(IN) :: STREi(6) ! 6 components of stress diff --git a/Source/Interfaces/PRESSURE_DATA_PROC_Interface.f90 b/Source/Interfaces/PRESSURE_DATA_PROC_Interface.f90 index c5291759..e108d2ac 100644 --- a/Source/Interfaces/PRESSURE_DATA_PROC_Interface.f90 +++ b/Source/Interfaces/PRESSURE_DATA_PROC_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE PRESSURE_DATA_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1Q - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, LINK1Q - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, L1Q_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1Q + USE IOUNT1, ONLY : WRT_ERR, LINK1Q + USE IOUNT1, ONLY : WRT_ERR, L1Q_MSG USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, DATA_NAM_LEN, FATAL_ERR, JCARD_LEN, LPDAT, LLOADC, & MPDAT_PLOAD1, MPDAT_PLOAD2, MPDAT_PLOAD4, MPLOAD4_3D_DATA, NELE, NLOAD, NPCARD, & NPLOAD4_3D, NPDAT, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : PRESSURE_DATA_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : LOAD_SIDS, LOAD_FACS, SUBLOD, PDATA, PPNT, PLOAD4_3D_DATA, PTYPE @@ -49,7 +48,7 @@ SUBROUTINE PRESSURE_DATA_PROC CHARACTER( 8*BYTE) :: TOKTYP ! Variable to test whether "THRU" option was used on B.D. PLOAD2 card CHARACTER( 8*BYTE) :: THRU ! ='Y' if THRU option used on TEMPRB, TEMPP1 continuation card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRESSURE_DATA_PROC_BEGEND + END SUBROUTINE PRESSURE_DATA_PROC diff --git a/Source/Interfaces/PRINCIPAL_2D_Interface.f90 b/Source/Interfaces/PRINCIPAL_2D_Interface.f90 index ac91a574..65a8d4d1 100644 --- a/Source/Interfaces/PRINCIPAL_2D_Interface.f90 +++ b/Source/Interfaces/PRINCIPAL_2D_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE PRINCIPAL_2D ( SX, SY, SXY, ANGLE, SMAJOR, SMINOR, SXYMAX, MEAN, VONM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, QUARTER, HALF, TWO, ONEPM6, FORTY5, CONV_RAD_DEG - USE SUBR_BEGEND_LEVELS, ONLY : PRINCIPAL_2D_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRINCIPAL_2D_BEGEND + REAL(DOUBLE), INTENT(IN) :: SX ! Normal x stress or strain REAL(DOUBLE), INTENT(IN) :: SY ! Normal y stress or strain diff --git a/Source/Interfaces/PRINCIPAL_3D_Interface.f90 b/Source/Interfaces/PRINCIPAL_3D_Interface.f90 index 5ef0de80..99a97434 100644 --- a/Source/Interfaces/PRINCIPAL_3D_Interface.f90 +++ b/Source/Interfaces/PRINCIPAL_3D_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE PRINCIPAL_3D ( STR, PRINCIPAL_STR, MEAN, VONMISES, SIG_OCT, TAU_OCT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, HALF, TWO, THREE USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : PRINCIPAL_3D_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRINCIPAL_3D_BEGEND + REAL(DOUBLE), INTENT(IN) :: STR(6) ! Stress or strain vector REAL(DOUBLE), INTENT(OUT) :: MEAN ! Mean stresses or strains diff --git a/Source/Interfaces/PRINT_CONSTANTS_1_Interface.f90 b/Source/Interfaces/PRINT_CONSTANTS_1_Interface.f90 index eda65761..2734c66e 100644 --- a/Source/Interfaces/PRINT_CONSTANTS_1_Interface.f90 +++ b/Source/Interfaces/PRINT_CONSTANTS_1_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE PRINT_CONSTANTS_1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : PROG_NAME IMPLICIT NONE diff --git a/Source/Interfaces/PRINT_ORDER_Interface.f90 b/Source/Interfaces/PRINT_ORDER_Interface.f90 index 02780f43..15dca904 100644 --- a/Source/Interfaces/PRINT_ORDER_Interface.f90 +++ b/Source/Interfaces/PRINT_ORDER_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE PRINT_ORDER USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_ORDER_GAUSS, MAX_ORDER_TRIA, NUM_TRIA_ORDERS, TRIA_ORDER_NUMS IMPLICIT NONE diff --git a/Source/Interfaces/PROCESS_INCLUDE_FILES_Interface.f90 b/Source/Interfaces/PROCESS_INCLUDE_FILES_Interface.f90 index f1ec7004..c927f546 100644 --- a/Source/Interfaces/PROCESS_INCLUDE_FILES_Interface.f90 +++ b/Source/Interfaces/PROCESS_INCLUDE_FILES_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE PROCESS_INCLUDE_FILES ( NUM_INCL_FILES ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN0, IN1, INC, INFILE, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN0, IN1, INC, INFILE USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PROCESS_INCLUDE_FILES_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(OUT) :: NUM_INCL_FILES ! Number of INCLUDE files in the Bulk Data file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PROCESS_INCLUDE_FILES_BEGEND + END SUBROUTINE PROCESS_INCLUDE_FILES diff --git a/Source/Interfaces/PROJ_VEC_ONTO_PLANE_Interface.f90 b/Source/Interfaces/PROJ_VEC_ONTO_PLANE_Interface.f90 index 7ce867d5..12d0d458 100644 --- a/Source/Interfaces/PROJ_VEC_ONTO_PLANE_Interface.f90 +++ b/Source/Interfaces/PROJ_VEC_ONTO_PLANE_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE PROJ_VEC_ONTO_PLANE ( VEC_A, VEC_B, VEC_C ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PROJ_VEC_ONTO_PLANE_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PROJ_VEC_ONTO_PLANE_BEGEND + REAL(DOUBLE) , INTENT(IN) :: VEC_A(3) ! Vector to be projected REAL(DOUBLE) , INTENT(IN) :: VEC_B(3) ! Vector normal to the plane onto which VEC_A is to be projected diff --git a/Source/Interfaces/PRT_MATS_ON_RESTART_Interface.f90 b/Source/Interfaces/PRT_MATS_ON_RESTART_Interface.f90 index 9dc2a931..3d5b0818 100644 --- a/Source/Interfaces/PRT_MATS_ON_RESTART_Interface.f90 +++ b/Source/Interfaces/PRT_MATS_ON_RESTART_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE PRT_MATS_ON_RESTART USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE IOUNT1, ONLY : L1E , L1H , L1J , L1L , L1R , L2A , L2B , L2C , L2D , L2E , & L2F , L2G , L2H , L2I , L2J , L2K , L2L , L2M , L2N , L2O , & @@ -74,13 +74,12 @@ SUBROUTINE PRT_MATS_ON_RESTART I_PA , J_PA , PA ,I_PG , J_PG , PG ,I_PL , J_PL , PL ,I_PS , J_PS , PS , & I_QSYS, J_QSYS, QSYS,I_RMG , J_RMG , RMG - USE SUBR_BEGEND_LEVELS, ONLY : PRT_MATS_ON_RESTART_BEGEND IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRT_MATS_ON_RESTART_BEGEND + END SUBROUTINE PRT_MATS_ON_RESTART diff --git a/Source/Interfaces/QDEL1_Interface.f90 b/Source/Interfaces/QDEL1_Interface.f90 index 80b3f5c4..265849a1 100644 --- a/Source/Interfaces/QDEL1_Interface.f90 +++ b/Source/Interfaces/QDEL1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE QDEL1 ( OPT, INT_ELEM_ID, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MEFE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QDEL1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, FOUR, TWELVE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL, IORQ1B, IORQ1M, IORQ1S, IORQ2B, QUAD4TYP @@ -52,7 +51,7 @@ SUBROUTINE QDEL1 ( OPT, INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG) :: GAUSS_PT ! Gauss point number (used for DEBUG output in subr SHP2DQ INTEGER(LONG), PARAMETER :: IORD_PCOMP = 2 ! Int order for nonsym layup PCOMP must be 2 (checked in subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QDEL1_BEGEND + REAL(DOUBLE) :: M0 ! An intermediate variable used in calc elem mass, ME diff --git a/Source/Interfaces/QMEM1_Interface.f90 b/Source/Interfaces/QMEM1_Interface.f90 index edb2b565..9251cd34 100644 --- a/Source/Interfaces/QMEM1_Interface.f90 +++ b/Source/Interfaces/QMEM1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE QMEM1 ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, AREA, XSD, YSD, BIG_BM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MAX_STRESS_POINTS, MEFE, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QMEM1_BEGEND USE CONSTANTS_1, ONLY : ZERO, FOUR USE MODEL_STUF, ONLY : ALPVEC, BE1, BMEANT, DT, EID, ELDOF, ELGP, EM, ERR_SUB_NAM, HBAR, KE, MXWARP, & NUM_EMG_FATAL_ERRS, PCOMP_LAM, PCOMP_PROPS, PPE, PRESS, PTE, & @@ -75,7 +74,7 @@ SUBROUTINE QMEM1 ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, AREA, XSD, YSD, BIG_BM INTEGER(LONG), PARAMETER :: IORD_STRESS_Q4 = 2! Gauss integration order for stress/strain recovery matrices INTEGER(LONG), PARAMETER :: NUM_NODES = 4 ! Quad has 4 nodes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QMEM1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords diff --git a/Source/Interfaces/QPLT1_Interface.f90 b/Source/Interfaces/QPLT1_Interface.f90 index c385713b..e0f39702 100644 --- a/Source/Interfaces/QPLT1_Interface.f90 +++ b/Source/Interfaces/QPLT1_Interface.f90 @@ -32,10 +32,8 @@ SUBROUTINE QPLT1 ( OPT, AREA, XSD, YSD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_ORDER_GAUSS, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QPLT1_BEGEND USE CONSTANTS_1, ONLY : ZERO, FOUR USE PARAMS, ONLY : IORQ2B USE MODEL_STUF, ONLY : ALPVEC, BE2, DT, EB, EID, KE, PRESS, PPE, PTE, SE2, STE2, SHELL_D, SHELL_DALP @@ -60,7 +58,7 @@ SUBROUTINE QPLT1 ( OPT, AREA, XSD, YSD ) INTEGER(LONG), PARAMETER :: IORD_STRESS_Q4 = 2! Gauss integration order for stress/strain recovery matrices INTEGER(LONG), PARAMETER :: NUM_NODES = 8 ! DKQ element has 8 nodes (4 are internal) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QPLT1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords diff --git a/Source/Interfaces/QPLT2_Interface.f90 b/Source/Interfaces/QPLT2_Interface.f90 index 97ac002d..1879925b 100644 --- a/Source/Interfaces/QPLT2_Interface.f90 +++ b/Source/Interfaces/QPLT2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE QPLT2 ( OPT, AREA, XSD, YSD, BIG_BB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_ORDER_GAUSS, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QPLT2_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, FOUR USE PARAMS, ONLY : EPSIL, IORQ2B, IORQ2T USE MODEL_STUF, ONLY : ALPVEC, BE2, BE3, BENSUM, DT, EID, ELDOF, EB, ET, & @@ -85,7 +84,7 @@ SUBROUTINE QPLT2 ( OPT, AREA, XSD, YSD, BIG_BB ) INTEGER(LONG) :: IORDXX ! Gaussian integration order to use when subr ORDER is called INTEGER(LONG), PARAMETER :: NUM_NODES = 4 ! Quad has 4 nodes ! Indicator of no output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QPLT2_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords diff --git a/Source/Interfaces/QPLT3_Interface.f90 b/Source/Interfaces/QPLT3_Interface.f90 index 8a4a4dd4..a23585f0 100644 --- a/Source/Interfaces/QPLT3_Interface.f90 +++ b/Source/Interfaces/QPLT3_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE QPLT3 ( OPT, AREA_QUAD, XSD, YSD, BIG_BB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEFE, MIN4T_QUAD4_TRIA_NO, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QPLT3_BEGEND USE CONSTANTS_1, ONLY : ZERO, QUARTER, HALF, ONE, TWO, FOUR, CONV_RAD_DEG, PI USE PARAMS, ONLY : MIN4TRED USE MACHINE_PARAMS, ONLY : MACH_SFMIN @@ -73,7 +72,7 @@ SUBROUTINE QPLT3 ( OPT, AREA_QUAD, XSD, YSD, BIG_BB ) 23 /) ! IDM(12) = 23 means quad elem DOF 12 is MYSTRAN elem DOF 23 INTEGER(LONG), PARAMETER :: NUM_TRIAS = 4 ! DO NOT CHANGE THIS. Num of triangles that subdivide the QUAD4 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QPLT3_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA_QUAD ! Element area REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords diff --git a/Source/Interfaces/QSHEAR_Interface.f90 b/Source/Interfaces/QSHEAR_Interface.f90 index 84dd12ea..841482a6 100644 --- a/Source/Interfaces/QSHEAR_Interface.f90 +++ b/Source/Interfaces/QSHEAR_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE QSHEAR ( OPT, IORD, RED_INT_SHEAR, XSD, YSD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MAX_STRESS_POINTS, MEFE, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : QSHEAR_BEGEND USE CONSTANTS_1, ONLY : ZERO, FOUR USE MODEL_STUF, ONLY : ALPVEC, BE1, BMEANT, DT, EID, ELDOF, ELGP, EM, ERR_SUB_NAM, HBAR, KE, MXWARP, & NUM_EMG_FATAL_ERRS, PCOMP_LAM, PCOMP_PROPS, PPE, PRESS, PTE, & @@ -73,7 +72,7 @@ SUBROUTINE QSHEAR ( OPT, IORD, RED_INT_SHEAR, XSD, YSD ) 21 /) ! ID2(12)= 21 means expand 12x12 elem DOF 12 is MYSTRAN 24X24 elem DOF 21 INTEGER(LONG), PARAMETER :: NUM_NODES = 4 ! Quad has 4 nodes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = QSHEAR_BEGEND + REAL(DOUBLE) , INTENT(IN) :: XSD(4) ! Diffs in x coords of quad sides in local coords REAL(DOUBLE) , INTENT(IN) :: YSD(4) ! Diffs in y coords of quad sides in local coords diff --git a/Source/Interfaces/R8FLD_Interface.f90 b/Source/Interfaces/R8FLD_Interface.f90 index 95213987..3df1cce2 100644 --- a/Source/Interfaces/R8FLD_Interface.f90 +++ b/Source/Interfaces/R8FLD_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE R8FLD ( JCARDI, IFLD, R8INP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR, JCARD_LEN USE CONSTANTS_1, ONLY : ZERO diff --git a/Source/Interfaces/RBE2_PROC_Interface.f90 b/Source/Interfaces/RBE2_PROC_Interface.f90 index 81348608..958a40f6 100644 --- a/Source/Interfaces/RBE2_PROC_Interface.f90 +++ b/Source/Interfaces/RBE2_PROC_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F, LINK1F, L1F_MSG, L1J + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F, LINK1F, L1F_MSG, L1J USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCORD, NGRID USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : GRID, RGRID, GRID_ID, CORD USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -47,7 +46,7 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) INTEGER(LONG), INTENT(INOUT) :: IERR ! Count of errors in RIGID_ELEM_PROC INTEGER(LONG), INTENT(INOUT) :: REC_NO ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + 1 + END SUBROUTINE RBE2_PROC diff --git a/Source/Interfaces/RBE3_PROC_Interface.f90 b/Source/Interfaces/RBE3_PROC_Interface.f90 index 69fce159..0fc1b9ab 100644 --- a/Source/Interfaces/RBE3_PROC_Interface.f90 +++ b/Source/Interfaces/RBE3_PROC_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F, LINK1F, L1F_MSG, L1J + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F, LINK1F, L1F_MSG, L1J USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MRBE3, NCORD, NGRID, NTERM_RMG USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : CORD, GRID_ID, GRID, RCORD, RGRID USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) INTEGER(LONG), INTENT(INOUT) :: IERR ! Count of errors in RIGID_ELEM_PROC INTEGER(LONG), INTENT(INOUT) :: REC_NO ! Record number when reading file L1F - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + END SUBROUTINE RBE3_PROC diff --git a/Source/Interfaces/RB_DISP_MATRIX_PROC_Interface.f90 b/Source/Interfaces/RB_DISP_MATRIX_PROC_Interface.f90 index f8cc9063..0dbf5483 100644 --- a/Source/Interfaces/RB_DISP_MATRIX_PROC_Interface.f90 +++ b/Source/Interfaces/RB_DISP_MATRIX_PROC_Interface.f90 @@ -33,12 +33,11 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCORD, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOF, TDOFI, TDOF_ROW_START USE PARAMS, ONLY : EQCHK_REF_GRID, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : RB_DISP_MATRIX_PROC_BEGEND USE MODEL_STUF, ONLY : CORD, GRID, RGRID, GRID_ID, INV_GRID_SEQ, MODEL_XCG, MODEL_YCG, MODEL_ZCG USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -49,7 +48,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) INTEGER(LONG), INTENT(IN) :: REF_PT ! An actual grid ID (only used if REF_PT_TXT = 'GRID') - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RB_DISP_MATRIX_PROC_BEGEND + 1 + END SUBROUTINE RB_DISP_MATRIX_PROC diff --git a/Source/Interfaces/RDOF_Interface.f90 b/Source/Interfaces/RDOF_Interface.f90 index e2aca305..ad6d7a23 100644 --- a/Source/Interfaces/RDOF_Interface.f90 +++ b/Source/Interfaces/RDOF_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE RDOF ( INTDOF, CDOF ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RDOF_BEGEND IMPLICIT NONE CHARACTER( 1*BYTE), INTENT(OUT) :: CDOF(6) ! Contains 1 in each of the 6 pos'ns corresponding to a DOF from INTDOF INTEGER(LONG), INTENT(IN) :: INTDOF ! Integer field which should contain only the digits 1 - 6 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RDOF_BEGEND + END SUBROUTINE RDOF diff --git a/Source/Interfaces/READERR_Interface.f90 b/Source/Interfaces/READERR_Interface.f90 index ad11aaf8..a05af446 100644 --- a/Source/Interfaces/READERR_Interface.f90 +++ b/Source/Interfaces/READERR_Interface.f90 @@ -28,25 +28,22 @@ MODULE READERR_Interface INTERFACE - SUBROUTINE READERR (IOCHK, FILNAM, MESSAG, REC_NO, OUNT, WRITE_F04 ) + SUBROUTINE READERR (IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, SC1 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : READERR_BEGEND + USE PENTIUM_II_KIND, ONLY : LONG + USE IOUNT1, ONLY : SC1 + USE SCONTR, ONLY : FATAL_ERR IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: MESSAG ! File description. Used for error messaging CHARACTER(LEN=*), INTENT(IN) :: FILNAM ! File name - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG), INTENT(IN) :: IOCHK ! IOSTAT error number when opening/reading a file INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to INTEGER(LONG), INTENT(IN) :: REC_NO ! Indicator of record number when error encountered reading file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READERR_BEGEND + END SUBROUTINE READERR diff --git a/Source/Interfaces/READ_DOF_TABLES_Interface.f90 b/Source/Interfaces/READ_DOF_TABLES_Interface.f90 index d0a6eb16..b944e6a0 100644 --- a/Source/Interfaces/READ_DOF_TABLES_Interface.f90 +++ b/Source/Interfaces/READ_DOF_TABLES_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE READ_DOF_TABLES USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, L1C, LINK1C, L1C_MSG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, L1C, LINK1C, L1C_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, MTDOF, NDOFG, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : READ_DOF_TABLES_BEGEND USE DOF_TABLES, ONLY : TDOFI, TDOF, TSET IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_DOF_TABLES_BEGEND + END SUBROUTINE READ_DOF_TABLES diff --git a/Source/Interfaces/READ_IN4_FULL_MAT_Interface.f90 b/Source/Interfaces/READ_IN4_FULL_MAT_Interface.f90 index 9c394d7f..e72f08de 100644 --- a/Source/Interfaces/READ_IN4_FULL_MAT_Interface.f90 +++ b/Source/Interfaces/READ_IN4_FULL_MAT_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE READ_IN4_FULL_MAT ( ELEM_TYP, ELEM_ID, MAT_NAME_IN, NRI, NCI, UNT, FI USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : NUM_EMG_FATAL_ERRS - USE SUBR_BEGEND_LEVELS, ONLY : READ_IN4_FULL_MAT_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE READ_IN4_FULL_MAT ( ELEM_TYP, ELEM_ID, MAT_NAME_IN, NRI, NCI, UNT, FI INTEGER(LONG), INTENT(IN) :: NRI ! Number of rows expected in MAT_FULL INTEGER(LONG), INTENT(IN) :: NCI ! Number of cols expected in MAT INTEGER(LONG), INTENT(OUT) :: IERRT ! IERR1+IERR2 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_IN4_FULL_MAT_BEGEND + REAL(DOUBLE), INTENT(OUT) :: MAT_FULL(NRI,NCI) ! Array of terms in matrix MAT diff --git a/Source/Interfaces/READ_INCLUDE_FILNAM_Interface.f90 b/Source/Interfaces/READ_INCLUDE_FILNAM_Interface.f90 index 6a003034..8c9134a0 100644 --- a/Source/Interfaces/READ_INCLUDE_FILNAM_Interface.f90 +++ b/Source/Interfaces/READ_INCLUDE_FILNAM_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE READ_INCLUDE_FILNAM ( CARD, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, FILE_NAM_MAXLEN, INC, INCFIL + USE IOUNT1, ONLY : ERR, F06, FILE_NAM_MAXLEN, INC, INCFIL USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, FATAL_ERR USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : READ_INCLUDE_FILNAM_BEGEND IMPLICIT NONE CHARACTER(LEN=EC_ENTRY_LEN), INTENT(IN) :: CARD ! An entry from an input data (DAT) file INTEGER(LONG), INTENT(OUT) :: IERR ! Local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_INCLUDE_FILNAM_BEGEND + END SUBROUTINE READ_INCLUDE_FILNAM diff --git a/Source/Interfaces/READ_INI_Interface.f90 b/Source/Interfaces/READ_INI_Interface.f90 index 34118c0f..f27863a2 100644 --- a/Source/Interfaces/READ_INI_Interface.f90 +++ b/Source/Interfaces/READ_INI_Interface.f90 @@ -33,9 +33,9 @@ SUBROUTINE READ_INI ( INI_EXIST ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, DEFDIR, INIFIL, SC1, MOU4, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, DEFDIR, INIFIL, SC1, MOU4, WRT_ERR - USE IOUNT1, ONLY : ANS, BUG, ERR, F04, F06, IN0, IN1, INI, L1A, NEU, & + USE IOUNT1, ONLY : BUG, ERR, F06, IN0, IN1, INI, L1A, NEU, & SEQ, SPC, & F21, F22, F23, F24, F25, & L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, L1K, & @@ -45,7 +45,7 @@ SUBROUTINE READ_INI ( INI_EXIST ) L2K, L2L, L2M, L2N, L2O, L2P, L2Q, L2R, L2S, L2T, & L3A, L4A, L4B, L4C, L4D, L5A, L5B, OP2, OU4 - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ANSSTAT, BUGSTAT, ERRSTAT, F04STAT, F06STAT, IN0STAT, IN1STAT, & + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUGSTAT, ERRSTAT, F06STAT, IN0STAT, IN1STAT, & L1ASTAT, NEUSTAT, SEQSTAT, SPCSTAT, & F21STAT, F22STAT, F23STAT, F24STAT, F25STAT, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1JSTAT, L1KSTAT, & diff --git a/Source/Interfaces/READ_INPUT_FILE_NAME_Interface.f90 b/Source/Interfaces/READ_INPUT_FILE_NAME_Interface.f90 index 3e9b7164..5f0611b5 100644 --- a/Source/Interfaces/READ_INPUT_FILE_NAME_Interface.f90 +++ b/Source/Interfaces/READ_INPUT_FILE_NAME_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE READ_INPUT_FILE_NAME ( INI_EXIST ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, DEFDIR, INFILE, & + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, DEFDIR, INFILE, & LEN_INPUT_FNAME, SC1 USE SCONTR, ONLY : PROG_NAME diff --git a/Source/Interfaces/READ_L1A_Interface.f90 b/Source/Interfaces/READ_L1A_Interface.f90 index e52520ca..63ffd9a5 100644 --- a/Source/Interfaces/READ_L1A_Interface.f90 +++ b/Source/Interfaces/READ_L1A_Interface.f90 @@ -28,14 +28,14 @@ MODULE READ_L1A_Interface INTERFACE - SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) + SUBROUTINE READ_L1A ( CLOSE_STAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : MOT4, MOU4, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : MOT4, MOU4, WRT_ERR - USE IOUNT1, ONLY : ANS, BUG, EIN, ENF, ERR, F04, F06, IN0, IN1, INI, & + USE IOUNT1, ONLY : BUG, EIN, ENF, ERR, F06, IN0, IN1, INI, & L1A, NEU, OT4, PCH, SEQ, SPC, SC1, & F21, F22, F23, F24, F25, & L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, L1K, & @@ -45,7 +45,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) L2K, L2L, L2M, L2N, L2O, L2P, L2Q, L2R, L2S, L2T, & L3A, L4A, L4B, L4C, L4D, L5A, L5B, OP2, OU4 - USE IOUNT1, ONLY : ANSSTAT, BUGSTAT, EINSTAT, ENFSTAT, ERRSTAT, F04STAT, F06STAT, IN0STAT, IN1STAT, INISTAT, & + USE IOUNT1, ONLY : BUGSTAT, EINSTAT, ENFSTAT, ERRSTAT, F06STAT, IN0STAT, IN1STAT, INISTAT, & L1ASTAT, NEUSTAT, OT4STAT, PCHSTAT, SEQSTAT, SPCSTAT, & F21STAT, F22STAT, F23STAT, F24STAT, F25STAT, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1JSTAT, L1KSTAT, & @@ -55,7 +55,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) L2KSTAT, L2LSTAT, L2MSTAT, L2NSTAT, L2OSTAT, L2PSTAT, L2QSTAT, L2RSTAT, L2SSTAT, L2TSTAT, & L3ASTAT, L4ASTAT, L4BSTAT, L4CSTAT, L4DSTAT, L5ASTAT, L5BSTAT, OP2STAT, OU4STAT - USE IOUNT1, ONLY : ANSFIL, BUGFIL, EINFIL, ENFFIL, ERRFIL, F04FIL, F06FIL, IN0FIL, INIFIL, LINK1A, & + USE IOUNT1, ONLY : BUGFIL, EINFIL, ENFFIL, ERRFIL, F06FIL, IN0FIL, INIFIL, LINK1A, & NEUFIL, OT4FIL, PCHFIL, SEQFIL, SPCFIL, F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, & LINK1A, LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, & LINK1K, LINK1L, LINK1M, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1R, LINK1S, LINK1T, & @@ -64,7 +64,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) LINK2K, LINK2L, LINK2M, LINK2N, LINK2O, LINK2P, LINK2Q, LINK2R, LINK2S, LINK2T, & LINK3A, LINK4A, LINK4B, LINK4C, LINK4D, LINK5A, LINK5B, OP2FIL, OU4FIL - USE IOUNT1, ONLY : ANS_MSG, BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F04_MSG, F06_MSG, IN0_MSG, IN1_MSG, INI_MSG, & + USE IOUNT1, ONLY : BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F06_MSG, IN0_MSG, IN1_MSG, INI_MSG, & L1A_MSG, NEU_MSG, OT4_MSG, PCH_MSG, SEQ_MSG, SPC_MSG, & F21_MSG, F22_MSG, F23_MSG, F24_MSG, F25_MSG, & L1B_MSG, L1C_MSG, L1D_MSG, L1E_MSG, L1F_MSG, L1G_MSG, L1H_MSG, L1I_MSG, L1J_MSG, L1K_MSG, & @@ -79,17 +79,15 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) MATSPARS, MIN4TRED, QUAD4TYP, QUADAXIS, SPARSTOR USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : READ_L1A_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: CLOSE_STAT ! STATUS when closing file LINK1A - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) CHARACTER(80*BYTE) :: MESSAG ! File description. Used for error messaging INTEGER(LONG), PARAMETER :: NUMIO = 304 ! Number of terms in IOCHKI array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_L1A_BEGEND + END SUBROUTINE READ_L1A diff --git a/Source/Interfaces/READ_L1M_Interface.f90 b/Source/Interfaces/READ_L1M_Interface.f90 index 118a37ba..aae561f6 100644 --- a/Source/Interfaces/READ_L1M_Interface.f90 +++ b/Source/Interfaces/READ_L1M_Interface.f90 @@ -34,7 +34,7 @@ SUBROUTINE READ_L1M ( IERROR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : LINKNO, NUM_EIGENS - USE IOUNT1, ONLY : ERR, F06, L1M, L1M_MSG, L1MSTAT, LINK1M, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1M, L1M_MSG, L1MSTAT, LINK1M, SC1, WRT_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE EIGEN_MATRICES_1 , ONLY : EIGEN_VAL, GEN_MASS, MODE_NUM diff --git a/Source/Interfaces/READ_L1Z_Interface.f90 b/Source/Interfaces/READ_L1Z_Interface.f90 index 46e2f378..0348d15f 100644 --- a/Source/Interfaces/READ_L1Z_Interface.f90 +++ b/Source/Interfaces/READ_L1Z_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE READ_L1Z USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L1Z, LINK1Z, L1Z_MSG + USE IOUNT1, ONLY : ERR, F06, L1Z, LINK1Z, L1Z_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NSUB, SOL_NAME USE TIMDAT, ONLY : STIME, TSEC USE MODEL_STUF, ONLY : CC_EIGR_SID, MPCSET, SPCSET, SUBLOD - USE SUBR_BEGEND_LEVELS, ONLY : READ_L1Z_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_L1Z_BEGEND + END SUBROUTINE READ_L1Z diff --git a/Source/Interfaces/READ_MATRIX_1_Interface.f90 b/Source/Interfaces/READ_MATRIX_1_Interface.f90 index 4d38bc57..654e25cd 100644 --- a/Source/Interfaces/READ_MATRIX_1_Interface.f90 +++ b/Source/Interfaces/READ_MATRIX_1_Interface.f90 @@ -33,12 +33,11 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME , I_MATOUT, J_MATOUT, MATOUT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : READ_MATRIX_1_BEGEND IMPLICIT NONE @@ -56,7 +55,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME INTEGER(LONG), INTENT(IN) :: UNT ! Unit number of FILNAM INTEGER(LONG), INTENT(OUT) :: I_MATOUT(NROWS+1) ! Row numbers for terms in matrix MATOUT INTEGER(LONG), INTENT(OUT) :: J_MATOUT(NTERM) ! Col numbers for terms in matrix MATOUT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_MATRIX_1_BEGEND + REAL(DOUBLE) , INTENT(OUT) :: MATOUT(NTERM) ! Real values for matrix MATOUT diff --git a/Source/Interfaces/READ_MATRIX_2_Interface.f90 b/Source/Interfaces/READ_MATRIX_2_Interface.f90 index ed88813c..7e397369 100644 --- a/Source/Interfaces/READ_MATRIX_2_Interface.f90 +++ b/Source/Interfaces/READ_MATRIX_2_Interface.f90 @@ -33,11 +33,10 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME , I2_MATOUT, J_MATOUT, MATOUT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : READ_MATRIX_2_BEGEND IMPLICIT NONE @@ -56,7 +55,7 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME INTEGER(LONG), INTENT(OUT) :: I2_MATOUT(NTERMS) ! Row numbers for terms in matrix MATOUT INTEGER(LONG), INTENT(OUT) :: J_MATOUT(NTERMS) ! Col numbers for terms in matrix MATOUT INTEGER(LONG) :: OLD_ROW_NUM ! A variable used to tell when a new row of MATOUT is being read - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_MATRIX_2_BEGEND + REAL(DOUBLE) , INTENT(OUT) :: MATOUT(NTERMS) ! Real values for matrix MATOUT diff --git a/Source/Interfaces/READ_XTIME_Interface.f90 b/Source/Interfaces/READ_XTIME_Interface.f90 index 6c0398bc..95dde67d 100644 --- a/Source/Interfaces/READ_XTIME_Interface.f90 +++ b/Source/Interfaces/READ_XTIME_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE READ_XTIME ( UNT, FILNAM, MESSAG, OUNT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : READ_XTIME_BEGEND IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE READ_XTIME ( UNT, FILNAM, MESSAG, OUNT ) INTEGER(LONG), INTENT(IN) :: UNT ! File unit number INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_XTIME_BEGEND + END SUBROUTINE READ_XTIME diff --git a/Source/Interfaces/REDUCE_A_LR_Interface.f90 b/Source/Interfaces/REDUCE_A_LR_Interface.f90 index ddef9885..3ed0aaf8 100644 --- a/Source/Interfaces/REDUCE_A_LR_Interface.f90 +++ b/Source/Interfaces/REDUCE_A_LR_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE REDUCE_A_LR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, LINKNO, NDOFA, NDOFG, NDOFL, NDOFR, NSUB, SOL_NAME, & NTERM_KAA , NTERM_KLL , NTERM_KRL , NTERM_KRR , & NTERM_KAAD, NTERM_KLLD, NTERM_KRLD, NTERM_KRRD, & @@ -44,7 +44,6 @@ SUBROUTINE REDUCE_A_LR USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_ASET, RBGLOBAL_GSET, RBGLOBAL_LSET USE PARAMS, ONLY : EQCHK_OUTPUT, MATSPARS, PRTSTIFD, PRTSTIFF, PRTMASS, PRTFOR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_A_LR_BEGEND USE SPARSE_MATRICES, ONLY : I_KAA , J_KAA , KAA , I_KLL , J_KLL , KLL , I_KRL , J_KRL , KRL , I_KRR , J_KRR , KRR , & I_KAAD, J_KAAD, KAAD, I_KLLD, J_KLLD, KLLD, I_KRLD, J_KRLD, KRLD, I_KRRD, J_KRRD, KRRD, & I_MAA , J_MAA , MAA , I_MLL , J_MLL , MLL , I_MRL , J_MRL , MRL , I_MRR , J_MRR , MRR , & @@ -56,7 +55,7 @@ SUBROUTINE REDUCE_A_LR CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_A_LR_BEGEND + END SUBROUTINE REDUCE_A_LR diff --git a/Source/Interfaces/REDUCE_F_AO_Interface.f90 b/Source/Interfaces/REDUCE_F_AO_Interface.f90 index 571d1360..908c1f14 100644 --- a/Source/Interfaces/REDUCE_F_AO_Interface.f90 +++ b/Source/Interfaces/REDUCE_F_AO_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE REDUCE_F_AO USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE CONSTANTS_1, ONLY : ZERO USE SCONTR, ONLY : BLNK_SUB_NAM, LINKNO, KOO_SDIA, NDOFF, NDOFG, NDOFA, NDOFO, NSUB, SOL_NAME, & NTERM_KFF , NTERM_KAA , NTERM_KAO , NTERM_KOO , & @@ -44,7 +44,6 @@ SUBROUTINE REDUCE_F_AO USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE DOF_TABLES, ONLY : TDOFI USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_FSET, RBGLOBAL_ASET - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_F_AO_BEGEND USE SPARSE_MATRICES, ONLY : I_KFF , J_KFF , KFF , I_KAA , J_KAA , KAA , I_KAO , J_KAO , KAO , I_KOO , J_KOO , KOO , & I_KFFD, J_KFFD, KFFD, I_KAAD, J_KAAD, KAAD, I_KAOD, J_KAOD, KAOD, I_KOOD, J_KOOD, KOOD, & I_MFF , J_MFF , MFF , I_MAA , J_MAA , MAA , I_MAO , J_MAO , MAO , I_MOO , J_MOO , MOO , & @@ -57,7 +56,7 @@ SUBROUTINE REDUCE_F_AO CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_F_AO_BEGEND + REAL(DOUBLE) :: DUM_COL(NDOFO) ! Temp variable used in SuperLU diff --git a/Source/Interfaces/REDUCE_G_NM_Interface.f90 b/Source/Interfaces/REDUCE_G_NM_Interface.f90 index 4eb7482b..829866d3 100644 --- a/Source/Interfaces/REDUCE_G_NM_Interface.f90 +++ b/Source/Interfaces/REDUCE_G_NM_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE REDUCE_G_NM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1C, LINK1C, L1C_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1C, LINK1C, L1C_MSG, SC1, WRT_ERR USE SCONTR, ONLY : LINKNO , NDOFG, NDOFN, NDOFM, NGRID, NSUB, & NTERM_KGG , NTERM_KNN , NTERM_KNM , NTERM_KMM , & @@ -46,7 +46,6 @@ SUBROUTINE REDUCE_G_NM USE DOF_TABLES, ONLY : TDOF, TDOFI USE MODEL_STUF, ONLY : GRID_ID USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_NSET - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_G_NM_BEGEND USE SPARSE_MATRICES, ONLY : I_KGG , J_KGG , KGG , I_KGGD, J_KGGD, KGGD, & I_KNN , J_KNN , KNN , I_KNM , J_KNM , KNM , I_KMM , J_KMM , KMM , & I_KNND, J_KNND, KNND, I_KNMD, J_KNMD, KNMD, I_KMMD, J_KMMD, KMMD, & @@ -62,7 +61,7 @@ SUBROUTINE REDUCE_G_NM CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_G_NM_BEGEND + END SUBROUTINE REDUCE_G_NM diff --git a/Source/Interfaces/REDUCE_KAAD_TO_KLLD_Interface.f90 b/Source/Interfaces/REDUCE_KAAD_TO_KLLD_Interface.f90 index 7512d6e5..c612335a 100644 --- a/Source/Interfaces/REDUCE_KAAD_TO_KLLD_Interface.f90 +++ b/Source/Interfaces/REDUCE_KAAD_TO_KLLD_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE REDUCE_KAAD_TO_KLLD ( PART_VEC_A_LR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2K, L2L, LINK2K, LINK2L, L2K_MSG, L2L_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2K, L2L, LINK2K, LINK2L, L2K_MSG, L2L_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFL, NDOFR, NTERM_KAAD, NTERM_KLLD, NTERM_KRLD, & NTERM_KRRD, SOL_NAME USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KAAD_TO_KLLD_BEGEND USE SPARSE_MATRICES, ONLY : I_KAAD, J_KAAD, KAAD, I_KLLD, J_KLLD, KLLD, I_KRLD, J_KRLD, KRLD, I_KRRD, J_KRRD, KRRD, & SYM_KAAD, SYM_KLLD, SYM_KRLD, SYM_KRRD USE SCRATCH_MATRICES @@ -46,7 +45,7 @@ SUBROUTINE REDUCE_KAAD_TO_KLLD ( PART_VEC_A_LR ) INTEGER(LONG), INTENT(IN) :: PART_VEC_A_LR(NDOFA)! Partitioning vector (F set into A and O sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KAAD_TO_KLLD_BEGEND + END SUBROUTINE REDUCE_KAAD_TO_KLLD diff --git a/Source/Interfaces/REDUCE_KAA_TO_KLL_Interface.f90 b/Source/Interfaces/REDUCE_KAA_TO_KLL_Interface.f90 index 39e1e32b..b4d40f03 100644 --- a/Source/Interfaces/REDUCE_KAA_TO_KLL_Interface.f90 +++ b/Source/Interfaces/REDUCE_KAA_TO_KLL_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE REDUCE_KAA_TO_KLL ( PART_VEC_A_LR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2K, L2L, LINK2K, LINK2L, L2K_MSG, L2L_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2K, L2L, LINK2K, LINK2L, L2K_MSG, L2L_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFL, NDOFR, NTERM_KAA, NTERM_KLL, NTERM_KRL, NTERM_KRR, & SOL_NAME USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KAA_TO_KLL_BEGEND USE SPARSE_MATRICES, ONLY : I_KAA, J_KAA, KAA, I_KLL, J_KLL, KLL, I_KRL, J_KRL, KRL, I_KRR, J_KRR, KRR, & SYM_KAA, SYM_KLL, SYM_KRL, SYM_KRR USE SCRATCH_MATRICES @@ -46,7 +45,7 @@ SUBROUTINE REDUCE_KAA_TO_KLL ( PART_VEC_A_LR ) INTEGER(LONG), INTENT(IN) :: PART_VEC_A_LR(NDOFA)! Partitioning vector (F set into A and O sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KAA_TO_KLL_BEGEND + END SUBROUTINE REDUCE_KAA_TO_KLL diff --git a/Source/Interfaces/REDUCE_KFFD_TO_KAAD_Interface.f90 b/Source/Interfaces/REDUCE_KFFD_TO_KAAD_Interface.f90 index c9121f4a..c0430d78 100644 --- a/Source/Interfaces/REDUCE_KFFD_TO_KAAD_Interface.f90 +++ b/Source/Interfaces/REDUCE_KFFD_TO_KAAD_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE REDUCE_KFFD_TO_KAAD ( PART_VEC_F_AO ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2E, LINK2E, L2E_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2E, LINK2E, L2E_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, NDOFF, NDOFA, NDOFO, NTERM_KFFD, NTERM_KAAD, & NTERM_KAOD, NTERM_KOOD, NTERM_KOODs, NTERM_GOA USE PARAMS, ONLY : EPSIL, KOORAT, SPARSTOR, RCONDK USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KFFD_TO_KAAD_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_KFFD, J_KFFD, KFFD, I_KAAD, J_KAAD, KAAD, I_KAOD, J_KAOD, KAOD, I_GOA, J_GOA, GOA, & I_KOOD, I2_KOOD, J_KOOD, KOOD, I_KOODs, I2_KOODs, J_KOODs, KOODs @@ -52,7 +51,7 @@ SUBROUTINE REDUCE_KFFD_TO_KAAD ( PART_VEC_F_AO ) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KFFD_TO_KAAD_BEGEND + END SUBROUTINE REDUCE_KFFD_TO_KAAD diff --git a/Source/Interfaces/REDUCE_KFF_TO_KAA_Interface.f90 b/Source/Interfaces/REDUCE_KFF_TO_KAA_Interface.f90 index d80e7cdc..1de0d79f 100644 --- a/Source/Interfaces/REDUCE_KFF_TO_KAA_Interface.f90 +++ b/Source/Interfaces/REDUCE_KFF_TO_KAA_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE REDUCE_KFF_TO_KAA ( PART_VEC_F_AO ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2E, LINK2E, L2E_MSG, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2E, LINK2E, L2E_MSG, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KOO_SDIA, NDOFF, NDOFA, NDOFO, NTERM_KFF, & NTERM_KAA, NTERM_KAO, NTERM_KOO, NTERM_GOA USE PARAMS, ONLY : KOORAT, MATSPARS, SOLLIB, SPARSTOR, SPARSE_FLAVOR, RCONDK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KFF_TO_KAA_BEGEND USE CONSTANTS_1, ONLY : ONE USE FULL_MATRICES, ONLY : KAA_FULL, KAO_FULL, GOA_FULL, DUM1, DUM2 USE SPARSE_MATRICES, ONLY : I_KFF, J_KFF, KFF, I_KAA, J_KAA, KAA, I_KAO, J_KAO, KAO, I_GOA, J_GOA, GOA, & @@ -54,7 +53,7 @@ SUBROUTINE REDUCE_KFF_TO_KAA ( PART_VEC_F_AO ) INTEGER(LONG), PARAMETER :: ITRNSPB = 0 ! Transpose indicator for matrix multiply routine INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KFF_TO_KAA_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/REDUCE_KGGD_TO_KNND_Interface.f90 b/Source/Interfaces/REDUCE_KGGD_TO_KNND_Interface.f90 index 3f7f4e34..8db1aec4 100644 --- a/Source/Interfaces/REDUCE_KGGD_TO_KNND_Interface.f90 +++ b/Source/Interfaces/REDUCE_KGGD_TO_KNND_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, LINK2A, L2A, L2ASTAT, L2A_MSG, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, LINK2A, L2A, L2ASTAT, L2A_MSG, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NTERM_HMN, NTERM_KGGD, NTERM_KNND, & NTERM_KNMD, NTERM_KMMD, NTERM_GMN USE PARAMS, ONLY : EPSIL, SPARSTOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KGGD_TO_KNND_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_HMN, J_HMN, HMN, I_KGGD, J_KGGD, KGGD, I_KNND, J_KNND, KNND, I_KNMD, J_KNMD, KNMD, & I_KMMD, J_KMMD, KMMD, I_KMND, J_KMND, KMND, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt @@ -50,7 +49,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) INTEGER(LONG), INTENT(IN) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KGGD_TO_KNND_BEGEND + END SUBROUTINE REDUCE_KGGD_TO_KNND diff --git a/Source/Interfaces/REDUCE_KGG_TO_KNN_Interface.f90 b/Source/Interfaces/REDUCE_KGG_TO_KNN_Interface.f90 index 1a1b3a49..94bfa64f 100644 --- a/Source/Interfaces/REDUCE_KGG_TO_KNN_Interface.f90 +++ b/Source/Interfaces/REDUCE_KGG_TO_KNN_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE REDUCE_KGG_TO_KNN ( PART_VEC_G_NM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NTERM_HMN, NTERM_KGG, NTERM_KNN, & NTERM_KNM, NTERM_KMM, NTERM_GMN USE PARAMS, ONLY : EPSIL, MATSPARS, SPARSTOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KGG_TO_KNN_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_HMN, J_HMN, HMN, I_KGG, J_KGG, KGG, I_KNN, J_KNN, KNN, I_KNM, J_KNM, KNM, & I_KMM, J_KMM, KMM,I_KMN, J_KMN, KMN, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt @@ -51,7 +50,7 @@ SUBROUTINE REDUCE_KGG_TO_KNN ( PART_VEC_G_NM ) INTEGER(LONG), INTENT(IN) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KGG_TO_KNN_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/REDUCE_KNND_TO_KFFD_Interface.f90 b/Source/Interfaces/REDUCE_KNND_TO_KFFD_Interface.f90 index 91c74ef4..6ada10d9 100644 --- a/Source/Interfaces/REDUCE_KNND_TO_KFFD_Interface.f90 +++ b/Source/Interfaces/REDUCE_KNND_TO_KFFD_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE REDUCE_KNND_TO_KFFD ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PAR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2B, LINK2B, L2B_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2B, LINK2B, L2B_MSG USE SCONTR, ONLY : FATAL_ERR, NDOFN, NDOFF, NDOFS, NDOFSE, NTERM_KNND, NTERM_KFFD, NTERM_KFSD, NTERM_KSSD, & NTERM_KFSDe, NTERM_KSSDe, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KNND_TO_KFFD_BEGEND USE SPARSE_MATRICES, ONLY : I_KNND, J_KNND, KNND, I_KFFD, J_KFFD, KFFD, I_KFSD, J_KFSD, KFSD, I_KFSDe, J_KFSDe, KFSDe,& I_KSFD, J_KSFD, KSFD, I_KSSD, J_KSSD, KSSD, I_KSSDe, J_KSSDe, KSSDe USE SPARSE_MATRICES, ONLY : SYM_KNND, SYM_KFFD, SYM_KFSD, SYM_KFSDe, SYM_KSSD, SYM_KSSD, SYM_KSSDe @@ -50,7 +49,7 @@ SUBROUTINE REDUCE_KNND_TO_KFFD ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PAR INTEGER(LONG), INTENT(IN) :: PART_VEC_S_SzSe(NDOFS) ! Partitioning vector (S set into SZ and SE sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KNND_TO_KFFD_BEGEND + END SUBROUTINE REDUCE_KNND_TO_KFFD diff --git a/Source/Interfaces/REDUCE_KNN_TO_KFF_Interface.f90 b/Source/Interfaces/REDUCE_KNN_TO_KFF_Interface.f90 index 0343a278..0139488f 100644 --- a/Source/Interfaces/REDUCE_KNN_TO_KFF_Interface.f90 +++ b/Source/Interfaces/REDUCE_KNN_TO_KFF_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE REDUCE_KNN_TO_KFF ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PART_ USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2B, LINK2B, L2B_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2B, LINK2B, L2B_MSG USE SCONTR, ONLY : FATAL_ERR, NDOFN, NDOFF, NDOFS, NDOFSE, NTERM_KNN, NTERM_KFF, NTERM_KFS, NTERM_KSS, & NTERM_KFSe, NTERM_KSSe, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KNN_TO_KFF_BEGEND USE SPARSE_MATRICES, ONLY : I_KNN, J_KNN, KNN, I_KFF, J_KFF, KFF, I_KFS, J_KFS, KFS, I_KFSe, J_KFSe, KFSe, & I_KSF, J_KSF, KSF, I_KSS, J_KSS, KSS, I_KSSe, J_KSSe, KSSe USE SPARSE_MATRICES, ONLY : SYM_KNN, SYM_KFF, SYM_KFS, SYM_KFSe, SYM_KSS, SYM_KSS, SYM_KSSe @@ -52,7 +51,7 @@ SUBROUTINE REDUCE_KNN_TO_KFF ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PART_ INTEGER(LONG), INTENT(IN) :: PART_VEC_S_SzSe(NDOFS) ! Partitioning vector (S set into SZ and SE sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KNN_TO_KFF_BEGEND + END SUBROUTINE REDUCE_KNN_TO_KFF diff --git a/Source/Interfaces/REDUCE_MAA_TO_MLL_Interface.f90 b/Source/Interfaces/REDUCE_MAA_TO_MLL_Interface.f90 index 437fd0b9..d0ab591c 100644 --- a/Source/Interfaces/REDUCE_MAA_TO_MLL_Interface.f90 +++ b/Source/Interfaces/REDUCE_MAA_TO_MLL_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE REDUCE_MAA_TO_MLL ( PART_VEC_A_LR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2M, L2N, LINK2M, LINK2N, L2M_MSG, L2N_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2M, L2N, LINK2M, LINK2N, L2M_MSG, L2N_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFL, NDOFR, NTERM_MAA, NTERM_MLL, NTERM_MRL, NTERM_MRR, & SOL_NAME USE PARAMS, ONLY : EPSIL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_MAA_TO_MLL_BEGEND USE SPARSE_MATRICES, ONLY : I_MAA, J_MAA, MAA, I_MLL, J_MLL, MLL, I_MRL, J_MRL, MRL, I_MRR, J_MRR, MRR, & SYM_MAA, SYM_MLL, SYM_MRL, SYM_MRR USE SCRATCH_MATRICES @@ -47,7 +46,7 @@ SUBROUTINE REDUCE_MAA_TO_MLL ( PART_VEC_A_LR ) INTEGER(LONG), INTENT(IN) :: PART_VEC_A_LR(NDOFA)! Partitioning vector (F set into A and O sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_MAA_TO_MLL_BEGEND + END SUBROUTINE REDUCE_MAA_TO_MLL diff --git a/Source/Interfaces/REDUCE_MFF_TO_MAA_Interface.f90 b/Source/Interfaces/REDUCE_MFF_TO_MAA_Interface.f90 index 638ef00c..631cec23 100644 --- a/Source/Interfaces/REDUCE_MFF_TO_MAA_Interface.f90 +++ b/Source/Interfaces/REDUCE_MFF_TO_MAA_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE REDUCE_MFF_TO_MAA ( PART_VEC_F_AO ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFF, NDOFA, NDOFO, NTERM_MFF, NTERM_MAA, NTERM_MAO, NTERM_MOO, & NTERM_GOA USE PARAMS, ONLY : EPSIL, MATSPARS, SPARSTOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_MFF_TO_MAA_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_MFF, J_MFF, MFF, I_MAA, J_MAA, MAA, I_MAO, J_MAO, MAO, I_MOO, J_MOO, MOO, & I_GOA, J_GOA, GOA, I_GOAt, J_GOAt, GOAt @@ -51,7 +50,7 @@ SUBROUTINE REDUCE_MFF_TO_MAA ( PART_VEC_F_AO ) INTEGER(LONG), INTENT(IN) :: PART_VEC_F_AO(NDOFF)! Partitioning vector (F set into A and O sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_MFF_TO_MAA_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/REDUCE_MGG_TO_MNN_Interface.f90 b/Source/Interfaces/REDUCE_MGG_TO_MNN_Interface.f90 index cd935cc2..1d3df9f1 100644 --- a/Source/Interfaces/REDUCE_MGG_TO_MNN_Interface.f90 +++ b/Source/Interfaces/REDUCE_MGG_TO_MNN_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE REDUCE_MGG_TO_MNN ( PART_VEC_G_NM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2R, LINK2R, L2R_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2R, LINK2R, L2R_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NTERM_MGG, NTERM_MNN, NTERM_MNM, NTERM_MMM, & NTERM_GMN, NTERM_LMN USE PARAMS, ONLY : EPSIL, MATSPARS, SPARSTOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_MGG_TO_MNN_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_LMN, J_LMN, LMN, I_MGG, J_MGG, MGG, I_MNN, J_MNN, MNN, I_MNM , J_MNM , MNM , & I_MMN, J_MMN, MMN, I_MMM, J_MMM, MMM, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt @@ -51,7 +50,7 @@ SUBROUTINE REDUCE_MGG_TO_MNN ( PART_VEC_G_NM ) INTEGER(LONG), INTENT(IN) :: PART_VEC_G_NM(NDOFG)! Partitioning vector (G set into N and M sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_MGG_TO_MNN_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/REDUCE_MNN_TO_MFF_Interface.f90 b/Source/Interfaces/REDUCE_MNN_TO_MFF_Interface.f90 index 2595293e..649ee695 100644 --- a/Source/Interfaces/REDUCE_MNN_TO_MFF_Interface.f90 +++ b/Source/Interfaces/REDUCE_MNN_TO_MFF_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE REDUCE_MNN_TO_MFF ( PART_VEC_N_FS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2S, LINK2S, L2S_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2S, LINK2S, L2S_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFN, NDOFF, NDOFS, NTERM_MNN, NTERM_MFF, NTERM_MFS, NTERM_MSS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_MNN_TO_MFF_BEGEND USE SPARSE_MATRICES, ONLY : I_MNN, J_MNN, MNN, I_MFF, J_MFF, MFF, I_MFS, J_MFS, MFS, I_MSF, J_MSF, MSF, & I_MSS, J_MSS, MSS USE SPARSE_MATRICES, ONLY : SYM_MNN, SYM_MFF, SYM_MFS, SYM_MSS @@ -46,7 +45,7 @@ SUBROUTINE REDUCE_MNN_TO_MFF ( PART_VEC_N_FS ) INTEGER(LONG), INTENT(IN) :: PART_VEC_N_FS(NDOFN) ! Partitioning vector (N set into F and S sets) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_MNN_TO_MFF_BEGEND + END SUBROUTINE REDUCE_MNN_TO_MFF diff --git a/Source/Interfaces/REDUCE_N_FS_Interface.f90 b/Source/Interfaces/REDUCE_N_FS_Interface.f90 index 2efea79f..c58aeef8 100644 --- a/Source/Interfaces/REDUCE_N_FS_Interface.f90 +++ b/Source/Interfaces/REDUCE_N_FS_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE REDUCE_N_FS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1H, LINK1H, L1H_MSG, L2C, LINK2C, L2C_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1H, LINK1H, L1H_MSG, L2C, LINK2C, L2C_MSG, SC1, WRT_ERR USE SCONTR, ONLY : LINKNO , NDOFF, NDOFG, NDOFN, NDOFS, NDOFSE, NSUB, & NTERM_KNN , NTERM_KFF , NTERM_KFS , NTERM_KSS , NTERM_KSSe , & NTERM_KNND, NTERM_KFFD, NTERM_KFSD, NTERM_KSSD, NTERM_KSSDe, & @@ -44,7 +44,6 @@ SUBROUTINE REDUCE_N_FS USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_NSET, RBGLOBAL_FSET USE PARAMS, ONLY : EQCHK_OUTPUT, MATSPARS, PRTSTIFD, PRTSTIFF, PRTMASS, PRTFOR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_N_FS_BEGEND USE SPARSE_MATRICES, ONLY : I_KNN , J_KNN , KNN , I_KFF , J_KFF , KFF , I_KFS , J_KFS , KFS , & I_KSS , J_KSS , KSS , I_KSSe , J_KSSe , KSSe , & I_KNND , J_KNND , KNND , I_KFFD , J_KFFD , KFFD , I_KFSD , J_KFSD , KFSD , & @@ -64,7 +63,7 @@ SUBROUTINE REDUCE_N_FS CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG) , PARAMETER :: NUM_YS_COLS = 1 ! Variable for number of cols in array YSe - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_N_FS_BEGEND + END SUBROUTINE REDUCE_N_FS diff --git a/Source/Interfaces/REDUCE_PA_TO_PL_Interface.f90 b/Source/Interfaces/REDUCE_PA_TO_PL_Interface.f90 index 5e604ff7..5ce46e02 100644 --- a/Source/Interfaces/REDUCE_PA_TO_PL_Interface.f90 +++ b/Source/Interfaces/REDUCE_PA_TO_PL_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE REDUCE_PA_TO_PL ( PART_VEC_A_LR, PART_VEC_SUB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFL, NDOFR, NSUB, NTERM_GOA, NTERM_PA, NTERM_PL, NTERM_PR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_PA_TO_PL_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_PA, J_PA, PA, I_PL, J_PL, PL, I_PR, J_PR, PR, I_GOA, J_GOA, GOA, I_GOAt, J_GOAt, GOAt USE SPARSE_MATRICES, ONLY : SYM_PA, SYM_PL, SYM_PR @@ -46,7 +45,7 @@ SUBROUTINE REDUCE_PA_TO_PL ( PART_VEC_A_LR, PART_VEC_SUB ) INTEGER(LONG), INTENT(IN) :: PART_VEC_SUB(NSUB) ! Partitioning vector (1's for all subcases) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_PA_TO_PL_BEGEND + END SUBROUTINE REDUCE_PA_TO_PL diff --git a/Source/Interfaces/REDUCE_PF_TO_PA_Interface.f90 b/Source/Interfaces/REDUCE_PF_TO_PA_Interface.f90 index 2b55d246..a9564d2a 100644 --- a/Source/Interfaces/REDUCE_PF_TO_PA_Interface.f90 +++ b/Source/Interfaces/REDUCE_PF_TO_PA_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE REDUCE_PF_TO_PA ( PART_VEC_F_AO, PART_VEC_SUB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KOO_SDIA, NDOFF, NDOFA, NDOFO, NSUB, NTERM_GOA, NTERM_PF, & NTERM_PA, NTERM_PO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_PF_TO_PA_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : EPSIL, MATSPARS USE SPARSE_MATRICES, ONLY : I_PF, J_PF, PF, I_PA, J_PA, PA, I_PO, J_PO, PO, I_GOA, J_GOA, GOA, I_GOAt, J_GOAt, GOAt @@ -53,7 +52,7 @@ SUBROUTINE REDUCE_PF_TO_PA ( PART_VEC_F_AO, PART_VEC_SUB ) INTEGER(LONG), PARAMETER :: ITRNSPB = 0 ! Transpose indicator for matrix multiply routine INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_PF_TO_PA_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/REDUCE_PG_TO_PN_Interface.f90 b/Source/Interfaces/REDUCE_PG_TO_PN_Interface.f90 index c68deb9d..79ec6853 100644 --- a/Source/Interfaces/REDUCE_PG_TO_PN_Interface.f90 +++ b/Source/Interfaces/REDUCE_PG_TO_PN_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE REDUCE_PG_TO_PN ( PART_VEC_G_NM, PART_VEC_SUB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NSUB, NTERM_GMN, NTERM_PG, NTERM_PN, NTERM_PM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_PG_TO_PN_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : EPSIL, MATSPARS USE SPARSE_MATRICES, ONLY : I_PG, J_PG, PG, I_PN, J_PN, PN, I_PM, J_PM, PM, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt @@ -52,7 +51,7 @@ SUBROUTINE REDUCE_PG_TO_PN ( PART_VEC_G_NM, PART_VEC_SUB ) INTEGER(LONG), PARAMETER :: ITRNSPB = 0 ! Transpose indicator for matrix multiply routine INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_PG_TO_PN_BEGEND + REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix diff --git a/Source/Interfaces/REDUCE_PN_TO_PF_Interface.f90 b/Source/Interfaces/REDUCE_PN_TO_PF_Interface.f90 index 21c1ec98..a6aa0ee2 100644 --- a/Source/Interfaces/REDUCE_PN_TO_PF_Interface.f90 +++ b/Source/Interfaces/REDUCE_PN_TO_PF_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE REDUCE_PN_TO_PF ( PART_VEC_N_FS, PART_VEC_SUB ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2D, LINK2D, L2D_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2D, LINK2D, L2D_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFN, NDOFF, NDOFS, NDOFSE, NSUB, NTERM_KFSe, NTERM_PN, & NTERM_PF, NTERM_PFYS, NTERM_PS USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_PN_TO_PF_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : MATSPARS USE SPARSE_MATRICES, ONLY : I_KFSe, J_KFSe, KFSe, I_PN, J_PN, PN, I_PF, J_PF, PF, I_PS, J_PS, PS, I_PF_TMP, J_PF_TMP, & @@ -58,7 +57,7 @@ SUBROUTINE REDUCE_PN_TO_PF ( PART_VEC_N_FS, PART_VEC_SUB ) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM_YS_COLS = 1 ! Variable for number of cols in array YSe - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_PN_TO_PF_BEGEND + END SUBROUTINE REDUCE_PN_TO_PF diff --git a/Source/Interfaces/RENORM_Interface.f90 b/Source/Interfaces/RENORM_Interface.f90 index 8fb9a551..3de5a459 100644 --- a/Source/Interfaces/RENORM_Interface.f90 +++ b/Source/Interfaces/RENORM_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE RENORM ( VEC_NUM, NORM_GRD, NORM_COMP, NORM, NORM_GSET_DOF, GEN_MASS1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFG, NDOFG, NGRID, WARN_ERR USE PARAMS, ONLY : EPSIL, SUPWARN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RENORM_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE COL_VECS, ONLY : UG_COL @@ -48,7 +47,7 @@ SUBROUTINE RENORM ( VEC_NUM, NORM_GRD, NORM_COMP, NORM, NORM_GSET_DOF, GEN_MASS1 INTEGER(LONG), INTENT(IN) :: NORM_GRD ! Grid Point for renormalizing eigenvectors (from EIGR card) INTEGER(LONG), INTENT(IN) :: NORM_GSET_DOF ! G-set DOF no. for NORM_GRD/NORM_COMP INTEGER(LONG), INTENT(IN) :: VEC_NUM ! Number used to control an output message (only want this information - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RENORM_BEGEND + REAL(DOUBLE) , INTENT(INOUT) :: GEN_MASS1 ! Generalized mass for 1 eigenvector REAL(DOUBLE) , INTENT(OUT) :: PHI_SCALE_FAC ! Scale factor for the eigenvector to renormalize it diff --git a/Source/Interfaces/RENORM_ON_MASS_Interface.f90 b/Source/Interfaces/RENORM_ON_MASS_Interface.f90 index 52502f30..02529a4c 100644 --- a/Source/Interfaces/RENORM_ON_MASS_Interface.f90 +++ b/Source/Interfaces/RENORM_ON_MASS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE RENORM_ON_MASS ( NVC, EPS1 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFL, BLNK_SUB_NAM, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL, SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : RENORM_ON_MASS_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE EIGEN_MATRICES_1 , ONLY : GEN_MASS, EIGEN_VEC USE MODEL_STUF, ONLY : EIG_NORM, MAXMIJ, MIJ_COL, MIJ_ROW @@ -45,7 +44,7 @@ SUBROUTINE RENORM_ON_MASS ( NVC, EPS1 ) IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: NVC ! Number of eigenvectors to be renormalized. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RENORM_ON_MASS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: EPS1 ! Small number to compare variables against zero diff --git a/Source/Interfaces/REPLACE_TABS_W_BLANKS_Interface.f90 b/Source/Interfaces/REPLACE_TABS_W_BLANKS_Interface.f90 index b47219a0..25e15e8a 100644 --- a/Source/Interfaces/REPLACE_TABS_W_BLANKS_Interface.f90 +++ b/Source/Interfaces/REPLACE_TABS_W_BLANKS_Interface.f90 @@ -32,16 +32,14 @@ SUBROUTINE REPLACE_TABS_W_BLANKS ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REPLACE_TABS_W_BLANKS_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! Input entry character line - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REPLACE_TABS_W_BLANKS_BEGEND + END SUBROUTINE REPLACE_TABS_W_BLANKS diff --git a/Source/Interfaces/RESTART_DATA_FOR_L3_Interface.f90 b/Source/Interfaces/RESTART_DATA_FOR_L3_Interface.f90 index 57420d04..a339ce2c 100644 --- a/Source/Interfaces/RESTART_DATA_FOR_L3_Interface.f90 +++ b/Source/Interfaces/RESTART_DATA_FOR_L3_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE RESTART_DATA_FOR_L3 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE IOUNT1, ONLY : L2G, LINK2G, L2G_MSG, L2GSTAT USE IOUNT1, ONLY : L2H, LINK2H, L2H_MSG, L2HSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFL, NTERM_KLL, NTERM_PL USE TIMDAT, ONLY : TSEC USE SPARSE_MATRICES, ONLY : I_KLL , J_KLL , KLL ,I_PL , J_PL , PL - USE SUBR_BEGEND_LEVELS, ONLY : RESTART_DATA_FOR_L3_BEGEND IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RESTART_DATA_FOR_L3_BEGEND + END SUBROUTINE RESTART_DATA_FOR_L3 diff --git a/Source/Interfaces/RFORCE_PROC_Interface.f90 b/Source/Interfaces/RFORCE_PROC_Interface.f90 index 715f04ed..585ce821 100644 --- a/Source/Interfaces/RFORCE_PROC_Interface.f90 +++ b/Source/Interfaces/RFORCE_PROC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE RFORCE_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, FILE_NAM_MAXLEN, L1U, LINK1U, L1U_MSG, SC1, SCR, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, FILE_NAM_MAXLEN, L1U, LINK1U, L1U_MSG, SC1, SCR, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LLOADC, NCORD, NRFORCE, NGRID, NLOAD, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RFORCE_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : SUPWARN USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -46,7 +45,7 @@ SUBROUTINE RFORCE_PROC CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG), PARAMETER :: ACID_0 = 0 ! Basic coord system - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RFORCE_PROC_BEGEND + END SUBROUTINE RFORCE_PROC diff --git a/Source/Interfaces/RIGID_BODY_DISP_MAT_Interface.f90 b/Source/Interfaces/RIGID_BODY_DISP_MAT_Interface.f90 index b3f32ac3..8edc7720 100644 --- a/Source/Interfaces/RIGID_BODY_DISP_MAT_Interface.f90 +++ b/Source/Interfaces/RIGID_BODY_DISP_MAT_Interface.f90 @@ -32,15 +32,13 @@ SUBROUTINE RIGID_BODY_DISP_MAT ( GRD_COORDS, REF_COORDS, RB_DISP ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_BODY_DISP_MAT_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_BODY_DISP_MAT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: GRD_COORDS(3) ! Coords of grid point for which the RB matrix is to be formulated REAL(DOUBLE) , INTENT(IN) :: REF_COORDS(3) ! Coords of reference grid (grid about which the RB disps occur) diff --git a/Source/Interfaces/RIGID_ELEM_PROC_Interface.f90 b/Source/Interfaces/RIGID_ELEM_PROC_Interface.f90 index d2ba587e..8fc665d2 100644 --- a/Source/Interfaces/RIGID_ELEM_PROC_Interface.f90 +++ b/Source/Interfaces/RIGID_ELEM_PROC_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE RIGID_ELEM_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1F, LINK1F, L1F_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1F, LINK1F, L1F_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NRECARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + END SUBROUTINE RIGID_ELEM_PROC diff --git a/Source/Interfaces/ROD1_Interface.f90 b/Source/Interfaces/ROD1_Interface.f90 index eb30ca14..bbdbf642 100644 --- a/Source/Interfaces/ROD1_Interface.f90 +++ b/Source/Interfaces/ROD1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ROD1 ( OPT, L, AREA, JTOR, SCOEFF, E, G, ALPHA, TREF ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NTSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ROD1_BEGEND USE CONSTANTS_1, ONLY : TWO USE MODEL_STUF, ONLY : DT, KE, PTE, SE1, STE1 @@ -43,7 +42,7 @@ SUBROUTINE ROD1 ( OPT, L, AREA, JTOR, SCOEFF, E, G, ALPHA, TREF ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROD1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: ALPHA ! Coefficient of thermal expansion REAL(DOUBLE) , INTENT(IN) :: AREA ! Cross-sectional area diff --git a/Source/Interfaces/ROD_MARGIN_Interface.f90 b/Source/Interfaces/ROD_MARGIN_Interface.f90 index 961ccb25..151c86cf 100644 --- a/Source/Interfaces/ROD_MARGIN_Interface.f90 +++ b/Source/Interfaces/ROD_MARGIN_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ROD_MARGIN (ICOL, S1, S2, MS1, MS2, MSP1, MSP2 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ROD_MARGIN_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, ONEPM6, ONEPP10 USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : ULT_STRE @@ -45,7 +44,7 @@ SUBROUTINE ROD_MARGIN (ICOL, S1, S2, MS1, MS2, MSP1, MSP2 ) CHARACTER(LEN=*), INTENT(OUT) :: MSP1,MSP2 ! If '1', print margins in F06 file. If '0', do not print. INTEGER(LONG), INTENT(IN) :: ICOL ! Column no. from ULT_STRE to get max allow. stresses - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROD_MARGIN_BEGEND + REAL(DOUBLE), INTENT(OUT) :: MS1 ! Calculated margin of safety REAL(DOUBLE), INTENT(OUT) :: MS2 ! Calculated margin of safety diff --git a/Source/Interfaces/ROT_AXES_MATL_TO_LOC_Interface.f90 b/Source/Interfaces/ROT_AXES_MATL_TO_LOC_Interface.f90 index 023f75db..13be0ae9 100644 --- a/Source/Interfaces/ROT_AXES_MATL_TO_LOC_Interface.f90 +++ b/Source/Interfaces/ROT_AXES_MATL_TO_LOC_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE ROT_AXES_MATL_TO_LOC ( WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEMATC, NCORD USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE @@ -40,13 +40,12 @@ SUBROUTINE ROT_AXES_MATL_TO_LOC ( WRITE_WARN ) RCORD, TE, THETAM, TYPE USE PARAMS, ONLY : EPSIL USE DEBUG_PARAMETERS - USE SUBR_BEGEND_LEVELS, ONLY : ROT_AXES_MATL_TO_LOC_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y' write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROT_AXES_MATL_TO_LOC_BEGEND + END SUBROUTINE ROT_AXES_MATL_TO_LOC diff --git a/Source/Interfaces/ROT_COMP_ELEM_AXES_Interface.f90 b/Source/Interfaces/ROT_COMP_ELEM_AXES_Interface.f90 index 426e58aa..060a2e41 100644 --- a/Source/Interfaces/ROT_COMP_ELEM_AXES_Interface.f90 +++ b/Source/Interfaces/ROT_COMP_ELEM_AXES_Interface.f90 @@ -32,21 +32,20 @@ SUBROUTINE ROT_COMP_ELEM_AXES ( INT_ELEM_ID, IPLY, THETA, DIRECTION ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEMATC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : CONV_DEG_RAD, ZERO, HALF, ONE, TWO, FOUR USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : ALPVEC, EB, EM, ET, EBM, INTL_MID, MTRL_TYPE, STRESS, STRAIN, T1P, T1M, T1T, T2P, T2M, T2T - USE SUBR_BEGEND_LEVELS, ONLY : ROT_COMP_ELEM_AXES_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID CHARACTER(LEN=*), INTENT(IN) :: DIRECTION ! =1-2, rotate from ply to elem mat'l axes (when gen ABD matrices) INTEGER(LONG), INTENT(IN) :: IPLY ! Ply number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROT_COMP_ELEM_AXES_BEGEND + REAL(DOUBLE), INTENT(IN) :: THETA ! Orient angle of long dir of ply i wrt matl axis for the composite elem diff --git a/Source/Interfaces/ROW_AT_COLJ_BEGEND_Interface.f90 b/Source/Interfaces/ROW_AT_COLJ_BEGEND_Interface.f90 index 384e72fb..0af22f99 100644 --- a/Source/Interfaces/ROW_AT_COLJ_BEGEND_Interface.f90 +++ b/Source/Interfaces/ROW_AT_COLJ_BEGEND_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE ROW_AT_COLJ_BEGEND ( NAME, NROWS, NCOLS, NTERM, I_A, J_A, ROW_AT_COLJ USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ROW_AT_COLJ_BEGEND_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE ROW_AT_COLJ_BEGEND ( NAME, NROWS, NCOLS, NTERM, I_A, J_A, ROW_AT_COLJ INTEGER(LONG), INTENT(IN ) :: J_A(NTERM) ! Array of column numbers for matrix A INTEGER(LONG), INTENT(OUT) :: ROW_AT_COLJ_BEG(NCOLS)! jth term is row number in MATIN where col j nonzeros begin INTEGER(LONG), INTENT(OUT) :: ROW_AT_COLJ_END(NCOLS)! jth term is row number in MATIN where col j nonzeros end - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROW_AT_COLJ_BEGEND_BEGEND + END SUBROUTINE ROW_AT_COLJ_BEGEND diff --git a/Source/Interfaces/RSPLINE_PROC_Interface.f90 b/Source/Interfaces/RSPLINE_PROC_Interface.f90 index ec154cbd..fa0e383d 100644 --- a/Source/Interfaces/RSPLINE_PROC_Interface.f90 +++ b/Source/Interfaces/RSPLINE_PROC_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F, L1F_MSG, LINK1F, L1J + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F, L1F_MSG, LINK1F, L1J USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MRSPLINE, NCORD, NGRID, NTERM_RMG USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : CORD, GRID, RGRID, GRID_ID, CORD USE PARAMS, ONLY : EPSIL @@ -48,7 +47,7 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) INTEGER(LONG), INTENT(INOUT) :: IERR ! Count of errors in RIGID_ELEM_PROC INTEGER(LONG), INTENT(INOUT) :: REC_NO ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + 1 + END SUBROUTINE RSPLINE_PROC diff --git a/Source/Interfaces/RW_INCLUDE_FILES_Interface.f90 b/Source/Interfaces/RW_INCLUDE_FILES_Interface.f90 index a3382857..010ef8e8 100644 --- a/Source/Interfaces/RW_INCLUDE_FILES_Interface.f90 +++ b/Source/Interfaces/RW_INCLUDE_FILES_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE RW_INCLUDE_FILES ( UNIT_IN, UNIT_OUT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, FILE_NAM_MAXLEN, INCFIL + USE IOUNT1, ONLY : ERR, F06, FILE_NAM_MAXLEN, INCFIL USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RW_INCLUDE_FILES_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RW_INCLUDE_FILES_BEGEND + INTEGER(LONG), INTENT(IN) :: UNIT_IN ! Unit number to read INCLUDE entries from INTEGER(LONG), INTENT(IN) :: UNIT_OUT ! Unit number to write INCLUDE entries to diff --git a/Source/Interfaces/SEQ_PROC_Interface.f90 b/Source/Interfaces/SEQ_PROC_Interface.f90 index 9a5bf4fa..d81d2cb9 100644 --- a/Source/Interfaces/SEQ_PROC_Interface.f90 +++ b/Source/Interfaces/SEQ_PROC_Interface.f90 @@ -32,20 +32,19 @@ SUBROUTINE SEQ_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SEQ, L1B - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, SEQFIL - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, SEQSTAT + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SEQ, L1B + USE IOUNT1, ONLY : WRT_ERR, SEQFIL + USE IOUNT1, ONLY : WRT_ERR, SEQSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, FATAL_ERR, NGRID, NSEQ, PROG_NAME, WARN_ERR USE PARAMS, ONLY : EPSIL, GRIDSEQ USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : SEQ_PROC_BEGEND USE MODEL_STUF, ONLY : GRID_ID, GRID_SEQ, INV_GRID_SEQ, SEQ1, SEQ2 USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SEQ_PROC_BEGEND + END SUBROUTINE SEQ_PROC diff --git a/Source/Interfaces/SET_FILE_CLOSE_STAT_Interface.f90 b/Source/Interfaces/SET_FILE_CLOSE_STAT_Interface.f90 index 0f5a87ce..bbfda637 100644 --- a/Source/Interfaces/SET_FILE_CLOSE_STAT_Interface.f90 +++ b/Source/Interfaces/SET_FILE_CLOSE_STAT_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE SET_FILE_CLOSE_STAT ( CLOSE_STAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERRSTAT, F04STAT, SEQSTAT, SPCSTAT, L1ASTAT, & + USE IOUNT1, ONLY : WRT_ERR, ERRSTAT, SEQSTAT, SPCSTAT, L1ASTAT, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1TSTAT, L1JSTAT, & L1KSTAT, L1LSTAT, L1MSTAT, L1NSTAT, L1OSTAT, L1PSTAT, L1QSTAT, L1RSTAT, L1SSTAT, L1USTAT, & L1VSTAT, L1WSTAT, L1XSTAT, L1YSTAT, L1ZSTAT, & diff --git a/Source/Interfaces/SET_SPARSE_MAT_SYM_Interface.f90 b/Source/Interfaces/SET_SPARSE_MAT_SYM_Interface.f90 index 5aa4af00..2fa166c6 100644 --- a/Source/Interfaces/SET_SPARSE_MAT_SYM_Interface.f90 +++ b/Source/Interfaces/SET_SPARSE_MAT_SYM_Interface.f90 @@ -31,7 +31,7 @@ MODULE SET_SPARSE_MAT_SYM_Interface SUBROUTINE SET_SPARSE_MAT_SYM - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : SPARSTOR, SUPINFO diff --git a/Source/Interfaces/SHELL_ABD_MATRICES_Interface.f90 b/Source/Interfaces/SHELL_ABD_MATRICES_Interface.f90 index 8509f8c8..8977f187 100644 --- a/Source/Interfaces/SHELL_ABD_MATRICES_Interface.f90 +++ b/Source/Interfaces/SHELL_ABD_MATRICES_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE SHELL_ABD_MATRICES ( INT_ELEM_ID, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEMATC, MRMATLC, MPCOMP_PLIES, MPCOMP0, MRPCOMP_PLIES, MRPCOMP0, & WARN_ERR USE TIMDAT, ONLY : TSEC @@ -46,7 +46,6 @@ SUBROUTINE SHELL_ABD_MATRICES ( INT_ELEM_ID, WRITE_WARN ) RPSHEL, RHO, RMATL, SHELL_A, SHELL_B, SHELL_D, SHELL_T, SHELL_AALP, SHELL_BALP, & SHELL_DALP, SHELL_TALP, SHELL_T_MOD, THETA_PLY, TPLY, TYPE, ULT_STRE, ULT_STRN, ZPLY, ZS - USE SUBR_BEGEND_LEVELS, ONLY : SHELL_ABD_MATRICES_BEGEND USE SHELL_ABD_MATRICES_USE_IFs @@ -59,7 +58,7 @@ SUBROUTINE SHELL_ABD_MATRICES ( INT_ELEM_ID, WRITE_WARN ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID for which INTEGER(LONG) :: I,J,K ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHELL_ABD_MATRICES_BEGEND + REAL(DOUBLE) :: DET_SHELL_T ! Determinant of SHELL_T REAL(DOUBLE) :: EPS1 ! Small number with which to comapre zero diff --git a/Source/Interfaces/SHELL_ENGR_FORCE_OGEL_Interface.f90 b/Source/Interfaces/SHELL_ENGR_FORCE_OGEL_Interface.f90 index 86f2e31c..f7270dba 100644 --- a/Source/Interfaces/SHELL_ENGR_FORCE_OGEL_Interface.f90 +++ b/Source/Interfaces/SHELL_ENGR_FORCE_OGEL_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SHELL_ENGR_FORCE_OGEL ( NUM1 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHELL_ENGR_FORCE_OGEL_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : FCONV, STRESS USE LINK9_STUFF, ONLY : MAXREQ, MAXREQ, OGEL @@ -43,7 +42,7 @@ SUBROUTINE SHELL_ENGR_FORCE_OGEL ( NUM1 ) IMPLICIT NONE INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHELL_ENGR_FORCE_OGEL_BEGEND + END SUBROUTINE SHELL_ENGR_FORCE_OGEL diff --git a/Source/Interfaces/SHELL_STRAIN_OUTPUTS_Interface.f90 b/Source/Interfaces/SHELL_STRAIN_OUTPUTS_Interface.f90 index 75255006..11ad1e85 100644 --- a/Source/Interfaces/SHELL_STRAIN_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/SHELL_STRAIN_OUTPUTS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SHELL_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHELL_STRAIN_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : ANY_FAILURE_THEORY, FAILURE_THEORY, PCOMP_PROPS, STRAIN, STRESS, TYPE, ZS USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OPT @@ -51,7 +50,7 @@ SUBROUTINE SHELL_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: SIZE_ALLOCATED ! No. of rows allocated to array that will be written to INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHELL_STRAIN_OUTPUTS_BEGEND + END SUBROUTINE SHELL_STRAIN_OUTPUTS diff --git a/Source/Interfaces/SHELL_STRESS_OUTPUTS_Interface.f90 b/Source/Interfaces/SHELL_STRESS_OUTPUTS_Interface.f90 index 619863c6..6bee1ee5 100644 --- a/Source/Interfaces/SHELL_STRESS_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/SHELL_STRESS_OUTPUTS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SHELL_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHELL_STRESS_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : ANY_FAILURE_THEORY, FAILURE_THEORY, PCOMP_PROPS, STRAIN, STRESS, TYPE, ZS USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OPT @@ -51,7 +50,7 @@ SUBROUTINE SHELL_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: SIZE_ALLOCATED ! No. of rows allocated to array that will be written to INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHELL_STRESS_OUTPUTS_BEGEND + END SUBROUTINE SHELL_STRESS_OUTPUTS diff --git a/Source/Interfaces/SHP2DQ_Interface.f90 b/Source/Interfaces/SHP2DQ_Interface.f90 index a7a447b2..9a170ae6 100644 --- a/Source/Interfaces/SHP2DQ_Interface.f90 +++ b/Source/Interfaces/SHP2DQ_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SHP2DQ ( IGAUS, JGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, MEFE, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, FOUR USE MODEL_STUF, ONLY : EID, EMG_IFE, ERR_SUB_NAM, NUM_EMG_FATAL_ERRS, TYPE @@ -50,7 +49,7 @@ SUBROUTINE SHP2DQ ( IGAUS, JGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI INTEGER(LONG), INTENT(IN) :: JGAUS ! J index of Gauss point (needed for some optional output) INTEGER(LONG), INTENT(IN) :: IORZZZ ! Integration order (used for debug output) INTEGER(LONG), INTENT(IN) :: NUM_NODES ! Number of element nodes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHP_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point location component REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point location component diff --git a/Source/Interfaces/SHP3DH_Interface.f90 b/Source/Interfaces/SHP3DH_Interface.f90 index b7295a87..44552698 100644 --- a/Source/Interfaces/SHP3DH_Interface.f90 +++ b/Source/Interfaces/SHP3DH_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE SHP3DH ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZ PSH, DPSHG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, FOUR, EIGHT USE MODEL_STUF, ONLY : EID, TYPE @@ -52,7 +51,7 @@ SUBROUTINE SHP3DH ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZ INTEGER(LONG), INTENT(IN) :: KGAUS ! K index of Gauss point (needed for some optional output) INTEGER(LONG), INTENT(IN) :: IORZZZ ! Integration order (used for debug output) INTEGER(LONG), INTENT(IN) :: NUM_NODES ! Number of element nodes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHP_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point location component 1 REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point location component 2 diff --git a/Source/Interfaces/SHP3DP_Interface.f90 b/Source/Interfaces/SHP3DP_Interface.f90 index d7ac3da5..8a7d90c2 100644 --- a/Source/Interfaces/SHP3DP_Interface.f90 +++ b/Source/Interfaces/SHP3DP_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE SHP3DP ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, INT_ WRT_BUG_THIS_TIME, PSH, DPSHG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, HALF USE MODEL_STUF, ONLY : EID, TYPE @@ -53,7 +52,7 @@ SUBROUTINE SHP3DP ( IGAUS, JGAUS, KGAUS, NUM_NODES, CALLING_SUBR, IORD_MSG, INT_ INTEGER(LONG), INTENT(IN) :: INT_ORD_IJ ! Integration order in triangle (used for debug output) INTEGER(LONG), INTENT(IN) :: INT_ORD_K ! Integration order along z (used for debug output) INTEGER(LONG), INTENT(IN) :: NUM_NODES ! Number of element nodes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHP_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point location component 1 REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point location component 2 diff --git a/Source/Interfaces/SHP3DT_Interface.f90 b/Source/Interfaces/SHP3DT_Interface.f90 index 517e7320..5f0322b0 100644 --- a/Source/Interfaces/SHP3DT_Interface.f90 +++ b/Source/Interfaces/SHP3DT_Interface.f90 @@ -33,10 +33,9 @@ SUBROUTINE SHP3DT ( GAUSS_PT, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI, SS DPSHG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, BUG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_SHPJ_BIT, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, FOUR USE MODEL_STUF, ONLY : EID, TYPE @@ -50,7 +49,7 @@ SUBROUTINE SHP3DT ( GAUSS_PT, NUM_NODES, CALLING_SUBR, IORD_MSG, IORZZZ, SSI, SS INTEGER(LONG), INTENT(IN) :: GAUSS_PT ! Gauss point (needed for some optional output) INTEGER(LONG), INTENT(IN) :: IORZZZ ! Integration order (used for debug output) INTEGER(LONG), INTENT(IN) :: NUM_NODES ! Number of element nodes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHP_BEGEND + REAL(DOUBLE) , INTENT(IN) :: SSI ! Gauss point location component 1 REAL(DOUBLE) , INTENT(IN) :: SSJ ! Gauss point location component 2 diff --git a/Source/Interfaces/SLOAD_PROC_Interface.f90 b/Source/Interfaces/SLOAD_PROC_Interface.f90 index 88db71c7..2aaf9e6d 100644 --- a/Source/Interfaces/SLOAD_PROC_Interface.f90 +++ b/Source/Interfaces/SLOAD_PROC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SLOAD_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, L1W, LINK1W, L1W_MSG, L1WSTAT + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, L1W, LINK1W, L1W_MSG, L1WSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LLOADC, NGRID, NLOAD, NSLOAD, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SLOAD_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, SUPWARN USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -43,7 +42,7 @@ SUBROUTINE SLOAD_PROC IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SLOAD_PROC_BEGEND + END SUBROUTINE SLOAD_PROC diff --git a/Source/Interfaces/SOLID_STRAIN_OUTPUTS_Interface.f90 b/Source/Interfaces/SOLID_STRAIN_OUTPUTS_Interface.f90 index 6110aa77..9842d6eb 100644 --- a/Source/Interfaces/SOLID_STRAIN_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/SOLID_STRAIN_OUTPUTS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SOLID_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLID_STRAIN_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : STRAIN, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OPT @@ -51,7 +50,7 @@ SUBROUTINE SOLID_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: SIZE_ALLOCATED ! No. of rows allocated to array that will be written to INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLID_STRAIN_OUTPUTS_BEGEND + END SUBROUTINE SOLID_STRAIN_OUTPUTS diff --git a/Source/Interfaces/SOLID_STRESS_OUTPUTS_Interface.f90 b/Source/Interfaces/SOLID_STRESS_OUTPUTS_Interface.f90 index 98458acf..b1f50231 100644 --- a/Source/Interfaces/SOLID_STRESS_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/SOLID_STRESS_OUTPUTS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SOLID_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLID_STRESS_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : STRESS, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OPT @@ -51,7 +50,7 @@ SUBROUTINE SOLID_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: SIZE_ALLOCATED ! No. of rows allocated to array that will be written to INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLID_STRESS_OUTPUTS_BEGEND + END SUBROUTINE SOLID_STRESS_OUTPUTS diff --git a/Source/Interfaces/SOLVE_DLR_Interface.f90 b/Source/Interfaces/SOLVE_DLR_Interface.f90 index 6105b759..17a73e89 100644 --- a/Source/Interfaces/SOLVE_DLR_Interface.f90 +++ b/Source/Interfaces/SOLVE_DLR_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE SOLVE_DLR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, SCR + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, SCR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KLL_SDIA, NDOFR, NDOFL, NTERM_DLR, NTERM_KLL, & NTERM_KRL USE PARAMS, ONLY : EPSIL, PRTDLR, SOLLIB, SPARSE_FLAVOR, SPARSTOR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_DLR_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE SPARSE_MATRICES, ONLY : I2_DLR, I_DLR, J_DLR, DLR, I_DLRt, I2_DLRt, J_DLRt, DLRt, I_KRL, J_KRL, KRL, & I_KLL, I2_KLL, J_KLL, KLL @@ -48,7 +47,7 @@ SUBROUTINE SOLVE_DLR CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_DLR_BEGEND + END SUBROUTINE SOLVE_DLR diff --git a/Source/Interfaces/SOLVE_GMN_Interface.f90 b/Source/Interfaces/SOLVE_GMN_Interface.f90 index 68d2e8dd..47f90b77 100644 --- a/Source/Interfaces/SOLVE_GMN_Interface.f90 +++ b/Source/Interfaces/SOLVE_GMN_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE SOLVE_GMN ( PART_VEC_G_NM, PART_VEC_M ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SCR, L2A, LINK2A, L2A_MSG, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SCR, L2A, LINK2A, L2A_MSG, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFM, NTERM_RMG, NTERM_RMN, NTERM_RMM, NTERM_GMN USE PARAMS, ONLY : EPSIL, PRTRMG, PRTGMN, SOLLIB, SPARSE_FLAVOR, SUPINFO USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_GMN_BEGEND USE SPARSE_MATRICES, ONLY : I_RMG, J_RMG, RMG, I_RMN, J_RMN, RMN, I_RMM, J_RMM, RMM, I_GMN, J_GMN, GMN USE SPARSE_MATRICES, ONLY : SYM_RMG, SYM_RMN, SYM_RMM USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -50,7 +49,7 @@ SUBROUTINE SOLVE_GMN ( PART_VEC_G_NM, PART_VEC_M ) INTEGER(LONG), INTENT(IN) :: PART_VEC_M(NDOFM) ! Partitioning vector (1's for all M set DOF's) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_GMN_BEGEND + 1 + END SUBROUTINE SOLVE_GMN diff --git a/Source/Interfaces/SOLVE_GOA_Interface.f90 b/Source/Interfaces/SOLVE_GOA_Interface.f90 index 2c383a44..6c87d55e 100644 --- a/Source/Interfaces/SOLVE_GOA_Interface.f90 +++ b/Source/Interfaces/SOLVE_GOA_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE SOLVE_GOA USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_LOG, ERR, F04, F06, SCR + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, ERR, F06, SCR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KOO_SDIA, NDOFA, NDOFO, NTERM_GOA, NTERM_KOO, & NTERM_KAO USE PARAMS, ONLY : EPSIL, PRTGOA USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_GOA_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : SOLLIB, SPARSE_FLAVOR USE SPARSE_MATRICES, ONLY : I2_GOA, I_GOA, J_GOA, GOA, I_KOO, J_KOO, KOO, I_KAO, J_KAO, KAO @@ -47,7 +46,7 @@ SUBROUTINE SOLVE_GOA CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_GOA_BEGEND + END SUBROUTINE SOLVE_GOA diff --git a/Source/Interfaces/SOLVE_PHIZL1_Interface.f90 b/Source/Interfaces/SOLVE_PHIZL1_Interface.f90 index 27a5d1f7..845bcde5 100644 --- a/Source/Interfaces/SOLVE_PHIZL1_Interface.f90 +++ b/Source/Interfaces/SOLVE_PHIZL1_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE SOLVE_PHIZL1 ( NTERM_CRS3 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, SCR + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, SCR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KLL_SDIA, NDOFR, NDOFL, NTERM_DLR, & NTERM_PHIZL1, NTERM_KLL, NTERM_KLLs USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE PARAMS, ONLY : EPSIL, SOLLIB, SPARSE_FLAVOR, SPARSTOR - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_PHIZL1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE SCRATCH_MATRICES, ONLY : I_CRS3, J_CRS3, CRS3 USE SPARSE_MATRICES, ONLY : I2_PHIZL1, I_PHIZL1, J_PHIZL1, PHIZL1, I2_PHIZL1t, I_PHIZL1t, J_PHIZL1t, PHIZL1t, & @@ -49,7 +48,7 @@ SUBROUTINE SOLVE_PHIZL1 ( NTERM_CRS3 ) CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT INTEGER(LONG), INTENT(IN) :: NTERM_CRS3 ! Number of terms in matrix CRS3 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_PHIZL1_BEGEND + END SUBROUTINE SOLVE_PHIZL1 diff --git a/Source/Interfaces/SOLVE_UO0_Interface.f90 b/Source/Interfaces/SOLVE_UO0_Interface.f90 index e261e0b6..08a4411d 100644 --- a/Source/Interfaces/SOLVE_UO0_Interface.f90 +++ b/Source/Interfaces/SOLVE_UO0_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SOLVE_UO0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L2F, LINK2F, L2F_MSG + USE IOUNT1, ONLY : ERR, F06, L2F, LINK2F, L2F_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KOO_SDIA, NDOFO, NSUB, NTERM_KOO, NTERM_PO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_UO0_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : PRTUO0, SOLLIB, SPARSE_FLAVOR USE SPARSE_MATRICES, ONLY : I_PO, J_PO, PO, I_KOO, J_KOO, KOO @@ -46,7 +45,7 @@ SUBROUTINE SOLVE_UO0 CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_UO0_BEGEND + ! LAPACK_S values not used so null this vector diff --git a/Source/Interfaces/SORTLEN_Interface.f90 b/Source/Interfaces/SORTLEN_Interface.f90 index 0fa34ee0..d51cc96c 100644 --- a/Source/Interfaces/SORTLEN_Interface.f90 +++ b/Source/Interfaces/SORTLEN_Interface.f90 @@ -32,18 +32,17 @@ SUBROUTINE SORTLEN ( NLEN, JCT ) USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE CONSTANTS_1, ONLY : TWO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORTLEN_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: NLEN ! Length of the array that will be sorted in the calling procedure INTEGER(LONG), INTENT(OUT) :: JCT ! Sort parameter to be used by calling procedure INTEGER(LONG) :: MAX_JCT ! Max practical value of JCT to use in sort by the calling procedure. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORTLEN_BEGEND + END SUBROUTINE SORTLEN diff --git a/Source/Interfaces/SORT_GRID_RGRID_Interface.f90 b/Source/Interfaces/SORT_GRID_RGRID_Interface.f90 index 793ffe86..fc74244d 100644 --- a/Source/Interfaces/SORT_GRID_RGRID_Interface.f90 +++ b/Source/Interfaces/SORT_GRID_RGRID_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_GRID_RGRID ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MGRID, MRGRID USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_GRID_RGRID_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE SORT_GRID_RGRID ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) INTEGER(LONG) :: IDUM1 ! Dummy values in IARRAY used when switching IARRAY rows during sort INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_GRID_RGRID_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE,MRGRID)! Array RGRID REAL(DOUBLE) :: RDUM1 ! Dummy values in RARRAY used when switching RARRAY rows during sort diff --git a/Source/Interfaces/SORT_INT1_Interface.f90 b/Source/Interfaces/SORT_INT1_Interface.f90 index 1260f27b..ba50620d 100644 --- a/Source/Interfaces/SORT_INT1_Interface.f90 +++ b/Source/Interfaces/SORT_INT1_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_INT1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT1_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE SORT_INT1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY ) INTEGER(LONG) :: IDUM ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT1_BEGEND + END SUBROUTINE SORT_INT1 diff --git a/Source/Interfaces/SORT_INT1_REAL1_Interface.f90 b/Source/Interfaces/SORT_INT1_REAL1_Interface.f90 index eaa4d36e..811f3b4b 100644 --- a/Source/Interfaces/SORT_INT1_REAL1_Interface.f90 +++ b/Source/Interfaces/SORT_INT1_REAL1_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_INT1_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT1_REAL1_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE SORT_INT1_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) INTEGER(LONG) :: IDUM ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT1_REAL1_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE) ! Array of real values REAL(DOUBLE) :: RDUM ! Dummy values in RARRAY used when switching RARRAY rows during the sort. diff --git a/Source/Interfaces/SORT_INT1_REAL3_Interface.f90 b/Source/Interfaces/SORT_INT1_REAL3_Interface.f90 index c92ee979..40b52892 100644 --- a/Source/Interfaces/SORT_INT1_REAL3_Interface.f90 +++ b/Source/Interfaces/SORT_INT1_REAL3_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_INT1_REAL3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT1_REAL3_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE SORT_INT1_REAL3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) INTEGER(LONG) :: IDUM ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT1_REAL3_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE,3) ! Array of real values REAL(DOUBLE) :: RDUM ! Dummy values in RARRAY used when switching RARRAY rows during the sort. diff --git a/Source/Interfaces/SORT_INT2_Interface.f90 b/Source/Interfaces/SORT_INT2_Interface.f90 index 4f123e26..5d8368d7 100644 --- a/Source/Interfaces/SORT_INT2_Interface.f90 +++ b/Source/Interfaces/SORT_INT2_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_INT2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT2_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE SORT_INT2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2 ) INTEGER(LONG) :: IDUM1,IDUM2 ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT2_BEGEND + END SUBROUTINE SORT_INT2 diff --git a/Source/Interfaces/SORT_INT2_REAL1_Interface.f90 b/Source/Interfaces/SORT_INT2_REAL1_Interface.f90 index c2a399af..b1673bff 100644 --- a/Source/Interfaces/SORT_INT2_REAL1_Interface.f90 +++ b/Source/Interfaces/SORT_INT2_REAL1_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_INT2_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, RARR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT2_REAL1_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE SORT_INT2_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, RARR INTEGER(LONG) :: IDUM1,IDUM2 ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT2_REAL1_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE) ! Array of real values REAL(DOUBLE) :: RDUM ! Dummy values in RARRAY used when switching RARRAY rows during the sort diff --git a/Source/Interfaces/SORT_INT3_CHAR2_Interface.f90 b/Source/Interfaces/SORT_INT3_CHAR2_Interface.f90 index 2e9a5c56..3ea088ea 100644 --- a/Source/Interfaces/SORT_INT3_CHAR2_Interface.f90 +++ b/Source/Interfaces/SORT_INT3_CHAR2_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_INT3_CHAR2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT3_CHAR2_BEGEND IMPLICIT NONE @@ -54,7 +53,7 @@ SUBROUTINE SORT_INT3_CHAR2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARR INTEGER(LONG) :: IDUM1,IDUM2,IDUM3 ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT3_CHAR2_BEGEND + END SUBROUTINE SORT_INT3_CHAR2 diff --git a/Source/Interfaces/SORT_INT3_Interface.f90 b/Source/Interfaces/SORT_INT3_Interface.f90 index 507f3219..fbe50794 100644 --- a/Source/Interfaces/SORT_INT3_Interface.f90 +++ b/Source/Interfaces/SORT_INT3_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_INT3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARRAY3 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT3_BEGEND IMPLICIT NONE @@ -50,7 +49,7 @@ SUBROUTINE SORT_INT3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARRAY3 ) INTEGER(LONG) :: IDUM1,IDUM2,IDUM3 ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT3_BEGEND + END SUBROUTINE SORT_INT3 diff --git a/Source/Interfaces/SORT_REAL1_INT1_Interface.f90 b/Source/Interfaces/SORT_REAL1_INT1_Interface.f90 index 41ca5df2..d6f46925 100644 --- a/Source/Interfaces/SORT_REAL1_INT1_Interface.f90 +++ b/Source/Interfaces/SORT_REAL1_INT1_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_REAL1_INT1 ( CALLING_SUBR, MESSAG, NSIZE, RARRAY, IARRAY ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_REAL1_INT1_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE SORT_REAL1_INT1 ( CALLING_SUBR, MESSAG, NSIZE, RARRAY, IARRAY ) INTEGER(LONG) :: IDUM ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_REAL1_INT1_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE) ! Array of real values REAL(DOUBLE) :: RDUM ! Dummy values in RARRAY used when switching RARRAY rows during sort. diff --git a/Source/Interfaces/SORT_TDOF_Interface.f90 b/Source/Interfaces/SORT_TDOF_Interface.f90 index 52923062..bef6b247 100644 --- a/Source/Interfaces/SORT_TDOF_Interface.f90 +++ b/Source/Interfaces/SORT_TDOF_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SORT_TDOF ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, ICOL ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MTDOF USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_TDOF_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE SORT_TDOF ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, ICOL ) INTEGER(LONG) :: IDUM(MTDOF) ! Dummy values in IARRAY used when switching IARRAY rows during sort. INTEGER(LONG) :: JCT ! Shell sort parameter returned from subroutine SORTLEN. INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_TDOF_BEGEND + END SUBROUTINE SORT_TDOF diff --git a/Source/Interfaces/SPARSE_CRS_SPARSE_CCS_Interface.f90 b/Source/Interfaces/SPARSE_CRS_SPARSE_CCS_Interface.f90 index 34ed0959..25e8dd49 100644 --- a/Source/Interfaces/SPARSE_CRS_SPARSE_CCS_Interface.f90 +++ b/Source/Interfaces/SPARSE_CRS_SPARSE_CCS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SPARSE_CRS_SPARSE_CCS ( NROWS_A, NCOLS_A, NTERMS_A, MAT_A_NAME, I_A, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_CRS_SPARSE_CCS_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -53,7 +52,7 @@ SUBROUTINE SPARSE_CRS_SPARSE_CCS ( NROWS_A, NCOLS_A, NTERMS_A, MAT_A_NAME, I_A, INTEGER(LONG), INTENT(IN) :: J_A(NTERMS_A) ! Col numbers for nonzero terms in A INTEGER(LONG), INTENT(OUT) :: I_B(NTERMS_A) ! Row numbers for nonzero terms in B INTEGER(LONG), INTENT(OUT) :: J_B(NCOLS_A+1) ! J_B(I+1) - J_B(I) are the number of nonzeros in B col I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_CRS_SPARSE_CCS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NTERMS_A) ! Real nonzero values in input matrix A REAL(DOUBLE) , INTENT(OUT) :: B(NTERMS_A) ! Real nonzero values in output matrix B diff --git a/Source/Interfaces/SPARSE_CRS_TERM_COUNT_Interface.f90 b/Source/Interfaces/SPARSE_CRS_TERM_COUNT_Interface.f90 index f6233db2..fd264de4 100644 --- a/Source/Interfaces/SPARSE_CRS_TERM_COUNT_Interface.f90 +++ b/Source/Interfaces/SPARSE_CRS_TERM_COUNT_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SPARSE_CRS_TERM_COUNT ( NROWS, NTERM_IN, MATIN_NAME, I_MATIN, J_MATIN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_CRS_TERM_COUNT_BEGEND IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE SPARSE_CRS_TERM_COUNT ( NROWS, NTERM_IN, MATIN_NAME, I_MATIN, J_MATIN INTEGER(LONG), INTENT(IN) :: I_MATIN(NROWS+1) ! I_MATIN(I+1) - I_MATIN(I) are the number of nonzeros in MATIN row I INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERM_IN) ! Col numbers for nonzero terms in MATIN INTEGER(LONG), INTENT(OUT) :: NTERM_OUT ! Number of nonzero terms in output matrix, MATOUT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_CRS_TERM_COUNT_BEGEND + END SUBROUTINE SPARSE_CRS_TERM_COUNT diff --git a/Source/Interfaces/SPARSE_CRS_TO_FULL_Interface.f90 b/Source/Interfaces/SPARSE_CRS_TO_FULL_Interface.f90 index 206452ff..1517d81a 100644 --- a/Source/Interfaces/SPARSE_CRS_TO_FULL_Interface.f90 +++ b/Source/Interfaces/SPARSE_CRS_TO_FULL_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE SPARSE_CRS_TO_FULL ( MATIN_NAME, NTERM_IN, NROWS, NCOLS, SYM_IN, I_MA USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_CRS_TO_FULL_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE SPARSE_CRS_TO_FULL ( MATIN_NAME, NTERM_IN, NROWS, NCOLS, SYM_IN, I_MA INTEGER(LONG), INTENT(IN) :: NTERM_IN ! Number of nonzero terms in input matrix, MATIN INTEGER(LONG), INTENT(IN) :: I_MATIN(NROWS+1) ! I_MATIN(I+1) - I_MATIN(I) are the number of nonzeros in MATIN row I INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERM_IN) ! Col numbers for nonzero terms in MATIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_CRS_TO_FULL_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM_IN) ! Real nonzero values in input matrix MATIN REAL(DOUBLE) , INTENT(OUT) :: MATOUT(NROWS,NCOLS) ! Real nonzero values in output matrix MATOUT diff --git a/Source/Interfaces/SPARSE_KGGD_Interface.f90 b/Source/Interfaces/SPARSE_KGGD_Interface.f90 index cd580f22..8cd423b9 100644 --- a/Source/Interfaces/SPARSE_KGGD_Interface.f90 +++ b/Source/Interfaces/SPARSE_KGGD_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SPARSE_KGGD USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, SPCFIL, SPC, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, SPCFIL, SPC, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NGRID, NIND_GRDS_MPCS, & NTERM_KGGD, NUM_PCHD_SPC1, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_KGGD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : AUTOSPC, AUTOSPC_RAT, EPSIL, PRTSTIFF, SPC1QUIT, SUPINFO, SUPWARN USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -49,7 +48,7 @@ SUBROUTINE SPARSE_KGGD CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_KGGD_BEGEND + END SUBROUTINE SPARSE_KGGD diff --git a/Source/Interfaces/SPARSE_KGG_Interface.f90 b/Source/Interfaces/SPARSE_KGG_Interface.f90 index 9fd73b19..b540f6cf 100644 --- a/Source/Interfaces/SPARSE_KGG_Interface.f90 +++ b/Source/Interfaces/SPARSE_KGG_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SPARSE_KGG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1L, L1L_MSG, LINK1L, SC1, SPCFIL, SPC, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1L, L1L_MSG, LINK1L, SC1, SPCFIL, SPC, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NGRID, NIND_GRDS_MPCS, & NTERM_KGG, NUM_PCHD_SPC1, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_KGG_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : AUTOSPC, AUTOSPC_RAT, EPSIL, PRTTSET, PRTSTIFF, SPC1QUIT, SUPINFO, SUPWARN USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -49,7 +48,7 @@ SUBROUTINE SPARSE_KGG IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_KGG_BEGEND + END SUBROUTINE SPARSE_KGG diff --git a/Source/Interfaces/SPARSE_MAT_DIAG_ZEROS_Interface.f90 b/Source/Interfaces/SPARSE_MAT_DIAG_ZEROS_Interface.f90 index d45424c0..d1b5bbb5 100644 --- a/Source/Interfaces/SPARSE_MAT_DIAG_ZEROS_Interface.f90 +++ b/Source/Interfaces/SPARSE_MAT_DIAG_ZEROS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SPARSE_MAT_DIAG_ZEROS ( NAME, NROWS_A, NTERM_A, I_A, J_A, NUM_A_DIAG_ USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_MAT_DIAG_ZEROS_BEGEND IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE SPARSE_MAT_DIAG_ZEROS ( NAME, NROWS_A, NTERM_A, I_A, J_A, NUM_A_DIAG_ INTEGER(LONG), INTENT(IN) :: I_A(NROWS_A+1) ! Array of row no's for terms in input matrix A INTEGER(LONG), INTENT(IN) :: J_A(NTERM_A) ! Array of col no's for terms in input matrix A INTEGER(LONG), INTENT(OUT) :: NUM_A_DIAG_ZEROS ! Number of zero diagonal terms in input matrix A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_MAT_DIAG_ZEROS_BEGEND + END SUBROUTINE SPARSE_MAT_DIAG_ZEROS diff --git a/Source/Interfaces/SPARSE_MGG_Interface.f90 b/Source/Interfaces/SPARSE_MGG_Interface.f90 index e26f27b4..ad38ce51 100644 --- a/Source/Interfaces/SPARSE_MGG_Interface.f90 +++ b/Source/Interfaces/SPARSE_MGG_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SPARSE_MGG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1R, L1R_MSG, LINK1R, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1R, L1R_MSG, LINK1R, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCMASS, NDOFG, NGRID, NTERM_MGG, NTERM_MGGC, NTERM_MGGE, & NTERM_MGGS, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_MGG_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO, ONE USE DOF_TABLES,ONLY : TDOF_ROW_START @@ -51,7 +50,7 @@ SUBROUTINE SPARSE_MGG CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_MGG_BEGEND + END SUBROUTINE SPARSE_MGG diff --git a/Source/Interfaces/SPARSE_PG_Interface.f90 b/Source/Interfaces/SPARSE_PG_Interface.f90 index 0a3da7d9..eec18b8b 100644 --- a/Source/Interfaces/SPARSE_PG_Interface.f90 +++ b/Source/Interfaces/SPARSE_PG_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE SPARSE_PG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1E, L1E_MSG, L1ESTAT, LINK1E, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1E, L1E_MSG, L1ESTAT, LINK1E, SC1, WRT_ERR USE SCONTR, ONLY : FATAL_ERR, NDOFG, NSUB, NTERM_PG, BLNK_SUB_NAM, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_PG_BEGEND USE PARAMS, ONLY : EPSIL, PRTFOR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP, NL_NUM_LOAD_STEPS USE MODEL_STUF, ONLY : SYS_LOAD @@ -45,7 +44,7 @@ SUBROUTINE SPARSE_PG CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_PG_BEGEND + END SUBROUTINE SPARSE_PG diff --git a/Source/Interfaces/SPARSE_RMG_Interface.f90 b/Source/Interfaces/SPARSE_RMG_Interface.f90 index 1fdf2491..e589f5fb 100644 --- a/Source/Interfaces/SPARSE_RMG_Interface.f90 +++ b/Source/Interfaces/SPARSE_RMG_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE SPARSE_RMG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1J, LINK1J, L1J_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1J, LINK1J, L1J_MSG USE SCONTR, ONLY : NDOFM, NTERM_RMG, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_RMG_BEGEND USE PARAMS, ONLY : EPSIL USE SPARSE_MATRICES, ONLY : I_RMG, J_RMG, RMG IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_RMG_BEGEND + END SUBROUTINE SPARSE_RMG diff --git a/Source/Interfaces/STIFF_MAT_EQUIL_CHK_Interface.f90 b/Source/Interfaces/STIFF_MAT_EQUIL_CHK_Interface.f90 index 38567177..74da66fd 100644 --- a/Source/Interfaces/STIFF_MAT_EQUIL_CHK_Interface.f90 +++ b/Source/Interfaces/STIFF_MAT_EQUIL_CHK_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE STIFF_MAT_EQUIL_CHK ( OUTPUT, X_SET, SYM_KIN, NROWS, NTERM_KIN, I_KIN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NSPOINT, WARN_ERR USE TIMDAT, ONLY : TSEC @@ -42,7 +42,6 @@ SUBROUTINE STIFF_MAT_EQUIL_CHK ( OUTPUT, X_SET, SYM_KIN, NROWS, NTERM_KIN, I_KIN USE LAPACK_DPB_MATRICES, ONLY : ABAND USE LAPACK_BLAS_AUX USE PARAMS, ONLY : EPSIL, EQCHK_NORM, SUPWARN, SUPINFO - USE SUBR_BEGEND_LEVELS, ONLY : STIFF_MAT_EQUIL_CHK_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -55,7 +54,7 @@ SUBROUTINE STIFF_MAT_EQUIL_CHK ( OUTPUT, X_SET, SYM_KIN, NROWS, NTERM_KIN, I_KIN INTEGER(LONG), INTENT(IN) :: I_KIN(NROWS+1) ! Row start indices for KIN INTEGER(LONG), INTENT(IN) :: J_KIN(NTERM_KIN) ! Col numbers of terms in KIN INTEGER(LONG), INTENT(IN) :: OUTPUT ! =1, output PRB, =2 output RB_STRN_ENRGY, =3 output both - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STIFF_MAT_EQUIL_CHK_BEGEND + REAL(DOUBLE), INTENT(IN) :: KIN(NTERM_KIN) ! Nonzero terms in KIN REAL(DOUBLE), INTENT(IN) :: KIN_DIAG(NROWS) ! Diagonal of KIN diff --git a/Source/Interfaces/STMERR_Interface.f90 b/Source/Interfaces/STMERR_Interface.f90 index 163e6dbe..29ceb56f 100644 --- a/Source/Interfaces/STMERR_Interface.f90 +++ b/Source/Interfaces/STMERR_Interface.f90 @@ -28,23 +28,21 @@ MODULE STMERR_Interface INTERFACE - SUBROUTINE STMERR ( XTIME, FILNAM, OUNT, WRITE_F04 ) + SUBROUTINE STMERR ( XTIME, FILNAM, OUNT ) - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : STMERR_BEGEND + USE PENTIUM_II_KIND, ONLY : LONG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN + USE SCONTR, ONLY : FATAL_ERR + USE TIMDAT, ONLY : STIME IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: FILNAM ! File name - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to INTEGER(LONG), INTENT(IN) :: XTIME ! Time stamp read from file LINK1A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STMERR_BEGEND + END SUBROUTINE STMERR diff --git a/Source/Interfaces/STOKEN_Interface.f90 b/Source/Interfaces/STOKEN_Interface.f90 index 047301cd..44cb063d 100644 --- a/Source/Interfaces/STOKEN_Interface.f90 +++ b/Source/Interfaces/STOKEN_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE STOKEN ( CALLING_SUBR, TOKSTR, TOKEN_BEG, STRNG_END, NTOKEN, IERROR, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : MAX_TOKEN_LEN, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : STOKEN_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -52,7 +51,7 @@ SUBROUTINE STOKEN ( CALLING_SUBR, TOKSTR, TOKEN_BEG, STRNG_END, NTOKEN, IERROR, INTEGER(LONG), INTENT(INOUT) :: TOKEN_BEG ! On entry, where to start to look for a token in TOKSTR INTEGER(LONG), INTENT(OUT) :: IERROR ! Integer error no. when an error occurs when processing tokens INTEGER(LONG), INTENT(OUT) :: NTOKEN ! The number of tokens found in this execution - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STOKEN_BEGEND + END SUBROUTINE STOKEN diff --git a/Source/Interfaces/STR_TENSOR_TRANSFORM_Interface.f90 b/Source/Interfaces/STR_TENSOR_TRANSFORM_Interface.f90 index 1180adc6..53cff29b 100644 --- a/Source/Interfaces/STR_TENSOR_TRANSFORM_Interface.f90 +++ b/Source/Interfaces/STR_TENSOR_TRANSFORM_Interface.f90 @@ -34,15 +34,14 @@ SUBROUTINE STR_TENSOR_TRANSFORM ( STRESS_TENSOR, STRESS_CORD_SYS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE USE SCONTR, ONLY : BLNK_SUB_NAM, NCORD - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : CORD, RCORD, TE - USE SUBR_BEGEND_LEVELS, ONLY : STR_TENSOR_TRANSFORM_BEGEND IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: STRESS_CORD_SYS ! Actual coord system ID for stress/strain/engr force output - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STR_TENSOR_TRANSFORM_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: STRESS_TENSOR(3,3)! 2D stress tensor (eqn 6 above) REAL(DOUBLE) :: DUM33(3,3) ! Intermediate array used in calc outputs diff --git a/Source/Interfaces/SUBCASE_PROC_Interface.f90 b/Source/Interfaces/SUBCASE_PROC_Interface.f90 index ab59071e..89f3dcff 100644 --- a/Source/Interfaces/SUBCASE_PROC_Interface.f90 +++ b/Source/Interfaces/SUBCASE_PROC_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE SUBCASE_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1D + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1D USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, DATA_NAM_LEN, FATAL_ERR, IBIT, WARN_ERR, LSETLN, & MELDTS, MELOUTS, METYPE, MGROUTS, NELE, NGRID, NSUB @@ -42,7 +42,6 @@ SUBROUTINE SUBCASE_PROC USE PARAMS, ONLY : PRTSCP, SUPWARN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SUBCASE_PROC_BEGEND USE MODEL_STUF, ONLY : CCELDT, ONE_SET_ARRAY, SC_ACCE, SC_DISP, SC_ELFN, SC_ELFE, SC_GPFO, SC_MPCF, & SC_OLOA, SC_SPCF, SC_STRE, SC_STRN, ELDT, OELDT, ELOUT, OELOUT, GROUT, OGROUT, LABEL, & @@ -54,7 +53,7 @@ SUBROUTINE SUBCASE_PROC CHARACTER( 1*BYTE) :: PRNTOUT ! Flag used in deciding what to output if B.D. PARAM PRTSCP = 1 INTEGER(LONG) :: ELM_BIT(METYPE) ! Array used for output warning purposes - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SUBCASE_PROC_BEGEND + END SUBROUTINE SUBCASE_PROC diff --git a/Source/Interfaces/SURFACE_FIT_Interface.f90 b/Source/Interfaces/SURFACE_FIT_Interface.f90 index 6ffb865a..37d78c4c 100644 --- a/Source/Interfaces/SURFACE_FIT_Interface.f90 +++ b/Source/Interfaces/SURFACE_FIT_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE SURFACE_FIT ( NUM_FITS, NUM_COEFFS, XI, YI, WI, XO, YO, WO, DEB, MESS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE - USE SUBR_BEGEND_LEVELS, ONLY : SURFACE_FIT_BEGEND USE LSQ_MYSTRAN IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE SURFACE_FIT ( NUM_FITS, NUM_COEFFS, XI, YI, WI, XO, YO, WO, DEB, MESS INTEGER(LONG), INTENT(IN) :: OUNT(2) ! Output units for SURFACE_FIT INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator INTEGER(LONG), PARAMETER :: MAX_COEFFS = 6 ! Maximum number of coefficients coded for ther polynomial fit - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SURFACE_FIT_BEGEND + REAL(DOUBLE), INTENT(IN) :: WI(NUM_FITS) ! Values of the function to fit at the input data points REAL(DOUBLE), INTENT(IN) :: XI(NUM_FITS) ! X coords of the input data points diff --git a/Source/Interfaces/SUSER1_Interface.f90 b/Source/Interfaces/SUSER1_Interface.f90 index 61c46fd8..581eafcc 100644 --- a/Source/Interfaces/SUSER1_Interface.f90 +++ b/Source/Interfaces/SUSER1_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE SUSER1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SUSER1_BEGEND USE MODEL_STUF, ONLY : TYPE IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'SUSER1' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SUSER1_BEGEND + END SUBROUTINE SUSER1 diff --git a/Source/Interfaces/SYM_MAT_DECOMP_LAPACK_Interface.f90 b/Source/Interfaces/SYM_MAT_DECOMP_LAPACK_Interface.f90 index d88a6346..3b754075 100644 --- a/Source/Interfaces/SYM_MAT_DECOMP_LAPACK_Interface.f90 +++ b/Source/Interfaces/SYM_MAT_DECOMP_LAPACK_Interface.f90 @@ -34,7 +34,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N EQUIL_SCALE_FACS, INFO ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, LINKNO USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE CONSTANTS_1, ONLY : ZERO, ONE, ONEPP6 @@ -43,7 +43,6 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N USE DEBUG_PARAMETERS, ONLY : DEBUG, NDEBUG USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM USE LAPACK_LIN_EQN_DPB - USE SUBR_BEGEND_LEVELS, ONLY : SYM_MAT_DECOMP_LAPACK_BEGEND IMPLICIT NONE @@ -70,7 +69,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N INTEGER(LONG), INTENT(INOUT) :: INFO ! Output from LAPACK routine to do factorization of ABAND INTEGER(LONG), INTENT(OUT) :: MATIN_SDIA ! No. of superdiags in the MATIN upper triangle - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SYM_MAT_DECOMP_LAPACK_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERMS) ! A small number to compare real zero REAL(DOUBLE) , INTENT(OUT) :: RCOND ! Recrip of cond no. of MATIN. Determined in subr COND_NUM diff --git a/Source/Interfaces/SYM_MAT_DECOMP_SUPRLU_Interface.f90 b/Source/Interfaces/SYM_MAT_DECOMP_SUPRLU_Interface.f90 index 41e65bc6..8fb001e6 100644 --- a/Source/Interfaces/SYM_MAT_DECOMP_SUPRLU_Interface.f90 +++ b/Source/Interfaces/SYM_MAT_DECOMP_SUPRLU_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE SYM_MAT_DECOMP_SUPRLU ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : CRS_CCS, SPARSTOR USE SCRATCH_MATRICES, ONLY : I_CCS1, J_CCS1, CCS1 USE SuperLU_STUF, ONLY : SLU_FACTORS - USE SUBR_BEGEND_LEVELS, ONLY : SYM_MAT_DECOMP_SUPRLU_BEGEND IMPLICIT NONE @@ -60,7 +59,7 @@ SUBROUTINE SYM_MAT_DECOMP_SUPRLU ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N INTEGER(LONG), INTENT(INOUT) :: INFO ! Output from SuperLU routine - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SYM_MAT_DECOMP_SUPRLU_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERMS) ! A small number to compare real zero diff --git a/Source/Interfaces/TDOF_COL_NUM_Interface.f90 b/Source/Interfaces/TDOF_COL_NUM_Interface.f90 index 04014cbe..0192219c 100644 --- a/Source/Interfaces/TDOF_COL_NUM_Interface.f90 +++ b/Source/Interfaces/TDOF_COL_NUM_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE TDOF_COL_NUM ( CHAR_SET, COL_NUM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MTDOF, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TDOF_COL_NUM_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE TDOF_COL_NUM ( CHAR_SET, COL_NUM ) INTEGER(LONG), INTENT(OUT) :: COL_NUM ! Col number in array TDOF where displ set CHAR_SET exists INTEGER(LONG), PARAMETER :: OFFSET = 4 ! Columns of TDOF prior to where the G-set begins - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TDOF_COL_NUM_BEGEND + END SUBROUTINE TDOF_COL_NUM diff --git a/Source/Interfaces/TDOF_PROC_Interface.f90 b/Source/Interfaces/TDOF_PROC_Interface.f90 index f95b18af..cabec193 100644 --- a/Source/Interfaces/TDOF_PROC_Interface.f90 +++ b/Source/Interfaces/TDOF_PROC_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LDOFG, MTDOF, NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, NDOFN, NDOFO, & NDOFR, NDOFS, NDOFSA, NDOFSB, NDOFSE, NDOFSG, NDOFSZ, NGRID, NUM_USET_U1, NUM_USET_U2, & SOL_NAME, WARN_ERR USE PARAMS, ONLY : EIGESTL, PRTDOF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET, TDOF, TDOFI, TDOF_ROW_START, USET USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : EIG_N2, GRID, GRID_ID, GRID_SEQ, INV_GRID_SEQ @@ -49,7 +48,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CHARACTER(LEN=*), INTENT(IN) :: TDOF_MSG ! Message to be printed out regarding at what point in the run the TDOF,I INTEGER(LONG) :: I_USET_U1 ! Counter for USET U1 INTEGER(LONG) :: I_USET_U2 ! Counter for USET U2 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + END SUBROUTINE TDOF_PROC diff --git a/Source/Interfaces/TEMPERATURE_DATA_PROC_Interface.f90 b/Source/Interfaces/TEMPERATURE_DATA_PROC_Interface.f90 index 33e16b28..694cdf22 100644 --- a/Source/Interfaces/TEMPERATURE_DATA_PROC_Interface.f90 +++ b/Source/Interfaces/TEMPERATURE_DATA_PROC_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE TEMPERATURE_DATA_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1K - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, LINK1K - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, L1K_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1K + USE IOUNT1, ONLY : WRT_ERR, LINK1K + USE IOUNT1, ONLY : WRT_ERR, L1K_MSG USE SCONTR, ONLY : DATA_NAM_LEN, NELE, NGRID, NTDAT, NTSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TEMPERATURE_DATA_PROC_BEGEND USE MODEL_STUF, ONLY : CETEMP, CETEMP_ERR, CGTEMP, CGTEMP_ERR, ETEMP, GTEMP, TDATA, TPNT, GRID_ID, ESORT1, ETYPE,& SCNUM, SUBLOD, eid USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -46,7 +45,7 @@ SUBROUTINE TEMPERATURE_DATA_PROC CHARACTER( 1*BYTE) :: NOTE ! Used to indicate whether or not to print out a message - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TEMPERATURE_DATA_PROC_BEGEND + END SUBROUTINE TEMPERATURE_DATA_PROC diff --git a/Source/Interfaces/TETRA_Interface.f90 b/Source/Interfaces/TETRA_Interface.f90 index 3e9cd8f3..c64cab05 100644 --- a/Source/Interfaces/TETRA_Interface.f90 +++ b/Source/Interfaces/TETRA_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE TETRA ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_TETRA, NTSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : HALF, QUARTER, ZERO, FOUR USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : TETRA_BEGEND USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : ALPVEC, BE1, BE2, DT, EID, ELGP, NUM_EMG_FATAL_ERRS, ES, KE, KED, ME, PTE, RHO, & @@ -53,7 +52,7 @@ SUBROUTINE TETRA ( OPT, INT_ELEM_ID, IORD, RED_INT_SHEAR, WRITE_WARN ) INTEGER(LONG), INTENT(IN) :: INT_ELEM_ID ! Internal element ID INTEGER(LONG), INTENT(IN) :: IORD ! Gaussian integ order for element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TETRA_BEGEND + REAL(DOUBLE) :: CBAR(3,3*ELGP) ! Derivatives of shape fcns wrt x,y,z used in diff stiff matrix REAL(DOUBLE) :: DUM0(3*ELGP) ! Intermediate matrix used in solving for elem matrices diff --git a/Source/Interfaces/TMEM1_Interface.f90 b/Source/Interfaces/TMEM1_Interface.f90 index 2131f506..4cfc05ea 100644 --- a/Source/Interfaces/TMEM1_Interface.f90 +++ b/Source/Interfaces/TMEM1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE TMEM1 ( OPT, AREA, X2E, X3E, Y3E, WRT_BUG_THIS_TIME, BIG_BM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, F04, WRT_BUG, WRT_LOG + USE IOUNT1, ONLY : BUG, WRT_BUG USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_BCHK_BIT, ELDT_BUG_BMAT_BIT, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TMEM1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, THREE USE MODEL_STUF, ONLY : ALPVEC, BE1, EID, DT, EM, ELDOF, KE, PCOMP_LAM, PCOMP_PROPS, PRESS, PPE, PTE, SE1, STE1, & SHELL_AALP, SHELL_A, SHELL_PROP_ALP, TREF, TYPE, XEB, XEL @@ -46,7 +45,7 @@ SUBROUTINE TMEM1 ( OPT, AREA, X2E, X3E, Y3E, WRT_BUG_THIS_TIME, BIG_BM ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices CHARACTER( 1*BYTE), INTENT(IN) :: WRT_BUG_THIS_TIME ! If 'Y' then write to BUG file if WRT_BUG array says to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TMEM1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: X2E ! x coord of elem node 2 diff --git a/Source/Interfaces/TOKCHK_Interface.f90 b/Source/Interfaces/TOKCHK_Interface.f90 index 8d81d6b3..5f17ae9d 100644 --- a/Source/Interfaces/TOKCHK_Interface.f90 +++ b/Source/Interfaces/TOKCHK_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE TOKCHK ( TOKEN, TOKTYPE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 IMPLICIT NONE diff --git a/Source/Interfaces/TPLT1_Interface.f90 b/Source/Interfaces/TPLT1_Interface.f90 index 6ee9db80..95a6613a 100644 --- a/Source/Interfaces/TPLT1_Interface.f90 +++ b/Source/Interfaces/TPLT1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE TPLT1 ( OPT, AREA, X2E, X3E, Y3E ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TPLT1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, THREE, FOUR, SIX, TWELVE USE MODEL_STUF, ONLY : ALPVEC, BE2, DT, EB, KE, PRESS, PPE, PTE, SHELL_DALP, SHELL_D, SHELL_PROP_ALP, SE2, STE2 @@ -43,7 +42,7 @@ SUBROUTINE TPLT1 ( OPT, AREA, X2E, X3E, Y3E ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TPLT1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: X2E ! x coord of elem node 2 diff --git a/Source/Interfaces/TPLT2_Interface.f90 b/Source/Interfaces/TPLT2_Interface.f90 index 63ab7aa4..d977db03 100644 --- a/Source/Interfaces/TPLT2_Interface.f90 +++ b/Source/Interfaces/TPLT2_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE TPLT2(OPT, AREA, X2E, X3E, Y3E, CALC_EMATS, IERROR, KV, PTV, PPV, B2V USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MEMATC, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TPLT2_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, THREE, FOUR, SIX, EIGHT, TWELVE, CONV_RAD_DEG USE MODEL_STUF, ONLY : ALPVEC, BE2, BE3, BENSUM, DT, EB, EBM, EID, ET, ELDOF, FCONV, KE, & MTRL_TYPE, PCOMP_LAM, PCOMP_PROPS, PHI_SQ, PPE, PRESS, PTE, SE2, SE3, SHELL_B, SHELL_DALP,& @@ -64,7 +63,7 @@ SUBROUTINE TPLT2(OPT, AREA, X2E, X3E, Y3E, CALC_EMATS, IERROR, KV, PTV, PPV, B2V 5, & ! ID(7) = 5 means virgin 9x9 elem DOF 7 is MYSTRAN 18x18 elem DOF 5 11, & ! ID(8) = 11 means virgin 9x9 elem DOF 8 is MYSTRAN 18x18 elem DOF 11 17 /) ! ID(9) = 17 means virgin 9x9 elem DOF 9 is MYSTRAN 18x18 elem DOF 17 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TPLT2_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AREA ! Element area REAL(DOUBLE) , INTENT(IN) :: PSI ! Angle to rotate orthotropic mat'l matrix of a sub-tria to align w QUAD diff --git a/Source/Interfaces/TRANSFORM_NODE_FORCES_Interface.f90 b/Source/Interfaces/TRANSFORM_NODE_FORCES_Interface.f90 index 5b696e2a..e2f18845 100644 --- a/Source/Interfaces/TRANSFORM_NODE_FORCES_Interface.f90 +++ b/Source/Interfaces/TRANSFORM_NODE_FORCES_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE TRANSFORM_NODE_FORCES ( COORD_SYS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MELGP, NCORD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TRANSFORM_NODE_FORCES_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : CAN_ELEM_TYPE_OFFSET, GRID, CORD, BGRID, ELDOF, ELGP, OFFDIS, OFFSET, PEB, PEG, PEL, TE, & TYPE @@ -50,7 +49,7 @@ SUBROUTINE TRANSFORM_NODE_FORCES ( COORD_SYS ) INTEGER(LONG), PARAMETER :: NROW = 3 ! An input to subr MATPUT, MATGET called herein INTEGER(LONG), PARAMETER :: NCOL = 1 ! An input to subr MATPUT, MATGET called herein INTEGER(LONG), PARAMETER :: PCOL = 1 ! An input to subr MATPUT, MATGET called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TRANSFORM_NODE_FORCES_BEGEND + REAL(DOUBLE) :: THETAD,PHID ! Returns from subr GEN_T0L (not used here) diff --git a/Source/Interfaces/TREL1_Interface.f90 b/Source/Interfaces/TREL1_Interface.f90 index 5cf5737b..ee5dc578 100644 --- a/Source/Interfaces/TREL1_Interface.f90 +++ b/Source/Interfaces/TREL1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE TREL1 ( OPT, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, MEWE, NSUB, NTSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TREL1_BEGEND USE CONSTANTS_1, ONLY : ZERO, TENTH, ONE, TWO, THREE, TWELVE USE PARAMS, ONLY : SUPWARN USE MODEL_STUF, ONLY : EID, ELDOF, EMG_IWE, EMG_RWE, INTL_MID, KE, MASS_PER_UNIT_AREA, ME, & @@ -47,7 +46,7 @@ SUBROUTINE TREL1 ( OPT, WRITE_WARN ) CHARACTER(1*BYTE), INTENT(IN) :: OPT(6) ! 'Y'/'N' flags for whether to calc certain elem matrices CHARACTER(LEN=*), INTENT(IN) :: WRITE_WARN ! If 'Y" write warning messages, otherwise do not - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TREL1_BEGEND + REAL(DOUBLE) :: M0 ! An intermediate variable used in calc elem mass, ME diff --git a/Source/Interfaces/TSET_PROC_FOR_MPCS_Interface.f90 b/Source/Interfaces/TSET_PROC_FOR_MPCS_Interface.f90 index 7a686a8d..ccc83b3b 100644 --- a/Source/Interfaces/TSET_PROC_FOR_MPCS_Interface.f90 +++ b/Source/Interfaces/TSET_PROC_FOR_MPCS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1S, L1S_MSG, LINK1S + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1S, L1S_MSG, LINK1S USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LIND_GRDS_MPCS, LMPCADDC, NDOFM, NGRID, NIND_GRDS_MPCS, NMPC, & NMPCADD, NTERM_RMG, NUM_MPCSIDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID_ID, MPC_IND_GRIDS, MPCSET, MPCSIDS @@ -46,7 +45,7 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) INTEGER(LONG), INTENT(INOUT) :: IERRT ! Sum of all grid and DOF errors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + END SUBROUTINE TSET_PROC_FOR_MPCS diff --git a/Source/Interfaces/TSET_PROC_FOR_OMITS_Interface.f90 b/Source/Interfaces/TSET_PROC_FOR_OMITS_Interface.f90 index 1e78c739..f47924e0 100644 --- a/Source/Interfaces/TSET_PROC_FOR_OMITS_Interface.f90 +++ b/Source/Interfaces/TSET_PROC_FOR_OMITS_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1N, L1N_MSG, LINK1N + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1N, L1N_MSG, LINK1N USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NAOCARD, NDOFO, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID IMPLICIT NONE INTEGER(LONG), INTENT(INOUT) :: IERRT ! Sum of all grid and DOF errors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + END SUBROUTINE TSET_PROC_FOR_OMITS diff --git a/Source/Interfaces/TSET_PROC_FOR_RIGELS_Interface.f90 b/Source/Interfaces/TSET_PROC_FOR_RIGELS_Interface.f90 index 598963e3..3c04c8b7 100644 --- a/Source/Interfaces/TSET_PROC_FOR_RIGELS_Interface.f90 +++ b/Source/Interfaces/TSET_PROC_FOR_RIGELS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L1F, L1F_MSG, LINK1F + USE IOUNT1, ONLY : ERR, F06, L1F, L1F_MSG, LINK1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LIND_GRDS_MPCS, NDOFM, NGRID, NIND_GRDS_MPCS, NRECARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID, MPC_IND_GRIDS @@ -43,7 +42,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) INTEGER(LONG), INTENT(INOUT) :: IERRT ! Sum of all grid and DOF errors INTEGER(LONG) :: IDUM(6) ! Integer values read that are not used - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + REAL(DOUBLE) :: RDUM ! Real value read that is not used diff --git a/Source/Interfaces/TSET_PROC_FOR_SPCS_Interface.f90 b/Source/Interfaces/TSET_PROC_FOR_SPCS_Interface.f90 index c59dc993..c27c1622 100644 --- a/Source/Interfaces/TSET_PROC_FOR_SPCS_Interface.f90 +++ b/Source/Interfaces/TSET_PROC_FOR_SPCS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1H, L1O, L1O_MSG, LINK1O + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1H, L1O, L1O_MSG, LINK1O USE SCONTR, ONLY : BLNK_SUB_NAM, ENFORCED, FATAL_ERR, LSPCADDC, NDOFSB, NDOFSE, NDOFSG, NGRID, NSPCADD, & NUM_SPC_RECORDS, NUM_SPC1_RECORDS, NUM_SPCSIDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE PARAMS, ONLY : EPSIL USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID, SPCADD_SIDS, SPCSET, SPCSIDS @@ -44,7 +43,7 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) IMPLICIT NONE INTEGER(LONG), INTENT(INOUT) :: IERRT ! Sum of all grid and DOF errors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + END SUBROUTINE TSET_PROC_FOR_SPCS diff --git a/Source/Interfaces/TSET_PROC_FOR_SUPORTS_Interface.f90 b/Source/Interfaces/TSET_PROC_FOR_SUPORTS_Interface.f90 index 3546c15f..4a528192 100644 --- a/Source/Interfaces/TSET_PROC_FOR_SUPORTS_Interface.f90 +++ b/Source/Interfaces/TSET_PROC_FOR_SUPORTS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE TSET_PROC_FOR_SUPORTS ( IERRT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1T, L1T_MSG, LINK1T + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1T, L1T_MSG, LINK1T USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NGRID, NUM_SUPT_CARDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE PARAMS, ONLY : EPSIL USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID @@ -43,7 +42,7 @@ SUBROUTINE TSET_PROC_FOR_SUPORTS ( IERRT ) IMPLICIT NONE INTEGER(LONG), INTENT(INOUT) :: IERRT ! Sum of all grid and DOF errors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + END SUBROUTINE TSET_PROC_FOR_SUPORTS diff --git a/Source/Interfaces/UNIX_TIME_Interface.f90 b/Source/Interfaces/UNIX_TIME_Interface.f90 index 49df4b4f..30714157 100644 --- a/Source/Interfaces/UNIX_TIME_Interface.f90 +++ b/Source/Interfaces/UNIX_TIME_Interface.f90 @@ -1,52 +1,43 @@ ! ############################################################################################################################### -! Begin MIT license text. +! Begin MIT license text. ! _______________________________________________________________________________________________________ - -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) - -! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and ! associated documentation files (the "Software"), to deal in the Software without restriction, including ! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to -! the following conditions: - -! The above copyright notice and this permission notice shall be included in all copies or substantial -! portions of the Software and documentation. - -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -! THE SOFTWARE. +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. ! _______________________________________________________________________________________________________ - -! End MIT license text. + +! End MIT license text. MODULE UNIX_TIME_Interface INTERFACE SUBROUTINE UNIX_TIME(T) - + USE PENTIUM_II_KIND, ONLY: LONG IMPLICIT NONE - + INTEGER(LONG), INTENT(OUT) :: T - CHARACTER(LEN=8) :: DATE_C - CHARACTER(LEN=10) :: TIME_C - CHARACTER(LEN=5) :: ZONE_C - INTEGER :: VALUES(8) - INTEGER :: Y, MO, DA, HH, MM, SS - INTEGER :: ZH, ZM, SIGN - INTEGER(LONG) :: TZ_MIN, Y0, M0, A, B, JDN, EPOCH END SUBROUTINE UNIX_TIME END INTERFACE END MODULE UNIX_TIME_Interface - - \ No newline at end of file diff --git a/Source/Interfaces/USERIN_Interface.f90 b/Source/Interfaces/USERIN_Interface.f90 index 34d0acfb..6eb728b0 100644 --- a/Source/Interfaces/USERIN_Interface.f90 +++ b/Source/Interfaces/USERIN_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN4, IN4_MSG, IN4FIL, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN4, IN4_MSG, IN4FIL USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MEDAT0_CUSERIN, MELDOF, NDOFG, NGRID, NSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO @@ -47,7 +47,6 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) USERIN_NUM_BDY_DOF, USERIN_NUM_ACT_GRDS, USERIN_NUM_SPOINTS, & USERIN_MASS_MAT_NAME, USERIN_LOAD_MAT_NAME, USERIN_RBM0_MAT_NAME, USERIN_STIF_MAT_NAME - USE SUBR_BEGEND_LEVELS, ONLY : USERIN_BEGEND IMPLICIT NONE @@ -60,7 +59,7 @@ SUBROUTINE USERIN ( INT_ELEM_ID, OPT, EMG_CALLING_SUBR, WRITE_WARN ) ! Array that has USERIN grid num in col 1 and comp number in remaining 7 ! cols (1 col has all comps, others each indiv comp) for USERIN bdy DOF's INTEGER(LONG) :: USERIN_CID0_ICID ! Internal coordinate system ID for USERIN_CID0 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = USERIN_BEGEND + REAL(DOUBLE) :: DX ! X offset of USERIN elem CG from overall model basic sys origin REAL(DOUBLE) :: DY ! Y offset of USERIN elem CG from overall model basic sys origin diff --git a/Source/Interfaces/USET_PROC_Interface.f90 b/Source/Interfaces/USET_PROC_Interface.f90 index 8fc5fee1..ea2792b3 100644 --- a/Source/Interfaces/USET_PROC_Interface.f90 +++ b/Source/Interfaces/USET_PROC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE USET_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L1X, L1X_MSG, LINK1X + USE IOUNT1, ONLY : ERR, F06, L1X, L1X_MSG, LINK1X USE SCONTR, ONLY : BLNK_SUB_NAM, ENFORCED, FATAL_ERR, NGRID, NUM_USET_RECORDS, NUM_USET_U1, NUM_USET_U2 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : USET_PROC_BEGEND USE PARAMS, ONLY : EPSIL USE DOF_TABLES, ONLY : TSET_CHR_LEN, USET USE MODEL_STUF, ONLY : GRID, GRID_ID @@ -45,7 +44,7 @@ SUBROUTINE USET_PROC CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'USET_PROC' INTEGER(LONG) :: USET_ERR = 0 ! Count of errors that result from setting displ sets in USET - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = USET_PROC_BEGEND + END SUBROUTINE USET_PROC diff --git a/Source/Interfaces/VECINORM_Interface.f90 b/Source/Interfaces/VECINORM_Interface.f90 index c8cc6c87..e8a33cb2 100644 --- a/Source/Interfaces/VECINORM_Interface.f90 +++ b/Source/Interfaces/VECINORM_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE VECINORM ( X, N, X_INORM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : VECINORM_BEGEND USE CONSTANTS_1, ONLY : ZERO IMPLICIT NONE INTEGER(LONG), INTENT(IN) :: N ! Dimension of the input vector X - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = VECINORM_BEGEND + REAL(DOUBLE), INTENT(IN) :: X(N) ! The input vector for which the infinity norm is calc'd REAL(DOUBLE), INTENT(OUT) :: X_INORM ! The calc'd infinity norm of X diff --git a/Source/Interfaces/VECTOR_NORM_Interface.f90 b/Source/Interfaces/VECTOR_NORM_Interface.f90 index e67ec4fe..84af80af 100644 --- a/Source/Interfaces/VECTOR_NORM_Interface.f90 +++ b/Source/Interfaces/VECTOR_NORM_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE VECTOR_NORM ( VEC, NSIZE, WHICH, VEC_NORM, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : VECTOR_NORM_BEGEND IMPLICIT NONE @@ -44,7 +43,6 @@ SUBROUTINE VECTOR_NORM ( VEC, NSIZE, WHICH, VEC_NORM, IERR ) INTEGER(LONG) , INTENT(IN) :: NSIZE ! Extent of VEC INTEGER(LONG) , INTENT(OUT) :: IERR ! Error indicator - INTEGER(LONG) , PARAMETER :: SUBR_BEGEND = VECTOR_NORM_BEGEND REAL(DOUBLE) , INTENT(IN) :: VEC(NSIZE) ! The vector for which the norm will be calculated REAL(DOUBLE) , INTENT(OUT) :: VEC_NORM ! The norm calculated for VEC diff --git a/Source/Interfaces/WRITE_ALLOC_MEM_TABLE_Interface.f90 b/Source/Interfaces/WRITE_ALLOC_MEM_TABLE_Interface.f90 index e76c23e7..5125740e 100644 --- a/Source/Interfaces/WRITE_ALLOC_MEM_TABLE_Interface.f90 +++ b/Source/Interfaces/WRITE_ALLOC_MEM_TABLE_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE WRITE_ALLOC_MEM_TABLE ( MESSAGE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE ALLOCATED_ARRAY_DATA, ONLY : ALLOCATED_ARRAY_NAMES, ALLOCATED_ARRAY_MEM, NUM_ALLOC_ARRAYS diff --git a/Source/Interfaces/WRITE_BAR_Interface.f90 b/Source/Interfaces/WRITE_BAR_Interface.f90 index c103b2bf..68dd298f 100644 --- a/Source/Interfaces/WRITE_BAR_Interface.f90 +++ b/Source/Interfaces/WRITE_BAR_Interface.f90 @@ -28,16 +28,15 @@ MODULE WRITE_BAR_Interface INTERFACE - SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & + SUBROUTINE WRITE_BAR (NUM, FILL_F06, ISUBCASE, ITABLE, & TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE ) + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_F06 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BARTOR, BLNK_SUB_NAM, MOGEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_BAR_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, MAXREQ, MSPRNT, OGEL @@ -45,11 +44,10 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: FILL_F06 ! Padding for output format - CHARACTER(LEN=*), INTENT(IN) :: FILL_ANS ! Padding for output format INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out INTEGER(LONG), INTENT(IN) :: ISUBCASE ! The subcase ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_BAR_BEGEND + INTEGER(LONG), INTENT(IN) :: ITABLE ! the current op2 subtable, should be -3, -5, ... CHARACTER(LEN=128), INTENT(IN) :: TITLE ! the model TITLE @@ -57,7 +55,8 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL INTEGER(LONG), INTENT(IN) :: FIELD5_INT_MODE REAL(DOUBLE), INTENT(IN) :: FIELD6_EIGENVALUE - + LOGICAL, INTENT(IN) :: WRITE_F06 + END SUBROUTINE WRITE_BAR END INTERFACE diff --git a/Source/Interfaces/WRITE_DOF_TABLES_Interface.f90 b/Source/Interfaces/WRITE_DOF_TABLES_Interface.f90 index f5869b06..4d65d44f 100644 --- a/Source/Interfaces/WRITE_DOF_TABLES_Interface.f90 +++ b/Source/Interfaces/WRITE_DOF_TABLES_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE WRITE_DOF_TABLES USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, L1C, LINK1C, L1C_MSG + USE IOUNT1, ONLY : L1C, LINK1C, L1C_MSG USE SCONTR, ONLY : DATA_NAM_LEN, MTDOF, NDOFG, NGRID, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_DOF_TABLES_BEGEND USE DOF_TABLES, ONLY : TDOFI, TDOF, TSET IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_DOF_TABLES_BEGEND + END SUBROUTINE WRITE_DOF_TABLES diff --git a/Source/Interfaces/WRITE_EDAT_Interface.f90 b/Source/Interfaces/WRITE_EDAT_Interface.f90 index 8fc1e72f..b7356f1b 100644 --- a/Source/Interfaces/WRITE_EDAT_Interface.f90 +++ b/Source/Interfaces/WRITE_EDAT_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE WRITE_EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM , LGUSERIN , LSUSERIN , NELE , NCUSERIN , WARN_ERR, & MEDAT_CBAR , MEDAT_CBEAM , MEDAT_CBUSH , MEDAT_CELAS1 , MEDAT_CELAS2 , & @@ -44,7 +44,6 @@ SUBROUTINE WRITE_EDAT USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : EDAT, EPNT, ETYPE USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_EDAT_BEGEND IMPLICIT NONE @@ -52,7 +51,7 @@ SUBROUTINE WRITE_EDAT INTEGER(LONG) :: NG ! Number of grids defined on a CUSERIN entry INTEGER(LONG) :: NS ! Number of scalar points defined on a CUSERIN entry - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_EDAT_BEGEND + END SUBROUTINE WRITE_EDAT diff --git a/Source/Interfaces/WRITE_ELEM_ENGR_FORCE_Interface.f90 b/Source/Interfaces/WRITE_ELEM_ENGR_FORCE_Interface.f90 index 47c9f60f..31561df0 100644 --- a/Source/Interfaces/WRITE_ELEM_ENGR_FORCE_Interface.f90 +++ b/Source/Interfaces/WRITE_ELEM_ENGR_FORCE_Interface.f90 @@ -32,14 +32,12 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, OP2 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OP2 USE SCONTR, ONLY : BLNK_SUB_NAM, INT_SC_NUM, NDOFR, NUM_CB_DOFS, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC - USE PARAMS, ONLY : PRTANS USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, OGEL - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELEM_ENGR_FORCE_BEGEND USE MODEL_STUF, ONLY : ELEM_ONAME, LABEL, SCNUM, STITLE, TITLE, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : FORC_OUT USE WRITE_ELEM_ENGR_FORCE_USE_IFs @@ -60,8 +58,8 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) INTEGER(LONG) :: BDY_DOF_NUM ! DOF number for BDY_GRID/BDY_COMP INTEGER(LONG) :: I,J,J1,K,L ! DO loop indices or counters INTEGER(LONG) :: NUM_TERMS ! Number of terms to write out for shell elems - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELEM_ENGR_FORCE_BEGEND - LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_ANS ! flag + + LOGICAL :: WRITE_F06, WRITE_OP2 ! flag REAL(DOUBLE) :: ABS_ANS(8) ! Max ABS for all element output REAL(DOUBLE) :: MAX_ANS(8) ! Max for all element output diff --git a/Source/Interfaces/WRITE_ELEM_NODE_FORCE_Interface.f90 b/Source/Interfaces/WRITE_ELEM_NODE_FORCE_Interface.f90 index b2e0becd..87a08fda 100644 --- a/Source/Interfaces/WRITE_ELEM_NODE_FORCE_Interface.f90 +++ b/Source/Interfaces/WRITE_ELEM_NODE_FORCE_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, INT_SC_NUM, NDOFR, NUM_CB_DOFS, MOGEL, NVEC, SOL_NAME USE PARAMS, ONLY : ELFORCEN USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELEM_NODE_FORCE_BEGEND USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, EID_OUT_ARRAY, MAXREQ, OGEL USE MODEL_STUF, ONLY : ELEM_ONAME, LABEL, SCNUM, STITLE, TITLE USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM @@ -50,7 +49,7 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) INTEGER(LONG), INTENT(IN) :: JSUB ! Solution vector number INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out INTEGER(LONG), INTENT(IN) :: NUM_ELGP ! The number of grid points for the elem being processed - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELEM_NODE_FORCE_BEGEND + END SUBROUTINE WRITE_ELEM_NODE_FORCE diff --git a/Source/Interfaces/WRITE_ELEM_STRAINS_Interface.f90 b/Source/Interfaces/WRITE_ELEM_STRAINS_Interface.f90 index 14506623..821a2a68 100644 --- a/Source/Interfaces/WRITE_ELEM_STRAINS_Interface.f90 +++ b/Source/Interfaces/WRITE_ELEM_STRAINS_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, MAX_NUM_STR, NDOFR, NUM_CB_DOFS, & NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELEM_STRAINS_BEGEND USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, GID_OUT_ARRAY, OGEL, POLY_FIT_ERR, POLY_FIT_ERR_INDEX USE MODEL_STUF, ONLY : ELEM_ONAME, ELMTYP, LABEL, SCNUM, STITLE, TITLE, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRN_OPT @@ -52,7 +51,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out INTEGER(LONG), INTENT(IN) :: NUM_PTS ! Num diff strain points for one element (3rd dim in arrays SEi, STEi) INTEGER(LONG), INTENT(INOUT) :: ITABLE ! the current op2 subtable, should be -3, -5, ... - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELEM_STRAINS_BEGEND + END SUBROUTINE WRITE_ELEM_STRAINS diff --git a/Source/Interfaces/WRITE_ELEM_STRESSES_Interface.f90 b/Source/Interfaces/WRITE_ELEM_STRESSES_Interface.f90 index 50b642d3..d9b53315 100644 --- a/Source/Interfaces/WRITE_ELEM_STRESSES_Interface.f90 +++ b/Source/Interfaces/WRITE_ELEM_STRESSES_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, MAX_NUM_STR, NDOFR, NUM_CB_DOFS, & NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELEM_STRESSES_BEGEND USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, GID_OUT_ARRAY, OGEL, POLY_FIT_ERR, POLY_FIT_ERR_INDEX USE MODEL_STUF, ONLY : ELEM_ONAME, ELMTYP, LABEL, SCNUM, STITLE, TITLE, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_LOC, STRE_OPT @@ -52,7 +51,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out INTEGER(LONG), INTENT(IN) :: NUM_PTS ! Num diff stress points for one element (3rd dim in arrays SEi, STEi) INTEGER(LONG), INTENT(IN) :: ITABLE ! the current op2 subtable, should be -3, -5, ... - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELEM_STRESSES_BEGEND + END SUBROUTINE WRITE_ELEM_STRESSES diff --git a/Source/Interfaces/WRITE_ELM_OT4_Interface.f90 b/Source/Interfaces/WRITE_ELM_OT4_Interface.f90 index eff182c7..099e2152 100644 --- a/Source/Interfaces/WRITE_ELM_OT4_Interface.f90 +++ b/Source/Interfaces/WRITE_ELM_OT4_Interface.f90 @@ -32,11 +32,9 @@ SUBROUTINE WRITE_ELM_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELM_OT4_BEGEND IMPLICIT NONE @@ -48,7 +46,7 @@ SUBROUTINE WRITE_ELM_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in MAT INTEGER(LONG), INTENT(IN) :: NROWS_MAT ! Number of rows in MAT INTEGER(LONG), INTENT(IN) :: UNT ! Unit number where to write matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELM_OT4_BEGEND + END SUBROUTINE WRITE_ELM_OT4 diff --git a/Source/Interfaces/WRITE_ENF_TO_L1O_Interface.f90 b/Source/Interfaces/WRITE_ENF_TO_L1O_Interface.f90 index 76939de2..876f4106 100644 --- a/Source/Interfaces/WRITE_ENF_TO_L1O_Interface.f90 +++ b/Source/Interfaces/WRITE_ENF_TO_L1O_Interface.f90 @@ -32,17 +32,16 @@ SUBROUTINE WRITE_ENF_TO_L1O USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ENF, ENFFIL, ENFSTAT, ENF_MSG, ERR, F04, F06, L1O, LINK1O, L1OSTAT, L1O_MSG, WRT_LOG + USE IOUNT1, ONLY : ENF, ENFFIL, ENFSTAT, ENF_MSG, ERR, F06, L1O, LINK1O, L1OSTAT, L1O_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFSG, NGRID, NSPC, NUM_SPC_RECORDS, NUM_SPC1_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : SPCSET - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ENF_TO_L1O_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ENF_TO_L1O_BEGEND + END SUBROUTINE WRITE_ENF_TO_L1O diff --git a/Source/Interfaces/WRITE_FEMAP_ELFO_VECS_Interface.f90 b/Source/Interfaces/WRITE_FEMAP_ELFO_VECS_Interface.f90 index d020a8cd..7da3c2a6 100644 --- a/Source/Interfaces/WRITE_FEMAP_ELFO_VECS_Interface.f90 +++ b/Source/Interfaces/WRITE_FEMAP_ELFO_VECS_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE WRITE_FEMAP_ELFO_VECS ( ELEM_TYP, NUM_FEMAP_ROWS, FEMAP_SET_ID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NEU + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NEU USE PARAMS, ONLY : SUPWARN USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FEMAP_ELFO_VECS_BEGEND IMPLICIT NONE @@ -46,7 +45,7 @@ SUBROUTINE WRITE_FEMAP_ELFO_VECS ( ELEM_TYP, NUM_FEMAP_ROWS, FEMAP_SET_ID ) INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows of FEMAP data to write INTEGER(LONG), INTENT(IN) :: FEMAP_SET_ID ! FEMAP set ID to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FEMAP_ELFO_VECS_BEGEND + END SUBROUTINE WRITE_FEMAP_ELFO_VECS diff --git a/Source/Interfaces/WRITE_FEMAP_GRID_VECS_Interface.f90 b/Source/Interfaces/WRITE_FEMAP_GRID_VECS_Interface.f90 index 5f890aec..bd628b94 100644 --- a/Source/Interfaces/WRITE_FEMAP_GRID_VECS_Interface.f90 +++ b/Source/Interfaces/WRITE_FEMAP_GRID_VECS_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE WRITE_FEMAP_GRID_VECS ( GRID_VEC, FEMAP_SET_ID, WHAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NEU + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NEU USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCORD, NDOFG, NGRID USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : CORD, GRID, GRID_ID, INV_GRID_SEQ - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FEMAP_GRID_VECS_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: WHAT ! Indicator if GRID_VEC is DISP, OLOA, SPCF or MPCF INTEGER(LONG), INTENT(IN) :: FEMAP_SET_ID ! FEMAP set ID to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FEMAP_GRID_VECS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: GRID_VEC(NDOFG) ! G-set Vector to process diff --git a/Source/Interfaces/WRITE_FEMAP_STRE_VECS_Interface.f90 b/Source/Interfaces/WRITE_FEMAP_STRE_VECS_Interface.f90 index eec202a3..ddcf34e4 100644 --- a/Source/Interfaces/WRITE_FEMAP_STRE_VECS_Interface.f90 +++ b/Source/Interfaces/WRITE_FEMAP_STRE_VECS_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE WRITE_FEMAP_STRE_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NEU + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NEU USE PARAMS, ONLY : SUPWARN USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OPT USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FEMAP_STRE_VECS_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE WRITE_FEMAP_STRE_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows of FEMAP data to write INTEGER(LONG), INTENT(IN) :: FEMAP_SET_ID ! FEMAP set ID to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FEMAP_STRE_VECS_BEGEND + END SUBROUTINE WRITE_FEMAP_STRE_VECS diff --git a/Source/Interfaces/WRITE_FEMAP_STRN_VECS_Interface.f90 b/Source/Interfaces/WRITE_FEMAP_STRN_VECS_Interface.f90 index 33ee134f..16c1420f 100644 --- a/Source/Interfaces/WRITE_FEMAP_STRN_VECS_Interface.f90 +++ b/Source/Interfaces/WRITE_FEMAP_STRN_VECS_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE WRITE_FEMAP_STRN_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NEU + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NEU USE PARAMS, ONLY : SUPWARN USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OPT USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FEMAP_STRN_VECS_BEGEND IMPLICIT NONE @@ -48,7 +47,7 @@ SUBROUTINE WRITE_FEMAP_STRN_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows of FEMAP data to write INTEGER(LONG), INTENT(IN) :: FEMAP_SET_ID ! FEMAP set ID to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FEMAP_STRN_VECS_BEGEND + END SUBROUTINE WRITE_FEMAP_STRN_VECS diff --git a/Source/Interfaces/WRITE_FIJFIL_Interface.f90 b/Source/Interfaces/WRITE_FIJFIL_Interface.f90 index df95cf53..12d0d9da 100644 --- a/Source/Interfaces/WRITE_FIJFIL_Interface.f90 +++ b/Source/Interfaces/WRITE_FIJFIL_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE WRITE_FIJFIL ( WHICH, JVEC ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, F06, F21, F22, F23, F24, F25, F21_MSG, F22_MSG, F23_MSG, F24_MSG, F25_MSG + USE IOUNT1, ONLY : F06, F21, F22, F23, F24, F25, F21_MSG, F22_MSG, F23_MSG, F24_MSG, F25_MSG USE DEBUG_PARAMETERS USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_STRESS_POINTS, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FIJFIL_BEGEND USE MODEL_STUF, ONLY : EID, TYPE, ELGP, ELDOF, KE, ME, PEB, PEG, PEL, PPE, PTE, & SE1, SE2, SE3, STE1, STE2, STE3, UEB, UEG, UEL USE PARAMS, ONLY : ELFORCEN @@ -45,7 +44,7 @@ SUBROUTINE WRITE_FIJFIL ( WHICH, JVEC ) INTEGER(LONG), INTENT(IN) :: JVEC ! Internal subcase or vector number for data to be written INTEGER(LONG), INTENT(IN) :: WHICH ! Which F2j file to write to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FIJFIL_BEGEND + END SUBROUTINE WRITE_FIJFIL diff --git a/Source/Interfaces/WRITE_GRD_OT4_Interface.f90 b/Source/Interfaces/WRITE_GRD_OT4_Interface.f90 index 85d6ccff..a90ef8c3 100644 --- a/Source/Interfaces/WRITE_GRD_OT4_Interface.f90 +++ b/Source/Interfaces/WRITE_GRD_OT4_Interface.f90 @@ -32,10 +32,8 @@ SUBROUTINE WRITE_GRD_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_GRD_OT4_BEGEND IMPLICIT NONE @@ -47,7 +45,7 @@ SUBROUTINE WRITE_GRD_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in MAT INTEGER(LONG), INTENT(IN) :: NROWS_MAT ! Number of rows in MAT INTEGER(LONG), INTENT(IN) :: UNT ! Unit number where to write matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_GRD_OT4_BEGEND + END SUBROUTINE WRITE_GRD_OT4 diff --git a/Source/Interfaces/WRITE_GRD_PCH_OUTPUTS_Interface.f90 b/Source/Interfaces/WRITE_GRD_PCH_OUTPUTS_Interface.f90 index a0ec2274..9f4bdbfe 100644 --- a/Source/Interfaces/WRITE_GRD_PCH_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/WRITE_GRD_PCH_OUTPUTS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE WRITE_GRD_PCH_OUTPUTS ( JSUB, NUM, WHAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, PCH + USE IOUNT1, ONLY : ERR, F06, PCH USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, INT_SC_NUM, PCH_LINE_NUM, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_GRD_PCH_OUTPUTS_BEGEND USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, OGEL USE MODEL_STUF, ONLY : GRID, LABEL, SCNUM, SUBLOD, STITLE, TITLE @@ -46,7 +45,7 @@ SUBROUTINE WRITE_GRD_PCH_OUTPUTS ( JSUB, NUM, WHAT ) INTEGER(LONG), INTENT(IN) :: JSUB ! Solution vector number INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_GRD_PCH_OUTPUTS_BEGEND + END SUBROUTINE WRITE_GRD_PCH_OUTPUTS diff --git a/Source/Interfaces/WRITE_GRD_PRT_OUTPUTS_Interface.f90 b/Source/Interfaces/WRITE_GRD_PRT_OUTPUTS_Interface.f90 index 71d5035b..7ff0da84 100644 --- a/Source/Interfaces/WRITE_GRD_PRT_OUTPUTS_Interface.f90 +++ b/Source/Interfaces/WRITE_GRD_PRT_OUTPUTS_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, PCH + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, PCH USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, INT_SC_NUM, MELGP, MOGEL, NDOFR, NVEC, NUM_CB_DOFS, & SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_GRD_PRT_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -51,7 +50,7 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG CHARACTER(1*BYTE), INTENT(IN) :: ALL_SAME_CID ! Indicator of whether all grids, for the output set, have the same INTEGER(LONG), INTENT(IN) :: JVEC ! Sol'n vector num. Can be internal subcase number or eigenvector number INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_GRD_PRT_OUTPUTS_BEGEND + CHARACTER(1*BYTE), INTENT(IN) :: WRITE_OGEL(NUM) ! 'Y'/'N' as to whether to write OGEL for a grid (used to avoid writing END SUBROUTINE WRITE_GRD_PRT_OUTPUTS diff --git a/Source/Interfaces/WRITE_INTEGER_VEC_Interface.f90 b/Source/Interfaces/WRITE_INTEGER_VEC_Interface.f90 index 8f36ee32..b1de88e0 100644 --- a/Source/Interfaces/WRITE_INTEGER_VEC_Interface.f90 +++ b/Source/Interfaces/WRITE_INTEGER_VEC_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE WRITE_INTEGER_VEC ( ARRAY_DESCR, INT_VEC, NROWS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MATRIX_BY_COLS_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE WRITE_INTEGER_VEC ( ARRAY_DESCR, INT_VEC, NROWS ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in matrix MATOUT INTEGER(LONG), INTENT(IN) :: INT_VEC(NROWS) ! Integer vector to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MATRIX_BY_COLS_BEGEND + END SUBROUTINE WRITE_INTEGER_VEC diff --git a/Source/Interfaces/WRITE_L1A_Interface.f90 b/Source/Interfaces/WRITE_L1A_Interface.f90 index 530c47bb..5a0bc969 100644 --- a/Source/Interfaces/WRITE_L1A_Interface.f90 +++ b/Source/Interfaces/WRITE_L1A_Interface.f90 @@ -28,14 +28,14 @@ MODULE WRITE_L1A_Interface INTERFACE - SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) + SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : MOT4, MOU4, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : MOT4, MOU4, WRT_ERR - USE IOUNT1, ONLY : ANS, BUG, EIN, ENF, ERR, F04, F06, IN0, IN1, INI, & + USE IOUNT1, ONLY : BUG, EIN, ENF, ERR, F06, IN0, IN1, INI, & L1A, NEU, OT4, PCH, SEQ, SPC, SC1, & F21, F22, F23, F24, F25, & L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, L1K, & @@ -45,7 +45,7 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) L2K, L2L, L2M, L2N, L2O, L2P, L2Q, L2R, L2S, L2T, & L3A, L4A, L4B, L4C, L4D, L5A, L5B, OP2, OU4 - USE IOUNT1, ONLY : ANSSTAT, BUGSTAT, EINSTAT, ENFSTAT, ERRSTAT, F04STAT, F06STAT, IN0STAT, IN1STAT, INISTAT, & + USE IOUNT1, ONLY : BUGSTAT, EINSTAT, ENFSTAT, ERRSTAT, F06STAT, IN0STAT, IN1STAT, INISTAT, & L1ASTAT, NEUSTAT, OT4STAT, PCHSTAT, SEQSTAT, SPCSTAT, & F21STAT, F22STAT, F23STAT, F24STAT, F25STAT, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1JSTAT, L1KSTAT, & @@ -55,7 +55,7 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) L2KSTAT, L2LSTAT, L2MSTAT, L2NSTAT, L2OSTAT, L2PSTAT, L2QSTAT, L2RSTAT, L2SSTAT, L2TSTAT, & L3ASTAT, L4ASTAT, L4BSTAT, L4CSTAT, L4DSTAT, L5ASTAT, L5BSTAT, OP2STAT, OU4STAT - USE IOUNT1, ONLY : ANSFIL, BUGFIL, EINFIL, ENFFIL, ERRFIL, F04FIL, F06FIL, IN0FIL, INIFIL, LINK1A, & + USE IOUNT1, ONLY : BUGFIL, EINFIL, ENFFIL, ERRFIL, F06FIL, IN0FIL, INIFIL, LINK1A, & NEUFIL, OT4FIL, PCHFIL, SEQFIL, SPCFIL, F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, & LINK1A, LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, & LINK1K, LINK1L, LINK1M, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1R, LINK1S, LINK1T, & @@ -64,7 +64,7 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) LINK2K, LINK2L, LINK2M, LINK2N, LINK2O, LINK2P, LINK2Q, LINK2R, LINK2S, LINK2T, & LINK3A, LINK4A, LINK4B, LINK4C, LINK4D, LINK5A, LINK5B, OP2FIL, OU4FIL - USE IOUNT1, ONLY : ANS_MSG, BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F04_MSG, F06_MSG, IN0_MSG, IN1_MSG, INI_MSG, & + USE IOUNT1, ONLY : BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F06_MSG, IN0_MSG, IN1_MSG, INI_MSG, & L1A_MSG, NEU_MSG, OT4_MSG, PCH_MSG, SEQ_MSG, SPC_MSG, & F21_MSG, F22_MSG, F23_MSG, F24_MSG, F25_MSG, & L1B_MSG, L1C_MSG, L1D_MSG, L1E_MSG, L1F_MSG, L1G_MSG, L1H_MSG, L1I_MSG, L1J_MSG, L1K_MSG, & @@ -75,7 +75,6 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) L3A_MSG, L4A_MSG, L4B_MSG, L4C_MSG, L4D_MSG, L5A_MSG, L5B_MSG, OP2_MSG, OU4_MSG USE SCONTR USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_L1A_BEGEND USE PARAMS, ONLY : CBMIN3, CBMIN4, ELFORCEN, HEXAXIS, IORQ1B, IORQ1M, IORQ1S, IORQ2B, IORQ2T,& MATSPARS, MIN4TRED, QUAD4TYP, QUADAXIS, SPARSTOR @@ -83,9 +82,7 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) CHARACTER(LEN=*), INTENT(IN) :: CLOSE_STAT ! STATUS when closing file LINK1A CHARACTER(LEN=*), INTENT(IN) :: CALL_OUTA_HERE ! 'Y'/'N' indicator of whether to call OUTA_HERE (this should be 'Y' - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_L1A_BEGEND END SUBROUTINE WRITE_L1A diff --git a/Source/Interfaces/WRITE_L1M_Interface.f90 b/Source/Interfaces/WRITE_L1M_Interface.f90 index 06ccb090..09305ca0 100644 --- a/Source/Interfaces/WRITE_L1M_Interface.f90 +++ b/Source/Interfaces/WRITE_L1M_Interface.f90 @@ -34,7 +34,7 @@ SUBROUTINE WRITE_L1M USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : LINKNO, NUM_EIGENS - USE IOUNT1, ONLY : ERR, F06, L1M, L1M_MSG, L1MSTAT, LINK1M, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1M, L1M_MSG, L1MSTAT, LINK1M, SC1, WRT_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE EIGEN_MATRICES_1 , ONLY : EIGEN_VAL, GEN_MASS, MODE_NUM diff --git a/Source/Interfaces/WRITE_L1Z_Interface.f90 b/Source/Interfaces/WRITE_L1Z_Interface.f90 index e5b559d1..3cfe9198 100644 --- a/Source/Interfaces/WRITE_L1Z_Interface.f90 +++ b/Source/Interfaces/WRITE_L1Z_Interface.f90 @@ -32,15 +32,14 @@ SUBROUTINE WRITE_L1Z USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, F06, L1Z, LINK1Z, L1Z_MSG, L1ZSTAT + USE IOUNT1, ONLY : F06, L1Z, LINK1Z, L1Z_MSG, L1ZSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, NSUB, SOL_NAME USE TIMDAT, ONLY : STIME, TSEC USE MODEL_STUF, ONLY : CC_EIGR_SID, MPCSET, SPCSET, SUBLOD - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_L1Z_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_L1Z_BEGEND + END SUBROUTINE WRITE_L1Z diff --git a/Source/Interfaces/WRITE_MATRIX_1_Interface.f90 b/Source/Interfaces/WRITE_MATRIX_1_Interface.f90 index 13951788..2402500b 100644 --- a/Source/Interfaces/WRITE_MATRIX_1_Interface.f90 +++ b/Source/Interfaces/WRITE_MATRIX_1_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE WRITE_MATRIX_1 ( FILNAM, UNT, CLOSE_IT, CLOSE_STAT, MESSAG, NAME, NTE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MATRIX_1_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE WRITE_MATRIX_1 ( FILNAM, UNT, CLOSE_IT, CLOSE_STAT, MESSAG, NAME, NTE INTEGER(LONG), INTENT(IN) :: UNT ! Unit number of FILNAM INTEGER(LONG), INTENT(IN) :: I_MATIN(NROWS+1) ! Row numbers for terms in matrix MATIN INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERM) ! Col numbers for terms in matrix MATIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MATRIX_1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM) ! Real values for matrix MATIN diff --git a/Source/Interfaces/WRITE_MATRIX_BY_COLS_Interface.f90 b/Source/Interfaces/WRITE_MATRIX_BY_COLS_Interface.f90 index 315d6246..915b9eb8 100644 --- a/Source/Interfaces/WRITE_MATRIX_BY_COLS_Interface.f90 +++ b/Source/Interfaces/WRITE_MATRIX_BY_COLS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE WRITE_MATRIX_BY_COLS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MATRIX_BY_COLS_BEGEND IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE WRITE_MATRIX_BY_COLS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in matrix MATOUT INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in matrix MATOUT INTEGER(LONG), INTENT(IN) :: OUT_UNT ! Output unit number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MATRIX_BY_COLS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATOUT(NROWS,NCOLS)! Matrix to write out diff --git a/Source/Interfaces/WRITE_MATRIX_BY_ROWS_Interface.f90 b/Source/Interfaces/WRITE_MATRIX_BY_ROWS_Interface.f90 index f61d905b..3f8aa402 100644 --- a/Source/Interfaces/WRITE_MATRIX_BY_ROWS_Interface.f90 +++ b/Source/Interfaces/WRITE_MATRIX_BY_ROWS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE WRITE_MATRIX_BY_ROWS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MATRIX_BY_ROWS_BEGEND IMPLICIT NONE @@ -44,7 +43,7 @@ SUBROUTINE WRITE_MATRIX_BY_ROWS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in matrix MATOUT INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in matrix MATOUT INTEGER(LONG), INTENT(IN) :: OUT_UNT ! Output unit number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MATRIX_BY_ROWS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATOUT(NROWS,NCOLS)! Matrix to write out diff --git a/Source/Interfaces/WRITE_MEFFMASS_Interface.f90 b/Source/Interfaces/WRITE_MEFFMASS_Interface.f90 index 3f7793ce..874f5cff 100644 --- a/Source/Interfaces/WRITE_MEFFMASS_Interface.f90 +++ b/Source/Interfaces/WRITE_MEFFMASS_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE WRITE_MEFFMASS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MEFFMASS_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, ONE_HUNDRED, PI USE DEBUG_PARAMETERS, ONLY : DEBUG USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, MEFFMASS @@ -44,7 +43,7 @@ SUBROUTINE WRITE_MEFFMASS IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MEFFMASS_BEGEND + END SUBROUTINE WRITE_MEFFMASS diff --git a/Source/Interfaces/WRITE_MPFACTOR_Interface.f90 b/Source/Interfaces/WRITE_MPFACTOR_Interface.f90 index 3e778aeb..1b53a8f6 100644 --- a/Source/Interfaces/WRITE_MPFACTOR_Interface.f90 +++ b/Source/Interfaces/WRITE_MPFACTOR_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFG, NDOFR, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MPFACTOR_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO, PI USE DEBUG_PARAMETERS, ONLY : DEBUG USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, MPFACTOR_NR, MPFACTOR_N6 @@ -45,7 +44,7 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MPFACTOR_BEGEND + END SUBROUTINE WRITE_MPFACTOR diff --git a/Source/Interfaces/WRITE_OU4_FULL_MAT_Interface.f90 b/Source/Interfaces/WRITE_OU4_FULL_MAT_Interface.f90 index 9938fb73..1f21cebd 100644 --- a/Source/Interfaces/WRITE_OU4_FULL_MAT_Interface.f90 +++ b/Source/Interfaces/WRITE_OU4_FULL_MAT_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE WRITE_OU4_FULL_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, MAT, UNT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, LEN_INPUT_FNAME, OU4, OU4FIL, MOU4, WRT_LOG + USE IOUNT1, ONLY : F06, LEN_INPUT_FNAME, OU4, OU4FIL, MOU4 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : PRTOU4 - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_OU4_FULL_MAT_BEGEND IMPLICIT NONE @@ -51,7 +50,7 @@ SUBROUTINE WRITE_OU4_FULL_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, MAT, UNT ) INTEGER(LONG), PARAMETER :: IROW = 1 ! A term written to UNT for the trailer record (just to be like NASTRAN) INTEGER(LONG), PARAMETER :: PREC = 2 ! Matrix precision (2 indicates double precision) INTEGER(LONG), PARAMETER :: ROW_BEG = 1 ! 1st row of matrix output to UNT is row 1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_OU4_FULL_MAT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MAT(NROWS,NCOLS) ! Array of terms in matrix MAT diff --git a/Source/Interfaces/WRITE_OU4_SPARSE_MAT_Interface.f90 b/Source/Interfaces/WRITE_OU4_SPARSE_MAT_Interface.f90 index e2d7b292..d120cc0c 100644 --- a/Source/Interfaces/WRITE_OU4_SPARSE_MAT_Interface.f90 +++ b/Source/Interfaces/WRITE_OU4_SPARSE_MAT_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE WRITE_OU4_SPARSE_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, NTERM_MAT, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, LEN_INPUT_FNAME, OU4, OU4FIL, mou4, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, LEN_INPUT_FNAME, OU4, OU4FIL, mou4 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : PRTOU4, SPARSTOR USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1, I_CCS1, J_CCS1, CCS1 - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_OU4_SPARSE_MAT_BEGEND IMPLICIT NONE @@ -55,7 +54,7 @@ SUBROUTINE WRITE_OU4_SPARSE_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, NTERM_MAT, INTEGER(LONG), PARAMETER :: IROW = 1 ! INTEGER(LONG), PARAMETER :: PREC = 2 ! Matrix precision (2 indicates double precision) INTEGER(LONG), PARAMETER :: ROW_BEG = 1 ! 1st row of matrix output to UNT is row 1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_OU4_SPARSE_MAT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MAT(NTERM_MAT) ! Array of terms in matrix MAT diff --git a/Source/Interfaces/WRITE_PARTNd_MAT_HDRS_Interface.f90 b/Source/Interfaces/WRITE_PARTNd_MAT_HDRS_Interface.f90 index 67d42847..7d73fa6e 100644 --- a/Source/Interfaces/WRITE_PARTNd_MAT_HDRS_Interface.f90 +++ b/Source/Interfaces/WRITE_PARTNd_MAT_HDRS_Interface.f90 @@ -32,13 +32,12 @@ SUBROUTINE WRITE_PARTNd_MAT_HDRS ( MAT_NAME, ROW_SET, COL_SET, NROWS, NCOLS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MTDOF, NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, NDOFN, NDOFO, NDOFR, & NDOFS, NDOFSA, NDOFSB, NDOFSE, NDOFSG, NDOFSZ, NUM_USET_U1, NUM_USET_U2, TSET_CHR_LEN USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOFI USE OUTPUT4_MATRICES, ONLY : OU4_MAT_COL_GRD_COMP, OU4_MAT_ROW_GRD_COMP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_PARTNd_MAT_HDRS_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE WRITE_PARTNd_MAT_HDRS ( MAT_NAME, ROW_SET, COL_SET, NROWS, NCOLS ) INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in the partitioned matrix MAT_NAME INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in the partitioned matrix MAT_NAME INTEGER(LONG) :: NUM_LEFT ! Used when printing a line of 10 values in the set - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_PARTNd_MAT_HDRS_BEGEND + END SUBROUTINE WRITE_PARTNd_MAT_HDRS diff --git a/Source/Interfaces/WRITE_PCOMP_EQUIV_Interface.f90 b/Source/Interfaces/WRITE_PCOMP_EQUIV_Interface.f90 index f75c290b..574094c6 100644 --- a/Source/Interfaces/WRITE_PCOMP_EQUIV_Interface.f90 +++ b/Source/Interfaces/WRITE_PCOMP_EQUIV_Interface.f90 @@ -33,7 +33,7 @@ SUBROUTINE WRITE_PCOMP_EQUIV ( PCOMP_TM, PCOMP_IB, PCOMP_TS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : TWELVE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, MEMATC, MID1_PCOMP_EQ, MID2_PCOMP_EQ, MID3_PCOMP_EQ, & MID4_PCOMP_EQ, MID1_PCOMP_EQ, MID2_PCOMP_EQ, MID3_PCOMP_EQ, MID4_PCOMP_EQ USE PARAMS, ONLY : EPSIL, PCOMPEQ, SUPINFO diff --git a/Source/Interfaces/WRITE_PLY_STRAINS_Interface.f90 b/Source/Interfaces/WRITE_PLY_STRAINS_Interface.f90 index ce9a8ac3..cdea1422 100644 --- a/Source/Interfaces/WRITE_PLY_STRAINS_Interface.f90 +++ b/Source/Interfaces/WRITE_PLY_STRAINS_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, LPCOMP_PLIES, NDOFR, NUM_CB_DOFS, & NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_PLY_STRAINS_BEGEND USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, FTNAME, OGEL USE MODEL_STUF, ONLY : ANY_FAILURE_THEORY, ELEM_ONAME, LABEL, PCOMP, SCNUM, STITLE, TITLE USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OPT @@ -53,7 +52,7 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out CHARACTER(8*BYTE), INTENT(IN) :: ETYPE ! the name of the element INTEGER(LONG), INTENT(INOUT) :: ITABLE ! the op2 subtable name - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_PLY_STRAINS_BEGEND + INTEGER(LONG) :: STRESS_CODE ! flag for op2 END SUBROUTINE WRITE_PLY_STRAINS diff --git a/Source/Interfaces/WRITE_PLY_STRESSES_Interface.f90 b/Source/Interfaces/WRITE_PLY_STRESSES_Interface.f90 index 3a73aca5..9d84a82a 100644 --- a/Source/Interfaces/WRITE_PLY_STRESSES_Interface.f90 +++ b/Source/Interfaces/WRITE_PLY_STRESSES_Interface.f90 @@ -32,14 +32,13 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, LPCOMP_PLIES, NDOFR, NUM_CB_DOFS, & SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_PLY_STRESSES_BEGEND USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, FTNAME, OGEL USE MODEL_STUF, ONLY : ANY_FAILURE_THEORY, ELEM_ONAME, LABEL, PCOMP, SCNUM, STITLE, TITLE USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OPT @@ -53,7 +52,7 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out CHARACTER(8*BYTE), INTENT(IN) :: ETYPE ! the name of the element INTEGER(LONG), INTENT(INOUT) :: ITABLE ! the op2 subtable name - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_PLY_STRESSES_BEGEND + INTEGER(LONG) :: STRESS_CODE ! flag for op2 END SUBROUTINE WRITE_PLY_STRESSES diff --git a/Source/Interfaces/WRITE_ROD_Interface.f90 b/Source/Interfaces/WRITE_ROD_Interface.f90 index 89d34a39..e9a09d3a 100644 --- a/Source/Interfaces/WRITE_ROD_Interface.f90 +++ b/Source/Interfaces/WRITE_ROD_Interface.f90 @@ -28,15 +28,14 @@ MODULE WRITE_ROD_Interface INTERFACE - SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, TITLE, SUBTITLE, LABEL, & + SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, ITABLE, TITLE, SUBTITLE, LABEL, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_OP2 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ROD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, MSPRNT, OGEL @@ -45,7 +44,6 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, TITLE, SUBTITL INTEGER(LONG), INTENT(IN) :: ISUBCASE ! the current subcase CHARACTER(LEN=*), INTENT(IN) :: FILL_F06 ! Padding for output format - CHARACTER(LEN=*), INTENT(IN) :: FILL_ANS ! Padding for output format CHARACTER(LEN=128), INTENT(IN) :: TITLE ! the model TITLE CHARACTER(LEN=128), INTENT(IN) :: SUBTITLE ! the subcase SUBTITLE CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL @@ -56,7 +54,7 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, TITLE, SUBTITL INTEGER(LONG), INTENT(IN) :: FIELD5_INT_MODE REAL(DOUBLE), INTENT(IN) :: FIELD6_EIGENVALUE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ROD_BEGEND + END SUBROUTINE WRITE_ROD diff --git a/Source/Interfaces/WRITE_SPARSE_CRS_Interface.f90 b/Source/Interfaces/WRITE_SPARSE_CRS_Interface.f90 index cdd2151f..be02975a 100644 --- a/Source/Interfaces/WRITE_SPARSE_CRS_Interface.f90 +++ b/Source/Interfaces/WRITE_SPARSE_CRS_Interface.f90 @@ -32,12 +32,11 @@ SUBROUTINE WRITE_SPARSE_CRS ( MAT_NAME, ROW_SET, COL_SET, NTERM_A, NROWS_A, I_AX USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SPARSTOR, TINY - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_SPARSE_CRS_BEGEND IMPLICIT NONE @@ -49,7 +48,7 @@ SUBROUTINE WRITE_SPARSE_CRS ( MAT_NAME, ROW_SET, COL_SET, NTERM_A, NROWS_A, I_AX INTEGER(LONG), INTENT(IN) :: NROWS_A ! No. of rows in sparse matrix INTEGER(LONG), INTENT(IN) :: I_AXX(NROWS_A+1) ! Array of starting indices for the 1-st term in rows of AXX INTEGER(LONG), INTENT(IN) :: J_AXX(NTERM_A) ! Array of col no's for terms in matrix AXX - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_SPARSE_CRS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AXX(NTERM_A) ! Array of terms in matrix AXX diff --git a/Source/Interfaces/WRITE_TDOF_Interface.f90 b/Source/Interfaces/WRITE_TDOF_Interface.f90 index 9263962b..4a648aee 100644 --- a/Source/Interfaces/WRITE_TDOF_Interface.f90 +++ b/Source/Interfaces/WRITE_TDOF_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE WRITE_TDOF ( TDOF_MSG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MTDOF, NDOFG, NDOFM, NDOFN, NDOFSA, NDOFSB, NDOFSG, NDOFSZ, NDOFSE, NDOFS, & NDOFF, NDOFO, NDOFA, NDOFR, NDOFL, NGRID, NUM_USET_U1, NUM_USET_U2 USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOF, TDOFI USE PARAMS, ONLY : PRTDOF USE MODEL_STUF, ONLY : GRID_ID, INV_GRID_SEQ - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_TDOF_BEGEND IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: TDOF_MSG ! Message to be printed out regarding at what point in the run the TDOF,I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_TDOF_BEGEND + END SUBROUTINE WRITE_TDOF diff --git a/Source/Interfaces/WRITE_TSET_Interface.f90 b/Source/Interfaces/WRITE_TSET_Interface.f90 index 2d5652d4..ddc485b2 100644 --- a/Source/Interfaces/WRITE_TSET_Interface.f90 +++ b/Source/Interfaces/WRITE_TSET_Interface.f90 @@ -32,16 +32,15 @@ SUBROUTINE WRITE_TSET USE PENTIUM_II_KIND, ONLY : LONG - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MTSET, NGRID USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : GRID, GRID_SEQ, INV_GRID_SEQ USE DOF_TABLES, ONLY : TSET - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_TSET_BEGEND IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_TSET_BEGEND + END SUBROUTINE WRITE_TSET diff --git a/Source/Interfaces/WRITE_USERIN_BD_CARDS_Interface.f90 b/Source/Interfaces/WRITE_USERIN_BD_CARDS_Interface.f90 index 9d554bac..3fcc9864 100644 --- a/Source/Interfaces/WRITE_USERIN_BD_CARDS_Interface.f90 +++ b/Source/Interfaces/WRITE_USERIN_BD_CARDS_Interface.f90 @@ -32,7 +32,7 @@ SUBROUTINE WRITE_USERIN_BD_CARDS ( NROWS, X_SET ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, F06FIL, MOU4, OU4, OU4FIL + USE IOUNT1, ONLY : ERR, F06, F06FIL, MOU4, OU4, OU4FIL USE SCONTR, ONLY : JCARD_LEN, NCORD, NDOFG, NGRID, NVEC, WARN_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : START_YEAR, START_MONTH, START_DAY, START_HOUR, START_MINUTE, START_SEC, START_SFRAC USE DOF_TABLES, ONLY : TDOFI diff --git a/Source/Interfaces/WRITE_USETSTR_Interface.f90 b/Source/Interfaces/WRITE_USETSTR_Interface.f90 index 18eca3c1..abe97fce 100644 --- a/Source/Interfaces/WRITE_USETSTR_Interface.f90 +++ b/Source/Interfaces/WRITE_USETSTR_Interface.f90 @@ -32,11 +32,10 @@ SUBROUTINE WRITE_USETSTR USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MTDOF, NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, NDOFN, NDOFO, NDOFR, & NDOFS, NDOFSA, NDOFSB, NDOFSE, NDOFSG, NDOFSZ, NUM_USET_U1, NUM_USET_U2, TSET_CHR_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_USETSTR_BEGEND USE DOF_TABLES, ONLY : TDOFI, USETSTR_TABLE IMPLICIT NONE @@ -47,7 +46,7 @@ SUBROUTINE WRITE_USETSTR INTEGER(LONG) :: GRID_NUM(NDOFG) ! Array of grid numbers for members of a DOF set requested in USETSTR INTEGER(LONG) :: COMP_NUM(NDOFG) ! Array of comp numbers for members of a DOF set requested in USETSTR INTEGER(LONG) :: NUM_LEFT ! Used when printing a line of 10 values in the set - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_USETSTR_BEGEND + END SUBROUTINE WRITE_USETSTR diff --git a/Source/Interfaces/WRITE_USET_Interface.f90 b/Source/Interfaces/WRITE_USET_Interface.f90 index 3739c772..ed21abb0 100644 --- a/Source/Interfaces/WRITE_USET_Interface.f90 +++ b/Source/Interfaces/WRITE_USET_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE WRITE_USET USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MTSET, NDOFG, NGRID, NUM_USET_U1, NUM_USET_U2 USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : GRID, GRID_SEQ, INV_GRID_SEQ USE PARAMS, ONLY : PRTUSET - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_USET_BEGEND USE DOF_TABLES, ONLY : TDOF, USET, USETSTR_TABLE IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'WRITE_USET' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_USET_BEGEND + END SUBROUTINE WRITE_USET diff --git a/Source/Interfaces/WRITE_VECTOR_Interface.f90 b/Source/Interfaces/WRITE_VECTOR_Interface.f90 index eeb586ab..a7af50d8 100644 --- a/Source/Interfaces/WRITE_VECTOR_Interface.f90 +++ b/Source/Interfaces/WRITE_VECTOR_Interface.f90 @@ -32,10 +32,9 @@ SUBROUTINE WRITE_VECTOR ( VEC_NAME, WHAT, NUM, UX ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_VECTOR_BEGEND IMPLICIT NONE @@ -43,7 +42,7 @@ SUBROUTINE WRITE_VECTOR ( VEC_NAME, WHAT, NUM, UX ) CHARACTER(LEN=*), INTENT(IN) :: WHAT ! Title over output vector (e.g. DISPL, FORCE, etc.) INTEGER(LONG), INTENT(IN) :: NUM ! Size of vector UX to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_VECTOR_BEGEND + REAL(DOUBLE) , INTENT(IN) :: UX(NUM) ! Vector to write out diff --git a/Source/Interfaces/YS_ARRAY_Interface.f90 b/Source/Interfaces/YS_ARRAY_Interface.f90 index fb36835e..2b85cd34 100644 --- a/Source/Interfaces/YS_ARRAY_Interface.f90 +++ b/Source/Interfaces/YS_ARRAY_Interface.f90 @@ -32,19 +32,18 @@ SUBROUTINE YS_ARRAY USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1H - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, LINK1H - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, L1H_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1H + USE IOUNT1, ONLY : WRT_ERR, LINK1H + USE IOUNT1, ONLY : WRT_ERR, L1H_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFSE, NGRID USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : YS_ARRAY_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : GRID_ID USE COL_VECS, ONLY : YSe IMPLICIT NONE - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = YS_ARRAY_BEGEND + END SUBROUTINE YS_ARRAY diff --git a/Source/LK1/L1A-BD/BD_ASET.f90 b/Source/LK1/L1A-BD/BD_ASET.f90 index a836e2c3..9edc6e32 100644 --- a/Source/LK1/L1A-BD/BD_ASET.f90 +++ b/Source/LK1/L1A-BD/BD_ASET.f90 @@ -35,10 +35,9 @@ SUBROUTINE BD_ASET ( CARD ) ! GRIDJ is written twice to be compatible with the data written to file LINK1N for ASET1 data USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1N + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1N USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NAOCARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_ASET_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN USE BD_ASET_USE_IFs @@ -57,14 +56,9 @@ SUBROUTINE BD_ASET ( CARD ) INTEGER(LONG) :: JERR = 0 ! Count of no. of errors when data fields are read from ASET/OMIT cards INTEGER(LONG) :: COMPJ = 0 ! Displ component(s) read from a B.D. ASET/OMIT card INTEGER(LONG) :: GRIDJ = 0 ! A grid point number read from a B.D. ASET/OMIT card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_ASET_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! ASET, OMIT Bulk Data Card routine @@ -130,12 +124,7 @@ SUBROUTINE BD_ASET ( CARD ) CALL BD_IMBEDDED_BLANK ( JCARD,2,0,4,0,6,0,8,0 ) ! Make sure that there are no imbedded blanks in fields 2, 4, 6, 8 CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_ASET1.f90 b/Source/LK1/L1A-BD/BD_ASET1.f90 index 330fca26..95488f6b 100644 --- a/Source/LK1/L1A-BD/BD_ASET1.f90 +++ b/Source/LK1/L1A-BD/BD_ASET1.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_ASET1 ( CARD, LARGE_FLD_INP ) ! Each record contains: COMPJ, GRIDJ1, GRIDJ2, SET USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1N + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1N USE SCONTR, ONLY : FATAL_ERR, IERRFL, JCARD_LEN, JF, NAOCARD, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_ASET1_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN USE BD_ASET1_USE_IFs @@ -61,14 +60,9 @@ SUBROUTINE BD_ASET1 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: GRIDJ = 0 ! A grid point number read from a B.D. ASET/OMIT card in format #2 INTEGER(LONG) :: GRIDJ1 = 0 ! 1st grid in format #1 of ASET/OMIT input INTEGER(LONG) :: GRIDJ2 = 0 ! 2nd grid in format #1 of ASET/OMIT input - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_ASET1_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! ASET1, OMIT1 Bulk Data Card routine @@ -227,12 +221,7 @@ SUBROUTINE BD_ASET1 ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_BAROR.f90 b/Source/LK1/L1A-BD/BD_BAROR.f90 index 60479c4e..4d27b24a 100644 --- a/Source/LK1/L1A-BD/BD_BAROR.f90 +++ b/Source/LK1/L1A-BD/BD_BAROR.f90 @@ -30,11 +30,10 @@ SUBROUTINE BD_BAROR ( CARD ) ! if present. The BAROR V vector type (BAROR_VVEC_TYPE) was determined in subr BAROR0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LVVEC, NBAROR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : BD_BAROR_BEGEND USE MODEL_STUF, ONLY : BAROR_VVEC_TYPE, BAROR_G0, BAROR_VV, BAROR_PID USE BD_BAROR_USE_IFs @@ -48,17 +47,12 @@ SUBROUTINE BD_BAROR ( CARD ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: I4INP ! A value read from input file that should be an integer value INTEGER(LONG) :: PGM_ERR = 0 ! A count of the number of coding errors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_BAROR_BEGEND + REAL(DOUBLE) :: EPS1 ! A small value to compare zero to REAL(DOUBLE) :: R8INP ! A value read from input file that should be a real value -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! BAROR Bulk Data Card routine @@ -134,12 +128,7 @@ SUBROUTINE BD_BAROR ( CARD ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_BAROR0.f90 b/Source/LK1/L1A-BD/BD_BAROR0.f90 index 7cfc29d2..87602329 100644 --- a/Source/LK1/L1A-BD/BD_BAROR0.f90 +++ b/Source/LK1/L1A-BD/BD_BAROR0.f90 @@ -36,10 +36,9 @@ SUBROUTINE BD_BAROR0 ( CARD ) ! d) 'ERROR ' means anything but (a), (b), or (c). Subr BD_BAROR will print error USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, LVVEC, NBAROR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_BAROR0_BEGEND USE MODEL_STUF, ONLY : BAROR_PID, BAROR_G0, BAROR_VV, BAROR_VVEC_TYPE, JBAROR USE BD_BAROR0_USE_IFs @@ -53,16 +52,11 @@ SUBROUTINE BD_BAROR0 ( CARD ) INTEGER(LONG) :: I4INP = 0 ! A value read from input file that should be an integer value INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: JERR = 0 ! A local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_BAROR0_BEGEND + REAL(DOUBLE) :: R8INP ! A value read from input file that should be a real value -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make JCARD from CARD @@ -145,12 +139,7 @@ SUBROUTINE BD_BAROR0 ( CARD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_BEAMOR.f90 b/Source/LK1/L1A-BD/BD_BEAMOR.f90 index 87db1d84..ab9c94ad 100644 --- a/Source/LK1/L1A-BD/BD_BEAMOR.f90 +++ b/Source/LK1/L1A-BD/BD_BEAMOR.f90 @@ -30,11 +30,10 @@ SUBROUTINE BD_BEAMOR ( CARD ) ! if present. The BEAMOR V vector type (BEAMOR_VVEC_TYPE) was determined in subr BEAMOR0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LVVEC, NBEAMOR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : BD_BEAMOR_BEGEND USE MODEL_STUF, ONLY : BEAMOR_VVEC_TYPE, BEAMOR_G0, BEAMOR_VV, BEAMOR_PID USE BD_BEAMOR_USE_IFs @@ -48,17 +47,12 @@ SUBROUTINE BD_BEAMOR ( CARD ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: I4INP ! A value read from input file that should be an integer value INTEGER(LONG) :: PGM_ERR = 0 ! A count of the number of coding errors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_BEAMOR_BEGEND + REAL(DOUBLE) :: EPS1 ! A small value to compare zero to REAL(DOUBLE) :: R8INP ! A value read from input file that should be a real value -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! BEAMOR Bulk Data Card routine @@ -134,12 +128,7 @@ SUBROUTINE BD_BEAMOR ( CARD ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_BEAMOR0.f90 b/Source/LK1/L1A-BD/BD_BEAMOR0.f90 index 143d1e8b..25de48fb 100644 --- a/Source/LK1/L1A-BD/BD_BEAMOR0.f90 +++ b/Source/LK1/L1A-BD/BD_BEAMOR0.f90 @@ -36,10 +36,9 @@ SUBROUTINE BD_BEAMOR0 ( CARD ) ! d) 'ERROR ' means anything but (a), (b), or (c). Subr BD_BEAMOR will print error USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, LVVEC, NBEAMOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_BEAMOR0_BEGEND USE MODEL_STUF, ONLY : BEAMOR_PID, BEAMOR_G0, BEAMOR_VV, BEAMOR_VVEC_TYPE, JBEAMOR USE BD_BEAMOR0_USE_IFs @@ -53,16 +52,11 @@ SUBROUTINE BD_BEAMOR0 ( CARD ) INTEGER(LONG) :: I4INP = 0 ! A value read from input file that should be an integer value INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: JERR = 0 ! A local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_BEAMOR0_BEGEND + REAL(DOUBLE) :: R8INP ! A value read from input file that should be a real value -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make JCARD from CARD @@ -145,12 +139,7 @@ SUBROUTINE BD_BEAMOR0 ( CARD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CBAR.f90 b/Source/LK1/L1A-BD/BD_CBAR.f90 index 3a139620..df05d86f 100644 --- a/Source/LK1/L1A-BD/BD_CBAR.f90 +++ b/Source/LK1/L1A-BD/BD_CBAR.f90 @@ -28,11 +28,10 @@ SUBROUTINE BD_CBAR ( CARD, LARGE_FLD_INP ) ! Processes CBAR and CBEAM Bulk Data Cards: USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LBAROFF, LVVEC, MEDAT_CBAR, & MEDAT_CBEAM, NBAROFF, NBAROR, NBEAMOR, NCBAR, NCBEAM, NEDAT, NELE, NVVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CBAR_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : BAROFF, BAROR_G0, BEAMOR_G0, BAROR_PID, BEAMOR_PID, BAROR_VVEC_TYPE, BEAMOR_VVEC_TYPE, & @@ -63,7 +62,7 @@ SUBROUTINE BD_CBAR ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: VVEC_NUM = 0 ! V vector number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CBAR_BEGEND + REAL(DOUBLE) :: VV(3) ! The 3 components of the V vector for this CBAR/CBEAM elem REAL(DOUBLE) :: EPS1 ! A small number to compare real zero @@ -71,12 +70,7 @@ SUBROUTINE BD_CBAR ( CARD, LARGE_FLD_INP ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CBAR element Bulk Data Card routine @@ -348,12 +342,7 @@ SUBROUTINE BD_CBAR ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CBAR0.f90 b/Source/LK1/L1A-BD/BD_CBAR0.f90 index 385b8199..60fffa56 100644 --- a/Source/LK1/L1A-BD/BD_CBAR0.f90 +++ b/Source/LK1/L1A-BD/BD_CBAR0.f90 @@ -29,10 +29,8 @@ SUBROUTINE BD_CBAR0 ( CARD, LARGE_FLD_INP ) ! Processes CBAR or CBEAM Bulk Data Cards to increment LVVEC and LBAROFF if the CBAR or CBEAM entry has a V vector or offsets USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, LBAROFF, LVVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CBAR0_BEGEND USE BD_CBAR0_USE_IFs @@ -48,14 +46,9 @@ SUBROUTINE BD_CBAR0 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: J INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CBAR0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make JCARD from CARD @@ -91,12 +84,7 @@ SUBROUTINE BD_CBAR0 ( CARD, LARGE_FLD_INP ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CBUSH.f90 b/Source/LK1/L1A-BD/BD_CBUSH.f90 index ce427b0a..3acefa6f 100644 --- a/Source/LK1/L1A-BD/BD_CBUSH.f90 +++ b/Source/LK1/L1A-BD/BD_CBUSH.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_CBUSH ( CARD, LARGE_FLD_INP ) ! Processes CBUSH Bulk Data card: USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LBUSHOFF, LVVEC, MEDAT_CBUSH,& NBUSHOFF, NCBUSH, NEDAT, NELE, NVVEC, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CBUSH_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : BUSHOFF, EDAT, ETYPE, VVEC @@ -63,7 +62,7 @@ SUBROUTINE BD_CBUSH ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: NEDAT_START ! Value of NEDAT at start of this subr INTEGER(LONG) :: OCID ! Coord sys ID for offsets INTEGER(LONG) :: VVEC_NUM = 0 ! V vector number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CBUSH_BEGEND + REAL(DOUBLE) :: VV(3) ! The 3 components of the V vector for this CBUSH elem REAL(DOUBLE) :: EPS1 ! A small number to compare real zero @@ -71,12 +70,7 @@ SUBROUTINE BD_CBUSH ( CARD, LARGE_FLD_INP ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CBUSH element Bulk Data Card routine @@ -364,12 +358,7 @@ SUBROUTINE BD_CBUSH ( CARD, LARGE_FLD_INP ) NEDAT = NEDAT_START + MEDAT_CBUSH -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CBUSH0.f90 b/Source/LK1/L1A-BD/BD_CBUSH0.f90 index 7b19ab33..2fd44e81 100644 --- a/Source/LK1/L1A-BD/BD_CBUSH0.f90 +++ b/Source/LK1/L1A-BD/BD_CBUSH0.f90 @@ -29,10 +29,8 @@ SUBROUTINE BD_CBUSH0 ( CARD, LARGE_FLD_INP ) ! Processes CBUSH Bulk Data Cards to increment LVVEC and LBUSHOFF if the CBUSH entry has a V vector or offsets USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, LBUSHOFF, LVVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CBUSH0_BEGEND USE BD_CBUSH0_USE_IFs @@ -48,14 +46,9 @@ SUBROUTINE BD_CBUSH0 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: J INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CBUSH0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make JCARD from CARD @@ -94,12 +87,7 @@ SUBROUTINE BD_CBUSH0 ( CARD, LARGE_FLD_INP ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CELAS1.f90 b/Source/LK1/L1A-BD/BD_CELAS1.f90 index 662c50ca..fd5cfec3 100644 --- a/Source/LK1/L1A-BD/BD_CELAS1.f90 +++ b/Source/LK1/L1A-BD/BD_CELAS1.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CELAS1 ( CARD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEDAT_CELAS1, NCELAS1, NELE, NEDAT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CELAS_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE USE BD_CELAS1_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE BD_CELAS1 ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IDOF ! Displ component (1,2,3,4,5 or 6) that one end of CELSA conn. to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CELAS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CELAS1 scalar spring element Bulk Data Card routine @@ -124,12 +118,7 @@ SUBROUTINE BD_CELAS1 ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 ) ! Issue warning if fields 8, 9 are not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CELAS2.f90 b/Source/LK1/L1A-BD/BD_CELAS2.f90 index 6921ee42..1a9aa9b0 100644 --- a/Source/LK1/L1A-BD/BD_CELAS2.f90 +++ b/Source/LK1/L1A-BD/BD_CELAS2.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CELAS2 ( CARD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEDAT_CELAS2, NCELAS2, NELE, NEDAT, NPELAS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CELAS_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE, PELAS, RPELAS USE BD_CELAS2_USE_IFs @@ -52,16 +51,11 @@ SUBROUTINE BD_CELAS2 ( CARD ) INTEGER(LONG) :: I4INP ! An integer read INTEGER(LONG) :: IDOF ! Displ component (1,2,3,4,5 or 6) that one end of CELSA conn. to INTEGER(LONG) :: IERR ! Error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CELAS_BEGEND + REAL(DOUBLE) :: R8INP ! A real value read -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CELAS2 scalar spring element Bulk Data Card routine @@ -163,12 +157,7 @@ SUBROUTINE BD_CELAS2 ( CARD ) CALL BD_IMBEDDED_BLANK ( JCARD,2,3,4,5,6,7,8,9 ) ! Make sure that there are no imbedded blanks in fields 2-7 CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CELAS3.f90 b/Source/LK1/L1A-BD/BD_CELAS3.f90 index 8d334e2d..e7c198ea 100644 --- a/Source/LK1/L1A-BD/BD_CELAS3.f90 +++ b/Source/LK1/L1A-BD/BD_CELAS3.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CELAS3 ( CARD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEDAT_CELAS3, NCELAS3, NELE, NEDAT USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CELAS_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE USE BD_CELAS3_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE BD_CELAS3 ( CARD ) CHARACTER(LEN(JCARD)) :: JCARD_EDAT(10) ! JCARD but with fields 5 and 6 switched to get G.P.'s together in EDAT INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CELAS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CELAS3 scalar spring element Bulk Data Card routine @@ -94,12 +88,7 @@ SUBROUTINE BD_CELAS3 ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,6,7,8,9 ) ! Issue warning if fields 6-9 are not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CELAS4.f90 b/Source/LK1/L1A-BD/BD_CELAS4.f90 index 3863ea9c..d54f8758 100644 --- a/Source/LK1/L1A-BD/BD_CELAS4.f90 +++ b/Source/LK1/L1A-BD/BD_CELAS4.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CELAS4 ( CARD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEDAT_CELAS4, NCELAS4, NELE, NEDAT, NPELAS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CELAS_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE, PELAS, RPELAS USE BD_CELAS4_USE_IFs @@ -50,16 +49,11 @@ SUBROUTINE BD_CELAS4 ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: I4INP ! Integer value read from a field of the CELAS4 entry INTEGER(LONG) :: IERR ! Error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CELAS_BEGEND + REAL(DOUBLE) :: R8INP ! Real value read from a field on the PSHEAR entry -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CELAS4 scalar spring element Bulk Data Card routine @@ -125,12 +119,7 @@ SUBROUTINE BD_CELAS4 ( CARD ) EDAT(NEDAT-2) = -EDAT(NEDAT-2) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CHEXA.f90 b/Source/LK1/L1A-BD/BD_CHEXA.f90 index 42d6d8c2..80cf2bb4 100644 --- a/Source/LK1/L1A-BD/BD_CHEXA.f90 +++ b/Source/LK1/L1A-BD/BD_CHEXA.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CHEXA ( CARD, LARGE_FLD_INP, NUM_GRD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN, NCHEXA8, NCHEXA20, NEDAT, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CHEXA_BEGEND USE MODEL_STUF, ONLY : ETYPE USE BD_CHEXA_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE BD_CHEXA ( CARD, LARGE_FLD_INP, NUM_GRD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CHEXA_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CHEXA element Bulk Data Card routine @@ -184,12 +178,7 @@ SUBROUTINE BD_CHEXA ( CARD, LARGE_FLD_INP, NUM_GRD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CHEXA0.f90 b/Source/LK1/L1A-BD/BD_CHEXA0.f90 index fe040366..eab77901 100644 --- a/Source/LK1/L1A-BD/BD_CHEXA0.f90 +++ b/Source/LK1/L1A-BD/BD_CHEXA0.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CHEXA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) ! Processes CHEXA Bulk Data Cards to determine how many words to allocate to array EDAT for this element USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, MEDAT_CHEXA8, MEDAT_CHEXA20 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CHEXA0_BEGEND USE BD_CHEXA0_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE BD_CHEXA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG), INTENT(OUT) :: DELTA_LEDAT ! Delta number of words to add to LEDAT for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CHEXA0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! This element must have at least 1 continuation card since there must be at leas 8 grids defined (all corner nodes). The parent @@ -86,12 +80,7 @@ SUBROUTINE BD_CHEXA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) ELSE ! There was no 1st contin card. This is error that will be caught later DELTA_LEDAT = MEDAT_CHEXA20 ! For this error, set DELTA_LEDAT to largest until error is caught ENDIF -!*********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CMASS1.f90 b/Source/LK1/L1A-BD/BD_CMASS1.f90 index c6083750..d5303f32 100644 --- a/Source/LK1/L1A-BD/BD_CMASS1.f90 +++ b/Source/LK1/L1A-BD/BD_CMASS1.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CMASS1 ( CARD ) ! Processes CMASS1 Bulk Data Cards. NOTE: MYSTRAN scalar masses must be attached to only 1 point USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NCMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CMASS_BEGEND USE MODEL_STUF, ONLY : CMASS USE BD_CMASS1_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE BD_CMASS1 ( CARD ) INTEGER(LONG) :: CMASS_ELID ! Element ID INTEGER(LONG) :: GPOINT1,GPOINT2 ! 2 grid points (1 must be blank or zero) INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CMASS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CMASS1 scalar spring element Bulk Data Card routine @@ -138,12 +132,7 @@ SUBROUTINE BD_CMASS1 ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 ) ! Issue warning if fields 8, 9 are not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CMASS2.f90 b/Source/LK1/L1A-BD/BD_CMASS2.f90 index 25516cd1..d2e25d07 100644 --- a/Source/LK1/L1A-BD/BD_CMASS2.f90 +++ b/Source/LK1/L1A-BD/BD_CMASS2.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CMASS2 ( CARD ) ! Processes CMASS2 Bulk Data Cards. NOTE: MYSTRAN scalar masses must be attached to only 1 point USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NCMASS, NPMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CMASS_BEGEND USE MODEL_STUF, ONLY : CMASS, PMASS, RPMASS USE BD_CMASS2_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE BD_CMASS2 ( CARD ) INTEGER(LONG) :: CMASS_ELID ! Element ID INTEGER(LONG) :: GPOINT1,GPOINT2 ! 2 grid points (1 must be blank or zero) INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CMASS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CMASS2 scalar spring element Bulk Data Card routine @@ -142,12 +136,7 @@ SUBROUTINE BD_CMASS2 ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 ) ! Issue warning if fields 8, 9 are not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CMASS3.f90 b/Source/LK1/L1A-BD/BD_CMASS3.f90 index 8aa12bf6..c0f8b822 100644 --- a/Source/LK1/L1A-BD/BD_CMASS3.f90 +++ b/Source/LK1/L1A-BD/BD_CMASS3.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CMASS3 ( CARD ) ! Processes CMASS3 Bulk Data Cards. NOTE: MYSTRAN scalar masses must be attached to only 1 scalar point USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NCMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CMASS_BEGEND USE MODEL_STUF, ONLY : CMASS USE BD_CMASS3_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE BD_CMASS3 ( CARD ) INTEGER(LONG) :: CMASS_ELID ! Element ID INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SPOINT1,SPOINT2 ! 2 scalar points (1 must be blank or zero) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CMASS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CMASS3 scalar spring element Bulk Data Card routine @@ -141,12 +135,7 @@ SUBROUTINE BD_CMASS3 ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,6,7,8,9 ) ! Issue warning if fields 6-9 are not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CMASS4.f90 b/Source/LK1/L1A-BD/BD_CMASS4.f90 index 1d2efecd..062f389e 100644 --- a/Source/LK1/L1A-BD/BD_CMASS4.f90 +++ b/Source/LK1/L1A-BD/BD_CMASS4.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CMASS4 ( CARD ) ! Processes CMASS4 Bulk Data Cards. NOTE: MYSTRAN scalar masses must be attached to only 1 scalar point USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NCMASS, NPMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CMASS_BEGEND USE MODEL_STUF, ONLY : CMASS, PMASS, RPMASS USE BD_CMASS4_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE BD_CMASS4 ( CARD ) INTEGER(LONG) :: CMASS_ELID ! Element ID INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SPOINT1,SPOINT2 ! 2 scalar points (1 must be blank or zero) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CMASS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CMASS4 scalar spring element Bulk Data Card routine @@ -143,12 +137,7 @@ SUBROUTINE BD_CMASS4 ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 ) ! Issue warning if fields 8, 9 are not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CONM2.f90 b/Source/LK1/L1A-BD/BD_CONM2.f90 index 17cd0f25..834fa933 100644 --- a/Source/LK1/L1A-BD/BD_CONM2.f90 +++ b/Source/LK1/L1A-BD/BD_CONM2.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CONM2 ( CARD, LARGE_FLD_INP ) ! 2) Reads mass, offsets, and moments of inertia and puts them into array RCONM2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LCONM2, NCONM2, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CONM2_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SUPWARN USE MODEL_STUF, ONLY : CONM2, RCONM2 @@ -56,14 +55,9 @@ SUBROUTINE BD_CONM2 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CONM2_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CONM2 Bulk Data Card routine @@ -206,12 +200,7 @@ SUBROUTINE BD_CONM2 ( CARD, LARGE_FLD_INP ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CONROD.f90 b/Source/LK1/L1A-BD/BD_CONROD.f90 index 80a20db1..4b8e0fda 100644 --- a/Source/LK1/L1A-BD/BD_CONROD.f90 +++ b/Source/LK1/L1A-BD/BD_CONROD.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CONROD ( CARD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, MEDAT_CROD, NCROD, NELE, NEDAT, NPROD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CONROD_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE, PROD, RPROD USE BD_CONROD_USE_IFs @@ -51,16 +50,11 @@ SUBROUTINE BD_CONROD ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: I4INP ! An integer read INTEGER(LONG) :: IERR ! Error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CONROD_BEGEND + REAL(DOUBLE) :: R8INP ! A real value read -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CONROD element Bulk Data Card routine @@ -148,12 +142,7 @@ SUBROUTINE BD_CONROD ( CARD ) CALL R8FLD ( JCARD(8), JF(8), RPROD(NPROD,3) ) CALL R8FLD ( JCARD(9), JF(9), RPROD(NPROD,4) ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CORD.f90 b/Source/LK1/L1A-BD/BD_CORD.f90 index 6d643998..8a7d4ba8 100644 --- a/Source/LK1/L1A-BD/BD_CORD.f90 +++ b/Source/LK1/L1A-BD/BD_CORD.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CORD ( CARD, LARGE_FLD_INP ) ! 3) Reads coord data into array RCORD USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, IERRFL, JCARD_LEN, JF, LCORD, NCORD, NCORD1, NCORD2, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CORD_BEGEND USE MODEL_STUF, ONLY : CORD, RCORD USE BD_CORD_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE BD_CORD ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: I4INP = 0 ! A value read from input file that should be an integer value INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CORD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CORD1R Bulk Data Card routine @@ -307,12 +301,7 @@ SUBROUTINE BD_CORD ( CARD, LARGE_FLD_INP ) ! ---------------------------------------------------------------------------------------------------------------------------------- ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CPENTA.f90 b/Source/LK1/L1A-BD/BD_CPENTA.f90 index 0a10be56..ca4682c9 100644 --- a/Source/LK1/L1A-BD/BD_CPENTA.f90 +++ b/Source/LK1/L1A-BD/BD_CPENTA.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CPENTA ( CARD, LARGE_FLD_INP, NUM_GRD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, JCARD_LEN, NCPENTA6, NCPENTA15, NEDAT, NELE, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CPENTA_BEGEND USE MODEL_STUF, ONLY : ETYPE USE BD_CPENTA_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE BD_CPENTA ( CARD, LARGE_FLD_INP, NUM_GRD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CPENTA_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CPENTA element Bulk Data Card routine @@ -172,12 +166,7 @@ SUBROUTINE BD_CPENTA ( CARD, LARGE_FLD_INP, NUM_GRD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CPENTA0.f90 b/Source/LK1/L1A-BD/BD_CPENTA0.f90 index e6e750a1..fe64c63f 100644 --- a/Source/LK1/L1A-BD/BD_CPENTA0.f90 +++ b/Source/LK1/L1A-BD/BD_CPENTA0.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CPENTA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) ! Processes CPENTA Bulk Data Cards to determine how many words to allocate to array EDAT for this element USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, MEDAT_CPENTA6, MEDAT_CPENTA15 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CPENTA0_BEGEND USE BD_CPENTA0_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE BD_CPENTA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG), INTENT(OUT) :: DELTA_LEDAT ! Delta number of words to add to LEDAT for this element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CPENTA0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! This element does not need any continuation cards. The parent must define 6 nodes of the PENTA. Continuation cards can define @@ -78,12 +72,7 @@ SUBROUTINE BD_CPENTA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) DELTA_LEDAT = MEDAT_CPENTA6 ENDIF -!*********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CQUAD.f90 b/Source/LK1/L1A-BD/BD_CQUAD.f90 index eddffd13..26cdb94f 100644 --- a/Source/LK1/L1A-BD/BD_CQUAD.f90 +++ b/Source/LK1/L1A-BD/BD_CQUAD.f90 @@ -31,11 +31,10 @@ SUBROUTINE BD_CQUAD ( CARD, LARGE_FLD_INP, NUM_GRD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, FATAL_ERR, JCARD_LEN, JF, LMATANGLE, LPLATEOFF, LPLATETHICK, & MEDAT_CQUAD, NCQUAD4K, NCQUAD4, NEDAT, NELE, NMATANGLE, NPLATEOFF, NPLATETHICK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CQUAD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : EDAT, ETYPE, MATANGLE, PLATEOFF, PLATETHICK @@ -58,16 +57,11 @@ SUBROUTINE BD_CQUAD ( CARD, LARGE_FLD_INP, NUM_GRD ) INTEGER(LONG) :: INT41,INT42 ! An integer used in getting MATANGLE INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CQUAD_BEGEND + REAL(DOUBLE) :: R8INP = ZERO ! A value read from input file that should be a real value -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CQUADi element Bulk Data Card routine @@ -252,12 +246,7 @@ SUBROUTINE BD_CQUAD ( CARD, LARGE_FLD_INP, NUM_GRD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CQUAD0.f90 b/Source/LK1/L1A-BD/BD_CQUAD0.f90 index 39ea100a..6d50a47e 100644 --- a/Source/LK1/L1A-BD/BD_CQUAD0.f90 +++ b/Source/LK1/L1A-BD/BD_CQUAD0.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_CQUAD0 ( CARD, LARGE_FLD_INP ) ! (3) LPLATETHICK if the elem has thicknesses defined on a continuation entry USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, LMATANGLE, LPLATEOFF, LPLATETHICK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CQUAD0_BEGEND USE BD_CQUAD0_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE BD_CQUAD0 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CQUAD0_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Make JCARD from CARD @@ -89,12 +83,7 @@ SUBROUTINE BD_CQUAD0 ( CARD, LARGE_FLD_INP ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CROD.f90 b/Source/LK1/L1A-BD/BD_CROD.f90 index 4eb79311..e5658749 100644 --- a/Source/LK1/L1A-BD/BD_CROD.f90 +++ b/Source/LK1/L1A-BD/BD_CROD.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CROD ( CARD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, MEDAT_CROD, NCROD, NEDAT, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CROD_BEGEND USE MODEL_STUF, ONLY : ETYPE USE BD_CROD_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE BD_CROD ( CARD ) CHARACTER(LEN(JCARD)) :: JCARD_EDAT(10) ! JCARD values sent to subr ELEPRO INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CROD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CROD element Bulk Data Card routine @@ -94,12 +88,7 @@ SUBROUTINE BD_CROD ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,6,7,8,9 ) ! Issue warning if fields 6, 7, 8, 9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CSHEAR.f90 b/Source/LK1/L1A-BD/BD_CSHEAR.f90 index f67ac1fa..6b1294f8 100644 --- a/Source/LK1/L1A-BD/BD_CSHEAR.f90 +++ b/Source/LK1/L1A-BD/BD_CSHEAR.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CSHEAR ( CARD, NUM_GRD ) ! Processes CSHEAR Bulk Data Cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, MEDAT_CSHEAR, NCSHEAR, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CSHEAR_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE USE BD_CSHEAR_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE BD_CSHEAR ( CARD, NUM_GRD ) INTEGER(LONG), INTENT(OUT) :: NUM_GRD ! Number of GRID's + SPOINT's for the elem INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CSHEAR_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! CSHEAR element Bulk Data Card routine @@ -96,12 +90,7 @@ SUBROUTINE BD_CSHEAR ( CARD, NUM_GRD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 )! Issue warning if fields 8, 9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CTETRA.f90 b/Source/LK1/L1A-BD/BD_CTETRA.f90 index 30085d61..7fdfdd91 100644 --- a/Source/LK1/L1A-BD/BD_CTETRA.f90 +++ b/Source/LK1/L1A-BD/BD_CTETRA.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CTETRA ( CARD, LARGE_FLD_INP, NUM_GRD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, FATAL_ERR, NCTETRA4, NCTETRA10, NEDAT, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CTETRA_BEGEND USE MODEL_STUF, ONLY : ETYPE USE BD_CTETRA_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE BD_CTETRA ( CARD, LARGE_FLD_INP, NUM_GRD ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CTETRA_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CTETRA element Bulk Data Card routine @@ -144,12 +138,7 @@ SUBROUTINE BD_CTETRA ( CARD, LARGE_FLD_INP, NUM_GRD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CTETRA0.f90 b/Source/LK1/L1A-BD/BD_CTETRA0.f90 index fa7a536e..0b537d98 100644 --- a/Source/LK1/L1A-BD/BD_CTETRA0.f90 +++ b/Source/LK1/L1A-BD/BD_CTETRA0.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CTETRA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) ! Processes CTETRA Bulk Data Cards to determine how many words to allocate to array EDAT for this element USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, MEDAT_CTETRA4, MEDAT_CTETRA10 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CTETRA0_BEGEND USE BD_CTETRA0_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE BD_CTETRA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) INTEGER(LONG), INTENT(OUT) :: DELTA_LEDAT ! Delta number of words to add to LEDAT for this element INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CTETRA0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! This element does not need any continuation cards. The parent must define the 4 mandatory corner nodes of the TETRA and can also @@ -82,12 +76,7 @@ SUBROUTINE BD_CTETRA0 ( CARD, LARGE_FLD_INP, DELTA_LEDAT ) ENDIF ENDIF -!********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CTRIA.f90 b/Source/LK1/L1A-BD/BD_CTRIA.f90 index 65073bef..599cc6c9 100644 --- a/Source/LK1/L1A-BD/BD_CTRIA.f90 +++ b/Source/LK1/L1A-BD/BD_CTRIA.f90 @@ -31,11 +31,10 @@ SUBROUTINE BD_CTRIA ( CARD, LARGE_FLD_INP, NUM_GRD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, FATAL_ERR, JCARD_LEN, JF, LMATANGLE, LPLATEOFF, LPLATETHICK, & MEDAT_CTRIA, NCTRIA3K, NCTRIA3, NEDAT, NELE, NMATANGLE, NPLATEOFF, NPLATETHICK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CTRIA_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : EDAT, ETYPE, MATANGLE, PLATEOFF, PLATETHICK @@ -58,16 +57,11 @@ SUBROUTINE BD_CTRIA ( CARD, LARGE_FLD_INP, NUM_GRD ) INTEGER(LONG) :: INT41,INT42 ! An integer used in getting MATANGLE INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CTRIA_BEGEND + REAL(DOUBLE) :: R8INP = ZERO ! A value read from input file that should be a real value -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CTRIAi, CTRPLTi, CTRMEM element Bulk Data Card routine @@ -251,12 +245,7 @@ SUBROUTINE BD_CTRIA ( CARD, LARGE_FLD_INP, NUM_GRD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CTRIA0.f90 b/Source/LK1/L1A-BD/BD_CTRIA0.f90 index a753c3a7..5b759afe 100644 --- a/Source/LK1/L1A-BD/BD_CTRIA0.f90 +++ b/Source/LK1/L1A-BD/BD_CTRIA0.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_CTRIA0 ( CARD, LARGE_FLD_INP ) ! Processes CTRIA Bulk Data Cards to increment LMATANGLE if the elem has a material property angle USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, LMATANGLE, LPLATEOFF, LPLATETHICK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CTRIA0_BEGEND USE BD_CTRIA0_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE BD_CTRIA0 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CTRIA0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make JCARD from CARD @@ -84,12 +78,7 @@ SUBROUTINE BD_CTRIA0 ( CARD, LARGE_FLD_INP ) LPLATETHICK = LPLATETHICK + 3 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CUSER1.f90 b/Source/LK1/L1A-BD/BD_CUSER1.f90 index 5a4e69d5..cce21ad3 100644 --- a/Source/LK1/L1A-BD/BD_CUSER1.f90 +++ b/Source/LK1/L1A-BD/BD_CUSER1.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_CUSER1 ( CARD, LARGE_FLD_INP, NUM_GRD ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, JF, MEDAT_CUSER1, NCUSER1, NEDAT, NELE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CUSER1_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE USE BD_CUSER1_USE_IFs @@ -52,14 +51,9 @@ SUBROUTINE BD_CUSER1 ( CARD, LARGE_FLD_INP, NUM_GRD ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CUSER1_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CUSER1 element Bulk Data Card routine @@ -133,12 +127,7 @@ SUBROUTINE BD_CUSER1 ( CARD, LARGE_FLD_INP, NUM_GRD ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CUSERIN.f90 b/Source/LK1/L1A-BD/BD_CUSERIN.f90 index 8430ae8b..c6df4e97 100644 --- a/Source/LK1/L1A-BD/BD_CUSERIN.f90 +++ b/Source/LK1/L1A-BD/BD_CUSERIN.f90 @@ -31,12 +31,11 @@ SUBROUTINE BD_CUSERIN ( CARD, LARGE_FLD_INP, NG, NS ) ! 2) Calls subr ELEPRO to read element ID, property ID and connection data into array EDAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LGUSERIN, LSUSERIN, MEDAT0_CUSERIN, & NCUSERIN, NEDAT, NELE, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : BD_CUSERIN_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE USE BD_CUSERIN_USE_IFs @@ -81,14 +80,9 @@ SUBROUTINE BD_CUSERIN ( CARD, LARGE_FLD_INP, NG, NS ) ! Array of displ components on the CUSERIN entry (for USERIN_GRIDS) INTEGER(LONG) :: USERIN_COMPS(LGUSERIN) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CUSERIN_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CUSERIN element Bulk Data Card routine @@ -418,12 +412,7 @@ SUBROUTINE BD_CUSERIN ( CARD, LARGE_FLD_INP, NG, NS ) EDAT(NEDAT) = NUM_BDY_DOF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_CUSERIN0.f90 b/Source/LK1/L1A-BD/BD_CUSERIN0.f90 index 228be201..c3e9a77e 100644 --- a/Source/LK1/L1A-BD/BD_CUSERIN0.f90 +++ b/Source/LK1/L1A-BD/BD_CUSERIN0.f90 @@ -29,10 +29,8 @@ SUBROUTINE BD_CUSERIN0 ( CARD, NG, NS ) ! Processes CUSERIN Bulk Data Cards to determine how many grids and SPOINT's are defined (so arrays can be allocated) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_CUSERIN0_BEGEND USE BD_CUSERIN0_USE_IFs @@ -45,14 +43,9 @@ SUBROUTINE BD_CUSERIN0 ( CARD, NG, NS ) INTEGER(LONG), INTENT(OUT) :: NG ! Number of GRID's INTEGER(LONG), INTENT(OUT) :: NS ! Number of SPOINT's INTEGER(LONG) :: I4INP = 0 ! A value read from input file that should be an integer value - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_CUSERIN0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CUSERIN parent entry @@ -84,12 +77,7 @@ SUBROUTINE BD_CUSERIN0 ( CARD, NG, NS ) IERRFL(5) = 'N' ENDIF -!********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_DEBUG.f90 b/Source/LK1/L1A-BD/BD_DEBUG.f90 index 7ac2dda0..931a400b 100644 --- a/Source/LK1/L1A-BD/BD_DEBUG.f90 +++ b/Source/LK1/L1A-BD/BD_DEBUG.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_DEBUG ( CARD ) ! Processes DEBUG Bulk Data Cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, IERRFL, JCARD_LEN, JF, WARN_ERR USE TIMDAT, ONLY : TSEC - USE PARAMS, ONLY : SUPWARN, PRTANS - USE SUBR_BEGEND_LEVELS, ONLY : BD_DEBUG_BEGEND + USE PARAMS, ONLY : SUPWARN USE DEBUG_PARAMETERS, ONLY : DEBUG, NDEBUG USE BD_DEBUG_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE BD_DEBUG ( CARD ) INTEGER(LONG), PARAMETER :: LOWER = 1 ! Lower allowable value for an integer parameter INTEGER(LONG) :: UPPER = NDEBUG ! Upper allowable value for an integer parameter INTEGER(LONG) :: VALUE ! Value for DEBUG(INDEX) read on B.D. DEBUG card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_DEBUG_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! DEBUG Bulk Data Card routine @@ -70,19 +64,7 @@ SUBROUTINE BD_DEBUG ( CARD ) IF (IERRFL(2) == 'N') THEN IF ((INDEX >= LOWER) .AND. (INDEX <= UPPER)) THEN CALL I4FLD ( JCARD(3), JF(3), VALUE ) - IF ((INDEX == 200) .AND. (PRTANS == 'Y')) THEN - ! already set this; VALUE is irrelvant because PRTANS takes priority - WARN_ERR = WARN_ERR + 1 - WRITE(ERR,101) CARD - WRITE(ERR,1121) VALUE - IF (SUPWARN == 'N') THEN - IF (ECHO == 'NONE ') THEN - WRITE(F06,101) CARD - ENDIF - WRITE(F06,1121) VALUE - ENDIF - - ELSEIF (IERRFL(3) == 'N') THEN + IF (IERRFL(3) == 'N') THEN DEBUG(INDEX) = VALUE ENDIF ELSE @@ -102,12 +84,7 @@ SUBROUTINE BD_DEBUG ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,4,5,6,7,8,9 ) ! Issue warning if fields 4-9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -115,8 +92,6 @@ SUBROUTINE BD_DEBUG ( CARD ) 101 FORMAT(A) 1120 FORMAT(' *WARNING : DEBUG INDEX MUST BE >= ',I4,' AND <= ',I4,' BUT INPUT VALUE IS: ',I8,'. ENTRY IGNORED') - 1121 FORMAT(' *WARNING : DEBUG,200 IS DEPRECATED AND IS REPLACED BY PARAM,PRTANS. BOTH WERE DEFINED. DEBUG,200, ', & - I4, ' AND WILL BE IGNORED') ! ********************************************************************************************************************************** diff --git a/Source/LK1/L1A-BD/BD_DEBUG0.f90 b/Source/LK1/L1A-BD/BD_DEBUG0.f90 index e5ec4549..3ffc8907 100644 --- a/Source/LK1/L1A-BD/BD_DEBUG0.f90 +++ b/Source/LK1/L1A-BD/BD_DEBUG0.f90 @@ -30,7 +30,7 @@ SUBROUTINE BD_DEBUG0 ( CARD ) ! set before LOADB is run. If there is an error here the DEBUG value is just not set. An error message is written when LOADB runs USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, IERRFL, JCARD_LEN, JF, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN diff --git a/Source/LK1/L1A-BD/BD_EIGR.f90 b/Source/LK1/L1A-BD/BD_EIGR.f90 index 5ebe3bb5..8eea0460 100644 --- a/Source/LK1/L1A-BD/BD_EIGR.f90 +++ b/Source/LK1/L1A-BD/BD_EIGR.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) ! Processes EIGR Bulk Data Cards. Reads and checks data and write data to file LINK1M. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1M + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1M USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : BD_EIG_BEGEND USE MODEL_STUF, ONLY : CC_EIGR_SID USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_CRIT_DEF, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_METH, EIG_MSGLVL, & EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, EIG_SID, EIG_SIGMA, & @@ -55,14 +54,9 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: JERR = 0 ! A local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_EIG_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! EIGR Bulk Data Card routine @@ -236,12 +230,7 @@ SUBROUTINE BD_EIGR ( CARD, LARGE_FLD_INP, EIGFND ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_EIGRL.f90 b/Source/LK1/L1A-BD/BD_EIGRL.f90 index 8c1554c3..eb166e9b 100644 --- a/Source/LK1/L1A-BD/BD_EIGRL.f90 +++ b/Source/LK1/L1A-BD/BD_EIGRL.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) ! Processes EIGRL Bulk Data Cards. Reads and checks data and write data to file LINK1M. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1M + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1M USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONEPM4 - USE SUBR_BEGEND_LEVELS, ONLY : BD_EIG_BEGEND USE MODEL_STUF, ONLY : CC_EIGR_SID, EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_LANCZOS_NEV_DELT, & EIG_METH, EIG_MSGLVL, EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, EIG_NCVFACL, EIG_NORM, & EIG_SID, EIG_SIGMA, EIG_VECS, MAXMIJ, MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT @@ -54,14 +53,9 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: JERR = 0 ! A local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_EIG_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! EIGRL Bulk Data Card routine @@ -214,19 +208,16 @@ SUBROUTINE BD_EIGRL ( CARD, LARGE_FLD_INP, EIGFND ) ! INITIAL_NEV*(2**MAX_DOUBLINGS), both being 10 and unlikely to be ! changed unless someone *really* wants more than 10k modes AND ! doesn't want to specify nmodes manually. - LSUB = 10240 + IF (SOL_NAME /= 'BUCKLING') THEN + LSUB = 10240 + END IF END IF CALL WRITE_L1M ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_FORMOM.f90 b/Source/LK1/L1A-BD/BD_FORMOM.f90 index e91571c8..3211cc54 100644 --- a/Source/LK1/L1A-BD/BD_FORMOM.f90 +++ b/Source/LK1/L1A-BD/BD_FORMOM.f90 @@ -33,10 +33,9 @@ SUBROUTINE BD_FORMOM ( CARD, CC_LOAD_FND ) ! SETID, GRID_NO, CID, FORMON1, FORMON2, FORMON3, FOR_OR_MOM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1I + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1I USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LFORCE, LSUB, NFORCE, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_FORMOM_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : FORMOM_SIDS, SUBLOD @@ -56,7 +55,7 @@ SUBROUTINE BD_FORMOM ( CARD, CC_LOAD_FND ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: SETID = 0 ! Set ID on the FORCE/MOMENT card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_FORMOM_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: FORMON1 = ZERO ! Force/moment magnitude for 1st dir in coord sys CID (= SCALEF*V1) @@ -70,12 +69,7 @@ SUBROUTINE BD_FORMOM ( CARD, CC_LOAD_FND ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! FORCE / MOMENT Bulk Data Card routine @@ -169,12 +163,7 @@ SUBROUTINE BD_FORMOM ( CARD, CC_LOAD_FND ) WRITE(L1I) SETID, GRID_NO, CID, FORMON1, FORMON2, FORMON3, FOR_OR_MOM ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_GRAV.f90 b/Source/LK1/L1A-BD/BD_GRAV.f90 index 804250c3..3c79d6fd 100644 --- a/Source/LK1/L1A-BD/BD_GRAV.f90 +++ b/Source/LK1/L1A-BD/BD_GRAV.f90 @@ -33,10 +33,9 @@ SUBROUTINE BD_GRAV ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) ! SETID, CID, ACCEL(1-6) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1P + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1P USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LGRAV, LSUB, NGRAV, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_GRAV_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : GRAV_SIDS, SUBLOD @@ -61,7 +60,7 @@ SUBROUTINE BD_GRAV ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) INTEGER(LONG) :: GID = 0 ! Grid ID (or 0) of the grid that the rotational grav accels refer to INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: SETID = 0 ! Set ID on the GRAV card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_GRAV_BEGEND + REAL(DOUBLE) :: ACCEL(6) ! Gravity magnitudes in the 3 translational and 3 rotational dirs REAL(DOUBLE) :: SCALEF = ZERO ! Scale factor on the GRAV card @@ -69,12 +68,7 @@ SUBROUTINE BD_GRAV ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! GRAV Bulk Data Card routine @@ -188,12 +182,7 @@ SUBROUTINE BD_GRAV ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) WRITE(L1P) SETID, CID, GID, (ACCEL(I),I=1,6) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_GRDSET.f90 b/Source/LK1/L1A-BD/BD_GRDSET.f90 index 0fc16e71..8c3005fe 100644 --- a/Source/LK1/L1A-BD/BD_GRDSET.f90 +++ b/Source/LK1/L1A-BD/BD_GRDSET.f90 @@ -35,10 +35,9 @@ SUBROUTINE BD_GRDSET ( CARD ) ! 2) GRDSET7 is field 8 for a GRID card (the perm SPC's) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NGRDSET USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_GRDSET_BEGEND USE MODEL_STUF, ONLY : GRDSET3, GRDSET7, GRDSET8 USE BD_GRDSET_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE BD_GRDSET ( CARD ) INTEGER(LONG) :: I4INP = 0 ! A value read from input file that should be an integer value INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein INTEGER(LONG) :: PGM_ERR = 0 ! A count of the number of coding errors - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_GRDSET_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! GRDSET Bulk Data Card routine. Values for GRDSET3, 7, 8 have already been @@ -130,12 +124,7 @@ SUBROUTINE BD_GRDSET ( CARD ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_GRDSET0.f90 b/Source/LK1/L1A-BD/BD_GRDSET0.f90 index 9408aa71..bc4ac064 100644 --- a/Source/LK1/L1A-BD/BD_GRDSET0.f90 +++ b/Source/LK1/L1A-BD/BD_GRDSET0.f90 @@ -35,10 +35,9 @@ SUBROUTINE BD_GRDSET0 ( CARD ) ! 2) GRDSET7 is field 8 for a GRID card (the perm SPC's) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, JF, IERRFL, NGRDSET USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_GRDSET0_BEGEND USE MODEL_STUF, ONLY : GRDSET3, GRDSET7, GRDSET8 USE BD_GRDSET0_USE_IFs @@ -53,14 +52,9 @@ SUBROUTINE BD_GRDSET0 ( CARD ) INTEGER(LONG) :: I4INP = 0 ! A value read from input file that should be an integer value INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_GRDSET0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! GRDSET Bulk Data Card routine @@ -117,12 +111,7 @@ SUBROUTINE BD_GRDSET0 ( CARD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_GRID.f90 b/Source/LK1/L1A-BD/BD_GRID.f90 index d7c8d74a..3f171089 100644 --- a/Source/LK1/L1A-BD/BD_GRID.f90 +++ b/Source/LK1/L1A-BD/BD_GRID.f90 @@ -35,10 +35,9 @@ SUBROUTINE BD_GRID ( CARD ) ! 5) Grid coordinates (fields 4, 5 and 6) and enters tham into array RGRID USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LGRID, NGRID, NGRDSET USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_GRID_BEGEND USE MODEL_STUF, ONLY : GRID, RGRID, GRDSET3, GRDSET7, GRDSET8 USE BD_GRID_USE_IFs @@ -55,14 +54,9 @@ SUBROUTINE BD_GRID ( CARD ) INTEGER(LONG) :: I4INP = 0 ! A value read from input file that should be an integer value INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_GRID_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! GRID Bulk Data Card routine @@ -162,12 +156,7 @@ SUBROUTINE BD_GRID ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,0,9 ) ! Issue warning if field 9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_IMBEDDED_BLANK.f90 b/Source/LK1/L1A-BD/BD_IMBEDDED_BLANK.f90 index 36d17f7e..bb90648a 100644 --- a/Source/LK1/L1A-BD/BD_IMBEDDED_BLANK.f90 +++ b/Source/LK1/L1A-BD/BD_IMBEDDED_BLANK.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_IMBEDDED_BLANK ( JCARD, CF2, CF3, CF4, CF5, CF6, CF7, CF8, CF9 ) ! Prepares message when some fields of a B.D card have imbedded blanks when they should not (but field can be completely blank) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_IMBEDDED_BLANK_BEGEND USE BD_IMBEDDED_BLANK_USE_IFs @@ -55,14 +54,9 @@ SUBROUTINE BD_IMBEDDED_BLANK ( JCARD, CF2, CF3, CF4, CF5, CF6, CF7, CF8, CF9 ) INTEGER(LONG) :: JCARDI_BEG ! Position where data begins in one JCARD INTEGER(LONG) :: JCARDI_END ! Position where data ends in one JCARD INTEGER(LONG) :: NUMBER(2:9) ! Number of imbedded blanks found in a Bulk Data card field - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_IMBEDDED_BLANK_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Load CF2 through CF9 into array CHK_FLD @@ -150,12 +144,7 @@ SUBROUTINE BD_IMBEDDED_BLANK ( JCARD, CF2, CF3, CF4, CF5, CF6, CF7, CF8, CF9 ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_LOAD.f90 b/Source/LK1/L1A-BD/BD_LOAD.f90 index c43f948a..8b90f952 100644 --- a/Source/LK1/L1A-BD/BD_LOAD.f90 +++ b/Source/LK1/L1A-BD/BD_LOAD.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_LOAD ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) ! 2) Scale factors (overall for this LOAD card and individual for each set ID) are entered into array LOAD_FACS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LLOADR, LSUB, NLOAD, LLOADC, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_LOAD_BEGEND USE MODEL_STUF, ONLY : LOAD_SIDS, LOAD_FACS, SUBLOD USE BD_LOAD_USE_IFs @@ -55,14 +54,9 @@ SUBROUTINE BD_LOAD ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: SETID ! Set ID for this LOAD Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_LOAD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! LOAD Bulk Data Card routine @@ -208,12 +202,7 @@ SUBROUTINE BD_LOAD ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_LOAD0.f90 b/Source/LK1/L1A-BD/BD_LOAD0.f90 index 6e52c429..671a828a 100644 --- a/Source/LK1/L1A-BD/BD_LOAD0.f90 +++ b/Source/LK1/L1A-BD/BD_LOAD0.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_LOAD0 ( CARD, LARGE_FLD_INP, ILOAD ) ! over all LOAD cards can be determined. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_LOAD0_BEGEND USE BD_LOAD0_USE_IFs @@ -51,14 +50,9 @@ SUBROUTINE BD_LOAD0 ( CARD, LARGE_FLD_INP, ILOAD ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_LOAD0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! LOAD Bulk Data Card: @@ -131,12 +125,7 @@ SUBROUTINE BD_LOAD0 ( CARD, LARGE_FLD_INP, ILOAD ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_MAT1.f90 b/Source/LK1/L1A-BD/BD_MAT1.f90 index f0ed30b0..aa459033 100644 --- a/Source/LK1/L1A-BD/BD_MAT1.f90 +++ b/Source/LK1/L1A-BD/BD_MAT1.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_MAT1 ( CARD, LARGE_FLD_INP ) ! Processes MAT1 Bulk Data Cards. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMATL, MRMATLC, NMATL, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MATL_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, TWO USE PARAMS, ONLY : EPSIL, SUPINFO, SUPWARN USE MODEL_STUF, ONLY : MATL, RMATL @@ -55,16 +54,11 @@ SUBROUTINE BD_MAT1 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATL_ID = 0 ! The ID for this MAT1 (field 2) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MATL_BEGEND + REAL(DOUBLE) :: R8INP ! A real input value read -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! MAT1 Bulk Data Card routine @@ -161,12 +155,7 @@ SUBROUTINE BD_MAT1 ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_MAT2.f90 b/Source/LK1/L1A-BD/BD_MAT2.f90 index 112be163..98121eba 100644 --- a/Source/LK1/L1A-BD/BD_MAT2.f90 +++ b/Source/LK1/L1A-BD/BD_MAT2.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_MAT2 ( CARD, LARGE_FLD_INP ) ! Processes MAT2 Bulk Data Cards. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMATL, MRMATLC, NMATL, WARN_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : BD_MATL_BEGEND USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : MATL, RMATL @@ -51,16 +50,11 @@ SUBROUTINE BD_MAT2 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATL_ID = 0 ! The ID for this MAT2 (field 2) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MATL_BEGEND + REAL(DOUBLE) :: R8INP ! A real input value read -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! MAT2 Bulk Data Card routine @@ -149,12 +143,7 @@ SUBROUTINE BD_MAT2 ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_MAT8.f90 b/Source/LK1/L1A-BD/BD_MAT8.f90 index 286ef128..e34aaee1 100644 --- a/Source/LK1/L1A-BD/BD_MAT8.f90 +++ b/Source/LK1/L1A-BD/BD_MAT8.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_MAT8 ( CARD, LARGE_FLD_INP ) ! Processes MAT8 Bulk Data Cards. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMATL, MRMATLC, NMATL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MATL_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : MATL, RMATL @@ -52,18 +51,13 @@ SUBROUTINE BD_MAT8 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATL_ID = 0 ! The ID for this MAT8 (field 2) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MATL_BEGEND + REAL(DOUBLE) :: E1 ! Modulus in longitudinal direction REAL(DOUBLE) :: E2 ! Modulus in lateral direction REAL(DOUBLE) :: NU12 ! Poissons ratio -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! MAT8 Bulk Data Card routine @@ -196,12 +190,7 @@ SUBROUTINE BD_MAT8 ( CARD, LARGE_FLD_INP ) CALL MAT8_VALUE_CHECK -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_MAT9.f90 b/Source/LK1/L1A-BD/BD_MAT9.f90 index 4561236d..0b79a59c 100644 --- a/Source/LK1/L1A-BD/BD_MAT9.f90 +++ b/Source/LK1/L1A-BD/BD_MAT9.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_MAT9 ( CARD, LARGE_FLD_INP ) ! Processes MAT9 Bulk Data Cards. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMATL, MRMATLC, NMATL, WARN_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : BD_MATL_BEGEND USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : MATL, RMATL @@ -53,16 +52,11 @@ SUBROUTINE BD_MAT9 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATL_ID = 0 ! The ID for this MAT9 (field 2) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MATL_BEGEND + REAL(DOUBLE) :: R8INP ! A real input value read -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! MAT9 Bulk Data Card routine @@ -224,12 +218,7 @@ SUBROUTINE BD_MAT9 ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_MPC.f90 b/Source/LK1/L1A-BD/BD_MPC.f90 index 71d56649..9a8ee915 100644 --- a/Source/LK1/L1A-BD/BD_MPC.f90 +++ b/Source/LK1/L1A-BD/BD_MPC.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_MPC ( CARD, LARGE_FLD_INP, CC_MPC_FND ) ! Processes MPC Bulk Data Cards. Writes MPC card data to file L1S USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1S + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1S USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMPC, LSUB, MMPC, NMPC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MPC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : MPCSET, MPC_SIDS @@ -57,16 +56,11 @@ SUBROUTINE BD_MPC ( CARD, LARGE_FLD_INP, CC_MPC_FND ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: SETID ! Set ID for this LOAD Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MPC_BEGEND + REAL(DOUBLE) :: MPC_COEFF(MMPC) ! Array of MPC coeff values found on this MPC logical card -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! MPC Bulk Data Card: @@ -287,12 +281,7 @@ SUBROUTINE BD_MPC ( CARD, LARGE_FLD_INP, CC_MPC_FND ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_MPC0.f90 b/Source/LK1/L1A-BD/BD_MPC0.f90 index 2214537d..52da0e32 100644 --- a/Source/LK1/L1A-BD/BD_MPC0.f90 +++ b/Source/LK1/L1A-BD/BD_MPC0.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_MPC0 ( CARD, LARGE_FLD_INP, IMPC ) ! over all MPC cards can be determined. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MPC0_BEGEND USE BD_MPC0_USE_IFs @@ -51,14 +50,9 @@ SUBROUTINE BD_MPC0 ( CARD, LARGE_FLD_INP, IMPC ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MPC0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! MPC Bulk Data Card: @@ -121,12 +115,7 @@ SUBROUTINE BD_MPC0 ( CARD, LARGE_FLD_INP, IMPC ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_MPCADD.f90 b/Source/LK1/L1A-BD/BD_MPCADD.f90 index 8d06baf4..6a077df0 100644 --- a/Source/LK1/L1A-BD/BD_MPCADD.f90 +++ b/Source/LK1/L1A-BD/BD_MPCADD.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_MPCADD ( CARD, LARGE_FLD_INP, CC_MPC_FND ) ! Processes MPCADD Bulk Data Cards. Reads and checks data and enters data into array MPCADD_SIDS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LMPCADDR, LSUB, NMPCADD, LMPCADDC, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MPCADD_BEGEND USE MODEL_STUF, ONLY : MPCADD_SIDS, MPCSET, SUBLOD USE BD_MPCADD_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE BD_MPCADD ( CARD, LARGE_FLD_INP, CC_MPC_FND ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: SETID ! Set ID for this MPCADD Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MPCADD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! MPCADD Bulk Data Card routine @@ -197,12 +191,7 @@ SUBROUTINE BD_MPCADD ( CARD, LARGE_FLD_INP, CC_MPC_FND ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_MPCADD0.f90 b/Source/LK1/L1A-BD/BD_MPCADD0.f90 index 7ec937c5..ef811a5c 100644 --- a/Source/LK1/L1A-BD/BD_MPCADD0.f90 +++ b/Source/LK1/L1A-BD/BD_MPCADD0.f90 @@ -30,10 +30,9 @@ SUBROUTINE BD_MPCADD0 ( CARD, LARGE_FLD_INP, IMPCADD ) ! determines the max number of set ID's over all MPCADD cards in the data deck USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_MPCADD0_BEGEND USE BD_MPCADD0_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE BD_MPCADD0 ( CARD, LARGE_FLD_INP, IMPCADD ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_MPCADD0_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! MPCADD Bulk Data Card routine @@ -126,12 +120,7 @@ SUBROUTINE BD_MPCADD0 ( CARD, LARGE_FLD_INP, IMPCADD ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_NLPARM.f90 b/Source/LK1/L1A-BD/BD_NLPARM.f90 index 4b28abbf..28b3c153 100644 --- a/Source/LK1/L1A-BD/BD_NLPARM.f90 +++ b/Source/LK1/L1A-BD/BD_NLPARM.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_NLPARM ( CARD, CC_NLSID_FND ) ! Processes NLPARM Bulk Data Cards. USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB USE TIMDAT, ONLY : TSEC USE NONLINEAR_PARAMS, ONLY : NL_MAXITER, NL_NUM_LOAD_STEPS, NL_SID - USE SUBR_BEGEND_LEVELS, ONLY : BD_NLPARM_BEGEND USE BD_NLPARM_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE BD_NLPARM ( CARD, CC_NLSID_FND ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: I4INP ! An integer value read from GRAV entry INTEGER(LONG) :: SETID ! NLPARM set id - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_NLPARM_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! NLPARM Bulk Data Card routine @@ -118,12 +112,7 @@ SUBROUTINE BD_NLPARM ( CARD, CC_NLSID_FND ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,4,5,6,0,8,9 ) ! Issue warning if fields 4,5,6,8,9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PARAM.F90 b/Source/LK1/L1A-BD/BD_PARAM.F90 index a7fe7844..b76c1bb4 100644 --- a/Source/LK1/L1A-BD/BD_PARAM.F90 +++ b/Source/LK1/L1A-BD/BD_PARAM.F90 @@ -29,12 +29,11 @@ SUBROUTINE BD_PARAM ( CARD ) ! Processes PARAM Bulk Data Cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, MEPSIL, MPBARLU, NUM_USETSTR, & WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PARAM_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE MACHINE_PARAMS, ONLY : MACH_PREC USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -70,7 +69,7 @@ SUBROUTINE BD_PARAM ( CARD ) THRESHK , THRESHK_LAP , TINY , & TSTM_DEF , USR_JCT , USR_LTERM_KGG , USR_LTERM_MGG , WINAMEM , & WTMASS , K6ROT, & - PRTALL , PRTANS , PRTF06 , PRTNEU , PRTOP2 , & + PRTALL , PRTF06 , PRTNEU , PRTOP2 , & SPIENV6 , SPIENV7 , SPIENV8 , SLU_NTHR USE BD_PARAM_USE_IFs @@ -91,19 +90,14 @@ SUBROUTINE BD_PARAM ( CARD ) INTEGER(LONG) :: IERR = 0 ! Local error indicator INTEGER(LONG) :: II ! An index in array EPSIL INTEGER(LONG) :: UPPER ! Upper allowable value for an integer parameter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PARAM_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: R8PARM ! A value read from input file that should be a real value INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PARAM Bulk Data Card routine @@ -819,17 +813,11 @@ SUBROUTINE BD_PARAM ( CARD ) PARNAM = 'PRTALL ' CALL YES_NO_CHECK(CARD, JCARD, CHRPARM, PARNAM, PRTALL) IF (PRTALL == 'Y') THEN - PRTANS = 'Y' PRTF06 = 'Y' PRTNEU = 'Y' PRTOP2 = 'Y' ENDIF - ! PRTANS writes all outputs for the ans file regardless of other flags besides PRTALL - ELSE IF ((PARAM_NAME(1:8) == 'PRTANS ') .OR. (PARAM_NAME(1:8) == 'ANS ')) THEN - PARNAM = 'PRTANS ' - CALL YES_NO_CHECK(CARD, JCARD, CHRPARM, PARNAM, PRTANS) - ! PRTOP2 writes all outputs for the f06 file regardless of other flags besides PRTALL ELSE IF ((PARAM_NAME(1:8) == 'PRTF06 ') .OR. (PARAM_NAME(1:8) == 'F06 ')) THEN PARNAM = 'PRTF06 ' @@ -2987,12 +2975,7 @@ SUBROUTINE BD_PARAM ( CARD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PARAM0.f90 b/Source/LK1/L1A-BD/BD_PARAM0.f90 index aa97f8f2..bbc352c7 100644 --- a/Source/LK1/L1A-BD/BD_PARAM0.f90 +++ b/Source/LK1/L1A-BD/BD_PARAM0.f90 @@ -30,10 +30,9 @@ SUBROUTINE BD_PARAM0 ( CARD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, EPSIL1_SET, IERRFL, JCARD_LEN, JF, MEPSIL, MPBARLU - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL, GRIDSEQ, PBARLDEC, PBARLSHR - USE SUBR_BEGEND_LEVELS, ONLY : BD_PARAM0_BEGEND USE BD_PARAM0_USE_IFs @@ -46,17 +45,12 @@ SUBROUTINE BD_PARAM0 ( CARD ) CHARACTER(LEN=JCARD_LEN) :: JCARD(10) ! The 10 fields of characters making up CARD CHARACTER(LEN(JCARD)) :: CHARINP ! A character field from CARD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PARAM0_BEGEND + INTEGER(LONG) :: I4INP ! An integer value read REAL(DOUBLE) :: R8INP ! A real value read -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make JCARD from CARD @@ -103,12 +97,7 @@ SUBROUTINE BD_PARAM0 ( CARD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PARVEC.f90 b/Source/LK1/L1A-BD/BD_PARVEC.f90 index 42a1acb3..447f224a 100644 --- a/Source/LK1/L1A-BD/BD_PARVEC.f90 +++ b/Source/LK1/L1A-BD/BD_PARVEC.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_PARVEC ( CARD ) ! PARTVEC_NAME, COMPJ, GRIDJ, DOFSET USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1V + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1V USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_PARTVEC_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES - USE SUBR_BEGEND_LEVELS, ONLY : BD_PARVEC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SUPWARN USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -60,14 +59,9 @@ SUBROUTINE BD_PARVEC ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IDUM ! Dummy arg in subr IP6CHK not used herein INTEGER(LONG) :: JERR = 0 ! A local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PARVEC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PARTVEC Bulk Data Card routine @@ -150,12 +144,7 @@ SUBROUTINE BD_PARVEC ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 ) CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PARVEC1.f90 b/Source/LK1/L1A-BD/BD_PARVEC1.f90 index 56c36db5..1acfe7b2 100644 --- a/Source/LK1/L1A-BD/BD_PARVEC1.f90 +++ b/Source/LK1/L1A-BD/BD_PARVEC1.f90 @@ -32,11 +32,10 @@ SUBROUTINE BD_PARVEC1 ( CARD, LARGE_FLD_INP ) ! PARTVEC1_NAME, COMPJ, GRIDJ, DOFSET USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1V + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1V USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_PARTVEC_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES - USE SUBR_BEGEND_LEVELS, ONLY : BD_PARVEC1_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -67,14 +66,9 @@ SUBROUTINE BD_PARVEC1 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: JERR = 0 ! A local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PARVEC1_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! PARTVEC1 Bulk Data Card routine @@ -258,12 +252,7 @@ SUBROUTINE BD_PARVEC1 ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PBAR.f90 b/Source/LK1/L1A-BD/BD_PBAR.f90 index 5f714df2..de69eed8 100644 --- a/Source/LK1/L1A-BD/BD_PBAR.f90 +++ b/Source/LK1/L1A-BD/BD_PBAR.f90 @@ -33,12 +33,11 @@ SUBROUTINE BD_PBAR ( CARD, LARGE_FLD_INP ) ! 4) From 2nd continuation card (if present): area factors for transverse shear and I12 and enter into array RPBAR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : EPSIL, SUPINFO USE SCONTR, ONLY : BLNK_SUB_NAM, BARTOR, IERRFL, FATAL_ERR, JCARD_LEN, JF, LPBAR, NPBAR USE CONSTANTS_1, ONLY : ZERO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PBAR_BEGEND USE MODEL_STUF, ONLY : PBAR, RPBAR USE BD_PBAR_USE_IFs @@ -57,19 +56,14 @@ SUBROUTINE BD_PBAR ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATERIAL_ID = 0 ! Material ID (field 3 of this property card) INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PBAR_BEGEND + REAL(DOUBLE) :: I1 = ZERO! Moment of inertia REAL(DOUBLE) :: I2 = ZERO! Moment of inertia REAL(DOUBLE) :: I12 = ZERO! Product of inertia REAL(DOUBLE) :: EPS1 ! A small number -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PBAR Bulk Data Card routine @@ -204,12 +198,7 @@ SUBROUTINE BD_PBAR ( CARD, LARGE_FLD_INP ) FATAL_ERR = FATAL_ERR + 1 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PBARL.f90 b/Source/LK1/L1A-BD/BD_PBARL.f90 index 3b2b8faa..4da814e7 100644 --- a/Source/LK1/L1A-BD/BD_PBARL.f90 +++ b/Source/LK1/L1A-BD/BD_PBARL.f90 @@ -34,7 +34,7 @@ SUBROUTINE BD_PBARL ( CARD, LARGE_FLD_INP, PBARL_TYPE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE DERIVED_DATA_TYPES, ONLY : CHAR1_INT1 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, IERRFL, FATAL_ERR, JCARD_LEN, JF, LPBAR, NPBAR, NPBARL USE PARAMS, ONLY : EPSIL, PBARLSHR, SUPINFO USE CONSTANTS_1, ONLY : PI, ZERO, QUARTER, THIRD, HALF, ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, & @@ -42,7 +42,6 @@ SUBROUTINE BD_PBARL ( CARD, LARGE_FLD_INP, PBARL_TYPE ) USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : PBAR, RPBAR - USE SUBR_BEGEND_LEVELS, ONLY : BD_PBARL_BEGEND USE BD_PBARL_USE_IFs @@ -70,7 +69,7 @@ SUBROUTINE BD_PBARL ( CARD, LARGE_FLD_INP, PBARL_TYPE ) INTEGER(LONG) :: NUM_D ! Number of D(i) values to read from the continuation entries INTEGER(LONG) :: MATL_ID = 0 ! Material ID (field 3 of this property card) INTEGER(LONG) :: PROP_ID = 0 ! Property ID (field 2 of this property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PBARL_BEGEND + REAL(DOUBLE) :: AREA = ZERO ! Cross-sectional area REAL(DOUBLE) :: D(NS) ! Dimensions of cross-secion of the bar @@ -83,12 +82,7 @@ SUBROUTINE BD_PBARL ( CARD, LARGE_FLD_INP, PBARL_TYPE ) REAL(DOUBLE) :: Z(4) = ZERO ! Z coords in cross-section for 4 points of data recovery REAL(DOUBLE) :: R8INP ! A real value read from a field on this PBARL entry -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PBAR Bulk Data Card routine @@ -360,12 +354,7 @@ SUBROUTINE BD_PBARL ( CARD, LARGE_FLD_INP, PBARL_TYPE ) ! CALL WRITE_PBAR_EQUIV ! ENDIF ! -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PBEAM.f90 b/Source/LK1/L1A-BD/BD_PBEAM.f90 index ea5086f0..508088d9 100644 --- a/Source/LK1/L1A-BD/BD_PBEAM.f90 +++ b/Source/LK1/L1A-BD/BD_PBEAM.f90 @@ -29,12 +29,11 @@ SUBROUTINE BD_PBEAM ( CARD, LARGE_FLD_INP ) ! Processes PBEAM Bulk Data Cards. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : EPSIL USE SCONTR, ONLY : BLNK_SUB_NAM, BEAMTOR, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPBEAM, NPBEAM USE CONSTANTS_1, ONLY : ZERO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PBEAM_BEGEND USE MODEL_STUF, ONLY : PBEAM, RPBEAM USE PARAMS, ONLY : SUPINFO @@ -56,7 +55,7 @@ SUBROUTINE BD_PBEAM ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATERIAL_ID = 0 ! Material ID (field 3 of this property card) INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PBEAM_BEGEND + REAL(DOUBLE) :: AREA_A = ZERO ! Cross sectional area at end A REAL(DOUBLE) :: I1_A = ZERO ! Moment of inertia, plane 1 at end A @@ -72,12 +71,7 @@ SUBROUTINE BD_PBEAM ( CARD, LARGE_FLD_INP ) REAL(DOUBLE) :: JTOR = ZERO ! Torsional constantr at any location along beam REAL(DOUBLE) :: NSM = ZERO ! Nonstructural mass at any location along beam -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PBEAM Bulk Data Card routine @@ -384,12 +378,7 @@ SUBROUTINE BD_PBEAM ( CARD, LARGE_FLD_INP ) CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PBUSH.f90 b/Source/LK1/L1A-BD/BD_PBUSH.f90 index f0adabd5..5119da8a 100644 --- a/Source/LK1/L1A-BD/BD_PBUSH.f90 +++ b/Source/LK1/L1A-BD/BD_PBUSH.f90 @@ -34,12 +34,11 @@ SUBROUTINE BD_PBUSH ( CARD, LARGE_FLD_INP ) ! 4) From 2nd continuation card (if present): area factors for transverse shear and I12 and enter into array RPBUSH USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : EPSIL USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPBUSH, NPBUSH, WARN_ERR USE CONSTANTS_1, ONLY : ZERO, ONE USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PBUSH_BEGEND USE MODEL_STUF, ONLY : PBUSH, RPBUSH USE BD_PBUSH_USE_IFs @@ -60,16 +59,11 @@ SUBROUTINE BD_PBUSH ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: NUM_ENTRIES ! Num of quantities to read depending on field 3 of parent or cont entry INTEGER(LONG) :: OFFSET ! Array index offset INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PBUSH_BEGEND + REAL(DOUBLE) :: R8INP ! A real value read from a field on this BD entry -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PBUSH Bulk Data Card routine @@ -219,12 +213,7 @@ SUBROUTINE BD_PBUSH ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PCOMP.f90 b/Source/LK1/L1A-BD/BD_PCOMP.f90 index 44195673..82d58dc7 100644 --- a/Source/LK1/L1A-BD/BD_PCOMP.f90 +++ b/Source/LK1/L1A-BD/BD_PCOMP.f90 @@ -29,7 +29,7 @@ SUBROUTINE BD_PCOMP ( CARD, LARGE_FLD_INP ) ! Processes PCOMP Bulk Data Cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPCOMP, MPCOMP0, MRPCOMP0, MPCOMP_PLIES, & MRPCOMP_PLIES, NPCOMP USE TIMDAT, ONLY : TSEC @@ -37,7 +37,6 @@ SUBROUTINE BD_PCOMP ( CARD, LARGE_FLD_INP ) USE CONSTANTS_1, ONLY : ZERO, HALF, TWO USE MODEL_STUF, ONLY : PCOMP, RPCOMP USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : BD_PCOMP_BEGEND USE BD_PCOMP_USE_IFs @@ -64,7 +63,7 @@ SUBROUTINE BD_PCOMP ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: PCOMP_PLIES0 ! Count of number of plies on PCOMP entry INTEGER(LONG) :: PCOMP_PLIES ! No. of plies in 1 PCOMP entry incl sym plies not explicitly defined INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this parent property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PCOMP_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number REAL(DOUBLE) :: GE ! Damping coeff @@ -76,12 +75,7 @@ SUBROUTINE BD_PCOMP ( CARD, LARGE_FLD_INP ) REAL(DOUBLE) :: Z0 = ZERO ! Dist (+/-) from ref plane to bottom surface REAL(DOUBLE) :: ZI = ZERO ! Dist (+/-) from ref plane to middle of ply i -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PCOMP Bulk Data Card: @@ -495,12 +489,7 @@ SUBROUTINE BD_PCOMP ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PCOMP0.f90 b/Source/LK1/L1A-BD/BD_PCOMP0.f90 index d749abd3..015ffff1 100644 --- a/Source/LK1/L1A-BD/BD_PCOMP0.f90 +++ b/Source/LK1/L1A-BD/BD_PCOMP0.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_PCOMP0 ( CARD, LARGE_FLD_INP, IPLIES ) ! Processes PCOMP Bulk Data Cards to determine the number of plies there are defined for this PCOMP entry USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PCOMP0_BEGEND USE BD_PCOMP0_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE BD_PCOMP0 ( CARD, LARGE_FLD_INP, IPLIES ) INTEGER(LONG), INTENT(OUT) :: IPLIES ! Count of number of plies defined by this PCOMP INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PCOMP0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PCOMP Bulk Data Card: @@ -126,12 +120,7 @@ SUBROUTINE BD_PCOMP0 ( CARD, LARGE_FLD_INP, IPLIES ) IPLIES = 2*IPLIES ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PCOMP1.f90 b/Source/LK1/L1A-BD/BD_PCOMP1.f90 index 266a6117..dfc2cb0a 100644 --- a/Source/LK1/L1A-BD/BD_PCOMP1.f90 +++ b/Source/LK1/L1A-BD/BD_PCOMP1.f90 @@ -30,7 +30,7 @@ SUBROUTINE BD_PCOMP1 ( CARD, LARGE_FLD_INP ) ! PCOMP1 will be put into the same PCOMP, RPCOMP arrays. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPCOMP_PLIES, LPCOMP, MPCOMP0, MRPCOMP0, & MPCOMP_PLIES, MRPCOMP_PLIES, NPCOMP USE TIMDAT, ONLY : TSEC @@ -38,7 +38,6 @@ SUBROUTINE BD_PCOMP1 ( CARD, LARGE_FLD_INP ) USE CONSTANTS_1, ONLY : ZERO, HALF, TWO USE MODEL_STUF, ONLY : PCOMP, RPCOMP USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : BD_PCOMP1_BEGEND USE BD_PCOMP1_USE_IFs @@ -65,7 +64,7 @@ SUBROUTINE BD_PCOMP1 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: PCOMP_PLIES ! No. of plies in 1 PCOMP1 entry incl sym plies not explicitly defined INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this parent property card) INTEGER(LONG) :: SOUT_INT = 0 ! Entry in array PCOMP (not defined on PCOMP1) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PCOMP1_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number REAL(DOUBLE) :: NSM ! Non structural mass @@ -77,12 +76,7 @@ SUBROUTINE BD_PCOMP1 ( CARD, LARGE_FLD_INP ) REAL(DOUBLE) :: Z0 = ZERO ! Dist (+/-) from ref plane to bottom surface REAL(DOUBLE) :: ZI = ZERO ! Dist (+/-) from ref plane to middle of ply i -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PCOMP1 Bulk Data Card: @@ -358,12 +352,7 @@ SUBROUTINE BD_PCOMP1 ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PCOMP10.f90 b/Source/LK1/L1A-BD/BD_PCOMP10.f90 index 7dccf05d..63e8123c 100644 --- a/Source/LK1/L1A-BD/BD_PCOMP10.f90 +++ b/Source/LK1/L1A-BD/BD_PCOMP10.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_PCOMP10 ( CARD, LARGE_FLD_INP, IPLIES ) ! Processes PCOMP1 Bulk Data Cards to determine the number of plies for a B.D. PCOMP1 entry USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PCOMP10_BEGEND USE BD_PCOMP10_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE BD_PCOMP10 ( CARD, LARGE_FLD_INP, IPLIES ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PCOMP10_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make JCARD from CARD @@ -98,12 +92,7 @@ SUBROUTINE BD_PCOMP10 ( CARD, LARGE_FLD_INP, IPLIES ) IPLIES = 2*IPLIES ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PELAS.f90 b/Source/LK1/L1A-BD/BD_PELAS.f90 index 418b6397..81cbb490 100644 --- a/Source/LK1/L1A-BD/BD_PELAS.f90 +++ b/Source/LK1/L1A-BD/BD_PELAS.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PELAS ( CARD ) ! 2) Stiffness, damping, stress recovery coeff. and enter into array RPELAS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPELAS, NPELAS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PELAS_BEGEND USE MODEL_STUF, ONLY : PELAS, RPELAS USE BD_PELAS_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE BD_PELAS ( CARD ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: PROP_ID = 0 ! Property ID (field 2 of this property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PELAS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PELAS Bulk Data Card routine @@ -99,12 +93,7 @@ SUBROUTINE BD_PELAS ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,6,7,8,9 ) ! Issue warning if fields 6, 7, 8, 9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PLOAD2.f90 b/Source/LK1/L1A-BD/BD_PLOAD2.f90 index b4d7b9c7..fe23f03a 100644 --- a/Source/LK1/L1A-BD/BD_PLOAD2.f90 +++ b/Source/LK1/L1A-BD/BD_PLOAD2.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_PLOAD2 ( CARD, CC_LOAD_FND ) ! Processes PLOAD2 Bulk Data Cards. Reads and checks data and then writes CARD to file LINK1Q for later processing USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1Q + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1Q USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPLOAD, LSUB, NPCARD, NPLOAD, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PLOAD2_BEGEND USE MODEL_STUF, ONLY : PRESS_SIDS, SUBLOD USE BD_PLOAD2_USE_IFs @@ -51,16 +50,11 @@ SUBROUTINE BD_PLOAD2 ( CARD, CC_LOAD_FND ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: JERR ! Error count INTEGER(LONG) :: SETID ! Load set ID on PLOADi card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PLOAD2_BEGEND + REAL(DOUBLE) :: RPRESS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PLOAD2 Bulk Data card check @@ -167,12 +161,7 @@ SUBROUTINE BD_PLOAD2 ( CARD, CC_LOAD_FND ) NPCARD = NPCARD + 1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PLOAD4.f90 b/Source/LK1/L1A-BD/BD_PLOAD4.f90 index 4f7a486d..192d9b34 100644 --- a/Source/LK1/L1A-BD/BD_PLOAD4.f90 +++ b/Source/LK1/L1A-BD/BD_PLOAD4.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_PLOAD4 ( CARD, CC_LOAD_FND ) ! Processes PLOAD4 Bulk Data Cards. Reads and checks data and then writes CARD to file LINK1Q for later processing USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1Q + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1Q USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPLOAD, LSUB, NPCARD, NPLOAD, & NPLOAD4_3D, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PLOAD4_BEGEND USE MODEL_STUF, ONLY : PRESS_SIDS, SUBLOD USE BD_PLOAD4_USE_IFs @@ -50,16 +49,11 @@ SUBROUTINE BD_PLOAD4 ( CARD, CC_LOAD_FND ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: JERR ! Error count INTEGER(LONG) :: SETID ! Load set ID on PLOADi card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PLOAD4_BEGEND + REAL(DOUBLE) :: R8INP ! A value read from input file that should be a real value -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PLOAD4 Bulk Data card check. @@ -197,12 +191,7 @@ SUBROUTINE BD_PLOAD4 ( CARD, CC_LOAD_FND ) NPCARD = NPCARD + 1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PLOTEL.f90 b/Source/LK1/L1A-BD/BD_PLOTEL.f90 index 9b8f6260..7fee5306 100644 --- a/Source/LK1/L1A-BD/BD_PLOTEL.f90 +++ b/Source/LK1/L1A-BD/BD_PLOTEL.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_PLOTEL ( CARD ) ! Processes PLOTEL Bulk Data Cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04, F06 + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF, MEDAT_PLOTEL, NELE, NPLOTEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PLOTEL_BEGEND USE MODEL_STUF, ONLY : EDAT, ETYPE USE BD_PLOTEL_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE BD_PLOTEL ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: I4INP ! An integer read INTEGER(LONG) :: IERR ! Error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PLOTEL_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! PLOTEL element Bulk Data Card routine @@ -110,12 +104,7 @@ SUBROUTINE BD_PLOTEL ( CARD ) CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PMASS.f90 b/Source/LK1/L1A-BD/BD_PMASS.f90 index b181c35b..0cdefa04 100644 --- a/Source/LK1/L1A-BD/BD_PMASS.f90 +++ b/Source/LK1/L1A-BD/BD_PMASS.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PMASS ( CARD ) ! 2) Mass value and enter into array RPMASS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NPMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PMASS_BEGEND USE MODEL_STUF, ONLY : PMASS, RPMASS USE BD_PMASS_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE BD_PMASS ( CARD ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: PMASS_PID ! Prop number from field 2,4,6,8 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PMASS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PMASS Bulk Data Card routine @@ -118,12 +112,7 @@ SUBROUTINE BD_PMASS ( CARD ) CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PROD.f90 b/Source/LK1/L1A-BD/BD_PROD.f90 index 8a58c9bd..af64c9fb 100644 --- a/Source/LK1/L1A-BD/BD_PROD.f90 +++ b/Source/LK1/L1A-BD/BD_PROD.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_PROD ( CARD ) ! 2) Area, torsional constant, stress recovery coeff for torsion and nonstructural mass and enter into array RPROD USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPROD, NPROD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PROD_BEGEND USE MODEL_STUF, ONLY : PROD, RPROD USE BD_PROD_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE BD_PROD ( CARD ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATERIAL_ID = 0 ! Material ID (field 3 of this property card) INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PROD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PROD Bulk Data Card routine @@ -113,12 +107,7 @@ SUBROUTINE BD_PROD ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 ) ! Issue warning if fields 8-9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PSHEAR.f90 b/Source/LK1/L1A-BD/BD_PSHEAR.f90 index fc20d276..af0e33ee 100644 --- a/Source/LK1/L1A-BD/BD_PSHEAR.f90 +++ b/Source/LK1/L1A-BD/BD_PSHEAR.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_PSHEAR ( CARD ) ! Processes PSHEAR Bulk Data Cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MPSHEAR, MRPSHEAR, NPSHEAR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PSHEAR_BEGEND USE MODEL_STUF, ONLY : PSHEAR, RPSHEAR USE BD_PSHEAR_USE_IFs @@ -46,16 +45,11 @@ SUBROUTINE BD_PSHEAR ( CARD ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATERIAL_ID = 0 ! Material ID INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this parent property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PSHEAR_BEGEND + REAL(DOUBLE) :: R8INP ! Real value read from a field on the PSHEAR entry -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PSHEAR element Bulk Data Card routine @@ -119,12 +113,7 @@ SUBROUTINE BD_PSHEAR ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,6,7,8,9 ) CALL CRDERR ( CARD ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PSHEL.f90 b/Source/LK1/L1A-BD/BD_PSHEL.f90 index 94da5f0b..bead261d 100644 --- a/Source/LK1/L1A-BD/BD_PSHEL.f90 +++ b/Source/LK1/L1A-BD/BD_PSHEL.f90 @@ -34,10 +34,9 @@ SUBROUTINE BD_PSHEL ( CARD, LARGE_FLD_INP ) ! 4) From 1st cont card (if present): locations for stress recovery and offset and enter into array RPSHEL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR, JCARD_LEN, JF, LPSHEL, NPSHEL, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PSHEL_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : PSHEL, RPSHEL @@ -58,16 +57,11 @@ SUBROUTINE BD_PSHEL ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: MATERIAL_ID = 0 ! Material ID INTEGER(LONG) :: N = 1 ! Counter INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this parent property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PSHEL_BEGEND + INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PSHELL Bulk Data Card routine @@ -203,12 +197,7 @@ SUBROUTINE BD_PSHEL ( CARD, LARGE_FLD_INP ) CALL CRDERR ( CARD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PSOLID.f90 b/Source/LK1/L1A-BD/BD_PSOLID.f90 index d3ec35c9..3a321e1b 100644 --- a/Source/LK1/L1A-BD/BD_PSOLID.f90 +++ b/Source/LK1/L1A-BD/BD_PSOLID.f90 @@ -31,11 +31,10 @@ SUBROUTINE BD_PSOLID ( CARD, IOR3D ) ! 1) Property ID and material ID and enter them into array PSOLID USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPSOLID, NPSOLID, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : BD_PSOLID_BEGEND USE MODEL_STUF, ONLY : PSOLID USE BD_PSOLID_USE_IFs @@ -50,14 +49,9 @@ SUBROUTINE BD_PSOLID ( CARD, IOR3D ) INTEGER(LONG), INTENT(OUT) :: IOR3D ! Integration order for this PSOLID entry INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: ID = 0 ! An integer ID read from a field of this card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PSOLID_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! PSOLID Bulk Data Card routine @@ -170,12 +164,7 @@ SUBROUTINE BD_PSOLID ( CARD, IOR3D ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,6,0,8,9 ) ! Issue warning if fields 6, 8 and 9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PUSER1.f90 b/Source/LK1/L1A-BD/BD_PUSER1.f90 index 9b18d892..af70275b 100644 --- a/Source/LK1/L1A-BD/BD_PUSER1.f90 +++ b/Source/LK1/L1A-BD/BD_PUSER1.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_PUSER1 ( CARD, LARGE_FLD_INP ) ! Processes PUSER1 Bulk Data Cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPUSER1, NPUSER1 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PUSER1_BEGEND USE MODEL_STUF, ONLY : PUSER1, RPUSER1 USE BD_PUSER1_USE_IFs @@ -50,14 +49,9 @@ SUBROUTINE BD_PUSER1 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: MATERIAL_ID = 0 ! Material ID (field 3 of this property card) INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PUSER1_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! PUSER1 Bulk Data Card routine @@ -146,12 +140,7 @@ SUBROUTINE BD_PUSER1 ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_PUSERIN.f90 b/Source/LK1/L1A-BD/BD_PUSERIN.f90 index 9abf7a7a..ee607aaf 100644 --- a/Source/LK1/L1A-BD/BD_PUSERIN.f90 +++ b/Source/LK1/L1A-BD/BD_PUSERIN.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_PUSERIN ( CARD ) ! Processes PUSERIN Bulk Data Cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NUM_IN4_FILES + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NUM_IN4_FILES USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LPUSERIN, NPUSERIN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_PUSERIN_BEGEND USE MODEL_STUF, ONLY : PUSERIN, USERIN_MAT_NAMES USE BD_PUSERIN_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE BD_PUSERIN ( CARD ) INTEGER(LONG) :: J ! DO loop indices !xx INTEGER(LONG) :: ISTART ! Start col in CARD for matrix names INTEGER(LONG) :: PROPERTY_ID = 0 ! Property ID (field 2 of this property card) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_PUSERIN_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! PUSERIN Bulk Data Card routine @@ -117,12 +111,7 @@ SUBROUTINE BD_PUSERIN ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 ) ! Issue warning if fields 8, 9 not blank CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_RBAR.f90 b/Source/LK1/L1A-BD/BD_RBAR.f90 index 78fb858b..1087f582 100644 --- a/Source/LK1/L1A-BD/BD_RBAR.f90 +++ b/Source/LK1/L1A-BD/BD_RBAR.f90 @@ -40,10 +40,9 @@ SUBROUTINE BD_RBAR ( CARD ) ! DDOF2: Dependent DOF's at GID2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRIGEL, NRBAR, NRIGEL, NRECARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBAR_BEGEND USE MODEL_STUF, ONLY : RIGID_ELEM_IDS USE BD_RBAR_USE_IFs @@ -67,14 +66,9 @@ SUBROUTINE BD_RBAR ( CARD ) INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein INTEGER(LONG) :: RBDOF(4) ! The DOF's in fields 5,6,7,8 INTEGER(LONG) :: RELID = 0 ! Rigid element ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBAR_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! RBAR Bulk Data Card routine @@ -209,12 +203,7 @@ SUBROUTINE BD_RBAR ( CARD ) NRECARD = NRECARD + 1 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_RBE1.f90 b/Source/LK1/L1A-BD/BD_RBE1.f90 index 9fb0895c..0407594c 100644 --- a/Source/LK1/L1A-BD/BD_RBE1.f90 +++ b/Source/LK1/L1A-BD/BD_RBE1.f90 @@ -36,10 +36,9 @@ SUBROUTINE BD_RBE1 ( CARD, LARGE_FLD_INP ) ! DGID, DDOF : One pair of dependent Grid/DOF USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRIGEL, NRBE1, NRIGEL, NRECARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBE1_BEGEND USE MODEL_STUF, ONLY : RIGID_ELEM_IDS USE BD_RBE1_USE_IFs @@ -77,14 +76,9 @@ SUBROUTINE BD_RBE1 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: JFLD2 ! A computed field number on the card INTEGER(LONG) :: NUM_IDOF_FLDS = 0 ! Number of fields that have independent DOF's specified INTEGER(LONG) :: RELID = 0 ! This rigid elements' ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBE1_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! RBE1 Bulk Data Card routine @@ -376,12 +370,7 @@ SUBROUTINE BD_RBE1 ( CARD, LARGE_FLD_INP ) CALL CRDERR ( CARD ) -! ********************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_RBE2.f90 b/Source/LK1/L1A-BD/BD_RBE2.f90 index d9c503d5..d392fc4c 100644 --- a/Source/LK1/L1A-BD/BD_RBE2.f90 +++ b/Source/LK1/L1A-BD/BD_RBE2.f90 @@ -37,10 +37,9 @@ SUBROUTINE BD_RBE2 ( CARD, LARGE_FLD_INP ) ! IGID: Independent Grid ID USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRIGEL, NRBE2, NRIGEL, NRECARD, NTERM_RMG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBE2_BEGEND USE MODEL_STUF, ONLY : RIGID_ELEM_IDS USE BD_RBE2_USE_IFs @@ -66,14 +65,9 @@ SUBROUTINE BD_RBE2 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: NUM_COMP = 0 ! Total number of components specified in DDOF INTEGER(LONG) :: RELID = 0 ! This elements' ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBE2_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! RBE2 Bulk Data Card routine @@ -188,12 +182,7 @@ SUBROUTINE BD_RBE2 ( CARD, LARGE_FLD_INP ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_RBE3.f90 b/Source/LK1/L1A-BD/BD_RBE3.f90 index 5f19b3cf..74271bda 100644 --- a/Source/LK1/L1A-BD/BD_RBE3.f90 +++ b/Source/LK1/L1A-BD/BD_RBE3.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_RBE3 ( CARD, LARGE_FLD_INP ) ! Processes RBE3 Bulk Data Cards. Writes RBE3 card data to file L1F USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRIGEL, MRBE3, NRECARD, NRIGEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBE3_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : RIGID_ELEM_IDS @@ -71,19 +70,14 @@ SUBROUTINE BD_RBE3 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: REFC = 0 ! REFC value in field 5 of parent entry INTEGER(LONG) :: REFGRID = 0 ! REFGRID value in field 4 of parent entry INTEGER(LONG) :: RELID = 0 ! This elements' ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBE3_BEGEND + REAL(DOUBLE) :: R8INP ! A real value read from a field on this RBE3 entry REAL(DOUBLE) :: WGT ! A weight read from a field on this RBE3 entry REAL(DOUBLE) :: WTi(MRBE3) ! Array of RBE3 weight values REAL(DOUBLE) :: WT_TOT ! Total of all WTi(i) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! RBE3 Bulk Data Card: @@ -357,12 +351,7 @@ SUBROUTINE BD_RBE3 ( CARD, LARGE_FLD_INP ) !xx NTERM_RMG = REFC_NUM_Ci*(NTERM_RMG + 1) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_RBE30.f90 b/Source/LK1/L1A-BD/BD_RBE30.f90 index 0b481304..f4f537de 100644 --- a/Source/LK1/L1A-BD/BD_RBE30.f90 +++ b/Source/LK1/L1A-BD/BD_RBE30.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_RBE30 ( CARD, LARGE_FLD_INP, IRBE3 ) ! a floating point number USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RBE30_BEGEND USE BD_RBE30_USE_IFs @@ -53,14 +52,9 @@ SUBROUTINE BD_RBE30 ( CARD, LARGE_FLD_INP, IRBE3 ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RBE30_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! RBE3 Bulk Data Card: @@ -111,12 +105,7 @@ SUBROUTINE BD_RBE30 ( CARD, LARGE_FLD_INP, IRBE3 ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_RFORCE.f90 b/Source/LK1/L1A-BD/BD_RFORCE.f90 index bd490443..42f24147 100644 --- a/Source/LK1/L1A-BD/BD_RFORCE.f90 +++ b/Source/LK1/L1A-BD/BD_RFORCE.f90 @@ -33,10 +33,9 @@ SUBROUTINE BD_RFORCE ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) ! SETID, CID, ACCEL(1-6) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1U + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1U USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LRFORCE, LSUB, NRFORCE, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RFORCE_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : RFORCE_SIDS, SUBLOD @@ -60,7 +59,7 @@ SUBROUTINE BD_RFORCE ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) INTEGER(LONG) :: GID = 0 ! Grid ID (or 0) of the grid that the rotational grav accels refer to INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: SETID = 0 ! Set ID on the RFORCE card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RFORCE_BEGEND + REAL(DOUBLE) :: R8INP ! A real value read from RFORCE entry REAL(DOUBLE) :: SCALEF_AA = ZERO ! Scale factor for angular accel on the RFORCE card @@ -69,12 +68,7 @@ SUBROUTINE BD_RFORCE ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! RFORCE Bulk Data Card routine @@ -179,12 +173,7 @@ SUBROUTINE BD_RFORCE ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) WRITE(L1U) SETID, CID, GID, SCALEF_AV, SCALEF_AA, (VEC(I),I=1,3) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_RSPLINE.f90 b/Source/LK1/L1A-BD/BD_RSPLINE.f90 index 7d475de2..ccc01370 100644 --- a/Source/LK1/L1A-BD/BD_RSPLINE.f90 +++ b/Source/LK1/L1A-BD/BD_RSPLINE.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_RSPLINE ( CARD, LARGE_FLD_INP ) ! spline will be fitted to all of the dep grid/comps USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, MRSPLINE, NRSPLINE, NRECARD, NRIGEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RSPLINE_BEGEND USE MODEL_STUF, ONLY : RIGID_ELEM_IDS USE BD_RSPLINE_USE_IFs @@ -75,17 +74,12 @@ SUBROUTINE BD_RSPLINE ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: NUM_ENTRIES ! Count of number of entries placed into array GC_FLDS INTEGER(LONG) :: NUM_Ci ! Number of displ components in a DCOMP field INTEGER(LONG) :: ELID = 0 ! This elements' ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RSPLINE_BEGEND + REAL(DOUBLE) :: DL_RAT ! Value in field 3 for D/L ratio REAL(DOUBLE) :: R8INP ! A real value read from a field on this RSPLINE entry -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! RSPLINE Bulk Data Card: @@ -268,12 +262,7 @@ SUBROUTINE BD_RSPLINE ( CARD, LARGE_FLD_INP ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_RSPLINE0.f90 b/Source/LK1/L1A-BD/BD_RSPLINE0.f90 index e8ebe27f..03505fc3 100644 --- a/Source/LK1/L1A-BD/BD_RSPLINE0.f90 +++ b/Source/LK1/L1A-BD/BD_RSPLINE0.f90 @@ -30,10 +30,9 @@ SUBROUTINE BD_RSPLINE0 ( CARD, LARGE_FLD_INP, IRSPLINE ) ! The first and last entries will be the 2 indep grids. Everything in between should be pairs of dep grid/comp entries USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_RSPLINE0_BEGEND USE BD_RSPLINE0_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE BD_RSPLINE0 ( CARD, LARGE_FLD_INP, IRSPLINE ) INTEGER(LONG), INTENT(OUT) :: IRSPLINE ! Count of number of grid/comp doublets on this RSPLINE logical card INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_RSPLINE0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! RSPLINE Bulk Data Card: @@ -91,12 +85,7 @@ SUBROUTINE BD_RSPLINE0 ( CARD, LARGE_FLD_INP, IRSPLINE ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SEQGP.f90 b/Source/LK1/L1A-BD/BD_SEQGP.f90 index e1a6ef37..60e20892 100644 --- a/Source/LK1/L1A-BD/BD_SEQGP.f90 +++ b/Source/LK1/L1A-BD/BD_SEQGP.f90 @@ -33,10 +33,9 @@ SUBROUTINE BD_SEQGP ( CARD ) ! to real before entering them into array SEQ2. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN, JF, LSEQ, NSEQ USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SEQGP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : SEQ1, SEQ2 @@ -53,18 +52,13 @@ SUBROUTINE BD_SEQGP ( CARD ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: JFLD1 ! A field number on the SEQGP card where grid ID's are located INTEGER(LONG) :: JFLD2 ! A field number on the SEQGP card where sequence numbers are located - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SEQGP_BEGEND + REAL(DOUBLE) :: RSEQ ! A real sequence number INTRINSIC INDEX,DBLE -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SEQGP Bulk Data Card routine @@ -113,12 +107,7 @@ SUBROUTINE BD_SEQGP ( CARD ) CALL BD_IMBEDDED_BLANK ( JCARD,2,3,4,5,6,7,8,9 ) ! Make sure that there are no imbedded blanks in fields 2-9 CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SLOAD.f90 b/Source/LK1/L1A-BD/BD_SLOAD.f90 index 94d1d5af..ed25b5ee 100644 --- a/Source/LK1/L1A-BD/BD_SLOAD.f90 +++ b/Source/LK1/L1A-BD/BD_SLOAD.f90 @@ -33,10 +33,9 @@ SUBROUTINE BD_SLOAD ( CARD, CC_LOAD_FND ) ! SETID, scalar point, load mag USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1W + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1W USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LFORCE, LSUB, NFORCE, NSLOAD, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SLOAD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SUPWARN USE MODEL_STUF, ONLY : SLOAD_SIDS, SUBLOD @@ -55,16 +54,11 @@ SUBROUTINE BD_SLOAD ( CARD, CC_LOAD_FND ) INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: NUM_PAIRS = 0 ! Bumber of pairs of SPOINT/FMAG on a SLOAD entry (can be up to 3) INTEGER(LONG) :: SETID = 0 ! Set ID on the FORCE/MOMENT card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SLOAD_BEGEND + REAL(DOUBLE) :: FMAG(3) ! Force magnitude -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SLOAD Bulk Data Card routine @@ -134,12 +128,7 @@ SUBROUTINE BD_SLOAD ( CARD, CC_LOAD_FND ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SLOAD0.f90 b/Source/LK1/L1A-BD/BD_SLOAD0.f90 index e4cbf64b..ab3ddde3 100644 --- a/Source/LK1/L1A-BD/BD_SLOAD0.f90 +++ b/Source/LK1/L1A-BD/BD_SLOAD0.f90 @@ -31,10 +31,8 @@ SUBROUTINE BD_SLOAD0 ( CARD, NUM_PAIRS ) ! SETID, scalar point, load mag USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SLOAD0_BEGEND USE BD_SLOAD0_USE_IFs @@ -46,14 +44,9 @@ SUBROUTINE BD_SLOAD0 ( CARD, NUM_PAIRS ) INTEGER(LONG), INTENT(OUT) :: NUM_PAIRS ! Number of pairs of SPOINT/force MAG on a SLOAD entry (can be up to 3) INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SLOAD0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SLOAD Bulk Data Card routine @@ -77,12 +70,7 @@ SUBROUTINE BD_SLOAD0 ( CARD, NUM_PAIRS ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SPC.f90 b/Source/LK1/L1A-BD/BD_SPC.f90 index 3a19c9c2..d8d6fbdb 100644 --- a/Source/LK1/L1A-BD/BD_SPC.f90 +++ b/Source/LK1/L1A-BD/BD_SPC.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_SPC ( CARD, CC_SPC_FND ) ! SETID, COMPJ, GRIDJ, RSPCJ, DOFSET USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1O + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1O USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSPC, NSPC, NUM_SPC_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SUPWARN USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -59,17 +58,12 @@ SUBROUTINE BD_SPC ( CARD, CC_SPC_FND ) INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: SETID = 0 ! SPC set ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPC_BEGEND + REAL(DOUBLE) :: DEPS1 ! A small positive number to compare real zero REAL(DOUBLE) :: RSPCJ = ZERO ! Enforced displ value -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SPC Bulk Data Card routine @@ -167,12 +161,7 @@ SUBROUTINE BD_SPC ( CARD, CC_SPC_FND ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,0,9 ) CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SPC1.f90 b/Source/LK1/L1A-BD/BD_SPC1.f90 index 11b7cf8c..b8372503 100644 --- a/Source/LK1/L1A-BD/BD_SPC1.f90 +++ b/Source/LK1/L1A-BD/BD_SPC1.f90 @@ -34,10 +34,9 @@ SUBROUTINE BD_SPC1 ( CARD, LARGE_FLD_INP, CC_SPC_FND ) ! Note that RSPCJ is written to be compatible with the data written for Bulk Data card SPC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1O + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1O USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSPC1, NSPC1, NUM_SPC1_RECORDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPC1_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TSET_CHR_LEN USE MODEL_STUF, ONLY : SPC1_SIDS, SPCSET @@ -67,17 +66,12 @@ SUBROUTINE BD_SPC1 ( CARD, LARGE_FLD_INP, CC_SPC_FND ) INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: JERR = 0 ! A local error count INTEGER(LONG) :: SETID = 0 ! SPC set ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPC1_BEGEND + REAL(DOUBLE) , PARAMETER :: RSPCJ = ZERO ! Enforced displ value (always zero on SPC1). Included for file LINK1O ! with SPC format. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SPC1 Bulk Data Card routine @@ -269,12 +263,7 @@ SUBROUTINE BD_SPC1 ( CARD, LARGE_FLD_INP, CC_SPC_FND ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SPCADD.f90 b/Source/LK1/L1A-BD/BD_SPCADD.f90 index 0c7b1ac0..d768fdd5 100644 --- a/Source/LK1/L1A-BD/BD_SPCADD.f90 +++ b/Source/LK1/L1A-BD/BD_SPCADD.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_SPCADD ( CARD, LARGE_FLD_INP, CC_SPC_FND ) ! Processes SPCADD Bulk Data Cards. Reads and checks data and enters data into array SPCADD_SIDS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSPCADDR, LSUB, NSPCADD, LSPCADDC, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPCADD_BEGEND USE MODEL_STUF, ONLY : SPCADD_SIDS, SPCSET, SUBLOD USE BD_SPCADD_USE_IFs @@ -53,14 +52,9 @@ SUBROUTINE BD_SPCADD ( CARD, LARGE_FLD_INP, CC_SPC_FND ) INTEGER(LONG) :: ICONT = 0 ! Indicator of whether a cont card exists. Output from subr NEXTC INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: SETID ! Set ID for this SPCADD Bulk Data card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPCADD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SPCADD Bulk Data Card routine @@ -189,12 +183,7 @@ SUBROUTINE BD_SPCADD ( CARD, LARGE_FLD_INP, CC_SPC_FND ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SPCADD0.f90 b/Source/LK1/L1A-BD/BD_SPCADD0.f90 index 5fabdb8b..1ecf04b7 100644 --- a/Source/LK1/L1A-BD/BD_SPCADD0.f90 +++ b/Source/LK1/L1A-BD/BD_SPCADD0.f90 @@ -30,10 +30,9 @@ SUBROUTINE BD_SPCADD0 ( CARD, LARGE_FLD_INP, ISPCADD ) ! determines the max number od set ID's over all SPCADD cards in the data deck USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPCADD0_BEGEND USE MODEL_STUF, ONLY : SPCADD_SIDS USE BD_SPCADD0_USE_IFs @@ -50,14 +49,9 @@ SUBROUTINE BD_SPCADD0 ( CARD, LARGE_FLD_INP, ISPCADD ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG), INTENT(OUT) :: ISPCADD ! Count of number of SPC or SPC1 set ID's defined on the SPCADD INTEGER(LONG) :: J ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPCADD0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SPCADD Bulk Data Card routine @@ -127,12 +121,7 @@ SUBROUTINE BD_SPCADD0 ( CARD, LARGE_FLD_INP, ISPCADD ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SPOINT.f90 b/Source/LK1/L1A-BD/BD_SPOINT.f90 index ec9f7653..4f2b3980 100644 --- a/Source/LK1/L1A-BD/BD_SPOINT.f90 +++ b/Source/LK1/L1A-BD/BD_SPOINT.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_SPOINT ( CARD ) ! Read Bulk Data SPOINT entries. Enter the SPOINT number into array GRID (in col 1) and set GRID(ngrid,6) to 1 to indicate SPOINT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NGRID USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : GRID - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPOINT_BEGEND USE BD_SPOINT_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE BD_SPOINT ( CARD ) INTEGER(LONG) :: JERR = 0 ! Error indicator for several types of error in format #2 of input INTEGER(LONG) :: SPOINT1 = 0 ! An SPOINT number INTEGER(LONG) :: SPOINT2 = 0 ! An SPOINT number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPOINT_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SPOINT Bulk Data Card routine @@ -160,12 +154,7 @@ SUBROUTINE BD_SPOINT ( CARD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SPOINT0.f90 b/Source/LK1/L1A-BD/BD_SPOINT0.f90 index 6818bf11..40045737 100644 --- a/Source/LK1/L1A-BD/BD_SPOINT0.f90 +++ b/Source/LK1/L1A-BD/BD_SPOINT0.f90 @@ -29,10 +29,8 @@ SUBROUTINE BD_SPOINT0 ( CARD, DELTA_SPOINT ) ! Processes SPOINT Bulk Data Cards to count the number of SPOINT's on one entry USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, IERRFL, JCARD_LEN, JF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SPOINT0_BEGEND USE BD_SPOINT0_USE_IFs @@ -49,14 +47,9 @@ SUBROUTINE BD_SPOINT0 ( CARD, DELTA_SPOINT ) INTEGER(LONG) :: JERR = 0 ! Error indicator for several types of error in format #2 of input INTEGER(LONG) :: SPOINT1 = 0 ! An SPOINT number INTEGER(LONG) :: SPOINT2 = 0 ! An SPOINT number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SPOINT0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SPOINT Bulk Data Card routine @@ -140,12 +133,7 @@ SUBROUTINE BD_SPOINT0 ( CARD, DELTA_SPOINT ) DELTA_SPOINT = 0 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_SUPORT.f90 b/Source/LK1/L1A-BD/BD_SUPORT.f90 index 670621a7..fc320328 100644 --- a/Source/LK1/L1A-BD/BD_SUPORT.f90 +++ b/Source/LK1/L1A-BD/BD_SUPORT.f90 @@ -31,10 +31,9 @@ SUBROUTINE BD_SUPORT ( CARD ) ! Each record contains: GRIDJ1, COMPJ USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1T + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1T USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_SUPT_CARDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_SUPORT_BEGEND USE BD_SUPORT_USE_IFs @@ -53,14 +52,9 @@ SUBROUTINE BD_SUPORT ( CARD ) INTEGER(LONG) :: IDUM ! Dummy arg in subr IP^CHK not used herein INTEGER(LONG) :: JERR = 0 ! Error indicator for several types of error INTEGER(LONG) :: NUM_PAIRS ! Number of pairs of grid/comp found on this SUPORT card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_SUPORT_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! SUPORT Bulk Data Card routine @@ -127,12 +121,7 @@ SUBROUTINE BD_SUPORT ( CARD ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_TEMP.f90 b/Source/LK1/L1A-BD/BD_TEMP.f90 index 2a7d1c48..7b904b96 100644 --- a/Source/LK1/L1A-BD/BD_TEMP.f90 +++ b/Source/LK1/L1A-BD/BD_TEMP.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_TEMP ( CARD, CC_LOAD_FND ) ! Processes TEMP Bulk Data Cards and writes CARD to file LINK1K for later processing USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1K + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1K USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, NSUB, NTCARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_TEMP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : SUBLOD @@ -51,16 +50,11 @@ SUBROUTINE BD_TEMP ( CARD, CC_LOAD_FND ) INTEGER(LONG) :: JERR = 0 ! Error count INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: SID = 0 ! Set ID read from CARD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_TEMP_BEGEND + REAL(DOUBLE) :: RTEMP = ZERO ! Real value of a temperature -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! TEMP Bulk Data card check (for format checking only) @@ -143,12 +137,7 @@ SUBROUTINE BD_TEMP ( CARD, CC_LOAD_FND ) NTCARD = NTCARD+1 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_TEMPD.f90 b/Source/LK1/L1A-BD/BD_TEMPD.f90 index 5c53638d..c66b0aa9 100644 --- a/Source/LK1/L1A-BD/BD_TEMPD.f90 +++ b/Source/LK1/L1A-BD/BD_TEMPD.f90 @@ -29,10 +29,9 @@ SUBROUTINE BD_TEMPD ( CARD, CC_LOAD_FND ) ! Processes TEMPD Bulk Data Cards and writes CARD to file LINK1K for later processing USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1K + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1K USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, NSUB, NTCARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_TEMPD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : SUBLOD @@ -52,16 +51,11 @@ SUBROUTINE BD_TEMPD ( CARD, CC_LOAD_FND ) INTEGER(LONG) :: JERR = 0 ! Error count INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: SID = 0 ! Set ID read from CARD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_TEMPD_BEGEND + REAL(DOUBLE) :: RTEMP = ZERO ! Real value of a temperature -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! TEMPD Bulk Data card check (for format checking only) @@ -151,12 +145,7 @@ SUBROUTINE BD_TEMPD ( CARD, CC_LOAD_FND ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_TEMPRP.f90 b/Source/LK1/L1A-BD/BD_TEMPRP.f90 index ebeaacd6..a633df4a 100644 --- a/Source/LK1/L1A-BD/BD_TEMPRP.f90 +++ b/Source/LK1/L1A-BD/BD_TEMPRP.f90 @@ -29,11 +29,10 @@ SUBROUTINE BD_TEMPRP ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) ! Processes TEMP Bulk Data Cards and writes CARD to file LINK1K for later processing USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1K + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1K USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, LSUB, MTDAT_TEMPRB, MTDAT_TEMPP1, NSUB, & NTCARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_TEMPRP_BEGEND USE MODEL_STUF, ONLY : SUBLOD USE BD_TEMPRP_USE_IFs @@ -63,16 +62,11 @@ SUBROUTINE BD_TEMPRP ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) INTEGER(LONG) :: IERR ! Error count INTEGER(LONG) :: NFLD ! No. of fields of temperature data (depends on type of CARD) INTEGER(LONG) :: SID = 0 ! Set ID read from CARD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_TEMPRP_BEGEND + REAL(DOUBLE) :: RTEMP ! Real value of a temperature -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! TEMPRB and TEMPP1 Bulk Data card check @@ -304,12 +298,7 @@ SUBROUTINE BD_TEMPRP ( CARD, LARGE_FLD_INP, CC_LOAD_FND ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_USET.f90 b/Source/LK1/L1A-BD/BD_USET.f90 index 49df2f74..40a40c7b 100644 --- a/Source/LK1/L1A-BD/BD_USET.f90 +++ b/Source/LK1/L1A-BD/BD_USET.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_USET ( CARD ) ! USET_NAME, COMPJ, GRIDJ, DOFSET USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1X + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1X USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_USET_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_USET_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SUPWARN USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -57,14 +56,9 @@ SUBROUTINE BD_USET ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IDUM ! Dummy arg in subr IP6CHK not used herein INTEGER(LONG) :: JERR = 0 ! A local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_USET_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! USET Bulk Data Card routine @@ -148,12 +142,7 @@ SUBROUTINE BD_USET ( CARD ) CALL CARD_FLDS_NOT_BLANK ( JCARD,0,0,0,0,0,0,8,9 ) CALL CRDERR ( CARD ) ! CRDERR prints errors found when reading fields -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-BD/BD_USET1.f90 b/Source/LK1/L1A-BD/BD_USET1.f90 index 0689ec7e..fc110aa3 100644 --- a/Source/LK1/L1A-BD/BD_USET1.f90 +++ b/Source/LK1/L1A-BD/BD_USET1.f90 @@ -32,10 +32,9 @@ SUBROUTINE BD_USET1 ( CARD, LARGE_FLD_INP ) ! USET_NAME, COMPJ, GRIDJ, DOFSET USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1X + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1X USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IERRFL, JCARD_LEN, JF, NUM_USET_RECORDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BD_USET1_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TSET_CHR_LEN @@ -63,14 +62,9 @@ SUBROUTINE BD_USET1 ( CARD, LARGE_FLD_INP ) INTEGER(LONG) :: IERR = 0 ! Error indicator returned from subr NEXTC called herein INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: JERR = 0 ! A local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BD_USET1_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! USET1 Bulk Data Card routine @@ -254,12 +248,7 @@ SUBROUTINE BD_USET1 ( CARD, LARGE_FLD_INP ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_ACCE.f90 b/Source/LK1/L1A-CC/CC_ACCE.f90 index f14437fd..7c5f901f 100644 --- a/Source/LK1/L1A-CC/CC_ACCE.f90 +++ b/Source/LK1/L1A-CC/CC_ACCE.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_ACCE ( CARD ) ! Processes Case Control ACCE cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_ACCE_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : ACCE_OUT USE MODEL_STUF, ONLY : SC_ACCE @@ -47,14 +46,9 @@ SUBROUTINE CC_ACCE ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ACCE_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries (they all have some common code so it is put there) @@ -86,12 +80,7 @@ SUBROUTINE CC_ACCE ( CARD ) SC_ACCE(NSUB) = SETID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_DISP.f90 b/Source/LK1/L1A-CC/CC_DISP.f90 index 6988e308..0f70f18c 100644 --- a/Source/LK1/L1A-CC/CC_DISP.f90 +++ b/Source/LK1/L1A-CC/CC_DISP.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_DISP ( CARD ) ! Processes Case Control cards for requests for displacement outputs ! - DISP: displacement USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_DISP_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : DISP_OUT USE MODEL_STUF, ONLY : SC_DISP @@ -50,14 +49,9 @@ SUBROUTINE CC_DISP ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_DISP_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries @@ -95,12 +89,7 @@ SUBROUTINE CC_DISP ( CARD ) SC_DISP(NSUB) = SETID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_ECHO.f90 b/Source/LK1/L1A-CC/CC_ECHO.f90 index bafcb5e7..6c24aebd 100644 --- a/Source/LK1/L1A-CC/CC_ECHO.f90 +++ b/Source/LK1/L1A-CC/CC_ECHO.f90 @@ -29,11 +29,10 @@ SUBROUTINE CC_ECHO ( CARD ) ! Processes Case Control ECHO cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_ECHO_BEGEND USE CC_ECHO_USE_IFs @@ -45,14 +44,9 @@ SUBROUTINE CC_ECHO ( CARD ) INTEGER(LONG) :: ECOL ! Col, on CARD, where "=" sign is located INTEGER(LONG) :: IERR ! Output from subr CSHIFT indicating an error - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ECHO_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process ECHO card @@ -84,12 +78,7 @@ SUBROUTINE CC_ECHO ( CARD ) ECHO = 'UNSORT' ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_ELDA.f90 b/Source/LK1/L1A-CC/CC_ELDA.f90 index 8201ad52..fe218401 100644 --- a/Source/LK1/L1A-CC/CC_ELDA.f90 +++ b/Source/LK1/L1A-CC/CC_ELDA.f90 @@ -32,11 +32,10 @@ SUBROUTINE CC_ELDA ( CARD ) ! ---- USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, WARN_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_ELDA_BEGEND USE MODEL_STUF, ONLY : CCELDT USE CC_ELDA_USE_IFs @@ -67,16 +66,11 @@ SUBROUTINE CC_ELDA ( CARD ) INTEGER(LONG) :: SETID = 0 ! Set ID on this Case Control card INTEGER(LONG) :: STRNG_LEN = 0 ! Length of character string between "()" in the ELDATA card INTEGER(LONG) :: TOKEN_BEG = 0 ! An input to subr STOKEN, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ELDA_BEGEND + INTRINSIC INDEX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process ELDATA cards. @@ -225,12 +219,7 @@ SUBROUTINE CC_ELDA ( CARD ) write(f06,*) endif -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_ELFO.f90 b/Source/LK1/L1A-CC/CC_ELFO.f90 index 9b853774..5c349efd 100644 --- a/Source/LK1/L1A-CC/CC_ELFO.f90 +++ b/Source/LK1/L1A-CC/CC_ELFO.f90 @@ -28,10 +28,9 @@ SUBROUTINE CC_ELFO ( CARD ) ! Processes Case Control ELFO (elforce) entries USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, err + USE IOUNT1, ONLY : err USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_ELFO_BEGEND USE MODEL_STUF, ONLY : SC_ELFE, SC_ELFN USE CC_OUTPUT_DESCRIBERS, ONLY : FORC_OUT @@ -53,14 +52,9 @@ SUBROUTINE CC_ELFO ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ELFO_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries (they all have some common code so it is put there) @@ -133,12 +127,7 @@ SUBROUTINE CC_ELFO ( CARD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_ENFO.f90 b/Source/LK1/L1A-CC/CC_ENFO.f90 index 0365c870..6465cb87 100644 --- a/Source/LK1/L1A-CC/CC_ENFO.f90 +++ b/Source/LK1/L1A-CC/CC_ENFO.f90 @@ -29,11 +29,10 @@ SUBROUTINE CC_ENFO ( CARD ) ! Processes Case Control ENFO (ENFORCED) entries USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ENFFIL, ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ENFFIL, ERR, F06 USE SCONTR, ONLY : WARN_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_ENFO_BEGEND USE CC_ENFO_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE CC_ENFO ( CARD ) INTEGER(LONG) :: ECOL ! Col, on CARD, where "=" sign is located INTEGER(LONG) :: IEND ! Col where end of data is on CARD1 INTEGER(LONG) :: IERR ! Output from subr CSHIFT indicating an error - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_ENFO_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process ENFORCED card @@ -70,12 +64,7 @@ SUBROUTINE CC_ENFO ( CARD ) CALL GET_CHAR_STRING_END ( CARD1, IEND ) ENFFIL = CARD1(1:IEND) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_GPFO.f90 b/Source/LK1/L1A-CC/CC_GPFO.f90 index 7e8ac40b..e8f7c099 100644 --- a/Source/LK1/L1A-CC/CC_GPFO.f90 +++ b/Source/LK1/L1A-CC/CC_GPFO.f90 @@ -28,10 +28,8 @@ SUBROUTINE CC_GPFO ( CARD ) ! Processes Case Control GPFO cards that define grid point force balance output requests USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_GPFO_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : GPFO_OUT USE MODEL_STUF, ONLY : SC_GPFO @@ -49,14 +47,9 @@ SUBROUTINE CC_GPFO ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_GPFO_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries @@ -93,12 +86,7 @@ SUBROUTINE CC_GPFO ( CARD ) SC_GPFO(NSUB) = SETID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_LABE.f90 b/Source/LK1/L1A-CC/CC_LABE.f90 index 1a798648..1ad01398 100644 --- a/Source/LK1/L1A-CC/CC_LABE.f90 +++ b/Source/LK1/L1A-CC/CC_LABE.f90 @@ -29,11 +29,10 @@ SUBROUTINE CC_LABE ( CARD ) ! Processes Case Control LABEL cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : WARN_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_LABE_BEGEND USE MODEL_STUF, ONLY : LABEL USE CC_LABE_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE CC_LABE ( CARD ) INTEGER(LONG) :: ECOL ! Col, on CARD, where "=" sign is located INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! Output from subr CSHIFT indicating an error - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_LABE_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process LABEL card @@ -75,12 +69,7 @@ SUBROUTINE CC_LABE ( CARD ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_LOAD.f90 b/Source/LK1/L1A-CC/CC_LOAD.f90 index 5c8279a9..c31c0026 100644 --- a/Source/LK1/L1A-CC/CC_LOAD.f90 +++ b/Source/LK1/L1A-CC/CC_LOAD.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_LOAD ( CARD ) ! Processes Case Control LOAD cards that define load sets to be applied USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_LOAD_BEGEND USE MODEL_STUF, ONLY : SUBLOD USE CC_LOAD_USE_IFs @@ -44,14 +43,9 @@ SUBROUTINE CC_LOAD ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_LOAD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process LOAD cards @@ -70,12 +64,7 @@ SUBROUTINE CC_LOAD ( CARD ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_METH.f90 b/Source/LK1/L1A-CC/CC_METH.f90 index 2f1941c1..c9d01a27 100644 --- a/Source/LK1/L1A-CC/CC_METH.f90 +++ b/Source/LK1/L1A-CC/CC_METH.f90 @@ -29,11 +29,10 @@ SUBROUTINE CC_METH ( CARD ) ! Processes Case Control eigenvalue METHOD cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : WARN_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_METH_BEGEND USE MODEL_STUF, ONLY : CC_EIGR_SID USE CC_METH_USE_IFs @@ -44,14 +43,9 @@ SUBROUTINE CC_METH ( CARD ) CHARACTER(LEN=*), INTENT(IN) :: CARD ! A Bulk Data card INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_METH_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process METHOD cards @@ -73,12 +67,7 @@ SUBROUTINE CC_METH ( CARD ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_MPC.f90 b/Source/LK1/L1A-CC/CC_MPC.f90 index 7023b286..d7d321c3 100644 --- a/Source/LK1/L1A-CC/CC_MPC.f90 +++ b/Source/LK1/L1A-CC/CC_MPC.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_MPC ( CARD ) ! Processes Case Control MPC cards for defining MPC set ID's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_MPC_BEGEND USE MODEL_STUF, ONLY : MPCSETS USE CC_MPC_USE_IFs @@ -44,14 +43,9 @@ SUBROUTINE CC_MPC ( CARD ) INTEGER(LONG) :: SETID ! Set ID on this Case Control card INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_MPC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process MPC cards @@ -69,12 +63,7 @@ SUBROUTINE CC_MPC ( CARD ) MPCSETS(I) = SETID ENDDO ENDIF - ! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_MPCF.f90 b/Source/LK1/L1A-CC/CC_MPCF.f90 index f02aab0b..3510dc3e 100644 --- a/Source/LK1/L1A-CC/CC_MPCF.f90 +++ b/Source/LK1/L1A-CC/CC_MPCF.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_MPCF ( CARD ) ! Processes Case Control cards for requests for MPC force output requests ! - MPCF: MPC force USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_MPCF_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : MPCF_OUT USE MODEL_STUF, ONLY : SC_MPCF @@ -50,14 +49,9 @@ SUBROUTINE CC_MPCF ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_MPCF_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries @@ -95,12 +89,7 @@ SUBROUTINE CC_MPCF ( CARD ) SC_MPCF(NSUB) = SETID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_NLPARM.f90 b/Source/LK1/L1A-CC/CC_NLPARM.f90 index 63bc9a25..c47faeb5 100644 --- a/Source/LK1/L1A-CC/CC_NLPARM.f90 +++ b/Source/LK1/L1A-CC/CC_NLPARM.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_NLPARM ( CARD ) ! Processes Case Control NLPARM cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LSUB, NSUB, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_NLPARM_BEGEND USE NONLINEAR_PARAMS, ONLY : NL_SID USE CC_NLPARM_USE_IFs @@ -44,14 +43,9 @@ SUBROUTINE CC_NLPARM ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_NLPARM_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process NLPARM cards @@ -76,12 +70,7 @@ SUBROUTINE CC_NLPARM ( CARD ) WRITE(F06,1203) 'NLPARM' ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_OLOA.f90 b/Source/LK1/L1A-CC/CC_OLOA.f90 index 07b66ed0..c93b97e9 100644 --- a/Source/LK1/L1A-CC/CC_OLOA.f90 +++ b/Source/LK1/L1A-CC/CC_OLOA.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_OLOA ( CARD ) ! Processes Case Control cards for requests for applied load requests ! - OLOA: applied load USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_OLOA_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : OLOA_OUT USE MODEL_STUF, ONLY : SC_OLOA @@ -50,14 +49,9 @@ SUBROUTINE CC_OLOA ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_OLOA_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries @@ -95,12 +89,7 @@ SUBROUTINE CC_OLOA ( CARD ) SC_OLOA(NSUB) = SETID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_OUTPUTS.f90 b/Source/LK1/L1A-CC/CC_OUTPUTS.f90 index 2e7981ab..aeb097c6 100644 --- a/Source/LK1/L1A-CC/CC_OUTPUTS.f90 +++ b/Source/LK1/L1A-CC/CC_OUTPUTS.f90 @@ -40,10 +40,9 @@ SUBROUTINE CC_OUTPUTS ( CARD, WHAT, SETID ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NCCCD, NSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_OUTPUTS_BEGEND USE CC_OUTPUTS_USE_IFs @@ -61,14 +60,9 @@ SUBROUTINE CC_OUTPUTS ( CARD, WHAT, SETID ) INTEGER(LONG) :: IERR = 0 ! Error designator from subr PARSE_CSV_STRING INTEGER(LONG) :: NUM_WORDS = 0 ! Number of words in the string between parens (), if present INTEGER(LONG) :: STRING_LEN = 0 ! Length of character string between "()" in the ELDATA card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_OUTPUTS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -112,12 +106,7 @@ SUBROUTINE CC_OUTPUTS ( CARD, WHAT, SETID ) RETURN ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_SET.f90 b/Source/LK1/L1A-CC/CC_SET.f90 index 88fb08f1..14d535b5 100644 --- a/Source/LK1/L1A-CC/CC_SET.f90 +++ b/Source/LK1/L1A-CC/CC_SET.f90 @@ -29,11 +29,10 @@ SUBROUTINE CC_SET ( CARD ) ! Processes Case Control SET cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : CC_ENTRY_LEN, FATAL_ERR, LSETS, LSETLN, MAX_TOKEN_LEN, NSETS, SETLEN, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_SET_BEGEND USE MODEL_STUF, ONLY : ALL_SETS_ARRAY, SETS_IDS USE CC_SET_USE_IFs @@ -72,16 +71,11 @@ SUBROUTINE CC_SET ( CARD ) INTEGER(LONG) :: SETERR = 0 ! Error indicator as set ID is read INTEGER(LONG) :: SETID = 0 ! Set ID on this Case Control card INTEGER(LONG) :: TOKLEN = 0 ! DATA_END - DATA_BEG + 1 (an input to subr STOKEN, called herein) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SET_BEGEND + INTRINSIC INDEX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process SET cards @@ -547,12 +541,7 @@ SUBROUTINE CC_SET ( CARD ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_SET0.f90 b/Source/LK1/L1A-CC/CC_SET0.f90 index 9ea1f854..d744d5c4 100644 --- a/Source/LK1/L1A-CC/CC_SET0.f90 +++ b/Source/LK1/L1A-CC/CC_SET0.f90 @@ -32,10 +32,9 @@ SUBROUTINE CC_SET0 ( CARD ) ! to write characters to ALL_SETS_ARRAY USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, LSETLN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_SET0_BEGEND USE CC_SET0_USE_IFs @@ -54,16 +53,11 @@ SUBROUTINE CC_SET0 ( CARD ) INTEGER(LONG) :: IOCHK = 0 ! IOSTAT error number when reading a Case Control card from unit IN1 INTEGER(LONG) :: K = 0 ! Counter INTEGER(LONG) :: SETERR = 0 ! Error indicator as set ID is read - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SET0_BEGEND + INTRINSIC INDEX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CARD1 = CARD @@ -145,12 +139,7 @@ SUBROUTINE CC_SET0 ( CARD ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_SPC.f90 b/Source/LK1/L1A-CC/CC_SPC.f90 index 8848a5b4..c027227c 100644 --- a/Source/LK1/L1A-CC/CC_SPC.f90 +++ b/Source/LK1/L1A-CC/CC_SPC.f90 @@ -29,11 +29,10 @@ SUBROUTINE CC_SPC ( CARD ) ! Processes Case Control SPC cards for defining SPC set ID's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_SPC_BEGEND USE MODEL_STUF, ONLY : SPCSETS USE CC_SPC_USE_IFs @@ -45,14 +44,9 @@ SUBROUTINE CC_SPC ( CARD ) INTEGER(LONG) :: SETID ! Set ID on this Case Control card INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SPC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process SPC cards @@ -71,12 +65,7 @@ SUBROUTINE CC_SPC ( CARD ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_SPCF.f90 b/Source/LK1/L1A-CC/CC_SPCF.f90 index 1ace7ee9..19dbe451 100644 --- a/Source/LK1/L1A-CC/CC_SPCF.f90 +++ b/Source/LK1/L1A-CC/CC_SPCF.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_SPCF ( CARD ) ! Processes Case Control SPCF cards for SPC force output requests ! - SPCF: SPC force USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, PCHSTAT + USE IOUNT1, ONLY : PCHSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_SPCF_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : SPCF_OUT USE MODEL_STUF, ONLY : SC_SPCF @@ -50,14 +49,9 @@ SUBROUTINE CC_SPCF ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SPCF_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries @@ -95,12 +89,7 @@ SUBROUTINE CC_SPCF ( CARD ) SC_SPCF(NSUB) = SETID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_STRE.f90 b/Source/LK1/L1A-CC/CC_STRE.f90 index 0bad1c29..fbd3ec81 100644 --- a/Source/LK1/L1A-CC/CC_STRE.f90 +++ b/Source/LK1/L1A-CC/CC_STRE.f90 @@ -28,10 +28,8 @@ SUBROUTINE CC_STRE ( CARD ) ! Processes Case Control STRE cards for element stress output requests USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_STRE_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OUT USE MODEL_STUF, ONLY : SC_STRE @@ -49,14 +47,9 @@ SUBROUTINE CC_STRE ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_STRE_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries (they all @@ -94,12 +87,7 @@ SUBROUTINE CC_STRE ( CARD ) SC_STRE(NSUB) = SETID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_STRN.f90 b/Source/LK1/L1A-CC/CC_STRN.f90 index ecb7f595..49a63509 100644 --- a/Source/LK1/L1A-CC/CC_STRN.f90 +++ b/Source/LK1/L1A-CC/CC_STRN.f90 @@ -28,10 +28,8 @@ SUBROUTINE CC_STRN ( CARD ) ! Processes Case Control STRN cards for element strain output requests USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, LSUB, NSUB, NCCCD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_STRN_BEGEND USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OUT USE MODEL_STUF, ONLY : SC_STRN @@ -49,14 +47,9 @@ SUBROUTINE CC_STRN ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_STRN_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! CC_OUTPUTS processes all output type Case Control entries @@ -94,12 +87,7 @@ SUBROUTINE CC_STRN ( CARD ) SC_STRN(NSUB) = SETID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_SUBC.f90 b/Source/LK1/L1A-CC/CC_SUBC.f90 index cb3eb2e2..e02fe456 100644 --- a/Source/LK1/L1A-CC/CC_SUBC.f90 +++ b/Source/LK1/L1A-CC/CC_SUBC.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_SUBC ( CARD ) ! Processes Case Control SUBCASE cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : CC_ENTRY_LEN, FATAL_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_SUBC_BEGEND USE MODEL_STUF, ONLY : SCNUM USE CC_SUBC_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE CC_SUBC ( CARD ) INTEGER(LONG) :: IERR ! Output from subr CSHIFT indicating an error INTEGER(LONG) :: JERR ! Error indicator if this subcase number is the same as a previous one INTEGER(LONG) :: SUBCASE_NUM ! Subcase number from the SUBCASE card being read - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SUBC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process SUBCASE cards @@ -105,12 +99,7 @@ SUBROUTINE CC_SUBC ( CARD ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_SUBT.f90 b/Source/LK1/L1A-CC/CC_SUBT.f90 index 38f43a75..f79c0dfd 100644 --- a/Source/LK1/L1A-CC/CC_SUBT.f90 +++ b/Source/LK1/L1A-CC/CC_SUBT.f90 @@ -29,11 +29,10 @@ SUBROUTINE CC_SUBT ( CARD ) ! Processes Case Control SUBTITLE cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : WARN_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_SUBT_BEGEND USE MODEL_STUF, ONLY : STITLE USE CC_SUBT_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE CC_SUBT ( CARD ) INTEGER(LONG) :: ECOL ! Col, on CARD, where "=" sign is located INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! Output from subr CSHIFT indicating an error - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_SUBT_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process SUBTITLE cards @@ -75,12 +69,7 @@ SUBROUTINE CC_SUBT ( CARD ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_TEMP.f90 b/Source/LK1/L1A-CC/CC_TEMP.f90 index af9648a7..d3ec583a 100644 --- a/Source/LK1/L1A-CC/CC_TEMP.f90 +++ b/Source/LK1/L1A-CC/CC_TEMP.f90 @@ -29,10 +29,9 @@ SUBROUTINE CC_TEMP ( CARD ) ! Processes Case Control TEMP cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : LSUB, NSUB, NTSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CC_TEMP_BEGEND USE MODEL_STUF, ONLY : SUBLOD USE CC_TEMP_USE_IFs @@ -44,14 +43,9 @@ SUBROUTINE CC_TEMP ( CARD ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: SETID ! Set ID on this Case Control card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_TEMP_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process TEMP cards @@ -71,12 +65,7 @@ SUBROUTINE CC_TEMP ( CARD ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CC_TITL.f90 b/Source/LK1/L1A-CC/CC_TITL.f90 index 529f7c8e..a4f38cb9 100644 --- a/Source/LK1/L1A-CC/CC_TITL.f90 +++ b/Source/LK1/L1A-CC/CC_TITL.f90 @@ -29,11 +29,10 @@ SUBROUTINE CC_TITL ( CARD ) ! Processes Case Control TITLE cards USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : WARN_ERR, LSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CC_TITL_BEGEND USE MODEL_STUF, ONLY : TITLE USE CC_TITL_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE CC_TITL ( CARD ) INTEGER(LONG) :: ECOL ! Col, on CARD, where "=" sign is located INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! Output from subr CSHIFT indicating an error - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CC_TITL_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process TITLE card @@ -75,12 +69,7 @@ SUBROUTINE CC_TITL ( CARD ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A-CC/CHK_CC_CMD_DESCRIBERS.f90 b/Source/LK1/L1A-CC/CHK_CC_CMD_DESCRIBERS.f90 index b0cddc68..90a6d0f8 100644 --- a/Source/LK1/L1A-CC/CHK_CC_CMD_DESCRIBERS.f90 +++ b/Source/LK1/L1A-CC/CHK_CC_CMD_DESCRIBERS.f90 @@ -31,12 +31,11 @@ SUBROUTINE CHK_CC_CMD_DESCRIBERS ( WHAT, NUM_WORDS ) ! Write warning messages if a descriptor is not valid for MYSTRAN USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_CMD_DESCRIBERS, ECHO, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRN_OPT, STRE_LOC, STRE_OPT, FORC_LOC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CHK_CC_CMD_DESCRIBERS_BEGEND USE CHK_CC_CMD_DESCRIBERS_USE_IFs @@ -59,15 +58,9 @@ SUBROUTINE CHK_CC_CMD_DESCRIBERS ( WHAT, NUM_WORDS ) INTEGER(LONG), INTENT(IN) :: NUM_WORDS ! Number of words we need to check in CC_CMD_DESCRIBERS INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: JCOL ! Designator of a column in an array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CHK_CC_CMD_DESCRIBERS_BEGEND + LOGICAL :: IS_PLOT, IS_PRINT, IS_PUNCH -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF ! ********************************************************************************************************************************** IF (WHAT == 'ACCE') THEN; OUTPUT_TYPE( 1) = 'ACCE'; JCOL = 1; @@ -364,12 +357,7 @@ SUBROUTINE CHK_CC_CMD_DESCRIBERS ( WHAT, NUM_WORDS ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/CSHIFT.f90 b/Source/LK1/L1A/CSHIFT.f90 index 1f7e7866..823d233e 100644 --- a/Source/LK1/L1A/CSHIFT.f90 +++ b/Source/LK1/L1A/CSHIFT.f90 @@ -1,65 +1,59 @@ ! ################################################################################################################################## -! Begin MIT license text. +! Begin MIT license text. ! _______________________________________________________________________________________________________ - -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) - -! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and ! associated documentation files (the "Software"), to deal in the Software without restriction, including ! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to -! the following conditions: - -! The above copyright notice and this permission notice shall be included in all copies or substantial -! portions of the Software and documentation. - -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -! THE SOFTWARE. +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. ! _______________________________________________________________________________________________________ - -! End MIT license text. - + +! End MIT license text. + SUBROUTINE CSHIFT ( CARD_IN, CHAR, CARD_SHIFTED, CHAR_COL, IERR ) - + ! Shifts card string data on CARD_IN so that the data after character CHAR is shifted to start in col 1 (with blanks ! between CHAR and data on CARD_IN deleted). An error is indicated if CHAR is not found. The special case of CHAR = ' ' ! input to this subr indicates we want to shift the card to begin in column 1 - + USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CSHIFT_BEGEND USE CSHIFT_USE_IFs IMPLICIT NONE - + CHARACTER(LEN=LEN(BLNK_SUB_NAM)) :: SUBR_NAME = 'CSHIFT' CHARACTER(LEN=*) , INTENT(IN) :: CARD_IN ! Input Case Control card CHARACTER(LEN=LEN(CARD_IN)) , INTENT(OUT):: CARD_SHIFTED ! C.C. card shifted to begin in 1st nonblank col after CHAR_COL CHARACTER(1*BYTE), INTENT(IN) :: CHAR ! Character to find in CARD - + INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator. If CHAR not found, IERR set to 1 INTEGER(LONG), INTENT(OUT) :: CHAR_COL ! Column number on CARD where character CHAR is found - INTEGER(LONG) :: CARD_IN_LEN ! Length of CARD + INTEGER(LONG) :: CARD_IN_LEN ! Length of CARD INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: ISTART ! The col on CARD where nonblank data begins after CHAR_COL - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CSHIFT_BEGEND + INTRINSIC INDEX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CARD_IN_LEN = LEN(CARD_IN) @@ -69,7 +63,7 @@ SUBROUTINE CSHIFT ( CARD_IN, CHAR, CARD_SHIFTED, CHAR_COL, IERR ) DO I=1,CARD_IN_LEN CARD_SHIFTED(I:I) = ' ' ENDDO - + IERR = 0 IF (CHAR == ' ') THEN ! Special case: shift card to begin in 1st nonblank col after col 1 CHAR_COL = 0 @@ -92,15 +86,10 @@ SUBROUTINE CSHIFT ( CARD_IN, CHAR, CARD_SHIFTED, CHAR_COL, IERR ) ENDDO CARD_SHIFTED(1:) = CARD_IN(ISTART:CARD_IN_LEN) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN ! ********************************************************************************************************************************** - + END SUBROUTINE CSHIFT diff --git a/Source/LK1/L1A/EC_IN4FIL.f90 b/Source/LK1/L1A/EC_IN4FIL.f90 index f8e95351..f10ad71c 100644 --- a/Source/LK1/L1A/EC_IN4FIL.f90 +++ b/Source/LK1/L1A/EC_IN4FIL.f90 @@ -29,10 +29,9 @@ SUBROUTINE EC_IN4FIL ( CARD ) ! Processes Executive Control IN4 entries that define IN4 files to be read USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, FILE_NAM_MAXLEN, IN4FIL, IN4FIL_NUM, NUM_IN4_FILES + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, FILE_NAM_MAXLEN, IN4FIL, IN4FIL_NUM, NUM_IN4_FILES USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_TOKEN_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : EC_IN4FIL_BEGEND USE EC_IN4FIL_USE_IFs @@ -53,16 +52,11 @@ SUBROUTINE EC_IN4FIL ( CARD ) INTEGER(LONG) :: JEND = 0 ! INTEGER(LONG) :: K = 0 ! Counter INTEGER(LONG) :: SETERR = 0 ! Error indicator as set ID is read - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EC_IN4FIL_BEGEND + INTRINSIC INDEX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process SET cards @@ -137,12 +131,7 @@ SUBROUTINE EC_IN4FIL ( CARD ) IN4FIL(NUM_IN4_FILES)(1:) = CARD2(ISTART:IEND) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/EC_OUTPUT4.f90 b/Source/LK1/L1A/EC_OUTPUT4.f90 index 3873647a..add96e57 100644 --- a/Source/LK1/L1A/EC_OUTPUT4.f90 +++ b/Source/LK1/L1A/EC_OUTPUT4.f90 @@ -37,8 +37,7 @@ SUBROUTINE EC_OUTPUT4 ( CARD1, IERR, ANY_OU4_NAME_BAD ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN - USE SUBR_BEGEND_LEVELS, ONLY : EC_OUTPUT4_BEGEND - USE IOUNT1, ONLY : ERR, F04, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1 USE DEBUG_PARAMETERS, ONLY : DEBUG USE OUTPUT4_MATRICES, ONLY : NUM_OU4_VALID_NAMES, TAPE_ACTION_MAX_VAL, TAPE_ACTION_MIN_VAL, NUM_OU4_REQUESTS, & OU4_FILE_UNITS, OU4_TAPE_ACTION, ACT_OU4_MYSTRAN_NAMES, ACT_OU4_OUTPUT_NAMES, & @@ -75,14 +74,9 @@ SUBROUTINE EC_OUTPUT4 ( CARD1, IERR, ANY_OU4_NAME_BAD ) INTEGER(LONG) :: ROW_NUM ! INTEGER(LONG) :: SLASH1_COL ! Col in matrix name where character "/" is found INTEGER(LONG) :: SLASH2_COL ! Col in matrix name where characters "//" are found - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EC_OUTPUT4_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -320,12 +314,7 @@ SUBROUTINE EC_OUTPUT4 ( CARD1, IERR, ANY_OU4_NAME_BAD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/EC_PARTN.f90 b/Source/LK1/L1A/EC_PARTN.f90 index d71dbed8..c9666ff8 100644 --- a/Source/LK1/L1A/EC_PARTN.f90 +++ b/Source/LK1/L1A/EC_PARTN.f90 @@ -39,8 +39,7 @@ SUBROUTINE EC_PARTN ( CARD1, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN - USE SUBR_BEGEND_LEVELS, ONLY : EC_PARTN_BEGEND - USE IOUNT1, ONLY : ERR, F04, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, MOU4, OU4, OU4_ELM_OTM, OU4_GRD_OTM, SC1 USE DEBUG_PARAMETERS, ONLY : DEBUG USE OUTPUT4_MATRICES, ONLY : NUM_OU4_REQUESTS, NUM_PARTN_REQUESTS, OU4_PART_VEC_NAMES, OU4_PART_MAT_NAMES, & ACT_OU4_MYSTRAN_NAMES, ACT_OU4_OUTPUT_NAMES, & @@ -65,14 +64,9 @@ SUBROUTINE EC_PARTN ( CARD1, IERR ) INTEGER(LONG) :: COMMA_COL(3) ! Column where comma is found in CARD2 INTEGER(LONG) :: I,J ! DO loop index INTEGER(LONG) :: JBEG ! Beg col in data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EC_PARTN_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF ((DEBUG(197) == 2) .OR. (DEBUG(197) == 3)) THEN @@ -224,12 +218,7 @@ SUBROUTINE EC_PARTN ( CARD1, IERR ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/ELEPRO.f90 b/Source/LK1/L1A/ELEPRO.f90 index fb54c448..f80d7a81 100644 --- a/Source/LK1/L1A/ELEPRO.f90 +++ b/Source/LK1/L1A/ELEPRO.f90 @@ -41,10 +41,9 @@ SUBROUTINE ELEPRO ( INCR_NELE, JCARD, NFIELD, NMORE, ! 4) Resets pointer array, EPNT. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR, JF, LEDAT, LELE, NEDAT, NELE, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELEPRO_BEGEND USE MODEL_STUF, ONLY : EDAT, EPNT USE ELEPRO_USE_IFs @@ -75,14 +74,9 @@ SUBROUTINE ELEPRO ( INCR_NELE, JCARD, NFIELD, NMORE, ! additional data will fit into EDAT can be made here. INTEGER(LONG) :: I4INP ! A value read from input file that should be an integer value INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELEPRO_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CHK_FLD_ARRAY(2) = CHK_FLD2 @@ -165,12 +159,7 @@ SUBROUTINE ELEPRO ( INCR_NELE, JCARD, NFIELD, NMORE, ENDDO jdo -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/FFIELD.f90 b/Source/LK1/L1A/FFIELD.f90 index 0ecb0f88..86a987d5 100644 --- a/Source/LK1/L1A/FFIELD.f90 +++ b/Source/LK1/L1A/FFIELD.f90 @@ -35,10 +35,9 @@ SUBROUTINE FFIELD ( CARD, IERR ) ! 2) Left justify fields 2 - 9 of cards that are fixed field USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, BD_ENTRY_LEN, FATAL_ERR, IMB_BLANK, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FFIELD_BEGEND USE FFIELD_USE_IFs @@ -60,14 +59,9 @@ SUBROUTINE FFIELD ( CARD, IERR ) INTEGER(LONG) :: IFD ! Counter for the 10 fields of a Bulk Data CARD INTEGER(LONG) :: JCT ! Column counter in free-field CARD INTEGER(LONG) :: K1S,K2S,K1L ! Indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FFIELD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CARD_LEN = LEN(CARD) @@ -188,12 +182,7 @@ SUBROUTINE FFIELD ( CARD, IERR ) ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/FFIELD2.f90 b/Source/LK1/L1A/FFIELD2.f90 index 3e1cc10a..93ee03ae 100644 --- a/Source/LK1/L1A/FFIELD2.f90 +++ b/Source/LK1/L1A/FFIELD2.f90 @@ -64,11 +64,10 @@ SUBROUTINE FFIELD2 ( CARD1, CARD2, CARD, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, BD_ENTRY_LEN, ECHO, FATAL_ERR, IMB_BLANK, JCARD_LEN USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : FFIELD2_BEGEND USE FFIELD2_USE_IFs @@ -85,14 +84,9 @@ SUBROUTINE FFIELD2 ( CARD1, CARD2, CARD, IERR ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG), INTENT(OUT) :: IERR ! = 1 if a field is longer than 8 chars on a free field card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FFIELD2_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -198,12 +192,7 @@ SUBROUTINE FFIELD2 ( CARD1, CARD2, CARD, IERR ) CALL MKCARD ( JCARD, CARD ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/LOADB.f90 b/Source/LK1/L1A/LOADB.f90 index db142bfb..4865d718 100644 --- a/Source/LK1/L1A/LOADB.f90 +++ b/Source/LK1/L1A/LOADB.f90 @@ -28,7 +28,7 @@ SUBROUTINE LOADB ! LOADB reads in the Bulk Data deck. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, IMB_BLANK, JF, LIND_GRDS_MPCS, & LSUB, LLOADC, LMPCADDC, LSPCADDC, MDT, MTDAT_TEMPP1, MTDAT_TEMPRB, & MAX_GAUSS_POINTS, MAX_STRESS_POINTS, & @@ -41,7 +41,6 @@ SUBROUTINE LOADB USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : GRIDSEQ, IORQ1M, IORQ1S, IORQ1B, IORQ2B, IORQ2T, QUADAXIS, SUPINFO, SUPWARN USE OUTPUT4_MATRICES, ONLY : NUM_PARTN_REQUESTS - USE SUBR_BEGEND_LEVELS, ONLY : LOADB_BEGEND USE MODEL_STUF, ONLY : FORMOM_SIDS, GRAV_SIDS, IOR3D_MAX, LOAD_SIDS, & MPCSET, MPC_SIDS, MPCSIDS, MPCADD_SIDS, PBAR, RPCOMP, PRESS_SIDS, RFORCE_SIDS, & RPBAR, SLOAD_SIDS, SPC_SIDS, SPC1_SIDS, SPCADD_SIDS, SPCSET, CC_EIGR_SID, SCNUM, SUBLOD @@ -88,14 +87,9 @@ SUBROUTINE LOADB INTEGER(LONG) :: NG ! Actual num grids on CUSERIN (not incl SPOINT's) INTEGER(LONG) :: NS ! Actual num SPOINT'ss on CUSERIN INTEGER(LONG) :: NUM_QUADS ! Number of quadrilateral elements - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADB_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize @@ -983,12 +977,7 @@ SUBROUTINE LOADB WRITE(F06,1197) MELGP, MELDOF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -1152,7 +1141,7 @@ SUBROUTINE READ_BDF_LINE(IN1, IOCHK, LINE) ! it seems like there should be a better way to write an upper function... ! https://en.wikibooks.org/wiki/Fortran/strings - USE IOUNT1, ONLY : ERR, INFILE, F06 !, F04 + USE IOUNT1, ONLY : ERR, INFILE, F06 ! USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE implicit none CHARACTER(256), intent (inout) :: LINE @@ -1178,7 +1167,7 @@ SUBROUTINE READ_BDF_LINE(IN1, IOCHK, LINE) DO WHILE(TRIM_LINE(1:1) == '$') IF (IOCHK /= 0) THEN REC_NO = -99 - CALL READERR (IOCHK, INFILE, MESSAG, REC_NO, OUNT, 'Y') + CALL READERR (IOCHK, INFILE, MESSAG, REC_NO, OUNT ) FATAL_ERR = FATAL_ERR + 1 ENDIF READ(IN1,101,IOSTAT=IOCHK) LINE diff --git a/Source/LK1/L1A/LOADB0.f90 b/Source/LK1/L1A/LOADB0.f90 index 0707611f..ea49dbe7 100644 --- a/Source/LK1/L1A/LOADB0.f90 +++ b/Source/LK1/L1A/LOADB0.f90 @@ -29,7 +29,7 @@ SUBROUTINE LOADB0 ! Preliminary reading of the Bulk Data to count several data sizes so ! that arrays may be allocated prior to the final reading of the Bulk Data. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, FATAL_ERR, LCMASS, LDOFG, LELE, & LEDAT, LFORCE, LCONM2, LCORD, LGRAV, LGRID, LGUSERIN, LLOADC, LLOADR, & LMATL, LMPC, LMPCADDC, LMPCADDR, LPBAR, LPBEAM, LPBUSH, LPCOMP, LPCOMP_PLIES, LPDAT, & @@ -42,7 +42,6 @@ SUBROUTINE LOADB0 MPDAT_PLOAD2, MPDAT_PLOAD4, MEDAT_PLOTEL, MRBE3, MRSPLINE, MTDAT_TEMPRB, MTDAT_TEMPP1, & NPBARL, NSPOINT, PROG_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LOADB0_BEGEND USE MODEL_STUF, ONLY : GRDSET3, GRDSET7, GRDSET8 USE PARAMS, ONLY : GRIDSEQ @@ -80,14 +79,9 @@ SUBROUTINE LOADB0 INTEGER(LONG) :: IPLIES ! Number of composite layers on 1 B.D. PCOMP card INTEGER(LONG) :: NG_USERIN ! Number of grids found on USERIN elems (not incl SPOINT's) INTEGER(LONG) :: NS_USERIN ! Number of SPOINT's found on USERIN elems - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADB0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CARD(1:) = ' ' @@ -518,12 +512,7 @@ SUBROUTINE LOADB0 ! ! reported when LOADB runs. ! ! ! ! FATAL_ERR = 0 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/LOADB_RESTART.f90 b/Source/LK1/L1A/LOADB_RESTART.f90 index 53c8a554..10fc8529 100644 --- a/Source/LK1/L1A/LOADB_RESTART.f90 +++ b/Source/LK1/L1A/LOADB_RESTART.f90 @@ -29,12 +29,11 @@ SUBROUTINE LOADB_RESTART ! LOADB_RESTART reads in some entries in the Bulk Data deck ! (e.g., DEBUG, PARAM) for a RESTART run USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, JCARD_LEN, JF, PROG_NAME, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : LOADB_RESTART_BEGEND USE LOADB_RESTART_USE_IFs @@ -63,14 +62,9 @@ SUBROUTINE LOADB_RESTART INTEGER(LONG) :: INT_VAL ! Integer value read fron a card field INTEGER(LONG) :: IERR ! Error indicator from subr FFIELD INTEGER(LONG) :: IOCHK ! IOSTAT error number when reading Bulk Data cards from unit IN1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADB_RESTART_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO I=1,NUM_PARMS @@ -295,12 +289,7 @@ SUBROUTINE LOADB_RESTART ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/LOADC.f90 b/Source/LK1/L1A/LOADC.f90 index 3d02c064..878ea477 100644 --- a/Source/LK1/L1A/LOADC.f90 +++ b/Source/LK1/L1A/LOADC.f90 @@ -28,12 +28,11 @@ SUBROUTINE LOADC ! LOADC reads in the CASE CONTROL DECK USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUGOUT, ERR, F04, F06, IN1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : BUGOUT, ERR, F06, IN1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, ENFORCED, FATAL_ERR, WARN_ERR, NSUB, NTSUB, PROG_NAME, & RESTART, SOL_NAME USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : LOADC_BEGEND USE MODEL_STUF, ONLY : CC_EIGR_SID, MEFFMASS_CALC, MPCSET, MPCSETS, MPFACTOR_CALC, SCNUM, SPCSET, SPCSETS, SUBLOD USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC, FORC_LOC @@ -53,14 +52,9 @@ SUBROUTINE LOADC INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! Error indicator. If CHAR not found, IERR set to 1 INTEGER(LONG) :: IOCHK ! IOSTAT error number when reading a Case Control card from unit IN1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADC_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** @@ -348,12 +342,7 @@ SUBROUTINE LOADC ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/LOADC0.f90 b/Source/LK1/L1A/LOADC0.f90 index 1a219c94..e5013d6b 100644 --- a/Source/LK1/L1A/LOADC0.f90 +++ b/Source/LK1/L1A/LOADC0.f90 @@ -36,10 +36,9 @@ SUBROUTINE LOADC0 ! number of characters in SET's to determine LSETLN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : ERR, F06, IN1 USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, FATAL_ERR, LSETS, LSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LOADC0_BEGEND USE LOADC0_USE_IFs @@ -55,14 +54,9 @@ SUBROUTINE LOADC0 INTEGER(LONG) :: IERR ! Error indicator. If CHAR not found, IERR set to 1 INTEGER(LONG) :: IOCHK ! IOSTAT error number when reading a Case Control card from unit IN1 INTEGER(LONG) :: JERR ! Error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADC0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -121,12 +115,7 @@ SUBROUTINE LOADC0 CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/LOADE.f90 b/Source/LK1/L1A/LOADE.f90 index 1a756e30..920af16b 100644 --- a/Source/LK1/L1A/LOADE.f90 +++ b/Source/LK1/L1A/LOADE.f90 @@ -28,7 +28,7 @@ SUBROUTINE LOADE ! LOADE reads in the EXEC CONTROL DECK USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, IN1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, IN1 USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, CHKPNT, FATAL_ERR, WARN_ERR, JCARD_LEN, JF, & PROG_NAME, SOL_NAME, RESTART USE TIMDAT, ONLY : TSEC @@ -38,7 +38,6 @@ SUBROUTINE LOADE USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES, ACT_OU4_OUTPUT_NAMES, ALLOW_OU4_MYSTRAN_NAMES, & ALLOW_OU4_OUTPUT_NAMES, OU4_PART_MAT_NAMES, OU4_PART_VEC_NAMES, NUM_OU4_VALID_NAMES - USE SUBR_BEGEND_LEVELS, ONLY : LOADE_BEGEND USE LOADE_USE_IFs @@ -76,14 +75,9 @@ SUBROUTINE LOADE INTEGER(LONG) :: NTOKEN ! An output from subr STOKEN (how many tokens were read) INTEGER(LONG) :: SOL_INT ! Integer value read from an Exec Control SOL entry INTEGER(LONG) :: TOKLEN ! Length of character string sent to subr STOKEN (= LEN(CARD)) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADE_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DOLLAR_WARN = 'N' @@ -345,12 +339,7 @@ SUBROUTINE LOADE WRITE(F06,998) EC_OUTPUT4_ERR CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/LOADE0.f90 b/Source/LK1/L1A/LOADE0.f90 index e7075d91..7e95cf90 100644 --- a/Source/LK1/L1A/LOADE0.f90 +++ b/Source/LK1/L1A/LOADE0.f90 @@ -29,11 +29,10 @@ SUBROUTINE LOADE0 ! LOADE0 does a preliminary read of the EXEC CONTROL DECK to find ! if there is a RESTART entry USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, FILE_NAM_MAXLEN, IN0, IN1, INC, LEN_INPUT_FNAME, INFILE, & - LEN_RESTART_FNAME, LNUM_IN4_FILES, RESTART_FILNAM, SCR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, FILE_NAM_MAXLEN, IN0, IN1, INC, LEN_INPUT_FNAME, INFILE, & + LEN_RESTART_FNAME, LNUM_IN4_FILES, RESTART_FILNAM, SCR USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, FATAL_ERR, RESTART USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LOADE0_BEGEND USE LOADE0_USE_IFs @@ -52,14 +51,9 @@ SUBROUTINE LOADE0 INTEGER(LONG) :: IEND ! Col where FILNAM ends after trailing blanks INTEGER(LONG) :: IERR = 0 ! Error indicator. INTEGER(LONG) :: IOCHK ! IOSTAT error number when reading a Case Control card from unit IN1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LOADE0_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -131,12 +125,7 @@ SUBROUTINE LOADE0 ENDDO main -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/READ_INCLUDE_FILNAM.f90 b/Source/LK1/L1A/READ_INCLUDE_FILNAM.f90 index 8cc97a04..b7096c90 100644 --- a/Source/LK1/L1A/READ_INCLUDE_FILNAM.f90 +++ b/Source/LK1/L1A/READ_INCLUDE_FILNAM.f90 @@ -30,11 +30,10 @@ SUBROUTINE READ_INCLUDE_FILNAM ( CARD, IERR ) ! INCLUDE 'filename' with or without the ' marks USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, FILE_NAM_MAXLEN, INC, INCFIL + USE IOUNT1, ONLY : ERR, F06, FILE_NAM_MAXLEN, INC, INCFIL USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, FATAL_ERR USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : READ_INCLUDE_FILNAM_BEGEND USE READ_INCLUDE_FILNAM_USE_IFs @@ -50,7 +49,7 @@ SUBROUTINE READ_INCLUDE_FILNAM ( CARD, IERR ) CHARACTER( 1*BYTE) :: DONE ! Indicator of having found start and end of file name INTEGER(LONG), INTENT(OUT) :: IERR ! Local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_INCLUDE_FILNAM_BEGEND + INTEGER(LONG) :: CHAR_COL ! Column number on CARD where character CHAR is found INTEGER(LONG) :: DELTA_END_COL ! Delta from START_ COL to END_COL INTEGER(LONG) :: END_COL ! Col from CARD1 where the 2nd ' exists, if it does exist @@ -60,12 +59,7 @@ SUBROUTINE READ_INCLUDE_FILNAM ( CARD, IERR ) INTEGER(LONG) :: OUNT(2) ! File units to write messages to -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -141,7 +135,7 @@ SUBROUTINE READ_INCLUDE_FILNAM ( CARD, IERR ) INQUIRE(FILE=INCFIL,EXIST=LEXIST) IF (LEXIST) THEN OPEN(INC,FILE=INCFIL,STATUS='OLD',ACTION='READ',IOSTAT=IOCHK) - IF (IOCHK /= 0) CALL OPNERR ( IOCHK, INCFIL, OUNT, 'Y' ) + IF (IOCHK /= 0) CALL OPNERR ( IOCHK, INCFIL, OUNT ) ELSE WRITE(ERR,1042) INCFIL WRITE(F06,1042) INCFIL @@ -162,12 +156,7 @@ SUBROUTINE READ_INCLUDE_FILNAM ( CARD, IERR ) CALL DEB_READ_INCL_FILNAM ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/REPLACE_TABS_W_BLANKS.f90 b/Source/LK1/L1A/REPLACE_TABS_W_BLANKS.f90 index 83dac7dd..4b368c0f 100644 --- a/Source/LK1/L1A/REPLACE_TABS_W_BLANKS.f90 +++ b/Source/LK1/L1A/REPLACE_TABS_W_BLANKS.f90 @@ -30,10 +30,8 @@ SUBROUTINE REPLACE_TABS_W_BLANKS ( CARD ) ! Case Control entries (but not Bulk Data entries - which are handled differently). USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REPLACE_TABS_W_BLANKS_BEGEND USE REPLACE_TABS_W_BLANKS_USE_IFs @@ -43,15 +41,10 @@ SUBROUTINE REPLACE_TABS_W_BLANKS ( CARD ) CHARACTER(LEN=*), INTENT(INOUT) :: CARD ! Input entry character line CHARACTER(LEN=LEN(CARD)) :: CARD0 ! Temporary CARD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REPLACE_TABS_W_BLANKS_BEGEND + INTEGER(LONG) :: I ! DO loop index -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Strip all tab chars from input CARD @@ -66,12 +59,7 @@ SUBROUTINE REPLACE_TABS_W_BLANKS ( CARD ) ENDDO CARD(1:) = CARD0(1:) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1A/RW_INCLUDE_FILES.f90 b/Source/LK1/L1A/RW_INCLUDE_FILES.f90 index fe70280c..896fccfd 100644 --- a/Source/LK1/L1A/RW_INCLUDE_FILES.f90 +++ b/Source/LK1/L1A/RW_INCLUDE_FILES.f90 @@ -30,10 +30,9 @@ SUBROUTINE RW_INCLUDE_FILES ( UNIT_IN, UNIT_OUT ) ! files entries) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, FILE_NAM_MAXLEN, INCFIL + USE IOUNT1, ONLY : ERR, F06, FILE_NAM_MAXLEN, INCFIL USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RW_INCLUDE_FILES_BEGEND USE RW_INCLUDE_FILES_USE_IFs @@ -42,18 +41,13 @@ SUBROUTINE RW_INCLUDE_FILES ( UNIT_IN, UNIT_OUT ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'RW_INCLUDE_FILES' CHARACTER(LEN=EC_ENTRY_LEN) :: CARD ! Entry from INCL_FILNAM - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RW_INCLUDE_FILES_BEGEND + INTEGER(LONG), INTENT(IN) :: UNIT_IN ! Unit number to read INCLUDE entries from INTEGER(LONG), INTENT(IN) :: UNIT_OUT ! Unit number to write INCLUDE entries to INTEGER(LONG) :: ICNT = 0 ! Counter INTEGER(LONG) :: IOCHK ! IOSTAT error number when reading an entry from INCL_FILNAM -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF + ! ********************************************************************************************************************************** WRITE(UNIT_OUT,201,IOSTAT=IOCHK) INCFIL @@ -111,12 +105,7 @@ SUBROUTINE RW_INCLUDE_FILES ( UNIT_IN, UNIT_OUT ) WRITE(F06,301) ICNT-1, INCFIL ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/CORD_PROC.f90 b/Source/LK1/L1B/CORD_PROC.f90 index 276f1951..02a71fbc 100644 --- a/Source/LK1/L1B/CORD_PROC.f90 +++ b/Source/LK1/L1B/CORD_PROC.f90 @@ -52,11 +52,10 @@ SUBROUTINE CORD_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE80, PI, CONV_DEG_RAD - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MRCORD, NCORD, NCORD1, NCORD2, NGRID, FATAL_ERR USE PARAMS, ONLY : EPSIL, PRTCORD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CORD_PROC_BEGEND USE MODEL_STUF, ONLY : CORD, GRID, RCORD, RGRID, TN USE CORD_PROC_USE_IFs @@ -116,7 +115,7 @@ SUBROUTINE CORD_PROC ! CORD1R each of the 3 cols will have the same coord sys value in row 1. INTEGER(LONG) :: RID_ARRAY_COL ! Col number in RID_ARRAY - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CORD_PROC_BEGEND + REAL(DOUBLE) :: EMTN(3,3) ! A coord transf matrix from some coord system to basic REAL(DOUBLE) :: EPS1 ! A small number @@ -155,12 +154,7 @@ SUBROUTINE CORD_PROC INTRINSIC :: DCOS, DSIN, DSQRT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -1116,12 +1110,7 @@ SUBROUTINE CORD_PROC ! Check IERROR and quit if > 0 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -1175,10 +1164,9 @@ SUBROUTINE CORDCHK ( IERROR ) ! sorting the coord system ID's and then checking the sorted dummy array for uniqueness USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NCORD, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CORD_PROC_BEGEND USE MODEL_STUF, ONLY : CORD IMPLICIT NONE @@ -1188,14 +1176,9 @@ SUBROUTINE CORDCHK ( IERROR ) INTEGER(LONG), INTENT(OUT) :: IERROR ! Count of the number of duplicate coord system ID's INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: DUMCORD(NCORD) ! Dummy array of coord system ID's sorted - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CORD_PROC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Create DUMCORD to be an array of the coordinate system ID's @@ -1222,12 +1205,7 @@ SUBROUTINE CORDCHK ( IERROR ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/DOF_PROC.f90 b/Source/LK1/L1B/DOF_PROC.f90 index 2a22ec27..92ffd249 100644 --- a/Source/LK1/L1B/DOF_PROC.f90 +++ b/Source/LK1/L1B/DOF_PROC.f90 @@ -44,10 +44,9 @@ SUBROUTINE DOF_PROC ( TDOF_MSG ) ! ------ USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFSE, NUM_USETSTR, SOL_NAME USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_PROC_USE_IFs @@ -58,14 +57,9 @@ SUBROUTINE DOF_PROC ( TDOF_MSG ) ! tables are printed out CHARACTER(43*BYTE) :: MODNAM ! Name to write to screen to describe module being run - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Part 1: Generate TSET table @@ -99,12 +93,7 @@ SUBROUTINE DOF_PROC ( TDOF_MSG ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/GRID_PROC.f90 b/Source/LK1/L1B/GRID_PROC.f90 index 501d9d0e..46d48fc3 100644 --- a/Source/LK1/L1B/GRID_PROC.f90 +++ b/Source/LK1/L1B/GRID_PROC.f90 @@ -39,11 +39,10 @@ SUBROUTINE GRID_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : CONV_DEG_RAD - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1B, OP2, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1B, OP2, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, FATAL_ERR, MCORD, MRCORD, MGRID, MRGRID, NCORD, NGRID USE PARAMS, ONLY : PRTBASIC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GRID_PROC_BEGEND USE MODEL_STUF, ONLY : GRID, RGRID, GRID_ID, GRID_SEQ, CORD, RCORD, TN USE GRID_PROC_USE_IFs @@ -59,7 +58,7 @@ SUBROUTINE GRID_PROC INTEGER(LONG) :: IERROR ! Error count INTEGER(LONG) :: JCORD ! Internal coord sys ID INTEGER(LONG) :: JFLD ! Used in error message to indicate a coord sys ID undefined - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GRID_PROC_BEGEND + REAL(DOUBLE) :: ANG1 ! An angle in a cyl or sph coord sys from the RGRID array REAL(DOUBLE) :: ANG2 ! An angle in a cyl or sph coord sys from the RGRID array @@ -71,12 +70,7 @@ SUBROUTINE GRID_PROC INTRINSIC :: DCOS, DSIN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -310,12 +304,7 @@ SUBROUTINE GRID_PROC CALL WRITE_GRID_COORDS ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/OU4_PARTVEC_PROC.f90 b/Source/LK1/L1B/OU4_PARTVEC_PROC.f90 index 2cba27e8..6c096072 100644 --- a/Source/LK1/L1B/OU4_PARTVEC_PROC.f90 +++ b/Source/LK1/L1B/OU4_PARTVEC_PROC.f90 @@ -46,12 +46,11 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L1V, L1V_MSG, LINK1V + USE IOUNT1, ONLY : ERR, F06, L1V, L1V_MSG, LINK1V USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MTSET, NDOFG, NGRID, NUM_PARTVEC_RECORDS, WARN_ERR USE CONSTANTS_1, ONLY : ZERO, ONE, TWO USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : OU4_PARTVEC_PROC_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN, TDOF, TDOFI, TDOF_ROW_START USE OUTPUT4_MATRICES, ONLY : ACT_OU4_MYSTRAN_NAMES, OU4_PART_VEC_NAMES, OU4_PARTVEC_COL, OU4_PARTVEC_ROW, & OU4_MAT_ROW_GRD_COMP, OU4_MAT_COL_GRD_COMP @@ -139,14 +138,9 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO INTEGER(LONG) :: TDOF_COL(2) ! Col number in TDOF/TDOFI where CHAR_SET set data exists INTEGER(LONG), INTENT(OUT) :: VAL_COLS ! Number to enter into PARTVEC_COL for a col that is to be partitioned INTEGER(LONG), INTENT(OUT) :: VAL_ROWS ! Number to enter into PARTVEC_ROW for a row that is to be partitioned - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OU4_PARTVEC_PROC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -255,13 +249,13 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO FOUND_PART_VEC(I) = 'N' - CALL FILE_OPEN ( L1V, LINK1V, OUNT, 'OLD', L1V_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1V, LINK1V, OUNT, 'OLD', L1V_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) j_do1: DO J=1,NUM_PARTVEC_RECORDS READ(L1V,IOSTAT=IOCHK) VNAME, ICOMP, GRID1, GRID2 REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1V, L1V_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1V, L1V_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading PARTVEC file . No sense continuing ENDIF @@ -292,7 +286,7 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO DO GRID_NUM=GRID1,GRID2 ! GRID2 >= GRID1 was checked in subr BD_SPC1 CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, GRID_ID_ROW_NUM ) IF (GRID_ID_ROW_NUM /= -1) THEN - CALL GET_GRID_NUM_COMPS ( GRID(GRID_ID_ROW_NUM,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS ! Put data in PSET IF (CDOF(K) == '1') THEN IF ((PSET(GRID_ID_ROW_NUM,K,I) == '--') .OR. (PSET(GRID_ID_ROW_NUM,K,I) == PSET_CHAR(I))) THEN @@ -318,7 +312,7 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO ENDIF ENDDO j_do1 - CALL FILE_CLOSE ( L1V, LINK1V, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1V, LINK1V, 'KEEP' ) IF (FOUND_PART_VEC(I) == 'N') THEN @@ -341,7 +335,7 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO IF (NDIM_F(I) > 0) THEN DO K=1,NGRID IGRID = INV_GRID_SEQ(K) - CALL GET_GRID_NUM_COMPS ( GRID_ID(IGRID), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (PSET(IGRID,J,I) == PSET_CHAR(I)) THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -404,12 +398,7 @@ SUBROUTINE OU4_PARTVEC_PROC ( INDEX, OU4_MAT_NAME, NROWS_F, NCOLS_F, ROW_SET, CO CALL GET_OU4_PART_GRD_COMP -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/RDOF.f90 b/Source/LK1/L1B/RDOF.f90 index 585b2708..fc446f96 100644 --- a/Source/LK1/L1B/RDOF.f90 +++ b/Source/LK1/L1B/RDOF.f90 @@ -31,10 +31,9 @@ SUBROUTINE RDOF ( INTDOF, CDOF ) ! Bulk Data card are checked by subr IP6CHK for validity when the bulk data was read. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RDOF_BEGEND USE RDOF_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE RDOF ( INTDOF, CDOF ) INTEGER(LONG), INTENT(IN) :: INTDOF ! Integer field which should contain only the digits 1 - 6 INTEGER(LONG) :: I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RDOF_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize CDOF @@ -87,12 +81,7 @@ SUBROUTINE RDOF ( INTDOF, CDOF ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/SEQ_PROC.f90 b/Source/LK1/L1B/SEQ_PROC.f90 index 19cc17e3..0940d4a9 100644 --- a/Source/LK1/L1B/SEQ_PROC.f90 +++ b/Source/LK1/L1B/SEQ_PROC.f90 @@ -29,14 +29,13 @@ SUBROUTINE SEQ_PROC ! Generates the grid point sequence order. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SEQ, L1B - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, SEQFIL - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, SEQSTAT + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SEQ, L1B + USE IOUNT1, ONLY : WRT_ERR, SEQFIL + USE IOUNT1, ONLY : WRT_ERR, SEQSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, FATAL_ERR, NGRID, NSEQ, PROG_NAME, WARN_ERR USE PARAMS, ONLY : EPSIL, GRIDSEQ USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : SEQ_PROC_BEGEND USE MODEL_STUF, ONLY : GRID_ID, GRID_SEQ, INV_GRID_SEQ, SEQ1, SEQ2 USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -53,19 +52,14 @@ SUBROUTINE SEQ_PROC INTEGER(LONG) :: TMP_GRID_ID(NGRID)! Set to array GRID_ID for aid in sorting GRID_SEQ INTEGER(LONG) :: TMP_GRD_SEQ(NGRID)! Set to array GRID_SEQ so we can sort it and get array INV_GRID_SEQ ! without disturbing GRID_SEQ sequence - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SEQ_PROC_BEGEND + REAL(DOUBLE) :: R_GSEQ(NGRID) ! Real sequence numbers (since SEQGP cards can have real no's). In the ! end, the sequence array that will be used is integer array GRID_SEQ INTRINSIC :: DBLE -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Coming in to this subr, GRID_SEQ is in the order of the grids as read in the input data deck. @@ -240,12 +234,7 @@ SUBROUTINE SEQ_PROC WRITE(L1B) SEQ1(I),SEQ2(I) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -284,13 +273,12 @@ SUBROUTINE AUTO_SEQ_PROC ! Reads SEQGP card images from bandit output file (filename.SEQ) using subr BD_SEQGP which creates SEQ1, SEQ2 arrays from SEQGP info USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, sc1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, sc1 USE SCONTR, ONLY : BANDIT_ERR, BD_ENTRY_LEN, BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN, LSEQ, NGRID, NSEQ, & PROG_NAME, WARN_ERR USE TIMDAT, ONLY : STIME, TSEC USE MODEL_STUF, ONLY : GRID_ID USE PARAMS, ONLY : GRIDSEQ, SEQPRT, SEQQUIT, SUPINFO - USE SUBR_BEGEND_LEVELS, ONLY : SEQ_PROC_BEGEND IMPLICIT NONE @@ -318,16 +306,11 @@ SUBROUTINE AUTO_SEQ_PROC INTEGER(LONG) :: OUNT(2) ! File units to write messages to INTEGER(LONG) :: REC_NO = 0 ! Indicator of record number when error encountered reading file INTEGER(LONG) :: XTIME ! Time stamp read from a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SEQ_PROC_BEGEND + 1 + INTRINSIC :: DBLE, INT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF (BANDIT_ERR /= 0) THEN @@ -352,7 +335,7 @@ SUBROUTINE AUTO_SEQ_PROC IERR0 = 0 ! Open SEQ file, read and check STIME OPEN (SEQ,FILE=SEQFIL,STATUS='OLD',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SEQFIL, OUNT, 'Y' ) + CALL OPNERR ( IOCHK, SEQFIL, OUNT ) IERR0 = IERR0 +1 IF (IOCHK < 0) THEN ! File cannot be opened WRITE(ERR,9991) SEQFIL, GRIDSEQ @@ -373,11 +356,11 @@ SUBROUTINE AUTO_SEQ_PROC READ(SEQ,'(1X,I11)',IOSTAT=IOCHK) XTIME IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, SEQFIL, 'STIME', REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, SEQFIL, 'STIME', REC_NO, OUNT ) IERR0 = IERR0 + 1 ELSE ! No error reading XTIME, so check XTIME = STIME IF (XTIME /= STIME) THEN - CALL STMERR ( XTIME, SEQFIL, OUNT, 'Y' ) + CALL STMERR ( XTIME, SEQFIL, OUNT ) IERR0 = IERR0 + 1 ENDIF ENDIF @@ -397,7 +380,7 @@ SUBROUTINE AUTO_SEQ_PROC IF (IOCHK < 0) THEN ! EOF/EOR so exit EXIT ELSE IF (IOCHK > 0) THEN ! Error reading a SEQGP card - CALL READERR ( IOCHK, SEQFIL, 'SEQGP cards', REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, SEQFIL, 'SEQGP cards', REC_NO, OUNT ) IERR1 = IERR1 + 1 ELSE ! READ was OK so process record IF (CARD(1:5) == 'SEQGP ') THEN ! If SEQGP image, call BD_SEQGP to read it and to add to SEQ1,2 arrays @@ -545,11 +528,11 @@ SUBROUTINE AUTO_SEQ_PROC READ(SEQ,'(1X,I11)',IOSTAT=IOCHK) XTIME IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, SEQFIL, 'STIME', REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, SEQFIL, 'STIME', REC_NO, OUNT ) IERR1 = IERR1 + 1 ELSE ! No error reading XTIME, so check XTIME = STIME IF (XTIME /= STIME) THEN - CALL STMERR ( XTIME, SEQFIL, OUNT, 'Y' ) + CALL STMERR ( XTIME, SEQFIL, OUNT ) IERR1 = IERR1 + 1 ENDIF ENDIF @@ -571,7 +554,7 @@ SUBROUTINE AUTO_SEQ_PROC ENDIF - CALL FILE_CLOSE ( SEQ, SEQFIL, SEQSTAT, 'Y' ) + CALL FILE_CLOSE ( SEQ, SEQFIL, SEQSTAT ) ELSE @@ -595,12 +578,7 @@ SUBROUTINE AUTO_SEQ_PROC ENDIF exist -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -670,7 +648,7 @@ SUBROUTINE AUTO_SEQ_PROC_WRAPUP ( SUBR_NAME, CLOSE_STAT ) ! Writes message for subr AUTO_SEQ_PROC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : SEQQUIT IMPLICIT NONE @@ -679,7 +657,7 @@ SUBROUTINE AUTO_SEQ_PROC_WRAPUP ( SUBR_NAME, CLOSE_STAT ) CHARACTER(LEN=*), INTENT(IN) :: CLOSE_STAT ! Status for closing SEQFIL ! ********************************************************************************************************************************** - CALL FILE_CLOSE ( SEQ, SEQFIL, CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( SEQ, SEQFIL, CLOSE_STAT ) IF (SEQQUIT == 'Y') THEN WRITE(ERR,8881) SUBR_NAME, SEQQUIT diff --git a/Source/LK1/L1B/TDOF_COL_NUM.f90 b/Source/LK1/L1B/TDOF_COL_NUM.f90 index 3a468840..00936129 100644 --- a/Source/LK1/L1B/TDOF_COL_NUM.f90 +++ b/Source/LK1/L1B/TDOF_COL_NUM.f90 @@ -29,10 +29,9 @@ SUBROUTINE TDOF_COL_NUM ( CHAR_SET, COL_NUM ) ! Converts character representation of displ set (G, N, F, etc) to a column number in array TDOF USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MTDOF, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TDOF_COL_NUM_BEGEND USE TDOF_COL_NUM_USE_IFs @@ -43,14 +42,9 @@ SUBROUTINE TDOF_COL_NUM ( CHAR_SET, COL_NUM ) INTEGER(LONG), INTENT(OUT) :: COL_NUM ! Col number in array TDOF where displ set CHAR_SET exists INTEGER(LONG), PARAMETER :: OFFSET = 4 ! Columns of TDOF prior to where the G-set begins - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TDOF_COL_NUM_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -92,12 +86,7 @@ SUBROUTINE TDOF_COL_NUM ( CHAR_SET, COL_NUM ) CALL OUTA_HERE ( 'Y' ) ! Coding error, so quit ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/TDOF_PROC.f90 b/Source/LK1/L1B/TDOF_PROC.f90 index 47e92afa..abb9dff1 100644 --- a/Source/LK1/L1B/TDOF_PROC.f90 +++ b/Source/LK1/L1B/TDOF_PROC.f90 @@ -62,13 +62,12 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LDOFG, MTDOF, NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, NDOFN, NDOFO, & NDOFR, NDOFS, NDOFSA, NDOFSB, NDOFSE, NDOFSG, NDOFSZ, NGRID, NUM_USET_U1, NUM_USET_U2, & SOL_NAME, WARN_ERR USE PARAMS, ONLY : EIGESTL, PRTDOF USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET, TDOF, TDOFI, TDOF_ROW_START, USET USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : EIG_N2, GRID, GRID_ID, GRID_SEQ, INV_GRID_SEQ @@ -105,14 +104,9 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) INTEGER(LONG) :: IGRID ! Internal grid number INTEGER(LONG) :: IROW ! Row number in array TDOF or TDOFI INTEGER(LONG) :: NUM_COMPS ! Number of displ components (1 for SPOINT, 6 for physical grid) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** WRITE(SC1, * ) ' TDOF PROC' @@ -150,7 +144,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) IROW = 0 CALL COUNTER_INIT(' Process col 1-4 of TDOF', NGRID) DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS IROW = IROW + 1 TDOF(IROW,1) = GRID_ID(I) @@ -168,7 +162,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 NDOFG = NDOFG + 1 @@ -194,7 +188,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process M -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'M ') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -213,7 +207,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SA-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'SA') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -232,7 +226,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SB-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'SB') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -251,7 +245,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SG-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'SG') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -270,7 +264,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SE-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'SE') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -289,7 +283,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process O -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'O ') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -308,7 +302,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process R -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (TSET(IGRID,J) == 'R ') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -326,7 +320,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process N -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,G_SET_COL) > 0) .AND. (TDOF(IROW,M_SET_COL) == 0)) THEN @@ -346,7 +340,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process SZ-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,SA_SET_COL) > 0) .OR. (TDOF(IROW,SB_SET_COL) > 0) .OR. (TDOF(IROW,SG_SET_COL) > 0)) THEN @@ -367,7 +361,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process S -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,SZ_SET_COL) > 0) .OR. (TDOF(IROW,SE_SET_COL) > 0)) THEN @@ -387,7 +381,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process F -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,N_SET_COL) > 0) .AND. (TDOF(IROW,S_SET_COL) == 0)) THEN @@ -406,7 +400,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process A -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,F_SET_COL) > 0) .AND. (TDOF(IROW,O_SET_COL) == 0)) THEN @@ -425,7 +419,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process L -set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IROW = TDOF_ROW_START(IGRID) + J - 1 IF ((TDOF(IROW,A_SET_COL) > 0) .AND. (TDOF(IROW,R_SET_COL) == 0)) THEN @@ -445,7 +439,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process U1-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (USET(IGRID,J) == 'U1') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -464,7 +458,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) CALL COUNTER_INIT(' Process U2-set ', NGRID) DO I=1,NGRID IGRID = INV_GRID_SEQ(I) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS IF (USET(IGRID,J) == 'U2') THEN IROW = TDOF_ROW_START(IGRID) + J - 1 @@ -533,12 +527,7 @@ SUBROUTINE TDOF_PROC ( TDOF_MSG ) !xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,*) CR13 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/TSET_PROC.f90 b/Source/LK1/L1B/TSET_PROC.f90 index ae2da1fa..11c7c928 100644 --- a/Source/LK1/L1B/TSET_PROC.f90 +++ b/Source/LK1/L1B/TSET_PROC.f90 @@ -70,12 +70,11 @@ SUBROUTINE TSET_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID, NAOCARD, NUM_SUPT_CARDS, & NDOFL, NDOFM, NDOFO, NDOFR, NDOFS, NDOFSA, NDOFSG, NDOFSB, NDOFSE, NDOFSZ USE PARAMS, ONLY : PRTTSET USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET USE MODEL_STUF, ONLY : GRID @@ -89,14 +88,9 @@ SUBROUTINE TSET_PROC INTEGER(LONG) :: I,K ! DO loop indices INTEGER(LONG) :: IERRT = 0 ! Sum of all grid and DOF errors INTEGER(LONG) :: NUM_COMPS ! Number of displ components (1 for SPOINT, 6 for physical grid) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -106,7 +100,7 @@ SUBROUTINE TSET_PROC WRITE(SC1,12345,ADVANCE='NO') ' Initializing ', CR13 DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 1) THEN DO K=2,6 TSET(I,K) = '--' @@ -141,7 +135,7 @@ SUBROUTINE TSET_PROC NDOFO = 0 IF (NAOCARD == 0) THEN ! If no ASET,1/OMIT,1 cards, then, for time being, set all remaining DOF DO I = 1,NGRID ! to A-set (if there are SUPORT's some will get changed to R set below) - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS IF (TSET(I,K) == ' ') THEN TSET(I,K) = 'A ' @@ -207,12 +201,7 @@ SUBROUTINE TSET_PROC CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/TSET_PROC_FOR_MPCS.f90 b/Source/LK1/L1B/TSET_PROC_FOR_MPCS.f90 index 091ded91..1b8cdccc 100644 --- a/Source/LK1/L1B/TSET_PROC_FOR_MPCS.f90 +++ b/Source/LK1/L1B/TSET_PROC_FOR_MPCS.f90 @@ -29,11 +29,10 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) ! DOF Processor for MPC's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1S, L1S_MSG, LINK1S + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1S, L1S_MSG, LINK1S USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LIND_GRDS_MPCS, LMPCADDC, NDOFM, NGRID, NIND_GRDS_MPCS, NMPC, & NMPCADD, NTERM_RMG, NUM_MPCSIDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID_ID, MPC_IND_GRIDS, MPCSET, MPCSIDS @@ -68,16 +67,11 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) INTEGER(LONG) :: OUNT(2) ! File units to write messages to. INTEGER(LONG) :: REC_NO = 0 ! Record number when reading a file INTEGER(LONG) :: SETID ! An SPC set ID read from file LINK1O - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + REAL(DOUBLE) :: RJUNK ! An MPC coeff value read from file LINK1S that we do not need -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -107,14 +101,14 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) READ(L1S,IOSTAT=IOCHK) SETID ! Read the SETID for the i-th logical MPC REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF READ(L1S,IOSTAT=IOCHK) NUM_TRIPLES ! Read the number of triplets of grid/comp/coeff for the i-th logical MPC REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF @@ -138,7 +132,7 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF ! Get the row number, in array GRID_ID, for dependent grid, AGRID_D @@ -154,7 +148,7 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) READ(L1S,IOSTAT=IOCHK) AGRID_I, IJUNK, RJUNK REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF IF (AGRID_I /= AGRID_I_PREV) THEN @@ -196,7 +190,7 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) READ(L1S,IOSTAT=IOCHK) IJUNK, IJUNK, RJUNK REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF ENDDO @@ -206,12 +200,7 @@ SUBROUTINE TSET_PROC_FOR_MPCS ( IERRT ) IERRT = IERRT + GID_ERR + DOF_ERR -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 b/Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 index e9a897c7..f4e593b8 100644 --- a/Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 +++ b/Source/LK1/L1B/TSET_PROC_FOR_OMITS.f90 @@ -29,10 +29,9 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) ! DOF Processor for MPC's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1N, L1N_MSG, LINK1N + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1N, L1N_MSG, LINK1N USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NAOCARD, NDOFO, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID @@ -58,14 +57,9 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) INTEGER(LONG) :: NUM_COMPS ! Number of displ components (1 for SPOINT, 6 for physical grid) INTEGER(LONG) :: OUNT(2) ! File units to write messages to. INTEGER(LONG) :: REC_NO = 0 ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -93,7 +87,7 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) READ(L1N,IOSTAT=IOCHK) ICOMP,GID1,GID2,DOFSET ! Read a record from L1N REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1N, L1N_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1N, L1N_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading ASET/OMIT file. No sense continuing ENDIF @@ -131,7 +125,7 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) DO J=GID1,GID2 ! GID2 > GID1 was checked when ASET/OMIT B.D. cards were read CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, J, GRID_ID_ROW_NUM ) IF (GRID_ID_ROW_NUM /= -1) THEN - CALL GET_GRID_NUM_COMPS ( GRID(GRID_ID_ROW_NUM,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS IF (CDOF1(K) == '1') THEN IF ((TSET(GRID_ID_ROW_NUM,K) == ' ') .OR. (TSET(GRID_ID_ROW_NUM,K) == DOFSET)) THEN @@ -155,7 +149,7 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) IF ((ASET_FND == 'Y').AND.(OMIT_FND == 'N')) THEN ! Make all DOF's not as yet set be O-set DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO K=1,NUM_COMPS IF (TSET(I,K) == ' ') THEN TSET(I,K) = 'O ' @@ -167,7 +161,7 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) IF ((ASET_FND == 'N').AND.(OMIT_FND == 'Y')) THEN ! Make all DOF's not as yet set be A-set DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO K=1,NUM_COMPS IF (TSET(I,K) == ' ') THEN TSET(I,K) = 'A ' @@ -180,12 +174,7 @@ SUBROUTINE TSET_PROC_FOR_OMITS ( IERRT ) IERRT = IERRT + GID_ERR + DOF_ERR -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/TSET_PROC_FOR_RIGELS.f90 b/Source/LK1/L1B/TSET_PROC_FOR_RIGELS.f90 index 9f1f2caa..a452bdb8 100644 --- a/Source/LK1/L1B/TSET_PROC_FOR_RIGELS.f90 +++ b/Source/LK1/L1B/TSET_PROC_FOR_RIGELS.f90 @@ -29,10 +29,9 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) ! DOF Processor for rigid elements (incl RBE3 and RSPLINE) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L1F, L1F_MSG, LINK1F + USE IOUNT1, ONLY : ERR, F06, L1F, L1F_MSG, LINK1F USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LIND_GRDS_MPCS, NDOFM, NGRID, NIND_GRDS_MPCS, NRECARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID, MPC_IND_GRIDS @@ -80,16 +79,11 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) INTEGER(LONG) :: REFC ! Dependent components on RBE3 INTEGER(LONG) :: REFGRID ! Dependent grid on RBE3 INTEGER(LONG) :: REID ! Rigid elem ID read from file LINK1F - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + REAL(DOUBLE) :: RDUM ! Real value read that is not used -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -109,7 +103,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) READ(L1F,IOSTAT=IOCHK) RTYPE REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading rigid elem file. No sense continuing ENDIF @@ -120,7 +114,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) READ(L1F,IOSTAT=IOCHK) REID,GID1,IDUM(1),DDOF1,GID2,IDUM(2),DDOF2 REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading rigid elem file. No sense continuing ENDIF ! Check for existence of grid pt. GID1 @@ -206,7 +200,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) READ(L1F,IOSTAT=IOCHK) REID,AGRID_D,COMPS_D,NUMI,(AGRIDI_I(J),IDUM(J),J=1,NUMI) REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading rigid elem file. No sense continuing ENDIF @@ -264,7 +258,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) ENDIF REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading rigid elem file. No sense continuing ENDIF ! Check for existence of dependent grid, AGRID_D @@ -314,7 +308,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) READ(L1F,IOSTAT=IOCHK) REID, REFGRID, REFC, IRBE3, RDUM REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading rigid elem file. No sense continuing ENDIF ! Check for existence of dependent grid, REFGRID @@ -330,7 +324,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) READ(L1F) AGRID_I, IDUM(1), RDUM REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading rigid elem file. No sense continuing ENDIF CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I, GRID_ID_ROW_NUM_I ) @@ -388,7 +382,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading rigid elem file. No sense continuing ENDIF ! Check for existence of dependent grid, AGRID_D @@ -453,12 +447,7 @@ SUBROUTINE TSET_PROC_FOR_RIGELS ( IERRT ) IERRT = IERRT + GID_ERR + DOF_ERR -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 b/Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 index 2e0114fe..fac3f026 100644 --- a/Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 +++ b/Source/LK1/L1B/TSET_PROC_FOR_SPCS.f90 @@ -30,11 +30,10 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) ! DOF Processor for SPC's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1H, L1O, L1O_MSG, LINK1O + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1H, L1O, L1O_MSG, LINK1O USE SCONTR, ONLY : BLNK_SUB_NAM, ENFORCED, FATAL_ERR, LSPCADDC, NDOFSB, NDOFSE, NDOFSG, NGRID, NSPCADD, & NUM_SPC_RECORDS, NUM_SPC1_RECORDS, NUM_SPCSIDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE PARAMS, ONLY : EPSIL USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID, SPCADD_SIDS, SPCSET, SPCSIDS @@ -60,17 +59,12 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) INTEGER(LONG) :: OUNT(2) ! File units to write messages to. INTEGER(LONG) :: REC_NO = 0 ! Record number when reading a file INTEGER(LONG) :: SETID ! An SPC set ID read from file LINK1O - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: RSPC ! SPC displ value (nonzero's are enforced displ's) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -90,7 +84,7 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) DO I=1,NGRID IF (GRID(I,4) /= 0) THEN CALL RDOF ( GRID(I,4), CDOF ) - CALL GET_GRID_NUM_COMPS ( GRID(I,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS IF (CDOF(K) == '1') THEN IF ((TSET(I,K) == ' ') .OR. (TSET(I,K) == 'SB')) THEN @@ -159,7 +153,7 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) READ(L1O,IOSTAT=IOCHK) SETID, ICOMP, GRID1, GRID2, RSPC, DOFSET REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1O, L1O_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1O, L1O_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading SPC file . No sense continuing ENDIF @@ -201,7 +195,7 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) DO GRID_NUM=GRID1,GRID2 ! GRID2 >= GRID1 was checked in subr BD_SPC1 CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, GRID_ID_ROW_NUM ) IF (GRID_ID_ROW_NUM /= -1) THEN - CALL GET_GRID_NUM_COMPS ( GRID(GRID_ID_ROW_NUM,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS ! Put data in TSET and write enforced displ to L1H. IF (CDOF(K) == '1') THEN IF (DOFSET == 'SE') THEN @@ -257,12 +251,7 @@ SUBROUTINE TSET_PROC_FOR_SPCS ( IERRT ) IERRT = IERRT + GID_ERR + DOF_ERR -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/TSET_PROC_FOR_SUPORTS.f90 b/Source/LK1/L1B/TSET_PROC_FOR_SUPORTS.f90 index 473a35e4..bf85b584 100644 --- a/Source/LK1/L1B/TSET_PROC_FOR_SUPORTS.f90 +++ b/Source/LK1/L1B/TSET_PROC_FOR_SUPORTS.f90 @@ -29,10 +29,9 @@ SUBROUTINE TSET_PROC_FOR_SUPORTS ( IERRT ) ! DOF Processor for SUPORT's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1T, L1T_MSG, LINK1T + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1T, L1T_MSG, LINK1T USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NGRID, NUM_SUPT_CARDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : DOF_PROC_BEGEND USE PARAMS, ONLY : EPSIL USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID @@ -55,14 +54,9 @@ SUBROUTINE TSET_PROC_FOR_SUPORTS ( IERRT ) INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening or reading a file INTEGER(LONG) :: OUNT(2) ! File units to write messages to. INTEGER(LONG) :: REC_NO = 0 ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DOF_PROC_BEGEND + 1 + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -83,7 +77,7 @@ SUBROUTINE TSET_PROC_FOR_SUPORTS ( IERRT ) READ(L1T,IOSTAT=IOCHK) GRID_NUM, ICOMP REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1T, L1T_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1T, L1T_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading SUPORT data file . No sense continuing ENDIF @@ -118,12 +112,7 @@ SUBROUTINE TSET_PROC_FOR_SUPORTS ( IERRT ) IERRT = IERRT + GID_ERR + DOF_ERR -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1B/USET_PROC.f90 b/Source/LK1/L1B/USET_PROC.f90 index 219e5446..a8eb14e4 100644 --- a/Source/LK1/L1B/USET_PROC.f90 +++ b/Source/LK1/L1B/USET_PROC.f90 @@ -46,10 +46,9 @@ SUBROUTINE USET_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L1X, L1X_MSG, LINK1X + USE IOUNT1, ONLY : ERR, F06, L1X, L1X_MSG, LINK1X USE SCONTR, ONLY : BLNK_SUB_NAM, ENFORCED, FATAL_ERR, NGRID, NUM_USET_RECORDS, NUM_USET_U1, NUM_USET_U2 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : USET_PROC_BEGEND USE PARAMS, ONLY : EPSIL USE DOF_TABLES, ONLY : TSET_CHR_LEN, USET USE MODEL_STUF, ONLY : GRID, GRID_ID @@ -74,14 +73,9 @@ SUBROUTINE USET_PROC INTEGER(LONG) :: NUM_COMPS ! Number of displ components (1 for SPOINT, 6 for physical grid) INTEGER(LONG) :: OUNT(2) ! File units to write messages to. INTEGER(LONG) :: REC_NO = 0 ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = USET_PROC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -110,14 +104,14 @@ SUBROUTINE USET_PROC ! Process USET data from file L1X (data written when USET and USET1 Bulk Data entries were read) - CALL FILE_OPEN ( L1X, LINK1X, OUNT, 'OLD', L1X_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1X, LINK1X, OUNT, 'OLD', L1X_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) i_do6:DO I=1,NUM_USET_RECORDS READ(L1X,IOSTAT=IOCHK) SNAME, ICOMP, GRID1, GRID2 REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1X, L1X_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1X, L1X_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading SPC file . No sense continuing ENDIF @@ -153,7 +147,7 @@ SUBROUTINE USET_PROC DO GRID_NUM=GRID1,GRID2 ! GRID2 >= GRID1 was checked in subr BD_SPC1 CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, GRID_ID_ROW_NUM ) IF (GRID_ID_ROW_NUM /= -1) THEN - CALL GET_GRID_NUM_COMPS ( GRID(GRID_ID_ROW_NUM,1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS ! Put data in USET and write enforced displ to L1H. IF (CDOF(J) == '1') THEN IF (SNAME == 'U1') THEN @@ -198,12 +192,7 @@ SUBROUTINE USET_PROC CALL WRITE_USET -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/CONM2_PROC_1.f90 b/Source/LK1/L1C/CONM2_PROC_1.f90 index f20cc555..cb540c69 100644 --- a/Source/LK1/L1C/CONM2_PROC_1.f90 +++ b/Source/LK1/L1C/CONM2_PROC_1.f90 @@ -34,13 +34,12 @@ SUBROUTINE CONM2_PROC_1 ! overwritten with the values in basic coords at the mass point at the close of this subr. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1Y + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1Y USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, FATAL_ERR, MCMASS, MCONM2, MPMASS, MRCONM2, MRPMASS, NCMASS, & NCONM2, NCORD, NGRID, NPMASS, WARN_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CONM2_PROC_1_BEGEND USE MODEL_STUF, ONLY : CMASS, CONM2, PMASS, RCONM2, RPMASS, GRID, GRID_ID, CORD USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -65,7 +64,7 @@ SUBROUTINE CONM2_PROC_1 INTEGER(LONG) :: NROWA ! No. rows in a matrix. For subr MATMULT_FFF/MATMULT_FFF_T, called herein INTEGER(LONG) :: NUM_COMPS ! No. displ components (1 for SPOINT, 6 for actual grid) INTEGER(LONG) :: NUM_RCONM2_RESET ! No. RCONM2's reset to zero because they are connected to SPOINT's - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CONM2_PROC_1_BEGEND + REAL(DOUBLE) :: DX_0 ! Offset of mass from grid in basic coord sys X direction REAL(DOUBLE) :: DY_0 ! Offset of mass from grid in basic coord sys Y direction @@ -101,12 +100,7 @@ SUBROUTINE CONM2_PROC_1 REAL(DOUBLE) :: T_0_CID(3,3) ! Transformation matrix from coord ACID to basic REAL(DOUBLE) :: T_CID_0(3,3) ! Transformation matrix from basic to coord ACID (transp of T_0_CID) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! For all SPOINT's reset all RCONM2 values back to zero (so that scalar points will not use offset and MOI terms) @@ -123,7 +117,7 @@ SUBROUTINE CONM2_PROC_1 WRITE(F06,1822) 'GRID ', AGRID, NAME, CONM2(I,1) ENDIF IF (IERROR == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 1) THEN NUM_RCONM2_RESET = NUM_RCONM2_RESET + 1 DO J=2,MRCONM2 ! Keep mass but reset offsets amd MOI's to zero for SPOINT's @@ -329,12 +323,7 @@ SUBROUTINE CONM2_PROC_1 ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/CONM2_PROC_2.f90 b/Source/LK1/L1C/CONM2_PROC_2.f90 index f73f069c..f984a82a 100644 --- a/Source/LK1/L1C/CONM2_PROC_2.f90 +++ b/Source/LK1/L1C/CONM2_PROC_2.f90 @@ -35,10 +35,9 @@ SUBROUTINE CONM2_PROC_2 ! RCONM2 in global coords at the grid is needed for the mass matrix generation subr, MGG_MASS_MATRIX. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCONM2, NCORD, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CONM2_PROC_2_BEGEND USE MODEL_STUF, ONLY : CONM2, RCONM2, GRID, GRID_ID, CORD USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -60,7 +59,7 @@ SUBROUTINE CONM2_PROC_2 INTEGER(LONG) :: NCOLA ! No. cols in a matrix. For subr MATMULT_FFF/MATMULT_FFF_T, called herein INTEGER(LONG) :: NCOLB ! No. cols in a matrix. For subr MATMULT_FFF/MATMULT_FFF_T, called herein INTEGER(LONG) :: NROWA ! No. rows in a matrix. For subr MATMULT_FFF/MATMULT_FFF_T, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CONM2_PROC_2_BEGEND + REAL(DOUBLE) :: DX_0 ! Offset of mass from grid in basic coord sys X direction REAL(DOUBLE) :: DY_0 ! Offset of mass from grid in basic coord sys Y direction @@ -101,12 +100,7 @@ SUBROUTINE CONM2_PROC_2 REAL(DOUBLE) :: PHID, THETAD ! Outputs from subr GEN_T0L REAL(DOUBLE) :: T_0_G(3,3) ! Transformation matrix from global to basic -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** outer:DO I = 1,NCONM2 @@ -263,12 +257,7 @@ SUBROUTINE CONM2_PROC_2 CALL OUTA_HERE ( 'Y' ) ! Quit due to undefined grid and coord sys ID's ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/ELEM_PROP_MATL_IIDS.f90 b/Source/LK1/L1C/ELEM_PROP_MATL_IIDS.f90 index 372f577e..a1a7aca4 100644 --- a/Source/LK1/L1C/ELEM_PROP_MATL_IIDS.f90 +++ b/Source/LK1/L1C/ELEM_PROP_MATL_IIDS.f90 @@ -31,12 +31,11 @@ SUBROUTINE ELEM_PROP_MATL_IIDS ! can be accessed sequentially. This subr performs that function. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN4FIL_NUM, NUM_IN4_FILES, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN4FIL_NUM, NUM_IN4_FILES USE SCONTR, ONLY : BLNK_SUB_NAM, DEDAT_Q4_SHELL_KEY, DEDAT_T3_SHELL_KEY, DEDAT_Q8_SHELL_KEY, FATAL_ERR, & MPCOMP0, MPCOMP_PLIES, NCMASS, NELE, NMATL, NPBAR, NPBEAM, & NPBUSH, NPCOMP, NPELAS, NPMASS, NPROD, npshear, NPSHEL, NPSOLID, NPUSER1, NPUSERIN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELEM_PROP_MATL_IIDS_BEGEND USE MODEL_STUF, ONLY : CMASS, ETYPE, EPNT, EDAT, PELAS, PROD, PBAR, PBEAM, PBUSH, PCOMP, PMASS, PSHEAR, & PSHEL, PSOLID, PUSER1, PUSERIN, MATL @@ -62,14 +61,9 @@ SUBROUTINE ELEM_PROP_MATL_IIDS INTEGER(LONG) :: PCOMP_INDEX ! Index into PCOMP array INTEGER(LONG) :: PCOMP_PLIES ! Number of plies in PCOMP array INTEGER(LONG) :: PROPERTY_ID ! Property ID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELEM_PROP_MATL_IIDS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** PROPERTY_NAME = ' ' @@ -533,12 +527,7 @@ SUBROUTINE ELEM_PROP_MATL_IIDS CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/ELEM_TRANSFORM_LBG.f90 b/Source/LK1/L1C/ELEM_TRANSFORM_LBG.f90 index 83409594..81e3fe2c 100644 --- a/Source/LK1/L1C/ELEM_TRANSFORM_LBG.f90 +++ b/Source/LK1/L1C/ELEM_TRANSFORM_LBG.f90 @@ -34,10 +34,9 @@ SUBROUTINE ELEM_TRANSFORM_LBG ( WHICH, ZE, QE ) ! data) in global coordinates and the BUSH in a unique system USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MELDOF, NCORD, NGRID, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELEM_TRANSFORM_LBG_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : AGRID, CORD, ELDOF, GRID, GRID_ID, KEG, TE_IDENT, TYPE USE MODEL_STUF, ONLY : ELGP @@ -64,7 +63,7 @@ SUBROUTINE ELEM_TRANSFORM_LBG ( WHICH, ZE, QE ) INTEGER(LONG) :: NCOL_IN ! Number of cols in matrix being transformed INTEGER(LONG), PARAMETER :: NROW_GET = 3 ! An input to subr MATGET/MATPUT (no. rows to get/put) INTEGER(LONG), PARAMETER :: NROWA = 3 ! An input to subr MATMULT_FFF/MATMULT_FFF_T, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELEM_TRANSFORM_LBG_BEGEND + REAL(DOUBLE) , INTENT(INOUT) :: QE(MELDOF,NSUB) ! PTE or PPE if WHICH = 'PTE' or 'PPE' REAL(DOUBLE) , INTENT(INOUT) :: ZE(MELDOF,MELDOF) ! Either the mass or stiff matrix of the element @@ -76,12 +75,7 @@ SUBROUTINE ELEM_TRANSFORM_LBG ( WHICH, ZE, QE ) REAL(DOUBLE) :: TJ(3,3) ! Coord transform matrix from basic to global for an internal REAL(DOUBLE) :: TK(3,3) ! Coord transform matrix from basic to global for an internal grid -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -278,12 +272,7 @@ SUBROUTINE ELEM_TRANSFORM_LBG ( WHICH, ZE, QE ) CALL GET_KE_OFFSET ! Now transform the global KE (with offsets) back to local ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/ELESORT.f90 b/Source/LK1/L1C/ELESORT.f90 index 1d8a5cce..f9274b5a 100644 --- a/Source/LK1/L1C/ELESORT.f90 +++ b/Source/LK1/L1C/ELESORT.f90 @@ -58,10 +58,9 @@ SUBROUTINE ELESORT ! 51 6 | 51 6 30 B1 | 61 5 24 Q2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, ELESORT_RUN, NELE, NRIGEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELESORT_BEGEND USE MODEL_STUF, ONLY : EDAT, EOFF, EPNT, ESORT1, ESORT2, ETYPE, RIGID_ELEM_IDS USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -73,14 +72,9 @@ SUBROUTINE ELESORT INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERROR ! Error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELESORT_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! (1) Generate ESORT1 and ESORT2. Initially, set ESORT1(I) = elem ID's in order read in Bulk Data and ESORT2(I) = I. @@ -152,12 +146,7 @@ SUBROUTINE ELESORT ELESORT_RUN = 'Y' -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/ELSAVE.f90 b/Source/LK1/L1C/ELSAVE.f90 index 3424a346..1444182d 100644 --- a/Source/LK1/L1C/ELSAVE.f90 +++ b/Source/LK1/L1C/ELSAVE.f90 @@ -29,7 +29,7 @@ SUBROUTINE ELSAVE ! Saves element data to file LINK1G. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1G + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1G USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, MMATL, MPBAR, MPBEAM, MPBUSH, MPELAS, MPROD, MPSHEL, & MPSOLID, MPUSER1,MPUSERIN, MRMATLC, MRPBAR, MRPBEAM, MRPBUSH, MRPELAS, MRPROD, MPSHEAR, & MRPSHEAR, MRPSHEL, MRPUSER1, NBAROFF, NBUSHOFF, NEDAT, NELE, NMATANGLE, NMATL, MPCOMP0, & @@ -37,7 +37,6 @@ SUBROUTINE ELSAVE NPELAS, NPLATEOFF, NPLATETHICK, NPROD, NPSHEAR, NPSHEL, NPSOLID, NPUSER1, NPUSERIN, NVVEC USE PARAMS, ONLY : CBMIN3, CBMIN4, IORQ1M, IORQ1S, IORQ1B, IORQ2B, IORQ2T USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELSAVE_BEGEND USE MODEL_STUF, ONLY : BAROFF, BUSHOFF, EDAT, EOFF, EPNT, ESORT1, ESORT2, ETYPE, MATANGLE, MATL, RMATL,PBAR, & RPBAR, PBEAM, RPBEAM, PBUSH, RPBUSH, PCOMP, RPCOMP, PELAS, RPELAS, PROD, RPROD, PSHEAR, & RPSHEAR, PSHEL, RPSHEL, PSOLID, PUSER1, RPUSER1, PUSERIN, PLATEOFF, PLATETHICK, & @@ -51,14 +50,9 @@ SUBROUTINE ELSAVE INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: PCOMP_PLIES ! Number of plies in 1 PCOMP entry incl sym plies not explicitly defined - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELSAVE_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Write element data @@ -331,12 +325,7 @@ SUBROUTINE ELSAVE WRITE(L1G) MATANGLE(I) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/GPWG.f90 b/Source/LK1/L1C/GPWG.f90 index b1a37b98..b73b0863 100644 --- a/Source/LK1/L1C/GPWG.f90 +++ b/Source/LK1/L1C/GPWG.f90 @@ -29,12 +29,11 @@ SUBROUTINE GPWG ( WHICH ) ! Generates rigid body mass properties for the finite element model USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, OP2, SC1, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, OP2, SC1, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_ME_BIT, IBIT, MBUG, NCONM2, NCORD, NELE, NGRID, SOL_NAME, WARN_ERR USE PARAMS, ONLY : EPSIL, GRDPNT, MEFMGRID, MEFMLOC, SUPWARN, WTMASS USE DEBUG_PARAMETERS, ONLY : DEBUG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GPWG_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : AGRID, BGRID, CONM2, CORD, CAN_ELEM_TYPE_OFFSET, ELDT, ELGP, NUM_EMG_FATAL_ERRS, & GRID, GRID_ID, MCG, ME, MEFFMASS_CALC, MEFM_RB_MASS, & @@ -66,7 +65,7 @@ SUBROUTINE GPWG ( WHICH ) INTEGER(LONG) :: NUM_COMPS ! Either 6 or 1 depending on whether grid is a physical grid or a SPOINT INTEGER(LONG) :: REFPNT ! Reference point for GPWG calc (either GRDPNT of MEFMGRID) INTEGER(LONG) :: REFPNT_DEF ! Default value of GRDPNT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GPWG_BEGEND + REAL(DOUBLE) :: BASIC_OFF(3) ! Offsets of an element at a grid in basic coords REAL(DOUBLE) :: EPS1 ! A small number to compare real zero @@ -107,12 +106,7 @@ SUBROUTINE GPWG ( WHICH ) INTRINSIC :: DABS INTRINSIC :: IAND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -216,7 +210,7 @@ SUBROUTINE GPWG ( WHICH ) ENDIF ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(J), NUM_COMPS, SUBR_NAME ) JDOF = NUM_COMPS*(J - 1) + 1 M0 = ME(JDOF,JDOF) MASS = MASS + M0 @@ -583,12 +577,7 @@ SUBROUTINE GPWG ( WHICH ) WRITE(F06,*) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/GPWG_PMOI.f90 b/Source/LK1/L1C/GPWG_PMOI.f90 index e7a5d446..2556a195 100644 --- a/Source/LK1/L1C/GPWG_PMOI.f90 +++ b/Source/LK1/L1C/GPWG_PMOI.f90 @@ -29,13 +29,12 @@ SUBROUTINE GPWG_PMOI (MOI1, Q, INFO ) ! Jacobi solution for 3x3 eigenvalue problem used in finding principal moments of inertia for the Grid Point Weight Generator (GPWG) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : SUPWARN, WTMASS USE LAPACK_STD_EIG_1 - USE SUBR_BEGEND_LEVELS, ONLY : GPWG_BEGEND USE GPWG_PMOI_USE_IFs @@ -55,7 +54,7 @@ SUBROUTINE GPWG_PMOI (MOI1, Q, INFO ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG), PARAMETER :: N = 3 ! Order of matrix MOI1 INTEGER(LONG), PARAMETER :: LWORK = 3*N-1 ! Size of array WORK - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GPWG_BEGEND + 1 + REAL(DOUBLE) , INTENT(INOUT) :: MOI1(3,3) ! On entry, the MOI's about c.g. in basic coords ! On exit , the principal MOI's in basic coords (if INFO = 0) @@ -72,12 +71,7 @@ SUBROUTINE GPWG_PMOI (MOI1, Q, INFO ) EXTERNAL :: DGEMM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -141,12 +135,7 @@ SUBROUTINE GPWG_PMOI (MOI1, Q, INFO ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/GPWG_USERIN.f90 b/Source/LK1/L1C/GPWG_USERIN.f90 index aeae3a29..7155ddd5 100644 --- a/Source/LK1/L1C/GPWG_USERIN.f90 +++ b/Source/LK1/L1C/GPWG_USERIN.f90 @@ -29,11 +29,10 @@ SUBROUTINE GPWG_USERIN ( IEID ) ! Generates rigid body mass properties for one USERIN element USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID, SOL_NAME, WARN_ERR USE PARAMS, ONLY : EPSIL, GRDPNT, MEFMGRID, SUPWARN, WTMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GPWG_USERIN_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : NUM_EMG_FATAL_ERRS, EID, GRID_ID, ME, PLY_NUM, RGRID, USERIN_RBM0 @@ -51,7 +50,7 @@ SUBROUTINE GPWG_USERIN ( IEID ) INTEGER(LONG) :: GRID_ID_ROW_NUM ! Row number in array GRID_ID where an actual grid ID is found INTEGER(LONG) :: INFO = 0 ! An output from subr GPWG_PMOI, called herein INTEGER(LONG) :: GRDPNT_DEF ! Default value of GRDPNT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GPWG_USERIN_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: M0 ! An intermediate variable used in calc model mass props @@ -67,12 +66,7 @@ SUBROUTINE GPWG_USERIN ( IEID ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -262,12 +256,7 @@ SUBROUTINE GPWG_USERIN ( IEID ) WRITE(F06,*) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 b/Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 index c5673a24..f50e5ee0 100644 --- a/Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 +++ b/Source/LK1/L1C/RB_DISP_MATRIX_PROC.f90 @@ -37,12 +37,11 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCORD, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOF, TDOFI, TDOF_ROW_START USE PARAMS, ONLY : EQCHK_REF_GRID, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : RB_DISP_MATRIX_PROC_BEGEND USE MODEL_STUF, ONLY : CORD, GRID, RGRID, GRID_ID, INV_GRID_SEQ, MODEL_XCG, MODEL_YCG, MODEL_ZCG USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -72,7 +71,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) INTEGER(LONG) :: IGRID ! Internal grid ID INTEGER(LONG) :: NUM_COMPS ! 6 if GRID_NUM is an physical grid, 1 if an SPOINT INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RB_DISP_MATRIX_PROC_BEGEND + 1 + REAL(DOUBLE) :: DUM1(6,6) ! Intermediate result in obtaining RB_GRID_GLOBL REAL(DOUBLE) :: DX0 ! X coord difference between grid I and ref grid @@ -92,12 +91,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) REAL(DOUBLE) :: Y0_K ! Basic Y coord of AGRID_I REAL(DOUBLE) :: Z0_K ! Basic Z coord of AGRID_I -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) @@ -136,7 +130,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) WRITE(F06,1408) SUBR_NAME, AGRID_R, 'GRID_ID' CALL OUTA_HERE ( 'Y' ) ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID_R, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_R, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! AGRID_R is a physical grid X0_R = RGRID(GRID_ID_ROW_NUM_R,1) Y0_R = RGRID(GRID_ID_ROW_NUM_R,2) @@ -211,7 +205,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) DO K=1,NGRID AGRID_K = GRID_ID(INV_GRID_SEQ(K)) - CALL GET_GRID_NUM_COMPS ( AGRID_K, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(K), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Only process physical grids. Let rows of RBGLOBAL = 0 otherwise @@ -332,7 +326,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) DO I=1,NGRID AGRID_K = GRID_ID(INV_GRID_SEQ(I)) AGRID = GRID_ID(INV_GRID_SEQ(I)) - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS L = L + 1 IF (J == 1) THEN @@ -346,12 +340,7 @@ SUBROUTINE RB_DISP_MATRIX_PROC ( REF_PT_TXT, REF_PT ) WRITE(F06,*) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1C/SUBCASE_PROC.f90 b/Source/LK1/L1C/SUBCASE_PROC.f90 index 1e1b4281..e5cd3acc 100644 --- a/Source/LK1/L1C/SUBCASE_PROC.f90 +++ b/Source/LK1/L1C/SUBCASE_PROC.f90 @@ -66,7 +66,7 @@ SUBROUTINE SUBCASE_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1D + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1D USE SCONTR, ONLY : BLNK_SUB_NAM, CC_ENTRY_LEN, DATA_NAM_LEN, FATAL_ERR, IBIT, WARN_ERR, LSETLN, & MELDTS, MELOUTS, METYPE, MGROUTS, NELE, NGRID, NSUB @@ -76,7 +76,6 @@ SUBROUTINE SUBCASE_PROC USE PARAMS, ONLY : PRTSCP, SUPWARN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SUBCASE_PROC_BEGEND USE MODEL_STUF, ONLY : CCELDT, ONE_SET_ARRAY, SC_ACCE, SC_DISP, SC_ELFN, SC_ELFE, SC_GPFO, SC_MPCF, & SC_OLOA, SC_SPCF, SC_STRE, SC_STRN, ELDT, OELDT, ELOUT, OELOUT, GROUT, OGROUT, LABEL, & @@ -129,16 +128,11 @@ SUBROUTINE SUBCASE_PROC INTEGER(LONG) :: NULSET ! Output from subr SETPRO. If 0, there were no SET's in ALL_SETS_ARRAY INTEGER(LONG) :: SETID ! = 0, -1, or pos integer set ID read from array SC_xxxx INTEGER(LONG) :: TOKLEN = 0 ! Length (bytes) of TOKSTR sent to subr STOKEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SUBCASE_PROC_BEGEND + INTRINSIC :: IAND,IBCLR,IBSET -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -1261,12 +1255,7 @@ SUBROUTINE SUBCASE_PROC WRITE(L1D) ANY_STRE_OUTPUT WRITE(L1D) ANY_STRN_OUTPUT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -1334,10 +1323,9 @@ SUBROUTINE SETPRO ( SETID_IN, NULSET, SLEN ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LSETLN, MAX_TOKEN_LEN, SETLEN, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SUBCASE_PROC_BEGEND USE MODEL_STUF, ONLY : ALL_SETS_ARRAY, ONE_SET_ARRAY IMPLICIT NONE @@ -1363,16 +1351,11 @@ SUBROUTINE SETPRO ( SETID_IN, NULSET, SLEN ) INTEGER(LONG) :: SET_2_BEG ! Pos'n in SETCHR where next 'SET' begins (where the chars 'SET' begin) INTEGER(LONG) :: SID_BEG ! Pos'n in SETCHR where a sets ID begins INTEGER(LONG) :: SID_END ! Pos'n in SETCHR where a sets ID ends - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SUBCASE_PROC_BEGEND + 1 + INTRINSIC INDEX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -1488,12 +1471,7 @@ SUBROUTINE SETPRO ( SETID_IN, NULSET, SLEN ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/EPTL.f90 b/Source/LK1/L1D/EPTL.f90 index b9a73967..1941620f 100644 --- a/Source/LK1/L1D/EPTL.f90 +++ b/Source/LK1/L1D/EPTL.f90 @@ -32,14 +32,13 @@ SUBROUTINE EPTL ! and pressure loads are inserted into the system loads array SYS_LOAD. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, F21, F21FIL, F21_MSG, SC1, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, F21, F21FIL, F21_MSG, SC1, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_P_T_BIT, ELDT_F21_P_T_BIT, IBIT, LINKNO, MBUG, MELDOF, NCORD, & NELE, NGRID, NSUB, NTSUB USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START - USE SUBR_BEGEND_LEVELS, ONLY : EPTL_BEGEND USE MODEL_STUF, ONLY : ELDOF, ELDT, GRID, GRID_ID, CORD, AGRID, ELGP, NUM_EMG_FATAL_ERRS, OELDT, PLY_NUM, PPE, & PTE, SYS_LOAD, TYPE, SUBLOD @@ -67,7 +66,7 @@ SUBROUTINE EPTL ! thermal load and internal S/C 5 is the 2-nd to have thermal load: ! TCASE2(1-5) = 3, 5, 0, 0, 0 ! Indicator for output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EPTL_BEGEND + REAL(DOUBLE) :: DZE(MELDOF,MELDOF)! A dummy array for the call to ELEM_TRANSFORM_LBG REAL(DOUBLE) :: EPS1 ! A small number to compare real zero @@ -76,12 +75,7 @@ SUBROUTINE EPTL INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -170,7 +164,7 @@ SUBROUTINE EPTL !xx CALL CALC_TDOF_ROW_NUM ( AGRID(J), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(J), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) ROW_NUM = ROW_NUM_START + K - 1 @@ -226,12 +220,7 @@ SUBROUTINE EPTL CALL OUTA_HERE ( 'Y' ) ! Errors from subr EMG, so quit ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/FORCE_MOM_PROC.f90 b/Source/LK1/L1D/FORCE_MOM_PROC.f90 index ca8d36a0..31d2afd0 100644 --- a/Source/LK1/L1D/FORCE_MOM_PROC.f90 +++ b/Source/LK1/L1D/FORCE_MOM_PROC.f90 @@ -85,10 +85,9 @@ SUBROUTINE FORCE_MOM_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, SCR, L1I, LINK1I, L1I_MSG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, SCR, L1I, LINK1I, L1I_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LLOADC, NCORD, NFORCE, NGRID, NLOAD, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FORCE_MOM_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, SUPWARN USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -127,7 +126,7 @@ SUBROUTINE FORCE_MOM_PROC INTEGER(LONG) :: REC_NO ! Record number when reading a file INTEGER(LONG) :: ROW_NUM ! Row no. in array TDOF corresponding to GDOF INTEGER(LONG) :: ROW_NUM_START ! Row no. in array TDOF where data begins for AGRID - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FORCE_MOM_PROC_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: F1(3), F2(3) ! 3 force or moment components in intermediate calcs @@ -140,12 +139,7 @@ SUBROUTINE FORCE_MOM_PROC INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -164,8 +158,8 @@ SUBROUTINE FORCE_MOM_PROC SCRFIL(1:9) = 'SCRATCH-991' OPEN (SCR(1),STATUS='SCRATCH',POSITION='REWIND',FORM='UNFORMATTED',ACTION='READWRITE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SCRFIL, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL OPNERR ( IOCHK, SCRFIL, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Error opening scratch file, so quit ENDIF REWIND (SCR(1)) @@ -185,7 +179,7 @@ SUBROUTINE FORCE_MOM_PROC READ(L1I,IOSTAT=IOCHK) SETID,AGRID,ACID_L,(FORMON(J),J=1,3),NAME IF (IOCHK /= 0) THEN REC_NO = I - CALL READERR ( IOCHK, LINK1I, L1I_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1I, L1I_MSG, REC_NO, OUNT ) READ_ERR = READ_ERR + 1 CYCLE i_do1 ENDIF @@ -320,8 +314,8 @@ SUBROUTINE FORCE_MOM_PROC READ(SCR(1),IOSTAT=IOCHK) SETID,AGRID,ACID_G,(FORMON(K),K=1,3),NAME IF (IOCHK /= 0) THEN REC_NO = J - CALL READERR ( IOCHK, SCRFIL, MESSAG, REC_NO, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL READERR ( IOCHK, SCRFIL, MESSAG, REC_NO, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Error reading scratch file, so quit ENDIF @@ -347,7 +341,7 @@ SUBROUTINE FORCE_MOM_PROC ELSE WRITE(ERR,1516) SUBR_NAME,NAME WRITE(F06,1516) SUBR_NAME,NAME - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) FATAL_ERR = FATAL_ERR + 1 CALL OUTA_HERE ( 'Y' ) ! Coding error (not FORCE or MOMENT), so quit ENDIF @@ -372,7 +366,7 @@ SUBROUTINE FORCE_MOM_PROC WRITE(ERR,1514) SUBR_NAME WRITE(F06,1514) SUBR_NAME FATAL_ERR = FATAL_ERR + 1 - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Coding error (dim on array FORMON out of bounds), so quit ELSE FORCEI = SCALE*FORMON(K1) @@ -393,14 +387,9 @@ SUBROUTINE FORCE_MOM_PROC ENDDO i_do2 - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/GET_GRID_6X6_MASS.f90 b/Source/LK1/L1D/GET_GRID_6X6_MASS.f90 index e3b99824..c1999570 100644 --- a/Source/LK1/L1D/GET_GRID_6X6_MASS.f90 +++ b/Source/LK1/L1D/GET_GRID_6X6_MASS.f90 @@ -30,13 +30,13 @@ SUBROUTINE GET_GRID_6X6_MASS ( AGRID, IGRID, FOUND, GRID_MGG ) ! THis subr was not coded for SPOINT's so check if AGRID is an SPOINT and give program error and quit if it is USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID, NTERM_MGG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_GRID_6X6_MASS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TDOF USE SPARSE_MATRICES, ONLY : I2_MGG, J_MGG, MGG + USE MODEL_STUF, ONLY : GRID_SEQ USE GET_GRID_6X6_MASS_USE_IFs @@ -51,23 +51,18 @@ SUBROUTINE GET_GRID_6X6_MASS ( AGRID, IGRID, FOUND, GRID_MGG ) INTEGER(LONG) :: I1,J1 ! Indices INTEGER(LONG) :: IGRID_DOF_NUM ! G-set DOF number for IGRID INTEGER(LONG) :: NUM_COMPS ! No. displ components (1 for SPOINT, 6 for actual grid) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_GRID_6X6_MASS_BEGEND + REAL(DOUBLE), INTENT(OUT) :: GRID_MGG(6,6) ! 6 x 6 mass matrix for internal grid IGRID INTRINSIC :: MODULO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! If AGRID is an SPOINT give error and quit - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS /= 6) THEN FATAL_ERR = FATAL_ERR + 1 WRITE(ERR,1502) AGRID, NUM_COMPS @@ -85,7 +80,7 @@ SUBROUTINE GET_GRID_6X6_MASS ( AGRID, IGRID, FOUND, GRID_MGG ) ENDDO ENDDO - IGRID_DOF_NUM = 6*(IGRID - 1) + 1 + IGRID_DOF_NUM = 6*(GRID_SEQ(IGRID) - 1) + 1 k_do: DO K=1,NTERM_MGG IF ((I2_MGG(K) >= IGRID_DOF_NUM) .AND. (I2_MGG(K) <= IGRID_DOF_NUM + 5)) THEN @@ -126,12 +121,7 @@ SUBROUTINE GET_GRID_6X6_MASS ( AGRID, IGRID, FOUND, GRID_MGG ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/GRAV_PROC.f90 b/Source/LK1/L1D/GRAV_PROC.f90 index 926b0670..0a50cdde 100644 --- a/Source/LK1/L1D/GRAV_PROC.f90 +++ b/Source/LK1/L1D/GRAV_PROC.f90 @@ -88,10 +88,9 @@ SUBROUTINE GRAV_PROC ! ( vi) Load the grav forces into the SYS_LOAD (systems load) array USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, ERR, F04, F06, SCR, L1P, LINK1P, L1P_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, ERR, F06, SCR, L1P, LINK1P, L1P_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LLOADC, NCORD, NGRAV, NGRID, NLOAD, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GRAV_PROC_BEGEND USE PARAMS, ONLY : SUPWARN USE CONSTANTS_1, ONLY : ZERO, ONE USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -135,7 +134,7 @@ SUBROUTINE GRAV_PROC INTEGER(LONG) :: REC_NO ! Record number when reading a file INTEGER(LONG) :: ROW_NUM ! Row no. in array TDOF corresponding to GDOF INTEGER(LONG) :: ROW_NUM_START ! Row no. in array TDOF where data begins for a grid - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GRAV_PROC_BEGEND + REAL(DOUBLE) :: ACCEL_I(6) ! 6 components of accel due to gravity at a grid REAL(DOUBLE) :: ACCEL_I_T1(3) ! 3 translational components of accel due to gravity at a grid @@ -162,12 +161,7 @@ SUBROUTINE GRAV_PROC INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** NAME = 'GRAV ' @@ -183,8 +177,8 @@ SUBROUTINE GRAV_PROC SCRFIL(1:9) = 'SCRATCH-991' OPEN (SCR(1),STATUS='SCRATCH',POSITION='REWIND',FORM='UNFORMATTED',ACTION='READWRITE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SCRFIL, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL OPNERR ( IOCHK, SCRFIL, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Error opening scratch file, so quit ENDIF REWIND (SCR(1)) @@ -199,7 +193,7 @@ SUBROUTINE GRAV_PROC IF (IOCHK /= 0) THEN REC_NO = I - CALL READERR ( IOCHK, LINK1P, L1P_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1P, L1P_MSG, REC_NO, OUNT ) READ_ERR = READ_ERR + 1 ! Increment READ_ERR and go back to read another grav card CYCLE i_do1 ENDIF @@ -317,8 +311,8 @@ SUBROUTINE GRAV_PROC READ(SCR(1),IOSTAT=IOCHK) SETID,ACID,GRAV_GRID,(ACCEL_RB(K),K=1,6) IF (IOCHK /= 0) THEN REC_NO = J - CALL READERR ( IOCHK, SCRFIL, MESSAG, REC_NO, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL READERR ( IOCHK, SCRFIL, MESSAG, REC_NO, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Error reading scratch file, so quit ENDIF @@ -452,14 +446,9 @@ SUBROUTINE GRAV_PROC WRITE(SC1,*) CR13 - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/MPC_PROC.f90 b/Source/LK1/L1D/MPC_PROC.f90 index 8ef2bd75..a6781174 100644 --- a/Source/LK1/L1D/MPC_PROC.f90 +++ b/Source/LK1/L1D/MPC_PROC.f90 @@ -29,10 +29,9 @@ SUBROUTINE MPC_PROC ! Processes MPC equations to get terms for the RMG constraint matrix USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1J, L1S, LINK1S, L1S_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1J, L1S, LINK1S, L1S_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LMPCADDC, NGRID, NMPC, NMPCADD, NUM_MPCSIDS, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MPC_PROC_BEGEND USE MODEL_STUF, ONLY : GRID_ID, MPCSET, MPCSIDS USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -63,17 +62,12 @@ SUBROUTINE MPC_PROC INTEGER(LONG) :: ROW_NUM ! A row number in array TDOF INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: SETID ! An SPC set ID read from file LINK1O - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MPC_PROC_BEGEND + REAL(DOUBLE) :: COEFF ! An MPC coeff value read from file LINK1S that we do not need REAL(DOUBLE) :: COEFF_JUNK ! An MPC coeff value read from file LINK1S that we do not need -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -103,14 +97,14 @@ SUBROUTINE MPC_PROC READ(L1S,IOSTAT=IOCHK) SETID ! Read the SETID for the i-th logical MPC REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF READ(L1S,IOSTAT=IOCHK) NUM_TRIPLES ! Read the number of triplets of grid/comp/coeff for the i-th logical MPC REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF @@ -125,7 +119,7 @@ SUBROUTINE MPC_PROC READ(L1S,IOSTAT=IOCHK) GID,COMP,COEFF ! Read dependent grid/comp/coeff REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF ! Get row num (in GRID_ID) corresponding to grid GID (we know GID exists) @@ -156,7 +150,7 @@ SUBROUTINE MPC_PROC REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF @@ -201,7 +195,7 @@ SUBROUTINE MPC_PROC READ(L1S,IOSTAT=IOCHK) GID_JUNK,COMP_JUNK,COEFF_JUNK REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1S, L1S_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF ENDDO @@ -214,12 +208,7 @@ SUBROUTINE MPC_PROC CALL DEALLOCATE_MODEL_STUF ( 'MPCSIDS' ) END IF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/PRESSURE_DATA_PROC.f90 b/Source/LK1/L1D/PRESSURE_DATA_PROC.f90 index cbd4842b..1cb1a2e1 100644 --- a/Source/LK1/L1D/PRESSURE_DATA_PROC.f90 +++ b/Source/LK1/L1D/PRESSURE_DATA_PROC.f90 @@ -31,15 +31,14 @@ SUBROUTINE PRESSURE_DATA_PROC ! PDATA (arrays used in the element generation routines) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1Q - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, LINK1Q - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, L1Q_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1Q + USE IOUNT1, ONLY : WRT_ERR, LINK1Q + USE IOUNT1, ONLY : WRT_ERR, L1Q_MSG USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, DATA_NAM_LEN, FATAL_ERR, JCARD_LEN, LPDAT, LLOADC, & MPDAT_PLOAD1, MPDAT_PLOAD2, MPDAT_PLOAD4, MPLOAD4_3D_DATA, NELE, NLOAD, NPCARD, & NPLOAD4_3D, NPDAT, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : PRESSURE_DATA_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : LOAD_SIDS, LOAD_FACS, SUBLOD, PDATA, PPNT, PLOAD4_3D_DATA, PTYPE @@ -77,19 +76,14 @@ SUBROUTINE PRESSURE_DATA_PROC INTEGER(LONG) :: REC_NO ! Record number when reading a file INTEGER(LONG) :: SETID ! Pressure load set ID read from an elem pressure B.D. card INTEGER(LONG) :: XTIME ! Time stamp read from an unformatted file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRESSURE_DATA_PROC_BEGEND + REAL(DOUBLE) :: SCALE ! Scale factor from a LOAD Bulk Data card REAL(DOUBLE) :: RPDAT ! Real pressure value read from file LINK1Q REAL(DOUBLE) :: RPDAT1 ! Real pressure value read from file LINK1Q REAL(DOUBLE) :: RSID(LLOADC+1) ! Array of load magnitudes (for LSID set ID's) needed for one S/C -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EL_REDUNDANT_PRES = 0 ! Initialize warn, err indicators for redundant elem press definition @@ -135,7 +129,7 @@ SUBROUTINE PRESSURE_DATA_PROC READ(L1Q,IOSTAT=IOCHK) CARD ! Read element pressure CARD from LINK1Q IF (IOCHK /= 0) THEN REC_NO = J + 1 - CALL READERR ( IOCHK, LINK1Q, L1Q_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1Q, L1Q_MSG, REC_NO, OUNT ) IERROR = IERROR + 1 CYCLE isubc ENDIF @@ -282,7 +276,7 @@ SUBROUTINE PRESSURE_DATA_PROC READ(L1Q,IOSTAT=IOCHK) XTIME IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, LINK1Q, L1Q_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1Q, L1Q_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Cannot read STIME from temperature data file, so quit ENDIF @@ -299,11 +293,11 @@ SUBROUTINE PRESSURE_DATA_PROC ! First close and delete L1Q file - CALL FILE_CLOSE ( L1Q, LINK1Q, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1Q, LINK1Q, 'DELETE' ) ! Open L1Q for write: - CALL FILE_OPEN ( L1Q, LINK1Q, OUNT, 'REPLACE', L1Q_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1Q, LINK1Q, OUNT, 'REPLACE', L1Q_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) DATA_SET_NAME = 'PPNT' WRITE(L1Q) DATA_SET_NAME @@ -336,12 +330,7 @@ SUBROUTINE PRESSURE_DATA_PROC WRITE(L1Q) (PLOAD4_3D_DATA(I,J),J=1,MPLOAD4_3D_DATA) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -375,10 +364,9 @@ SUBROUTINE EPPUT ( SETID, EID, JSUB, IPPNT, NAME, EFLAG, IELEM, EL_REDUNDANT_PRE ! Element pressure routine - generates the PPNT(i,J) array and PTYPE(i) array USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NELE, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PRESSURE_DATA_PROC_BEGEND USE MODEL_STUF, ONLY : ESORT1, ETYPE, SUBLOD, PPNT, PTYPE IMPLICIT NONE @@ -394,13 +382,9 @@ SUBROUTINE EPPUT ( SETID, EID, JSUB, IPPNT, NAME, EFLAG, IELEM, EL_REDUNDANT_PRE INTEGER(LONG), INTENT(OUT) :: IELEM ! Internal elem ID for actual elem ID EID INTEGER(LONG), INTENT(INOUT) :: EL_REDUNDANT_PRES ! Count of warning messages when elements have redundant pressures INTEGER(LONG), INTENT(INOUT) :: EL_PRES_ERR ! Count of errors where elem ID is wrong (*ERROR 1320) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRESSURE_DATA_PROC_BEGEND + 2 - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -450,12 +434,7 @@ SUBROUTINE EPPUT ( SETID, EID, JSUB, IPPNT, NAME, EFLAG, IELEM, EL_REDUNDANT_PRE ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/RBE2_PROC.f90 b/Source/LK1/L1D/RBE2_PROC.f90 index 0058e671..3c2a4a89 100644 --- a/Source/LK1/L1D/RBE2_PROC.f90 +++ b/Source/LK1/L1D/RBE2_PROC.f90 @@ -32,11 +32,10 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) ! MPC coefficients) which will be used in LINK2 to reduce the G-set mass, stiffness and load matrices to the N-set. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F, LINK1F, L1F_MSG, L1J + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F, LINK1F, L1F_MSG, L1J USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCORD, NGRID USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : GRID, RGRID, GRID_ID, CORD USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -75,7 +74,7 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) INTEGER(LONG) :: RMG_ROW_NUM ! Row no. of a term in array RMG INTEGER(LONG) :: ROW_NUM ! A row number in array TDOF INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + 1 + REAL(DOUBLE) :: DELTA_0(3,3) ! 3 x 3 matrix of diffs in coords bet dep & indep grids in basic coords REAL(DOUBLE) :: DUM1(3,3) ! Intermediate result in obtaining RDI_GLOBAL @@ -86,12 +85,7 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) REAL(DOUBLE) :: T0G_D(3,3) ! Transforms a dep DOF vector in basic coords to global coords REAL(DOUBLE) :: T0G_I(3,3) ! Transforms a indep DOF vector in basic coords to global coords -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -102,16 +96,20 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) JERR = 0 READ(L1F,IOSTAT=IOCHK) REID, AGRID_D, DDOF, AGRID_I + + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D, GRID_ID_ROW_NUM_D ) + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I, GRID_ID_ROW_NUM_I ) + REC_NO = REC_NO + 1 IF (IOCHK == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID_D, NUM_COMPS_D, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_D, NUM_COMPS_D, SUBR_NAME ) IF (NUM_COMPS_D /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 WRITE(ERR,1951) 'RBE2', REID, NUM_COMPS_D WRITE(F06,1951) 'RBE2', REID, NUM_COMPS_D ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID_I, NUM_COMPS_I, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_I, NUM_COMPS_I, SUBR_NAME ) IF (NUM_COMPS_I /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 @@ -119,7 +117,7 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) WRITE(F06,1951) 'RBE2', REID, NUM_COMPS_I ENDIF ELSE - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) IERR = IERR + 1 JERR = JERR + 1 ENDIF @@ -134,7 +132,6 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) ! We know that the indep and dep grids (AGRID_I and AGRID_D) exist. This was checked in subr DOF_PROC. ! Get the basic-to-global trensformation matrices for AGRID_D and AGRID_I - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D, GRID_ID_ROW_NUM_D ) ECORD_D = GRID(GRID_ID_ROW_NUM_D,3) IF (ECORD_D /= 0) THEN DO I=1,NCORD @@ -153,7 +150,6 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) ENDDO ENDIF - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I, GRID_ID_ROW_NUM_I ) ECORD_I = GRID(GRID_ID_ROW_NUM_I,3) IF (ECORD_I /= 0) THEN DO I=1,NCORD @@ -314,12 +310,7 @@ SUBROUTINE RBE2_PROC ( RTYPE, REC_NO, IERR ) WRITE(F06,*) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/RBE3_PROC.f90 b/Source/LK1/L1D/RBE3_PROC.f90 index acc013e9..baa5a9be 100644 --- a/Source/LK1/L1D/RBE3_PROC.f90 +++ b/Source/LK1/L1D/RBE3_PROC.f90 @@ -34,13 +34,12 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) ! The derivation of the equations for the RBE3 are shown in Appendix E to the MYSTRAN User's Reference Manual USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F, LINK1F, L1F_MSG, L1J + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F, LINK1F, L1F_MSG, L1J USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MRBE3, NCORD, NGRID, NTERM_RMG USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE MODEL_STUF, ONLY : CORD, GRID_ID, GRID, RCORD, RGRID USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE RBE3_PROC_USE_IFs @@ -80,7 +79,7 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) INTEGER(LONG) :: RMG_ROW_NUM ! Row no. of a term in array RMG INTEGER(LONG) :: ROW_NUM ! A row number in array TDOF INTEGER(LONG) :: ROW_NUM_START_D ! DOF number where TDOF data begins for the ref grid - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + REAL(DOUBLE) :: EPS1 ! Small number REAL(DOUBLE) :: DX_BAR ! Wgt'd avg diff in x dist from indep pt i to ref pt A (in ref pt global) @@ -107,12 +106,7 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) REAL(DOUBLE) :: SXY,SZX,SYZ ! new Rdd terms according to victor REAL(DOUBLE) :: WTi6(MRBE3,6) ! per-DoF grid weights -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! File LINK1F contains data from the logical RBE3 cards in the input B.D. deck. For each logical RBE3 card, LINK1F has: @@ -154,9 +148,12 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) ! Start reading at the 2nd record of L1F for this RBE3 (first record, RYPE, was read above in calling subr, RIGID_ELEM_PROC): ! Read 2nd record from L1F for this RBE3 READ(L1F,IOSTAT=IOCHK) REID, AGRID_D, COMPS_D, IRBE3, WT + + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D, GRID_ID_ROW_NUM_D ) + REC_NO = REC_NO + 1 IF (IOCHK == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID_D, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_D, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 @@ -164,7 +161,7 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) WRITE(F06,1951) 'RBE3', REID, NUM_COMPS ENDIF ELSE - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) IERR = IERR + 1 JERR = JERR + 1 ENDIF @@ -173,7 +170,7 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) READ(L1F,IOSTAT=IOCHK) AGRID_I(I), COMPS_I(I), WTi(I) REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) IERR = IERR + 1 JERR = JERR + 1 ENDIF @@ -195,7 +192,6 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) ! Get T0D (transforms global vector at AGRID_D to basic) - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D, GRID_ID_ROW_NUM_D ) ECORD_D = GRID(GRID_ID_ROW_NUM_D,3) IF (ECORD_D /= 0) THEN DO I=1,NCORD @@ -444,7 +440,9 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) ! Get T0I (transforms global vector at AGRID_I to basic) CALL RDOF ( COMPS_I(J), CDOF_I ) - CALL GET_GRID_NUM_COMPS ( AGRID_I(J), NUM_COMPS, SUBR_NAME ) + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I(J), GRID_ID_ROW_NUM_I ) + + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_I, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 @@ -454,7 +452,6 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) RETURN ENDIF - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I(J), GRID_ID_ROW_NUM_I ) ECORD_I= GRID(GRID_ID_ROW_NUM_I,3) IF (ECORD_I /= 0) THEN DO K=1,NCORD @@ -495,12 +492,7 @@ SUBROUTINE RBE3_PROC ( RTYPE, REC_NO, IERR ) RETURN ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/RFORCE_PROC.f90 b/Source/LK1/L1D/RFORCE_PROC.f90 index 687573a5..983564ad 100644 --- a/Source/LK1/L1D/RFORCE_PROC.f90 +++ b/Source/LK1/L1D/RFORCE_PROC.f90 @@ -101,10 +101,9 @@ SUBROUTINE RFORCE_PROC ! ( vi) Load the RFORCE forces into the SYS_LOAD (systems load) array USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, FILE_NAM_MAXLEN, L1U, LINK1U, L1U_MSG, SC1, SCR, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, FILE_NAM_MAXLEN, L1U, LINK1U, L1U_MSG, SC1, SCR, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LLOADC, NCORD, NRFORCE, NGRID, NLOAD, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RFORCE_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : SUPWARN USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -148,7 +147,7 @@ SUBROUTINE RFORCE_PROC INTEGER(LONG) :: ROW_NUM ! Row no. in array TDOF corresponding to GDOF INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: SETID ! Load set ID read from record in file LINK1U - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RFORCE_PROC_BEGEND + REAL(DOUBLE) :: ACCEL_I(6) ! 6 components of accel due to gravity at a grid REAL(DOUBLE) :: ACCEL_I_T1(3) ! 3 transl components of accel due to RFORCE at a grid in basic coords @@ -174,12 +173,7 @@ SUBROUTINE RFORCE_PROC INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** NAME = 'RFORCE ' @@ -195,8 +189,8 @@ SUBROUTINE RFORCE_PROC SCRFIL(1:9) = 'SCRATCH-991' OPEN (SCR(1),STATUS='SCRATCH',POSITION='REWIND',FORM='UNFORMATTED',ACTION='READWRITE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SCRFIL, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL OPNERR ( IOCHK, SCRFIL, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Error opening scratch file, so quit ENDIF REWIND (SCR(1)) @@ -210,7 +204,7 @@ SUBROUTINE RFORCE_PROC READ(L1U,IOSTAT=IOCHK) SETID, ACID_L, RFORCE_GRD, SCALEF_AV, SCALEF_AA, (VEC(J),J=1,3) IF (IOCHK /= 0) THEN REC_NO = I - CALL READERR ( IOCHK, LINK1U, L1U_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1U, L1U_MSG, REC_NO, OUNT ) READ_ERR = READ_ERR + 1 ! Increment READ_ERR and go back to read another RFORCE card CYCLE i_do1 ENDIF @@ -331,8 +325,8 @@ SUBROUTINE RFORCE_PROC IF (IOCHK /= 0) THEN REC_NO = J - CALL READERR ( IOCHK, SCRFIL, MESSAG, REC_NO, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL READERR ( IOCHK, SCRFIL, MESSAG, REC_NO, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Error reading scratch file, so quit ENDIF @@ -451,14 +445,9 @@ SUBROUTINE RFORCE_PROC WRITE(SC1,*) CR13 - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/RIGID_ELEM_PROC.f90 b/Source/LK1/L1D/RIGID_ELEM_PROC.f90 index 74908c8f..2eb87119 100644 --- a/Source/LK1/L1D/RIGID_ELEM_PROC.f90 +++ b/Source/LK1/L1D/RIGID_ELEM_PROC.f90 @@ -29,10 +29,9 @@ SUBROUTINE RIGID_ELEM_PROC ! Processes RBAR, RBE1, RBE2 rigid elements to get terms for the RMG constraint matrix USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1F, LINK1F, L1F_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1F, LINK1F, L1F_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NRECARD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND USE RIGID_ELEM_PROC_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE RIGID_ELEM_PROC INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: IERR = 0 ! Count of read errors when rigid elem data file is read INTEGER(LONG) :: REC_NO ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -70,7 +64,7 @@ SUBROUTINE RIGID_ELEM_PROC READ(L1F,IOSTAT=IOCHK) RTYPE REC_NO = REC_NO + 1 IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading RTYPE from rigid elem file. Can't continue ENDIF @@ -111,12 +105,7 @@ SUBROUTINE RIGID_ELEM_PROC CALL OUTA_HERE ( 'Y' ) ! Errors reading rigid element data file, so quit ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/RSPLINE_PROC.f90 b/Source/LK1/L1D/RSPLINE_PROC.f90 index c779a1f6..90425364 100644 --- a/Source/LK1/L1D/RSPLINE_PROC.f90 +++ b/Source/LK1/L1D/RSPLINE_PROC.f90 @@ -29,11 +29,10 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) ! Processes a single RSPLINE rigid element, per call, to get terms for the RMG constraint matrix USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1F, L1F_MSG, LINK1F, L1J + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1F, L1F_MSG, LINK1F, L1J USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MRSPLINE, NCORD, NGRID, NTERM_RMG USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : CORD, GRID, RGRID, GRID_ID, CORD USE PARAMS, ONLY : EPSIL @@ -78,7 +77,7 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) INTEGER(LONG) :: ROW_NUM ! A row number in array TDOF INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: TOTAL_NUM ! Total number of records read for a single rigid element - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + 1 + REAL(DOUBLE) :: DL_RAT ! D/L ratio from the B.D. RSPLINE entry @@ -112,12 +111,7 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) REAL(DOUBLE) :: V01D(3) ! Vector in basic coords from AGRID_I1 to AGRID_D REAL(DOUBLE) :: ZETA ! Nondimensional distance from AGRID_I1 to AGRID_D -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! File LINK1F contains data from the logical RSPLINE cards in the input B.D. deck. For each logical RSPLINE card, LINK1F has: @@ -135,23 +129,30 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) IF (DEBUG(111) > 0) CALL DEB_RSPLINE_PROC ( ' 1' ) + +! Get the internal grid ID's for AGRID I1, AGRID_I2 and AGRID_D. We know they exist + + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I1, GRID_ID_ROW_NUM_I1 ) + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I2, GRID_ID_ROW_NUM_I2 ) + CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D , GRID_ID_ROW_NUM_D ) + REC_NO = REC_NO + 1 IF (IOCHK == 0) THEN - CALL GET_GRID_NUM_COMPS ( AGRID_I1, NUM_COMPS_I1, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_I1, NUM_COMPS_I1, SUBR_NAME ) IF (NUM_COMPS_I1 /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 WRITE(ERR,1951) 'RSPLINE', REID, NUM_COMPS_I1 WRITE(F06,1951) 'RSPLINE', REID, NUM_COMPS_I1 ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID_I2, NUM_COMPS_I2, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_I2, NUM_COMPS_I2, SUBR_NAME ) IF (NUM_COMPS_I2 /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 WRITE(ERR,1951) 'RSPLINE', REID, NUM_COMPS_I2 WRITE(F06,1951) 'RSPLINE', REID, NUM_COMPS_I2 ENDIF - CALL GET_GRID_NUM_COMPS ( AGRID_D, NUM_COMPS_D, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( GRID_ID_ROW_NUM_D, NUM_COMPS_D, SUBR_NAME ) IF (NUM_COMPS_D /= 6) THEN IERR = IERR + 1 JERR = JERR + 1 @@ -159,7 +160,7 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) WRITE(F06,1951) 'RSPLINE', REID, NUM_COMPS_D ENDIF ELSE - CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1F, L1F_MSG, REC_NO, OUNT ) IERR = IERR + 1 JERR = JERR + 1 ENDIF @@ -171,11 +172,6 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) RETURN ENDIF -! Get the internal grid ID's for AGRID I1, AGRID_I2 and AGRID_D. We know they exist - - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I1, GRID_ID_ROW_NUM_I1 ) - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_I2, GRID_ID_ROW_NUM_I2 ) - CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID_D , GRID_ID_ROW_NUM_D ) ! Get the distances from AGRID_I1 to AGRID_I2 (total length of the RSPLINE) and AGRID_I1 to AGRID_D @@ -357,12 +353,7 @@ SUBROUTINE RSPLINE_PROC ( RTYPE, REC_NO, IERR ) IF (DEBUG(111) > 0) CALL DEB_RSPLINE_PROC ( '99' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -413,10 +404,9 @@ SUBROUTINE RSPLINE_GEOM ( REID, AGRID1, AGRID2, V012, LENGTH, TRSPLINE ) ! the line between the 2 RSPLINE indep grids) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL @@ -432,7 +422,7 @@ SUBROUTINE RSPLINE_GEOM ( REID, AGRID1, AGRID2, V012, LENGTH, TRSPLINE ) INTEGER(LONG) :: I3_IN(3) ! Integer array used in sorting VX. INTEGER(LONG) :: I3_OUT(3) ! Integer array in sort order of VX_SORT. If VX is sorted sp that ! comp 2 is smallest then comp 3 then comp 1 then I3_OUT is 2, 3, 1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + 1 + REAL(DOUBLE) , INTENT(IN) :: V012(3) ! Vector in basic coords from 1st to 2nd indep grids on the RSPLINE @@ -446,12 +436,7 @@ SUBROUTINE RSPLINE_GEOM ( REID, AGRID1, AGRID2, V012, LENGTH, TRSPLINE ) REAL(DOUBLE) :: VY(3) ! A vector in the elem y dir REAL(DOUBLE) :: VZ(3) ! A vector in the elem z dir -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -539,12 +524,7 @@ SUBROUTINE RSPLINE_GEOM ( REID, AGRID1, AGRID2, V012, LENGTH, TRSPLINE ) TRSPLINE(3,I) = VZ(I)/MAGZ ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -569,18 +549,17 @@ SUBROUTINE RSPLINE_FUNCTIONS ( Z, L12, FR11, FR12, FR13, FR14, FR21, FR22, FR23, ! Calculate thespline functions for an RSPLINE element in element coords (x axis along the line between the 2 indep grids) USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE CONSTANTS_1, ONLY : ONE, TWO, THREE, FOUR, SIX USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_ELEM_PROC_BEGEND IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'RSPLINE_FUNCTIONS' INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_ELEM_PROC_BEGEND + 1 + REAL(DOUBLE) , INTENT(IN) :: L12 ! Length of RSPLINE between the 2 independent grids REAL(DOUBLE) , INTENT(IN) :: Z ! Nondim distance to the RSPLINE dependent grid from the 1st indep grid @@ -597,12 +576,7 @@ SUBROUTINE RSPLINE_FUNCTIONS ( Z, L12, FR11, FR12, FR13, FR14, FR21, FR22, FR23, REAL(DOUBLE) :: Z_2 ! Z squared REAL(DOUBLE) :: Z_3 ! Z cubed -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -649,12 +623,7 @@ SUBROUTINE RSPLINE_FUNCTIONS ( Z, L12, FR11, FR12, FR13, FR14, FR21, FR22, FR23, FR24(2,2) = THREE*Z_2 - TWO*Z FR24(3,3) = FR24(2,2) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/SLOAD_PROC.f90 b/Source/LK1/L1D/SLOAD_PROC.f90 index 70fb4f5d..bacfe8f3 100644 --- a/Source/LK1/L1D/SLOAD_PROC.f90 +++ b/Source/LK1/L1D/SLOAD_PROC.f90 @@ -73,10 +73,9 @@ SUBROUTINE SLOAD_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, L1W, LINK1W, L1W_MSG, L1WSTAT + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, L1W, LINK1W, L1W_MSG, L1WSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LLOADC, NGRID, NLOAD, NSLOAD, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SLOAD_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, SUPWARN USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START @@ -103,7 +102,7 @@ SUBROUTINE SLOAD_PROC INTEGER(LONG) :: ROW_NUM ! Row no. in array TDOF corresponding to GDOF INTEGER(LONG) :: SPOINT ! Scalra point read from a record of L1W (point where force acts) INTEGER(LONG) :: XTIME ! Time stamp read from file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SLOAD_PROC_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: FMAG ! Force magnitude read from a L1W record (force on the SPOINT) @@ -112,12 +111,7 @@ SUBROUTINE SLOAD_PROC INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -163,8 +157,8 @@ SUBROUTINE SLOAD_PROC READ(L1W,IOSTAT=IOCHK) SETID, SPOINT, FMAG IF (IOCHK /= 0) THEN REC_NO = J - CALL READERR ( IOCHK, LINK1W, 'SLOAD FILE', REC_NO, OUNT, 'Y' ) - CALL FILE_CLOSE ( L1W, LINK1W, L1WSTAT, 'Y' ) + CALL READERR ( IOCHK, LINK1W, 'SLOAD FILE', REC_NO, OUNT ) + CALL FILE_CLOSE ( L1W, LINK1W, L1WSTAT ) CALL OUTA_HERE ( 'Y' ) ! Error reading scratch file, so quit ENDIF @@ -204,19 +198,14 @@ SUBROUTINE SLOAD_PROC READ(L1W,IOSTAT=IOCHK) XTIME IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, LINK1W, 'SLOAD FILE', REC_NO, OUNT, 'Y' ) - CALL FILERR ( OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1W, 'SLOAD FILE', REC_NO, OUNT ) + CALL FILERR ( OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF ENDDO i_do2 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/TEMPERATURE_DATA_PROC.f90 b/Source/LK1/L1D/TEMPERATURE_DATA_PROC.f90 index ac8e019d..5b701a14 100644 --- a/Source/LK1/L1D/TEMPERATURE_DATA_PROC.f90 +++ b/Source/LK1/L1D/TEMPERATURE_DATA_PROC.f90 @@ -62,12 +62,11 @@ SUBROUTINE TEMPERATURE_DATA_PROC USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1K - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, LINK1K - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, L1K_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1K + USE IOUNT1, ONLY : WRT_ERR, LINK1K + USE IOUNT1, ONLY : WRT_ERR, L1K_MSG USE SCONTR, ONLY : DATA_NAM_LEN, NELE, NGRID, NTDAT, NTSUB, NSUB, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TEMPERATURE_DATA_PROC_BEGEND USE MODEL_STUF, ONLY : CETEMP, CETEMP_ERR, CGTEMP, CGTEMP_ERR, ETEMP, GTEMP, TDATA, TPNT, GRID_ID, ESORT1, ETYPE,& SCNUM, SUBLOD, eid USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -95,14 +94,9 @@ SUBROUTINE TEMPERATURE_DATA_PROC ! If there are 5 subcases and internal S/C 3 is the 1-st S/C to have ! thermal load and internal S/C 5 is the 2-nd to have thermal load: ! TCASE2(1-5) = 3, 5, 0, 0, 0 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TEMPERATURE_DATA_PROC_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -238,11 +232,11 @@ SUBROUTINE TEMPERATURE_DATA_PROC ! First close and delete L1K file - CALL FILE_CLOSE ( L1K, LINK1K, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1K, LINK1K, 'DELETE' ) ! Open L1K for write: - CALL FILE_OPEN ( L1K, LINK1K, OUNT, 'REPLACE', L1K_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1K, LINK1K, OUNT, 'REPLACE', L1K_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) DATA_SET_NAME = 'TPNT' WRITE(L1K) DATA_SET_NAME @@ -291,12 +285,7 @@ SUBROUTINE TEMPERATURE_DATA_PROC ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -347,10 +336,9 @@ SUBROUTINE TEMPD_DATA_PROC ( TCASE1, OUNT, IERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BD_ENTRY_LEN, JCARD_LEN, NGRID, NSUB, NTCARD, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TEMPERATURE_DATA_PROC_BEGEND USE MODEL_STUF, ONLY : CGTEMP, GTEMP, SUBLOD IMPLICIT NONE @@ -369,23 +357,18 @@ SUBROUTINE TEMPD_DATA_PROC ( TCASE1, OUNT, IERR ) INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening a file INTEGER(LONG) :: REC_NO ! Record number when reading a file INTEGER(LONG) :: SID ! Thermal load set ID read from an elem temperature B.D. card - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TEMPERATURE_DATA_PROC_BEGEND + 1 + REAL(DOUBLE) :: RTEMP ! Real value of a temperature on a TEMPD or TEMP B.D. card -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO I=1,NTCARD READ(L1K,IOSTAT=IOCHK) CARD IF (IOCHK /= 0) THEN REC_NO = I - CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT ) IERR = IERR + 1 CYCLE ENDIF @@ -410,12 +393,7 @@ SUBROUTINE TEMPD_DATA_PROC ( TCASE1, OUNT, IERR ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -448,11 +426,10 @@ SUBROUTINE GRID_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, GID_ERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN, NGRID, NSUB, NTCARD, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : TEMPERATURE_DATA_PROC_BEGEND USE MODEL_STUF, ONLY : CGTEMP, GTEMP, GRID_ID, SUBLOD IMPLICIT NONE @@ -477,16 +454,11 @@ SUBROUTINE GRID_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, GID_ERR ) ! If there are 5 subcases and internal S/C 3 is the 1-st S/C to have ! thermal load and internal S/C 5 is the 2-nd to have thermal load: ! TCASE1(1-5) = 0, 0, 1, 0, 2 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TEMPERATURE_DATA_PROC_BEGEND + 1 + REAL(DOUBLE) :: RTEMP ! Real value of a temperature on a TEMPD or TEMP B.D. card -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** GID_ERR = 0 @@ -496,7 +468,7 @@ SUBROUTINE GRID_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, GID_ERR ) READ(L1K,IOSTAT=IOCHK) XTIME IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Cannot read STIME from temperature data file, so quit ENDIF @@ -504,7 +476,7 @@ SUBROUTINE GRID_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, GID_ERR ) READ(L1K,IOSTAT=IOCHK) CARD IF (IOCHK /= 0) THEN REC_NO = I+1 - CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT ) READ_ERR = READ_ERR + 1 CYCLE ENDIF @@ -550,12 +522,7 @@ SUBROUTINE GRID_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, GID_ERR ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -605,12 +572,11 @@ SUBROUTINE ELEM_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, ELID_ERR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN, LTDAT, MTDAT_TEMPRB, MTDAT_TEMPP1, & NTCARD, NTDAT, & NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TEMPERATURE_DATA_PROC_BEGEND USE CONSTANTS_1, ONLY : TWO USE PARAMS, ONLY : SUPWARN USE MODEL_STUF, ONLY : TDATA @@ -648,18 +614,13 @@ SUBROUTINE ELEM_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, ELID_ERR ) ! If there are 5 subcases and internal S/C 3 is the 1-st S/C to have ! thermal load and internal S/C 5 is the 2-nd to have thermal load: ! TCASE1(1-5) = 0, 0, 1, 0, 2 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TEMPERATURE_DATA_PROC_BEGEND + 1 + REAL(DOUBLE) :: TB1 ! Bulk temperature from TEMPRB card REAL(DOUBLE) :: TB2 ! Bulk temperature from TEMPRB card REAL(DOUBLE) :: TE_BULK ! Element bulk temperature -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ELID_ERR = 0 @@ -669,7 +630,7 @@ SUBROUTINE ELEM_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, ELID_ERR ) READ(L1K,IOSTAT=IOCHK) XTIME IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Cannot read STIME from temperature data file, so quit ENDIF @@ -683,7 +644,7 @@ SUBROUTINE ELEM_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, ELID_ERR ) CARD_NAME = CARD(1:8) IF (IOCHK /= 0) THEN REC_NO = ICRD - CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT ) READ_ERR = READ_ERR + 1 CYCLE ntcrd ENDIF @@ -735,7 +696,7 @@ SUBROUTINE ELEM_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, ELID_ERR ) CALL MKJCARD ( SUBR_NAME, CARD, JCARD ) IF (IOCHK /= 0) THEN ! Error reading temp. data file, so set error & cycle to read another REC_NO = ICRD - CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1K, L1K_MSG, REC_NO, OUNT ) READ_ERR = READ_ERR + 1 CYCLE ntcrd ENDIF @@ -810,12 +771,7 @@ SUBROUTINE ELEM_TEMP_DATA_PROC ( TCASE1, OUNT, READ_ERR, ELID_ERR ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -840,10 +796,9 @@ SUBROUTINE ELEM_TEMP_CHK( ISCNO, JTCOL, IELEM, TEMP_ELM ) ! which gives info about how the elem temp was arrived at. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MELGP, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TEMPERATURE_DATA_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : ETEMP, CGTEMP, CETEMP_ERR, GTEMP, EDAT, EPNT, ETYPE, GRID_ID, SCNUM, & AGRID, ELGP, EID, TYPE @@ -866,14 +821,9 @@ SUBROUTINE ELEM_TEMP_CHK( ISCNO, JTCOL, IELEM, TEMP_ELM ) INTEGER(LONG), INTENT(IN) :: IELEM ! Internal element number for a specific actual element ID INTEGER(LONG), INTENT(IN) :: ISCNO ! Internal subcase number INTEGER(LONG), INTENT(IN) :: JTCOL ! Col in thermal array CGTEMP, CETEMP for internal subcase no. ISCNO - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TEMPERATURE_DATA_PROC_BEGEND + 2 + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -918,12 +868,7 @@ SUBROUTINE ELEM_TEMP_CHK( ISCNO, JTCOL, IELEM, TEMP_ELM ) TEMP_ELM = 'B' ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -943,10 +888,9 @@ SUBROUTINE ETPUT( CARD_NAME, EFLAG, EID, SID, TCASE1, ITPNT, TE_BULK, IELEM, EL_ ! array CETEMP to state that this elem temp was specified on an elem temp card USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NELE, NSUB, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TEMPERATURE_DATA_PROC_BEGEND USE MODEL_STUF, ONLY : ETEMP, ESORT1, CETEMP, TPNT, TYPE, SUBLOD USE PARAMS, ONLY : SUPWARN @@ -968,16 +912,11 @@ SUBROUTINE ETPUT( CARD_NAME, EFLAG, EID, SID, TCASE1, ITPNT, TE_BULK, IELEM, EL_ ! If there are 5 subcases and internal S/C 3 is the 1-st S/C to have ! thermal load and internal S/C 5 is the 2-nd to have thermal load: ! TCASE1(1-5) = 0, 0, 1, 0, 2 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TEMPERATURE_DATA_PROC_BEGEND + 2 + REAL(DOUBLE) , INTENT(IN) :: TE_BULK ! Bulk temperature from element temperature B.D. card -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -1020,12 +959,7 @@ SUBROUTINE ETPUT( CARD_NAME, EFLAG, EID, SID, TCASE1, ITPNT, TE_BULK, IELEM, EL_ ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1D/YS_ARRAY.f90 b/Source/LK1/L1D/YS_ARRAY.f90 index 71c1f168..bb019a9e 100644 --- a/Source/LK1/L1D/YS_ARRAY.f90 +++ b/Source/LK1/L1D/YS_ARRAY.f90 @@ -29,12 +29,11 @@ SUBROUTINE YS_ARRAY ! Process enforced displacement data in file LINK1H and write the enforced displacement array, YSe, for use in subsequent LINK's. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1H - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, LINK1H - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, L1H_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1H + USE IOUNT1, ONLY : WRT_ERR, LINK1H + USE IOUNT1, ONLY : WRT_ERR, L1H_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFSE, NGRID USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : YS_ARRAY_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : GRID_ID USE COL_VECS, ONLY : YSe @@ -57,16 +56,11 @@ SUBROUTINE YS_ARRAY INTEGER(LONG) :: SE_SET_COL_NUM ! Col no., in TDOF array, of the SE-set DOF list INTEGER(LONG) :: TDOF_ROW_NUM ! Row num in array TDOF for DOF corresponding to GRID_ID_ROW_NUM, COMP INTEGER(LONG) :: YSDOF ! SE-set DOF number for the DOF corresponding to GRID_ID_ROW_NUM, COMP - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = YS_ARRAY_BEGEND + REAL(DOUBLE) :: YSV ! Enforced displ value read from file LINK1H -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -81,7 +75,7 @@ SUBROUTINE YS_ARRAY READ(L1H,IOSTAT=IOCHK) GRID_ID_ROW_NUM,COMP,YSV IF (IOCHK /= 0) THEN REC_NO = I - CALL READERR ( IOCHK, LINK1H, L1H_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1H, L1H_MSG, REC_NO, OUNT ) IERR1H = IERR1H + 1 ELSE CALL TDOF_COL_NUM ( 'SE', SE_SET_COL_NUM ) @@ -96,7 +90,7 @@ SUBROUTINE YS_ARRAY ! If there were any errors based on reading above file, quit. IF (IERR1H > 0) THEN - CALL FILERR ( OUNT, 'Y' ) + CALL FILERR ( OUNT ) CALL OUTA_HERE ( 'Y' ) ! Errors reading YSe file, so quit ENDIF @@ -108,12 +102,7 @@ SUBROUTINE YS_ARRAY WRITE(L1H) YSe(I) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/EMP.f90 b/Source/LK1/L1E/EMP.f90 index cdeca3c4..b7e1168e 100644 --- a/Source/LK1/L1E/EMP.f90 +++ b/Source/LK1/L1E/EMP.f90 @@ -33,14 +33,13 @@ SUBROUTINE EMP USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, F22, F22FIL, F22_MSG, SC1, WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, F22, F22FIL, F22_MSG, SC1, WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_ME_BIT, ELDT_F22_ME_BIT, FATAL_ERR, IBIT, LINKNO, LTERM_MGGE, & MBUG, MELDOF, NDOFG, NELE, NGRID, NTERM_MGGE, NSUB USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SPARSTOR - USE SUBR_BEGEND_LEVELS, ONLY : EMP_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : AGRID, ELDT, ELDOF, ELGP, GRID_ID, NUM_EMG_FATAL_ERRS, ME, OELDT, PLY_NUM, TYPE USE EMS_ARRAYS, ONLY : EMS, EMSCOL, EMSKEY, EMSPNT @@ -74,19 +73,14 @@ SUBROUTINE EMP INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: TDOF_ROW_NUM ! Row number in array TDOF ! Indicator for output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EMP_BEGEND + REAL(DOUBLE) :: DQE(MELDOF,NSUB) ! Dummy array in call to ELEM_TRANSFORM_LBG REAL(DOUBLE) :: EPS1 ! A small number to compare real zero INTRINSIC :: DABS, IAND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -159,7 +153,7 @@ SUBROUTINE EMP ! CALL CALC_TDOF_ROW_NUM ( AGRID(J), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(J), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) TDOF_ROW_NUM = ROW_NUM_START + K - 1 @@ -317,12 +311,7 @@ SUBROUTINE EMP WRITE(F06,9876) IERROR CALL OUTA_HERE ( 'Y' ) ! IERROR is count of all subr EMG errors, so quit ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -356,7 +345,7 @@ SUBROUTINE DUMPEMS ( WHAT, J, K, MGG_ROW, MGG_COL, IS, ISS ) ! Prints out info on the formulation of stiffness arrays for subr ESP, which generates the arrays USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NTERM_MGGE USE MODEL_STUF, ONLY : EID USE EMS_ARRAYS, ONLY : EMS, EMSCOL, EMSKEY, EMSPNT diff --git a/Source/LK1/L1E/EMP0.f90 b/Source/LK1/L1E/EMP0.f90 index 86c70c60..a444dc8c 100644 --- a/Source/LK1/L1E/EMP0.f90 +++ b/Source/LK1/L1E/EMP0.f90 @@ -40,11 +40,10 @@ SUBROUTINE EMP0 ! If field 3 of PARAM SETLKTK is 2: then the estimate of LTERM_MGGE is based on actual elem ME matrices unconnected. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : LTERM_MGGE, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : GRIDSEQ, SETLKTM, USR_LTERM_MGG - USE SUBR_BEGEND_LEVELS, ONLY : EMP0_BEGEND USE EMP0_USE_IFs @@ -53,14 +52,9 @@ SUBROUTINE EMP0 CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'EMP0' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EMP0_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** IF (SETLKTM == 0) THEN ! LTERM_MGG based on full elem mass matrices not connected @@ -77,12 +71,7 @@ SUBROUTINE EMP0 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -97,11 +86,10 @@ SUBROUTINE EMP0_0 ! Estimates LTERM_MGGE based on full elem mass matrices in an unassembled state (not connected) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : LTERM_MGGE, NELE, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SPARSTOR, SUPINFO - USE SUBR_BEGEND_LEVELS, ONLY : EMP0_BEGEND USE MODEL_STUF, ONLY : EDAT, EID, EPNT, ETYPE, ELGP, TYPE IMPLICIT NONE @@ -110,15 +98,10 @@ SUBROUTINE EMP0_0 INTEGER(LONG) :: DELTA_LTERM_MGGE ! Increment of LTERM_MGGE for one element INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EMP0_BEGEND + 1 + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process the elements: Assume mass has no coupling from one grid to another @@ -145,12 +128,7 @@ SUBROUTINE EMP0_0 WRITE(F06,4321) LTERM_MGGE, SETLKTM ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -169,12 +147,11 @@ SUBROUTINE EMP0_3 ! Estimates LTERM_MGG based on actual element mass matrices unconnected. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, LTERM_MGGE, MELDOF, NELE, NSUB USE PARAMS, ONLY : EPSIL, SETLKTM, SPARSTOR, SUPINFO USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : EMP0_BEGEND USE MODEL_STUF, ONLY : ELDOF, NUM_EMG_FATAL_ERRS, ME, PLY_NUM, TYPE IMPLICIT NONE @@ -185,19 +162,14 @@ SUBROUTINE EMP0_3 INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: IERROR ! Local error indicator INTEGER(LONG) :: KSTART ! Index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EMP0_BEGEND + REAL(DOUBLE) :: DQE(MELDOF,NSUB) ! Dummy array in call to ELEM_TRANSFORM_LBG REAL(DOUBLE) :: EPS1 ! A small number to compare real zero INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -276,12 +248,7 @@ SUBROUTINE EMP0_3 WRITE(F06,4321) LTERM_MGGE, SETLKTM ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/ESP.f90 b/Source/LK1/L1E/ESP.f90 index 77a2b441..4cf47c37 100644 --- a/Source/LK1/L1E/ESP.f90 +++ b/Source/LK1/L1E/ESP.f90 @@ -37,8 +37,8 @@ SUBROUTINE ESP USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, F23, F23FIL, F23_MSG, F24, F24FIL, F24_MSG, FILE_NAM_MAXLEN, SC1, SCR, & - WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, F23, F23FIL, F23_MSG, F24, F24FIL, F24_MSG, FILE_NAM_MAXLEN, SC1, SCR, & + WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, ELDT_BUG_KE_BIT, ELDT_BUG_SE_BIT, & ELDT_F23_KE_BIT, ELDT_F24_SE_BIT, ELDT_BUG_BCHK_BIT, ELDT_BUG_BMAT_BIT, ELDT_BUG_SHPJ_BIT,& FATAL_ERR, IBIT, LINKNO, LTERM_KGG, LTERM_KGGD, MBUG, MELDOF, NDOFG, NELE, NGRID, & @@ -46,7 +46,6 @@ SUBROUTINE ESP USE PARAMS, ONLY : EPSIL, SPARSTOR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : ESP_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : AGRID, ELDT, ELDOF, ELGP, GRID_ID, NUM_EMG_FATAL_ERRS, PLY_NUM, OELDT, KE, KED, TYPE @@ -91,7 +90,7 @@ SUBROUTINE ESP INTEGER(LONG) :: TDOF_ROW_NUM ! Row number in array TDOF ! Indicator for output of elem data to BUG file INTEGER(LONG) :: LTERM ! Either LTERM_KGGD (BUCKLING) or LTERM_KGG otherwise - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP_BEGEND + REAL(DOUBLE) :: DQE(MELDOF,NSUB) ! Dummy array in call to ELEM_TRANSFORM_LBG REAL(DOUBLE) :: EPS1 ! A small number to compare real zero @@ -100,12 +99,7 @@ SUBROUTINE ESP INTRINSIC :: IAND INTRINSIC :: MAX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -235,7 +229,7 @@ SUBROUTINE ESP DO J = 1,ELGP CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(J), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) TDOF_ROW_NUM = ROW_NUM_START + K - 1 @@ -491,8 +485,8 @@ SUBROUTINE ESP SCRFIL(1:9) = 'SCRATCH-991' OPEN (SCR(1),STATUS='SCRATCH',POSITION='REWIND',FORM='UNFORMATTED',ACTION='READWRITE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SCRFIL, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL OPNERR ( IOCHK, SCRFIL, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ENDIF REWIND (SCR(1)) @@ -509,12 +503,12 @@ SUBROUTINE ESP READ(SCR(1),IOSTAT=IOCHK) STF3(I) IF (IOCHK /= 0) THEN REC_NO = J - CALL READERR ( IOCHK, SCRFIL, 'SCR FILE WITH STF3', REC_NO, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL READERR ( IOCHK, SCRFIL, 'SCR FILE WITH STF3', REC_NO, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Error reading scratch file, so quit ENDIF ENDDO - CALL FILE_CLOSE (SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE (SCR(1), SCRFIL, 'DELETE' ) ! Reset LTERM and NTERM to appropriate values @@ -552,12 +546,7 @@ SUBROUTINE ESP WRITE(F06,*) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -606,7 +595,7 @@ SUBROUTINE DUMPSTF ( WHAT, J, K, KGG_ROW, KGG_COL, IS, ISS ) ! Prints out info on the formulation of stiffness arrays for subr ESP, which generates the arrays USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06 USE MODEL_STUF, ONLY : EID USE STF_ARRAYS, ONLY : STF3 @@ -666,7 +655,7 @@ END SUBROUTINE DUMPSTF SUBROUTINE WRITE_NEG_DIAG_STIFFNESS ( WHAT ) USE CONSTANTS_1,ONLY : ZERO - USE MODEL_STUF, ONLY : AGRID, EID, ELGP, ELDOF, TYPE + USE MODEL_STUF, ONLY : AGRID, BGRID, EID, ELGP, ELDOF, TYPE IMPLICIT NONE @@ -715,7 +704,7 @@ SUBROUTINE WRITE_NEG_DIAG_STIFFNESS ( WHAT ) WRITE(F06,97533) KK=0 DO LL=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(LL), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(LL), NUM_COMPS, SUBR_NAME ) DO MM=1,NUM_COMPS KK = KK + 1 RATIO = ZERO diff --git a/Source/LK1/L1E/ESP0.f90 b/Source/LK1/L1E/ESP0.f90 index 3a2e5569..37c27999 100644 --- a/Source/LK1/L1E/ESP0.f90 +++ b/Source/LK1/L1E/ESP0.f90 @@ -48,13 +48,12 @@ SUBROUTINE ESP0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, KMAT_BW, KMAT_DEN, LTERM_KGG, LTERM_KGGD, SOL_NAME USE PARAMS, ONLY : GRIDSEQ, SETLKTK, SUPINFO, USR_LTERM_KGG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : ESP0_BEGEND USE ESP0_USE_IFs @@ -64,14 +63,9 @@ SUBROUTINE ESP0 CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ESP0' INTEGER(LONG) :: LTERM ! Count of number of estimated terms in KGG or KGGD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP0_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** IF (SETLKTK == 0) THEN ! LTERM based on full elem stiffness matrices unconnected @@ -112,12 +106,7 @@ SUBROUTINE ESP0 LTERM_KGG = LTERM ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -132,12 +121,11 @@ SUBROUTINE ESP0_0 ( LTERM ) ! Estimates LTERM based on full elem stiffness matrices in an unassembled state (not connected) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, NELE, SOL_NAME USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SPARSTOR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : ESP0_BEGEND USE MODEL_STUF, ONLY : EDAT, EPNT, ETYPE, ELGP, TYPE use model_stuf, only : eid @@ -148,15 +136,10 @@ SUBROUTINE ESP0_0 ( LTERM ) INTEGER(LONG), INTENT(OUT) :: LTERM ! Count of number of estimated terms in KGG or KGGD INTEGER(LONG) :: DELTA_LTERM ! Increment of LTERM for one element INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP0_BEGEND + 1 + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process the elements: Asume each is has a stiffness matrix that is completely full @@ -190,12 +173,7 @@ SUBROUTINE ESP0_0 ( LTERM ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -217,25 +195,19 @@ SUBROUTINE ESP0_1 ( LTERM ) ! Estimates LTERM based on number of rows in the stiff matrix times the stiffness matrix bandwidth from BANDIT. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, F06 + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : KMAT_BW, KMAT_DEN, NDOFG, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ESP0_BEGEND IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ESP0_1' INTEGER(LONG), INTENT(OUT) :: LTERM ! Count of number of estimated terms in KGG or KGGD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP0_BEGEND + 1 + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Estimate number of nonzero terms as the number of rows in the stiff matrix times the stiff matrix bandwidth: @@ -254,12 +226,7 @@ SUBROUTINE ESP0_1 ( LTERM ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -283,27 +250,21 @@ SUBROUTINE ESP0_2 ( LTERM ) ! Estimates LTERM based on the full size of the stiffness matrix times the density returned from subr BANDIT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, F06 + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, KMAT_BW, KMAT_DEN, NDOFG, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE_HUNDRED USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : ESP0_BEGEND IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ESP0_2' INTEGER(LONG), INTENT(OUT) :: LTERM ! Count of number of estimated terms in KGG or KGGD - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP0_BEGEND + 1 + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Estimate number of nonzero terms as the number of rows in the stiff matrix times the stiff matrix bandwidth: @@ -322,12 +283,7 @@ SUBROUTINE ESP0_2 ( LTERM ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -351,13 +307,12 @@ SUBROUTINE ESP0_3 ( LTERM ) ! Estimates LTERM based on actual element stiffness matrices unconnected. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MELDOF, NELE, NSUB, SOL_NAME USE PARAMS, ONLY : EPSIL, SETLKTK, SPARSTOR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : ESP0_BEGEND USE MODEL_STUF, ONLY : ELDOF, NUM_EMG_FATAL_ERRS, PLY_NUM, KE, TYPE IMPLICIT NONE @@ -369,19 +324,14 @@ SUBROUTINE ESP0_3 ( LTERM ) INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: IERROR ! Local error indicator INTEGER(LONG) :: KSTART ! Index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP0_BEGEND + REAL(DOUBLE) :: DQE(MELDOF,NSUB) ! Dummy array in call to ELEM_TRANSFORM_LBG REAL(DOUBLE) :: EPS1 ! A small number to compare real zero INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -475,12 +425,7 @@ SUBROUTINE ESP0_3 ( LTERM ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -504,7 +449,7 @@ SUBROUTINE DUMPSTF0 ( WHAT, J, K, KGG_ROW, KGG_COL ) ! Prints out info on the formulation of stiffness arrays for subr ESP0_3 which estimates LTERM for subr ESP USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE MODEL_STUF, ONLY : EID IMPLICIT NONE diff --git a/Source/LK1/L1E/ESP0_FINAL.f90 b/Source/LK1/L1E/ESP0_FINAL.f90 index bad78299..18fbb386 100644 --- a/Source/LK1/L1E/ESP0_FINAL.f90 +++ b/Source/LK1/L1E/ESP0_FINAL.f90 @@ -32,12 +32,11 @@ SUBROUTINE ESP0_FINAL ! the exact LTERM_KGG and then calculate them in subr ESP. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, IBIT, LTERM_KGG, MELDOF, NELE, NGRID, NTERM_KGG, NSUB USE PARAMS, ONLY : EPSIL, SPARSTOR, SUPINFO USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : ESP0_FINAL_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : AGRID, ELDT, ELDOF, ELGP, GRID_ID, NUM_EMG_FATAL_ERRS, PLY_NUM, KE, TYPE USE STF_ARRAYS, ONLY : STFKEY, STF3 @@ -68,19 +67,14 @@ SUBROUTINE ESP0_FINAL INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: TDOF_ROW_NUM ! Row number in array TDOF ! Indicator for output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ESP0_FINAL_BEGEND + REAL(DOUBLE) :: DQE(MELDOF,NSUB) ! Dummy array in call to ELEM_TRANSFORM_LBG REAL(DOUBLE) :: EPS1 ! A small number to compare real zero INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -120,7 +114,7 @@ SUBROUTINE ESP0_FINAL !xx CALL CALC_TDOF_ROW_NUM ( AGRID(J), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(J), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(J), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, SUBR_NAME ) DO K = 1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL_NUM ) TDOF_ROW_NUM = ROW_NUM_START + K - 1 @@ -219,12 +213,7 @@ SUBROUTINE ESP0_FINAL WRITE(F06,4321) LTERM_KGG ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 b/Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 index cfeabfee..7c88d389 100644 --- a/Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 +++ b/Source/LK1/L1E/KGG_SINGULARITY_PROC.f90 @@ -33,12 +33,11 @@ SUBROUTINE KGG_SINGULARITY_PROC ( AGRID, KGRD, NUM_ASPC_BY_COMP ) ! the 3 eigenvales to the max value (among the 3) and, if the ratio is less than AUTOSPC_RAT, mark the DOF for AUTOSPC. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SPC + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SPC USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFSA, NGRID, NUM_PCHD_SPC1 USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : AUTOSPC, AUTOSPC_INFO, AUTOSPC_RAT, EPSIL, PCHSPC1, SPC1SID, SUPINFO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : KGG_SINGULARITY_PROC_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START, TDOFI, TSET USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : GRID_ID @@ -70,7 +69,7 @@ SUBROUTINE KGG_SINGULARITY_PROC ( AGRID, KGRD, NUM_ASPC_BY_COMP ) INTEGER(LONG) :: O_SET_COL ! Col no. in array TDOF where the O-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: R_SET_COL ! Col no. in array TDOF where the R-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = KGG_SINGULARITY_PROC_BEGEND + REAL(DOUBLE) , INTENT(IN) :: KGRD(6,6) ! 6x6 diagonal stiffness matrix for grid point AGRID REAL(DOUBLE) :: FAC ! Multipling factor used in an intermediate calc @@ -83,12 +82,7 @@ SUBROUTINE KGG_SINGULARITY_PROC ( AGRID, KGRD, NUM_ASPC_BY_COMP ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -112,7 +106,7 @@ SUBROUTINE KGG_SINGULARITY_PROC ( AGRID, KGRD, NUM_ASPC_BY_COMP ) !xx CALL CALC_TDOF_ROW_NUM ( AGRID, ROW_NUM_START, 'N' )! Det where in TDOF (not TDOFI) the DOF data begins for AGRID CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID, IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, 'N' ) + CALL GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, 'N' ) comps:IF (NUM_COMPS == 6) THEN ! Physical grid with 6 components represented in KGRD comps6: DO K=1,2 ! K=1 is for translational DOF's and K=2 is for rotational DOF's @@ -267,12 +261,7 @@ SUBROUTINE KGG_SINGULARITY_PROC ( AGRID, KGRD, NUM_ASPC_BY_COMP ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -296,7 +285,7 @@ SUBROUTINE K33_EIGENS (K33, K33_LAMBDAS, K33_VECS, INFO ) ! Jacobi solution for 3x3 eigenvalue problem used in finding the eigenvalues of a 3x3 diag partition of a 6x6 grid stiffness matrix USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE CONSTANTS_1, ONLY : ZERO USE LAPACK_STD_EIG_1 @@ -384,7 +373,7 @@ SUBROUTINE KGG_SING_PROC_DEBUG ( WHAT ) ! Debug output for KGG singularity calcs USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE LAPACK_STD_EIG_1 diff --git a/Source/LK1/L1E/MGGC_MASS_MATRIX.f90 b/Source/LK1/L1E/MGGC_MASS_MATRIX.f90 index 2c7f514a..b2f42e5d 100644 --- a/Source/LK1/L1E/MGGC_MASS_MATRIX.f90 +++ b/Source/LK1/L1E/MGGC_MASS_MATRIX.f90 @@ -29,12 +29,11 @@ SUBROUTINE MGGC_MASS_MATRIX ! Forms the mass matrix, MGGC, for concentrated masses by calling subr MGG_CONM2_PROC to process the concentrated masses USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : NGRID, NTERM_MGGC, BLNK_SUB_NAM USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, SPARSTOR, WTMASS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MGGC_MASS_MATRIX_BEGEND USE MODEL_STUF, ONLY : AGRID, GRID_ID, INV_GRID_SEQ USE SPARSE_MATRICES, ONLY : I_MGGC, J_MGGC, MGGC @@ -57,19 +56,14 @@ SUBROUTINE MGGC_MASS_MATRIX INTEGER(LONG) :: KSTART ! Used in deciding whether to process all elem mass terms or only ! the ones on and above the diagonal (controlled by param SPARSTOR) INTEGER(LONG) :: MGGC_COL_NUM ! A calculated col number for a nonzero term in MGG arrays - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MGGC_MASS_MATRIX_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: MGG_CONM2(6,6) ! 6 X 6 mass matrix in global coords for one CONM2 INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -84,10 +78,9 @@ SUBROUTINE MGGC_MASS_MATRIX IROW_START = 1 i_do1:DO I=1,NGRID -!xx GRID_NUM = GRID_ID(INV_GRID_SEQ(I)) ! GRID_NUM's are in TDOFI order (internal DOF order) - GRID_NUM = GRID_ID(I) + GRID_NUM = GRID_ID(INV_GRID_SEQ(I)) ! GRID_NUM's are in TDOFI order (internal DOF order) CALL MGG_CONM2_PROC ( I, GRID_NUM, MGG_CONM2, MGG_CONM2_NONZERO ) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) IF (MGG_CONM2_NONZERO == 'Y') THEN DO J=1,NUM_COMPS @@ -130,12 +123,7 @@ SUBROUTINE MGGC_MASS_MATRIX ! Do not deallocate MGGC arrays - they are needed later in subr SPARSE_MGG -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -150,10 +138,9 @@ SUBROUTINE MGG_CONM2_PROC ( INT_GRID_ID, GRID_NUM, MGG_CONM2, MGG_CONM2_NONZERO ! Generates 6 x 6 mass matrix, MGG_CONM2, for one CONM2 for grid GRID_NUM (if there is any CONM2 connected to this grid) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NCONM2, NGRID, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MGGC_MASS_MATRIX_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : CONM2, RCONM2 USE PARAMS, ONLY : ART_MASS, ART_ROT_MASS, ART_TRAN_MASS @@ -167,16 +154,11 @@ SUBROUTINE MGG_CONM2_PROC ( INT_GRID_ID, GRID_NUM, MGG_CONM2, MGG_CONM2_NONZERO ! one CONM2 (if one exists for this grid) INTEGER(LONG), INTENT(IN) :: GRID_NUM ! The actual grid number for internal grid ID INT_GRID_ID INTEGER(LONG) :: I,J,L ! DO loop indices or counters - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MGGC_MASS_MATRIX_BEGEND + 1 + REAL(DOUBLE) , INTENT(OUT) :: MGG_CONM2(6,6) ! 6 X 6 mass matrix in global coords for one CONM2 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -248,12 +230,7 @@ SUBROUTINE MGG_CONM2_PROC ( INT_GRID_ID, GRID_NUM, MGG_CONM2, MGG_CONM2_NONZERO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/MGGS_MASS_MATRIX.f90 b/Source/LK1/L1E/MGGS_MASS_MATRIX.f90 index 9d3f7b29..706124d5 100644 --- a/Source/LK1/L1E/MGGS_MASS_MATRIX.f90 +++ b/Source/LK1/L1E/MGGS_MASS_MATRIX.f90 @@ -29,7 +29,7 @@ SUBROUTINE MGGS_MASS_MATRIX ! Forms the sparse scalar mass matrix, MGGS, (for masses defined on Bulk Data CMASS) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR, NCMASS, NDOFG, NGRID, NPMASS, NTERM_MGGS, BLNK_SUB_NAM USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -38,7 +38,6 @@ SUBROUTINE MGGS_MASS_MATRIX USE DOF_TABLES, ONLY : TDOF USE MODEL_STUF, ONLY : CMASS, GRID_ID, PMASS, RPMASS USE SPARSE_MATRICES, ONLY : I_MGGS, J_MGGS, MGGS - USE SUBR_BEGEND_LEVELS, ONLY : MGGS_MASS_MATRIX_BEGEND USE MGGS_MASS_MATRIX_USE_IFs @@ -56,18 +55,13 @@ SUBROUTINE MGGS_MASS_MATRIX INTEGER(LONG) :: ROW_NUM ! Row number in TDOF where data begins for IGRID INTEGER(LONG) :: SGRID(NCMASS) ! Grid number for a scalar mass (from array CMASS) INTEGER(LONG) :: PMASS_ID(NCMASS) ! Prop ID for the CMASS that is attached to SGRID(I) (from array PMASS) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MGGS_MASS_MATRIX_BEGEND + REAL(DOUBLE) :: PMASS_VAL(NCMASS) ! Value for the mass attached to SGRID(I) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -167,12 +161,7 @@ SUBROUTINE MGGS_MASS_MATRIX NTERM_MGGS = KTERM_MGGS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/SPARSE_KGG.f90 b/Source/LK1/L1E/SPARSE_KGG.f90 index 4e8096de..9958d139 100644 --- a/Source/LK1/L1E/SPARSE_KGG.f90 +++ b/Source/LK1/L1E/SPARSE_KGG.f90 @@ -35,11 +35,10 @@ SUBROUTINE SPARSE_KGG ! (3) Call TDOF_PROC to regenerate TDOF, TDOFI tables if KGG_SINGULARITY_PROC found singularities USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1L, L1L_MSG, LINK1L, SC1, SPCFIL, SPC, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1L, L1L_MSG, LINK1L, SC1, SPCFIL, SPC, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NGRID, NIND_GRDS_MPCS, & NTERM_KGG, NUM_PCHD_SPC1, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_KGG_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : AUTOSPC, AUTOSPC_RAT, EPSIL, PRTTSET, PRTSTIFF, SPC1QUIT, SUPINFO, SUPWARN USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -81,7 +80,7 @@ SUBROUTINE SPARSE_KGG INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: RJ(NDOFG) ! Column numbers corresponding to the terms in RSTF(I). - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_KGG_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: KGG_II(6,6) ! 6 x 6 diagonal stiffness matrices for 1 grid @@ -93,12 +92,7 @@ SUBROUTINE SPARSE_KGG INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -160,15 +154,15 @@ SUBROUTINE SPARSE_KGG OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1L, LINK1L, OUNT, 'REPLACE', L1L_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1L, LINK1L, OUNT, 'REPLACE', L1L_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) WRITE(L1L) NTERM_KGG ! Open SPC to write SPC1 records if KGG_SINGULARITY_PROC finds singularities OPEN (SPC,FILE=SPCFIL,STATUS='REPLACE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SPCFIL, OUNT, 'Y') - CALL FILERR ( OUNT, 'Y' ) + CALL OPNERR ( IOCHK, SPCFIL, OUNT ) + CALL FILERR ( OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF @@ -198,7 +192,7 @@ SUBROUTINE SPARSE_KGG CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(INV_GRID_SEQ(I)), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) KGG_COL_NUM = TDOF(ROW_NUM_START,G_SET_COL) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) k_do: DO K=1,NUM_COMPS KGG_ROW_NUM = KGG_ROW_NUM + 1 @@ -319,14 +313,14 @@ SUBROUTINE SPARSE_KGG ENDIF IF (NUM_PCHD_SPC1 > 0) THEN ! Close SPC file and, if any records were written to it, save it - CALL FILE_CLOSE ( SPC, SPCFIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( SPC, SPCFIL, 'KEEP' ) IF (SPC1QUIT == 'Y') THEN WRITE(ERR,9991) SUBR_NAME, SPC1QUIT WRITE(F06,9991) SUBR_NAME, SPC1QUIT CALL OUTA_HERE ( 'Y' ) ENDIF ELSE - CALL FILE_CLOSE ( SPC, SPCFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SPC, SPCFIL, 'DELETE' ) ENDIF IF (KTERM_KGG /= NTERM_KGG) THEN ! Check KTERM_KGG = NTERM_KGG @@ -336,18 +330,13 @@ SUBROUTINE SPARSE_KGG CALL OUTA_HERE ( 'Y' ) ! Coding error, so quit ENDIF - CALL FILE_CLOSE ( L1L, LINK1L, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1L, LINK1L, 'KEEP' ) WRITE(ERR,101) NUM_MAX IF (SUPINFO == 'N') THEN WRITE(F06,101) NUM_MAX ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/SPARSE_KGGD.f90 b/Source/LK1/L1E/SPARSE_KGGD.f90 index c654eb08..7dc0923b 100644 --- a/Source/LK1/L1E/SPARSE_KGGD.f90 +++ b/Source/LK1/L1E/SPARSE_KGGD.f90 @@ -30,11 +30,10 @@ SUBROUTINE SPARSE_KGGD ! each row to be in G-set DOF numerical order. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, SPCFIL, SPC, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, SPCFIL, SPC, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NGRID, NIND_GRDS_MPCS, & NTERM_KGGD, NUM_PCHD_SPC1, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_KGGD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : AUTOSPC, AUTOSPC_RAT, EPSIL, PRTSTIFF, SPC1QUIT, SUPINFO, SUPWARN USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -64,7 +63,7 @@ SUBROUTINE SPARSE_KGGD INTEGER(LONG) :: NZERO = 0 ! Count on zero terms in array STF INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: RJ(NDOFG) ! Column numbers corresponding to the terms in RSTF(I). - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_KGGD_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: KGGD_II(6,6) ! 6 x 6 diagonal stiffness matrices for 1 grid @@ -74,12 +73,7 @@ SUBROUTINE SPARSE_KGGD INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -156,7 +150,7 @@ SUBROUTINE SPARSE_KGGD CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(INV_GRID_SEQ(I)), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) KGGD_COL_NUM = TDOF(ROW_NUM_START,G_SET_COL) - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) k_do: DO K=1,NUM_COMPS KGGD_ROW_NUM = KGGD_ROW_NUM + 1 @@ -232,12 +226,7 @@ SUBROUTINE SPARSE_KGGD WRITE(F06,101) NUM_MAX ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/SPARSE_MGG.f90 b/Source/LK1/L1E/SPARSE_MGG.f90 index d45e36d7..75dd30c9 100644 --- a/Source/LK1/L1E/SPARSE_MGG.f90 +++ b/Source/LK1/L1E/SPARSE_MGG.f90 @@ -30,11 +30,10 @@ SUBROUTINE SPARSE_MGG ! sparse G-set mass matrix, MGG. Rows are sorted to be in numerical G-set DOF order and the final MGG is written to file LINK1R USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1R, L1R_MSG, LINK1R, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1R, L1R_MSG, LINK1R, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCMASS, NDOFG, NGRID, NTERM_MGG, NTERM_MGGC, NTERM_MGGE, & NTERM_MGGS, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_MGG_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO, ONE USE DOF_TABLES,ONLY : TDOF_ROW_START @@ -70,7 +69,7 @@ SUBROUTINE SPARSE_MGG INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: RJ(NDOFG) ! Column numbers corresponding to the terms in REMS(I). INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_MGG_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: GRID_MGG(6,6) ! 6 x 6 mass matrix for a grid @@ -81,12 +80,7 @@ SUBROUTINE SPARSE_MGG INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -133,7 +127,7 @@ SUBROUTINE SPARSE_MGG OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1R, LINK1R, OUNT, 'REPLACE', L1R_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1R, LINK1R, OUNT, 'REPLACE', L1R_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) KTERM_MGGE = 0 I_MGGE(1) = 1 @@ -146,7 +140,7 @@ SUBROUTINE SPARSE_MGG !xx CALL CALC_TDOF_ROW_NUM ( GRID_NUM, IROW_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) k_do: DO K=1,NUM_COMPS IK = ROW_NUM_START + K - 1 @@ -291,7 +285,7 @@ SUBROUTINE SPARSE_MGG ENDDO ENDIF - CALL FILE_CLOSE ( L1R, LINK1R, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1R, LINK1R, 'KEEP' ) ! Get stats on MGG to write to F06 @@ -320,7 +314,7 @@ SUBROUTINE SPARSE_MGG IF (DEBUG(36) > 0) THEN WRITE(F06,1101) DO K=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(K), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( K, NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Only do output for actual grids, not SPOINT's CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(K), IGRID ) IF (IGRID == -1) THEN @@ -344,12 +338,7 @@ SUBROUTINE SPARSE_MGG WRITE(F06,1104) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/SPARSE_PG.f90 b/Source/LK1/L1E/SPARSE_PG.f90 index c537515f..aa20c4ef 100644 --- a/Source/LK1/L1E/SPARSE_PG.f90 +++ b/Source/LK1/L1E/SPARSE_PG.f90 @@ -30,10 +30,9 @@ SUBROUTINE SPARSE_PG ! written (for nonzero loads) is: G-set DOF number, internal subcase number, non-zero load value USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1E, L1E_MSG, L1ESTAT, LINK1E, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1E, L1E_MSG, L1ESTAT, LINK1E, SC1, WRT_ERR USE SCONTR, ONLY : FATAL_ERR, NDOFG, NSUB, NTERM_PG, BLNK_SUB_NAM, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_PG_BEGEND USE PARAMS, ONLY : EPSIL, PRTFOR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP, NL_NUM_LOAD_STEPS USE MODEL_STUF, ONLY : SYS_LOAD @@ -49,18 +48,13 @@ SUBROUTINE SPARSE_PG INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: KTERM_PG ! Count of the number of terms written to file L1E for PG loads INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_PG_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -69,7 +63,7 @@ SUBROUTINE SPARSE_PG OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1E, LINK1E, OUNT, 'REPLACE', L1E_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1E, LINK1E, OUNT, 'REPLACE', L1E_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ! Count the nonzero's in SYS_LOAD @@ -139,9 +133,9 @@ SUBROUTINE SPARSE_PG IF (NTERM_PG > 0) THEN - CALL FILE_CLOSE ( L1E, LINK1E, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1E, LINK1E, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1E, LINK1E, L1ESTAT, 'Y' ) + CALL FILE_CLOSE ( L1E, LINK1E, L1ESTAT ) ENDIF IF (PRTFOR(1) == 1) THEN ! Print PG if requested @@ -159,12 +153,7 @@ SUBROUTINE SPARSE_PG ,/,15X,A & ,/,14X,' WAS KTERM_PG = ',I12,'. IT SHOULD HAVE BEEN NTERM_PG = ',I12) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1E/SPARSE_RMG.f90 b/Source/LK1/L1E/SPARSE_RMG.f90 index d6bbfc07..7d1a42f8 100644 --- a/Source/LK1/L1E/SPARSE_RMG.f90 +++ b/Source/LK1/L1E/SPARSE_RMG.f90 @@ -30,11 +30,10 @@ SUBROUTINE SPARSE_RMG ! constraint matrix is written to file LINK1J in format: i, j, RMG(i,j) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1J, LINK1J, L1J_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1J, LINK1J, L1J_MSG USE SCONTR, ONLY : NDOFM, NTERM_RMG, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_RMG_BEGEND USE PARAMS, ONLY : EPSIL USE SPARSE_MATRICES, ONLY : I_RMG, J_RMG, RMG @@ -58,19 +57,14 @@ SUBROUTINE SPARSE_RMG INTEGER(LONG) :: NTERM_ROW_I ! Number of nonzero terms in row I of RMG INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: REC_NO ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_RMG_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: RRMG ! Real value for RMG INTRINSIC DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -84,7 +78,7 @@ SUBROUTINE SPARSE_RMG IF (NDOFM > 0) THEN - CALL FILE_OPEN ( L1J, LINK1J, OUNT, 'OLD', L1J_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1J, LINK1J, OUNT, 'OLD', L1J_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) NTERM_RMG = 0 ! First, calc NTERM_RMG REC_NO = 0 @@ -100,17 +94,17 @@ SUBROUTINE SPARSE_RMG CYCLE nterm ENDIF ELSE IF (IOCHK > 0) THEN - CALL READERR ( IOCHK, LINK1J, L1J_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1J, L1J_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading RMG file, so quit ELSE EXIT nterm ENDIF ENDDO nterm - CALL FILE_CLOSE ( L1J, LINK1J, 'KEEP', 'N' ) + CALL FILE_CLOSE ( L1J, LINK1J, 'KEEP' ) ! Allocate memory for RMG sparse arrays CALL ALLOCATE_SPARSE_MAT ( 'RMG', NDOFM, NTERM_RMG, SUBR_NAME ) - CALL FILE_OPEN ( L1J, LINK1J, OUNT, 'OLD', L1J_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1J, LINK1J, OUNT, 'OLD', L1J_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) KTERM_RMG = 0 REC_NO = 0 @@ -130,7 +124,7 @@ SUBROUTINE SPARSE_RMG CYCLE read_l1j ENDIF ELSE IF (IOCHK > 0) THEN - CALL READERR ( IOCHK, LINK1J, L1J_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1J, L1J_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Error reading RMG file, so quit ELSE EXIT read_l1j @@ -145,7 +139,7 @@ SUBROUTINE SPARSE_RMG ENDIF ENDDO - CALL FILE_CLOSE ( L1J, LINK1J, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1J, LINK1J, 'DELETE' ) ! Sort RMG so that the rows (M-set DOF's) are in numerically increasing order @@ -153,12 +147,12 @@ SUBROUTINE SPARSE_RMG ! Rewrite RMG matrix in the format i, j, RMG(i,j) to L1J - CALL FILE_OPEN ( L1J, LINK1J, OUNT, 'REPLACE', L1J_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1J, LINK1J, OUNT, 'REPLACE', L1J_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) WRITE(L1J) NTERM_RMG DO I=1,NTERM_RMG WRITE(L1J) I2_RMG(I),J_RMG(I),RMG(I) ENDDO - CALL FILE_CLOSE ( L1J, LINK1J, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1J, LINK1J, 'KEEP' ) ENDIF @@ -173,12 +167,7 @@ SUBROUTINE SPARSE_RMG I_RMG(IRMG+1) = I_RMG(IRMG+1) + 1 ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/CHAR_FLD.f90 b/Source/LK1/L1U/CHAR_FLD.f90 index 25ecf80e..7f6e228d 100644 --- a/Source/LK1/L1U/CHAR_FLD.f90 +++ b/Source/LK1/L1U/CHAR_FLD.f90 @@ -29,7 +29,7 @@ SUBROUTINE CHAR_FLD ( JCARDI, IFLD, CHAR_INP ) ! Reads a field of CHARACTER data that can be 1 to LEN(JCARDI) chars in length USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR USE CHAR_FLD_USE_IFs diff --git a/Source/LK1/L1U/CHECK_BAR_MOIs.f90 b/Source/LK1/L1U/CHECK_BAR_MOIs.f90 index 41d52100..6fbf602c 100644 --- a/Source/LK1/L1U/CHECK_BAR_MOIs.f90 +++ b/Source/LK1/L1U/CHECK_BAR_MOIs.f90 @@ -29,12 +29,11 @@ SUBROUTINE CHECK_BAR_MOIs ( NAME, ID, I1, I2, I12, IERR ) ! Checks sensibility of the 3 MOI's of a BAR or BEAM element and replaces zero values with small finite ones USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL, SUPINFO USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : CHECK_BAR_MOIs_BEGEND USE CHECK_BAR_MOIs_USE_IFs @@ -45,19 +44,13 @@ SUBROUTINE CHECK_BAR_MOIs ( NAME, ID, I1, I2, I12, IERR ) CHARACTER(LEN=*), INTENT(IN) :: ID ! Character value of the bar's ID INTEGER(LONG), INTENT(OUT) :: IERR ! Error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CHECK_BAR_MOIs_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: I1 ! MOI of the bar or beam REAL(DOUBLE), INTENT(INOUT) :: I2 ! MOI of the bar or beam REAL(DOUBLE), INTENT(INOUT) :: I12 ! MOI of the bar or beam REAL(DOUBLE) :: EPS1 ! A small number -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF ! ********************************************************************************************************************************** ! Initialize @@ -96,12 +89,7 @@ SUBROUTINE CHECK_BAR_MOIs ( NAME, ID, I1, I2, I12, IERR ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/CRDERR.f90 b/Source/LK1/L1U/CRDERR.f90 index f719ae29..a1fde543 100644 --- a/Source/LK1/L1U/CRDERR.f90 +++ b/Source/LK1/L1U/CRDERR.f90 @@ -29,10 +29,9 @@ SUBROUTINE CRDERR ( CARD ) ! Prints Bulk Data card errors and warnings USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ECHO, IERRFL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CRDERR_BEGEND USE CRDERR_USE_IFs @@ -43,14 +42,9 @@ SUBROUTINE CRDERR ( CARD ) CHARACTER( 1*BYTE) :: CARD_ERR ! = 'Y' if IERRFL is 'Y' for any Bulk Data card field INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CRDERR_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CARD_ERR = 'N' @@ -78,12 +72,7 @@ SUBROUTINE CRDERR ( CARD ) IERRFL(I) = 'N' ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/GET_ANSID.f90 b/Source/LK1/L1U/GET_ANSID.f90 index 2a42af8e..86a3582f 100644 --- a/Source/LK1/L1U/GET_ANSID.f90 +++ b/Source/LK1/L1U/GET_ANSID.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_ANSID ( CARD, SETID ) ! Gets 'ALL', 'NONE' or set ID from Case Control cards: DISP, ELDATA, ELFORCE, GPFORCE, OLOAD, SPCFORCE, STRESS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : CC_ENTRY_LEN, FATAL_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_ANSID_BEGEND USE GET_ANSID_USE_IFs @@ -56,14 +55,9 @@ SUBROUTINE GET_ANSID ( CARD, SETID ) INTEGER(LONG) :: ISTART ! An input to subr STOKEN, called herein INTEGER(LONG) :: NTOKEN ! An output from subr STOKEN, called herein INTEGER(LONG) :: TOKLEN ! An input to subr STOKEN, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ANSID_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Get 'ALL', 'NONE' or SETID @@ -115,12 +109,7 @@ SUBROUTINE GET_ANSID ( CARD, SETID ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/GET_SETID.f90 b/Source/LK1/L1U/GET_SETID.f90 index 114ef55f..63e125bf 100644 --- a/Source/LK1/L1U/GET_SETID.f90 +++ b/Source/LK1/L1U/GET_SETID.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_SETID ( CARD, SETID ) ! Gets SET ID from CASE CONTROL cards: LOAD, METHOD, MPC, NLPARM, SPC, TEMP USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : CC_ENTRY_LEN, FATAL_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_SETID_BEGEND USE GET_SETID_USE_IFs @@ -56,14 +55,9 @@ SUBROUTINE GET_SETID ( CARD, SETID ) INTEGER(LONG) :: ISTART ! An input to subr STOKEN, called herein INTEGER(LONG) :: NTOKEN ! An output from subr STOKEN, called herein INTEGER(LONG) :: TOKLEN ! An input to subr STOKEN, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_SETID_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Get SETID @@ -111,12 +105,7 @@ SUBROUTINE GET_SETID ( CARD, SETID ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/I4FLD.f90 b/Source/LK1/L1U/I4FLD.f90 index b3b8be9d..d21e1c50 100644 --- a/Source/LK1/L1U/I4FLD.f90 +++ b/Source/LK1/L1U/I4FLD.f90 @@ -29,7 +29,7 @@ SUBROUTINE I4FLD ( JCARDI, IFLD, I4INP ) ! Reads 8 column field of INTEGER*4 data USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR, JCARD_LEN, MAX_INTEGER_LEN USE I4FLD_USE_IFs diff --git a/Source/LK1/L1U/IP6CHK.f90 b/Source/LK1/L1U/IP6CHK.f90 index b9c0b96a..acba3f9b 100644 --- a/Source/LK1/L1U/IP6CHK.f90 +++ b/Source/LK1/L1U/IP6CHK.f90 @@ -45,11 +45,10 @@ SUBROUTINE IP6CHK ( JCARDI, JCARDO, IP6TYP, TOTAL_NUM_DIGITS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : IP6CHK_BEGEND USE IP6CHK_USE_IFs @@ -65,14 +64,9 @@ SUBROUTINE IP6CHK ( JCARDI, JCARDO, IP6TYP, TOTAL_NUM_DIGITS ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: NUM_DIGITS(6) ! NUM_DIGITS(I) is a count of the num of digits found in JCARDI INTEGER(LONG) :: POSN ! An position in JCARDO - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = IP6CHK_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -177,12 +171,7 @@ SUBROUTINE IP6CHK ( JCARDI, JCARDO, IP6TYP, TOTAL_NUM_DIGITS ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/LEFT_ADJ_BDFLD.f90 b/Source/LK1/L1U/LEFT_ADJ_BDFLD.f90 index 70e079b7..ba719ee3 100644 --- a/Source/LK1/L1U/LEFT_ADJ_BDFLD.f90 +++ b/Source/LK1/L1U/LEFT_ADJ_BDFLD.f90 @@ -29,10 +29,9 @@ SUBROUTINE LEFT_ADJ_BDFLD ( CHR_FLD ) ! Shifts a character string so that it is left adjusted USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LEFT_ADJ_BDFLD_BEGEND USE LEFT_ADJ_BDFLD_USE_IFs @@ -43,14 +42,9 @@ SUBROUTINE LEFT_ADJ_BDFLD ( CHR_FLD ) CHARACTER(LEN=JCARD_LEN) :: TCHR_FLD ! Temporary char field INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LEFT_ADJ_BDFLD_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF (CHR_FLD(1:1) == ' ') THEN ! We need to shift: @@ -68,12 +62,7 @@ SUBROUTINE LEFT_ADJ_BDFLD ( CHR_FLD ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/NEXTC.f90 b/Source/LK1/L1U/NEXTC.f90 index 68d0bdef..0034b300 100644 --- a/Source/LK1/L1U/NEXTC.f90 +++ b/Source/LK1/L1U/NEXTC.f90 @@ -28,10 +28,9 @@ SUBROUTINE NEXTC ( CARD, ICONTINUE, IERR ) ! Looks for a Bulk Data continuation card belonging to a parent card. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1, INFILE + USE IOUNT1, ONLY : ERR, F06, IN1, INFILE USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : NEXTC_BEGEND USE NEXTC_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE NEXTC ( CARD, ICONTINUE, IERR ) INTEGER(LONG) :: IOCHK ! IOSTAT error value from READ INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr READERR INTEGER(LONG) :: REC_NO ! Record number when reading a file. Input to subr READERR - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NEXTC_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize error indicator @@ -152,12 +146,7 @@ SUBROUTINE NEXTC ( CARD, ICONTINUE, IERR ) ENDIF FLUSH(ERR) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/NEXTC0.f90 b/Source/LK1/L1U/NEXTC0.f90 index 62c2be93..6c001e33 100644 --- a/Source/LK1/L1U/NEXTC0.f90 +++ b/Source/LK1/L1U/NEXTC0.f90 @@ -30,10 +30,9 @@ SUBROUTINE NEXTC0 ( CARD, ICONT, IERR ) ! and is the same as NEXTC except that it does not write CARD to F06 ! under any circumstances USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1, INFILE + USE IOUNT1, ONLY : ERR, F06, IN1, INFILE USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, FATAL_ERR, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : NEXTC0_BEGEND USE NEXTC0_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE NEXTC0 ( CARD, ICONT, IERR ) INTEGER(LONG) :: IOCHK ! IOSTAT error value from READ INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr READERR INTEGER(LONG) :: REC_NO ! Record number when reading a file. Input to subr READERR - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NEXTC0_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize error indicator and ICONT @@ -133,17 +127,12 @@ SUBROUTINE NEXTC0 ( CARD, ICONT, IERR ) ELSE BACKSPACE(IN1) REC_NO = -99 - CALL READERR (IOCHK, INFILE, MESSAG, REC_NO, OUNT, 'Y') + CALL READERR (IOCHK, INFILE, MESSAG, REC_NO, OUNT) FATAL_ERR = FATAL_ERR + 1 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/L1U/NEXTC2.f90 b/Source/LK1/L1U/NEXTC2.f90 index f8f9bdcb..4b618e4d 100644 --- a/Source/LK1/L1U/NEXTC2.f90 +++ b/Source/LK1/L1U/NEXTC2.f90 @@ -29,10 +29,9 @@ SUBROUTINE NEXTC2 ( PARENT, ICONTINUE, IERR, CHILD ) ! Looks for 2 physical Bulk Data large field format continuation ! entries belonging to a large field parent. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1, INFILE + USE IOUNT1, ONLY : ERR, F06, IN1, INFILE USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : NEXTC2_BEGEND USE NEXTC2_USE_IFs @@ -56,7 +55,7 @@ SUBROUTINE NEXTC2 ( PARENT, ICONTINUE, IERR, CHILD ) INTEGER(LONG) :: IOCHK ! IOSTAT error value from READ INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr READERR INTEGER(LONG) :: REC_NO ! Record number when reading a file. Input to subr READERR - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NEXTC2_BEGEND + ! ********************************************************************************************************************************** ! Initialize diff --git a/Source/LK1/L1U/NEXTC20.f90 b/Source/LK1/L1U/NEXTC20.f90 index 444b7cff..f4b79bf8 100644 --- a/Source/LK1/L1U/NEXTC20.f90 +++ b/Source/LK1/L1U/NEXTC20.f90 @@ -29,10 +29,9 @@ SUBROUTINE NEXTC20 ( PARENT, ICONT, IERR, CHILD ) ! Looks for 2 physical Bulk Data large field format continuation ! entries belonging to a large field parent. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, IN1, INFILE + USE IOUNT1, ONLY : ERR, F06, IN1, INFILE USE SCONTR, ONLY : BD_ENTRY_LEN, BLNK_SUB_NAM, ECHO, FATAL_ERR, JCARD_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : NEXTC20_BEGEND USE NEXTC20_USE_IFs @@ -56,7 +55,7 @@ SUBROUTINE NEXTC20 ( PARENT, ICONT, IERR, CHILD ) INTEGER(LONG) :: IOCHK ! IOSTAT error value from READ INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr READERR INTEGER(LONG) :: REC_NO ! Record number when reading a file. Input to subr READERR - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NEXTC20_BEGEND + ! ********************************************************************************************************************************** ! Initialize @@ -79,7 +78,7 @@ SUBROUTINE NEXTC20 ( PARENT, ICONT, IERR, CHILD ) CALL READ_BDF_LINE(IN1, IOCHK, CHILD1) IF (IOCHK /= 0) THEN REC_NO = -99 - CALL READERR ( IOCHK, INFILE, 'BULK DATA CARD', REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, INFILE, 'BULK DATA CARD', REC_NO, OUNT ) FATAL_ERR = FATAL_ERR + 1 RETURN ENDIF @@ -112,7 +111,7 @@ SUBROUTINE NEXTC20 ( PARENT, ICONT, IERR, CHILD ) CALL READ_BDF_LINE(IN1, IOCHK, CHILD2) IF (IOCHK /= 0) THEN REC_NO = -99 - CALL READERR ( IOCHK, INFILE, 'BULK DATA CARD', REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, INFILE, 'BULK DATA CARD', REC_NO, OUNT ) FATAL_ERR = FATAL_ERR + 1 RETURN ENDIF diff --git a/Source/LK1/L1U/R8FLD.f90 b/Source/LK1/L1U/R8FLD.f90 index 3817d680..197bb05c 100644 --- a/Source/LK1/L1U/R8FLD.f90 +++ b/Source/LK1/L1U/R8FLD.f90 @@ -29,7 +29,7 @@ SUBROUTINE R8FLD ( JCARDI, IFLD, R8INP ) ! Reads 8 column field of REAL DOUBLE data USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR, JCARD_LEN USE CONSTANTS_1, ONLY : ZERO diff --git a/Source/LK1/L1U/STOKEN.f90 b/Source/LK1/L1U/STOKEN.f90 index 36d7753f..21ee1425 100644 --- a/Source/LK1/L1U/STOKEN.f90 +++ b/Source/LK1/L1U/STOKEN.f90 @@ -37,10 +37,9 @@ SUBROUTINE STOKEN ( CALLING_SUBR, TOKSTR, TOKEN_BEG, STRNG_END, NTOKEN, IERROR, ! 2) a triad of char tokens of the form I1 THRU I2 where I1, I2 are integers USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : MAX_TOKEN_LEN, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : STOKEN_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE STOKEN_USE_IFs @@ -67,14 +66,9 @@ SUBROUTINE STOKEN ( CALLING_SUBR, TOKSTR, TOKEN_BEG, STRNG_END, NTOKEN, IERROR, INTEGER(LONG) :: TOKEN_END ! Where, in TOKSTR, the end of the current token is located INTEGER(LONG) :: NUM_TOK_EXP ! No. of tokens we expect (if we find "THRU", we should find 3 tokens) INTEGER(LONG) :: PRINT_ITEM ! An item number to print when DEBUG(19) is turned on - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STOKEN_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -246,12 +240,7 @@ SUBROUTINE STOKEN ( CALLING_SUBR, TOKSTR, TOKEN_BEG, STRNG_END, NTOKEN, IERROR, CALL DEB_STOKEN ( PRINT_ITEM ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -263,24 +252,18 @@ SUBROUTINE STOKEN ( CALLING_SUBR, TOKSTR, TOKEN_BEG, STRNG_END, NTOKEN, IERROR, SUBROUTINE DEB_STOKEN ( PRINT_ITEM ) - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : STOKEN_BEGEND IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEB_STOKEN' INTEGER(LONG), INTENT(IN) :: PRINT_ITEM ! What item to print - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STOKEN_BEGEND + 1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** @@ -325,12 +308,7 @@ SUBROUTINE DEB_STOKEN ( PRINT_ITEM ) 99999 FORMAT(' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' & ,'\\\\\\\\\\\\\\\\\\\\\\\\', //) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN ! ********************************************************************************************************************************** diff --git a/Source/LK1/L1U/TOKCHK.f90 b/Source/LK1/L1U/TOKCHK.f90 index 99b0a271..576a40b2 100644 --- a/Source/LK1/L1U/TOKCHK.f90 +++ b/Source/LK1/L1U/TOKCHK.f90 @@ -43,7 +43,7 @@ SUBROUTINE TOKCHK ( TOKEN, TOKTYPE ) ! TOKTYPE = 'FIJFIL ' if input TOKEN is "FIJFIL" USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TOKCHK_USE_IFs diff --git a/Source/LK1/LINK1/ALLOCATE_EMS_ARRAYS.f90 b/Source/LK1/LINK1/ALLOCATE_EMS_ARRAYS.f90 index 8e6c51b2..1a335ed3 100644 --- a/Source/LK1/LINK1/ALLOCATE_EMS_ARRAYS.f90 +++ b/Source/LK1/LINK1/ALLOCATE_EMS_ARRAYS.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, TWO, ONEPP6 - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO, LTERM_MGGE, NDOFG, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE EMS_ARRAYS, ONLY : EMS, EMSCOL, EMSKEY, EMSPNT - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_EMS_ARRAYS_BEGEND USE ALLOCATE_EMS_ARRAYS_USE_IFs @@ -49,7 +48,7 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows for matrix NAME - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_EMS_ARRAYS_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -61,12 +60,7 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -91,7 +85,6 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NDOFG)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) WRITE(SC1,22345,ADVANCE='NO') NAME, NDOFG, CR13 DO I=1,NDOFG !! WRITE(SC1,12345,ADVANCE='NO') NAME, I, NDOFG, CR13 @@ -120,7 +113,6 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LTERM_MGGE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) WRITE(SC1,22345,ADVANCE='NO') NAME, LTERM_MGGE, CR13 DO I=1,LTERM_MGGE !! WRITE(SC1,12345,ADVANCE='NO') NAME, I, LTERM_MGGE, CR13 @@ -149,7 +141,6 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LTERM_MGGE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) WRITE(SC1,22345,ADVANCE='NO') NAME, LTERM_MGGE, CR13 DO I=1,LTERM_MGGE !! WRITE(SC1,12345,ADVANCE='NO') NAME, I, LTERM_MGGE, CR13 @@ -178,7 +169,6 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LTERM_MGGE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) WRITE(SC1,22345,ADVANCE='NO') NAME, LTERM_MGGE, CR13 DO I=1,LTERM_MGGE !! WRITE(SC1,12345,ADVANCE='NO') NAME, I, LTERM_MGGE, CR13 @@ -203,12 +193,7 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -219,8 +204,6 @@ SUBROUTINE ALLOCATE_EMS_ARRAYS ( CALLING_SUBR ) 991 FORMAT(' *ERROR 991: CANNOT ALLOCATE ',F10.3,' MB OF MEMORY TO ARRAY ',A,' IN SUBROUTINE ',A & ,/,14X,' ALLOCATION STAT = ',I8) - 1092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) 12345 FORMAT(5X,'array ',A6,' row ',I8,' of ',I8, A, A) diff --git a/Source/LK1/LINK1/ALLOCATE_L1_MGG.f90 b/Source/LK1/LINK1/ALLOCATE_L1_MGG.f90 index 3ba7ac51..ee4fa582 100644 --- a/Source/LK1/LINK1/ALLOCATE_L1_MGG.f90 +++ b/Source/LK1/LINK1/ALLOCATE_L1_MGG.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NTERM_MGG, NTERM_MGGC, NTERM_MGGE, NTERM_MGGS, & TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_L1_MGG_BEGEND USE SPARSE_MATRICES, ONLY : I_MGG, I2_MGG, J_MGG, MGG, I_MGGC, J_MGGC, MGGC, I_MGGE, J_MGGE, MGGE, I_MGGS, J_MGGS, MGGS USE ALLOCATE_L1_MGG_USE_IFs @@ -50,7 +49,7 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_L1_MGG_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -62,12 +61,7 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RDOUBLE = REAL(DOUBLE) @@ -90,7 +84,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS I2_MGG(I) = 0 ENDDO @@ -116,7 +109,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS I_MGGC(I) = 1 ENDDO @@ -141,7 +133,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS J_MGGC(I) = 0 ENDDO @@ -166,7 +157,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS MGGC(I) = ZERO ENDDO @@ -193,7 +183,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS I_MGGE(I) = 1 ENDDO @@ -218,7 +207,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS J_MGGE(I) = 0 ENDDO @@ -243,7 +231,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS MGGE(I) = ZERO ENDDO @@ -270,7 +257,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS I_MGGS(I) = 1 ENDDO @@ -295,7 +281,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS J_MGGS(I) = 0 ENDDO @@ -320,7 +305,6 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS MGGS(I) = ZERO ENDDO @@ -350,12 +334,7 @@ SUBROUTINE ALLOCATE_L1_MGG ( NAME, CALLING_SUBR ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME, TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/LINK1/ALLOCATE_STF_ARRAYS.f90 b/Source/LK1/LINK1/ALLOCATE_STF_ARRAYS.f90 index 99fe3c14..f428240b 100644 --- a/Source/LK1/LINK1/ALLOCATE_STF_ARRAYS.f90 +++ b/Source/LK1/LINK1/ALLOCATE_STF_ARRAYS.f90 @@ -30,14 +30,13 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, TWO, ONEPP6 - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO, LTERM_KGG, LTERM_KGGD, NDOFG, SOL_NAME, & TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE PARAMS, ONLY : MEMAFAC, MXALLOCA, SUPINFO, WINAMEM USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE STF_ARRAYS, ONLY : STF, STFCOL, STFKEY, STFPNT, STF3 - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_STF_ARRAYS_BEGEND USE ALLOCATE_STF_ARRAYS_USE_IFs @@ -56,7 +55,7 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) INTEGER(LONG) :: LTERM ! Count of number of estimated terms in KGG or KGGD INTEGER(LONG) :: NROWS ! Number of rows for matrix NAME INTEGER(LONG) :: NTERMS ! Number of terms for matrix NAME - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_STF_ARRAYS_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -70,12 +69,7 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Set LTERM, which will be the size allocated to the G-set stiffness matrix, to the appropriate value @@ -111,7 +105,6 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) MB_ALLOC_THIS_TIME = MB_ALLOC_THIS_TIME + MB_ALLOCATED IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) WRITE(SC1,12345,ADVANCE='NO') NAME, NDOFG, ' rows', CR13 DO I=1,NDOFG STFKEY(I) = 0 @@ -139,7 +132,6 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) MB_ALLOC_THIS_TIME = MB_ALLOC_THIS_TIME + MB_ALLOCATED IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) WRITE(SC1,12345,ADVANCE='NO') NAME, LTERM, ' terms', CR13 DO I=1,LTERM STFCOL(I) = 0 @@ -167,7 +159,6 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) MB_ALLOC_THIS_TIME = MB_ALLOC_THIS_TIME + MB_ALLOCATED IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) WRITE(SC1,12345,ADVANCE='NO') NAME, LTERM, ' terms', CR13 DO I=1,LTERM STFPNT(I) = 0 @@ -195,7 +186,6 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) MB_ALLOC_THIS_TIME = MB_ALLOC_THIS_TIME + MB_ALLOCATED - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) WRITE(SC1,12345,ADVANCE='NO') NAME, LTERM, ' terms', CR13 DO I=1,LTERM STF(I) = ZERO @@ -230,7 +220,6 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(NTERMS)/ONEPP6 + TWO*RLONG*REAL(NTERMS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) MB_ALLOC_THIS_TIME = MB_ALLOC_THIS_TIME + MB_ALLOCATED - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NTERMS, 1, SUBR_BEGEND ) WRITE(SC1,12345,ADVANCE='NO') NAME, NTERMS, ' terms', CR13 WRITE(SC1,*) CR13 ELSE @@ -246,7 +235,6 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) WRITE(SC1,*) CR13 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) MB_ALLOC_THIS_TIME = MB_ALLOC_THIS_TIME + MB_ALLOCATED - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NTERMS, 1, SUBR_BEGEND ) EXIT i_do ELSE WRITE(SC1,32345,ADVANCE='NO') ALLOC_ATTEMPT_NUM, MB_ALLOCATED, NAME,' failed ', CR13 @@ -304,12 +292,7 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -326,8 +309,6 @@ SUBROUTINE ALLOCATE_STF_ARRAYS ( NAME, CALLING_SUBR ) 999 FORMAT(' THERE WERE ',I3,' ATTEMPTS TO ALLOCATE MEMORY TO ARRAY ',A & ,/,14X,' THE MAX ALLOWABLE ATTEMPTS CAN BE INCREASED VIA BULK DATA PARAM ',A) - 1092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) 1702 FORMAT(' ALLOCATED ',1ES9.2,' MB MEMORY TO ARRAY ',A) diff --git a/Source/LK1/LINK1/ALLOCATE_TEMPLATE.f90 b/Source/LK1/LINK1/ALLOCATE_TEMPLATE.f90 index 0e4e891f..aa46203a 100644 --- a/Source/LK1/LINK1/ALLOCATE_TEMPLATE.f90 +++ b/Source/LK1/LINK1/ALLOCATE_TEMPLATE.f90 @@ -30,10 +30,9 @@ SUBROUTINE ALLOCATE_TEMPLATE ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_TEMPLATE_BEGEND USE STF_TEMPLATE_ARRAYS, ONLY : CROW, TEMPLATE USE ALLOCATE_STF_ARRAYS_USE_IFs @@ -48,7 +47,7 @@ SUBROUTINE ALLOCATE_TEMPLATE ( CALLING_SUBR ) INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Nunber of rows in array NAME being allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_TEMPLATE_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -58,12 +57,7 @@ SUBROUTINE ALLOCATE_TEMPLATE ( CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = ZERO @@ -83,7 +77,6 @@ SUBROUTINE ALLOCATE_TEMPLATE ( CALLING_SUBR ) MB_ALLOCATED = REAL(BYTE)*REAL(NDOFG)*REAL(NDOFG)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NDOFG DO J=1,NDOFG TEMPLATE(I,J) = .FALSE. @@ -110,7 +103,6 @@ SUBROUTINE ALLOCATE_TEMPLATE ( CALLING_SUBR ) MB_ALLOCATED = REAL(BYTE)*REAL(LEN(CROW))*REAL(NDOFG)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NDOFG CROW(I) = ' ' ENDDO @@ -130,12 +122,7 @@ SUBROUTINE ALLOCATE_TEMPLATE ( CALLING_SUBR ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/LINK1/DEALLOCATE_EMS_ARRAYS.f90 b/Source/LK1/LINK1/DEALLOCATE_EMS_ARRAYS.f90 index d847d564..2ad96575 100644 --- a/Source/LK1/LINK1/DEALLOCATE_EMS_ARRAYS.f90 +++ b/Source/LK1/LINK1/DEALLOCATE_EMS_ARRAYS.f90 @@ -29,11 +29,10 @@ SUBROUTINE DEALLOCATE_EMS_ARRAYS ! Deallocate some arrays used in LINK1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_EMS_ARRAYS_BEGEND USE EMS_ARRAYS, ONLY : EMSCOL, EMSKEY, EMSPNT, EMS USE DEALLOCATE_EMS_ARRAYS_USE_IFs @@ -45,18 +44,13 @@ SUBROUTINE DEALLOCATE_EMS_ARRAYS INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_EMS_ARRAYS_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -67,7 +61,6 @@ SUBROUTINE DEALLOCATE_EMS_ARRAYS DEALLOCATE (EMSCOL,STAT=IERR) NAME = 'EMSCOL' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -82,7 +75,6 @@ SUBROUTINE DEALLOCATE_EMS_ARRAYS DEALLOCATE (EMSPNT,STAT=IERR) NAME = 'EMSPNT' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -97,7 +89,6 @@ SUBROUTINE DEALLOCATE_EMS_ARRAYS DEALLOCATE (EMSKEY,STAT=IERR) NAME = 'EMSKEY' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -112,7 +103,6 @@ SUBROUTINE DEALLOCATE_EMS_ARRAYS DEALLOCATE (EMS,STAT=IERR) NAME = 'EMS' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -127,12 +117,7 @@ SUBROUTINE DEALLOCATE_EMS_ARRAYS CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/LINK1/DEALLOCATE_L1_MGG.f90 b/Source/LK1/LINK1/DEALLOCATE_L1_MGG.f90 index 15c12e32..8d2e482d 100644 --- a/Source/LK1/LINK1/DEALLOCATE_L1_MGG.f90 +++ b/Source/LK1/LINK1/DEALLOCATE_L1_MGG.f90 @@ -29,11 +29,10 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) ! Deallocate some arrays used in LINK1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_L1_MGG_BEGEND USE SPARSE_MATRICES, ONLY : I_MGG, I2_MGG, J_MGG, MGG, I_MGGC, J_MGGC, MGGC, I_MGGE, J_MGGE, MGGE, I_MGGS, J_MGGS, MGGS USE DEALLOCATE_L1_MGG_USE_IFs @@ -46,18 +45,13 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_L1_MGG_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -68,7 +62,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (I2_MGG,STAT=IERR) NAME = 'I2_MGG' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -83,7 +76,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (I_MGGC,STAT=IERR) NAME = 'I_MGGC' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -96,7 +88,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (J_MGGC,STAT=IERR) NAME = 'J_MGGC' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -109,7 +100,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (MGGC,STAT=IERR) NAME = 'MGGC' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -124,7 +114,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (I_MGGE,STAT=IERR) NAME = 'I_MGGE' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -137,7 +126,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (J_MGGE,STAT=IERR) NAME = 'J_MGGE' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -150,7 +138,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (MGGE,STAT=IERR) NAME = 'MGGE' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME JERR = JERR + 1 @@ -165,7 +152,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (I_MGGS,STAT=IERR) NAME = 'I_MGGS' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -178,7 +164,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (J_MGGS,STAT=IERR) NAME = 'J_MGGS' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -191,7 +176,6 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) DEALLOCATE (MGGS,STAT=IERR) NAME = 'MGGS' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME, SUBR_NAME JERR = JERR + 1 @@ -215,12 +199,7 @@ SUBROUTINE DEALLOCATE_L1_MGG ( NAME_IN ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME, TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/LINK1/DEALLOCATE_STF_ARRAYS.f90 b/Source/LK1/LINK1/DEALLOCATE_STF_ARRAYS.f90 index a681c94c..22c743bf 100644 --- a/Source/LK1/LINK1/DEALLOCATE_STF_ARRAYS.f90 +++ b/Source/LK1/LINK1/DEALLOCATE_STF_ARRAYS.f90 @@ -29,11 +29,10 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) ! Deallocate some arrays used in LINK1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_STF_ARRAYS_BEGEND USE STF_ARRAYS, ONLY : STFCOL, STFKEY, STFPNT, STF, STF3 USE DEALLOCATE_STF_ARRAYS_USE_IFs @@ -46,18 +45,13 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_STF_ARRAYS_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -67,7 +61,6 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) IF (ALLOCATED(STFKEY)) THEN DEALLOCATE (STFKEY,STAT=IERR) CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -81,7 +74,6 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) IF (ALLOCATED(STFCOL)) THEN DEALLOCATE (STFCOL,STAT=IERR) CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -95,7 +87,6 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) IF (ALLOCATED(STFPNT)) THEN DEALLOCATE (STFPNT,STAT=IERR) CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -109,7 +100,6 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) IF (ALLOCATED(STF)) THEN DEALLOCATE (STF,STAT=IERR) CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -123,7 +113,6 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) IF (ALLOCATED(STF3)) THEN DEALLOCATE (STF3,STAT=IERR) CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -150,12 +139,7 @@ SUBROUTINE DEALLOCATE_STF_ARRAYS ( NAME ) WRITE(SC1,12345,ADVANCE='NO') CUR_MB_ALLOCATED, NAME, CR13 WRITE(F06,1702) CUR_MB_ALLOCATED, NAME -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/LINK1/DEALLOCATE_TEMPLATE.f90 b/Source/LK1/LINK1/DEALLOCATE_TEMPLATE.f90 index 6eb2b0a5..8687e843 100644 --- a/Source/LK1/LINK1/DEALLOCATE_TEMPLATE.f90 +++ b/Source/LK1/LINK1/DEALLOCATE_TEMPLATE.f90 @@ -29,11 +29,10 @@ SUBROUTINE DEALLOCATE_TEMPLATE ! Deallocate some arrays used in LINK1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_TEMPLATE_BEGEND USE STF_TEMPLATE_ARRAYS, ONLY : CROW, TEMPLATE USE DEALLOCATE_TEMPLATE_USE_IFs @@ -45,18 +44,13 @@ SUBROUTINE DEALLOCATE_TEMPLATE INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_TEMPLATE_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -67,7 +61,6 @@ SUBROUTINE DEALLOCATE_TEMPLATE DEALLOCATE (TEMPLATE,STAT=IERR) NAME = 'TEMPLATE' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -82,7 +75,6 @@ SUBROUTINE DEALLOCATE_TEMPLATE DEALLOCATE (CROW,STAT=IERR) NAME = 'CROW' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -97,12 +89,7 @@ SUBROUTINE DEALLOCATE_TEMPLATE CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/LINK1/LINK0.f90 b/Source/LK1/LINK1/LINK0.f90 index 070def87..e0d6e549 100644 --- a/Source/LK1/LINK1/LINK0.f90 +++ b/Source/LK1/LINK1/LINK0.f90 @@ -40,11 +40,11 @@ SUBROUTINE LINK0 USE PENTIUM_II_KIND, ONLY : BYTE, SHORT, LONG, SINGLE, DOUBLE, QUAD - USE IOUNT1, ONLY : MOU4, SC1, WRT_BUG, WRT_LOG - USE IOUNT1, ONLY : ANS, BUG, ERR, F06, F21, F22, F23, F24, F25, IN1, L1B, L1C, L1D, L1F, L1G, L1H, L1I, L1K, & + USE IOUNT1, ONLY : MOU4, SC1, WRT_BUG + USE IOUNT1, ONLY : BUG, ERR, F06, F21, F22, F23, F24, F25, IN1, L1B, L1C, L1D, L1F, L1G, L1H, L1I, L1K, & L1L, L1N, L1O, L1P, L1Q, L1S, L1T, L1U, L1V, L1W, L1X, L1Y, OP2, OU4, SEQ - USE IOUNT1, ONLY : ANSFIL, F04, F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, INFILE, LINK1B, LINK1C, LINK1D, & + USE IOUNT1, ONLY : F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, INFILE, LINK1B, LINK1C, LINK1D, & LINK1F, LINK1H, LINK1I, LINK1K, LINK1L, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1S, LINK1T, & LINK1U, LINK1V, LINK1W, LINK1X, LINK1Y, OP2FIL, OU4FIL, SEQFIL @@ -66,11 +66,10 @@ SUBROUTINE LINK0 ELDT_BUG_BCHK_BIT, ELDT_BUG_U_P_BIT, ELDT_F21_P_T_BIT , ELDT_F22_ME_BIT , & ELDT_F23_KE_BIT , ELDT_F24_SE_BIT , ELDT_F25_U_P_BIT use scontr, only : ndofo - USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE DOF_TABLES, ONLY : TDOFI USE PARAMS, ONLY : CHKGRDS, EPSIL, EQCHK_OUTPUT, GRDPNT, GRDPNT_IN, GRIDSEQ, MEFMGRID, MEFMLOC, PRTCONN, & PRTBASIC, PRTCORD, PRTDOF, PRTTSET, PRTSTIFD, PRTSTIFF, SETLKTK, SETLKTM, SUPINFO, & - SUPWARN, WTMASS, PRTANS, PRTF06, PRTOP2 + SUPWARN, WTMASS, PRTF06, PRTOP2 USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MACHINE_PARAMS, ONLY : MACH_PREC USE MODEL_STUF, ONLY : ANY_GPFO_OUTPUT, EIG_METH, ELDT, ETYPE, MEFFMASS_CALC, NUM_EMG_FATAL_ERRS, PLY_NUM, OELDT,& @@ -82,6 +81,7 @@ SUBROUTINE LINK0 USE OUTPUT4_MATRICES, ONLY : NUM_OU4_REQUESTS, OU4_FILE_UNITS USE LINK0_USE_IFs + USE LINK_MESSAGE_Interface IMPLICIT NONE @@ -89,7 +89,6 @@ SUBROUTINE LINK0 CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'LINK0' - CHARACTER(44*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER(1*BYTE) :: OPEN_UNT(MOU4) ! 'Y' if we need to open an OU4 file unit @@ -122,7 +121,6 @@ SUBROUTINE LINK0 REAL(DOUBLE) :: KGG_MAX_DIAG ! Max diag term from KGG (needed for equil check on RESTART) !LOGICAL :: WRITE_F06 ! flag !LOGICAL :: WRITE_OP2 ! flag - LOGICAL :: WRITE_ANS ! flag INTRINSIC :: IAND @@ -135,9 +133,6 @@ SUBROUTINE LINK0 WRT_BUG(I) = 0 ENDDO - ! Initialize WRITE_ANS - WRITE_ANS = (PRTANS == 'Y') - RBG_GSET_ALLOCATED = 'N' ! Set default values for SETLKT from values in module PARAMS @@ -154,9 +149,6 @@ SUBROUTINE LINK0 ! Write logo, date and copyright info to text files WRITE(F06,150) LINKNO - IF (WRT_LOG > 0) THEN - WRITE(F04,150) LINKNO - ENDIF WRITE(ERR,150) LINKNO ! Reset units for error output (were set to SC1 in MAIN1) @@ -164,17 +156,13 @@ SUBROUTINE LINK0 OUNT(2) = F06 ! Read input data to count sizes of arrays (no. GRID's, elems, etc.) - CALL OURTIM - MODNAM = 'DETERMINE ARRAY SIZES - CASE CONTROL ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('DETERMINE ARRAY SIZES - CASE CONTROL ') CALL LOADC0 ! Initial pass on Bulk Data when this is not a restart res11:IF (RESTART == 'N') THEN - CALL OURTIM - MODNAM = 'DETERMINE ARRAY SIZES - BULK DATA ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('DETERMINE ARRAY SIZES - BULK DATA ') CALL LOADB0 ENDIF res11 @@ -183,9 +171,7 @@ SUBROUTINE LINK0 REWIND (IN1) ! Processes the EXEC CONTROL DECK - CALL OURTIM - MODNAM = 'READ EXEC CONTROL DECK ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ EXEC CONTROL DECK ') WRITE(F06,*) CALL ALLOCATE_IN4_FILES ( 'IN4FIL', 0, 0, SUBR_NAME ) CALL LOADE @@ -223,19 +209,15 @@ SUBROUTINE LINK0 ! check-point data to L1Z if this is NOT a restart or ! verify that the check-pointed data ! agrees between the original run and this restart run - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ') CALL ALLOCATE_MODEL_STUF ( 'SETS ARRAYS', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'TITLES', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'SC_xxxx', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'SCNUM', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'SUBLOD', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'SPC_MPC_SET', SUBR_NAME ) - CALL OURTIM - MODNAM = 'READ CASE CONTROL DECK ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ CASE CONTROL DECK ') CALL LOADC ! If this is a restart, do the following: @@ -302,21 +284,21 @@ SUBROUTINE LINK0 ! L1U: Data from B.D. RFORCE cards ! L1W: Data from B.D. SLOAD cards - CALL FILE_OPEN ( L1F, LINK1F, OUNT, 'REPLACE', L1F_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1I, LINK1I, OUNT, 'REPLACE', L1I_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1K, LINK1K, OUNT, 'REPLACE', L1K_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1N, LINK1N, OUNT, 'REPLACE', L1N_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1O, LINK1O, OUNT, 'REPLACE', L1O_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1P, LINK1P, OUNT, 'REPLACE', L1P_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1Q, LINK1Q, OUNT, 'REPLACE', L1Q_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1S, LINK1S, OUNT, 'REPLACE', L1S_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1T, LINK1T, OUNT, 'REPLACE', L1T_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1U, LINK1U, OUNT, 'REPLACE', L1U_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1V, LINK1V, OUNT, 'REPLACE', L1V_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1W, LINK1W, OUNT, 'REPLACE', L1W_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL FILE_OPEN ( L1X, LINK1X, OUNT, 'REPLACE', L1X_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1F, LINK1F, OUNT, 'REPLACE', L1F_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1I, LINK1I, OUNT, 'REPLACE', L1I_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1K, LINK1K, OUNT, 'REPLACE', L1K_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1N, LINK1N, OUNT, 'REPLACE', L1N_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1O, LINK1O, OUNT, 'REPLACE', L1O_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1P, LINK1P, OUNT, 'REPLACE', L1P_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1Q, LINK1Q, OUNT, 'REPLACE', L1Q_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1S, LINK1S, OUNT, 'REPLACE', L1S_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1T, LINK1T, OUNT, 'REPLACE', L1T_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1U, LINK1U, OUNT, 'REPLACE', L1U_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1V, LINK1V, OUNT, 'REPLACE', L1V_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1W, LINK1W, OUNT, 'REPLACE', L1W_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL FILE_OPEN ( L1X, LINK1X, OUNT, 'REPLACE', L1X_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) !xx IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN -!xx CALL FILE_OPEN ( L1M, LINK1M, OUNT, 'REPLACE', L1M_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) +!xx CALL FILE_OPEN ( L1M, LINK1M, OUNT, 'REPLACE', L1M_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) !xx ENDIF ! Get machine parameters and set EPSIL(1). @@ -327,9 +309,7 @@ SUBROUTINE LINK0 ENDIF ! Processes the Bulk Data deck - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ' -! WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC +! CALL LINK_MESSAGE('ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ') CALL ALLOCATE_MODEL_STUF ( 'SEQ1,2', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'FORMOM_SIDS', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'PRESS_SIDS', SUBR_NAME ) @@ -351,9 +331,7 @@ SUBROUTINE LINK0 CALL ALLOCATE_MODEL_STUF ( 'SNORM, RSNORM', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'RIGID_ELEM_IDS', SUBR_NAME ) - CALL OURTIM - MODNAM = 'READ BULK DATA DECK ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ BULK DATA DECK ') CALL LOADB CALL DEALLOCATE_MODEL_STUF ( 'SPC_SIDS, SPC1_SIDS' ) @@ -430,86 +408,81 @@ SUBROUTINE LINK0 ! Close files opened for writing Bulk data info to IF (NRIGEL > 0) THEN - CALL FILE_CLOSE ( L1F, LINK1F, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1F, LINK1F, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1F, LINK1F, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1F, LINK1F, 'DELETE' ) ENDIF IF (NFORCE > 0) THEN - CALL FILE_CLOSE ( L1I, LINK1I, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1I, LINK1I, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1I, LINK1I, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1I, LINK1I, 'DELETE' ) ENDIF IF (NTCARD > 0) THEN - CALL FILE_CLOSE ( L1K, LINK1K, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1K, LINK1K, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1K, LINK1K, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1K, LINK1K, 'DELETE' ) ENDIF IF (NAOCARD > 0) THEN - CALL FILE_CLOSE ( L1N, LINK1N, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1N, LINK1N, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1N, LINK1N, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1N, LINK1N, 'DELETE' ) ENDIF IF ((NSPC > 0) .OR. (NSPC1 > 0)) THEN - CALL FILE_CLOSE ( L1O, LINK1O, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1O, LINK1O, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1O, LINK1O, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1O, LINK1O, 'DELETE' ) ENDIF IF (NGRAV > 0) THEN - CALL FILE_CLOSE ( L1P, LINK1P, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1P, LINK1P, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1P, LINK1P, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1P, LINK1P, 'DELETE' ) ENDIF IF (NPCARD > 0) THEN - CALL FILE_CLOSE ( L1Q, LINK1O, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1Q, LINK1O, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1Q, LINK1O, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1Q, LINK1O, 'DELETE' ) ENDIF IF (NMPC > 0) THEN - CALL FILE_CLOSE ( L1S, LINK1S, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1S, LINK1S, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1S, LINK1S, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1S, LINK1S, 'DELETE' ) ENDIF IF (NUM_SUPT_CARDS > 0) THEN - CALL FILE_CLOSE ( L1T, LINK1T, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1T, LINK1T, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1T, LINK1T, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1T, LINK1T, 'DELETE' ) ENDIF IF (NRFORCE > 0) THEN - CALL FILE_CLOSE ( L1U, LINK1U, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1U, LINK1U, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1U, LINK1U, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1U, LINK1U, 'DELETE' ) ENDIF IF (NSLOAD > 0) THEN - CALL FILE_CLOSE ( L1W, LINK1W, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1W, LINK1W, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1W, LINK1W, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1W, LINK1W, 'DELETE' ) ENDIF IF (NUM_PARTVEC_RECORDS > 0) THEN - CALL FILE_CLOSE ( L1V, LINK1V, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1V, LINK1V, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1V, LINK1V, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1V, LINK1V, 'DELETE' ) ENDIF IF (NUM_USET_RECORDS > 0) THEN - CALL FILE_CLOSE ( L1X, LINK1X, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1X, LINK1X, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1X, LINK1X, 'DELETE', 'Y' ) - ENDIF - - IF (WRITE_ANS) THEN - ! ANS was opened in subr MYSTRAN_FILES. We only need it if DEBUG(200) > 0 - CALL FILE_CLOSE ( ANS, ANSFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1X, LINK1X, 'DELETE' ) ENDIF CALL SET_SPARSE_MAT_SYM ! Set sparse matrix sym @@ -526,45 +499,35 @@ SUBROUTINE LINK0 res14:IF (RESTART == 'N') THEN - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ' -! WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC +! CALL LINK_MESSAGE('ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ') CALL ALLOCATE_MODEL_STUF ( 'ESORT1', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'ESORT2', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'EOFF', SUBR_NAME ) - CALL OURTIM - MODNAM = 'SORT AND CHECK ELEMENTS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SORT AND CHECK ELEMENTS ') CALL ELESORT CALL DEALLOCATE_MODEL_STUF ( 'RIGID_ELEM_IDS' ) ! Open L1B, OP2 for writing grid and coord data to. - CALL FILE_OPEN ( L1B, LINK1B, OUNT, 'REPLACE', L1B_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1B, LINK1B, OUNT, 'REPLACE', L1B_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) - CALL FILE_OPEN ( OP2, OP2FIL, OUNT, 'REPLACE', OP2_MSG, 'NEITHER', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( OP2, OP2FIL, OUNT, 'REPLACE', OP2_MSG, 'NEITHER', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) OP2STAT = 'KEEP ' CALL WRITE_OP2_HEADER(POST) ! Element processing to convert external PID's to internal. - CALL OURTIM - MODNAM = 'ELEM PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ELEM PROCESSOR ') CALL ELEM_PROP_MATL_IIDS ! Grid and coordinate system processing - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ' -! WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC +! CALL LINK_MESSAGE('ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ') CALL ALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'GRID_ID', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'GRID_SEQ, INV_GRID_SEQ', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'TN', SUBR_NAME ) - CALL OURTIM - MODNAM = 'GRID PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GRID PROCESSOR ') CALL GRID_PROC CALL DEALLOCATE_MODEL_STUF ( 'TN' ) @@ -573,9 +536,7 @@ SUBROUTINE LINK0 ! entries are defined IF (CHKGRDS == 'Y') THEN - CALL OURTIM - MODNAM = 'CHECK THAT ALL GRIDS FOR ELEMS EXIST ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CHECK THAT ALL GRIDS FOR ELEMS EXIST ') CALL COUNTER_INIT(' Process element', NELE) DO I=1,NELE @@ -588,14 +549,12 @@ SUBROUTINE LINK0 ! Run Bandit, if requested REWIND (IN1) IF (GRIDSEQ(1:6) == 'BANDIT') THEN - CALL OURTIM - MODNAM = 'BANDIT - RESEQUENCE GRIDS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC - CALL FILE_OPEN ( SEQ, SEQFIL, OUNT, 'REPLACE', SEQ_MSG, 'WRITE_STIME', 'FORMATTED', 'READWRITE', 'REWIND','Y','N','Y' ) + CALL LINK_MESSAGE('BANDIT - RESEQUENCE GRIDS ') + CALL FILE_OPEN ( SEQ, SEQFIL, OUNT, 'REPLACE', SEQ_MSG, 'WRITE_STIME', 'FORMATTED', 'READWRITE', 'REWIND','Y','N' ) CALL BANDIT ( NGRID, BANDIT_BW, KMAT_DEN, BANDIT_ERR ) INQUIRE ( FILE=SEQFIL, OPENED=FILE_OPND ) IF (FILE_OPND) THEN - CALL FILE_CLOSE ( SEQ, SEQFIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( SEQ, SEQFIL, 'KEEP' ) ENDIF WRITE(ERR,1030) BANDIT_ERR IF (SUPINFO == 'N') THEN @@ -614,14 +573,12 @@ SUBROUTINE LINK0 ENDIF ENDIF ENDIF - CALL FILE_CLOSE ( IN1, INFILE, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( IN1, INFILE, 'KEEP' ) ! Grid point sequencing - CALL OURTIM - MODNAM = 'GRID SEQUENCE PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GRID SEQUENCE PROCESSOR ') CALL SEQ_PROC - CALL FILE_CLOSE ( L1B, LINK1B, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1B, LINK1B, 'KEEP' ) CALL DEALLOCATE_MODEL_STUF ( 'SEQ1,2' ) ! Surface normal processing @@ -656,43 +613,39 @@ SUBROUTINE LINK0 ! Subcase processing CALL ALLOCATE_MODEL_STUF ( 'GROUT, ELOUT', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'ELDT', SUBR_NAME ) - CALL FILE_OPEN ( L1D, LINK1D, OUNT, 'REPLACE', L1D_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'SUBCASE PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1D, LINK1D, OUNT, 'REPLACE', L1D_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('SUBCASE PROCESSOR ') CALL SUBCASE_PROC CALL DEALLOCATE_MODEL_STUF ( 'GROUT, ELOUT' ) CALL DEALLOCATE_MODEL_STUF ( 'SETS ARRAYS' ) CALL DEALLOCATE_MODEL_STUF ( 'TITLES' ) CALL DEALLOCATE_MODEL_STUF ( 'SC_xxxx' ) - CALL FILE_CLOSE ( L1D, LINK1D, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1D, LINK1D, 'KEEP' ) ! If we will be writing data to the F2i disk files open them now IF ( IAND(OELDT,IBIT(ELDT_F21_P_T_BIT) ) > 0) THEN - CALL FILE_OPEN ( F21, F21FIL, OUNT, 'REPLACE', F21_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( F21, F21FIL, OUNT, 'REPLACE', F21_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ENDIF IF ( IAND(OELDT,IBIT(ELDT_F22_ME_BIT) ) > 0) THEN - CALL FILE_OPEN ( F22, F22FIL, OUNT, 'REPLACE', F22_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( F22, F22FIL, OUNT, 'REPLACE', F22_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ENDIF IF ( IAND(OELDT,IBIT(ELDT_F23_KE_BIT) ) > 0) THEN - CALL FILE_OPEN ( F23, F23FIL, OUNT, 'REPLACE', F23_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( F23, F23FIL, OUNT, 'REPLACE', F23_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ENDIF IF ( IAND(OELDT,IBIT(ELDT_F24_SE_BIT) ) > 0) THEN - CALL FILE_OPEN ( F24, F24FIL, OUNT, 'REPLACE', F24_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( F24, F24FIL, OUNT, 'REPLACE', F24_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ENDIF IF ( IAND(OELDT,IBIT(ELDT_F25_U_P_BIT) ) > 0) THEN - CALL FILE_OPEN ( F25, F25FIL, OUNT, 'REPLACE', F25_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( F25, F25FIL, OUNT, 'REPLACE', F25_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ENDIF ! Print table showing the elements connected to each grid if requested IF (RESTART == 'N') THEN IF ((ANY_GPFO_OUTPUT > 0) .OR. (PRTCONN > 0)) THEN - CALL OURTIM - MODNAM = 'GRID/ELEMENT CONNECTION TABLE ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GRID/ELEMENT CONNECTION TABLE ') CALL GRID_ELEM_CONN_TABLE IF (ANY_GPFO_OUTPUT == 0) THEN CALL DEALLOCATE_MODEL_STUF ( 'GRID_ELEM_CONN_ARRAY' ) @@ -703,9 +656,7 @@ SUBROUTINE LINK0 res15:IF (RESTART == 'Y') THEN IF (ANY_GPFO_OUTPUT > 0) THEN - CALL OURTIM - MODNAM = 'GRID/ELEMENT CONNECTION TABLE ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GRID/ELEMENT CONNECTION TABLE ') CALL GRID_ELEM_CONN_TABLE ENDIF @@ -813,41 +764,37 @@ SUBROUTINE LINK0 ! Open L1H for writing enforced displ SPC's. Keep L1H for later processing in YS_ARRAY if SOL = STATICS IF (NRIGEL > 0) THEN - CALL FILE_OPEN ( L1F, LINK1F, OUNT, 'OLD', L1F_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1F, LINK1F, OUNT, 'OLD', L1F_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF IF (NMPC > 0) THEN - CALL FILE_OPEN ( L1S, LINK1S, OUNT, 'OLD', L1S_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1S, LINK1S, OUNT, 'OLD', L1S_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF IF ((NSPC > 0) .OR. (NSPC1 > 0)) THEN - CALL FILE_OPEN ( L1O, LINK1O, OUNT, 'OLD', L1O_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1O, LINK1O, OUNT, 'OLD', L1O_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF IF (NAOCARD > 0) THEN - CALL FILE_OPEN ( L1N, LINK1N, OUNT, 'OLD', L1N_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1N, LINK1N, OUNT, 'OLD', L1N_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF IF (NUM_SUPT_CARDS > 0) THEN - CALL FILE_OPEN ( L1T, LINK1T, OUNT, 'OLD', L1T_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1T, LINK1T, OUNT, 'OLD', L1T_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF - CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'REPLACE', L1C_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'REPLACE', L1C_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) - CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'REPLACE', L1H_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'REPLACE', L1H_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ' -! WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC +! CALL LINK_MESSAGE('ALLOCATE MEMORY FOR SOME MODEL DATA ARRAYS ') CALL ALLOCATE_DOF_TABLES ( 'TSET', SUBR_NAME ) CALL ALLOCATE_DOF_TABLES ( 'TDOF', SUBR_NAME ) CALL ALLOCATE_DOF_TABLES ( 'TDOFI', SUBR_NAME ) CALL ALLOCATE_DOF_TABLES ( 'TDOF_ROW_START' , SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS', SUBR_NAME ) - CALL OURTIM - MODNAM = 'DOF PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('DOF PROCESSOR ') TDOF_MSG(1:) = ' ' TDOF_MSG(56:) = '(Before any AUTOSPC)' CALL DOF_PROC ( TDOF_MSG ) @@ -858,50 +805,44 @@ SUBROUTINE LINK0 CALL DEALLOCATE_MODEL_STUF ( 'SPCADD_SIDS' ) IF (NMPC > 0) THEN - CALL FILE_CLOSE ( L1S, LINK1S, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1S, LINK1S, 'KEEP' ) ENDIF IF (NRIGEL > 0) THEN - CALL FILE_CLOSE ( L1F, LINK1F, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1F, LINK1F, 'KEEP' ) ENDIF IF ((NSPC > 0) .OR. (NSPC1 > 0)) THEN - CALL FILE_CLOSE ( L1O, LINK1O, L1OSTAT, 'Y' ) + CALL FILE_CLOSE ( L1O, LINK1O, L1OSTAT ) ENDIF IF (NDOFSE > 0) THEN IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - CALL FILE_CLOSE ( L1H, LINK1H, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1H, LINK1H, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1H, LINK1H, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1H, LINK1H, 'DELETE' ) ENDIF ENDIF IF (NAOCARD > 0) THEN - CALL FILE_CLOSE ( L1N, LINK1N, L1NSTAT, 'Y' ) + CALL FILE_CLOSE ( L1N, LINK1N, L1NSTAT ) ENDIF ! CONM2 processing to get CONM2 data in basic coords at the mass - CALL FILE_OPEN ( L1Y, LINK1Y, OUNT, 'REPLACE', L1Y_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'CONM2 PROCESSOR #1 ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1Y, LINK1Y, OUNT, 'REPLACE', L1Y_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('CONM2 PROCESSOR #1 ') CALL CONM2_PROC_1 - CALL FILE_CLOSE ( L1Y, LINK1Y, L1YSTAT, 'Y' ) + CALL FILE_CLOSE ( L1Y, LINK1Y, L1YSTAT ) ! Grid point weight generator (model weight, c.g., etc.) - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR RBGLOBAL ARRAY ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR RBGLOBAL ARRAY ') CALL ALLOCATE_RBGLOBAL ( 'G ', SUBR_NAME ) RBG_GSET_ALLOCATED = 'Y' IF ((GRDPNT_IN >= 0) .OR. (MEFFMASS_CALC == 'Y')) THEN - CALL OURTIM - MODNAM = 'GRID POINT WEIGHT GENERATOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GRID POINT WEIGHT GENERATOR ') IF (NCUSERIN > 0) THEN DO I=1,NELE @@ -931,9 +872,7 @@ SUBROUTINE LINK0 CLOSE ( L1K, STATUS='KEEP') CLOSE ( L1Y, STATUS='KEEP') - CALL OURTIM - MODNAM = 'CHECKING FOR MATRICES TO PRINT ON RESTART' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CHECKING FOR MATRICES TO PRINT ON RESTART') IF ((PRTSTIFF(1) >= 1) .OR. (PRTSTIFD(1) >= 1) .OR. (EQCHK_OUTPUT(1) > 0)) THEN CALL ALLOCATE_SPARSE_MAT ( 'KGG', NDOFG, NTERM_KGG, SUBR_NAME ) CALL READ_MATRIX_1 ( LINK1L, L1L, 'N', 'Y', L1LSTAT, L1L_MSG,'KGG', NTERM_KGG, 'Y', NDOFG, I_KGG, J_KGG, KGG) @@ -956,9 +895,7 @@ SUBROUTINE LINK0 ENDIF CALL GET_MATRIX_DIAG_STATS ( 'KGG', 'G ', NDOFG, NTERM_KGG, I_KGG, J_KGG, KGG, PRINTIT, KGG_DIAG, KGG_MAX_DIAG ) - CALL OURTIM - MODNAM = 'EQUILIBRIUM CHECK ON KGG ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('EQUILIBRIUM CHECK ON KGG ') CALL STIFF_MAT_EQUIL_CHK ( EQCHK_OUTPUT(1), 'G ', SYM_KGG, NDOFG, NTERM_KGG, I_KGG, J_KGG, KGG, KGG_DIAG, KGG_MAX_DIAG,& RBGLOBAL_GSET ) @@ -969,17 +906,13 @@ SUBROUTINE LINK0 res18:IF (RESTART == 'N') THEN ! CONM2 processing to get CONM2 data in global coords at the grid - CALL OURTIM - MODNAM = 'CONM2 PROCESSOR #2 ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CONM2 PROCESSOR #2 ') CALL CONM2_PROC_2 ! Temperature data processing IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - CALL OURTIM - MODNAM = 'ALLOCATE MEM FOR ELEM AND GRID TEMP ARRAYS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEM FOR ELEM AND GRID TEMP ARRAYS ') CALL ALLOCATE_MODEL_STUF ( 'GTEMP', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'CGTEMP', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'ETEMP', SUBR_NAME ) @@ -989,14 +922,12 @@ SUBROUTINE LINK0 IF (NTCARD > 0) THEN OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1K, LINK1K, OUNT, 'OLD', L1K_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'GRID & ELEM TEMPERATURE DATA PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1K, LINK1K, OUNT, 'OLD', L1K_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('GRID & ELEM TEMPERATURE DATA PROCESSOR ') CALL TEMPERATURE_DATA_PROC - CALL FILE_CLOSE ( L1K, LINK1K, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1K, LINK1K, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1K, LINK1K, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( L1K, LINK1K, 'DELETE' ) ENDIF ENDIF CALL DEALLOCATE_MODEL_STUF ( 'ETEMP' ) @@ -1007,22 +938,18 @@ SUBROUTINE LINK0 ! Open L1Q which contains element pressure Bulk Data IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR ELEM PRESSURE DATA ARRAYS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR ELEM PRESSURE DATA ARRAYS ') CALL ALLOCATE_MODEL_STUF ( 'PPNT, PDATA, PTYPE', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'PLOAD4_3D_DATA', SUBR_NAME ) IF (NPCARD > 0) THEN - CALL FILE_OPEN ( L1Q, LINK1Q, OUNT, 'OLD', L1Q_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1Q, LINK1Q, OUNT, 'OLD', L1Q_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) - CALL OURTIM - MODNAM = 'ELEMENT PRESSURE DATA PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ELEMENT PRESSURE DATA PROCESSOR ') CALL PRESSURE_DATA_PROC - CALL FILE_CLOSE ( L1Q, LINK1Q, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1Q, LINK1Q, 'KEEP' ) ENDIF ENDIF CALL DEALLOCATE_MODEL_STUF ( 'PRESS_SIDS' ) @@ -1032,9 +959,7 @@ SUBROUTINE LINK0 IF (NDOFR > 0) THEN - CALL OURTIM - MODNAM = 'GENERATE RIGID BODY DISPL MATRIX ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GENERATE RIGID BODY DISPL MATRIX ') CALL RB_DISP_MATRIX_PROC ( 'CG', 0 ) CALL ALLOCATE_RBGLOBAL ( 'R ', SUBR_NAME ) @@ -1091,14 +1016,11 @@ SUBROUTINE LINK0 IF((EQCHK_OUTPUT(1) > 0) .OR. (EQCHK_OUTPUT(2) > 0) .OR. (EQCHK_OUTPUT(3) > 0) .OR. (EQCHK_OUTPUT(4) > 0) .OR. & (EQCHK_OUTPUT(5) > 0)) THEN IF (RBG_GSET_ALLOCATED == 'N') THEN - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR RBGLOBAL ARRAY ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR RBGLOBAL ARRAY ') CALL ALLOCATE_RBGLOBAL ( 'G ', SUBR_NAME ) ENDIF - CALL OURTIM ! already calculated above - MODNAM = 'GENERATE RIGID BODY DISPL MATRIX ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + ! already calculated above + CALL LINK_MESSAGE('GENERATE RIGID BODY DISPL MATRIX ') CALL RB_DISP_MATRIX_PROC ( 'EQCHK REF GRID', 0 ) ENDIF @@ -1107,21 +1029,17 @@ SUBROUTINE LINK0 IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR Yse ARRAY ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR Yse ARRAY ') CALL ALLOCATE_COL_VEC ( 'YSe', NDOFSE, SUBR_NAME ) OUNT(1) = ERR OUNT(2) = F06 CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'OLD', L1H_MSG, 'READ_STIME', 'UNFORMATTED', 'READWRITE', 'REWIND', & - 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'CALCULATE YS ENFORCED DISPL ARRAY ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + 'Y', 'N' ) + CALL LINK_MESSAGE('CALCULATE YS ENFORCED DISPL ARRAY ') CALL YS_ARRAY CALL DEALLOCATE_COL_VEC ( 'YSe' ) - CALL FILE_CLOSE ( L1H, LINK1H, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1H, LINK1H, 'KEEP' ) ENDIF @@ -1172,7 +1090,7 @@ SUBROUTINE LINK0 DO I=1,MOU4 ! Open the OU4 units IF (OPEN_UNT(I) == 'Y') THEN - CALL FILE_OPEN (OU4(I), OU4FIL(I), OUNT, 'REPLACE', OU4_MSG(I),'NEITHER','UNFORMATTED','WRITE','REWIND','Y','N','Y') + CALL FILE_OPEN (OU4(I), OU4FIL(I), OUNT, 'REPLACE', OU4_MSG(I),'NEITHER','UNFORMATTED','WRITE','REWIND','Y','N') ENDIF ENDDO @@ -1183,7 +1101,7 @@ SUBROUTINE LINK0 ! rewrites L1A if this a restart - needed to tell LINK9 that this is a restart COMM(LINKNO) = 'C' res20:IF (RESTART == 'N') THEN - CALL WRITE_L1A ( 'KEEP', 'Y', 'Y' ) + CALL WRITE_L1A ( 'KEEP', 'Y' ) ENDIF res20 ! Check allocation status of allocatable arrays, if requested @@ -1194,11 +1112,8 @@ SUBROUTINE LINK0 ENDIF ENDIF - ! Write LINK0 end to F04, F06 + ! Write LINK0 end to F06 CALL OURTIM - IF (WRT_LOG > 0) THEN - WRITE(F04,151) LINKNO - ENDIF WRITE(F06,151) LINKNO IF (( DEBUG(193) == 1) .OR. (DEBUG(193) == 999)) THEN @@ -1238,8 +1153,6 @@ SUBROUTINE LINK0 1030 FORMAT(' *INFORMATION: BANDIT WAS CALLED TO RESEQUENCE THE GRIDS AND HAS RETURNED WITH ERROR = ',I8,/) - 1092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 1802 FORMAT(' *ERROR 1802: THERE MUST BE THE SAME NUMBER OF CUSERIN ELEM CONN ENTRIES, (NCUSERIN = ',I8,')' & ,/,14X,' AND NUMBER OF PUSERIN PROPERTY ENTRIES, (NPUSERIN = ',I8,')') diff --git a/Source/LK1/LINK1/LINK1.f90 b/Source/LK1/LINK1/LINK1.f90 index 1d39fd92..8882d441 100644 --- a/Source/LK1/LINK1/LINK1.f90 +++ b/Source/LK1/LINK1/LINK1.f90 @@ -35,9 +35,7 @@ SUBROUTINE LINK1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG - - USE IOUNT1, ONLY : ERR, F04, F06, F21, F22, F23, F24, L1C, L1F, L1I, L1G, L1J, L1P, L1S, L1U, L1W, SC1 + USE IOUNT1, ONLY : ERR, F06, F21, F22, F23, F24, L1C, L1F, L1I, L1G, L1J, L1P, L1S, L1U, L1W, SC1 USE IOUNT1, ONLY : F21FIL, F22FIL, F23FIL, F24FIL, LINK1C, LINK1F, LINK1I, LINK1G, LINK1J, LINK1P, LINK1S, & @@ -52,16 +50,16 @@ SUBROUTINE LINK1 FATAL_ERR, IBIT, LINKNO, LTERM_KGG, LTERM_KGGD, LTERM_MGGE, NDOFM, NFORCE, & NGRAV, NMPC, NPLOAD, NRFORCE, NRIGEL, NSLOAD, NTERM_RMG, NTSUB, RESTART, SOL_NAME - USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE DOF_TABLES, ONLY : TDOFI USE PARAMS, ONLY : EMP0_PAUSE, ESP0_PAUSE, SETLKTK, SKIPMGG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE MODEL_STUF, ONLY : OELDT USE DEBUG_PARAMETERS, ONLY : DEBUG - + USE LINK1_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE LOGICAL :: LEXIST ! .TRUE. if a file exists @@ -70,7 +68,6 @@ SUBROUTINE LINK1 CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'LINK1' CHARACTER(10*BYTE) :: LTERM_NAME ! Name for an LTERM value - CHARACTER(44*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER( 1*BYTE) :: RESPONSE ! User response ('Y' or 'N') to a screen prompt INTEGER(LONG) :: BUCKLING_STEP ! If SOL is BUCKLING then this is step 1 or 2 in the process, otherwise 0 @@ -105,14 +102,11 @@ SUBROUTINE LINK1 ! Write info to text files WRITE(F06,150) LINKNO - IF (WRT_LOG > 0) THEN - WRITE(F04,150) LINKNO - ENDIF WRITE(ERR,150) LINKNO ! Read LINK1A file -!xx CALL READ_L1A ( 'KEEP', 'Y' ) +!xx CALL READ_L1A ( 'KEEP' ) CALL INIT_COUNTERS ! Check COMM for successful completion of prior LINKs @@ -126,9 +120,7 @@ SUBROUTINE LINK1 ! Allocate DOF tables - CALL OURTIM - MODNAM = 'ALLOCATE DOF TABLES' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE DOF TABLES') ! Set BUCKLING_STEP based on LOAD_ISTEP (see subr MYSTRAN.FOR) @@ -150,37 +142,30 @@ SUBROUTINE LINK1 IF ((NMPC > 0) .OR. (NRIGEL > 0)) THEN - CALL FILE_OPEN ( L1J, LINK1J, OUNT, 'REPLACE', L1J_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1J, LINK1J, OUNT, 'REPLACE', L1J_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) IF (NMPC > 0) THEN - CALL FILE_OPEN ( L1S, LINK1S, OUNT, 'OLD', L1S_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'MPC PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1S, LINK1S, OUNT, 'OLD', L1S_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('MPC PROCESSOR ') CALL MPC_PROC - CALL FILE_CLOSE ( L1S, LINK1S, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1S, LINK1S, 'KEEP' ) ENDIF IF (NRIGEL > 0) THEN ! Process rigid elements. - CALL FILE_OPEN ( L1F, LINK1F, OUNT, 'OLD', L1F_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'RIGID ELEMENT PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1F, LINK1F, OUNT, 'OLD', L1F_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('RIGID ELEMENT PROCESSOR ') CALL RIGID_ELEM_PROC - CALL FILE_CLOSE ( L1F, LINK1F, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1F, LINK1F, 'KEEP' ) ENDIF - CALL FILE_CLOSE ( L1J, LINK1J, 'KEEP', 'Y' ) ! Subr SPARSE_RMG will reopen LINK1S + CALL FILE_CLOSE ( L1J, LINK1J, 'KEEP' ) ! Subr SPARSE_RMG will reopen LINK1S - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR RMG ARRAY ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR RMG ARRAY ') - CALL OURTIM ! Generate sparse RMG (constraint) matrix. - MODNAM = 'SPARSE RMG PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + ! Generate sparse RMG (constraint) matrix. + CALL LINK_MESSAGE('SPARSE RMG PROCESSOR ') CALL SPARSE_RMG - CALL FILE_CLOSE ( L1J, LINK1J, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1J, LINK1J, 'KEEP' ) ENDIF @@ -188,16 +173,12 @@ SUBROUTINE LINK1 IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR SYS_LOAD ARRAY ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR SYS_LOAD ARRAY ') IF (NFORCE > 0) THEN - CALL FILE_OPEN ( L1I, LINK1I, OUNT, 'OLD', L1I_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'FORCE/MOMENT PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1I, LINK1I, OUNT, 'OLD', L1I_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('FORCE/MOMENT PROCESSOR ') CALL FORCE_MOM_PROC - CALL FILE_CLOSE ( L1I, LINK1I, L1ISTAT, 'Y' ) + CALL FILE_CLOSE ( L1I, LINK1I, L1ISTAT ) ENDIF ENDIF @@ -205,28 +186,22 @@ SUBROUTINE LINK1 IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. (SOL_NAME(1:8) == 'BUCKLING')) THEN !xx ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR THERMAL LOAD ARRAYS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR THERMAL LOAD ARRAYS ') IF ((NPLOAD > 0) .OR. (NTSUB > 0)) THEN - CALL OURTIM - MODNAM = 'ELEMENT THERMAL AND PRESSURE LOAD PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ELEMENT THERMAL AND PRESSURE LOAD PROCESSOR ') CALL EPTL ENDIF ENDIF INQUIRE ( FILE=F21FIL, EXIST=LEXIST, OPENED=LOPEN ) IF (LOPEN) THEN - CALL FILE_CLOSE ( F21, F21FIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( F21, F21FIL, 'KEEP' ) ELSE - CALL FILE_CLOSE ( F21, F21FIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( F21, F21FIL, 'DELETE' ) ENDIF ! Generate G-set mass matrix, MGG IF (SKIPMGG == 'N') THEN - CALL OURTIM - MODNAM = 'CALCULATE ESTIMATE OF MASS MATRIX SIZE ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALCULATE ESTIMATE OF MASS MATRIX SIZE ') CALL EMP0 ! Calcs estimate of LTERM_MGGE IF (EMP0_PAUSE == 'Y') THEN WRITE(SC1,'(A,I12)') 'From EMP0: LTERM_MGGE = ',LTERM_MGGE @@ -240,39 +215,29 @@ SUBROUTINE LINK1 ENDIF ENDIF - CALL OURTIM - MODNAM = 'ALLOCATE MEM FOR EMSKEY, EMSCOL, EMSPNT, EMS' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEM FOR EMSKEY, EMSCOL, EMSPNT, EMS') CALL ALLOCATE_EMS_ARRAYS ( SUBR_NAME ) - CALL OURTIM - MODNAM = 'ELEMENT MASS MATRIX PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ELEMENT MASS MATRIX PROCESSOR ') CALL EMP INQUIRE ( FILE=F22FIL, EXIST=LEXIST, OPENED=LOPEN ) IF (LOPEN) THEN - CALL FILE_CLOSE ( F22, F22FIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( F22, F22FIL, 'KEEP' ) ELSE - CALL FILE_CLOSE ( F22, F22FIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( F22, F22FIL, 'DELETE' ) ENDIF ! Formulate MGGC mass matrix for concentrated masses - CALL OURTIM - MODNAM = 'CONCENTRATED MASS MATRIX PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CONCENTRATED MASS MATRIX PROCESSOR ') CALL MGGC_MASS_MATRIX - CALL OURTIM - MODNAM = 'ALLOCATE MEMORY FOR ELEM MASS ARRAYS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEMORY FOR ELEM MASS ARRAYS ') CALL ALLOCATE_L1_MGG ( 'MGGE', SUBR_NAME ) ! Convert system mass matrix from linked list format to sparse format - CALL OURTIM - MODNAM = 'SPARSE MGG PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SPARSE MGG PROCESSOR ') CALL SPARSE_MGG CALL DEALLOCATE_EMS_ARRAYS @@ -299,12 +264,10 @@ SUBROUTINE LINK1 IF (NGRAV > 0) THEN OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1P, LINK1P, OUNT, 'OLD', L1P_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'GRAV LOAD PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1P, LINK1P, OUNT, 'OLD', L1P_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('GRAV LOAD PROCESSOR ') CALL GRAV_PROC - CALL FILE_CLOSE ( L1P, LINK1P, L1PSTAT, 'Y' ) + CALL FILE_CLOSE ( L1P, LINK1P, L1PSTAT ) ENDIF ENDIF @@ -315,12 +278,10 @@ SUBROUTINE LINK1 IF (NRFORCE > 0) THEN OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1U, LINK1U, OUNT, 'OLD', L1U_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'RFORCE LOAD PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1U, LINK1U, OUNT, 'OLD', L1U_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('RFORCE LOAD PROCESSOR ') CALL RFORCE_PROC - CALL FILE_CLOSE ( L1U, LINK1U, L1USTAT, 'Y' ) + CALL FILE_CLOSE ( L1U, LINK1U, L1USTAT ) ENDIF ENDIF CALL DEALLOCATE_L1_MGG ( 'I2_MGG' ) @@ -332,12 +293,10 @@ SUBROUTINE LINK1 IF (NSLOAD > 0) THEN OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1W, LINK1W, OUNT, 'OLD', L1W_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) - CALL OURTIM - MODNAM = 'SLOAD LOAD PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L1W, LINK1W, OUNT, 'OLD', L1W_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('SLOAD LOAD PROCESSOR ') CALL SLOAD_PROC - CALL FILE_CLOSE ( L1W, LINK1W, L1WSTAT, 'Y' ) + CALL FILE_CLOSE ( L1W, LINK1W, L1WSTAT ) ENDIF ENDIF @@ -349,24 +308,20 @@ SUBROUTINE LINK1 IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - CALL OURTIM - MODNAM = 'CONVERT LOADS TO SPARSE MATRIX FORM ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CONVERT LOADS TO SPARSE MATRIX FORM ') CALL SPARSE_PG CALL DEALLOCATE_MODEL_STUF ( 'SYS_LOAD' ) ENDIF ! Estimate LTERM so arrays can be allocated for G-set stiffness matrix - CALL OURTIM - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC CALL ESP0 IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - MODNAM = 'CALCULATE ESTIMATE OF KGGD MATRIX SIZE ' + CALL LINK_MESSAGE('CALCULATE ESTIMATE OF KGGD MATRIX SIZE ') LTERM_NAME = 'LTERM_KGGD' LTERM = LTERM_KGGD ELSE - MODNAM = 'CALCULATE ESTIMATE OF KGG MATRIX SIZE ' + CALL LINK_MESSAGE('CALCULATE ESTIMATE OF KGG MATRIX SIZE ') LTERM_NAME = 'LTERM_KGG' LTERM = LTERM_KGG ENDIF @@ -389,9 +344,7 @@ SUBROUTINE LINK1 ENDIF if (setlktk /= 3) then ! Subr ESP0 estimated LTERM conservatively. Now allocate this amount - CALL OURTIM - MODNAM = 'ALLOCATE MEM FOR STFKEY, STFCOL, STFPNT, STF' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE MEM FOR STFKEY, STFCOL, STFPNT, STF') CALL ALLOCATE_STF_ARRAYS ( 'STFKEY', SUBR_NAME ) CALL ALLOCATE_STF_ARRAYS ( 'STF3', SUBR_NAME ) else @@ -401,9 +354,7 @@ SUBROUTINE LINK1 ! Compute element stiffness and merge into system stiffness matrix. - CALL OURTIM - MODNAM = 'G-SET STIFFNESS MATRIX PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('G-SET STIFFNESS MATRIX PROCESSOR ') CALL ESP IF ((SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:8) /= 'NLSTATIC') .AND. (SOL_NAME(1:8) /= 'DIFFEREN')) THEN @@ -417,34 +368,30 @@ SUBROUTINE LINK1 INQUIRE ( FILE=F23FIL, EXIST=LEXIST, OPENED=LOPEN ) IF (LOPEN) THEN - CALL FILE_CLOSE ( F23, F23FIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( F23, F23FIL, 'KEEP' ) ELSE - CALL FILE_CLOSE ( F23, F23FIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( F23, F23FIL, 'DELETE' ) ENDIF CALL DEALLOCATE_IN4_FILES ( 'IN4FIL' ) INQUIRE ( FILE=F24FIL, EXIST=LEXIST, OPENED=LOPEN ) IF (LOPEN) THEN - CALL FILE_CLOSE ( F24, F24FIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( F24, F24FIL, 'KEEP' ) ELSE - CALL FILE_CLOSE ( F24, F24FIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( F24, F24FIL, 'DELETE' ) ENDIF ! Convert system stiff matrix from linked list format to sparse format (SPARSE_KGG calls grid singularity check subr) IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - CALL OURTIM - MODNAM = 'SPARSE KGGD PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SPARSE KGGD PROCESSOR ') CALL SPARSE_KGGD CALL DEALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS' ) CALL DEALLOCATE_STF_ARRAYS ( 'STFKEY' ) CALL DEALLOCATE_STF_ARRAYS ( 'STF3' ) ELSE - CALL OURTIM - MODNAM = 'SPARSE KGG PROCESSOR ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SPARSE KGG PROCESSOR ') CALL SPARSE_KGG CALL DEALLOCATE_MODEL_STUF ( 'MPC_IND_GRIDS' ) CALL DEALLOCATE_STF_ARRAYS ( 'STFKEY' ) @@ -453,21 +400,17 @@ SUBROUTINE LINK1 ! Write DOF tables and deallocate - CALL OURTIM - MODNAM = 'WRITE DOF TABLES TO FILE AND DEALLOCATE ' WRITE(SC1,*) CR13 - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE DOF TABLES TO FILE AND DEALLOCATE ') CALL WRITE_DOF_TABLES - CALL FILE_CLOSE ( L1C, LINK1C, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1C, LINK1C, 'KEEP' ) ! Write element data to L1G. Save L1G for use in LINK9. IF (LOAD_ISTEP == 1) THEN - CALL FILE_OPEN ( L1G, LINK1G, OUNT, 'REPLACE', L1G_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1G, LINK1G, OUNT, 'REPLACE', L1G_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) - CALL OURTIM - MODNAM = 'WRITE ELEMENT DATA TO FILE ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE ELEMENT DATA TO FILE ') CALL ELSAVE @@ -480,7 +423,7 @@ SUBROUTINE LINK1 CALL DEALLOCATE_MODEL_STUF ( 'ESORT2' ) ENDIF - CALL FILE_CLOSE ( L1G, LINK1G, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1G, LINK1G, 'KEEP' ) ENDIF @@ -506,15 +449,12 @@ SUBROUTINE LINK1 COMM(LINKNO) = 'C' res20:IF (RESTART == 'N') THEN - CALL WRITE_L1A ( 'KEEP', 'Y', 'Y' ) + CALL WRITE_L1A ( 'KEEP', 'Y' ) ENDIF res20 -! Write LINK1 end to F04, F06 +! Write LINK1 end to F06 CALL OURTIM - IF (WRT_LOG > 0) THEN - WRITE(F04,151) LINKNO - ENDIF WRITE(F06,151) LINKNO IF (( DEBUG(193) == 1) .OR. (DEBUG(193) == 999)) THEN @@ -533,8 +473,6 @@ SUBROUTINE LINK1 154 FORMAT( ' >> LINK',I3,' END') - 1092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 9998 FORMAT(/,' PROCESSING TERMINATED DUE TO ',I8,' INPUT ERRORS. CHECK OUTPUT FILE FOR ERROR MESSAGES') ! ################################################################################################################################## diff --git a/Source/LK1/LINK1/LINK1_RESTART_DATA.f90 b/Source/LK1/LINK1/LINK1_RESTART_DATA.f90 index e1cd1cf3..e2a53ab4 100644 --- a/Source/LK1/LINK1/LINK1_RESTART_DATA.f90 +++ b/Source/LK1/LINK1/LINK1_RESTART_DATA.f90 @@ -29,11 +29,11 @@ SUBROUTINE LINK1_RESTART_DATA ! Reads data from files LINK1B, LINK1G, LINK1K, LINK1Q, LINK1Y (created in LINK1) needed in LINK1 restart USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06 , FILE_NAM_MAXLEN, & + USE IOUNT1, ONLY : ERR, F06 , FILE_NAM_MAXLEN, & L1B , L1G , L1K , L1Q , L1Y , & LINK1B , LINK1G , LINK1K , LINK1Q, LINK1Y , & L1B_MSG, L1G_MSG, L1K_MSG, L1Q_MSG, L1Y_MSG, & - L1BSTAT, L1GSTAT, L1KSTAT, L1YSTAT, WRT_LOG + L1BSTAT, L1GSTAT, L1KSTAT, L1YSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, MCORD, MRCORD, MGRID, MRGRID, NBAROFF, NCORD, & NCONM2, NEDAT, NELE, NGRID, NMATANGLE, NMATL, NPBAR, NPBEAM, NPDAT, NPELAS,NPROD, NPSHEL, & @@ -45,7 +45,6 @@ SUBROUTINE LINK1_RESTART_DATA MPCOMP_PLIES, MRPCOMP0, MRPCOMP_PLIES, MPUSERIN, MUSERIN_MAT_NAMES USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LINK1_RESTART_DATA_BEGEND USE PARAMS, ONLY : CBMIN3, CBMIN4, IORQ1M, IORQ1S, IORQ1B, IORQ2B, IORQ2T USE MODEL_STUF, ONLY : CORD, RCORD USE MODEL_STUF, ONLY : CONM2, RCONM2 @@ -73,14 +72,9 @@ SUBROUTINE LINK1_RESTART_DATA INTEGER(LONG) :: PCOMP_PLIES ! Number of plies in 1 PCOMP entry incl sym plies not explicitly defined INTEGER(LONG) :: REC_NO ! Record number of a record read from a file INTEGER(LONG) :: UNT ! Unit number of a file to be read - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LINK1_RESTART_DATA_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -94,7 +88,7 @@ SUBROUTINE LINK1_RESTART_DATA UNT = L1B MESSAG = L1B_MSG - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read GRID, RGRID data @@ -165,7 +159,7 @@ SUBROUTINE LINK1_RESTART_DATA CALL READ_CHK ( IOCHK, FILNAM, NAME_ShouldBe, REC_NO, OUNT ) ENDDO - CALL FILE_CLOSE ( L1B, LINK1B, L1BSTAT, 'Y' ) + CALL FILE_CLOSE ( L1B, LINK1B, L1BSTAT ) !----------------------------------------------------------------------------------------------------------------------------------- ! Open L1G @@ -174,7 +168,7 @@ SUBROUTINE LINK1_RESTART_DATA UNT = L1G MESSAG = L1G_MSG - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read ETYPE, EPNT, ESORT1 ESORT,2, EOFF @@ -748,7 +742,7 @@ SUBROUTINE LINK1_RESTART_DATA CALL READ_CHK ( IOCHK, FILNAM, NAME_ShouldBe, REC_NO, OUNT ) ENDDO - CALL FILE_CLOSE ( L1G, LINK1G, L1GSTAT, 'Y' ) + CALL FILE_CLOSE ( L1G, LINK1G, L1GSTAT ) !----------------------------------------------------------------------------------------------------------------------------------- ! Open L1K and read data @@ -759,7 +753,7 @@ SUBROUTINE LINK1_RESTART_DATA IF (NTCARD > 0) THEN - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read TPNT @@ -827,7 +821,7 @@ SUBROUTINE LINK1_RESTART_DATA ENDDO ENDDO - CALL FILE_CLOSE ( L1K, LINK1K, L1KSTAT, 'Y' ) + CALL FILE_CLOSE ( L1K, LINK1K, L1KSTAT ) ENDIF @@ -840,7 +834,7 @@ SUBROUTINE LINK1_RESTART_DATA IF (NTCARD > 0) THEN - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read PPNT @@ -929,7 +923,7 @@ SUBROUTINE LINK1_RESTART_DATA UNT = L1Y MESSAG = L1Y_MSG - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read CONM2, RCONM2 data @@ -955,12 +949,7 @@ SUBROUTINE LINK1_RESTART_DATA ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK1/LINK1/PRINT_CONSTANTS_1.f90 b/Source/LK1/LINK1/PRINT_CONSTANTS_1.f90 index d02d884e..e3247fe9 100644 --- a/Source/LK1/LINK1/PRINT_CONSTANTS_1.f90 +++ b/Source/LK1/LINK1/PRINT_CONSTANTS_1.f90 @@ -30,7 +30,7 @@ SUBROUTINE PRINT_CONSTANTS_1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : PROG_NAME USE PRINT_CONSTANTS_1_USE_IFs diff --git a/Source/LK1/LINK1/PRINT_ORDER.f90 b/Source/LK1/LINK1/PRINT_ORDER.f90 index 6bc4bf5a..e79e0c2f 100644 --- a/Source/LK1/LINK1/PRINT_ORDER.f90 +++ b/Source/LK1/LINK1/PRINT_ORDER.f90 @@ -29,7 +29,7 @@ SUBROUTINE PRINT_ORDER ! Writes abcissa's and weights from subroutines ORDER_GAUSS and ORDER_TRIA used in isoparametric element matrix generation subr's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_ORDER_GAUSS, MAX_ORDER_TRIA, NUM_TRIA_ORDERS, TRIA_ORDER_NUMS USE PRINT_ORDER_USE_IFs diff --git a/Source/LK1/LINK1/WRITE_ENF_TO_L1O.f90 b/Source/LK1/LINK1/WRITE_ENF_TO_L1O.f90 index b62f7f4e..d82d963e 100644 --- a/Source/LK1/LINK1/WRITE_ENF_TO_L1O.f90 +++ b/Source/LK1/LINK1/WRITE_ENF_TO_L1O.f90 @@ -31,13 +31,12 @@ SUBROUTINE WRITE_ENF_TO_L1O USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ENF, ENFFIL, ENFSTAT, ENF_MSG, ERR, F04, F06, L1O, LINK1O, L1OSTAT, L1O_MSG, WRT_LOG + USE IOUNT1, ONLY : ENF, ENFFIL, ENFSTAT, ENF_MSG, ERR, F06, L1O, LINK1O, L1OSTAT, L1O_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFSG, NGRID, NSPC, NUM_SPC_RECORDS, NUM_SPC1_RECORDS, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN USE DOF_TABLES, ONLY : TSET_CHR_LEN, TSET USE MODEL_STUF, ONLY : SPCSET - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ENF_TO_L1O_BEGEND USE WRITE_ENF_TO_L1O_USE_IFs @@ -51,16 +50,11 @@ SUBROUTINE WRITE_ENF_TO_L1O INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr FILE_OPEN INTEGER(LONG) :: REC_NO ! Number of the record read from ENF file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ENF_TO_L1O_BEGEND + REAL(DOUBLE) :: RSPC(6) ! Enforced displ components read from file ENF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** OUNT(1) = ERR @@ -90,7 +84,7 @@ SUBROUTINE WRITE_ENF_TO_L1O ENDIF ENDIF - CALL FILE_OPEN ( ENF, ENFFIL, OUNT, 'OLD' , ENF_MSG, 'NEITHER' , 'FORMATTED' , 'READ' , 'REWIND', 'N', 'N', 'N' ) + CALL FILE_OPEN ( ENF, ENFFIL, OUNT, 'OLD' , ENF_MSG, 'NEITHER' , 'FORMATTED' , 'READ' , 'REWIND', 'N', 'N' ) REC_NO = 0 NUM_SPC_RECORDS = 0 @@ -120,15 +114,10 @@ SUBROUTINE WRITE_ENF_TO_L1O ENDDO - CALL FILE_CLOSE ( ENF, ENFFIL, 'KEEP', 'Y' ) - CALL FILE_CLOSE ( L1O, LINK1O, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( ENF, ENFFIL, 'KEEP' ) + CALL FILE_CLOSE ( L1O, LINK1O, 'KEEP' ) + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/LK2/ALLOCATE_L2_GMN_2.f90 b/Source/LK2/ALLOCATE_L2_GMN_2.f90 index 7d3d247c..916ef72b 100644 --- a/Source/LK2/ALLOCATE_L2_GMN_2.f90 +++ b/Source/LK2/ALLOCATE_L2_GMN_2.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_L2_GMN_2 ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFM, NTERM_GMN, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_L2_GMN_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_GMN USE ALLOCATE_L2_GMN_2_USE_IFs @@ -44,14 +43,13 @@ SUBROUTINE ALLOCATE_L2_GMN_2 ( CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_L2_GMN_2' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows in array INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_L2_GMN_2_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -61,12 +59,7 @@ SUBROUTINE ALLOCATE_L2_GMN_2 ( CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Allocate array for I2_GMN @@ -112,16 +105,6 @@ SUBROUTINE ALLOCATE_L2_GMN_2 ( CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -134,10 +117,6 @@ SUBROUTINE ALLOCATE_L2_GMN_2 ( CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE ALLOCATE_L2_GMN_2 diff --git a/Source/LK2/ALLOCATE_L2_GOA_2.f90 b/Source/LK2/ALLOCATE_L2_GOA_2.f90 index 5a4411a6..2ae8c292 100644 --- a/Source/LK2/ALLOCATE_L2_GOA_2.f90 +++ b/Source/LK2/ALLOCATE_L2_GOA_2.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_L2_GOA_2 ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NTERM_GOA, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_L2_GOA_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_GOA USE ALLOCATE_L2_GOA_2_USE_IFs @@ -44,14 +43,13 @@ SUBROUTINE ALLOCATE_L2_GOA_2 ( CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_L2_GOA_2' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows in array INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_L2_GOA_2_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -61,12 +59,7 @@ SUBROUTINE ALLOCATE_L2_GOA_2 ( CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Allocate array I2_GOA @@ -112,17 +105,6 @@ SUBROUTINE ALLOCATE_L2_GOA_2 ( CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF - RETURN ! ********************************************************************************************************************************** @@ -134,10 +116,6 @@ SUBROUTINE ALLOCATE_L2_GOA_2 ( CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE ALLOCATE_L2_GOA_2 diff --git a/Source/LK2/DEALLOCATE_L2_GMN_2.f90 b/Source/LK2/DEALLOCATE_L2_GMN_2.f90 index 2c512f12..a3b85d34 100644 --- a/Source/LK2/DEALLOCATE_L2_GMN_2.f90 +++ b/Source/LK2/DEALLOCATE_L2_GMN_2.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_L2_GMN_2 ! Deallocate some arrays used in LINK USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_L2_GMN_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_GMN USE DEALLOCATE_L2_GMN_2_USE_IFs @@ -47,18 +46,13 @@ SUBROUTINE DEALLOCATE_L2_GMN_2 INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_L2_GMN_2_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -84,28 +78,13 @@ SUBROUTINE DEALLOCATE_L2_GMN_2 CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN ! ********************************************************************************************************************************** 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE DEALLOCATE_L2_GMN_2 diff --git a/Source/LK2/DEALLOCATE_L2_GOA_2.f90 b/Source/LK2/DEALLOCATE_L2_GOA_2.f90 index f3172211..978f5628 100644 --- a/Source/LK2/DEALLOCATE_L2_GOA_2.f90 +++ b/Source/LK2/DEALLOCATE_L2_GOA_2.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_L2_GOA_2 ! Deallocate some arrays used in LINK2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_L2_GOA_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_GOA USE DEALLOCATE_L2_GOA_2_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_L2_GOA_2 CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_L2_GOA_2' CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_L2_GOA_2_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -85,25 +78,12 @@ SUBROUTINE DEALLOCATE_L2_GOA_2 ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN ! ********************************************************************************************************************************** 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/LK2/LINK2.f90 b/Source/LK2/LINK2.f90 index 85f46802..bb72460d 100644 --- a/Source/LK2/LINK2.f90 +++ b/Source/LK2/LINK2.f90 @@ -35,7 +35,7 @@ SUBROUTINE LINK2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06, L1A, ERRSTAT, SC1 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06, L1A, ERRSTAT, SC1 USE IOUNT1, ONLY : L2G, L2H , L2I , L2O , L2P , L2Q USE IOUNT1, ONLY : LINK2G, LINK2H , LINK2I , LINK2O , LINK2P , LINK2Q USE IOUNT1, ONLY : L2G_MSG, L2H_MSG, L2I_MSG, L2O_MSG, L2P_MSG, L2Q_MSG @@ -54,7 +54,6 @@ SUBROUTINE LINK2 NTERM_PA , NTERM_PL , & NTERM_RMG , SOL_NAME , WARN_ERR - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC USE CONSTANTS_1, ONLY : ONE USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET USE PARAMS, ONLY : CUSERIN, CUSERIN_XSET, EQCHK_OUTPUT, EQCHK_NORM, PRTSTIFF, PRTSTIFD, PRTMASS, PRTFOR, & @@ -69,6 +68,8 @@ SUBROUTINE LINK2 USE SPARSE_MATRICES, ONLY : SYM_KGG USE OUTPUT4_MATRICES, ONLY : NUM_OU4_REQUESTS USE LINK2_USE_IFs + USE LINK_MESSAGE_Interface + IMPLICIT NONE @@ -76,7 +77,6 @@ SUBROUTINE LINK2 CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'LINK2' CHARACTER( 1*BYTE) :: CLOSE_IT ! Input to subr READ_MATRIX_i. 'Y'/'N' whether to close a file or not CHARACTER( 8*BYTE) :: CLOSE_STAT ! What to do with file when it is closed - CHARACTER( 44*BYTE) :: MODNAM ! Name to write to screen to describe module being run INTEGER(LONG) :: NROWS ! Value of DOF size to pass to subr WRITE_USERIN_BD_CARDS INTEGER(LONG) :: I,J ! DO loop indices @@ -109,14 +109,11 @@ SUBROUTINE LINK2 ! Write info to text files WRITE(F06,150) LINKNO - IF (WRT_LOG > 0) THEN - WRITE(F04,150) LINKNO - ENDIF WRITE(ERR,150) LINKNO ! Read LINK1A file - CALL READ_L1A ( 'KEEP', 'Y' ) + CALL READ_L1A ( 'KEEP' ) ! Check COMM for successful completion of prior LINKs IF (COMM(P_LINKNO) /= 'C') THEN @@ -152,9 +149,7 @@ SUBROUTINE LINK2 ELSE CALL GET_MATRIX_DIAG_STATS ( 'KGG ', 'G ', NDOFG, NTERM_KGG , I_KGG , J_KGG , KGG , PRTSTIFD(1), KGG_DIAG , KGG_MAX_DIAG ) IF (EQCHK_OUTPUT(1) > 0) THEN - CALL OURTIM - MODNAM = 'EQUILIBRIUM CHECK ON KGG ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('EQUILIBRIUM CHECK ON KGG ') CALL STIFF_MAT_EQUIL_CHK ( EQCHK_OUTPUT(1), 'G ', SYM_KGG, NDOFG, NTERM_KGG, I_KGG, J_KGG, KGG, KGG_DIAG, KGG_MAX_DIAG,& RBGLOBAL_GSET ) ENDIF @@ -180,9 +175,7 @@ SUBROUTINE LINK2 NTERM_KNM = 0 NTERM_KMM = 0 ENDIF - CALL OURTIM - MODNAM = 'REDUCE G-SET TO N, M-SETS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('REDUCE G-SET TO N, M-SETS ') CALL REDUCE_G_NM WRITE(ERR,2001) NDOFM @@ -203,9 +196,7 @@ SUBROUTINE LINK2 NTERM_KFS = 0 NTERM_KSS = 0 ENDIF - CALL OURTIM - MODNAM = 'REDUCE N-SET TO F, S-SETS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('REDUCE N-SET TO F, S-SETS ') CALL REDUCE_N_FS WRITE(ERR,2003) NDOFS WRITE(ERR,2013) NDOFSA @@ -227,9 +218,7 @@ SUBROUTINE LINK2 NTERM_KAO = 0 NTERM_KOO = 0 ENDIF - CALL OURTIM - MODNAM = 'REDUCE F-SET TO A, O-SETS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('REDUCE F-SET TO A, O-SETS ') CALL REDUCE_F_AO WRITE(ERR,2005) NDOFO WRITE(ERR,2006) NDOFA @@ -242,23 +231,17 @@ SUBROUTINE LINK2 IF (SOL_NAME == 'GEN CB MODEL') THEN - CALL OURTIM - MODNAM = 'WRITE KAA STIFFNESS ARRAYS TO FILE' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE KAA STIFFNESS ARRAYS TO FILE') IF (NTERM_KAA > 0) THEN CALL WRITE_MATRIX_1 ( LINK2O, L2O, 'Y', 'KEEP', L2O_MSG, 'KAA', NTERM_KAA, NDOFA, I_KAA, J_KAA, KAA ) ENDIF - CALL OURTIM - MODNAM = 'WRITE MAA MASS ARRAYS TO FILE' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE MAA MASS ARRAYS TO FILE') IF (NTERM_MAA > 0) THEN CALL WRITE_MATRIX_1 ( LINK2P, L2P, 'Y', 'KEEP', L2P_MSG, 'MAA', NTERM_MAA, NDOFA, I_MAA, J_MAA, MAA ) ENDIF - CALL OURTIM - MODNAM = 'WRITE PA LOAD ARRAYS TO FILE' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE PA LOAD ARRAYS TO FILE') IF (NTERM_PA > 0) THEN CALL WRITE_MATRIX_1 ( LINK2Q, L2Q, 'Y', 'KEEP', L2Q_MSG, 'PA' , NTERM_PA , NDOFA, I_PA , J_PA , PA ) ENDIF @@ -276,9 +259,7 @@ SUBROUTINE LINK2 NTERM_KRL = 0 NTERM_KRR = 0 ENDIF - CALL OURTIM - MODNAM = 'REDUCE A-SET TO L, R-SETS ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('REDUCE A-SET TO L, R-SETS ') CALL REDUCE_A_LR CALL DEALLOCATE_RBGLOBAL ( 'G ' ) WRITE(ERR,2007) NDOFR @@ -296,9 +277,8 @@ SUBROUTINE LINK2 ELSE - CALL OURTIM ! Write L-set arrays to files - MODNAM = 'WRITE L SET ARRAYS TO FILE' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + ! Write L-set arrays to files + CALL LINK_MESSAGE('WRITE L SET ARRAYS TO FILE') IF (NTERM_KLL > 0) THEN CLOSE_IT = 'Y' @@ -327,9 +307,7 @@ SUBROUTINE LINK2 IF (NUM_OU4_REQUESTS > 0) THEN ! Call OUTPUT4 processor to process output requests for OUTPUT4 matrices - CALL OURTIM - MODNAM = 'WRITE OUTPUT4 NATRICES ' - WRITE(SC1,1092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE OUTPUT4 NATRICES ') WRITE(F06,*) CALL OUTPUT4_PROC ( SUBR_NAME ) @@ -392,7 +370,7 @@ SUBROUTINE LINK2 ! Write data to L1A - CALL WRITE_L1A ( 'KEEP', 'Y', 'Y' ) + CALL WRITE_L1A ( 'KEEP', 'Y' ) ! Check allocation status of allocatable arrays, if requested @@ -403,12 +381,9 @@ SUBROUTINE LINK2 ENDIF ENDIF -! Write LINK2 end to F04, F06 +! Write LINK2 end to F06 CALL OURTIM - IF (WRT_LOG > 0) THEN - WRITE(F04,151) LINKNO - ENDIF WRITE(F06,151) LINKNO ! Close files @@ -450,8 +425,6 @@ SUBROUTINE LINK2 2008 FORMAT(' *INFORMATION: NUMBER OF L SET DEGREES OF FREEDOM (NDOFL) = ',I12,/) - 1092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 2888 FORMAT(' *WARNING : CANNOT OUTPUT CUSERIN BD CARDS SINCE THE DOF SET REQUESTED ("',A,'") IS NOT ONE PROGRAMMED') 9998 FORMAT(' *ERROR 9998: COMM ',I3,' INDICATES UNSUCCESSFUL LINK ',I2,' COMPLETION.' & diff --git a/Source/LK2/REDUCE_A_LR.f90 b/Source/LK2/REDUCE_A_LR.f90 index fa99c3b6..2f283351 100644 --- a/Source/LK2/REDUCE_A_LR.f90 +++ b/Source/LK2/REDUCE_A_LR.f90 @@ -29,7 +29,7 @@ SUBROUTINE REDUCE_A_LR ! Call routines to reduce stiffness, mass, loads from A-set to L, R-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, LINKNO, NDOFA, NDOFG, NDOFL, NDOFR, NSUB, SOL_NAME, & NTERM_KAA , NTERM_KLL , NTERM_KRL , NTERM_KRR , & NTERM_KAAD, NTERM_KLLD, NTERM_KRLD, NTERM_KRRD, & @@ -41,7 +41,6 @@ SUBROUTINE REDUCE_A_LR USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_ASET, RBGLOBAL_GSET, RBGLOBAL_LSET USE PARAMS, ONLY : EQCHK_OUTPUT, MATSPARS, PRTSTIFD, PRTSTIFF, PRTMASS, PRTFOR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_A_LR_BEGEND USE SPARSE_MATRICES, ONLY : I_KAA , J_KAA , KAA , I_KLL , J_KLL , KLL , I_KRL , J_KRL , KRL , I_KRR , J_KRR , KRR , & I_KAAD, J_KAAD, KAAD, I_KLLD, J_KLLD, KLLD, I_KRLD, J_KRLD, KRLD, I_KRRD, J_KRRD, KRRD, & I_MAA , J_MAA , MAA , I_MLL , J_MLL , MLL , I_MRL , J_MRL , MRL , I_MRR , J_MRR , MRR , & @@ -75,19 +74,14 @@ SUBROUTINE REDUCE_A_LR INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: PART_VEC_A_LR(NDOFA) ! Partitioning vector (N set into F and S sets) INTEGER(LONG) :: PART_VEC_SUB(NSUB) ! Partitioning vector (1's for all subcases) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_A_LR_BEGEND + REAL(DOUBLE) :: KLL_DIAG(NDOFL) ! Diagonal terms from KLL REAL(DOUBLE) :: KLL_MAX_DIAG ! Max diag term from KLL REAL(DOUBLE) :: KLLD_DIAG(NDOFL) ! Diagonal terms from KLLD REAL(DOUBLE) :: KLLD_MAX_DIAG ! Max diag term from KLLD -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Determine if we need to keep any OUTPUT4 matrices allocated until after they are processed in LINK2 @@ -485,12 +479,7 @@ SUBROUTINE REDUCE_A_LR ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_F_AO.f90 b/Source/LK2/REDUCE_F_AO.f90 index fb9ccfac..08bcf829 100644 --- a/Source/LK2/REDUCE_F_AO.f90 +++ b/Source/LK2/REDUCE_F_AO.f90 @@ -29,7 +29,7 @@ SUBROUTINE REDUCE_F_AO ! Call routines to reduce stiffness, mass, loads from F-set to A, O-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE CONSTANTS_1, ONLY : ZERO USE SCONTR, ONLY : BLNK_SUB_NAM, LINKNO, KOO_SDIA, NDOFF, NDOFG, NDOFA, NDOFO, NSUB, SOL_NAME, & NTERM_KFF , NTERM_KAA , NTERM_KAO , NTERM_KOO , & @@ -41,7 +41,6 @@ SUBROUTINE REDUCE_F_AO USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE DOF_TABLES, ONLY : TDOFI USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_FSET, RBGLOBAL_ASET - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_F_AO_BEGEND USE SPARSE_MATRICES, ONLY : I_KFF , J_KFF , KFF , I_KAA , J_KAA , KAA , I_KAO , J_KAO , KAO , I_KOO , J_KOO , KOO , & I_KFFD, J_KFFD, KFFD, I_KAAD, J_KAAD, KAAD, I_KAOD, J_KAOD, KAOD, I_KOOD, J_KOOD, KOOD, & I_MFF , J_MFF , MFF , I_MAA , J_MAA , MAA , I_MAO , J_MAO , MAO , I_MOO , J_MOO , MOO , & @@ -65,7 +64,7 @@ SUBROUTINE REDUCE_F_AO INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: PART_VEC_F_AO(NDOFF)! Partitioning vector (G set into N and M sets) INTEGER(LONG) :: PART_VEC_SUB(NSUB) ! Partitioning vector (1's for all subcases) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_F_AO_BEGEND + REAL(DOUBLE) :: DUM_COL(NDOFO) ! Temp variable used in SuperLU REAL(DOUBLE) :: KAA_DIAG(NDOFA) ! Diagonal terms from KAA @@ -75,12 +74,7 @@ SUBROUTINE REDUCE_F_AO INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Depending on whether this is a BUCKLING soln (and LOAD_ISTEP value) or not, one or another segment of code will be run @@ -455,12 +449,7 @@ SUBROUTINE REDUCE_F_AO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_G_NM.f90 b/Source/LK2/REDUCE_G_NM.f90 index 8bfc8f25..cf5f3936 100644 --- a/Source/LK2/REDUCE_G_NM.f90 +++ b/Source/LK2/REDUCE_G_NM.f90 @@ -29,7 +29,7 @@ SUBROUTINE REDUCE_G_NM ! Call routines to reduce stiffness, mass, loads and constraint matrices from G-set to N, M-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1C, LINK1C, L1C_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1C, LINK1C, L1C_MSG, SC1, WRT_ERR USE SCONTR, ONLY : LINKNO , NDOFG, NDOFN, NDOFM, NGRID, NSUB, & NTERM_KGG , NTERM_KNN , NTERM_KNM , NTERM_KMM , & @@ -44,7 +44,6 @@ SUBROUTINE REDUCE_G_NM USE DOF_TABLES, ONLY : TDOF, TDOFI USE MODEL_STUF, ONLY : GRID_ID USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_NSET - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_G_NM_BEGEND USE SPARSE_MATRICES, ONLY : I_KGG , J_KGG , KGG , I_KGGD, J_KGGD, KGGD, & I_KNN , J_KNN , KNN , I_KNM , J_KNM , KNM , I_KMM , J_KMM , KMM , & I_KNND, J_KNND, KNND, I_KNMD, J_KNMD, KNMD, I_KMMD, J_KMMD, KMMD, & @@ -83,7 +82,6 @@ SUBROUTINE REDUCE_G_NM INTEGER(LONG) :: PART_VEC_SUB(NSUB) ! Partitioning vector (1's for all subcases) INTEGER(LONG) :: SA_SET_COL ! Col no. in array TDOF where the SA-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: TOT_NUM_ASPC ! Sum of NUM_ASPC_BY_COMP(6) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_G_NM_BEGEND REAL(DOUBLE) :: KNN_DIAG(NDOFN) ! Diagonal terms from KNN REAL(DOUBLE) :: KNN_MAX_DIAG ! Max diag term from KNN @@ -92,12 +90,7 @@ SUBROUTINE REDUCE_G_NM INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Determine if we need to keep any OUTPUT4 matrices allocated until after they are processed in LINK2 @@ -434,7 +427,7 @@ SUBROUTINE REDUCE_G_NM WRITE(SC1,2092) MODNAM,HOUR,MINUTE,SEC,SFRAC K = 0 DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS K = K + 1 IF (TDOF(K,SA_SET_COL) /= 0) THEN @@ -546,12 +539,7 @@ SUBROUTINE REDUCE_G_NM ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -574,8 +562,8 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 ! reruns subr TDOF_PROC and writes the new TSET, TDOF, TDOFI tables to file L1C USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE SCONTR, ONLY : DATA_NAM_LEN, NDOFG, NDOFSA, NGRID, NUM_PCHD_SPC1 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1C, L1C_MSG, LINK1C, SPC, SPCFIL + USE SCONTR, ONLY : DATA_NAM_LEN, FATAL_ERR, NDOFG, NDOFSA, NGRID, NUM_PCHD_SPC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1C, L1C_MSG, LINK1C, SPC, SPCFIL USE PARAMS, ONLY : AUTOSPC, AUTOSPC_INFO, AUTOSPC_NSET, PCHSPC1, PRTTSET, SPC1SID USE DOF_TABLES, ONLY : TDOF, TDOFI, TSET USE MODEL_STUF, ONLY : GRID, GRID_ID, GRID_SEQ @@ -593,14 +581,13 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 INTEGER(LONG) :: GRID_ID_ROW_NUM ! Row number in array GRID_ID where AGRID is found INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening/reading a file - INTEGER(LONG) :: JSTART ! DO loop start point INTEGER(LONG) :: NUM_ASPC_BY_COMP(6)! Number of AUTOSPC's by component number INTEGER(LONG) :: NUM_N_SET_ROWS_NULL! Number of rows in KNN that are null and are not S or O-set members INTEGER(LONG) :: N_SET_COL ! Col no. in array TDOF where the N-set is (from subr TDOF_COL_NUM) + INTEGER(LONG), ALLOCATABLE :: N_SET_TDOFI_ROW(:) ! Row in TDOFI for each N-set DOF number INTEGER(LONG) :: R_SET_COL ! Col no. in array TDOF where the R-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: S_SET_COL ! Col no. in array TDOF where the S-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - ! ********************************************************************************************************************************** OUNT(1) = ERR OUNT(2) = F06 @@ -613,8 +600,8 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 OPEN (SPC, FILE=SPCFIL, STATUS='REPLACE', IOSTAT=IOCHK) ENDIF IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SPCFIL, OUNT, 'Y' ) - CALL FILERR ( OUNT, 'Y' ) + CALL OPNERR ( IOCHK, SPCFIL, OUNT ) + CALL FILERR ( OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF @@ -622,6 +609,21 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 CALL TDOF_COL_NUM ( 'R ', R_SET_COL ) CALL TDOF_COL_NUM ( 'S ', S_SET_COL ) + IF (NDOFN > 0) THEN + ALLOCATE ( N_SET_TDOFI_ROW(NDOFN), STAT=IOCHK ) + IF (IOCHK /= 0) THEN + WRITE(ERR,*) ' *ERROR: ALLOCATING N_SET_TDOFI_ROW IN ', SUBR_NAME + WRITE(F06,*) ' *ERROR: ALLOCATING N_SET_TDOFI_ROW IN ', SUBR_NAME + FATAL_ERR = FATAL_ERR + 1 + CALL OUTA_HERE ( 'Y' ) + ENDIF + N_SET_TDOFI_ROW = 0 + DO J=1,NDOFG + N_SET_DOF = TDOFI(J,N_SET_COL) + IF (N_SET_DOF > 0) N_SET_TDOFI_ROW(N_SET_DOF) = J + ENDDO + ENDIF + WRITE(ERR,101) AUTOSPC_NSET, PROG_NAME IF (SUPINFO == 'N') THEN WRITE(F06,101) AUTOSPC_NSET, PROG_NAME @@ -634,12 +636,12 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 ENDDO NUM_N_SET_ROWS_NULL = 0 - JSTART = 1 !xx WRITE(SC1, * ) ! Advance 1 line for screen messages CALL COUNTER_INIT(' Proc N-set DOF ', NDOFN) i_do: DO I=1,NDOFN IF (I_KNN(I+1) == I_KNN(I)) THEN ! If true, row i is null -j_do: DO J=JSTART,NDOFG ! Loop over rows of TDOFI to find where this N-set row is null + J = N_SET_TDOFI_ROW(I) + IF (J > 0) THEN IF (TDOFI(J,N_SET_COL) == I) THEN IF ((TDOFI(J,S_SET_COL) == 0) .AND. (TDOFI(J,R_SET_COL) == 0)) THEN NUM_N_SET_ROWS_NULL = NUM_N_SET_ROWS_NULL + 1 @@ -659,11 +661,19 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 WRITE(SPC,109) SPC1SID, COMP, AGRID NUM_PCHD_SPC1 = NUM_PCHD_SPC1 + 1 ENDIF - JSTART = J - EXIT j_do ENDIF + ELSE + WRITE(ERR,*) ' *ERROR: N_SET_AUTOSPC_PROC_1 LOOKUP MISMATCH FOR N-SET DOF ', I + WRITE(F06,*) ' *ERROR: N_SET_AUTOSPC_PROC_1 LOOKUP MISMATCH FOR N-SET DOF ', I + FATAL_ERR = FATAL_ERR + 1 + CALL OUTA_HERE ( 'Y' ) ENDIF - ENDDO j_do + ELSE + WRITE(ERR,*) ' *ERROR: N_SET_AUTOSPC_PROC_1 LOOKUP FAILED FOR N-SET DOF ', I + WRITE(F06,*) ' *ERROR: N_SET_AUTOSPC_PROC_1 LOOKUP FAILED FOR N-SET DOF ', I + FATAL_ERR = FATAL_ERR + 1 + CALL OUTA_HERE ( 'Y' ) + ENDIF ENDIF CALL COUNTER_PROGRESS(I) ENDDO i_do @@ -672,9 +682,9 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 ! Close SPC file IF (NUM_PCHD_SPC1 > 0) THEN - CALL FILE_CLOSE ( SPC, SPCFIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( SPC, SPCFIL, 'KEEP' ) ELSE - CALL FILE_CLOSE ( SPC, SPCFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SPC, SPCFIL, 'DELETE' ) ENDIF ! IF we changed some DOF's from the N-set to the SA-set regenerate TDOF, TDOFI tables and write them to L1C @@ -707,9 +717,9 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'REPLACE', L1C_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'REPLACE', L1C_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) CALL WRITE_DOF_TABLES - CALL FILE_CLOSE ( L1C, LINK1C, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1C, LINK1C, 'KEEP' ) ELSE @@ -719,7 +729,6 @@ SUBROUTINE N_SET_AUTOSPC_PROC_1 ENDIF ENDIF - ! ********************************************************************************************************************************** 56 FORMAT(64X,'DEGREE OF FREEDOM SET TABLE (TSET)') @@ -752,7 +761,7 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : DATA_NAM_LEN, NDOFN, NDOFG, NDOFSA, NGRID, NUM_PCHD_SPC1, PROG_NAME - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L1C, L1C_MSG, LINK1C, SPC, SPCFIL + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L1C, L1C_MSG, LINK1C, SPC, SPCFIL USE PARAMS, ONLY : AUTOSPC, AUTOSPC_INFO, AUTOSPC_NSET, AUTOSPC_RAT, PCHSPC1, PRTTSET, SPC1SID USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TDOF, TDOFI, TSET @@ -779,7 +788,6 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 INTEGER(LONG) :: R_SET_COL ! Col no. in array TDOF where the R-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: S_SET_COL ! Col no. in array TDOF where the S-set is (from subr TDOF_COL_NUM) INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - ! ********************************************************************************************************************************** OUNT(1) = ERR OUNT(2) = F06 @@ -792,8 +800,8 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 OPEN (SPC, FILE=SPCFIL, STATUS='REPLACE', IOSTAT=IOCHK) ENDIF IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SPCFIL, OUNT, 'Y' ) - CALL FILERR ( OUNT, 'Y' ) + CALL OPNERR ( IOCHK, SPCFIL, OUNT ) + CALL FILERR ( OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF @@ -851,9 +859,9 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 ! Close SPC file IF (NUM_PCHD_SPC1 > 0) THEN - CALL FILE_CLOSE ( SPC, SPCFIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( SPC, SPCFIL, 'KEEP' ) ELSE - CALL FILE_CLOSE ( SPC, SPCFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SPC, SPCFIL, 'DELETE' ) ENDIF ! IF we changed some DOF's from the N-set to the SA-set regenerate TDOF, TDOFI tables and write them to L1C @@ -886,11 +894,11 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'REPLACE', L1C_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'REPLACE', L1C_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) CALL WRITE_DOF_TABLES - CALL FILE_CLOSE ( L1C, LINK1C, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1C, LINK1C, 'KEEP' ) ELSE @@ -900,9 +908,8 @@ SUBROUTINE N_SET_AUTOSPC_PROC_2 ENDIF ENDIF - ! ********************************************************************************************************************************** - 56 FORMAT(64X,'DEGREE OF FREEDOM SET TABLE (TSET)') + 56 FORMAT(64X,'DEGREE OF FREEDOM SET TABLE (TSET)') 57 FORMAT(33x,' GRID SEQUENCE T1 T2 T3 R1 R2 R3',/) diff --git a/Source/LK2/REDUCE_KAAD_TO_KLLD.f90 b/Source/LK2/REDUCE_KAAD_TO_KLLD.f90 index 246f8a00..9c89be86 100644 --- a/Source/LK2/REDUCE_KAAD_TO_KLLD.f90 +++ b/Source/LK2/REDUCE_KAAD_TO_KLLD.f90 @@ -29,11 +29,10 @@ SUBROUTINE REDUCE_KAAD_TO_KLLD ( PART_VEC_A_LR ) ! Call routines to reduce the KAAD differential stiffness matrix from the A-set to the L, R-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2K, L2L, LINK2K, LINK2L, L2K_MSG, L2L_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2K, L2L, LINK2K, LINK2L, L2K_MSG, L2L_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFL, NDOFR, NTERM_KAAD, NTERM_KLLD, NTERM_KRLD, & NTERM_KRRD, SOL_NAME USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KAAD_TO_KLLD_BEGEND USE SPARSE_MATRICES, ONLY : I_KAAD, J_KAAD, KAAD, I_KLLD, J_KLLD, KLLD, I_KRLD, J_KRLD, KRLD, I_KRRD, J_KRRD, KRRD, & SYM_KAAD, SYM_KLLD, SYM_KRLD, SYM_KRRD USE SCRATCH_MATRICES @@ -50,14 +49,9 @@ SUBROUTINE REDUCE_KAAD_TO_KLLD ( PART_VEC_A_LR ) INTEGER(LONG) :: KRRD_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KAAD_TO_KLLD_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Partition KLLD from KAAD (This is KLLD before reduction, or KLLD(bar) ) @@ -108,12 +102,7 @@ SUBROUTINE REDUCE_KAAD_TO_KLLD ( PART_VEC_A_LR ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_KAA_TO_KLL.f90 b/Source/LK2/REDUCE_KAA_TO_KLL.f90 index bd84c93f..57e4c64f 100644 --- a/Source/LK2/REDUCE_KAA_TO_KLL.f90 +++ b/Source/LK2/REDUCE_KAA_TO_KLL.f90 @@ -29,11 +29,10 @@ SUBROUTINE REDUCE_KAA_TO_KLL ( PART_VEC_A_LR ) ! Call routines to reduce the KAA linear stiffness matrix from the A-set to the L, R-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2K, L2L, LINK2K, LINK2L, L2K_MSG, L2L_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2K, L2L, LINK2K, LINK2L, L2K_MSG, L2L_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFL, NDOFR, NTERM_KAA, NTERM_KLL, NTERM_KRL, NTERM_KRR, & SOL_NAME USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KAA_TO_KLL_BEGEND USE SPARSE_MATRICES, ONLY : I_KAA, J_KAA, KAA, I_KLL, J_KLL, KLL, I_KRL, J_KRL, KRL, I_KRR, J_KRR, KRR, & SYM_KAA, SYM_KLL, SYM_KRL, SYM_KRR USE SCRATCH_MATRICES @@ -50,14 +49,9 @@ SUBROUTINE REDUCE_KAA_TO_KLL ( PART_VEC_A_LR ) INTEGER(LONG) :: KRR_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KAA_TO_KLL_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Partition KLL from KAA (This is KLL before reduction, or KLL(bar) ) @@ -115,12 +109,7 @@ SUBROUTINE REDUCE_KAA_TO_KLL ( PART_VEC_A_LR ) CALL WRITE_MATRIX_1 ( LINK2L, L2L, 'Y', 'KEEP', L2L_MSG, 'KRR', NTERM_KRR, NDOFR, I_KRR, J_KRR, KRR ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_KFFD_TO_KAAD.f90 b/Source/LK2/REDUCE_KFFD_TO_KAAD.f90 index 3cfd01d9..6b304c7c 100644 --- a/Source/LK2/REDUCE_KFFD_TO_KAAD.f90 +++ b/Source/LK2/REDUCE_KFFD_TO_KAAD.f90 @@ -29,12 +29,11 @@ SUBROUTINE REDUCE_KFFD_TO_KAAD ( PART_VEC_F_AO ) ! Call routines to reduce the KFFD differential stiffness matrix from the F-set to the A, O-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2E, LINK2E, L2E_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2E, LINK2E, L2E_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, NDOFF, NDOFA, NDOFO, NTERM_KFFD, NTERM_KAAD, & NTERM_KAOD, NTERM_KOOD, NTERM_KOODs, NTERM_GOA USE PARAMS, ONLY : EPSIL, KOORAT, SPARSTOR, RCONDK USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KFFD_TO_KAAD_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_KFFD, J_KFFD, KFFD, I_KAAD, J_KAAD, KAAD, I_KAOD, J_KAOD, KAOD, I_GOA, J_GOA, GOA, & I_KOOD, I2_KOOD, J_KOOD, KOOD, I_KOODs, I2_KOODs, J_KOODs, KOODs @@ -62,16 +61,11 @@ SUBROUTINE REDUCE_KFFD_TO_KAAD ( PART_VEC_F_AO ) INTEGER(LONG) :: NTERM_CRS2 ! Number of terms in matrix CRS2 INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KFFD_TO_KAAD_BEGEND + INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Partition KAAD from KFFD (This is KAAD before reduction, or KAAD(bar) ) @@ -208,12 +202,7 @@ SUBROUTINE REDUCE_KFFD_TO_KAAD ( PART_VEC_F_AO ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_KFF_TO_KAA.f90 b/Source/LK2/REDUCE_KFF_TO_KAA.f90 index 0e4d6490..2ab83494 100644 --- a/Source/LK2/REDUCE_KFF_TO_KAA.f90 +++ b/Source/LK2/REDUCE_KFF_TO_KAA.f90 @@ -34,12 +34,11 @@ SUBROUTINE REDUCE_KFF_TO_KAA ( PART_VEC_F_AO ) ! MYSTRAN since that approx time does not have full matrix code. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2E, LINK2E, L2E_MSG, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2E, LINK2E, L2E_MSG, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KOO_SDIA, NDOFF, NDOFA, NDOFO, NTERM_KFF, & NTERM_KAA, NTERM_KAO, NTERM_KOO, NTERM_GOA USE PARAMS, ONLY : KOORAT, MATSPARS, SOLLIB, SPARSTOR, SPARSE_FLAVOR, RCONDK USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KFF_TO_KAA_BEGEND USE CONSTANTS_1, ONLY : ONE USE FULL_MATRICES, ONLY : KAA_FULL, KAO_FULL, GOA_FULL, DUM1, DUM2 USE SPARSE_MATRICES, ONLY : I_KFF, J_KFF, KFF, I_KAA, J_KAA, KAA, I_KAO, J_KAO, KAO, I_GOA, J_GOA, GOA, & @@ -77,7 +76,7 @@ SUBROUTINE REDUCE_KFF_TO_KAA ( PART_VEC_F_AO ) INTEGER(LONG) :: NTERM_CRS2 ! Number of terms in matrix CRS2 INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KFF_TO_KAA_BEGEND + REAL(DOUBLE) :: ALPHA = ONE ! Scalar multiplier for matrix REAL(DOUBLE) :: BETA = ONE ! Scalar multiplier for matrix @@ -91,12 +90,7 @@ SUBROUTINE REDUCE_KFF_TO_KAA ( PART_VEC_F_AO ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -355,12 +349,7 @@ SUBROUTINE REDUCE_KFF_TO_KAA ( PART_VEC_F_AO ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_KGGD_TO_KNND.f90 b/Source/LK2/REDUCE_KGGD_TO_KNND.f90 index a0b389e2..87932909 100644 --- a/Source/LK2/REDUCE_KGGD_TO_KNND.f90 +++ b/Source/LK2/REDUCE_KGGD_TO_KNND.f90 @@ -29,12 +29,11 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) ! Call routines to reduce the KGGD differential stiffness matrix from the G-set to the N, M-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, LINK2A, L2A, L2ASTAT, L2A_MSG, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, LINK2A, L2A, L2ASTAT, L2A_MSG, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NTERM_HMN, NTERM_KGGD, NTERM_KNND, & NTERM_KNMD, NTERM_KMMD, NTERM_GMN USE PARAMS, ONLY : EPSIL, SPARSTOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KGGD_TO_KNND_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_HMN, J_HMN, HMN, I_KGGD, J_KGGD, KGGD, I_KNND, J_KNND, KNND, I_KNMD, J_KNMD, KNMD, & I_KMMD, J_KMMD, KMMD, I_KMND, J_KMND, KMND, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt @@ -67,16 +66,11 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) INTEGER(LONG) :: NTERM_KMND ! Number of nonzeros in sparse matrix KMND (should = NTERM_KNMD) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KGGD_TO_KNND_BEGEND + INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Partition KNND from KGGD (This is KNND before reduction, or KNND(bar) ) @@ -414,12 +408,7 @@ SUBROUTINE REDUCE_KGGD_TO_KNND ( PART_VEC_G_NM ) CALL DEALLOCATE_SCR_MAT ( 'CCS1' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_KGG_TO_KNN.f90 b/Source/LK2/REDUCE_KGG_TO_KNN.f90 index 1f28aeff..880ef7dc 100644 --- a/Source/LK2/REDUCE_KGG_TO_KNN.f90 +++ b/Source/LK2/REDUCE_KGG_TO_KNN.f90 @@ -35,12 +35,11 @@ SUBROUTINE REDUCE_KGG_TO_KNN ( PART_VEC_G_NM ) ! MYSTRAN since that approx time does not have full matrix code. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2J, LINK2J, L2J_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NTERM_HMN, NTERM_KGG, NTERM_KNN, & NTERM_KNM, NTERM_KMM, NTERM_GMN USE PARAMS, ONLY : EPSIL, MATSPARS, SPARSTOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KGG_TO_KNN_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_HMN, J_HMN, HMN, I_KGG, J_KGG, KGG, I_KNN, J_KNN, KNN, I_KNM, J_KNM, KNM, & I_KMM, J_KMM, KMM,I_KMN, J_KMN, KMN, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt @@ -74,7 +73,7 @@ SUBROUTINE REDUCE_KGG_TO_KNN ( PART_VEC_G_NM ) INTEGER(LONG) :: NTERM_KMN ! Number of nonzeros in sparse matrix KMN (should = NTERM_KNM) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KGG_TO_KNN_BEGEND + REAL(DOUBLE) :: ALPHA = ONE ! Scalar multiplier for matrix REAL(DOUBLE) :: BETA = ONE ! Scalar multiplier for matrix @@ -82,12 +81,7 @@ SUBROUTINE REDUCE_KGG_TO_KNN ( PART_VEC_G_NM ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Partition KNN from KGG (This is KNN before reduction, or KNN(bar) ) @@ -502,12 +496,7 @@ SUBROUTINE REDUCE_KGG_TO_KNN ( PART_VEC_G_NM ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_KNND_TO_KFFD.f90 b/Source/LK2/REDUCE_KNND_TO_KFFD.f90 index 41dad7b7..bc04eb1b 100644 --- a/Source/LK2/REDUCE_KNND_TO_KFFD.f90 +++ b/Source/LK2/REDUCE_KNND_TO_KFFD.f90 @@ -29,11 +29,10 @@ SUBROUTINE REDUCE_KNND_TO_KFFD ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PAR ! Call routines to reduce the KNND differential stiffness matrix from the N-set to the F, S-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2B, LINK2B, L2B_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2B, LINK2B, L2B_MSG USE SCONTR, ONLY : FATAL_ERR, NDOFN, NDOFF, NDOFS, NDOFSE, NTERM_KNND, NTERM_KFFD, NTERM_KFSD, NTERM_KSSD, & NTERM_KFSDe, NTERM_KSSDe, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KNND_TO_KFFD_BEGEND USE SPARSE_MATRICES, ONLY : I_KNND, J_KNND, KNND, I_KFFD, J_KFFD, KFFD, I_KFSD, J_KFSD, KFSD, I_KFSDe, J_KFSDe, KFSDe,& I_KSFD, J_KSFD, KSFD, I_KSSD, J_KSSD, KSSD, I_KSSDe, J_KSSDe, KSSDe USE SPARSE_MATRICES, ONLY : SYM_KNND, SYM_KFFD, SYM_KFSD, SYM_KFSDe, SYM_KSSD, SYM_KSSD, SYM_KSSDe @@ -60,16 +59,11 @@ SUBROUTINE REDUCE_KNND_TO_KFFD ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PAR INTEGER(LONG) :: NTERM_KSFD ! Number of nonzeros in sparse matrix KSFD (should = NTERM_KFSD) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KNND_TO_KFFD_BEGEND + INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -192,12 +186,7 @@ SUBROUTINE REDUCE_KNND_TO_KFFD ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PAR ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_KNN_TO_KFF.f90 b/Source/LK2/REDUCE_KNN_TO_KFF.f90 index a2adca06..cb23fd72 100644 --- a/Source/LK2/REDUCE_KNN_TO_KFF.f90 +++ b/Source/LK2/REDUCE_KNN_TO_KFF.f90 @@ -30,11 +30,10 @@ SUBROUTINE REDUCE_KNN_TO_KFF ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PART_ ! Reference Manual for the derivation of the reduction equations. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2B, LINK2B, L2B_MSG, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2B, LINK2B, L2B_MSG, SC1 USE SCONTR, ONLY : FATAL_ERR, NDOFN, NDOFF, NDOFS, NDOFSE, NTERM_KNN, NTERM_KFF, NTERM_KFS, NTERM_KSS, & NTERM_KFSe, NTERM_KSSe, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_KNN_TO_KFF_BEGEND USE SPARSE_MATRICES, ONLY : I_KNN, J_KNN, KNN, I_KFF, J_KFF, KFF, I_KFS, J_KFS, KFS, I_KFSe, J_KFSe, KFSe, & I_KSF, J_KSF, KSF, I_KSS, J_KSS, KSS, I_KSSe, J_KSSe, KSSe USE SPARSE_MATRICES, ONLY : SYM_KNN, SYM_KFF, SYM_KFS, SYM_KFSe, SYM_KSS, SYM_KSS, SYM_KSSe @@ -62,16 +61,11 @@ SUBROUTINE REDUCE_KNN_TO_KFF ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PART_ INTEGER(LONG) :: NTERM_KSF ! Number of nonzeros in sparse matrix KSF (should = NTERM_KFS) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_KNN_TO_KFF_BEGEND + INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -193,12 +187,7 @@ SUBROUTINE REDUCE_KNN_TO_KFF ( PART_VEC_N_FS, PART_VEC_S_SzSe, PART_VEC_F, PART_ ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_MAA_TO_MLL.f90 b/Source/LK2/REDUCE_MAA_TO_MLL.f90 index 305ffd8e..9973418f 100644 --- a/Source/LK2/REDUCE_MAA_TO_MLL.f90 +++ b/Source/LK2/REDUCE_MAA_TO_MLL.f90 @@ -30,12 +30,11 @@ SUBROUTINE REDUCE_MAA_TO_MLL ( PART_VEC_A_LR ) ! Reference Manual for the derivation of the reduction equations. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2M, L2N, LINK2M, LINK2N, L2M_MSG, L2N_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2M, L2N, LINK2M, LINK2N, L2M_MSG, L2N_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFL, NDOFR, NTERM_MAA, NTERM_MLL, NTERM_MRL, NTERM_MRR, & SOL_NAME USE PARAMS, ONLY : EPSIL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_MAA_TO_MLL_BEGEND USE SPARSE_MATRICES, ONLY : I_MAA, J_MAA, MAA, I_MLL, J_MLL, MLL, I_MRL, J_MRL, MRL, I_MRR, J_MRR, MRR, & SYM_MAA, SYM_MLL, SYM_MRL, SYM_MRR USE SCRATCH_MATRICES @@ -52,14 +51,9 @@ SUBROUTINE REDUCE_MAA_TO_MLL ( PART_VEC_A_LR ) INTEGER(LONG) :: MRR_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_MAA_TO_MLL_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Partition MLL from MAA @@ -117,12 +111,7 @@ SUBROUTINE REDUCE_MAA_TO_MLL ( PART_VEC_A_LR ) CALL WRITE_MATRIX_1 ( LINK2N, L2N, 'Y', 'KEEP', L2N_MSG, 'MRR', NTERM_MRR, NDOFR, I_MRR, J_MRR, MRR ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_MFF_TO_MAA.f90 b/Source/LK2/REDUCE_MFF_TO_MAA.f90 index 21c0c759..c8eba434 100644 --- a/Source/LK2/REDUCE_MFF_TO_MAA.f90 +++ b/Source/LK2/REDUCE_MFF_TO_MAA.f90 @@ -35,12 +35,11 @@ SUBROUTINE REDUCE_MFF_TO_MAA ( PART_VEC_F_AO ) ! MYSTRAN since that approx time does not have full matrix code. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFF, NDOFA, NDOFO, NTERM_MFF, NTERM_MAA, NTERM_MAO, NTERM_MOO, & NTERM_GOA USE PARAMS, ONLY : EPSIL, MATSPARS, SPARSTOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_MFF_TO_MAA_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_MFF, J_MFF, MFF, I_MAA, J_MAA, MAA, I_MAO, J_MAO, MAO, I_MOO, J_MOO, MOO, & I_GOA, J_GOA, GOA, I_GOAt, J_GOAt, GOAt @@ -73,7 +72,7 @@ SUBROUTINE REDUCE_MFF_TO_MAA ( PART_VEC_F_AO ) INTEGER(LONG) :: NTERM_CRS3 ! Number of terms in matrix CRS3 INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_MFF_TO_MAA_BEGEND + REAL(DOUBLE) :: ALPHA = ONE ! Scalar multiplier for matrix REAL(DOUBLE) :: BETA = ONE ! Scalar multiplier for matrix @@ -81,12 +80,7 @@ SUBROUTINE REDUCE_MFF_TO_MAA ( PART_VEC_F_AO ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Partition MAA from MFF (This is MAA before reduction, or MAA(bar) ) @@ -435,12 +429,7 @@ SUBROUTINE REDUCE_MFF_TO_MAA ( PART_VEC_F_AO ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_MGG_TO_MNN.f90 b/Source/LK2/REDUCE_MGG_TO_MNN.f90 index f311c89a..eba4b7fd 100644 --- a/Source/LK2/REDUCE_MGG_TO_MNN.f90 +++ b/Source/LK2/REDUCE_MGG_TO_MNN.f90 @@ -35,12 +35,11 @@ SUBROUTINE REDUCE_MGG_TO_MNN ( PART_VEC_G_NM ) ! MYSTRAN since that approx time does not have full matrix code. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2R, LINK2R, L2R_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2R, LINK2R, L2R_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NTERM_MGG, NTERM_MNN, NTERM_MNM, NTERM_MMM, & NTERM_GMN, NTERM_LMN USE PARAMS, ONLY : EPSIL, MATSPARS, SPARSTOR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_MGG_TO_MNN_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_LMN, J_LMN, LMN, I_MGG, J_MGG, MGG, I_MNN, J_MNN, MNN, I_MNM , J_MNM , MNM , & I_MMN, J_MMN, MMN, I_MMM, J_MMM, MMM, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt @@ -74,7 +73,7 @@ SUBROUTINE REDUCE_MGG_TO_MNN ( PART_VEC_G_NM ) INTEGER(LONG) :: NTERM_MMN ! Number of nonzeros in sparse matrix MMN (should = NTERM_MNM) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_MGG_TO_MNN_BEGEND + REAL(DOUBLE) :: ALPHA = ONE ! Scalar multiplier for matrix REAL(DOUBLE) :: BETA = ONE ! Scalar multiplier for matrix @@ -82,12 +81,7 @@ SUBROUTINE REDUCE_MGG_TO_MNN ( PART_VEC_G_NM ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Partition MNN from MGG (This is MNN before reduction, or MNN(bar) ) @@ -512,12 +506,7 @@ SUBROUTINE REDUCE_MGG_TO_MNN ( PART_VEC_G_NM ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_MNN_TO_MFF.f90 b/Source/LK2/REDUCE_MNN_TO_MFF.f90 index 5e3e3dda..d34e141e 100644 --- a/Source/LK2/REDUCE_MNN_TO_MFF.f90 +++ b/Source/LK2/REDUCE_MNN_TO_MFF.f90 @@ -30,10 +30,9 @@ SUBROUTINE REDUCE_MNN_TO_MFF ( PART_VEC_N_FS ) ! for the derivation of the reduction equations. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, L2S, LINK2S, L2S_MSG + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, L2S, LINK2S, L2S_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFN, NDOFF, NDOFS, NTERM_MNN, NTERM_MFF, NTERM_MFS, NTERM_MSS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_MNN_TO_MFF_BEGEND USE SPARSE_MATRICES, ONLY : I_MNN, J_MNN, MNN, I_MFF, J_MFF, MFF, I_MFS, J_MFS, MFS, I_MSF, J_MSF, MSF, & I_MSS, J_MSS, MSS USE SPARSE_MATRICES, ONLY : SYM_MNN, SYM_MFF, SYM_MFS, SYM_MSS @@ -55,16 +54,11 @@ SUBROUTINE REDUCE_MNN_TO_MFF ( PART_VEC_N_FS ) INTEGER(LONG), PARAMETER :: NUM1 = 1 ! Used in subr's that partition matrices INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices INTEGER(LONG) :: NTERM_MSF ! Number of nonzeros in sparse matrix MSF (should = NTERM_MFS) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_MNN_TO_MFF_BEGEND + INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Partition MFF from MNN. This is final MFF. @@ -155,12 +149,7 @@ SUBROUTINE REDUCE_MNN_TO_MFF ( PART_VEC_N_FS ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_N_FS.f90 b/Source/LK2/REDUCE_N_FS.f90 index 09f21a2e..f4aba485 100644 --- a/Source/LK2/REDUCE_N_FS.f90 +++ b/Source/LK2/REDUCE_N_FS.f90 @@ -29,7 +29,7 @@ SUBROUTINE REDUCE_N_FS ! Call routines to reduce stiffness, mass, loads from N-set to F, S-sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L1H, LINK1H, L1H_MSG, L2C, LINK2C, L2C_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L1H, LINK1H, L1H_MSG, L2C, LINK2C, L2C_MSG, SC1, WRT_ERR USE SCONTR, ONLY : LINKNO , NDOFF, NDOFG, NDOFN, NDOFS, NDOFSE, NSUB, & NTERM_KNN , NTERM_KFF , NTERM_KFS , NTERM_KSS , NTERM_KSSe , & NTERM_KNND, NTERM_KFFD, NTERM_KFSD, NTERM_KSSD, NTERM_KSSDe, & @@ -41,7 +41,6 @@ SUBROUTINE REDUCE_N_FS USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_NSET, RBGLOBAL_FSET USE PARAMS, ONLY : EQCHK_OUTPUT, MATSPARS, PRTSTIFD, PRTSTIFF, PRTMASS, PRTFOR USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_N_FS_BEGEND USE SPARSE_MATRICES, ONLY : I_KNN , J_KNN , KNN , I_KFF , J_KFF , KFF , I_KFS , J_KFS , KFS , & I_KSS , J_KSS , KSS , I_KSSe , J_KSSe , KSSe , & I_KNND , J_KNND , KNND , I_KFFD , J_KFFD , KFFD , I_KFSD , J_KFSD , KFSD , & @@ -83,7 +82,7 @@ SUBROUTINE REDUCE_N_FS INTEGER(LONG) :: PART_VEC_S_SzSe(NDOFS)! Partitioning vector (S set into SZ and SE sets) INTEGER(LONG) :: PART_VEC_SUB(NSUB) ! Partitioning vector (1's for all subcases) INTEGER(LONG) :: REC_NO ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_N_FS_BEGEND + REAL(DOUBLE) :: KFF_DIAG(NDOFF) ! Diagonal terms from KFF REAL(DOUBLE) :: KFF_MAX_DIAG ! Max diag term from KFF @@ -93,12 +92,7 @@ SUBROUTINE REDUCE_N_FS OUNT(1) = ERR OUNT(2) = F06 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Set partitioning vectors @@ -124,7 +118,7 @@ SUBROUTINE REDUCE_N_FS CALL ALLOCATE_COL_VEC ( 'YSe', NDOFSE, SUBR_NAME ) IF (NDOFSE > 0) THEN - CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'OLD', L1H_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'OLD', L1H_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) IERROR = 0 DO I=1,NDOFSE @@ -132,7 +126,7 @@ SUBROUTINE REDUCE_N_FS IF (IOCHK /= 0) THEN IERROR = IERROR + 1 REC_NO = I - CALL READERR ( IOCHK, LINK1H, L1H_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1H, L1H_MSG, REC_NO, OUNT ) ENDIF ENDDO IF (IERROR /= 0) THEN @@ -141,7 +135,7 @@ SUBROUTINE REDUCE_N_FS CALL OUTA_HERE ( 'Y' ) ! Quit due to read errors in YSe array file ENDIF - CALL FILE_CLOSE ( L1H, LINK1H, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1H, LINK1H, 'KEEP' ) IF (DEBUG(26) == 1) THEN CALL WRITE_VECTOR ( 'SE-SET YS ENFORCED DISPLS','DISPL', NDOFSE, YSe ) @@ -527,12 +521,7 @@ SUBROUTINE REDUCE_N_FS ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_PA_TO_PL.f90 b/Source/LK2/REDUCE_PA_TO_PL.f90 index a042f8be..0481a14f 100644 --- a/Source/LK2/REDUCE_PA_TO_PL.f90 +++ b/Source/LK2/REDUCE_PA_TO_PL.f90 @@ -30,10 +30,9 @@ SUBROUTINE REDUCE_PA_TO_PL ( PART_VEC_A_LR, PART_VEC_SUB ) ! Reference Manual for the derivation of the reduction equations. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFL, NDOFR, NSUB, NTERM_GOA, NTERM_PA, NTERM_PL, NTERM_PR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_PA_TO_PL_BEGEND USE CONSTANTS_1, ONLY : ONE USE SPARSE_MATRICES, ONLY : I_PA, J_PA, PA, I_PL, J_PL, PL, I_PR, J_PR, PR, I_GOA, J_GOA, GOA, I_GOAt, J_GOAt, GOAt USE SPARSE_MATRICES, ONLY : SYM_PA, SYM_PL, SYM_PR @@ -50,14 +49,9 @@ SUBROUTINE REDUCE_PA_TO_PL ( PART_VEC_A_LR, PART_VEC_SUB ) INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices INTEGER(LONG) :: PL_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG) :: PR_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_PA_TO_PL_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Partition PL from PA @@ -92,12 +86,7 @@ SUBROUTINE REDUCE_PA_TO_PL ( PART_VEC_A_LR, PART_VEC_SUB ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_PF_TO_PA.f90 b/Source/LK2/REDUCE_PF_TO_PA.f90 index 0804b9f7..779c0a3c 100644 --- a/Source/LK2/REDUCE_PF_TO_PA.f90 +++ b/Source/LK2/REDUCE_PF_TO_PA.f90 @@ -35,11 +35,10 @@ SUBROUTINE REDUCE_PF_TO_PA ( PART_VEC_F_AO, PART_VEC_SUB ) ! MYSTRAN since that approx time does not have full matrix code. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KOO_SDIA, NDOFF, NDOFA, NDOFO, NSUB, NTERM_GOA, NTERM_PF, & NTERM_PA, NTERM_PO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_PF_TO_PA_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : EPSIL, MATSPARS USE SPARSE_MATRICES, ONLY : I_PF, J_PF, PF, I_PA, J_PA, PA, I_PO, J_PO, PO, I_GOA, J_GOA, GOA, I_GOAt, J_GOAt, GOAt @@ -65,7 +64,7 @@ SUBROUTINE REDUCE_PF_TO_PA ( PART_VEC_F_AO, PART_VEC_SUB ) INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices INTEGER(LONG) :: PA_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG) :: PO_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_PF_TO_PA_BEGEND + REAL(DOUBLE) :: ALPHA = ONE ! Scalar multiplier for matrix REAL(DOUBLE) :: BETA = ONE ! Scalar multiplier for matrix @@ -73,12 +72,7 @@ SUBROUTINE REDUCE_PF_TO_PA ( PART_VEC_F_AO, PART_VEC_SUB ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -248,12 +242,7 @@ SUBROUTINE REDUCE_PF_TO_PA ( PART_VEC_F_AO, PART_VEC_SUB ) CALL SOLVE_UO0 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_PG_TO_PN.f90 b/Source/LK2/REDUCE_PG_TO_PN.f90 index 3fe30ec6..70571a23 100644 --- a/Source/LK2/REDUCE_PG_TO_PN.f90 +++ b/Source/LK2/REDUCE_PG_TO_PN.f90 @@ -35,10 +35,9 @@ SUBROUTINE REDUCE_PG_TO_PN ( PART_VEC_G_NM, PART_VEC_SUB ) ! MYSTRAN since that approx time does not have full matrix code. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFN, NDOFM, NSUB, NTERM_GMN, NTERM_PG, NTERM_PN, NTERM_PM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_PG_TO_PN_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : EPSIL, MATSPARS USE SPARSE_MATRICES, ONLY : I_PG, J_PG, PG, I_PN, J_PN, PN, I_PM, J_PM, PM, I_GMN, J_GMN, GMN, I_GMNt, J_GMNt, GMNt @@ -64,7 +63,7 @@ SUBROUTINE REDUCE_PG_TO_PN ( PART_VEC_G_NM, PART_VEC_SUB ) INTEGER(LONG), PARAMETER :: NUM2 = 2 ! Used in subr's that partition matrices INTEGER(LONG) :: PN_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG) :: PM_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_PG_TO_PN_BEGEND + REAL(DOUBLE) :: ALPHA = ONE ! Scalar multiplier for matrix REAL(DOUBLE) :: BETA = ONE ! Scalar multiplier for matrix @@ -72,12 +71,7 @@ SUBROUTINE REDUCE_PG_TO_PN ( PART_VEC_G_NM, PART_VEC_SUB ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -248,12 +242,7 @@ SUBROUTINE REDUCE_PG_TO_PN ( PART_VEC_G_NM, PART_VEC_SUB ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/REDUCE_PN_TO_PF.f90 b/Source/LK2/REDUCE_PN_TO_PF.f90 index bbae07ff..7f28e715 100644 --- a/Source/LK2/REDUCE_PN_TO_PF.f90 +++ b/Source/LK2/REDUCE_PN_TO_PF.f90 @@ -30,11 +30,10 @@ SUBROUTINE REDUCE_PN_TO_PF ( PART_VEC_N_FS, PART_VEC_SUB ) ! Reference Manual for the derivation of the reduction equations. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, L2D, LINK2D, L2D_MSG, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L2D, LINK2D, L2D_MSG, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFN, NDOFF, NDOFS, NDOFSE, NSUB, NTERM_KFSe, NTERM_PN, & NTERM_PF, NTERM_PFYS, NTERM_PS USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : REDUCE_PN_TO_PF_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : MATSPARS USE SPARSE_MATRICES, ONLY : I_KFSe, J_KFSe, KFSe, I_PN, J_PN, PN, I_PF, J_PF, PF, I_PS, J_PS, PS, I_PF_TMP, J_PF_TMP, & @@ -69,19 +68,14 @@ SUBROUTINE REDUCE_PN_TO_PF ( PART_VEC_N_FS, PART_VEC_SUB ) INTEGER(LONG) :: NTERM_PFYS1 = 0 ! No. of terms in matrix PFYS1 INTEGER(LONG) :: PF_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG) :: PS_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = REDUCE_PN_TO_PF_BEGEND + REAL(DOUBLE) :: ALPHA ! Scalar multiplier for matrix REAL(DOUBLE) :: BETA ! Scalar multiplier for matrix INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Partition PF from PN (This is PF before reduction, or PF(bar) ) @@ -330,12 +324,7 @@ SUBROUTINE REDUCE_PN_TO_PF ( PART_VEC_N_FS, PART_VEC_SUB ) CALL WRITE_MATRIX_1 ( LINK2D, L2D, CLOSE_IT, CLOSE_STAT, L2D_MSG, 'PS ', NTERM_PS , NDOFS, I_PS , J_PS , PS ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/SOLVE_GMN.f90 b/Source/LK2/SOLVE_GMN.f90 index 9c5971b3..8a7ee6e1 100644 --- a/Source/LK2/SOLVE_GMN.f90 +++ b/Source/LK2/SOLVE_GMN.f90 @@ -31,12 +31,11 @@ SUBROUTINE SOLVE_GMN ( PART_VEC_G_NM, PART_VEC_M ) ! are called to do the decomp of RMM and the forward-backward substitution (FBS) to obtain GMN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SCR, L2A, LINK2A, L2A_MSG, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SCR, L2A, LINK2A, L2A_MSG, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NDOFM, NTERM_RMG, NTERM_RMN, NTERM_RMM, NTERM_GMN USE PARAMS, ONLY : EPSIL, PRTRMG, PRTGMN, SOLLIB, SPARSE_FLAVOR, SUPINFO USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_GMN_BEGEND USE SPARSE_MATRICES, ONLY : I_RMG, J_RMG, RMG, I_RMN, J_RMN, RMN, I_RMM, J_RMM, RMM, I_GMN, J_GMN, GMN USE SPARSE_MATRICES, ONLY : SYM_RMG, SYM_RMN, SYM_RMM USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -60,18 +59,13 @@ SUBROUTINE SOLVE_GMN ( PART_VEC_G_NM, PART_VEC_M ) INTEGER(LONG) :: RMN_ROW_I_NTERMS ! No. terms in row I of matrix RMN INTEGER(LONG) :: RMN_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) INTEGER(LONG) :: RMM_ROW_MAX_TERMS ! Output from subr PARTITION_SIZE (max terms in any row of matrix) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_GMN_BEGEND + 1 + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -234,12 +228,7 @@ SUBROUTINE SOLVE_GMN ( PART_VEC_G_NM, PART_VEC_M ) CALL DEALLOCATE_L2_GMN_2 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -279,11 +268,10 @@ SUBROUTINE SOLVE_GMN_SOLVER USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFG, NDOFM, NDOFN, NTERM_GMN, NTERM_RMM, NTERM_RMN, BLNK_SUB_NAM USE PARAMS, ONLY : EPSIL, SOLLIB, SPARSE_FLAVOR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_GMN_BEGEND USE SPARSE_MATRICES, ONLY : I_RMN, J_RMN, RMN, I_RMM, J_RMM, RMM, I2_GMN, I_GMN, J_GMN, GMN USE SCRATCH_MATRICES, ONLY : I_CCS1, J_CCS1, CCS1 USE FULL_MATRICES, ONLY : RMM_FULL @@ -316,7 +304,7 @@ SUBROUTINE SOLVE_GMN_SOLVER INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening a file INTEGER(LONG) :: NRHS ! No. of RHS's in solving (RMM)*(GMN) = -RMN INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_GMN_BEGEND + 1 + REAL(DOUBLE) :: BETA ! Multiple for rhs for use in subr FBS REAL(DOUBLE) :: DUM_COL(NDOFM) ! Temp variable used in SuperLU @@ -326,12 +314,7 @@ SUBROUTINE SOLVE_GMN_SOLVER INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -413,8 +396,8 @@ SUBROUTINE SOLVE_GMN_SOLVER SCRFIL(1:9) = 'SCRATCH-991' OPEN (SCR(1),STATUS='SCRATCH',FORM='UNFORMATTED',ACTION='READWRITE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SCRFIL, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL OPNERR ( IOCHK, SCRFIL, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Can't open scratch file, so quit ENDIF REWIND (SCR(1)) @@ -562,14 +545,9 @@ SUBROUTINE SOLVE_GMN_SOLVER CALL READ_MATRIX_1 ( SCRFIL, SCR(1), OPND, CLOSE_IT, CLOSE_STAT, MESSAG, 'GMN', NTERM_GMN, READ_NTERM, NDOFM, & I_GMN, J_GMN, GMN) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/LK2/SOLVE_GOA.f90 b/Source/LK2/SOLVE_GOA.f90 index 26cfb0b7..13441ff4 100644 --- a/Source/LK2/SOLVE_GOA.f90 +++ b/Source/LK2/SOLVE_GOA.f90 @@ -31,12 +31,11 @@ SUBROUTINE SOLVE_GOA ! load matrices from the F-set to the A, O_sets USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_LOG, ERR, F04, F06, SCR + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, ERR, F06, SCR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KOO_SDIA, NDOFA, NDOFO, NTERM_GOA, NTERM_KOO, & NTERM_KAO USE PARAMS, ONLY : EPSIL, PRTGOA USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_GOA_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : SOLLIB, SPARSE_FLAVOR USE SPARSE_MATRICES, ONLY : I2_GOA, I_GOA, J_GOA, GOA, I_KOO, J_KOO, KOO, I_KAO, J_KAO, KAO @@ -64,7 +63,7 @@ SUBROUTINE SOLVE_GOA INTEGER(LONG) :: INFO ! Info on success of factorization or solve INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening a file INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_GOA_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero REAL(DOUBLE) :: GOA_COL(NDOFO) ! A column of GOA solved for herein @@ -74,12 +73,7 @@ SUBROUTINE SOLVE_GOA INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the screen and output file @@ -112,8 +106,8 @@ SUBROUTINE SOLVE_GOA SCRFIL(1:9) = 'SCRATCH-991' OPEN (SCR(1),STATUS='SCRATCH',FORM='UNFORMATTED',ACTION='READWRITE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SCRFIL, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL OPNERR ( IOCHK, SCRFIL, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Can't open scratch file, so quit ENDIF @@ -226,7 +220,7 @@ SUBROUTINE SOLVE_GOA CALL READ_MATRIX_1 ( SCRFIL, SCR(1), OPND, CLOSE_IT, CLOSE_STAT, MESSAG, 'GOA', NTERM_GOA, READ_NTERM, NDOFO, & I_GOA, J_GOA, GOA) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) ! Print out constraint matrix GOA, if requested @@ -236,12 +230,7 @@ SUBROUTINE SOLVE_GOA ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK2/SOLVE_UO0.f90 b/Source/LK2/SOLVE_UO0.f90 index 9e068314..f12eaf10 100644 --- a/Source/LK2/SOLVE_UO0.f90 +++ b/Source/LK2/SOLVE_UO0.f90 @@ -29,10 +29,9 @@ SUBROUTINE SOLVE_UO0 ! Solves KOO*UO0 = PO for matrix UO0 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L2F, LINK2F, L2F_MSG + USE IOUNT1, ONLY : ERR, F06, L2F, LINK2F, L2F_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KOO_SDIA, NDOFO, NSUB, NTERM_KOO, NTERM_PO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_UO0_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : PRTUO0, SOLLIB, SPARSE_FLAVOR USE SPARSE_MATRICES, ONLY : I_PO, J_PO, PO, I_KOO, J_KOO, KOO @@ -53,18 +52,13 @@ SUBROUTINE SOLVE_UO0 INTEGER(LONG) :: I,J ! DO loop indices or counters INTEGER(LONG) :: INFO ! Info on success of SuperLU solve INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_UO0_BEGEND + REAL(DOUBLE) :: NULL_SCALE_FACS(NDOFO) ! LAPACK_S values not used so null this vector REAL(DOUBLE) :: INOUT_COL(NDOFO) ! Temp variable for one col of load matrix PO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make units for writing errors the screen and output file @@ -86,7 +80,7 @@ SUBROUTINE SOLVE_UO0 ! Open file for writing UO0 ! Write GOA matrix to file L2F - CALL FILE_OPEN ( L2F, LINK2F, OUNT, 'REPLACE', L2F_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L2F, LINK2F, OUNT, 'REPLACE', L2F_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ! ********************************************************************************************************************************** ! Solve for UO0 by looping on columns of PO ("loads") to get columns of UO0 ("displs") @@ -168,14 +162,9 @@ SUBROUTINE SOLVE_UO0 CALL DEALLOCATE_COL_VEC ( 'UO0_COL' ) - CALL FILE_CLOSE ( L2F, LINK2F, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L2F, LINK2F, 'KEEP' ) + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/LK2/STIFF_MAT_EQUIL_CHK.f90 b/Source/LK2/STIFF_MAT_EQUIL_CHK.f90 index cdeecba1..bab61975 100644 --- a/Source/LK2/STIFF_MAT_EQUIL_CHK.f90 +++ b/Source/LK2/STIFF_MAT_EQUIL_CHK.f90 @@ -32,7 +32,7 @@ SUBROUTINE STIFF_MAT_EQUIL_CHK ( OUTPUT, X_SET, SYM_KIN, NROWS, NTERM_KIN, I_KIN ! example would be the case if it were grounded - e.g. a cantilevered beam has rigid body modes restrained) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NSPOINT, WARN_ERR USE TIMDAT, ONLY : TSEC @@ -42,7 +42,6 @@ SUBROUTINE STIFF_MAT_EQUIL_CHK ( OUTPUT, X_SET, SYM_KIN, NROWS, NTERM_KIN, I_KIN USE LAPACK_DPB_MATRICES, ONLY : ABAND USE LAPACK_BLAS_AUX USE PARAMS, ONLY : EPSIL, EQCHK_NORM, SUPWARN, SUPINFO - USE SUBR_BEGEND_LEVELS, ONLY : STIFF_MAT_EQUIL_CHK_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE STIFF_MAT_EQUIL_CHK_USE_IFs @@ -67,7 +66,7 @@ SUBROUTINE STIFF_MAT_EQUIL_CHK ( OUTPUT, X_SET, SYM_KIN, NROWS, NTERM_KIN, I_KIN INTEGER(LONG) :: KIN_SDIA ! No. of superdiags in KIN upper triangle INTEGER(LONG) :: ROW,COL ! Row/col where max term in RB_STRAIN_ENERGY exists INTEGER(LONG) :: SA_SET_COL ! Col no. in array TDOF where the SA-set is (from subr TDOF_COL_NUM) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STIFF_MAT_EQUIL_CHK_BEGEND + CHARACTER( 1*BYTE) :: FLAG(NROWS) ! Character to designate whether PRBN was normalized to diag KIN or not @@ -86,12 +85,7 @@ SUBROUTINE STIFF_MAT_EQUIL_CHK ( OUTPUT, X_SET, SYM_KIN, NROWS, NTERM_KIN, I_KIN INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! If NSPOINT > 0 MYSTRAN code, as of 05/05/07, will not accomodate equil check on models with any SPOINT's @@ -252,12 +246,7 @@ SUBROUTINE STIFF_MAT_EQUIL_CHK ( OUTPUT, X_SET, SYM_KIN, NROWS, NTERM_KIN, I_KIN ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -302,7 +291,7 @@ SUBROUTINE WRITE_RB_MATS ( WHAT ) ! Write rigid body matrices (RB displ, forces due to RB disp) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : NDOFG USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TDOFI diff --git a/Source/LK3/EPSCALC.f90 b/Source/LK3/EPSCALC.f90 index 3de7e9fb..a37cd3c7 100644 --- a/Source/LK3/EPSCALC.f90 +++ b/Source/LK3/EPSCALC.f90 @@ -31,10 +31,9 @@ SUBROUTINE EPSCALC ( ISUB ) ! EPSILON = UL(t)*[ PL - KLL*UL ]/[ UL(t)*PL ], UL: displ's, PL: loads, KLL: stiff matrix for the L-set USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFL, NTERM_KLl, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : EPSCALC_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : EPSIL, SUPINFO, SUPWARN USE MACHINE_PARAMS, ONLY : MACH_SFMIN @@ -51,7 +50,7 @@ SUBROUTINE EPSCALC ( ISUB ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'EPSCALC' INTEGER(LONG), INTENT(IN) :: ISUB ! Internal subcase no. (1 to NSUB) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EPSCALC_BEGEND + REAL(DOUBLE) , PARAMETER :: ALPHA = ONE ! Scalar multiplier for KLL in calc'ing residual vector, RES REAL(DOUBLE) , PARAMETER :: BETA = -ONE ! Scalar multiplier for PL in calc'ing residual vector, RES @@ -62,12 +61,7 @@ SUBROUTINE EPSCALC ( ISUB ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Calculate residual vector. First, multiply KLL x UL_COL and then add -PL_COL: @@ -95,12 +89,7 @@ SUBROUTINE EPSCALC ( ISUB ) WRITE(F06,3702) ISUB, DEN, MACH_SFMIN ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK3/LINK3.f90 b/Source/LK3/LINK3.f90 index fb8702e9..7a3ba8e1 100644 --- a/Source/LK3/LINK3.f90 +++ b/Source/LK3/LINK3.f90 @@ -35,10 +35,9 @@ SUBROUTINE LINK3 ! memory than sparse storage for large stiffness matrices. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06, L3A, SC1, LINK3A, L3A_MSG + USE IOUNT1, ONLY : WRT_BUG, ERR, F06, L3A, SC1, LINK3A, L3A_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, KLL_SDIA, LINKNO, MBUG, NDOFL, NSUB, & NTERM_KLL, NTERM_PL, RESTART, SOL_NAME, WARN_ERR - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, TEN USE PARAMS, ONLY : CRS_CCS, EPSERR, EPSIL, KLLRAT, RELINK3, RCONDK, SOLLIB, SUPWARN, SPARSE_FLAVOR USE SPARSE_MATRICES, ONLY : I_KLL, J_KLL, KLL, I_PL, J_PL, PL @@ -55,6 +54,7 @@ SUBROUTINE LINK3 ! which is "USE'd" above ! USE LINK3_USE_IFs + USE LINK_MESSAGE_Interface IMPLICIT NONE @@ -63,7 +63,6 @@ SUBROUTINE LINK3 CHARACTER( 2*BYTE) :: L_SET = 'L ' ! L-set designator CHARACTER( 1*BYTE) :: EQUED ! 'Y' if the stiff matrix was equilibrated in subr EQUILIBRATE CHARACTER( 1*BYTE) :: NULL_COL ! 'Y' if a col of KAO(transpose) is null - CHARACTER( 54*BYTE) :: MODNAM ! Name to write to screen INTEGER(LONG) :: DEB_PRT(2) ! Debug numbers to say whether to write ABAND and/or its decomp to output ! file in called subr SYM_MAT_DECOMP_LAPACK (ABAND = band form of KLL) @@ -127,14 +126,11 @@ SUBROUTINE LINK3 ! Write info to text files WRITE(F06,150) LINKNO - IF (WRT_LOG > 0) THEN - WRITE(F04,150) LINKNO - ENDIF WRITE(ERR,150) LINKNO ! Read LINK1A file - CALL READ_L1A ( 'KEEP', 'Y' ) + CALL READ_L1A ( 'KEEP' ) ! Check COMM for successful completion of prior LINKs @@ -218,7 +214,7 @@ SUBROUTINE LINK3 ! Open file for writing displs to. - CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'REPLACE', L3A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'REPLACE', L3A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ! Loop on subcases @@ -230,9 +226,8 @@ SUBROUTINE LINK3 CALL ALLOCATE_COL_VEC ( 'UL_COL', NDOFL, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'PL_COL', NDOFL, SUBR_NAME ) - CALL OURTIM ! Get the loads for this subcase from I_PL, J_PL, PL and put into PL_COL - MODNAM = 'GET COL OF PL LOADS FOR Subcase' - WRITE(SC1,3093) LINKNO,MODNAM,ISUB,HOUR,MINUTE,SEC,SFRAC + ! Get the loads for this subcase from I_PL, J_PL, PL and put into PL_COL + CALL LINK_MESSAGE_I('GET COL OF PL LOADS FOR Subcase', ISUB) DO J=1,NDOFL PL_COL(J) = ZERO DUM_COL(J) = ZERO @@ -248,9 +243,8 @@ SUBROUTINE LINK3 WRITE(F06,*) ENDIF - CALL OURTIM ! Call FBS to solve for displacements for this subcase - MODNAM = 'FBS - SOLVE FOR RHS ANSWERS FOR "' - WRITE(SC1,3093) LINKNO,MODNAM,ISUB,HOUR,MINUTE,SEC,SFRAC + ! Call FBS to solve for displacements for this subcase + CALL LINK_MESSAGE_I('FBS - SOLVE FOR RHS ANSWERS FOR "', ISUB) !xx WRITE(SC1, * ) ! Advance 1 line for screen messages IF (SOLLIB == 'BANDED ') THEN @@ -293,17 +287,13 @@ SUBROUTINE LINK3 ENDIF IF (EPSERR == 'Y') THEN ! Calculate residual vector, R. Use RES to calculate EPSILON - CALL OURTIM - MODNAM = 'CALC EPSILON ERROR ESTIMATE "' - WRITE(SC1,3093) LINKNO,MODNAM,ISUB,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('CALC EPSILON ERROR ESTIMATE "', ISUB) CALL EPSCALC ( ISUB ) ENDIF ! Calculate the LAPACK error bounds IF ((RCONDK == 'Y') .AND. (SOLLIB == 'BANDED')) THEN IF (DABS(RCOND) > MACH_SFMIN) THEN - CALL OURTIM - MODNAM = 'CALC LAPACK ERROR ESTIMATE "' - WRITE(SC1,3093) LINKNO,MODNAM,ISUB,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('CALC LAPACK ERROR ESTIMATE "', ISUB) CALL VECINORM ( UL_COL, NDOFL, UL_INORM ) CALL VECINORM ( PL_COL, NDOFL, PL_INORM ) CALL VECINORM ( RES , NDOFL, RES_INORM ) @@ -357,9 +347,7 @@ SUBROUTINE LINK3 ! Dellocate arrays - CALL OURTIM - MODNAM = 'DEALLOCATE ARRAYS' - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('DEALLOCATE ARRAYS') !xx WRITE(SC1, * ) ! Advance 1 line for screen messages IF (SOL_NAME(1:8) == 'BUCKLING') THEN @@ -377,7 +365,7 @@ SUBROUTINE LINK3 !xx WRITE(SC1,12345,ADVANCE='NO') ' Deallocate PL_COL', CR13 ; CALL DEALLOCATE_COL_VEC ( 'PL_COL' ) !xx WRITE(SC1,12345,ADVANCE='NO') ' Deallocate PL ', CR13 ; CALL DEALLOCATE_SPARSE_MAT ( 'PL' ) - CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP' ) ! Process is now complete so set COMM(LINKNO) @@ -385,7 +373,7 @@ SUBROUTINE LINK3 ! Write data to L1A - CALL WRITE_L1A ( 'KEEP', 'Y', 'Y' ) + CALL WRITE_L1A ( 'KEEP', 'Y' ) ! Check allocation status of allocatable arrays, if requested @@ -396,12 +384,9 @@ SUBROUTINE LINK3 ENDIF ENDIF -! Write LINK3 end to F04, F06 +! Write LINK3 end to F06 CALL OURTIM - IF (WRT_LOG > 0) THEN - WRITE(F04,151) LINKNO - ENDIF WRITE(F06,151) LINKNO ! Close files @@ -460,10 +445,6 @@ SUBROUTINE LINK3 3026 FORMAT(' *INFORMATION: CANNOT CALCULATE OMEGAI. DEN = 0',/) - 3092 FORMAT(1X,I2,'/',A54,8X,2X,I2,':',I2,':',I2,'.',I3) - - 3093 FORMAT(1X,I2,'/',A54,I8,2X,I2,':',I2,':',I2,'.',I3) - 9991 FORMAT(' *ERROR 9991: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,A, ' = ',A,' NOT PROGRAMMED ',A) diff --git a/Source/LK3/VECINORM.f90 b/Source/LK3/VECINORM.f90 index 669517e5..098c4048 100644 --- a/Source/LK3/VECINORM.f90 +++ b/Source/LK3/VECINORM.f90 @@ -30,10 +30,9 @@ SUBROUTINE VECINORM ( X, N, X_INORM ) ! of the numerically largest term in the vector. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : VECINORM_BEGEND USE CONSTANTS_1, ONLY : ZERO USE VECINORM_USE_IFs @@ -44,19 +43,14 @@ SUBROUTINE VECINORM ( X, N, X_INORM ) INTEGER(LONG), INTENT(IN) :: N ! Dimension of the input vector X INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = VECINORM_BEGEND + REAL(DOUBLE), INTENT(IN) :: X(N) ! The input vector for which the infinity norm is calc'd REAL(DOUBLE), INTENT(OUT) :: X_INORM ! The calc'd infinity norm of X INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Calculate infinity norm of a vector @@ -68,12 +62,7 @@ SUBROUTINE VECINORM ( X, N, X_INORM ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK4/CALC_GEN_MASS.f90 b/Source/LK4/CALC_GEN_MASS.f90 index 2ddaa786..99c4e774 100644 --- a/Source/LK4/CALC_GEN_MASS.f90 +++ b/Source/LK4/CALC_GEN_MASS.f90 @@ -40,13 +40,12 @@ SUBROUTINE CALC_GEN_MASS USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFL, NTERM_KLLDn, NTERM_MLLn, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : CALC_GEN_MASS_BEGEND USE EIGEN_MATRICES_1, ONLY : GEN_MASS, EIGEN_VEC USE MODEL_STUF, ONLY : EIG_CRIT, MAXMIJ, MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT USE SPARSE_MATRICES, ONLY : I_KLLDn, J_KLLDn, KLLDn, I_MLLn, J_MLLn, MLLn @@ -60,7 +59,7 @@ SUBROUTINE CALC_GEN_MASS CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'CALC_GEN_MASS' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_GEN_MASS_BEGEND + INTEGER(LONG) :: I,J,K ! DO loop indices REAL(DOUBLE) :: DMIJ ! DABS of MIJ @@ -72,12 +71,7 @@ SUBROUTINE CALC_GEN_MASS INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -140,12 +134,7 @@ SUBROUTINE CALC_GEN_MASS CALL COUNTER_PROGRESS(I) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK4/DSBAND_PREFAC.f b/Source/LK4/DSBAND_PREFAC.f index a5b02724..14153c2c 100644 --- a/Source/LK4/DSBAND_PREFAC.f +++ b/Source/LK4/DSBAND_PREFAC.f @@ -41,13 +41,12 @@ subroutine dsband_prefac( rvec, howmny, select, d, z, ldz, sigma, & lworkl, iwork, info, info_lapack, dtbsv_msg, piters) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, SOL_NAME, & NTERM_KLLDn, NTERM_MLLn, & NTERM_KMSMn, NTERM_ALL USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : EIG_MSGLVL, EIG_LAP_MAT_TYPE - USE SUBR_BEGEND_LEVELS, ONLY : ARPACK_BEGEND USE SuperLU_STUF, ONLY : SLU_FACTORS, SLU_INFO USE PARAMS, ONLY : SOLLIB USE SPARSE_MATRICES, ONLY : I_KLLDn, J_KLLDn, KLLDn, @@ -67,7 +66,6 @@ subroutine dsband_prefac( rvec, howmny, select, d, z, ldz, sigma, CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DSBAND_PREFAC' - INTEGER(LONG) :: SUBR_BEGEND = ARPACK_BEGEND c c %------------------% c | Scalar Arguments | @@ -126,12 +124,7 @@ subroutine dsband_prefac( rvec, howmny, select, d, z, ldz, sigma, c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ierr = 0 ! ********************************************************************************************************************************** @@ -253,7 +246,6 @@ subroutine dsband_prefac( rvec, howmny, select, d, z, ldz, sigma, dsaupd_loop_count = dsaupd_loop_count + 1 endif write(sc1,12345,advance='no') iter+1,dsaupd_loop_count,ido,cr13_a - Write(f04, 9876) iter+1, dsaupd_loop_count, ido ! ********************************************************************** if (ido .eq. -1) then @@ -597,27 +589,17 @@ subroutine dsband_prefac( rvec, howmny, select, d, z, ldz, sigma, ! ********************************************************************************************************************************** 12345 format(5X,'Iteration',i4,' Rev comm loop',i4,' with IDO =',i3,a) - 9876 format(7X,'Iteration',i4,' Rev comm loop',i4,' with IDO =',i3) - 4907 FORMAT(/,22X,A & ,/,7X,'1',12X,'2',12X,'3',12X,'4',12X,'5',12X,'6',12X, & '7',12X,'8',12X,'9',12X,'10') 4908 FORMAT(10(1X,1ES12.5)) - 4092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 98710 FORMAT(' dsaupd loop count = ',I4,' ido = ',i4,', "type" = ',I3, & ', using ',a,' LAPACK matrices',/) 99990 FORMAT('********************************************************** &***************************') -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -635,8 +617,7 @@ SUBROUTINE ARP_DEB_PREFAC ( WHICH_DEB, N_DEB, IDO_DEB, IPNTR_DEB, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : PROG_NAME, FATAL_ERR, WARN_ERR - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, - & F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06 IMPLICIT NONE diff --git a/Source/LK4/EIG_GIV_MGIV.f90 b/Source/LK4/EIG_GIV_MGIV.f90 index 3fb9e4c6..4a437a08 100644 --- a/Source/LK4/EIG_GIV_MGIV.f90 +++ b/Source/LK4/EIG_GIV_MGIV.f90 @@ -29,12 +29,11 @@ SUBROUTINE EIG_GIV_MGIV ! Solves for eigenvalues and eigenvectors when method is GIV (Givens) or MGIV (modified Givens) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KLL_SDIA, KLLD_SDIA, MLL_SDIA, NDOFL, NTERM_KLL, NTERM_KLLD, & NTERM_MLL, NUM_EIGENS, NUM_KLLD_DIAG_ZEROS, NUM_MLL_DIAG_ZEROS, NVEC, SOL_NAME, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : BAILOUT, EPSIL, SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : EIG_GIV_MGIV_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, PI USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, EIGEN_VEC, MODE_NUM USE MODEL_STUF, ONLY : EIG_FRQ1, EIG_FRQ2, EIG_METH, EIG_N1, EIG_N2, EIG_VECS @@ -44,14 +43,14 @@ SUBROUTINE EIG_GIV_MGIV USE LAPACK_GIV_MGIV_EIG USE EIG_GIV_MGIV_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'EIG_GIV_MGIV' CHARACTER( 1*BYTE) :: JOBZ ! 'V' or 'N' input to subr DSBGVX ( if 'V', calc vecs, 'N' do not). CHARACTER( 1*BYTE) :: IFAIL_NULL ! 'Y'/'N' indicator if array IFAIL has any nonzero values. - CHARACTER(44*BYTE) :: MODNAM ! Name to write to screen to describe module being run. CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: CALLED_SUBR = ' ' ! Name of a called subr (for output error purposes) CHARACTER( 8*BYTE) :: NAME2 = ' ' ! Name for output purposes. CHARACTER( 1*BYTE) :: RANGE ! 'V' or 'I' indicator for LAPACK of whether eigen range is based on @@ -84,7 +83,7 @@ SUBROUTINE EIG_GIV_MGIV INTEGER(LONG) :: MLL_NULL_ROWS ! Number of null rows in the MLL mass matrix. INTEGER(LONG) :: NUM_FAIL ! Number of eigenvalues/vectors that failed to converge. INTEGER(LONG) :: NUM1 ! Number to use for max no. of eigens to find. Must be NUM1 <= NDOFL - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_GIV_MGIV_BEGEND + REAL(DOUBLE) :: ABSTOL ! Tolerance number for LAPACK routines. REAL(DOUBLE) :: EPS1 ! Small number to compare variables against zero. @@ -100,39 +99,29 @@ SUBROUTINE EIG_GIV_MGIV INTRINSIC :: DSQRT, MIN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) ! Determine bandwidth of stiffness and mass matrices so BANDGEN can put them in LAPACK band form - CALL OURTIM - MODNAM = 'CALCULATE BANDWIDTH OF KLL MATRIX' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALCULATE BANDWIDTH OF KLL MATRIX') CALL BANDSIZ ( NDOFL, NTERM_KLL, I_KLL, J_KLL, KLL_SDIA ) WRITE(ERR,4904) KLL_SDIA IF (SUPINFO == 'N') THEN WRITE(F06,4904) KLL_SDIA ENDIF - CALL OURTIM IF (SOL_NAME(1:8) == 'BUCKLING') THEN - MODNAM = 'CALCULATE BANDWIDTH OF KLLD MATRIX' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALCULATE BANDWIDTH OF KLLD MATRIX') CALL BANDSIZ ( NDOFL, NTERM_KLLD, I_KLLD, J_KLLD, KLLD_SDIA ) WRITE(ERR,4905) 'KLLD', KLLD_SDIA IF (SUPINFO == 'N') THEN WRITE(F06,4905) 'KLLD', KLLD_SDIA ENDIF ELSE - MODNAM = 'CALCULATE BANDWIDTH OF MLL MATRIX' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALCULATE BANDWIDTH OF MLL MATRIX') CALL BANDSIZ ( NDOFL, NTERM_MLL, I_MLL, J_MLL, MLL_SDIA ) WRITE(ERR,4905) 'MLL', MLL_SDIA IF (SUPINFO == 'N') THEN @@ -195,41 +184,32 @@ SUBROUTINE EIG_GIV_MGIV ! Allocate arrays ABAND and BBAND (stiffness, mass matrices in band form for LAPACK) - CALL OURTIM - MODNAM = 'ALLOCATE ARRAYS FOR LAPACK BAND FORM OF KLL' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR LAPACK BAND FORM OF KLL') CALL ALLOCATE_LAPACK_MAT ( 'ABAND', LDAB, NDOFL, SUBR_NAME ) - CALL OURTIM IF (SOL_NAME(1:8) == 'BUCKLING') THEN - MODNAM = 'ALLOCATE ARRAYS FOR LAPACK BAND FORM OF KLLD' + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR LAPACK BAND FORM OF KLLD') ELSE - MODNAM = 'ALLOCATE ARRAYS FOR LAPACK BAND FORM OF MLL' + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR LAPACK BAND FORM OF MLL') ENDIF - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC CALL ALLOCATE_LAPACK_MAT ( 'BBAND', LDBB, NDOFL, SUBR_NAME ) ! Put stiffness and mass matrices in form required by LAPACK band matrix and write them out, if requested. - CALL OURTIM - MODNAM = 'PUT KLL MATRIX IN LAPACK BAND FORM' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('PUT KLL MATRIX IN LAPACK BAND FORM') CALL BANDGEN_LAPACK_DPB ( 'KLL', NDOFL, A_SDIA, NTERM_KLL, I_KLL, J_KLL, KLL, ABAND, SUBR_NAME ) IF ((DEBUG(40) == 1) .OR. (DEBUG(40) == 3)) THEN CALL WRITE_MATRIX_BY_ROWS ( 'STIFFNESS MATRIX KLL IN LAPACK BAND FORM', ABAND, LDAB, NDOFL, F06 ) ENDIF - CALL OURTIM IF (SOL_NAME(1:8) == 'BUCKLING') THEN - MODNAM = 'PUT KLLD MATRIX IN LAPACK BAND FORM' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('PUT KLLD MATRIX IN LAPACK BAND FORM') CALL BANDGEN_LAPACK_DPB ( 'KLLD', NDOFL, B_SDIA, NTERM_KLLD, I_KLLD, J_KLLD, KLLD, BBAND, SUBR_NAME ) IF ((DEBUG(40) == 2) .OR. (DEBUG(40) == 3)) THEN CALL WRITE_MATRIX_BY_ROWS ( 'DIFF STIFF MATRIX KLLD IN LAPACK BAND FORM' , BBAND, LDBB, NDOFL, F06 ) ENDIF ELSE - MODNAM = 'PUT MLL MATRIX IN LAPACK BAND FORM' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('PUT MLL MATRIX IN LAPACK BAND FORM') CALL BANDGEN_LAPACK_DPB ( 'MLL', NDOFL, B_SDIA, NTERM_MLL, I_MLL, J_MLL, MLL, BBAND, SUBR_NAME ) IF ((DEBUG(40) == 2) .OR. (DEBUG(40) == 3)) THEN CALL WRITE_MATRIX_BY_ROWS ( 'MASS MATRIX MLL IN LAPACK BAND FORM' , BBAND, LDBB, NDOFL, F06 ) @@ -239,9 +219,7 @@ SUBROUTINE EIG_GIV_MGIV ! If this is not a CB or BUCKLING soln, dellocate arrays for KLL. ! Keep arrays MLL, KLLD. Need them later to calc gen mass IF ((SOL_NAME(1:12) /= 'GEN CB MODEL' ) .AND. (SOL_NAME(1:8) /= 'BUCKLING')) THEN - CALL OURTIM - MODNAM = 'DEALLOCATE SPARSE KLL ARRAYS' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('DEALLOCATE SPARSE KLL ARRAYS') !xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KLL', CR13 CALL DEALLOCATE_SPARSE_MAT ( 'KLL' ) @@ -316,9 +294,7 @@ SUBROUTINE EIG_GIV_MGIV IF (EIG_METH(1:3) == 'GIV') THEN - CALL OURTIM - MODNAM = 'SOLVE FOR EIGENVALUES/VECTORS - GIV METHOD' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SOLVE FOR EIGENVALUES/VECTORS - GIV METHOD') IF (SOL_NAME(1:8) == 'BUCKLING') THEN CALL DSBGVX_GIV_MGIV ( JOBZ, RANGE, 'U', NDOFL, A_SDIA, B_SDIA, ABAND, LDAB, -BBAND, LDBB, Q, LDQ, VL, VU, IL, IU, & ABSTOL, NUM_EIGENS, EIGEN_VAL, EIGEN_VEC, LDZ, WORK, IWORK, IFAIL, INFO, EIG_METH, MODE_NUM, & @@ -347,9 +323,7 @@ SUBROUTINE EIG_GIV_MGIV ENDDO ENDIF - CALL OURTIM - MODNAM = 'SOLVE FOR EIGENVALUES/VECTORS - MGIV METHOD' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SOLVE FOR EIGENVALUES/VECTORS - MGIV METHOD') IF (SOL_NAME(1:8) == 'BUCKLING') THEN CALL DSBGVX_GIV_MGIV ( JOBZ, RANGE, 'U', NDOFL, B_SDIA, A_SDIA, -BBAND, LDBB, ABAND, LDAB, Q, LDQ, VL, VU, IL, IU, & ABSTOL, NUM_EIGENS, EIGEN_VAL, EIGEN_VEC, LDZ, WORK, IWORK, IFAIL, INFO, EIG_METH, MODE_NUM, & @@ -435,12 +409,7 @@ SUBROUTINE EIG_GIV_MGIV ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -460,8 +429,6 @@ SUBROUTINE EIG_GIV_MGIV 40052 FORMAT(15X,10I8) - 4092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 4904 FORMAT(' *INFORMATION: NUMBER OF SUPERDIAGONALS IN THE KLL STIFFNESS MATRIX UPPER TRIANGLE IS = ',I12,/) 4905 FORMAT(' *INFORMATION: NUMBER OF SUPERDIAGONALS IN THE ',A,' MATRIX UPPER TRIANGLE IS = ',I12,/) diff --git a/Source/LK4/EIG_INV_PWR.f90 b/Source/LK4/EIG_INV_PWR.f90 index a44da230..249e30d5 100644 --- a/Source/LK4/EIG_INV_PWR.f90 +++ b/Source/LK4/EIG_INV_PWR.f90 @@ -30,13 +30,12 @@ SUBROUTINE EIG_INV_PWR ! iterative method USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KMSM_SDIA, LINKNO, NDOFL, NTERM_KLL, NTERM_KLLD, NTERM_KMSM, & NTERM_KMSMs, NTERM_MLL, NUM_EIGENS, NVEC, SOL_NAME, WARN_ERR - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC + USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : BAILOUT, EPSIL, KLLRAT, MXITERI, SOLLIB, SPARSE_FLAVOR, SPARSTOR, SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : EIG_INV_PWR_BEGEND USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, EIGEN_VEC, MODE_NUM USE MODEL_STUF, ONLY : EIG_N2, EIG_SIGMA USE SPARSE_MATRICES, ONLY : I_KLL, J_KLL, KLL, I_KLLD, J_KLLD, KLLD, I_MLL, J_MLL, MLL, & @@ -46,13 +45,13 @@ SUBROUTINE EIG_INV_PWR USE DEBUG_PARAMETERS, ONLY : DEBUG USE EIG_INV_PWR_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'EIG_INV_PWR' CHARACTER( 1*BYTE) :: EQUED ! 'Y' if KLL stiff matrix was equilibrated in subr EQUILIBRATE - CHARACTER(44*BYTE) :: MODNAM ! Name to write to screen to describe module being run. INTEGER(LONG) :: DEB_PRT(2) ! Debug numbers to say whether to write ABAND and/or its decomp to output ! file in called subr SYM_MAT_DECOMP_LAPACK (ABAND = band form of KLL) @@ -61,7 +60,7 @@ SUBROUTINE EIG_INV_PWR INTEGER(LONG) :: INFO = 0 ! INTEGER(LONG) :: ITER_NUM ! Number of iterations in converging on eigenvalue - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_INV_PWR_BEGEND + REAL(DOUBLE) :: EIGEN_VAL_APPROX(0:MXITERI) ! Eigenvalue at a given iteration number @@ -76,12 +75,7 @@ SUBROUTINE EIG_INV_PWR INTRINSIC :: MIN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Check that user did not ask for more than 1 eigen (currently Inverse Power can't be used to find more than 1 eigen). @@ -96,9 +90,7 @@ SUBROUTINE EIG_INV_PWR EIG_N2 = 1 ENDIF - CALL OURTIM - MODNAM = 'SOLVE FOR EIGENVALS/VECTORS - INV POWER METH' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SOLVE FOR EIGENVALS/VECTORS - INV POWER METH') ! Calc KMSM = KLL - EIG_SIGMA*MLL (or - EIG_SIGMA*KLLD for BUCKLING) where EIG_SIGMA = shift freq @@ -336,20 +328,13 @@ SUBROUTINE EIG_INV_PWR ! If this is not a CB or BUCKLING soln, dellocate arrays for KLL. IF ((SOL_NAME(1:12) /= 'GEN CB MODEL' ) .AND. (SOL_NAME(1:8) /= 'BUCKLING')) THEN - CALL OURTIM - MODNAM = 'DEALLOCATE SPARSE KLL ARRAYS' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('DEALLOCATE SPARSE KLL ARRAYS') !xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,32345,ADVANCE='NO') ' Deallocate KLL', CR13 CALL DEALLOCATE_SPARSE_MAT ( 'KLL' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -372,8 +357,6 @@ SUBROUTINE EIG_INV_PWR 4008 FORMAT(' *INFORMATION: THE INVERSE POWER METHOD PERFORMED ',I8,' ITERATIONS TO CONVERGE TO THE FIRST EIGENVALUE WITHIN ' & ,1ES9.1,'%') - 4092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 4901 FORMAT(' *WARNING : REQUEST FOR ',I8,' EIGENVALUES CANNOT BE HONORED. INVERSE POWER CAN BE USED TO FIND NO MORE THAN ONE' & ,I8,/,14X,' ATTEMPT WILL BE MADE TO FIND ONE EIGENVALUE') diff --git a/Source/LK4/EIG_LANCZOS_ARPACK.f90 b/Source/LK4/EIG_LANCZOS_ARPACK.f90 index 5aef31ea..7f635685 100644 --- a/Source/LK4/EIG_LANCZOS_ARPACK.f90 +++ b/Source/LK4/EIG_LANCZOS_ARPACK.f90 @@ -29,17 +29,16 @@ SUBROUTINE EIG_LANCZOS_ARPACK ! Solves for eigenvalues and eigenvectors when the Lanczos method is requested (on Bulk Data EIGRL entry) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KMSM_SDIA, LINKNO, NDOFL, NTERM_KLL, NTERM_KLLD, NTERM_KMSM, & NTERM_KMSMn, NTERM_KMSMs, NTERM_MLL, NTERM_ULL, NUM_EIGENS, NUM_KLLD_DIAG_ZEROS, & NUM_MLL_DIAG_ZEROS, NVEC, SOL_NAME, WARN_ERR - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC + USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, PI USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : ARP_TOL, BAILOUT, DARPACK, EIGESTL, EPSIL, MXITERL, SOLLIB, SPARSTOR, SUPINFO, & SUPWARN USE DOF_TABLES, ONLY : TDOFI - USE SUBR_BEGEND_LEVELS, ONLY : EIG_LANCZOS_ARPACK_BEGEND USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, EIGEN_VEC, MODE_NUM USE MODEL_STUF, ONLY : EIG_FRQ1, EIG_FRQ2, EIG_LANCZOS_NEV_DELT, EIG_LAP_MAT_TYPE, EIG_MODE, EIG_N1, EIG_N2, & EIG_NCVFACL, EIG_SIGMA @@ -50,7 +49,8 @@ SUBROUTINE EIG_LANCZOS_ARPACK USE ARPACK_LANCZOS_EIG USE EIG_LANCZOS_ARPACK_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE LOGICAL :: RVEC ! = .TRUE. or .FALSE. Specifies whether eigenvectors are to be calculated @@ -74,7 +74,6 @@ SUBROUTINE EIG_LANCZOS_ARPACK ! If NEV is odd, compute 1 more from high end than from low end ! When IPARAM(7) = 3, 4, or 5, WHICH should be set to 'LM' only. - CHARACTER(44*BYTE) :: MODNAM ! Name to write to screen to describe module being run. CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: CALLED_SUBR = ' ' ! Name of a called subr (for output error purposes) INTEGER(LONG) :: COMPV ! Component number (1-6) of a grid DOF @@ -95,19 +94,14 @@ SUBROUTINE EIG_LANCZOS_ARPACK INTEGER(LONG) :: NUM_NEG_TERMS2 ! Number of negative terms on the diagonal of RFAC for EIG_FRQ2 INTEGER(LONG) :: NUM_EST_EIGENS ! Number of estimated eigens in the freq interval (EIG_FRQ2 - EIG_FRQ1) INTEGER(LONG) :: NUM_KMSM_DIAG_0 ! Number of zero diagonal terms in KMSM - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_LANCZOS_ARPACK_BEGEND + INTEGER(LONG) :: MIN_NCV, MAX_NCV, LNONZEROS REAL(DOUBLE) :: EPS1 ! A small number to compare zero to INTRINSIC :: MIN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -167,13 +161,11 @@ SUBROUTINE EIG_LANCZOS_ARPACK ! Det bandwidth of KMSM so BANDGEN can put it in LAPACK band form. KMSM_SDIA is the number of super-diags in the band form of KMSM - CALL OURTIM IF (SOL_NAME(1:8) == 'BUCKLING') THEN - MODNAM = 'CALCULATE BANDWIDTH OF [KLL + sigma*KLLD]' + CALL LINK_MESSAGE('CALCULATE BANDWIDTH OF [KLL + sigma*KLLD]') ELSE - MODNAM = 'CALCULATE BANDWIDTH OF [KLL - sigma*MLL]' + CALL LINK_MESSAGE('CALCULATE BANDWIDTH OF [KLL - sigma*MLL]') ENDIF - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC CALL BANDSIZ ( NDOFL, NTERM_KMSM, I_KMSM, J_KMSM, KMSM_SDIA ) WRITE(ERR,4905) KMSM_SDIA IF (SUPINFO == 'N') THEN @@ -198,13 +190,11 @@ SUBROUTINE EIG_LANCZOS_ARPACK ! Allocate array RFAC = (KLL - EIG_SIGMA*MLL, or KLL + EIG_SIGMA*KLLD) for ARACK - CALL OURTIM IF (SOL_NAME(1:8) == 'BUCKLING') THEN - MODNAM = 'ALLOCATE ARPACK BAND MAT: RFAC = KLL + sigma*KLLD' + CALL LINK_MESSAGE('ALLOCATE ARPACK BAND MAT: RFAC = KLL + sigma*KLLD') ELSE - MODNAM = 'ALLOCATE ARPACK BAND MAT: RFAC = KLL - sigma*MLL' + CALL LINK_MESSAGE('ALLOCATE ARPACK BAND MAT: RFAC = KLL - sigma*MLL') ENDIF - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC CALL ALLOCATE_LAPACK_MAT ( 'RFAC', LDRFAC, NDOFL, SUBR_NAME ) @@ -212,9 +202,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK ! Put KMSM in form required by LAPACK band matrix. Call result array RFAC - CALL OURTIM - MODNAM = 'PUT RFAC MATRIX IN ARPACK BAND FORM' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('PUT RFAC MATRIX IN ARPACK BAND FORM') IF (EIG_LAP_MAT_TYPE(1:3) == 'DPB') THEN CALL BANDGEN_LAPACK_DPB ( 'KMSM', NDOFL, KMSM_SDIA, NTERM_KMSM, I_KMSM, J_KMSM, KMSM, RFAC, SUBR_NAME ) ELSE IF (EIG_LAP_MAT_TYPE(1:3) == 'DGB') THEN @@ -236,9 +224,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK ! If this is not a CB or BUCKLING soln, dellocate arrays for KLL. ! Keep arrays MLL, KLLD. Need them later to calc gen mass IF ((SOL_NAME(1:12) /= 'GEN CB MODEL' ) .AND. (SOL_NAME(1:8) /= 'BUCKLING')) THEN - CALL OURTIM - MODNAM = 'DEALLOCATE SPARSE KLL ARRAYS' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('DEALLOCATE SPARSE KLL ARRAYS') !xx WRITE(SC1, * ) ! Advance 1 line for screen messages WRITE(SC1,12345,ADVANCE='NO') ' Deallocate KLL', CR13 CALL DEALLOCATE_SPARSE_MAT ( 'KLL' ) @@ -251,14 +237,10 @@ SUBROUTINE EIG_LANCZOS_ARPACK CALL SPARSE_MAT_DIAG_ZEROS ( 'KMSM', NDOFL, NTERM_KMSM, I_KMSM, J_KMSM, NUM_KMSM_DIAG_0 ) NTERM_KMSMn = 2*NTERM_KMSM - (NDOFL - NUM_KMSM_DIAG_0) - CALL OURTIM - MODNAM = 'ALLOCATE SPARSE KMSMn ARRAYS' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE SPARSE KMSMn ARRAYS') CALL ALLOCATE_SPARSE_MAT ( 'KMSMn', NDOFL, NTERM_KMSMn, SUBR_NAME ) - CALL OURTIM - MODNAM = 'CONVERT SYM CRS KMSM TO NONSYM CRS KMSMn' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CONVERT SYM CRS KMSM TO NONSYM CRS KMSMn') CALL CRS_SYM_TO_CRS_NONSYM ( 'KMSM', NDOFL, NTERM_KMSM, I_KMSM, J_KMSM, KMSM, 'KMSMn', NTERM_KMSMn, I_KMSMn, J_KMSMn, & KMSMn, 'Y' ) @@ -426,9 +408,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK SELECT(I) = .FALSE. ! so all members of SELECT are .FALSE. ENDDO - CALL OURTIM - MODNAM = 'SOLVE FOR EIGENVALS/VECTORS - LANCZOS METH' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SOLVE FOR EIGENVALS/VECTORS - LANCZOS METH') !xx WRITE(SC1, * ) ! Make new line for DTBSV pass messages that overwrite each other IF (DEBUG(50) == 1) CALL DEBUG_EIG_LANCZOS @@ -513,12 +493,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK NUM_EIGENS = NVEC -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -540,8 +515,6 @@ SUBROUTINE EIG_LANCZOS_ARPACK 4003 FORMAT(' *ERROR 4003: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,' EIG_LAP_MAT_TYPE MUST BE EITHER "DGB" OR "DPB" BUT IS = ',A) - 4092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 4901 FORMAT(' *WARNING : REQUEST FOR ',I8,' EIGENVALUES CANNOT BE HONORED. LANCZOS CAN BE USED TO FIND NO MORE THAN', & ' NEV = ' & ,I8,/,14X,' ATTEMPT WILL BE MADE TO FIND ',I8,' EIGENVALUES (SEE MANUAL FOR DEFINITION OF PARAMETER DARPACK)') diff --git a/Source/LK4/EIG_LANCZOS_ARPACK_ADAPTIVE.f90 b/Source/LK4/EIG_LANCZOS_ARPACK_ADAPTIVE.f90 index a89aed27..aeeffd98 100644 --- a/Source/LK4/EIG_LANCZOS_ARPACK_ADAPTIVE.f90 +++ b/Source/LK4/EIG_LANCZOS_ARPACK_ADAPTIVE.f90 @@ -40,15 +40,14 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE ! NOTE: This routine only supports normal modes (not BUCKLING or GEN CB MODEL) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, KMSM_SDIA, LINKNO, NDOFL, NTERM_KLL, NTERM_KMSM, & NTERM_KMSMn, NTERM_MLL, NUM_EIGENS, NUM_MLL_DIAG_ZEROS, NVEC, SOL_NAME, WARN_ERR - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC + USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, PI USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : ARP_TOL, BAILOUT, EPSIL, MXITERL, SOLLIB, SPARSTOR, SUPINFO, SUPWARN USE DOF_TABLES, ONLY : TDOFI - USE SUBR_BEGEND_LEVELS, ONLY : EIG_LANCZOS_ARPACK_BEGEND USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, EIGEN_VEC, MODE_NUM USE MODEL_STUF, ONLY : EIG_FRQ1, EIG_FRQ2, EIG_LAP_MAT_TYPE, EIG_N2, EIG_NCVFACL USE ARPACK_MATRICES_1, ONLY : IWORK, RESID, RFAC, SELECT, VBAS, WORKD, WORKL @@ -63,7 +62,8 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE USE EIG_LANCZOS_ARPACK_ADAPTIVE_USE_IFs USE DSBAND_PREFAC_Interface USE SYM_MAT_DECOMP_SUPRLU_Interface - + USE LINK_MESSAGE_Interface + IMPLICIT NONE LOGICAL :: RVEC ! Specifies whether eigenvectors are to be calculated @@ -77,7 +77,6 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE CHARACTER( 1*BYTE) :: BMAT ! 'G' for generalized eigenvalue problem CHARACTER( 1*BYTE) :: HOWMNY ! 'A' to compute all eigenvectors CHARACTER( 2*BYTE) :: WHICH ! 'LM' for largest magnitude (closest to sigma in shift-invert) - CHARACTER(44*BYTE) :: MODNAM ! Module name for screen output CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: CALLED_SUBR = ' ' ! Name of called subr for error messages INTEGER(LONG) :: COMPV ! Component number (1-6) of a grid DOF @@ -102,7 +101,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE INTEGER(LONG) :: MAX_DOUBLINGS ! Maximum number of doublings allowed INTEGER(LONG) :: INITIAL_NEV ! Starting value for NEV INTEGER(LONG) :: MAX_NEV ! Maximum NEV based on problem size and EIG_N2 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_LANCZOS_ARPACK_BEGEND + REAL(DOUBLE) :: EPS1 ! Small number for comparisons REAL(DOUBLE) :: SIGMA ! Shift value (center of frequency range in omega^2) @@ -127,12 +126,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE INTRINSIC :: MIN, MAX, SQRT, ABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME, TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! NOTE: This routine should only be called when: @@ -212,9 +206,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE ! ********************************************************************************************************************************** ! Build KMSM = KLL - SIGMA*MLL (this is done ONCE since sigma is fixed) - CALL OURTIM - MODNAM = 'BUILD SHIFTED MATRIX [KLL - sigma*MLL]' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('BUILD SHIFTED MATRIX [KLL - sigma*MLL]') CALL MATADD_SSS_NTERM ( NDOFL, 'KLL', NTERM_KLL, I_KLL, J_KLL, SYM_KLL, '-sigma*MLL', & NTERM_MLL, I_MLL, J_MLL, SYM_MLL, 'KMSM', NTERM_KMSM ) @@ -224,9 +216,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE 'KMSM', NTERM_KMSM, I_KMSM, J_KMSM, KMSM ) ! Calculate bandwidth of KMSM - CALL OURTIM - MODNAM = 'CALCULATE BANDWIDTH OF [KLL - sigma*MLL]' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALCULATE BANDWIDTH OF [KLL - sigma*MLL]') CALL BANDSIZ ( NDOFL, NTERM_KMSM, I_KMSM, J_KMSM, KMSM_SDIA ) WRITE(ERR,4905) KMSM_SDIA IF (SUPINFO == 'N') THEN @@ -283,9 +273,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE KL = KMSM_SDIA KU = KL - CALL OURTIM - MODNAM = 'FACTOR SHIFTED MATRIX [KLL - sigma*MLL]' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('FACTOR SHIFTED MATRIX [KLL - sigma*MLL]') ! Allocate RFAC and IWORK (kept across all iterations) CALL ALLOCATE_LAPACK_MAT ( 'RFAC', LDRFAC, NDOFL, SUBR_NAME ) @@ -435,9 +423,7 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE ENDDO ! Call DSBAND_PREFAC to compute eigenvalues (uses pre-factored RFAC/SLU_FACTORS) - CALL OURTIM - MODNAM = 'SOLVE FOR EIGENVALS/VECTORS - LANCZOS METH' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SOLVE FOR EIGENVALS/VECTORS - LANCZOS METH') INFO_ARPACK = 0 INFO_LAPACK = 0 @@ -715,12 +701,6 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE WRITE(SC1,1014) NUM_EIGENS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME, TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -832,8 +812,6 @@ SUBROUTINE EIG_LANCZOS_ARPACK_ADAPTIVE 4003 FORMAT(' *ERROR 4003: PROGRAMMING ERROR IN SUBROUTINE ',A, & /,14X,' EIG_LAP_MAT_TYPE MUST BE EITHER "DGB" OR "DPB" BUT IS = ',A) - 4092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 4905 FORMAT(' *INFORMATION: NUMBER OF SUPERDIAGONALS IN THE KMSM = [KLL - sigma*MLL] MATRIX UPPER TRIANGLE IS = ',I12,/) 9101 FORMAT(' *ERROR 9101: SUBROUTINE ',A,' DOES NOT SUPPORT BUCKLING SOLUTIONS.', & diff --git a/Source/LK4/EIG_SUMMARY.f90 b/Source/LK4/EIG_SUMMARY.f90 index 5d983e89..634455cd 100644 --- a/Source/LK4/EIG_SUMMARY.f90 +++ b/Source/LK4/EIG_SUMMARY.f90 @@ -29,13 +29,12 @@ SUBROUTINE EIG_SUMMARY ! Prints eigenvalue analysis summary table USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ANS, ANSFIL, ANS_MSG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFL, NUM_EIGENS, NVEC, NUM_KLLD_DIAG_ZEROS, NUM_MLL_DIAG_ZEROS, SOL_NAME, & WARN_ERR USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE PARAMS, ONLY : ART_MASS, ART_ROT_MASS, ART_TRAN_MASS, DARPACK, SOLLIB, SUPINFO, SUPWARN, PRTANS - USE SUBR_BEGEND_LEVELS, ONLY : EIG_SUMMARY_BEGEND + USE PARAMS, ONLY : ART_MASS, ART_ROT_MASS, ART_TRAN_MASS, DARPACK, SOLLIB, SUPINFO, SUPWARN USE CONSTANTS_1, ONLY : ZERO, TWO, PI USE EIGEN_MATRICES_1, ONLY : GEN_MASS, MODE_NUM, EIGEN_VAL USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_GRID, EIG_LAP_MAT_TYPE, EIG_METH, EIG_MODE, EIG_N2, EIG_NORM, & @@ -55,31 +54,18 @@ SUBROUTINE EIG_SUMMARY INTEGER(LONG) :: MAX_LANCZOS_EIGENS! Max number of eigenvalues that can be found by Lanczos method INTEGER(LONG) :: NUM_NEG_EIGENS ! Number of eigenvalues that are negative INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EIG_SUMMARY_BEGEND + REAL(DOUBLE) :: CYCLES1 ! Circular frequency of a mode REAL(DOUBLE) :: GEN_STIFF1 ! Generalized stiffness for a mode REAL(DOUBLE) :: RADS1 ! Radian frequency of a mode -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** OUNT(1) = ERR OUNT(2) = F06 - IF (PRTANS == 'Y') THEN - INQUIRE (FILE=ANSFIL, OPENED=FILE_OPND) - IF (.NOT.FILE_OPND) THEN ! Otherwise we assume it is positioned at its end and ready for write - CALL FILE_OPEN ( ANS, ANSFIL, OUNT, 'OLD', ANS_MSG, 'WRITE_STIME', 'FORMATTED', 'READWRITE', 'REWIND', 'Y', 'Y', 'Y' ) - ENDIF - WRITE(ANS,*) - WRITE(ANS,*) - ENDIF IF (EIG_METH == 'LANCZOS') THEN @@ -142,15 +128,6 @@ SUBROUTINE EIG_SUMMARY WRITE(F06,94201) WRITE(F06,94202) ENDIF - IF (PRTANS == 'Y') THEN - IF (SOL_NAME(1:8) == 'BUCKLING') THEN - WRITE(ANS,94301) - WRITE(ANS,94302) - ELSE - WRITE(ANS,94401) - WRITE(ANS,94402) - ENDIF - ENDIF NUM_NEG_EIGENS = 0 DO I=1,NUM_EIGENS @@ -164,26 +141,12 @@ SUBROUTINE EIG_SUMMARY ELSE WRITE(F06,95302) MODE_NUM(I),I,EIGEN_VAL(I),ASTERISK,RADS1,CYCLES1,GEN_MASS(I),GEN_STIFF1 ENDIF - IF (PRTANS == 'Y') THEN - IF (SOL_NAME(1:8) == 'BUCKLING') THEN - WRITE(ANS,95311) MODE_NUM(I),I,EIGEN_VAL(I),ASTERISK - ELSE - WRITE(ANS,95312) MODE_NUM(I),I,EIGEN_VAL(I),ASTERISK,RADS1,CYCLES1,GEN_MASS(I),GEN_STIFF1 - ENDIF - ENDIF ELSE IF (SOL_NAME(1:8) == 'BUCKLING') THEN WRITE(F06,95401) MODE_NUM(I),I,EIGEN_VAL(I) ELSE WRITE(F06,95402) MODE_NUM(I),I,EIGEN_VAL(I), RADS1,CYCLES1,GEN_MASS(I),GEN_STIFF1 ENDIF - IF (PRTANS == 'Y') THEN - IF (SOL_NAME(1:8) == 'BUCKLING') THEN - WRITE(ANS,95411) MODE_NUM(I),I,EIGEN_VAL(I) - ELSE - WRITE(ANS,95412) MODE_NUM(I),I,EIGEN_VAL(I), RADS1,CYCLES1,GEN_MASS(I),GEN_STIFF1 - ENDIF - ENDIF ENDIF ENDDO @@ -235,10 +198,6 @@ SUBROUTINE EIG_SUMMARY ENDIF ENDIF - IF (PRTANS == 'Y') THEN - WRITE(ANS,*) - ENDIF - IF (NUM_NEG_EIGENS > 0) THEN WRITE(F06,*) WRITE(F06,99000) NUM_NEG_EIGENS @@ -246,17 +205,8 @@ SUBROUTINE EIG_SUMMARY WRITE(F06,*) WRITE(F06,*) - IF (PRTANS == 'Y') THEN - WRITE(ANS,*) - WRITE(ANS,*) - ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -289,9 +239,6 @@ SUBROUTINE EIG_SUMMARY 92007 FORMAT(32X,'NUMBER OF OFF DIAGONAL GENERALIZED MASS') 92008 FORMAT(32X,'TERMS FAILING CRITERION OF ',1ES8.1,'. . . . .',2X,I8,/) - -92009 FORMAT(32X,'RATIO OF HIGHEST REAL MGIV EIGENVALUE' & - ,/,32X,'TO LOWEST "INFINITE" EIGENVALUE. . . . . . . ',1ES8.1) 92010 FORMAT(4X,'NO EIGENVECTORS WERE REQUESTED TO BE OUTPUT, SO NO GENERALIZED MASS OR GENERALIZED STIFFNESS HAS BEEN CALCULATED',& /) @@ -306,31 +253,14 @@ SUBROUTINE EIG_SUMMARY & ',/,3X,'NUMBER ORDER MASS STIFFNESS'& ,/) -94301 FORMAT(44X,'R E A L E I G E N V A L U E S',/,43X,'(subcase 1 buckling load factors)',/) - -94302 FORMAT(40X,' MODE EXTRACTION EIGENVALUE',/,40X,'NUMBER ORDER',/) - -94401 FORMAT(40X,'R E A L E I G E N V A L U E S') - -94402 FORMAT(9X,' MODE EXTRACT EIGENVALUE RADIANS CYCLES GENERALIZED GENERALIZED& -& ',/,9X,'NUMBER ORDER MASS STIFFNESS',/) - 95301 FORMAT(38X,2I8,1ES20.6,A) 95302 FORMAT(1X,2I8,1ES20.6,A,1ES19.6,3(1ES20.6)) -95311 FORMAT(6X,2I9,1ES14.6,A) - -95312 FORMAT(6X,2I9,1ES14.6,A,1ES13.6,3(1ES14.6)) - 95401 FORMAT(38X,2I8,1ES20.6) 95402 FORMAT(1X,2I8,5(1ES20.6)) -95411 FORMAT(6X,2I9,1ES14.6) - -95412 FORMAT(6X,2I9,5(1ES14.6)) - 98006 FORMAT(' *WARNING : THE BULK DATA EIGR/EIGRL ENTRY ASKED FOR MODES UP TO NUMBER',I8,'. HOWEVER, THIS MODEL HAS ONLY',I8 & ,/,14X,' FINITE EIGENVALUES DUE TO THE FACT THAT THE L-SET MASS MATRIX HAS',I8,' ZERO MASS DEGREES OF FREEDOM.'& ,/,14x,' (USE OF BULK DATA PARAM ART_MASS WITH SMALL VALUE MAY HELP TO AVOID EIGENVALUES THAT ARE', & diff --git a/Source/LK4/INVERT_EIGENS.f90 b/Source/LK4/INVERT_EIGENS.f90 index 572db3ba..3b3cb020 100644 --- a/Source/LK4/INVERT_EIGENS.f90 +++ b/Source/LK4/INVERT_EIGENS.f90 @@ -30,10 +30,9 @@ SUBROUTINE INVERT_EIGENS ( MLAM, N, W, Z, EIG_NUM ) ! 1/eigenvalue USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : INVERT_EIGENS_BEGEND USE CONSTANTS_1, ONLY : ONE USE MACHINE_PARAMS, ONLY : MACH_SFMIN, MACH_LARGE_NUM USE MODEL_STUF, ONLY : EIG_SIGMA @@ -51,19 +50,14 @@ SUBROUTINE INVERT_EIGENS ( MLAM, N, W, Z, EIG_NUM ) INTEGER(LONG) :: I,J ! DO loop indices. INTEGER(LONG) :: M1 ! One eigenvector number INTEGER(LONG) :: PM,QM ! Indices used in reording the W and Z - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = INVERT_EIGENS_BEGEND + REAL(DOUBLE) , INTENT(INOUT) :: W(MLAM) ! Eigenvalues REAL(DOUBLE) , INTENT(INOUT) :: Z(N,NVEC) ! Eigenvectors REAL(DOUBLE) :: W1 ! One eigenvalue REAL(DOUBLE) :: Z1(N) ! One eigenvector -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO I=1,MLAM ! Invert eigenvalues @@ -113,12 +107,7 @@ SUBROUTINE INVERT_EIGENS ( MLAM, N, W, Z, EIG_NUM ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK4/LINK4.f90 b/Source/LK4/LINK4.f90 index f482ec4b..6df73eaf 100644 --- a/Source/LK4/LINK4.f90 +++ b/Source/LK4/LINK4.f90 @@ -53,13 +53,12 @@ SUBROUTINE LINK4 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, ERRSTAT, F04, F06, L1M, L3A, SC1 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, ERRSTAT, F06, L1M, L3A, SC1 USE IOUNT1, ONLY : LINK1M, LINK2I, LINK3A, L1M_MSG, L3A_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, LINKNO, MBUG, NDOFL, & NTERM_KLL, NTERM_KLLD, NTERM_KLLDn, & NTERM_MLL, NTERM_MLLn, & NVEC, NUM_EIGENS, NUM_KLLD_DIAG_ZEROS, NUM_MLL_DIAG_ZEROS, SOL_NAME, WARN_ERR - USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EPSIL, SOLLIB, SPARSTOR, SUPINFO USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_METH, EIG_MSGLVL, EIG_LAP_MAT_TYPE, & @@ -74,12 +73,12 @@ SUBROUTINE LINK4 USE DEBUG_PARAMETERS, ONLY : DEBUG USE LINK4_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'LINK4' - CHARACTER( 44*BYTE) :: MODNAM ! Name to write to screen to describe module being run. INTEGER(LONG) :: I,J ! DO loop indices or counters. INTEGER(LONG) :: IERROR ! Error count when reading records from a file. @@ -119,13 +118,10 @@ SUBROUTINE LINK4 ! Write info to text files WRITE(F06,150) LINKNO - IF (WRT_LOG > 0) THEN - WRITE(F04,150) LINKNO - ENDIF WRITE(ERR,150) LINKNO ! Read LINK1A file - CALL READ_L1A ( 'KEEP', 'Y' ) + CALL READ_L1A ( 'KEEP' ) ! Check COMM for successful completion of prior LINKs IF (COMM(P_LINKNO) /= 'C') THEN @@ -195,14 +191,10 @@ SUBROUTINE LINK4 CALL SPARSE_MAT_DIAG_ZEROS ( 'KLLD', NDOFL, NTERM_KLLD, I_KLLD, J_KLLD, NUM_KLLD_DIAG_ZEROS ) NTERM_KLLDn = 2*NTERM_KLLD - (NDOFL - NUM_KLLD_DIAG_ZEROS) - CALL OURTIM - MODNAM = 'ALLOCATE SPARSE KLLDn ARRAYS' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE SPARSE KLLDn ARRAYS') CALL ALLOCATE_SPARSE_MAT ( 'KLLDn', NDOFL, NTERM_KLLDn, SUBR_NAME ) - CALL OURTIM - MODNAM = 'CONVERT SYM CRS KLLD TO NONSYM CRS KLLDn' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CONVERT SYM CRS KLLD TO NONSYM CRS KLLDn') CALL CRS_SYM_TO_CRS_NONSYM ( 'KLLD', NDOFL, NTERM_KLLD, I_KLLD, J_KLLD, KLLD, 'KLLDn', NTERM_KLLDn, & I_KLLDn, J_KLLDn, KLLDn, 'Y' ) @@ -211,14 +203,10 @@ SUBROUTINE LINK4 CALL SPARSE_MAT_DIAG_ZEROS ( 'MLL', NDOFL, NTERM_MLL, I_MLL, J_MLL, NUM_MLL_DIAG_ZEROS ) NTERM_MLLn = 2*NTERM_MLL - (NDOFL - NUM_MLL_DIAG_ZEROS) - CALL OURTIM - MODNAM = 'ALLOCATE SPARSE MLLn ARRAYS' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE SPARSE MLLn ARRAYS') CALL ALLOCATE_SPARSE_MAT ( 'MLLn', NDOFL, NTERM_MLLn, SUBR_NAME ) - CALL OURTIM - MODNAM = 'CONVERT SYM CRS MLL TO NONSYM CRS MLLn' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CONVERT SYM CRS MLL TO NONSYM CRS MLLn') CALL CRS_SYM_TO_CRS_NONSYM ( 'MLL', NDOFL, NTERM_MLL, I_MLL, J_MLL, MLL, 'MLLn', NTERM_MLLn, I_MLLn, J_MLLn, MLLn, 'Y' ) ENDIF @@ -227,16 +215,11 @@ SUBROUTINE LINK4 IF (SOL_NAME(1:8) == 'BUCKLING') THEN - CALL OURTIM - - MODNAM = 'ALLOCATE ARRAYS FOR NONSYM STORAGE OF KLLD' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR NONSYM STORAGE OF KLLD') NTERM_KLLDn = NTERM_KLLD CALL ALLOCATE_SPARSE_MAT ( 'KLLDn', NDOFL, NTERM_KLLDn, SUBR_NAME ) - CALL OURTIM - MODNAM = 'GET VALUES FOR NONSYM FORM OF KLLD' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GET VALUES FOR NONSYM FORM OF KLLD') DO I=1,NDOFL+1 I_KLLDn(I) = I_KLLD(I) ENDDO @@ -247,15 +230,11 @@ SUBROUTINE LINK4 ELSE - CALL OURTIM - MODNAM = 'ALLOCATE ARRAYS FOR NONSYM STORAGE OF MLL' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR NONSYM STORAGE OF MLL') NTERM_MLLn = NTERM_MLL CALL ALLOCATE_SPARSE_MAT ( 'MLLn', NDOFL, NTERM_MLLn, SUBR_NAME ) - CALL OURTIM - MODNAM = 'GET VALUES FOR NONSYM FORM OF MLL' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GET VALUES FOR NONSYM FORM OF MLL') DO I=1,NDOFL+1 I_MLLn(I) = I_MLL(I) ENDDO @@ -323,15 +302,13 @@ SUBROUTINE LINK4 CALL ALLOCATE_EIGEN1_MAT ( 'GEN_MASS', NUM_EIGENS, 1, SUBR_NAME ) IF (NVEC > 0) THEN - CALL OURTIM ! Calc gen mass - MODNAM = 'CALCULATE GENERALIZED MASS' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + ! Calc gen mass + CALL LINK_MESSAGE('CALCULATE GENERALIZED MASS') CALL CALC_GEN_MASS IF (EIG_NORM == 'MASS') THEN - CALL OURTIM ! Renorm vecs to mass if user asked for 'MASS'. - MODNAM = 'RENORMALIZE EIGENVECTORS TO UNIT GEN MASS' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + ! Renorm vecs to mass if user asked for 'MASS'. + CALL LINK_MESSAGE('RENORMALIZE EIGENVECTORS TO UNIT GEN MASS') CALL RENORM_ON_MASS ( NVEC, EPS1 ) ENDIF @@ -355,26 +332,22 @@ SUBROUTINE LINK4 ! Write eigenvalue analysis summary to output file ! if DEBUG requested them or if renormalization is on 'MASS' or 'NONE' - MODNAM = 'WRITE EIGENVALUE SUMMARY TO OUTFIL' IF ((EIG_NORM == 'MASS ') .OR. (EIG_NORM == 'NONE')) THEN - CALL OURTIM - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE EIGENVALUE SUMMARY TO OUTFIL') CALL EIG_SUMMARY ENDIF ! Open and set up file L3A (used to hold eigenvectors) - CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'REPLACE', L3A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'REPLACE', L3A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ! Write out computed eigenvectors to L3A - CALL OURTIM - MODNAM = 'WRITE EIGENVECTORS TO DISK FILE' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE EIGENVECTORS TO DISK FILE') DO J=1,NVEC DO I=1,NDOFL WRITE(L3A) EIGEN_VEC(I,J) ENDDO ENDDO - CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP' ) ! Optional eigenvector debug output IF (DEBUG(43) == 1) THEN @@ -389,9 +362,7 @@ SUBROUTINE LINK4 ! Call OUTPUT4 processor to process output requests for OUTPUT4 matrices generated in this link IF (NUM_OU4_REQUESTS > 0) THEN - CALL OURTIM - MODNAM = 'WRITE OUTPUT4 NATRICES ' - WRITE(SC1,4092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE OUTPUT4 NATRICES ') WRITE(F06,*) CALL OUTPUT4_PROC ( SUBR_NAME ) ENDIF @@ -412,7 +383,7 @@ SUBROUTINE LINK4 COMM(LINKNO) = 'C' ! Write data to L1A - CALL WRITE_L1A ( 'KEEP', 'Y', 'Y' ) + CALL WRITE_L1A ( 'KEEP', 'Y' ) ! Check allocation status of allocatable arrays, if requested IF (DEBUG(100) > 0) THEN @@ -422,11 +393,8 @@ SUBROUTINE LINK4 ENDIF ENDIF - ! Write LINK4 end to F04, F06 + ! Write LINK4 end to F06 CALL OURTIM - IF (WRT_LOG > 0) THEN - WRITE(F04,151) LINKNO - ENDIF WRITE(F06,151) LINKNO ! Close files @@ -456,8 +424,6 @@ SUBROUTINE LINK4 4005 FORMAT(' *ERROR 4005: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,' CODE ONLY WRITTEN FOR METHOD = GIV, MGIV, OR LANCZOS BUT METHOD IS = ',A8) - 4092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 9101 FORMAT(1X,A,' = ','"',A,'"') 9102 FORMAT(1X,A,' = ',I13) diff --git a/Source/LK4/RENORM_ON_MASS.f90 b/Source/LK4/RENORM_ON_MASS.f90 index a5a3de14..37b63225 100644 --- a/Source/LK4/RENORM_ON_MASS.f90 +++ b/Source/LK4/RENORM_ON_MASS.f90 @@ -29,11 +29,10 @@ SUBROUTINE RENORM_ON_MASS ( NVC, EPS1 ) ! Renormalizes eigenvectors to unit generalized mass USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFL, BLNK_SUB_NAM, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL, SUPINFO, SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : RENORM_ON_MASS_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE EIGEN_MATRICES_1 , ONLY : GEN_MASS, EIGEN_VEC USE MODEL_STUF, ONLY : EIG_NORM, MAXMIJ, MIJ_COL, MIJ_ROW @@ -47,19 +46,14 @@ SUBROUTINE RENORM_ON_MASS ( NVC, EPS1 ) INTEGER(LONG), INTENT(IN) :: NVC ! Number of eigenvectors to be renormalized. INTEGER(LONG) :: I,J ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RENORM_ON_MASS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: EPS1 ! Small number to compare variables against zero REAL(DOUBLE) :: DEN ! Normalizing factor in gen mass matrix normalization INTRINSIC DSQRT,DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF (EIG_NORM /= 'MASS ') THEN @@ -95,12 +89,7 @@ SUBROUTINE RENORM_ON_MASS ( NVC, EPS1 ) GEN_MASS(J) = ONE ! Now reset generalized masses to unity ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK5/BUILD_A_LR.f90 b/Source/LK5/BUILD_A_LR.f90 index cecada4f..acb254c6 100644 --- a/Source/LK5/BUILD_A_LR.f90 +++ b/Source/LK5/BUILD_A_LR.f90 @@ -31,10 +31,9 @@ SUBROUTINE BUILD_A_LR ( COL_NUM ) ! 1) Merge UL and UR to get UA where UL was read into subr LINK5 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFL, NDOFA, NDOFR, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BUILD_A_LR_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : PRTDISP USE COL_VECS, ONLY : UL_COL, UA_COL, UR_COL @@ -50,14 +49,9 @@ SUBROUTINE BUILD_A_LR ( COL_NUM ) INTEGER(LONG) :: A_SET_COL ! Col no. in TDOF for A displ set definition INTEGER(LONG) :: L_SET_COL ! Col no. in TDOF for L displ set definition INTEGER(LONG) :: R_SET_COL ! Col no. in TDOF for R displ set definition - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUILD_A_LR_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Get column numbers for various DOF sets @@ -100,12 +94,7 @@ SUBROUTINE BUILD_A_LR ( COL_NUM ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK5/BUILD_F_AO.f90 b/Source/LK5/BUILD_F_AO.f90 index 8561646e..9e1f811b 100644 --- a/Source/LK5/BUILD_F_AO.f90 +++ b/Source/LK5/BUILD_F_AO.f90 @@ -36,10 +36,8 @@ SUBROUTINE BUILD_F_AO ! 2) Merge UO and UA to get UF USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFA, NDOFF, NDOFO, NTERM_GOA, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BUILD_F_AO_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : PRTDISP USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -57,14 +55,9 @@ SUBROUTINE BUILD_F_AO INTEGER(LONG) :: A_SET_COL ! Col no. in TDOF for A displ set definition INTEGER(LONG) :: O_SET_COL ! Col no. in TDOF for O displ set definition INTEGER(LONG), PARAMETER :: NUMCOLS = 1 ! Variable for number of cols of an array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUILD_F_AO_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Multiply GOA x UA to recover part of UO @@ -113,12 +106,7 @@ SUBROUTINE BUILD_F_AO ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK5/BUILD_G_NM.f90 b/Source/LK5/BUILD_G_NM.f90 index d7641a87..8cedf64c 100644 --- a/Source/LK5/BUILD_G_NM.f90 +++ b/Source/LK5/BUILD_G_NM.f90 @@ -35,10 +35,9 @@ SUBROUTINE BUILD_G_NM ! 2) Merge UM and UN to get UG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFG, NDOFM, NDOFN, NTERM_GMN, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BUILD_G_NM_BEGEND USE CONSTANTS_1, ONLY : ONE USE PARAMS, ONLY : PRTDISP USE SPARSE_MATRICES, ONLY : I_GMN, J_GMN, GMN, SYM_GMN @@ -55,14 +54,9 @@ SUBROUTINE BUILD_G_NM INTEGER(LONG) :: N_SET_COL ! Col no. in TDOF for N displ set definition INTEGER(LONG) :: M_SET_COL ! Col no. in TDOF for M displ set definition INTEGER(LONG), PARAMETER :: NUMCOLS = 1 ! Variable for number of cols of an array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUILD_G_NM_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Recover UM from GMN x UN @@ -108,12 +102,7 @@ SUBROUTINE BUILD_G_NM ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK5/BUILD_N_FS.f90 b/Source/LK5/BUILD_N_FS.f90 index a6064389..95a14313 100644 --- a/Source/LK5/BUILD_N_FS.f90 +++ b/Source/LK5/BUILD_N_FS.f90 @@ -31,10 +31,9 @@ SUBROUTINE BUILD_N_FS ! 1) Merge UF and US to get UN where UF is calc'd in subr BUILD_F_AO USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFF, NDOFN, NDOFS, NDOFSE, NDOFSZ, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BUILD_N_FS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : PRTDISP USE COL_VECS, ONLY : UF_COL, UN_COL, US_COL, YSe @@ -51,16 +50,11 @@ SUBROUTINE BUILD_N_FS INTEGER(LONG) :: S_SET_COL ! Col no. in TDOF for S displ set definition INTEGER(LONG) :: SZ_SET_COL ! Col no. in TDOF for SZ displ set definition INTEGER(LONG) :: SE_SET_COL ! Col no. in TDOF for SE displ set definition - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BUILD_N_FS_BEGEND + REAL(DOUBLE) :: USZ_COL(NDOFSZ) ! Array of zero displs for the SZ set -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Get column numbers for various DOF sets @@ -113,12 +107,7 @@ SUBROUTINE BUILD_N_FS ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK5/EXPAND_PHIXA_TO_PHIXG.f90 b/Source/LK5/EXPAND_PHIXA_TO_PHIXG.f90 index 68395545..8d0a356f 100644 --- a/Source/LK5/EXPAND_PHIXA_TO_PHIXG.f90 +++ b/Source/LK5/EXPAND_PHIXA_TO_PHIXG.f90 @@ -31,37 +31,32 @@ SUBROUTINE EXPAND_PHIXA_TO_PHIXG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ONE - USE IOUNT1, ONLY : ERR, F04, F06, L5B, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, L5B, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, LINKNO, NDOFA, NDOFF, NDOFG, NDOFM, NDOFN, NDOFO, NDOFR, NDOFS, NTERM_PHIXA,& NTERM_PHIXG, NVEC, SOL_NAME - USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC + USE TIMDAT, ONLY : TSEC USE COL_VECS, ONLY : UA_COL, UG_COL USE PARAMS, ONLY : EPSIL, TINY USE DEBUG_PARAMETERS, ONLY : DEBUG USE SPARSE_MATRICES, ONLY : I_PHIXA, J_PHIXA, PHIXA, I_PHIXG, J_PHIXG, PHIXG - USE SUBR_BEGEND_LEVELS, ONLY : EXPAND_PHIXA_TO_PHIXG_BEGEND USE EXPAND_PHIXA_TO_PHIXG_USE_IFs + USE LINK_MESSAGE_Interface + IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'EXPAND_PHIXA_TO_PHIXG' - CHARACTER(54*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER( 1*BYTE) :: NULL_COL ! = 'Y' if col of PHIXA is null INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = EXPAND_PHIXA_TO_PHIXG_BEGEND + REAL(DOUBLE) :: PHIXG_FULL(NDOFG,NDOFR+NVEC) ! ! Full representation of matrix PHIXG before converting to sparse matrix REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Expand PHIXA (cols stored in UA_COL) to G-set columns (UG_COL). Each UG_COL is a column of matrix PHIXG @@ -73,34 +68,27 @@ SUBROUTINE EXPAND_PHIXA_TO_PHIXG ! Build F-set from A and O-set CALL ALLOCATE_COL_VEC ( 'UF_COL' , NDOFF, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'UO_COL' , NDOFO, SUBR_NAME ) - CALL OURTIM - MODNAM = 'BUILD UF DISPLS FROM UA, UO: "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('BUILD UF DISPLS FROM UA, UO: "', J) CALL BUILD_F_AO CALL DEALLOCATE_COL_VEC ( 'UA_COL' ) CALL DEALLOCATE_COL_VEC ( 'UO_COL' ) ! Build N-set from F and S-set CALL ALLOCATE_COL_VEC ( 'UN_COL', NDOFN, SUBR_NAME) CALL ALLOCATE_COL_VEC ( 'US_COL', NDOFS, SUBR_NAME ) - CALL OURTIM - MODNAM = 'BUILD UN DISPLS FROM UF, US: "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('BUILD UN DISPLS FROM UF, US: "',J) CALL BUILD_N_FS CALL DEALLOCATE_COL_VEC ( 'UF_COL' ) CALL DEALLOCATE_COL_VEC ( 'US_COL' ) ! Build G-set from N and M-set CALL ALLOCATE_COL_VEC ( 'UG_COL', NDOFG, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'UM_COL', NDOFM, SUBR_NAME ) - CALL OURTIM - MODNAM = 'BUILD UG DISPLS FROM UN, UM: "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('BUILD UG DISPLS FROM UN, UM: "', J) CALL BUILD_G_NM CALL DEALLOCATE_COL_VEC ( 'UN_COL' ) CALL DEALLOCATE_COL_VEC ( 'UM_COL' ) - CALL OURTIM ! Write UG displs for this subcase to file LINK5A - MODNAM = 'WRITE PHIXG DISPLS TO FILE, "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + ! Write UG displs for this subcase to file LINK5A + CALL LINK_MESSAGE_I('WRITE PHIXG DISPLS TO FILE, "', J) !xx WRITE(SC1, * ) ! Separator between UG_COL calcs DO I=1,NDOFG WRITE(L5B) UG_COL(I) ! For CB this is a col of PHIXG (which is never processed as an array) @@ -121,12 +109,7 @@ SUBROUTINE EXPAND_PHIXA_TO_PHIXG CALL FULL_TO_SPARSE_CRS ( 'PHIXG_FULL', NDOFG, NDOFR+NVEC, PHIXG_FULL, NTERM_PHIXG, SMALL, SUBR_NAME, 'N', & I_PHIXG, J_PHIXG, PHIXG ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -137,8 +120,6 @@ SUBROUTINE EXPAND_PHIXA_TO_PHIXG 102 FORMAT(' *INFORMATION: TERMS WHOSE ABS VALUE ARE < PARAM TINY =',1ES10.3,' ARE NOT INCLUDED IN MATRIX ',A,' IN SUBR ',A & ,/,14X,' AS THIS FULL MATRIX IS BEING CONVERTED TO A SPARSE MATRIX') - 5093 FORMAT(1X,I2,'/',A54,I8,2X,I2,':',I2,':',I2,'.',I3) - 99885 FORMAT(82X,'MATRIX PHIXG',/,82X,'------------') 99886 FORMAT(5X,32676(I14)) diff --git a/Source/LK5/LINK5.f90 b/Source/LK5/LINK5.f90 index cb788036..e38300cd 100644 --- a/Source/LK5/LINK5.f90 +++ b/Source/LK5/LINK5.f90 @@ -32,14 +32,13 @@ SUBROUTINE LINK5 ! In addition, for Craig-Bampton model generation (SOL = GEN CB MODEL or 31), array PHIXA is expanded to G-set size USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, F04, F06, L1H, L2A, L2E, L2F, L3A, L5A, L5B, SC1 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06, L1H, L2A, L2E, L2F, L3A, L5A, L5B, SC1 USE IOUNT1, ONLY : LINK1H, LINK2A, LINK2E, LINK2F, LINK3A, LINK5A, LINK5B USE IOUNT1, ONLY : L1H_MSG, L2A_MSG, L2E_MSG, L2F_MSG, L3A_MSG, L5A_MSG, L5B_MSG USE IOUNT1, ONLY : ERRSTAT, L1HSTAT, L2ESTAT, L2FSTAT, L3ASTAT USE SCONTR, ONLY : BLNK_SUB_NAM, COMM, FATAL_ERR, LINKNO, MBUG, NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, & NDOFN, NDOFO, NDOFR, NDOFS, NDOFSE, NGRID, NSUB, NTERM_GMN, NTERM_GOA, NTERM_PO, & NUM_CB_DOFS, NUM_EIGENS, NVEC, SOL_NAME, WARN_ERR - USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE CONSTANTS_1, ONLY : ZERO, ONE USE PARAMS, ONLY : EIGNORM2, SUPINFO, SUPWARN USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -54,7 +53,8 @@ SUBROUTINE LINK5 USE MODEL_STUF, ONLY : GRID, GRID_ID, INV_GRID_SEQ, EIG_COMP, EIG_GRID, EIG_NORM, MAXMIJ, MIJ_COL, MIJ_ROW USE LINK5_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE LOGICAL :: VEC_SIGN_CHG(NDOFL) ! Indicators of whether user wants to change sign of an eigenvector @@ -66,7 +66,6 @@ SUBROUTINE LINK5 CHARACTER( 1*BYTE) :: DO_IT ! If 'Y' execute some code CHARACTER( 1*BYTE) :: MIJ_COL_FOUND='N' ! 'Y' if MIJ_ROW is processed as a solution vector in this LINK CHARACTER( 1*BYTE) :: MIJ_ROW_FOUND='N' ! 'Y' if MIJ_ROW is processed as a solution vector in this LINK - CHARACTER(54*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER( 1*BYTE) :: READ_NTERM ! 'Y' or 'N' Input to subr READ_MATRIX_1 CHARACTER( 1*BYTE) :: OPND ! Input to subr READ_MATRIX_i. 'Y'/'N' whether to open a file or not CHARACTER( 1*BYTE) :: READ_UO0 ! If 'Y' then read UO0 data from file L2F @@ -121,14 +120,11 @@ SUBROUTINE LINK5 ! Write info to text files WRITE(F06,150) LINKNO - IF (WRT_LOG > 0) THEN - WRITE(F04,150) LINKNO - ENDIF WRITE(ERR,150) LINKNO ! Read LINK1A file - CALL READ_L1A ( 'KEEP', 'Y' ) + CALL READ_L1A ( 'KEEP' ) ! Check COMM for successful completion of prior LINKs IF (SOL_NAME(1:7) == 'STATICS') THEN @@ -207,9 +203,7 @@ SUBROUTINE LINK5 ! ********************************************************************************************************************************** ! Allocate arrays for YSe, GMN, GOA - CALL OURTIM - MODNAM = 'ALLOCATE SEVERAL ARRAYS' - WRITE(SC1,5092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE SEVERAL ARRAYS') CALL ALLOCATE_SPARSE_MAT ( 'GMN', NDOFM, NTERM_GMN, SUBR_NAME ) CALL ALLOCATE_SPARSE_MAT ( 'GOA', NDOFO, NTERM_GOA, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'YSe' , NDOFS, SUBR_NAME ) @@ -218,9 +212,7 @@ SUBROUTINE LINK5 IF (NTERM_GMN > 0) THEN - CALL OURTIM - MODNAM = 'READ GMN MATRIX' - WRITE(SC1,5092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ GMN MATRIX') READ_NTERM = 'Y' OPND = 'N' CLOSE_IT = 'Y' @@ -231,9 +223,7 @@ SUBROUTINE LINK5 ! Read GOA matrix if there are omitted DOFs IF (NTERM_GOA > 0) THEN - CALL OURTIM - MODNAM = 'READ GOA MATRIX' - WRITE(SC1,5092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ GOA MATRIX') READ_NTERM = 'Y' OPND = 'N' CLOSE_IT = 'Y' @@ -250,11 +240,9 @@ SUBROUTINE LINK5 IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'OLD', L1H_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'OLD', L1H_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) - CALL OURTIM - MODNAM = 'READ YSe ENFORCED DISPLACEMENTS' - WRITE(SC1,5092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ YSe ENFORCED DISPLACEMENTS') IERROR = 0 DO I=1,NDOFSE @@ -262,7 +250,7 @@ SUBROUTINE LINK5 IF (IOCHK /= 0) THEN IERROR = IERROR + 1 REC_NO = I - CALL READERR ( IOCHK, LINK1H, L1H_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1H, L1H_MSG, REC_NO, OUNT ) ENDIF ENDDO IF (IERROR /= 0) THEN @@ -273,9 +261,9 @@ SUBROUTINE LINK5 IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN ! ensure L1H survives for the second round - CALL FILE_CLOSE ( L1H, LINK1H, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1H, LINK1H, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1H, LINK1H, L1HSTAT, 'Y' ) + CALL FILE_CLOSE ( L1H, LINK1H, L1HSTAT ) END IF ENDIF @@ -311,18 +299,18 @@ SUBROUTINE LINK5 ! Open file that has L-set displs, or eigenvectors ('MODES') or PHIZL ('GEN CB MODEL') IF (NDOFL > 0) THEN - CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'OLD', L3A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'OLD', L3A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF ! Open file for writing displs to. - CALL FILE_CLOSE ( L5A, LINK5A, 'KEEP', 'Y' ) - CALL FILE_OPEN ( L5A, LINK5A, OUNT, 'REPLACE', L5A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_CLOSE ( L5A, LINK5A, 'KEEP' ) + CALL FILE_OPEN ( L5A, LINK5A, OUNT, 'REPLACE', L5A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ! Open file that has UO0 IF (NTERM_PO > 0) THEN - CALL FILE_OPEN ( L2F, LINK2F, OUNT, 'OLD', L2F_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L2F, LINK2F, OUNT, 'OLD', L2F_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF ! Set NUM_SOLNS for use in loop (below) to get outputs for each subcase/solution vector @@ -425,21 +413,20 @@ SUBROUTINE LINK5 CALL ALLOCATE_COL_VEC ('UL_COL', NDOFL, SUBR_NAME)! Allocate array UL_COL - CALL OURTIM ! Read UL displs for the current subcase/vector from LINK3A + ! Read UL displs for the current subcase/vector from LINK3A IF ((SOL_NAME(1: 7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - MODNAM = 'READ L-SET DISPLACEMENTS Subcase' + CALL LINK_MESSAGE_I('READ L-SET DISPLACEMENTS Subcase', J) ELSE IF (SOL_NAME(1: 5) == 'MODES') THEN - MODNAM = 'READ L-SET EIGENVECTORS Vector' + CALL LINK_MESSAGE_I('READ L-SET EIGENVECTORS Vector', J) ELSE IF (SOL_NAME(1: 8) == 'BUCKLING') THEN IF (LOAD_ISTEP == 1) THEN - MODNAM = 'READ L-SET DISPLACEMENTS Subcase' + CALL LINK_MESSAGE_I('READ L-SET DISPLACEMENTS Subcase', J) ELSE IF (LOAD_ISTEP == 2) THEN - MODNAM = 'READ L-SET EIGENVECTORS Vector' + CALL LINK_MESSAGE_I('READ L-SET EIGENVECTORS Vector', J) ENDIF ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - MODNAM = 'READ L-SET CB VECTORS (PHIZL) CB vec' + CALL LINK_MESSAGE_I('READ L-SET CB VECTORS (PHIZL) CB vec', J) ENDIF - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC REC_NO = 0 IERROR = 0 @@ -447,7 +434,7 @@ SUBROUTINE LINK5 REC_NO = REC_NO + 1 READ(L3A,IOSTAT=IOCHK) UL_COL(I) ! For CB, a col of PHIZL. So UG_COL, calc'd in this subr, is a PHIZG col IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK3A, L3A_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK3A, L3A_MSG, REC_NO, OUNT ) IERROR = IERROR + 1 ENDIF ENDDO @@ -460,9 +447,7 @@ SUBROUTINE LINK5 ! Build UA from UL and UR CALL ALLOCATE_COL_VEC ( 'UA_COL', NDOFA, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'UR_COL', NDOFR, SUBR_NAME ) - CALL OURTIM - MODNAM = 'BUILD UA DISPLS FROM UL, UR: "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('BUILD UA DISPLS FROM UL, UR: "', J) COL_NUM = 0 IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN IF ((J > NDOFR+nvec) .AND. (J <= NUM_CB_DOFS)) THEN @@ -477,22 +462,18 @@ SUBROUTINE LINK5 CALL ALLOCATE_COL_VEC ( 'UF_COL' , NDOFF, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'UO_COL' , NDOFO, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'UO0_COL', NDOFO, SUBR_NAME ) - CALL OURTIM - MODNAM = 'BUILD UF DISPLS FROM UA, UO: "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('BUILD UF DISPLS FROM UA, UO: "', J) IF (READ_UO0 == 'Y') THEN IF (NDOFO > 0) THEN IF (NTERM_PO > 0) THEN - CALL OURTIM - MODNAM = ' READ UO0 DISPLS, "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I(' READ UO0 DISPLS, "', J) IERROR = 0 DO I=1,NDOFO READ(L2F,IOSTAT=IOCHK) UO0_COL(I) IF (IOCHK /= 0) THEN REC_NO = I+1 - CALL READERR ( IOCHK, LINK2F, L2F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK2F, L2F_MSG, REC_NO, OUNT ) IERROR = IERROR + 1 ENDIF ENDDO @@ -515,9 +496,7 @@ SUBROUTINE LINK5 ! Build UN from UF and US CALL ALLOCATE_COL_VEC ( 'UN_COL', NDOFN , SUBR_NAME) CALL ALLOCATE_COL_VEC ( 'US_COL', NDOFS, SUBR_NAME ) - CALL OURTIM - MODNAM = 'BUILD UN DISPLS FROM UF, US: "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('BUILD UN DISPLS FROM UF, US: "', J) CALL BUILD_N_FS CALL DEALLOCATE_COL_VEC ( 'UF_COL' ) CALL DEALLOCATE_COL_VEC ( 'US_COL' ) @@ -525,9 +504,7 @@ SUBROUTINE LINK5 CALL DEALLOCATE_COL_VEC ( 'UG_COL' ) CALL ALLOCATE_COL_VEC ( 'UG_COL', NDOFG, SUBR_NAME ) CALL ALLOCATE_COL_VEC ( 'UM_COL', NDOFM, SUBR_NAME ) - CALL OURTIM - MODNAM = 'BUILD UG DISPLS FROM UN, UM: "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('BUILD UG DISPLS FROM UN, UM: "', J) CALL BUILD_G_NM CALL DEALLOCATE_COL_VEC ( 'UN_COL' ) CALL DEALLOCATE_COL_VEC ( 'UM_COL' ) @@ -591,9 +568,8 @@ SUBROUTINE LINK5 ENDIF ENDIF - CALL OURTIM ! Write UG displs for this subcase to file LINK5A - MODNAM = 'WRITE UG DISPLS TO FILE, "' - WRITE(SC1,5093) LINKNO,MODNAM,J,HOUR,MINUTE,SEC,SFRAC + ! Write UG displs for this subcase to file LINK5A + CALL LINK_MESSAGE_I('WRITE UG DISPLS TO FILE, "', J) WRITE(SC1, * ) ! Separator between UG_COL calcs DO I=1,NDOFG WRITE(L5A) UG_COL(I) ! For CB this is a col of PHIZG (which is never processed as an array) @@ -605,7 +581,7 @@ SUBROUTINE LINK5 IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ! Open file for writing cols of PHIXG - CALL FILE_OPEN ( L5B, LINK5B, OUNT, 'REPLACE', L5B_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L5B, LINK5B, OUNT, 'REPLACE', L5B_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) CALL DEALLOCATE_COL_VEC ( 'UG_COL' ) CALL EXPAND_PHIXA_TO_PHIXG ! Expand PHIXA to PHIXG and write cols to file L5B @@ -623,7 +599,7 @@ SUBROUTINE LINK5 WRITE(F06,99886) (J,J=1,NUM_CB_DOFS) L = 0 DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO K=1,NUM_COMPS L = L + 1 IF (K == 1) THEN @@ -674,23 +650,21 @@ SUBROUTINE LINK5 !xx CLOSE_STAT = L2FSTAT CLOSE_STAT = 'KEEP' ENDIF - CALL FILE_CLOSE ( L2F, LINK2F, CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( L2F, LINK2F, CLOSE_STAT ) IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L3A, LINK3A, L3ASTAT, 'Y' ) + CALL FILE_CLOSE ( L3A, LINK3A, L3ASTAT ) ENDIF - CALL FILE_CLOSE ( L5A, LINK5A, 'KEEP', 'Y' ) - CALL FILE_CLOSE ( L5B, LINK5B, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L5A, LINK5A, 'KEEP' ) + CALL FILE_CLOSE ( L5B, LINK5B, 'KEEP' ) ! Call OUTPUT4 processor to process output requests for OUTPUT4 matrices generated in this link IF (NUM_OU4_REQUESTS > 0) THEN - CALL OURTIM - MODNAM = 'WRITE OUTPUT4 NATRICES ' - WRITE(SC1,5092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE OUTPUT4 NATRICES ') WRITE(F06,*) CALL OUTPUT4_PROC ( SUBR_NAME ) ENDIF @@ -712,7 +686,7 @@ SUBROUTINE LINK5 COMM(LINKNO) = 'C' ! Write data to L1A - CALL WRITE_L1A ( 'KEEP', 'Y', 'Y' ) + CALL WRITE_L1A ( 'KEEP', 'Y' ) ! Check allocation status of allocatable arrays, if requested @@ -723,12 +697,9 @@ SUBROUTINE LINK5 ENDIF ENDIF -! Write LINK5 end to F04, F06 +! Write LINK5 end to F06 CALL OURTIM - IF (WRT_LOG > 0) THEN - WRITE(F04,151) LINKNO - ENDIF WRITE(F06,151) LINKNO ! Close files @@ -756,10 +727,6 @@ SUBROUTINE LINK5 5002 FORMAT(' *ERROR 5002: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,'VARIABLE LOAD_ISTEP MUST BE 1 OR 2 BUT VALUE IS = ',I8) - 5092 FORMAT(1X,I2,'/',A54,8X,2X,I2,':',I2,':',I2,'.',I3) - - 5093 FORMAT(1X,I2,'/',A54,I8,2X,I2,':',I2,':',I2,'.',I3) - 5094 FORMAT(/,' >> LINK',I2,' END',19X,I2,':',I2,':',I2,'.',I3,/) 5101 FORMAT(' *WARNING : THE LARGEST OFF-DIAGONAL GENERALIZED MASS TERM REPORTED IN THE EIGENVALUE ANALYSIS SUMMARY CANNOT BE' & diff --git a/Source/LK5/RENORM.f90 b/Source/LK5/RENORM.f90 index 1eed7c17..c277e81d 100644 --- a/Source/LK5/RENORM.f90 +++ b/Source/LK5/RENORM.f90 @@ -29,11 +29,10 @@ SUBROUTINE RENORM ( VEC_NUM, NORM_GRD, NORM_COMP, NORM, NORM_GSET_DOF, GEN_MASS1 ! Renormalizes eigenves based on NORM = POINT or MAX if requested on Bulk Data entry EIGR or EIGRL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFG, NDOFG, NGRID, WARN_ERR USE PARAMS, ONLY : EPSIL, SUPWARN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : RENORM_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE COL_VECS, ONLY : UG_COL @@ -50,7 +49,7 @@ SUBROUTINE RENORM ( VEC_NUM, NORM_GRD, NORM_COMP, NORM, NORM_GSET_DOF, GEN_MASS1 INTEGER(LONG), INTENT(IN) :: VEC_NUM ! Number used to control an output message (only want this information ! message written if tyhis is the first call to this subr). INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RENORM_BEGEND + REAL(DOUBLE) , INTENT(INOUT) :: GEN_MASS1 ! Generalized mass for 1 eigenvector REAL(DOUBLE) , INTENT(OUT) :: PHI_SCALE_FAC ! Scale factor for the eigenvector to renormalize it @@ -61,12 +60,7 @@ SUBROUTINE RENORM ( VEC_NUM, NORM_GRD, NORM_COMP, NORM, NORM_GSET_DOF, GEN_MASS1 INTRINSIC DSQRT,DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -131,12 +125,7 @@ SUBROUTINE RENORM ( VEC_NUM, NORM_GRD, NORM_COMP, NORM, NORM_GSET_DOF, GEN_MASS1 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/ALLOCATE_L6_2.f90 b/Source/LK6/ALLOCATE_L6_2.f90 index deb4a1d7..4844dd54 100644 --- a/Source/LK6/ALLOCATE_L6_2.f90 +++ b/Source/LK6/ALLOCATE_L6_2.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_L6_2 ( NAME, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NTERM_DLR, NTERM_PHIZL1, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_L6_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_DLR, I2_DLRt, I2_PHIZL1, I2_PHIZL1t USE ALLOCATE_L6_2_USE_IFs @@ -44,14 +43,13 @@ SUBROUTINE ALLOCATE_L6_2 ( NAME, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_L6_2' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows in array INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_L6_2_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -61,12 +59,7 @@ SUBROUTINE ALLOCATE_L6_2 ( NAME, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = ZERO @@ -176,18 +169,7 @@ SUBROUTINE ALLOCATE_L6_2 ( NAME, CALLING_SUBR ) ! ********************************************************************************************************************************** MB_ALLOCATED = (REAL(DOUBLE))*(REAL(NROWS))/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) - - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF + RETURN @@ -203,9 +185,6 @@ SUBROUTINE ALLOCATE_L6_2 ( NAME, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/LK6/CALC_CB_MEFM_MPF.f90 b/Source/LK6/CALC_CB_MEFM_MPF.f90 index 50e8ec6b..d709a2ec 100644 --- a/Source/LK6/CALC_CB_MEFM_MPF.f90 +++ b/Source/LK6/CALC_CB_MEFM_MPF.f90 @@ -39,13 +39,12 @@ SUBROUTINE CALC_CB_MEFM_MPF USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, & NDOFL, NDOFR, NTERM_MPF0 , NVEC USE TIMDAT, ONLY : TSEC USE CONSTANTs_1, ONLY : ZERO, ONE USE PARAMS, ONLY : MPFOUT - USE SUBR_BEGEND_LEVELS, ONLY : CALC_CB_MEFM_MPF_BEGEND USE RIGID_BODY_DISP_MATS, ONLY : TR6_MEFM USE SPARSE_MATRICES, ONLY : I_MPF0 , J_MPF0 , MPF0 , SYM_MPF0 USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1 @@ -59,7 +58,7 @@ SUBROUTINE CALC_CB_MEFM_MPF ! 'N' for nonsymmetric storage) INTEGER(LONG) :: I,J,K ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_CB_MEFM_MPF_BEGEND + REAL(DOUBLE) :: DUM1(NDOFR,6) ! Intermediate matrix REAL(DOUBLE) :: MEFW_MAT_RR(NDOFR,NDOFR)! Modal eff wgt for 1 mode for all R DOF's @@ -69,12 +68,7 @@ SUBROUTINE CALC_CB_MEFM_MPF REAL(DOUBLE) :: MPFi(1,NDOFR) ! i-th row of MPF REAL(DOUBLE) :: MPFit(NDOFR,1) ! MPFi' -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CALL ALLOCATE_EIGEN1_MAT ( 'MEFFMASS', NVEC, 6 , SUBR_NAME ) @@ -127,12 +121,7 @@ SUBROUTINE CALC_CB_MEFM_MPF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/CALC_KRRcb.f90 b/Source/LK6/CALC_KRRcb.f90 index d6ee7e45..ab7b81dc 100644 --- a/Source/LK6/CALC_KRRcb.f90 +++ b/Source/LK6/CALC_KRRcb.f90 @@ -34,7 +34,7 @@ SUBROUTINE CALC_KRRcb USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KRRcb_SDIA, & NDOFL, NDOFR, NTERM_DLR, NTERM_KRL, NTERM_KRR, NTERM_KRRcb, NTERM_KRRcbs USE TIMDAT, ONLY : TSEC @@ -46,7 +46,6 @@ SUBROUTINE CALC_KRRcb I_KRRcb, J_KRRcb, KRRcb, I_KRRcbs, J_KRRcbs, KRRcbs USE SCRATCH_MATRICES USE LAPACK_DPB_MATRICES, ONLY : ABAND - USE SUBR_BEGEND_LEVELS, ONLY : CALC_KRRcb_BEGEND USE CALC_KRRcb_USE_IFs @@ -65,19 +64,14 @@ SUBROUTINE CALC_KRRcb INTEGER(LONG) :: NTERM_CRS1 ! Number of terms in matrix CRS1 INTEGER(LONG) :: NTERM_CRS3 ! Number of terms in matrix CRS3 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_KRRcb_BEGEND + REAL(DOUBLE) :: EQUIL_SCALE_FACS(NDOFR) ! LAPACK_S values returned from subr SYM_MAT_DECOMP_LAPACK REAL(DOUBLE) :: K_INORM ! Inf norm of KRRcb matrix (det in subr COND_NUM) REAL(DOUBLE) :: RCOND ! Recrip of cond no. of the KLL. Det in subr COND_NUM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Calc KRRcb = KRR + KRL*DLR @@ -188,12 +182,7 @@ SUBROUTINE CALC_KRRcb ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/CALC_MRN.f90 b/Source/LK6/CALC_MRN.f90 index 13ad494f..601460ed 100644 --- a/Source/LK6/CALC_MRN.f90 +++ b/Source/LK6/CALC_MRN.f90 @@ -34,7 +34,7 @@ SUBROUTINE CALC_MRN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, & NDOFL, NDOFR, NTERM_DLR, NTERM_MLL, NTERM_MLLn, NTERM_MPF0, NTERM_MRL, NTERM_MRN, & NUM_MLL_DIAG_ZEROS, NVEC @@ -50,7 +50,6 @@ SUBROUTINE CALC_MRN I_MPF0, J_MPF0, MPF0 USE SCRATCH_MATRICES, ONLY : I_CCS1, J_CCS1, CCS1, I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CRS3, J_CRS3, CRS3 - USE SUBR_BEGEND_LEVELS, ONLY : CALC_MRN_BEGEND USE CALC_MRN_USE_IFs @@ -63,14 +62,9 @@ SUBROUTINE CALC_MRN INTEGER(LONG) :: NTERM_CRS1 ! Number of terms in matrix CRS1 INTEGER(LONG) :: NTERM_CRS2 ! Number of terms in matrix CRS2 INTEGER(LONG) :: NTERM_CRS3 ! Number of terms in matrix CRS3 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_MRN_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Calc MRN = (MRL + DLR'*MLL)*EIGEN_VEC @@ -225,12 +219,7 @@ SUBROUTINE CALC_MRN CALL DEALLOCATE_SCR_MAT ( 'CRS1' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/CALC_MRRcb.f90 b/Source/LK6/CALC_MRRcb.f90 index 82517b81..c70aca5c 100644 --- a/Source/LK6/CALC_MRRcb.f90 +++ b/Source/LK6/CALC_MRRcb.f90 @@ -34,7 +34,7 @@ SUBROUTINE CALC_MRRcb USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFL, NDOFR, NTERM_DLR, NTERM_MLL, NTERM_MRL, NTERM_MRR, & NTERM_MRRcb, NTERM_MRRcbn USE TIMDAT, ONLY : TSEC @@ -49,7 +49,6 @@ SUBROUTINE CALC_MRRcb SYM_MRRcb USE SCRATCH_MATRICES - USE SUBR_BEGEND_LEVELS, ONLY : CALC_MRRcb_BEGEND USE CALC_MRRcb_USE_IFs @@ -68,18 +67,13 @@ SUBROUTINE CALC_MRRcb INTEGER(LONG) :: NTERM_CRS2 ! Number of terms in matrix CRS2 INTEGER(LONG) :: NTERM_CRS3 ! Number of terms in matrix CRS3 INTEGER(LONG) :: NUM_MRRcb_DIAG_0 ! Number of zero diagonal terms in MRRcb - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_MRRcb_BEGEND + REAL(DOUBLE) :: DUMR6(NDOFR,6) ! Intermediate matrix ! Full representation of MRRcb REAL(DOUBLE) :: MRRcb_FULL(NDOFR,NDOFR) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Calc MRRcb = MRR + MRL*DLR + (MRL*DLR)' + DLR'*MLL*DLR @@ -314,12 +308,7 @@ SUBROUTINE CALC_MRRcb ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/CALC_PHIZL.f90 b/Source/LK6/CALC_PHIZL.f90 index 234adf01..f04f94c3 100644 --- a/Source/LK6/CALC_PHIZL.f90 +++ b/Source/LK6/CALC_PHIZL.f90 @@ -38,7 +38,7 @@ SUBROUTINE CALC_PHIZL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFL, NDOFR, & NTERM_DLR, NTERM_PHIZL, NTERM_PHIZL1, NTERM_PHIZL2 , NTERM_MLL, NTERM_MLR, NTERM_MRL, & NUM_CB_DOFS, NVEC @@ -54,7 +54,6 @@ SUBROUTINE CALC_PHIZL USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CRS3, J_CRS3, CRS3, I_CCS1, J_CCS1, CCS1 - USE SUBR_BEGEND_LEVELS, ONLY : CALC_PHIZL_BEGEND USE CALC_PHIZL_USE_IFs @@ -67,17 +66,12 @@ SUBROUTINE CALC_PHIZL INTEGER(LONG) :: NTERM_CRS1 ! Number of terms in matrix CRS1 INTEGER(LONG) :: NTERM_CRS2 ! Number of terms in matrix CRS2 INTEGER(LONG) :: NTERM_CRS3 ! Number of terms in matrix CRS3 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_PHIZL_BEGEND + REAL(DOUBLE) :: DUM1(NDOFL,NVEC) ! Intermediate matrix REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Part 1: Calculate PHIZL1 = -KLL(-1)*(MLR + MLL*DLR). Use CRS3 to hold (MLR + MLL*DLR) @@ -214,12 +208,7 @@ SUBROUTINE CALC_PHIZL CALL DEALLOCATE_SPARSE_MAT ( 'PHIZL1' ) CALL DEALLOCATE_SPARSE_MAT ( 'PHIZL2' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/DEALLOCATE_L6_2.f90 b/Source/LK6/DEALLOCATE_L6_2.f90 index 06e9213a..0f01a671 100644 --- a/Source/LK6/DEALLOCATE_L6_2.f90 +++ b/Source/LK6/DEALLOCATE_L6_2.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_L6_2 ( NAME ) ! Deallocate arrays used in LINK6 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_L6_2_BEGEND USE SPARSE_MATRICES, ONLY : I2_DLR, I2_DLRt, I2_PHIZL1, I2_PHIZL1t USE DEALLOCATE_L6_2_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_L6_2 ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_L6_2' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_L6_2_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -126,16 +119,6 @@ SUBROUTINE DEALLOCATE_L6_2 ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -144,10 +127,7 @@ SUBROUTINE DEALLOCATE_L6_2 ( NAME ) ,/,14X,' NAME OF ARRAY TO BE ',A,' IS INCORRECT. INPUT NAME WAS ',A) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/LK6/INTERFACE_FORCE_LTM.f90 b/Source/LK6/INTERFACE_FORCE_LTM.f90 index 66b125ca..a804a246 100644 --- a/Source/LK6/INTERFACE_FORCE_LTM.f90 +++ b/Source/LK6/INTERFACE_FORCE_LTM.f90 @@ -34,7 +34,7 @@ SUBROUTINE INTERFACE_FORCE_LTM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NTERM_KRRcb, NTERM_KRRcbn, NTERM_MRRcbn, NTERM_MRN , & NTERM_IF_LTM , NVEC USE PARAMS, ONLY : PRTIFLTM, SPARSTOR @@ -48,7 +48,6 @@ SUBROUTINE INTERFACE_FORCE_LTM USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1 - USE SUBR_BEGEND_LEVELS, ONLY : INTERFACE_FORCE_LTM_BEGEND USE INTERFACE_FORCE_LTM_USE_IFs @@ -60,15 +59,10 @@ SUBROUTINE INTERFACE_FORCE_LTM INTEGER(LONG) :: NCOL_CRS1 ! Number of cols in scratch matrix CRS1 INTEGER(LONG) :: NTERM_CRS1 ! Number of nonzero terms in scratch matrix CRS1 INTEGER(LONG) :: NUM_KRRcb_DIAG_0 ! Number of zeros on the diagonal of matrix KRRcb - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = INTERFACE_FORCE_LTM_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Set KRRcbn based on SPARSTOR (we need KRRcb in nonsym format since IF_LTM will be nonsym @@ -129,12 +123,7 @@ SUBROUTINE INTERFACE_FORCE_LTM ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/LINK6.f90 b/Source/LK6/LINK6.f90 index bda3f709..e15a5521 100644 --- a/Source/LK6/LINK6.f90 +++ b/Source/LK6/LINK6.f90 @@ -33,7 +33,7 @@ SUBROUTINE LINK6 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, F04, F06, ERRSTAT, MOU4, SC1, & + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06, ERRSTAT, MOU4, SC1, & L2I , L2K , L2L , L2M , L2N , L3A ,OU4, & LINK2I , LINK2K , LINK2L , LINK2M , LINK2N , LINK3A ,OU4FIL, & L2I_MSG, L2K_MSG, L2L_MSG, L2M_MSG, L2N_MSG, L3A_MSG, & @@ -49,7 +49,6 @@ SUBROUTINE LINK6 USE CONSTANTS_1, ONLY : ONE USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : CUSERIN, CUSERIN_XSET, PRTPHIXA, SUPWARN - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC USE MODEL_STUF, ONLY : MEFFMASS_CALC, MPFACTOR_CALC USE EIGEN_MATRICES_1, ONLY : GEN_MASS, EIGEN_VAL, EIGEN_VEC USE OUTPUT4_MATRICES @@ -63,13 +62,13 @@ SUBROUTINE LINK6 I_PHIXA , J_PHIXA , PHIXA USE LINK6_USE_IFs ! Added 2019/07/14 - + USE LINK_MESSAGE_Interface + IMPLICIT NONE CHARACTER, PARAMETER :: CR13 = CHAR(13) ! This causes a carriage return simulating the "+" action in a FORMAT CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'LINK6' CHARACTER( 1*BYTE) :: CLOSE_IT ! Input to subr READ_MATRIX_i. 'Y'/'N' whether to close a file or not - CHARACTER( 44*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER( 1*BYTE) :: READ_NTERM ! 'Y' or 'N' Input to subr READ_MATRIX_1 CHARACTER( 1*BYTE) :: NULL_COL ! = 'Y' if col returned from subr GET_SPARSE_CRS_COL is null CHARACTER( 1*BYTE) :: OPND ! Input to subr READ_MATRIX_i. 'Y'/'N' whether to open a file or not @@ -117,14 +116,11 @@ SUBROUTINE LINK6 ! Write info to text files WRITE(F06,150) LINKNO - IF (WRT_LOG > 0) THEN - WRITE(F04,150) LINKNO - ENDIF WRITE(ERR,150) LINKNO ! Read LINK1A file - CALL READ_L1A ( 'KEEP', 'Y' ) + CALL READ_L1A ( 'KEEP' ) ! Set NUM_CB_DOFS (since it was initialized as 0 in SCONTR and hasn't been calc'd yet, must do this AFTER we call READ_L1A) NUM_CB_DOFS = 2*NDOFR + NVEC @@ -155,9 +151,7 @@ SUBROUTINE LINK6 !xx READ_NTERM = 'Y' !xx OPND = 'N' !xx CLOSE_IT = 'Y' -!xx CALL OURTIM -!xx MODNAM = 'READ KLL STIFFNESS MATRIX ' -!xx WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC +!xx CALL LINK_MESSAGE('READ KLL STIFFNESS MATRIX ') !xx CALL READ_MATRIX_1 ( LINK2G, L2G, OPND, CLOSE_IT, L2GSTAT, L2G_MSG, 'KLL', NTERM_KLL, READ_NTERM, NDOFL & !xx , I_KLL, J_KLL, KLL) !xx ENDIF @@ -171,9 +165,7 @@ SUBROUTINE LINK6 READ_NTERM = 'Y' OPND = 'N' CLOSE_IT = 'Y' - CALL OURTIM - MODNAM = 'READ KRL STIFFNESS MATRIX ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ KRL STIFFNESS MATRIX ') CALL READ_MATRIX_1 ( LINK2K, L2K, OPND, CLOSE_IT, L2KSTAT, L2K_MSG, 'KRL', NTERM_KRL, READ_NTERM, NDOFR & , I_KRL, J_KRL, KRL) ENDIF @@ -187,9 +179,7 @@ SUBROUTINE LINK6 READ_NTERM = 'Y' OPND = 'N' CLOSE_IT = 'Y' - CALL OURTIM - MODNAM = 'READ KRR STIFFNESS MATRIX ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ KRR STIFFNESS MATRIX ') CALL READ_MATRIX_1 ( LINK2L, L2L, OPND, CLOSE_IT, L2LSTAT, L2L_MSG, 'KRR', NTERM_KRR, READ_NTERM, NDOFR & , I_KRR, J_KRR, KRR) ENDIF @@ -203,9 +193,7 @@ SUBROUTINE LINK6 !xx READ_NTERM = 'Y' !xx OPND = 'N' !xx CLOSE_IT = 'Y' -!xx CALL OURTIM -!xx MODNAM = 'READ MLL MASS MATRIX ' -!xx WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC +!xx CALL LINK_MESSAGE('READ MLL MASS MATRIX ') !xx CALL READ_MATRIX_1 ( LINK2I, L2I, OPND, CLOSE_IT, 'KEEP', L2I_MSG, 'MLL', NTERM_MLL, READ_NTERM, NDOFL & !xx , I_MLL, J_MLL, MLL) !xx ENDIF @@ -219,9 +207,7 @@ SUBROUTINE LINK6 READ_NTERM = 'Y' OPND = 'N' CLOSE_IT = 'Y' - CALL OURTIM - MODNAM = 'READ MRL MASS MATRIX ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ MRL MASS MATRIX ') CALL READ_MATRIX_1 ( LINK2M, L2M, OPND, CLOSE_IT, L2MSTAT, L2M_MSG, 'MRL', NTERM_MRL, READ_NTERM, NDOFR & , I_MRL, J_MRL, MRL) ENDIF @@ -235,30 +221,26 @@ SUBROUTINE LINK6 READ_NTERM = 'Y' OPND = 'N' CLOSE_IT = 'Y' - CALL OURTIM - MODNAM = 'READ MRR MASS MATRIX ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ MRR MASS MATRIX ') CALL READ_MATRIX_1 ( LINK2N, L2N, OPND, CLOSE_IT, L2NSTAT, L2N_MSG, 'MRR', NTERM_MRR, READ_NTERM, NDOFR & , I_MRR, J_MRR, MRR) ENDIF ! Open file that has L-set eigenvectors and read them - CALL OURTIM - CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'OLD', L3A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) - MODNAM = 'READ EIGENVECTORS FROM FILE' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'OLD', L3A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) + CALL LINK_MESSAGE('READ EIGENVECTORS FROM FILE') CALL ALLOCATE_EIGEN1_MAT ( 'EIGEN_VEC', NDOFL, NVEC, SUBR_NAME ) DO J=1,NVEC DO I=1,NDOFL READ(L3A,IOSTAT=IOCHK) EIGEN_VEC(I,J) IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK3A, L3A_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK3A, L3A_MSG, REC_NO, OUNT ) IERROR = IERROR + 1 ENDIF ENDDO ENDDO - CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP' ) IF (IERROR > 0) THEN CALL OUTA_HERE ( 'Y' ) @@ -266,9 +248,7 @@ SUBROUTINE LINK6 ! Solve for DLR - CALL OURTIM - MODNAM = 'SOLVE FOR DLR ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('SOLVE FOR DLR ') IF ((NTERM_KLL > 0) .AND. (NTERM_KRL > 0)) THEN CALL SOLVE_DLR ELSE @@ -296,9 +276,7 @@ SUBROUTINE LINK6 CALL PARTITION_VEC ( NDOFA, 'A ', 'L ', 'R ', PART_VEC_A_LR ) NTERM_PHIXA = NDOFR + NTERM_DLR + NDOFL*NVEC CALL ALLOCATE_SPARSE_MAT ( 'PHIXA', NDOFA, NTERM_PHIXA, 'LINK6' ) - CALL OURTIM - MODNAM = 'MERGE MATRICES INTO PHIXA ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('MERGE MATRICES INTO PHIXA ') CALL MERGE_PHIXA ( PART_VEC_A_LR ) IF (PRTPHIXA > 0) THEN CALL WRITE_SPARSE_CRS ( 'PHIXA','A ',' ', NTERM_PHIXA, NDOFA, I_PHIXA, J_PHIXA, PHIXA ) @@ -309,56 +287,40 @@ SUBROUTINE LINK6 ! Calculate L-set PHIZL (cols are L-set CB vecs that will be written to L3A for LINK5 processing to G-set size) - CALL OURTIM - MODNAM = 'CALC DISPLACEMENT PHIZL ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC DISPLACEMENT PHIZL ') CALL CALC_PHIZL ! Calc KXX, the CB stiffness matrix (with DOF's: R-set displs and modal DOF's) - CALL OURTIM - MODNAM = 'CALC KRRcb ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC KRRcb ') CALL CALC_KRRcb - CALL OURTIM - MODNAM = 'MERGE MATRICES INTO KXX ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('MERGE MATRICES INTO KXX ') CALL MERGE_KXX ! Calc MXX, the CB mass matrix (with DOF's: R-set displs and modal DOF's) - CALL OURTIM - MODNAM = 'CALC MRRcb ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC MRRcb ') CALL CALC_MRRcb - CALL OURTIM - MODNAM = 'CALC MRN ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC MRN ') CALL CALC_MRN !xx WRITE(SC1, * ) WRITE(SC1,12345,ADVANCE='NO') ' Deallocate DLRt ', CR13 CALL DEALLOCATE_SPARSE_MAT ( 'DLRt' ) - CALL OURTIM - MODNAM = 'MERGE MATRICES INTO MXX ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('MERGE MATRICES INTO MXX ') CALL MERGE_MXX ! Calculate LTM for interface forces - CALL OURTIM - MODNAM = 'CALC INTERFACE FORCES ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC INTERFACE FORCES ') CALL INTERFACE_FORCE_LTM ! Calculate LTM for net CG accels - CALL OURTIM - MODNAM = 'CALC NET CG LOADS ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC NET CG LOADS ') CALL NET_CG_LOADS_LTM !xx WRITE(SC1, * ) @@ -367,17 +329,13 @@ SUBROUTINE LINK6 ! Merge CG_LTM and IF_LTM into overall LTM - CALL OURTIM - MODNAM = 'MERGE LTM ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('MERGE LTM ') CALL MERGE_LTM ! Rewind L3A and write PHIZL to it and then close L3A - CALL OURTIM - MODNAM = 'WRITE L-set PHIZL to FILE' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC - CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'OLD', L3A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL LINK_MESSAGE('WRITE L-set PHIZL to FILE') + CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'OLD', L3A_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) NUM_SOLNS = NUM_CB_DOFS DO I=1,NUM_SOLNS CALL GET_SPARSE_CRS_COL ( 'PHIZL', I, NTERM_PHIZL, NDOFL, NUM_SOLNS, I_PHIZL, J_PHIZL, PHIZL, ONE, PHIZL_COL, NULL_COL ) @@ -385,23 +343,19 @@ SUBROUTINE LINK6 WRITE(L3A) PHIZL_COL(J) ENDDO ENDDO - CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L3A, LINK3A, 'KEEP' ) ! Calc modal participation factors and modal mass IF ((MEFFMASS_CALC == 'Y') .OR. (MPFACTOR_CALC == 'Y')) THEN - CALL OURTIM - MODNAM = 'CALC MPF AND MEFFMASS' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC MPF AND MEFFMASS') CALL CALC_CB_MEFM_MPF ENDIF ! Call OUTPUT4 processor to process output requests for OUTPUT4 matrices generated in this link IF (NUM_OU4_REQUESTS > 0) THEN - CALL OURTIM - MODNAM = 'WRITE OUTPUT4 NATRICES ' - WRITE(SC1,6092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE OUTPUT4 NATRICES ') WRITE(F06,*) CALL OUTPUT4_PROC ( SUBR_NAME ) ENDIF @@ -453,7 +407,7 @@ SUBROUTINE LINK6 ! Write data to L1A - CALL WRITE_L1A ( 'KEEP', 'Y', 'Y' ) + CALL WRITE_L1A ( 'KEEP', 'Y' ) ! Check allocation status of allocatable arrays, if requested IF (DEBUG(100) > 0) THEN @@ -463,12 +417,9 @@ SUBROUTINE LINK6 ENDIF ENDIF -! Write LINK6 end to F04, F06 +! Write LINK6 end to F06 CALL OURTIM - IF (WRT_LOG > 0) THEN - WRITE(F04,151) LINKNO - ENDIF WRITE(F06,151) LINKNO ! Close files @@ -492,8 +443,6 @@ SUBROUTINE LINK6 290 FORMAT(23X,5A) - 6092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 6888 FORMAT(' *WARNING : PARAMETER CUSERIN_XSET WAS READ FROM THE B.D. PARAM CUSERIN ENTRY AS "',A,'". IT HAS BEEN RESET TO' & ,/,14X,'"R " FOR THIS CB MODEL GENERATION RUN') diff --git a/Source/LK6/MERGE_KXX.f90 b/Source/LK6/MERGE_KXX.f90 index e66c39bc..bf7c89a9 100644 --- a/Source/LK6/MERGE_KXX.f90 +++ b/Source/LK6/MERGE_KXX.f90 @@ -38,13 +38,12 @@ SUBROUTINE MERGE_KXX USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFR, NTERM_KRRcb, NTERM_KXX , NVEC USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : PRTKXX USE EIGEN_MATRICES_1, ONLY : GEN_MASS, EIGEN_VAL USE SPARSE_MATRICES , ONLY : I_KRRcb, J_KRRcb, KRRcb, I_KXX , J_KXX , KXX - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_KXX_BEGEND USE MERGE_KXX_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE MERGE_KXX INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: K ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_KXX_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** NTERM_KXX = NTERM_KRRcb + NVEC @@ -89,12 +83,7 @@ SUBROUTINE MERGE_KXX CALL WRITE_SPARSE_CRS ( 'KXX ',' ',' ', NTERM_KXX , NDOFR+NVEC, I_KXX , J_KXX , KXX ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/MERGE_LTM.f90 b/Source/LK6/MERGE_LTM.f90 index 16450095..a6ca259d 100644 --- a/Source/LK6/MERGE_LTM.f90 +++ b/Source/LK6/MERGE_LTM.f90 @@ -37,11 +37,10 @@ SUBROUTINE MERGE_LTM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NTERM_CG_LTM, NTERM_IF_LTM, NTERM_LTM, NUM_CB_DOFS USE TIMDAT, ONLY : TSEC USE SPARSE_MATRICES, ONLY : I_CG_LTM, J_CG_LTM, CG_LTM, I_IF_LTM, J_IF_LTM, IF_LTM, I_LTM, J_LTM, LTM - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_LTM_BEGEND USE MERGE_LTM_USE_IFs @@ -51,14 +50,9 @@ SUBROUTINE MERGE_LTM INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: LTM_MERGE_VEC(6+NDOFR) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_LTM_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Merge CG_LTM rows with rows ofIF_LTM into LTM @@ -77,12 +71,7 @@ SUBROUTINE MERGE_LTM CALL MERGE_MAT_ROWS_SSS ( 'CG_LTM', 6 , NTERM_CG_LTM, I_CG_LTM, J_CG_LTM, CG_LTM, 1, & 'IF_LTM', NDOFR, NTERM_IF_LTM, I_IF_LTM, J_IF_LTM, IF_LTM, 2, LTM_MERGE_VEC, & 'LTM' , I_LTM , J_LTM , LTM ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/MERGE_MXX.f90 b/Source/LK6/MERGE_MXX.f90 index c1a11b58..5a5d97df 100644 --- a/Source/LK6/MERGE_MXX.f90 +++ b/Source/LK6/MERGE_MXX.f90 @@ -37,7 +37,7 @@ SUBROUTINE MERGE_MXX USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NVEC, NTERM_MRRcb, NTERM_MRRcbn, NTERM_MRN, NTERM_MXX, & NTERM_MXXn USE TIMDAT, ONLY : TSEC @@ -46,7 +46,6 @@ SUBROUTINE MERGE_MXX USE SPARSE_MATRICES, ONLY : SYM_MRRcbn, SYM_MRN , SYM_MXX , SYM_MXXn USE SPARSE_MATRICES, ONLY : I_MRRcb, J_MRRcb, MRRcb, I_MRRcbn, J_MRRcbn, MRRcbn, I_MRN , J_MRN , MRN , & I_MXX , J_MXX , MXX , I_MXXn , J_MXXn , MXXn - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_MXX_BEGEND USE MERGE_MXX_USE_IFs @@ -69,19 +68,14 @@ SUBROUTINE MERGE_MXX INTEGER(LONG) :: NTERM_MXXa ! INTEGER(LONG) :: NTERM_MXXb ! !xx INTEGER(LONG) :: NUM_MNR_IN_ROW_I ! Number of terms in row i of MNR - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_MXX_BEGEND + REAL(DOUBLE) :: GEN_MASS2(NVEC) REAL(DOUBLE) :: MNR(NTERM_MRN) REAL(DOUBLE) :: MXXa(NTERM_MRRcbn+NTERM_MRN) REAL(DOUBLE) :: MXXb(NTERM_MRN+NVEC) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** NTERM_MNR = NTERM_MRN @@ -207,12 +201,7 @@ SUBROUTINE MERGE_MXX CALL WRITE_SPARSE_CRS ( 'MXX ',' ',' ', NTERM_MXX , NDOFR+NVEC, I_MXX , J_MXX , MXX ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/MERGE_PHIXA.f90 b/Source/LK6/MERGE_PHIXA.f90 index 32bc61e4..2a6075a3 100644 --- a/Source/LK6/MERGE_PHIXA.f90 +++ b/Source/LK6/MERGE_PHIXA.f90 @@ -37,13 +37,12 @@ SUBROUTINE MERGE_PHIXA ( PART_VEC_A_LR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, NDOFR, NVEC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE EIGEN_MATRICES_1, ONLY : EIGEN_VEC USE SPARSE_MATRICES, ONLY : I_DLR , J_DLR , DLR , I_IRR , J_IRR , IRR , I_PHIXA, J_PHIXA, PHIXA - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_PHIXA_BEGEND USE MERGE_PHIXA_USE_IFs ! Added 2019/07/14 @@ -63,14 +62,9 @@ SUBROUTINE MERGE_PHIXA ( PART_VEC_A_LR ) INTEGER(LONG) :: ROW_NUM_DLR ! Row number in matrix DLR INTEGER(LONG) :: ROW_NUM_EV ! Row number in matrix EIGEN_VEC (L-set eigenvectors) INTEGER(LONG) :: ROW_NUM_IRR ! Row number in matrix IRR (R-set identity matrix) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_PHIXA_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ROW_NUM_DLR = 0 @@ -118,12 +112,7 @@ SUBROUTINE MERGE_PHIXA ( PART_VEC_A_LR ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/NET_CG_LOADS_LTM.f90 b/Source/LK6/NET_CG_LOADS_LTM.f90 index e55f4366..35fdb637 100644 --- a/Source/LK6/NET_CG_LOADS_LTM.f90 +++ b/Source/LK6/NET_CG_LOADS_LTM.f90 @@ -34,7 +34,7 @@ SUBROUTINE NET_CG_LOADS_LTM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFR, NTERM_MRRcbn, NTERM_MRN, NTERM_CG_LTM, NUM_CB_DOFS USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE @@ -48,7 +48,6 @@ SUBROUTINE NET_CG_LOADS_LTM USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CCS1, J_CCS1, CCS1 - USE SUBR_BEGEND_LEVELS, ONLY : NET_CG_LOADS_LTM_BEGEND USE NET_CG_LOADS_LTM_USE_IFs @@ -62,7 +61,7 @@ SUBROUTINE NET_CG_LOADS_LTM INTEGER(LONG) :: NTERM_CCS1 ! Number of nonzero terms in scratch matrix CCS1 INTEGER(LONG) :: NTERM_CRS1 ! Number of nonzero terms in scratch matrix CRS1 INTEGER(LONG) :: NTERM_CRS2 ! Number of nonzero terms in scratch matrix CRS2 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = NET_CG_LOADS_LTM_BEGEND + REAL(DOUBLE) :: DUM1(NDOFR,6) ! MRRcbn*TR6_CG REAL(DOUBLE) :: DUM2(6,NDOFR) ! @@ -72,12 +71,7 @@ SUBROUTINE NET_CG_LOADS_LTM REAL(DOUBLE) :: SMALL ! A number used in filtering out small numbers from a full matrix REAL(DOUBLE) :: TR6_CGt(6,NDOFR) ! TR6_CG' -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -203,12 +197,7 @@ SUBROUTINE NET_CG_LOADS_LTM CALL WRITE_SPARSE_CRS ( 'CG_LTM',' ',' ', NTERM_CG_LTM, NDOFR, I_CG_LTM, J_CG_LTM, CG_LTM ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/SOLVE_DLR.f90 b/Source/LK6/SOLVE_DLR.f90 index ebf45f7b..54d9c989 100644 --- a/Source/LK6/SOLVE_DLR.f90 +++ b/Source/LK6/SOLVE_DLR.f90 @@ -32,12 +32,11 @@ SUBROUTINE SOLVE_DLR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, SCR + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, SCR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KLL_SDIA, NDOFR, NDOFL, NTERM_DLR, NTERM_KLL, & NTERM_KRL USE PARAMS, ONLY : EPSIL, PRTDLR, SOLLIB, SPARSE_FLAVOR, SPARSTOR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_DLR_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE SPARSE_MATRICES, ONLY : I2_DLR, I_DLR, J_DLR, DLR, I_DLRt, I2_DLRt, J_DLRt, DLRt, I_KRL, J_KRL, KRL, & I_KLL, I2_KLL, J_KLL, KLL @@ -66,7 +65,7 @@ SUBROUTINE SOLVE_DLR INTEGER(LONG) :: INFO = 0 ! Info on success of factorization or solve INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening a file INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_DLR_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero @@ -80,12 +79,7 @@ SUBROUTINE SOLVE_DLR INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -151,8 +145,8 @@ SUBROUTINE SOLVE_DLR SCRFIL(1:9) = 'SCRATCH-991' OPEN (SCR(1),STATUS='SCRATCH',FORM='UNFORMATTED',ACTION='READWRITE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SCRFIL, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL OPNERR ( IOCHK, SCRFIL, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Can't open scratch file, so quit ENDIF @@ -245,7 +239,7 @@ SUBROUTINE SOLVE_DLR CALL MATTRNSP_SS ( NDOFR, NDOFL, NTERM_DLR, 'DLRt', I_DLRt, J_DLRt, DLRt, 'DLR', I_DLR, J_DLR, DLR ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) ! Print out constraint matrix DLR, if requested @@ -255,12 +249,7 @@ SUBROUTINE SOLVE_DLR ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK6/SOLVE_PHIZL1.f90 b/Source/LK6/SOLVE_PHIZL1.f90 index cb826e09..90dcc17f 100644 --- a/Source/LK6/SOLVE_PHIZL1.f90 +++ b/Source/LK6/SOLVE_PHIZL1.f90 @@ -33,12 +33,11 @@ SUBROUTINE SOLVE_PHIZL1 ( NTERM_CRS3 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, SCR + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, SCR USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, KLL_SDIA, NDOFR, NDOFL, NTERM_DLR, & NTERM_PHIZL1, NTERM_KLL, NTERM_KLLs USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE PARAMS, ONLY : EPSIL, SOLLIB, SPARSE_FLAVOR, SPARSTOR - USE SUBR_BEGEND_LEVELS, ONLY : SOLVE_PHIZL1_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE SCRATCH_MATRICES, ONLY : I_CRS3, J_CRS3, CRS3 USE SPARSE_MATRICES, ONLY : I2_PHIZL1, I_PHIZL1, J_PHIZL1, PHIZL1, I2_PHIZL1t, I_PHIZL1t, J_PHIZL1t, PHIZL1t, & @@ -69,7 +68,7 @@ SUBROUTINE SOLVE_PHIZL1 ( NTERM_CRS3 ) INTEGER(LONG) :: INFO = 0 ! Input value for subr SYM_MAT_DECOMP_LAPACK (quit on sing KRRCB) INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening a file INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLVE_PHIZL1_BEGEND + REAL(DOUBLE) :: EPS1 ! A small number to compare real zero @@ -83,12 +82,7 @@ SUBROUTINE SOLVE_PHIZL1 ( NTERM_CRS3 ) INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -106,8 +100,8 @@ SUBROUTINE SOLVE_PHIZL1 ( NTERM_CRS3 ) SCRFIL(1:9) = 'SCRATCH-991' OPEN (SCR(1),STATUS='SCRATCH',FORM='UNFORMATTED',ACTION='READWRITE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, SCRFIL, OUNT, 'Y' ) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL OPNERR ( IOCHK, SCRFIL, OUNT ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) CALL OUTA_HERE ( 'Y' ) ! Can't open scratch file, so quit ENDIF @@ -201,14 +195,9 @@ SUBROUTINE SOLVE_PHIZL1 ( NTERM_CRS3 ) CALL MATTRNSP_SS ( NDOFR, NDOFL, NTERM_PHIZL1, 'PHIZL1t', I_PHIZL1t, J_PHIZL1t, PHIZL1t, 'PHIZL1', I_PHIZL1, J_PHIZL1, PHIZL1) - CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( SCR(1), SCRFIL, 'DELETE' ) + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/LK9/L91/BAR_MARGIN.f90 b/Source/LK9/L91/BAR_MARGIN.f90 index 8ba250c8..d7149098 100644 --- a/Source/LK9/L91/BAR_MARGIN.f90 +++ b/Source/LK9/L91/BAR_MARGIN.f90 @@ -29,10 +29,9 @@ SUBROUTINE BAR_MARGIN ( ICOL, S1, S2, S3, S4, S5, MS1, MS2, MS3, MSP1, MSP2, MSP ! Calculates margins of safety for BAR element USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BAR_MARGIN_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, ONEPM6, ONEPM15, ONEPP10 USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : ULT_STRE @@ -47,7 +46,7 @@ SUBROUTINE BAR_MARGIN ( ICOL, S1, S2, S3, S4, S5, MS1, MS2, MS3, MSP1, MSP2, MSP CHARACTER(LEN=*), INTENT(OUT) :: MSP3 ! If '1', print margins in F06 file. If '0', do not print. INTEGER(LONG), INTENT(IN) :: ICOL ! Column no. from ULT_STRE to get max allow. stresses - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BAR_MARGIN_BEGEND + REAL(DOUBLE), INTENT(OUT) :: MS1 ! Calculated margin of safety REAL(DOUBLE), INTENT(OUT) :: MS2 ! Calculated margin of safety @@ -74,12 +73,7 @@ SUBROUTINE BAR_MARGIN ( ICOL, S1, S2, S3, S4, S5, MS1, MS2, MS3, MSP1, MSP2, MSP INTRINSIC :: DABS, DMIN1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS5 = EPSIL(5) @@ -205,12 +199,7 @@ SUBROUTINE BAR_MARGIN ( ICOL, S1, S2, S3, S4, S5, MS1, MS2, MS3, MSP1, MSP2, MSP MSP3 = '0' ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/GET_MAX_MIN_ABS_STR.f90 b/Source/LK9/L91/GET_MAX_MIN_ABS_STR.f90 index 7467b8ab..08013705 100644 --- a/Source/LK9/L91/GET_MAX_MIN_ABS_STR.f90 +++ b/Source/LK9/L91/GET_MAX_MIN_ABS_STR.f90 @@ -30,12 +30,10 @@ SUBROUTINE GET_MAX_MIN_ABS_STR ( NUM_ROWS, NUM_COLS, SECOND_LINE, MAX_ANS, MIN_A USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM - USE IOUNT1, ONLY : F04, WRT_LOG USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM USE LINK9_STUFF, ONLY : OGEL - USE SUBR_BEGEND_LEVELS, ONLY : GET_MAX_MIN_ABS_STR_BEGEND USE GET_MAX_MIN_ABS_STR_USE_IFs ! Added 2019/07/14 @@ -47,7 +45,7 @@ SUBROUTINE GET_MAX_MIN_ABS_STR ( NUM_ROWS, NUM_COLS, SECOND_LINE, MAX_ANS, MIN_A INTEGER(LONG) , INTENT(IN) :: NUM_ROWS ! Number of stress or strain rows in OGEL INTEGER(LONG) , INTENT(IN) :: NUM_COLS ! Number of MAX, MIN, ABS to calc (number of cols in OGEL) INTEGER(LONG) :: I,J,K ! DO loop indices or counters - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_MAX_MIN_ABS_STR_BEGEND + REAL(DOUBLE) , INTENT(OUT) :: ABS_ANS(NUM_COLS) ! Max ABS for all grids output for each of the 6 disp components REAL(DOUBLE) , INTENT(OUT) :: MAX_ANS(NUM_COLS) ! Max for all grids output for each of the 6 disp components @@ -55,12 +53,7 @@ SUBROUTINE GET_MAX_MIN_ABS_STR ( NUM_ROWS, NUM_COLS, SECOND_LINE, MAX_ANS, MIN_A INTRINSIC :: MAX, MIN, DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO J=1,NUM_COLS @@ -119,12 +112,7 @@ SUBROUTINE GET_MAX_MIN_ABS_STR ( NUM_ROWS, NUM_COLS, SECOND_LINE, MAX_ANS, MIN_A ABS_ANS(J) = MAX( DABS(MAX_ANS(J)), DABS(MIN_ANS(J)) ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/PRINCIPAL_2D.f90 b/Source/LK9/L91/PRINCIPAL_2D.f90 index f0aba6a6..7c9f8f06 100644 --- a/Source/LK9/L91/PRINCIPAL_2D.f90 +++ b/Source/LK9/L91/PRINCIPAL_2D.f90 @@ -33,11 +33,10 @@ SUBROUTINE PRINCIPAL_2D ( SX, SY, SXY, ANGLE, SMAJOR, SMINOR, SXYMAX, MEAN, VONM USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, QUARTER, HALF, TWO, ONEPM6, CONV_RAD_DEG - USE SUBR_BEGEND_LEVELS, ONLY : PRINCIPAL_2D_BEGEND USE PRINCIPAL_2D_USE_IFs @@ -45,7 +44,7 @@ SUBROUTINE PRINCIPAL_2D ( SX, SY, SXY, ANGLE, SMAJOR, SMINOR, SXYMAX, MEAN, VONM CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'PRINCIPAL_2D' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRINCIPAL_2D_BEGEND + REAL(DOUBLE), INTENT(IN) :: SX ! Normal x stress or strain REAL(DOUBLE), INTENT(IN) :: SY ! Normal y stress or strain @@ -62,12 +61,7 @@ SUBROUTINE PRINCIPAL_2D ( SX, SY, SXY, ANGLE, SMAJOR, SMINOR, SXYMAX, MEAN, VONM INTRINSIC :: DATAN2, DSQRT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -97,12 +91,7 @@ SUBROUTINE PRINCIPAL_2D ( SX, SY, SXY, ANGLE, SMAJOR, SMINOR, SXYMAX, MEAN, VONM MEAN = HALF*(SMAJOR + SMINOR) VONMISES = DSQRT( SMAJOR*SMAJOR - SMAJOR*SMINOR + SMINOR*SMINOR) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/PRINCIPAL_3D.f90 b/Source/LK9/L91/PRINCIPAL_3D.f90 index 039f91aa..60c36e1a 100644 --- a/Source/LK9/L91/PRINCIPAL_3D.f90 +++ b/Source/LK9/L91/PRINCIPAL_3D.f90 @@ -32,12 +32,11 @@ SUBROUTINE PRINCIPAL_3D ( STR, PRINCIPAL_STR, MEAN, VONMISES, SIG_OCT, TAU_OCT ) ! (b) If STR input vector is strain then outputs are strain USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, HALF, TWO, THREE USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : PRINCIPAL_3D_BEGEND USE PRINCIPAL_3D_USE_IFs @@ -47,7 +46,7 @@ SUBROUTINE PRINCIPAL_3D ( STR, PRINCIPAL_STR, MEAN, VONMISES, SIG_OCT, TAU_OCT ) INTEGER(LONG) :: I,J = 0 ! DO loop indices INTEGER(LONG) :: INFO = 0 ! An output from subr ROOTS_3D, called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRINCIPAL_3D_BEGEND + REAL(DOUBLE), INTENT(IN) :: STR(6) ! Stress or strain vector REAL(DOUBLE), INTENT(OUT) :: MEAN ! Mean stresses or strains @@ -65,12 +64,7 @@ SUBROUTINE PRINCIPAL_3D ( STR, PRINCIPAL_STR, MEAN, VONMISES, SIG_OCT, TAU_OCT ) INTRINSIC :: DABS, DATAN2, DSQRT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx I1 = STR(1) + STR(2) + STR(3) @@ -106,12 +100,7 @@ SUBROUTINE PRINCIPAL_3D ( STR, PRINCIPAL_STR, MEAN, VONMISES, SIG_OCT, TAU_OCT ) TAU_OCT = TWO*DSQRT((TAU12*TAU12 + TAU23*TAU23 + TAU13*TAU13))/THREE MEAN = SIG_OCT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -128,10 +117,9 @@ SUBROUTINE ROOTS_3D ( STR_TENSOR, Q, INFO ) ! Jacobi solution for 3x3 eigenvalue problem used in finding principal moments of inertia USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PRINCIPAL_3D_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE LAPACK_STD_EIG_1 @@ -151,7 +139,7 @@ SUBROUTINE ROOTS_3D ( STR_TENSOR, Q, INFO ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG), PARAMETER :: N = 3 ! Order of matrix STR_TENSOR INTEGER(LONG), PARAMETER :: LWORK = 3*N-1 ! Size of array WORK - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRINCIPAL_3D_BEGEND + 1 + REAL(DOUBLE) , INTENT(INOUT) :: STR_TENSOR(N,N) ! On entry, the stress or strain tensor ! On exit , the principal stresses or strains (if INFO = 0) @@ -168,12 +156,7 @@ SUBROUTINE ROOTS_3D ( STR_TENSOR, Q, INFO ) !xx EXTERNAL :: DGEMM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -234,12 +217,7 @@ SUBROUTINE ROOTS_3D ( STR_TENSOR, Q, INFO ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/ROD_MARGIN.f90 b/Source/LK9/L91/ROD_MARGIN.f90 index 47354240..1f31e5ff 100644 --- a/Source/LK9/L91/ROD_MARGIN.f90 +++ b/Source/LK9/L91/ROD_MARGIN.f90 @@ -29,10 +29,9 @@ SUBROUTINE ROD_MARGIN (ICOL, S1, S2, MS1, MS2, MSP1, MSP2 ) ! Calculates margins of safety for ROD element USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ROD_MARGIN_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, ONEPM6, ONEPP10 USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : ULT_STRE @@ -45,7 +44,7 @@ SUBROUTINE ROD_MARGIN (ICOL, S1, S2, MS1, MS2, MSP1, MSP2 ) CHARACTER(LEN=*), INTENT(OUT) :: MSP1,MSP2 ! If '1', print margins in F06 file. If '0', do not print. INTEGER(LONG), INTENT(IN) :: ICOL ! Column no. from ULT_STRE to get max allow. stresses - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROD_MARGIN_BEGEND + REAL(DOUBLE), INTENT(OUT) :: MS1 ! Calculated margin of safety REAL(DOUBLE), INTENT(OUT) :: MS2 ! Calculated margin of safety @@ -59,12 +58,7 @@ SUBROUTINE ROD_MARGIN (ICOL, S1, S2, MS1, MS2, MSP1, MSP2 ) INTRINSIC :: DABS, DMIN1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS5 = EPSIL(5) @@ -132,12 +126,7 @@ SUBROUTINE ROD_MARGIN (ICOL, S1, S2, MS1, MS2, MSP1, MSP2 ) MSP2 = '0' ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/WRITE_BAR.f90 b/Source/LK9/L91/WRITE_BAR.f90 index 65a0f6c0..248c1e8c 100644 --- a/Source/LK9/L91/WRITE_BAR.f90 +++ b/Source/LK9/L91/WRITE_BAR.f90 @@ -24,19 +24,17 @@ ! End MIT license text. - SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & + SUBROUTINE WRITE_BAR (NUM, FILL_F06, ISUBCASE, ITABLE, & TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE ) + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_F06 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, OP2 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OP2 USE SCONTR, ONLY : BARTOR, BLNK_SUB_NAM, MOGEL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_BAR_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, MAXREQ, MSPRNT, OGEL - USE PARAMS, ONLY : PRTANS USE WRITE_BAR_USE_IFs @@ -45,13 +43,13 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'WRITE_BAR' CHARACTER(LEN=*), INTENT(IN) :: FILL_F06 ! Padding for output format - CHARACTER(LEN=*), INTENT(IN) :: FILL_ANS ! Padding for output format INTEGER(LONG), INTENT(IN) :: ITABLE ! the current op2 subtable, should be -3, -5, ... CHARACTER(LEN=128), INTENT(IN) :: TITLE ! the model TITLE CHARACTER(LEN=128), INTENT(IN) :: SUBTITLE ! the subcase SUBTITLE CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL INTEGER(LONG), INTENT(IN) :: FIELD5_INT_MODE REAL(DOUBLE), INTENT(IN) :: FIELD6_EIGENVALUE + LOGICAL, INTENT(IN) :: WRITE_F06 CHARACTER(133*BYTE) :: BLINE1A ! Result of concatenating char. variables BOUT1, BMS1, BMSF1, BTOR to ! make the 1st line of stress output for a CBAR with torsional stress @@ -81,7 +79,7 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: K ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_BAR_BEGEND + REAL(DOUBLE) :: ABS_ANS(16) ! Max ABS for all grids output for each of the 6 disp components REAL(DOUBLE) :: MAX_ANS(16) ! Max for all grids output for each of the 6 disp components @@ -94,16 +92,11 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & INTEGER(LONG) :: NVALUES ! number of values in the op2 block STRESS_CODE = 1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** - ! Routine for writing output to text files F06 and ANS for BAR element stresses. Up to 2 elements written per line of output. - ! Data is first written to character variables and then that character variable is output the F06 and ANS. + ! Routine for writing output to text file F06 for BAR element stresses. Up to 2 elements written per line of output. + ! Data is first written to character variables and then that character variable is output the F06. ! op2_headers = ['s1a', 's2a', 's3a', 's4a', 'axial', 'smaxa', 'smina', 'MS_tension', ! 's1b', 's2b', 's3b', 's4b', 'smaxb', 'sminb', 'MS_compression'] @@ -190,47 +183,29 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & ENDIF ! Write the two lines of stress output for one element to F06 - WRITE(F06,*) - IF (PRTANS == 'Y') WRITE(ANS,*) + IF (WRITE_F06) WRITE(F06,*) IF (BARTOR == 'Y') THEN BLINE1A = BOUT1//BMS1//BMSF1//BTOR BLINE2A = BOUT2//BMS2//BMSF2//BMS3//BMSF3 - WRITE(F06,9031) BLINE1A - WRITE(F06,9031) BLINE2A - IF (PRTANS == 'Y') THEN - WRITE(ANS,9901) FILL_ANS, EID_OUT_ARRAY(I,1), (OGEL(K-1,J),J=1,9) - WRITE(ANS,9902) FILL_ANS, (OGEL(K,J),J=1,9) - ENDIF + IF (WRITE_F06) WRITE(F06,9031) BLINE1A + IF (WRITE_F06) WRITE(F06,9031) BLINE2A ELSE BLINE1B = BOUT1//BMS1//BMSF1 BLINE2B = BOUT2//BMS2//BMSF2 - WRITE(F06,9031) BLINE1B - WRITE(F06,9031) BLINE2B - IF (PRTANS == 'Y') THEN - WRITE(ANS,9903) FILL_ANS, EID_OUT_ARRAY(I,1), (OGEL(K-1,J),J=1,8) - WRITE(ANS,9904) FILL_ANS, (OGEL(K,J),J=1,8) - ENDIF - ENDIF - - IF (PRTANS == 'Y') THEN + IF (WRITE_F06) WRITE(F06,9031) BLINE1B + IF (WRITE_F06) WRITE(F06,9031) BLINE2B ENDIF ENDDO CALL GET_MAX_MIN_ABS ( 1, 8 ) - WRITE(F06,9108) (MAX_ANS_CHAR(J),J=1,7), MAX_ANS(8), (MAX_ANS_CHAR(J),J=9,15), MAX_ANS(16), & - (MIN_ANS_CHAR(J),J=1,7), MIN_ANS(8), (MIN_ANS_CHAR(J),J=9,15), MIN_ANS(16), & - (ABS_ANS_CHAR(J),J=1,7), ABS_ANS(8), (ABS_ANS_CHAR(J),J=9,15), ABS_ANS(16) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9118) (MAX_ANS(J),J=1,16),(MIN_ANS(J),J=1,16), (ABS_ANS(J),J=1,16) + IF (WRITE_F06) THEN + WRITE(F06,9108) (MAX_ANS_CHAR(J),J=1,7), MAX_ANS(8), (MAX_ANS_CHAR(J),J=9,15), MAX_ANS(16), & + (MIN_ANS_CHAR(J),J=1,7), MIN_ANS(8), (MIN_ANS_CHAR(J),J=9,15), MIN_ANS(16), & + (ABS_ANS_CHAR(J),J=1,7), ABS_ANS(8), (ABS_ANS_CHAR(J),J=9,15), ABS_ANS(16) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -253,16 +228,6 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & 9041 FORMAT(ES14.6) - 9901 FORMAT(A,I8,7(1ES14.6),4X,1ES10.2,2ES14.6) - - 9902 FORMAT(A,8X,7(1ES14.6),4X,1ES10.2,2ES14.6) - - 9903 FORMAT(A,I8,7(1ES14.6),4X,1ES10.2,1ES14.6) - - 9904 FORMAT(A,8X,7(1ES14.6),4X,1ES10.2,1ES14.6) - - - 9108 FORMAT( 1X,' ------------- ------------- ------------- ------------- ------------- ------------- -------------', & ' ---------',/, & 1X,'MAX* : ',7A,1ES10.2,/, & @@ -273,15 +238,6 @@ SUBROUTINE WRITE_BAR (NUM, FILL_F06, FILL_ANS, ISUBCASE, ITABLE, & 1X,'ABS* : ',7A,1ES10.2,/, & 1X,'*for output set') - 9118 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- ------------- -------------',& - ' ---------',/, & - 1X,'MAX (for output set): ',7(1ES14.6),ES14.2,/, & - 1X,'MAX (for output set): ',7(1ES14.6),ES14.2,//, & - 1X,'MIN (for output set): ',7(1ES14.6),ES14.2,/, & - 1X,'MIN (for output set): ',7(1ES14.6),ES14.2,//, & - 1X,'ABS (for output set): ',7(1ES14.6),ES14.2,/, & - 1X,'ABS (for output set): ',7(1ES14.6),ES14.2) - ! ********************************************************************************************************************************** ! ################################################################################################################################## diff --git a/Source/LK9/L91/WRITE_ELEM_ENGR_FORCE.f90 b/Source/LK9/L91/WRITE_ELEM_ENGR_FORCE.f90 index 24152c9a..44e39e52 100644 --- a/Source/LK9/L91/WRITE_ELEM_ENGR_FORCE.f90 +++ b/Source/LK9/L91/WRITE_ELEM_ENGR_FORCE.f90 @@ -30,14 +30,12 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ! subcase. Elements that can have engineering force output are the ones ! enumerated below fin the IF(TYPE == ???) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, OP2 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OP2 USE SCONTR, ONLY : BLNK_SUB_NAM, INT_SC_NUM, NDOFR, NUM_CB_DOFS, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC - USE PARAMS, ONLY : PRTANS USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, GID_OUT_ARRAY, OGEL - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELEM_ENGR_FORCE_BEGEND USE MODEL_STUF, ONLY : ELEM_ONAME, LABEL, SCNUM, STITLE, TITLE, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : FORC_OUT USE WRITE_ELEM_ENGR_FORCE_USE_IFs @@ -58,8 +56,8 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) INTEGER(LONG) :: BDY_DOF_NUM ! DOF number for BDY_GRID/BDY_COMP INTEGER(LONG) :: I,J,J1,K,L ! DO loop indices or counters INTEGER(LONG) :: NUM_TERMS ! Number of terms to write out for shell elems - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELEM_ENGR_FORCE_BEGEND - LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_ANS ! flag + + LOGICAL :: WRITE_F06, WRITE_OP2 ! flag REAL(DOUBLE) :: ABS_ANS(8) ! Max ABS for all element output REAL(DOUBLE) :: MAX_ANS(8) ! Max for all element output @@ -88,12 +86,7 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ! initialize ANALYSIS_CODE = -1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! initialize @@ -112,7 +105,6 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) WRITE_F06 = (FORC_OUT(1:1) == 'Y') WRITE_OP2 = (FORC_OUT(2:2) == 'Y') - WRITE_ANS = (PRTANS == 'Y') headr:IF (IHDR == 'Y') THEN @@ -267,8 +259,6 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ENDIF ! write f06 - IF (WRITE_ANS) CALL FWRITE_ANS ( 'Headers' ) - ENDIF headr ! Write element force output @@ -298,7 +288,6 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ! IF (FORC_OUT(3:3) == 'Y') CALL WRITE_GRD_PCH_OUTPUTS(JVEC, NUM, WHAT) ! pch/punch ! IF (FORC_OUT(4:4) == 'Y') CALL WRITE_GRD_NEU_OUTPUTS(JVEC, NUM, WHAT) ! NEU ! IF (FORC_OUT(5:5) == 'Y') CALL WRITE_GRD_CSV_OUTPUTS(JVEC, NUM, WHAT) ! CSV - IF (WRITE_ANS) CALL FWRITE_ANS ( 'BAR' ) ELSE IF (TYPE(1:4) == 'ELAS') THEN ! Engr force for ELAS was put into OGEL(I,1) @@ -330,7 +319,6 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) WRITE(F06,1203) FILL(1: 0), FILL(1: 0), (MAX_ANS(J),J=1,1), FILL(1: 0), (MIN_ANS(J),J=1,1), FILL(1: 0), & (ABS_ANS(J),J=1,1), FILL(1: 0) ENDIF - IF (WRITE_ANS) CALL FWRITE_ANS ( 'ELAS' ) ELSE IF (TYPE == 'ROD ') THEN IF (WRITE_OP2) THEN ! op2/plot @@ -360,7 +348,6 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) WRITE(F06,1303) FILL(1: 0), FILL(1: 0), (MAX_ANS(J),J=7,8), FILL(1: 0), (MIN_ANS(J),J=7,8), FILL(1: 0), & (ABS_ANS(J),J=7,8), FILL(1: 0) ENDIF - IF (WRITE_ANS) CALL FWRITE_ANS ( 'ROD' ) ELSE IF (TYPE == 'SHEAR ') THEN IF (WRITE_OP2) THEN ! op2/plot @@ -396,7 +383,6 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) WRITE(F06,1403) FILL(1: 0), FILL(1: 0), (MAX_ANS(J),J=1,3), FILL(1: 0), (MIN_ANS(J),J=1,3), FILL(1: 0), & (ABS_ANS(J),J=1,3), FILL(1: 0) ENDIF - IF (WRITE_ANS) CALL FWRITE_ANS ( 'SHEAR' ) ELSE IF ((TYPE == 'TRIA3K ') .OR. (TYPE == 'QUAD4K ')) THEN IF (WRITE_F06) THEN @@ -408,7 +394,6 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) (ABS_ANS(J),J=1,6), FILL(1: 0) ENDIF NUM_TERMS = 6 - IF (WRITE_ANS) CALL FWRITE_ANS ( 'SHELL' ) ELSE IF ((TYPE == 'TRIA3 ') .OR. (TYPE == 'QUAD4 ') .OR. (TYPE == 'QUAD8 ')) THEN IF (WRITE_OP2) THEN @@ -451,7 +436,6 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) (ABS_ANS(J),J=1,8), FILL(1: 0) ENDIF NUM_TERMS = 8 - IF (WRITE_ANS) CALL FWRITE_ANS ( 'SHELL' ) ELSE IF (TYPE(1:4) == 'BUSH') THEN ! Engr force for BUSH was put into OGEL(I,1-6) @@ -473,16 +457,9 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) WRITE(F06,1603) FILL(1: 0), FILL(1: 0), (MAX_ANS(J),J=1,6), FILL(1: 0), (MIN_ANS(J),J=1,6), FILL(1: 0), & (ABS_ANS(J),J=1,6), FILL(1: 0) ENDIF - IF (WRITE_ANS) CALL FWRITE_ANS ( 'BUSH' ) ENDIF -! ********************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -595,202 +572,7 @@ SUBROUTINE WRITE_ELEM_ENGR_FORCE ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ! ********************************************************************************************************************************** CONTAINS - -! ################################################################################################################################## - - SUBROUTINE FWRITE_ANS ( WHICH ) - - USE PENTIUM_II_KIND, ONLY : BYTE - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: WHICH ! Which of the below to write during this call - INTEGER(LONG) :: II,JJ ! DO loop indices or counters - -! ********************************************************************************************************************************** - IF (WHICH == 'Headers') THEN - - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,*) - IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - WRITE(ANS,101) SCNUM(JSUB) - - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN - WRITE(F06,101) SCNUM(JSUB) - - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - WRITE(F06,102) JSUB - - ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - WRITE(ANS,102) JSUB - - ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ! Write info on what CB DOF the output is for - - IF ((JSUB <= NDOFR) .OR. (JSUB >= NDOFR+NVEC)) THEN - IF (JSUB <= NDOFR) THEN - BDY_DOF_NUM = JSUB - ELSE - BDY_DOF_NUM = JSUB-(NDOFR+NVEC) - ENDIF - CALL GET_GRID_AND_COMP ( 'R ', BDY_DOF_NUM, BDY_GRID, BDY_COMP ) - ENDIF - - IF (JSUB <= NDOFR) THEN - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'acceleration', BDY_GRID, BDY_COMP - ELSE IF ((JSUB > NDOFR) .AND. (JSUB <= NDOFR+NVEC)) THEN - WRITE(ANS,104) JSUB, NUM_CB_DOFS, JSUB-NDOFR - ELSE - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'displacement', BDY_GRID, BDY_COMP - ENDIF - - ENDIF - 101 FORMAT(' OUTPUT FOR SUBCASE ',I8) - 102 FORMAT(' OUTPUT FOR EIGENVECTOR ',I8) - 103 FORMAT(' OUTPUT FOR CRAIG-BAMPTON DOF ',I8,' OF ',I8,' (boundary ',A,' for grid',I8,' component',I2,')') - 104 FORMAT(' OUTPUT FOR CRAIG-BAMPTON DOF ',I8,' OF ',I8,' (modal acceleration for mode ',I8,')') - - WRITE(ANS,*) - - IF ((TYPE(1:4) /= 'HEXA') .AND. (TYPE(1:5) /= 'PENTA') .AND. (TYPE(1:5) /= 'TETRA')) THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(ANS,302) FILL(1:16) - ELSE - WRITE(ANS,301) FILL(1:16) - ENDIF - WRITE(ANS,401) FILL(1:16), ONAME - ENDIF - 301 FORMAT(39X,A,'E L E M E N T E N G I N E E R I N G F O R C E S') - 302 FORMAT(33X,A,'C B E L E M E N T E N G I N E E R I N G F O R C E O T M') - 401 FORMAT(44X,A,'F O R E L E M E N T T Y P E ',A11) - - IF (TYPE(1:4) == 'ELAS') THEN - WRITE(ANS,1111) FILL(1:16), FILL(1:16) - 1111 FORMAT(2X,A,'Element Force' & - ,/,2X,A,' ID') - - ELSE IF (TYPE == 'BAR ') THEN - WRITE(ANS,1211) FILL(1:16), FILL(1:16) - - ELSE IF (TYPE == 'ROD ') THEN - WRITE(ANS,1311) FILL(1:16), FILL(1:16) - - ELSE IF (TYPE == 'SHEAR ') THEN - WRITE(ANS,1411) FILL(1:16), FILL(1:16) - - ELSE IF ((TYPE(1:5)== 'TRIA3') .OR. (TYPE(1:5) == 'QUAD4')) THEN - WRITE(ANS,1511) FILL(1:16), FILL(1:16), FILL(1:16) - - ELSE IF (TYPE == 'BUSH ') THEN - WRITE(ANS,1611) FILL(1:16), FILL(1:16) - - ENDIF - - ENDIF - - ELSE IF (WHICH == 'ELAS' ) THEN - WRITE(ANS,1112) FILL(1:16), (EID_OUT_ARRAY(II,1),OGEL(II,1),II=1,NUM) - WRITE(ANS,1113) (MAX_ANS(JJ),JJ=1,1),(MIN_ANS(JJ),JJ=1,1),(ABS_ANS(JJ),JJ=1,1) - 1112 FORMAT(A,5(I8,1ES14.6)) - 1113 FORMAT(11X,' -------------',/, & - 1X,'MAX (for output set): ',1(ES14.6),/, & - 1X,'MIN (for output set): ',1(ES14.6),//, & - 1X,'ABS (for output set): ',1(ES14.6)) - - ELSE IF (WHICH == 'BAR' ) THEN - DO II=1,NUM - WRITE(ANS,1212) FILL(1:16), EID_OUT_ARRAY(II,1),(OGEL(II,JJ),JJ=1,8) - ENDDO - WRITE(ANS,1213) (MAX_ANS(JJ),JJ=1,8),(MIN_ANS(JJ),JJ=1,8),(ABS_ANS(JJ),JJ=1,8) - - ELSE IF (WHICH == 'ROD' ) THEN - WRITE(ANS,1312) (FILL(1:16), EID_OUT_ARRAY(II,1), OGEL(II,7), OGEL(II,8),II=1,NUM) - WRITE(ANS,1313) (MAX_ANS(JJ),JJ=7,8),(MIN_ANS(JJ),JJ=7,8),(ABS_ANS(JJ),JJ=7,8) - - ELSE IF (WHICH == 'SHEAR') THEN - DO II=1,NUM - WRITE(ANS,1412) FILL(1:16), EID_OUT_ARRAY(II,1),(OGEL(II,JJ),JJ=1,3) - ENDDO - WRITE(ANS,1413) (MAX_ANS(JJ),JJ=1,3),(MIN_ANS(JJ),JJ=1,3),(ABS_ANS(JJ),JJ=1,3) - - ELSE IF (WHICH == 'SHELL') THEN - DO II=1,NUM - WRITE(ANS,1512) FILL(1:16), EID_OUT_ARRAY(II,1),(OGEL(II,JJ),JJ=1,NUM_TERMS) - ENDDO - WRITE(ANS,1513) (MAX_ANS(JJ),JJ=1,8),(MIN_ANS(JJ),JJ=1,8),(ABS_ANS(JJ),JJ=1,NUM_TERMS) - - ELSE IF (WHICH == 'BUSH' ) THEN - DO II=1,NUM - WRITE(ANS,1612) FILL(1:16), EID_OUT_ARRAY(II,1),(OGEL(II,JJ),JJ=1,6) - ENDDO - WRITE(ANS,1613) (MAX_ANS(JJ),JJ=1,6),(MIN_ANS(JJ),JJ=1,6),(ABS_ANS(JJ),JJ=1,6) - - ENDIF - - RETURN - -! BAR >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - 1211 FORMAT(2X,A,'Element Bend-Moment End A Bend-Moment End B - Shear - Axial' & - ,' Torque' & - ,/,2X,A,' ID Plane 1 Plane 2 Plane 1 Plane 2 Plane 1 Plane 2 Force') - - 1212 FORMAT(A,I8,8(1ES14.6)) - - 1213 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- ------------- -------------',& - ' -------------',/, & - 1X,'MAX (for output set): ',8(ES14.6),/, & - 1X,'MIN (for output set): ',8(ES14.6),//, & - 1X,'ABS (for output set): ',8(ES14.6)) - -! ROD >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - 1311 FORMAT(2X,A,'Element Axial Torque' & - ,/,2X,A,' ID Force') - - 1312 FORMAT(A,I8,1ES14.6,1ES14.6) - - 1313 FORMAT(11X,' ------------- -------------',/, & - 1X,'MAX (for output set): ',2(ES14.6),/, & - 1X,'MIN (for output set): ',2(ES14.6),//, & - 1X,'ABS (for output set): ',2(ES14.6)) - -! SHEAR >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - 1411 FORMAT(1X,A,' Element N o r m a l F o r c e s' & - ,/,1X,A,' ID Nxx Nyy Nxy') - - 1412 FORMAT(A,40X,I8,3(1ES14.6)) - - 1413 FORMAT(1X,' ------------- ------------- -------------',/, & - 1X,' MAX* : ',3(ES14.6),/, & - 1X,' MIN* : ',3(ES14.6),//, & - 1X,' ABS* : ',3(ES14.6),/, & - 1X,' *for output set') - -! SHELL >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - 1511 FORMAT(2X,A,'Element N o r m a l F o r c e s M o m e n t s' & - ,19X,'T r a n s v e r s e',/,A,95x,'S h e a r F o r c e s' & - ,/,2X,A,' ID Nxx Nyy Nxy Mxx Myy Mxy Qx ' & - ,' Qy') - - 1512 FORMAT(A,I8,8(1ES14.6)) - - 1513 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- ------------- -------------',& - ' -------------',/, & - 1X,'MAX (for output set): ',8(ES14.6),/, & - 1X,'MIN (for output set): ',8(ES14.6),//, & - 1X,'ABS (for output set): ',8(ES14.6)) - -! BUSH >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - 1611 FORMAT(1X,A,' Element Force Force Force Force Force Force' & - ,/,1X,A,' ID TX TY TZ RX RY RZ') - - 1612 FORMAT(A,I8,6(1ES14.6)) - - 1613 FORMAT(1X,' ------------- ------------- ------------- ------------- ------------- ------------- ',/, & - 1X,'MAX (for output set): ',6(ES14.6),/, & - 1X,'MIN (for output set): ',6(ES14.6),//, & - 1X,'ABS (for output set): ',6(ES14.6)) - -! ********************************************************************************************************************************** - END SUBROUTINE FWRITE_ANS ! ################################################################################################################################## diff --git a/Source/LK9/L91/WRITE_ELEM_NODE_FORCE.f90 b/Source/LK9/L91/WRITE_ELEM_NODE_FORCE.f90 index 0f208e43..c7d1ac3a 100644 --- a/Source/LK9/L91/WRITE_ELEM_NODE_FORCE.f90 +++ b/Source/LK9/L91/WRITE_ELEM_NODE_FORCE.f90 @@ -29,13 +29,12 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) ! Writes blocks of elem nodal force output for one elem type, one subcase. All elements can have node force output USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, INT_SC_NUM, NDOFR, NUM_CB_DOFS, MOGEL, NVEC, SOL_NAME - USE PARAMS, ONLY : ELFORCEN, PRTANS + USE PARAMS, ONLY : ELFORCEN USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELEM_NODE_FORCE_BEGEND USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, EID_OUT_ARRAY, MAXREQ, OGEL USE MODEL_STUF, ONLY : ELEM_ONAME, LABEL, SCNUM, STITLE, TITLE USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM @@ -61,18 +60,13 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) INTEGER(LONG) :: BDY_DOF_NUM ! DOF number for BDY_GRID/BDY_COMP INTEGER(LONG) :: I,J,K,M ! DO loop indices INTEGER(LONG) :: L ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELEM_NODE_FORCE_BEGEND + REAL(DOUBLE) :: ABS_ANS(6) ! Max Abs for all grids output for each of the 6 disp components REAL(DOUBLE) :: MAX_ANS(6) ! Max for all grids output for each of the 6 disp components REAL(DOUBLE) :: MIN_ANS(6) ! Min for all grids output for each of the 6 disp components -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Get element output name @@ -146,52 +140,6 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) WRITE(F06,212) ONAME WRITE(F06,213) - IF (PRTANS == 'Y') THEN - WRITE(ANS,*) - WRITE(ANS,*) - IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - - WRITE(ANS,9101) SCNUM(JSUB) - - ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - - WRITE(ANS,9102) JSUB - - ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ! Write info on what CB DOF the output is for - - IF ((JSUB <= NDOFR) .OR. (JSUB >= NDOFR+NVEC)) THEN - IF (JSUB <= NDOFR) THEN - BDY_DOF_NUM = JSUB - ELSE - BDY_DOF_NUM = JSUB-(NDOFR+NVEC) - ENDIF - CALL GET_GRID_AND_COMP ( 'R ', BDY_DOF_NUM, BDY_GRID, BDY_COMP ) - ENDIF - - IF (JSUB <= NDOFR) THEN - WRITE(ANS,9103) JSUB, NUM_CB_DOFS, 'acceleration', BDY_GRID, BDY_COMP - ELSE IF ((JSUB > NDOFR) .AND. (JSUB <= NDOFR+NVEC)) THEN - WRITE(ANS,9105) JSUB, NUM_CB_DOFS, JSUB-NDOFR - ELSE - WRITE(ANS,9103) JSUB, NUM_CB_DOFS, 'displacement', BDY_GRID, BDY_COMP - ENDIF - - ENDIF - - WRITE(ANS,*) - - IF (ELFORCEN == 'LOCAL') THEN - FORCE_COORD_SYS = 'L O C A L' - ELSE IF (ELFORCEN == 'GLOBAL') THEN - FORCE_COORD_SYS = 'G L O B A L' - ELSE IF (ELFORCEN == 'BASIC' ) THEN - FORCE_COORD_SYS = 'B A S I C ' - ENDIF - WRITE(ANS,201) FORCE_COORD_SYS - WRITE(ANS,212) ONAME - WRITE(ANS,213) - ENDIF - ENDIF ! Get MAX, MIN, ABS values @@ -267,22 +215,13 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) IF (J == 1) THEN WRITE(F06,221) EID_OUT_ARRAY(I,1),GID_OUT_ARRAY(I,J),(OGEL_CHAR(K),K=1,6) - IF (PRTANS == 'Y') THEN - WRITE(ANS,291) EID_OUT_ARRAY(I,1),GID_OUT_ARRAY(I,J),(OGEL(L,K),K=1,6) - ENDIF ELSE WRITE(F06,222) GID_OUT_ARRAY(I,J),(OGEL_CHAR(K),K=1,6) - IF (PRTANS == 'Y') THEN - WRITE(ANS,292) GID_OUT_ARRAY(I,J),(OGEL(L,K),K=1,6) - ENDIF ENDIF ENDDO WRITE(F06,*) - IF (PRTANS == 'Y') THEN - WRITE(ANS,*) - ENDIF ENDDO @@ -291,16 +230,8 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) ENDDO WRITE(F06,9111) (MAX_ANS_CHAR(J),J=1,6),(MIN_ANS_CHAR(J),J=1,6),(ABS_ANS_CHAR(J),J=1,6) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9191) (MAX_ANS(J),J=1,6),(MIN_ANS(J),J=1,6),(ABS_ANS (J),J=1,6) - ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -318,10 +249,6 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) 222 FORMAT(16X,I8,6A) - 291 FORMAT(6X,2(1X,I8),6(1ES14.6)) - - 292 FORMAT(16X,I8,6(1ES14.6)) - 9101 FORMAT(' OUTPUT FOR SUBCASE ',I8) 9102 FORMAT(' OUTPUT FOR EIGENVECTOR ',I8) @@ -338,12 +265,6 @@ SUBROUTINE WRITE_ELEM_NODE_FORCE ( JSUB, NUM_ELGP, NUM, IHDR ) 16X,'ABS* : ',6A,/ & 16X,'* for output set') - 9191 FORMAT(12X,' ------------- ------------- ------------- ------------- ------------- -------------',/,& - 1X,'MAX (for output set): ',6(1ES14.6),/, & - 1X,'MIN (for output set): ',6(1ES14.6),//, & - 1X,'ABS (for output set): ',6(1ES14.6)) - - 8001 FORMAT(A1) ! ********************************************************************************************************************************** diff --git a/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 b/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 index 8fb78a6d..01ffb1b6 100644 --- a/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 +++ b/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 @@ -30,15 +30,14 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ! all 2-D, 3-D plus several 1-D elements (i.e. that have strain calculations). USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, OP2 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OP2 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, MAX_NUM_STR, NDOFR, NUM_CB_DOFS, & NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE PARAMS, ONLY : PRTANS, STR_CID + USE PARAMS, ONLY : STR_CID USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELEM_STRAINS_BEGEND USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, GID_OUT_ARRAY, OGEL, POLY_FIT_ERR, POLY_FIT_ERR_INDEX USE MODEL_STUF, ONLY : ELEM_ONAME, ELMTYP, LABEL, SCNUM, STITLE, TITLE, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRN_OPT, STRN_OUT @@ -69,7 +68,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) INTEGER(LONG) :: I,J,L ! DO loop indices INTEGER(LONG) :: K ! Counter INTEGER(LONG) :: NCOLS ! Num of cols to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELEM_STRAINS_BEGEND + REAL(DOUBLE) :: ABS_ANS(11) ! Max ABS for all element output REAL(DOUBLE) :: MAX_ANS(11) ! Max for all element output @@ -83,7 +82,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) INTEGER(LONG) :: ANALYSIS_CODE ! static/modal/time/etc. flag INTEGER(LONG) :: ELEMENT_TYPE ! the OP2 flag for the element LOGICAL :: FIELD_5_INT_FLAG ! flag to trigger FIELD5_INT_MODE vs. FIELD5_FLOAT_TIME_FREQ - LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_ANS ! flag + LOGICAL :: WRITE_F06, WRITE_OP2 ! flag INTEGER(LONG) :: FIELD5_INT_MODE ! int value for field 5 REAL(DOUBLE) :: FIELD5_FLOAT_TIME_FREQ ! float value for field 5 REAL(DOUBLE) :: FIELD6_EIGENVALUE ! float value for field 6 @@ -103,12 +102,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) INTEGER(LONG) :: CID ! coordinate system CHARACTER(4*BYTE) :: CEN_WORD ! the word "CEN/" (we need to cast the length) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -143,13 +137,10 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) FIELD6_EIGENVALUE = 0.0 WRITE_F06 = (STRN_OUT(1:1) == 'Y') WRITE_OP2 = (STRN_OUT(2:2) == 'Y') - WRITE_ANS = (PRTANS == 'Y') IF (IHDR == 'Y') THEN IF (WRITE_F06) WRITE(F06,*) IF (WRITE_F06) WRITE(F06,*) - IF (WRITE_ANS) WRITE(ANS,*) - IF (WRITE_ANS) WRITE(ANS,*) ! -- F06 header: OUTPUT FOR SUBCASE, EIGENVECTOR or CRAIG-BAMPTON DOF ISUBCASE_INDEX = 0 @@ -159,13 +150,11 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) FIELD5_INT_MODE = 1 ! temp FIELD5_INT_MODE = SCNUM(JSUB) IF (WRITE_F06) WRITE(F06,101) SCNUM(JSUB) - IF (WRITE_ANS) WRITE(ANS,101) SCNUM(JSUB) ELSE IF (SOL_NAME(1:8) == 'NLSTATIC') THEN ISUBCASE_INDEX = 1 ! statics ANALYSIS_CODE = 10 FIELD5_INT_MODE = SCNUM(JSUB) IF (WRITE_F06) WRITE(F06,101) SCNUM(JSUB) - IF (WRITE_ANS) WRITE(ANS,101) SCNUM(JSUB) ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN ISUBCASE_INDEX = 1 ! statics @@ -186,7 +175,6 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) FIELD5_INT_MODE = JSUB ! FIELD6_EIGENVALUE = ???? IF (WRITE_F06) WRITE(F06,102) JSUB - IF (WRITE_ANS) WRITE(ANS,102) JSUB ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ISUBCASE_INDEX = 1 ! modes @@ -209,15 +197,6 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ENDIF ENDIF ! write f06 - IF (WRITE_ANS) THEN - IF (JSUB <= NDOFR) THEN - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'acceleration', BDY_GRID, BDY_COMP - ELSE IF ((JSUB > NDOFR) .AND. (JSUB <= NDOFR+NVEC)) THEN - WRITE(ANS,104) JSUB, NUM_CB_DOFS, JSUB-NDOFR - ELSE - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'displacement', BDY_GRID, BDY_COMP - ENDIF - ENDIF ! write ans ENDIF ISUBCASE = SCNUM(ISUBCASE_INDEX) @@ -238,120 +217,89 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) IF (LABEL(INT_SC_NUM)(1:) /= ' ') THEN WRITE(F06,201) LABEL(INT_SC_NUM) ENDIF - ENDIF - IF (WRITE_F06) WRITE(F06,*) - IF (WRITE_ANS) WRITE(ANS,*) + WRITE(F06,*) - ! -- F06 1st 2 header lines for strain output description - IF (.TRUE.) THEN ! f06/print + ! -- F06 1st 2 header lines for strain output description IF (TYPE(1:4) == 'ELAS') THEN IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) + WRITE(F06,302) FILL(1: 20) ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 11) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 27) + WRITE(F06,301) FILL(1: 11) ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 40), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 56), ONAME + WRITE(F06,401) FILL(1: 40), ONAME ELSE IF ((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN IF (STRN_OPT == 'VONMISES') THEN IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN IF(STR_CID == -2) THEN - IF (WRITE_F06) WRITE(F06,312) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,312) FILL(1: 20) + WRITE(F06,312) FILL(1: 20) ELSE - IF (WRITE_F06) WRITE(F06,302) FILL(1: 15) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 15) + WRITE(F06,302) FILL(1: 15) ENDIF - ELSE + ELSE IF(STR_CID == -2) THEN - IF (WRITE_F06) WRITE(F06,311) FILL(1: 32) - IF (WRITE_ANS) WRITE(ANS,311) FILL(1: 32) + WRITE(F06,311) FILL(1: 32) ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 27) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 27) + WRITE(F06,301) FILL(1: 27) ENDIF - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 55), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 55), ONAME + ENDIF + WRITE(F06,401) FILL(1: 55), ONAME ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN IF(STR_CID == -2) THEN - IF (WRITE_F06) WRITE(F06,312) FILL(1: 27) - IF (WRITE_ANS) WRITE(ANS,312) FILL(1: 27) + WRITE(F06,312) FILL(1: 27) ELSE - IF (WRITE_F06) WRITE(F06,302) FILL(1: 22) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 22) + WRITE(F06,302) FILL(1: 22) ENDIF ELSE IF(STR_CID == -2) THEN - IF (WRITE_F06) WRITE(F06,311) FILL(1: 38) - IF (WRITE_ANS) WRITE(ANS,311) FILL(1: 38) + WRITE(F06,311) FILL(1: 38) ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 33) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 33) + WRITE(F06,301) FILL(1: 33) ENDIF ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 61), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 61), ONAME - ENDIF + WRITE(F06,401) FILL(1: 61), ONAME + ENDIF ELSE IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 20) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 42) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 42) - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 71), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 71), ONAME + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 42) + ENDIF + WRITE(F06,401) FILL(1: 71), ONAME ELSE IF (TYPE(1:3) == 'ROD') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 13) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 29) - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 42), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 58), ONAME + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 13) + ENDIF + WRITE(F06,401) FILL(1: 42), ONAME ELSE IF (TYPE(1:5) == 'SHEAR') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 13) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 52) - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 42), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 81), ONAME + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 13) + ENDIF + WRITE(F06,401) FILL(1: 42), ONAME ELSE IF (TYPE(1:5) == 'TRIA3') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 36) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 52) - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 65), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 81), ONAME + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 36) + ENDIF + WRITE(F06,401) FILL(1: 65), ONAME ELSE IF (TYPE(1:4) == 'BUSH') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 0) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 10) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 52) - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 39), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 81), ONAME + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 0) + ELSE + WRITE(F06,301) FILL(1: 10) + ENDIF + WRITE(F06,401) FILL(1: 39), ONAME ELSE WRITE(ERR,9300) SUBR_NAME,TYPE WRITE(F06,9300) SUBR_NAME,TYPE @@ -360,57 +308,49 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ENDIF ! element types - header ! -- F06 header lines describing strain columns - IF (TYPE(1:4) == 'ELAS') THEN - IF (WRITE_F06) WRITE(F06,1201) FILL(1:1), FILL(1:1) - IF (WRITE_ANS) WRITE(ANS,1201) FILL(1:16), FILL(1:16) - - ELSE IF((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN - IF (STRN_OPT == 'VONMISES') THEN - IF (WRITE_F06) WRITE(F06,1301) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1301) FILL(1:16), FILL(1:16) - ELSE - IF (WRITE_F06) WRITE(F06,1302) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1302) FILL(1:16), FILL(1:16) - ENDIF + IF (TYPE(1:4) == 'ELAS') THEN + WRITE(F06,1201) FILL(1:1), FILL(1:1) + ELSE IF((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN + IF (STRN_OPT == 'VONMISES') THEN + WRITE(F06,1301) FILL(1: 1), FILL(1: 1) + ELSE + WRITE(F06,1302) FILL(1: 1), FILL(1: 1) + ENDIF + ELSE IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN + IF (STRN_OPT == 'VONMISES') THEN + WRITE(F06,1401) FILL(1: 1), FILL(1: 1), FILL(1: 1) + ELSE + WRITE(F06,1402) FILL(1: 1), FILL(1: 1) + ENDIF - ELSE IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN - IF (STRN_OPT == 'VONMISES') THEN - IF (WRITE_F06) WRITE(F06,1401) FILL(1: 1), FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1401) FILL(1:16), FILL(1:16), FILL(1:16) - ELSE - IF (WRITE_F06) WRITE(F06,1402) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1402) FILL(1:16), FILL(1:16) + ELSE IF (TYPE == 'ROD ') THEN + WRITE(F06,1501) FILL(1: 1), FILL(1: 1) + + ELSE IF (TYPE(1:5) == 'SHEAR') THEN + WRITE(F06,1601) FILL(1: 1), FILL(1: 1) + ELSE IF (TYPE(1:5) == 'TRIA3') THEN + IF (STRN_OPT == 'VONMISES') THEN + WRITE(F06,1701) FILL(1: 1), FILL(1: 1), FILL(1: 1) + ELSE + WRITE(F06,1702) FILL(1: 1), FILL(1: 1) + ENDIF + + ELSE IF (TYPE == 'BUSH ') THEN + WRITE(F06,1801) FILL(1: 1), FILL(1: 1) + + ELSE IF (TYPE == 'USERIN ') THEN + WRITE(F06,1901) FILL(1: 1), FILL(1: 1) + ELSE + WRITE(ERR,9300) SUBR_NAME,TYPE + WRITE(F06,9300) SUBR_NAME,TYPE + FATAL_ERR = FATAL_ERR + 1 + CALL OUTA_HERE ( 'Y' ) ! Coding error (elem type not valid) , so quit ENDIF - ELSE IF (TYPE == 'ROD ') THEN - IF (WRITE_F06) WRITE(F06,1501) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1501) FILL(1:16), FILL(1:16) - - ELSE IF (TYPE(1:5) == 'SHEAR') THEN - IF (WRITE_F06) WRITE(F06,1601) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1601) FILL(1:16), FILL(1:16), FILL(1:16) - ELSE IF (TYPE(1:5) == 'TRIA3') THEN - IF (STRN_OPT == 'VONMISES') THEN - IF (WRITE_F06) WRITE(F06,1701) FILL(1: 1), FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1701) FILL(1:16), FILL(1:16), FILL(1:16) - ELSE - IF (WRITE_F06) WRITE(F06,1702) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1702) FILL(1:16), FILL(1:16) - ENDIF - ELSE IF (TYPE == 'BUSH ') THEN - IF (WRITE_F06) WRITE(F06,1801) FILL(1: 1), FILL(1: 1) + ENDIF ! write f06 - ELSE IF (TYPE == 'USERIN ') THEN - WRITE(F06,1901) FILL(1: 1), FILL(1: 1) - ELSE - WRITE(ERR,9300) SUBR_NAME,TYPE - WRITE(F06,9300) SUBR_NAME,TYPE - FATAL_ERR = FATAL_ERR + 1 - CALL OUTA_HERE ( 'Y' ) ! Coding error (elem type not valid) , so quit - ENDIF - ENDIF - ENDIF ! write f06/ans + ENDIF ! Write the element strain output !IF (TYPE == 'BAR ') THEN @@ -435,11 +375,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ENDIF ! end of op2 WRITE(F06,1103) (FILL(1:1), EID_OUT_ARRAY(I,1), OGEL(I,1),I=1,NUM) - - IF (WRITE_ANS) THEN - WRITE(ANS,1104) (FILL(1:16), EID_OUT_ARRAY(I,1),OGEL(I,1),I=1,NUM) - ENDIF - + ELSE IF((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN ! 12345 @@ -525,14 +461,8 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) IF (STRN_OPT == 'VONMISES') THEN WRITE(F06,1304) (MAX_ANS(J),J=1,7), (MIN_ANS(J),J=1,7), (ABS_ANS(J),J=1,7) - IF (WRITE_ANS) THEN - WRITE(ANS,1314) (MAX_ANS(J),J=1,7), (MIN_ANS(J),J=1,7), (ABS_ANS(J),J=1,7) - ENDIF ELSE WRITE(F06,1305) (MAX_ANS(J),J=1,8), (MIN_ANS(J),J=1,8), (ABS_ANS(J),J=1,8) - IF (WRITE_ANS) THEN - WRITE(ANS,1315) (MAX_ANS(J),J=1,8), (MIN_ANS(J),J=1,8), (ABS_ANS(J),J=1,8) - ENDIF ENDIF ELSE IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN @@ -594,122 +524,95 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ENDIF ENDIF ! write op2 - !IF(WRITE_F06 .OR. WRITE_ANS) THEN - K = 0 - DO I=1,NUM,NUM_PTS - 4 FORMAT(' *DEBUG: WRITE_CQUAD4-144: I=',I4, " K=", I4) - K = K + 1 - WRITE(ERR,4) I,K - WRITE(F06,*) - WRITE(F06,1403) FILL(1: 0), EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,10) - - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,1413) EID_OUT_ARRAY(I,1), (OGEL(K,J),J=1,10) - ENDIF - K = K + 1 - WRITE(F06,1404) FILL(1: 0), (OGEL(K,J),J=1,8) - IF (WRITE_ANS) WRITE(ANS,1414) (OGEL(K,J),J=1,8) + !IF(WRITE_F06) THEN + K = 0 + DO I=1,NUM,NUM_PTS + 4 FORMAT(' *DEBUG: WRITE_CQUAD4-144: I=',I4, " K=", I4) + K = K + 1 + WRITE(ERR,4) I,K + WRITE(F06,*) + WRITE(F06,1403) FILL(1: 0), EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,10) - DO L=1,NUM_PTS-1 - K = K + 1 - WRITE(ERR,4) I,K + K = K + 1 + WRITE(F06,1404) FILL(1: 0), (OGEL(K,J),J=1,8) - WRITE(F06,*) - IF (DABS(POLY_FIT_ERR(I+L)) >= 0.01D0) THEN - WRITE(F06,1405) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L), POLY_FIT_ERR_INDEX(I+L) - WRT_ERR_INDEX_NOTE(POLY_FIT_ERR_INDEX(I+L)) = 'Y' - ELSE - WRITE(F06,1406) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L) + DO L=1,NUM_PTS-1 + K = K + 1 + WRITE(ERR,4) I,K + + WRITE(F06,*) + IF (DABS(POLY_FIT_ERR(I+L)) >= 0.01D0) THEN + WRITE(F06,1405) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L), POLY_FIT_ERR_INDEX(I+L) + WRT_ERR_INDEX_NOTE(POLY_FIT_ERR_INDEX(I+L)) = 'Y' + ELSE + WRITE(F06,1406) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L) + ENDIF + + K = K + 1 + WRITE(F06,1407) FILL(1: 0), (OGEL(K,J),J=1,8) + ENDDO + ENDDO ! num_pts + + CALL GET_MAX_MIN_ABS_STR ( NUM, 10, 'Y', MAX_ANS, MIN_ANS, ABS_ANS ) + + ! Get max POLY_FIT_ERR + MAX_ANS(11) = ZERO + K = 0 + DO I=1,NUM + K = K + 1 + IF (POLY_FIT_ERR(I) > MAX_ANS(11)) THEN + MAX_ANS(11) = POLY_FIT_ERR(I) ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,1415) GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), & - POLY_FIT_ERR(I+L), POLY_FIT_ERR_INDEX(I+L) - ENDIF - - K = K + 1 - WRITE(F06,1407) FILL(1: 0), (OGEL(K,J),J=1,8) - IF (WRITE_ANS) WRITE(ANS,1417) (OGEL(K,J),J=1,8) - ENDDO - ENDDO ! num_pts - - CALL GET_MAX_MIN_ABS_STR ( NUM, 10, 'Y', MAX_ANS, MIN_ANS, ABS_ANS ) - - ! Get max POLY_FIT_ERR - MAX_ANS(11) = ZERO - K = 0 - DO I=1,NUM - K = K + 1 - IF (POLY_FIT_ERR(I) > MAX_ANS(11)) THEN - MAX_ANS(11) = POLY_FIT_ERR(I) - ENDIF - K = K + 1 - ENDDO - MIN_ANS(11) = MAX_ANS(11) - - ! Get min POLY_FIT_ERR - K = 0 - DO I=1,NUM - K = K + 1 - IF (POLY_FIT_ERR(I) < MIN_ANS(11)) THEN - MIN_ANS(11) = POLY_FIT_ERR(I) - ENDIF - K = K + 1 - ENDDO + K = K + 1 + ENDDO + MIN_ANS(11) = MAX_ANS(11) - ! Get abs POLY_FIT_ERR - ABS_ANS(11) = MAX( DABS(MAX_ANS(11)), DABS(MIN_ANS(11)) ) + ! Get min POLY_FIT_ERR + K = 0 + DO I=1,NUM + K = K + 1 + IF (POLY_FIT_ERR(I) < MIN_ANS(11)) THEN + MIN_ANS(11) = POLY_FIT_ERR(I) + ENDIF + K = K + 1 + ENDDO - IF ((STRN_LOC == 'CORNER ') .OR. (TYPE(1:5) == 'QUAD8')) THEN - WRITE(F06,1408) FILL(1: 0), FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8), & + ! Get abs POLY_FIT_ERR + ABS_ANS(11) = MAX( DABS(MAX_ANS(11)), DABS(MIN_ANS(11)) ) + + IF ((STRN_LOC == 'CORNER ') .OR. (TYPE(1:5) == 'QUAD8')) THEN + WRITE(F06,1408) FILL(1: 0), FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8), & MAX_ANS(9), MAX_ANS(10),MAX_ANS(11), & FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8), & MIN_ANS(9),MIN_ANS(10),MIN_ANS(11), & FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8), & ABS_ANS(9),ABS_ANS(10),ABS_ANS(11), FILL(1: 0) - ELSE - WRITE(F06,1408) FILL(1: 0), FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8), & + ELSE + WRITE(F06,1408) FILL(1: 0), FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8), & MAX_ANS(9),MAX_ANS(10),MAX_ANS(11), & FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8), & MIN_ANS(9),MIN_ANS(10),MIN_ANS(11), & FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8), & ABS_ANS(9),ABS_ANS(10),ABS_ANS(11), FILL(1: 0) - ENDIF + ENDIF - IF (WRITE_ANS) THEN - IF ((STRN_LOC == 'CORNER ') .OR. (TYPE(1:5) == 'QUAD8')) THEN - WRITE(ANS,1418)MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & - MAX_ANS(10),MAX_ANS(11), & - MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & - MIN_ANS(10),MIN_ANS(11), & - ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & - ABS_ANS(10) - ELSE - WRITE(ANS,1418)MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & - MAX_ANS(10),MAX_ANS(11), & - MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & - MIN_ANS(10),MIN_ANS(11), & - ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & - ABS_ANS(10),ABS_ANS(11) + WRITE_NOTES = 'N' + DO I=1,MAX_NUM_STR + IF (WRT_ERR_INDEX_NOTE(I) == 'Y') THEN + WRITE_NOTES = 'Y' ENDIF - ENDIF ! write ans + ENDDO + + IF (WRITE_NOTES == 'Y') THEN + WRITE(F06,1498) + DO I=1,MAX_NUM_STR + IF (WRT_ERR_INDEX_NOTE(I) == 'Y') THEN + WRITE(F06,1499) ERR_INDEX_NOTE(I) + ENDIF + ENDDO + ENDIF + - WRITE_NOTES = 'N' - DO I=1,MAX_NUM_STR - IF (WRT_ERR_INDEX_NOTE(I) == 'Y') THEN - WRITE_NOTES = 'Y' - ENDIF - ENDDO - - IF (WRITE_NOTES == 'Y') THEN - WRITE(F06,1498) - DO I=1,MAX_NUM_STR - IF (WRT_ERR_INDEX_NOTE(I) == 'Y') THEN - WRITE(F06,1499) ERR_INDEX_NOTE(I) - ENDIF - ENDDO - ENDIF ELSE IF (TYPE == 'ROD ') THEN CALL WRITE_ROD (ISUBCASE, NUM, FILL(1:1), FILL(1:16), ITABLE, TITLEI, STITLEI, LABELI, & @@ -718,12 +621,12 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ELSE IF (TYPE(1:5) == 'SHEAR') THEN CALL WRITE_OST_CSHEAR (NUM, FILL, ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, & - WRITE_F06, WRITE_OP2, WRITE_ANS) + WRITE_F06, WRITE_OP2) ELSE IF (TYPE(1:5) == 'TRIA3') THEN CALL WRITE_OST_CTRIA3 (NUM, FILL, ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, & - WRITE_F06, WRITE_OP2, WRITE_ANS) + WRITE_F06, WRITE_OP2) ELSE IF (TYPE == 'BUSH ') THEN IF (WRITE_OP2) THEN @@ -743,13 +646,11 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) DO I=1,NUM WRITE(F06,1802) EID_OUT_ARRAY(I,1),(OGEL(I,J),J=1,6) - IF (WRITE_ANS) WRITE(ANS,1812) EID_OUT_ARRAY(I,1),(OGEL(I,J),J=1,6) ENDDO ELSE IF (TYPE == 'USERIN ') THEN DO I=1,NUM WRITE(F06,1902) EID_OUT_ARRAY(I,1),(OGEL(I,J),J=1,6) - IF (WRITE_ANS) WRITE(ANS,1912) EID_OUT_ARRAY(I,1),(OGEL(I,J),J=1,6) ENDDO ELSE @@ -759,12 +660,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) CALL OUTA_HERE ( 'Y' ) ! Coding error (elem type not valid) , so quit ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -809,8 +705,6 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) 1103 FORMAT(5(A,I8,1ES14.6)) - 1104 FORMAT(A,I8,1ES14.6) - ! 3D Elems >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1301 FORMAT(1X,A,' Elem Location Epsilon-xx Epsilon-yy Epsilon-zz Gamma-xy Gamma-yz Gamma-zx ', & ' von Mises' & @@ -850,21 +744,6 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) 1306 FORMAT(1X,A,10X,'GRD',I8,5X,8(1ES14.6)) - 1313 FORMAT(16X,I8,8(1ES14.6)) - - 1314 FORMAT(28X,'------------- ------------- ------------- ------------- ------------- ------------- -------------',/, & - 1X,'MAX (for output set): ',7(ES14.6),/, & - 1X,'MIN (for output set): ',7(ES14.6),//, & - 1X,'ABS (for output set): ',7(ES14.6),/, & - 1X,'*for output set') - - 1315 FORMAT(28X,'------------- ------------- ------------- ------------- ------------- ------------- -------------', & - ' -------------',/, & - 1X,'MAX (for output set): ',8(ES14.6),/, & - 1X,'MIN (for output set): ',8(ES14.6),//, & - 1X,'ABS (for output set): ',8(ES14.6),/, & - 1X,'*for output set') - ! QUAD4 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1401 FORMAT(1X,A,'Elem Location Fibre Strains In Element Coord System Principal Strains (Zero Shear)', & ' Transverse Transverse % Poly',/,1X,A, & @@ -893,20 +772,6 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) 1X,A,'ABS* : ',25x,3(ES13.5),8X,5(ES13.5),E9.1,/, & 1X,A,'*for output set') - 1413 FORMAT(1X,I8,2X,'CENTER ',5X,4(1ES14.6),0PF14.3,5(1ES14.6)) - - 1414 FORMAT(9X,15X,4(1ES14.6),0PF14.3,3(1ES14.6)) - - 1415 FORMAT(21X,'GRID',I8,1X,4(1ES14.6),0PF9.3,5(1ES14.6),F13.2,'% (',I1,')') - - 1417 FORMAT(9X,15X,4(1ES14.6),0PF9.3,3(1ES14.6)) - - 1418 FORMAT(39X,'------------- ------------- ------------- ------------- ------------- ------------- -------------',& - ' ------------- -------------',/, & - 1X,'MAX (for output set): ',15X,3(ES14.6),14X,5(ES14.6),F14.2,/, & - 1X,'MIN (for output set): ',15X,3(ES14.6),14X,5(ES14.6),F14.2,//, & - 1X,'ABS (for output set): ',15X,3(ES14.6),14X,5(ES14.6),F14.2) - 1498 FORMAT(' NOTE: Explanation of errors in the polynomial fit to extrapolate element corner point strains from values at the', & ' Gauss points:') @@ -945,31 +810,18 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) 1X,'ABS* : ',28x,3(ES13.5),9X,5(ES13.5),/, & 1X,'*for output set') - 1713 FORMAT(1X,I8,4X,'Anywhere',3X,4(1ES14.6),0PF14.3,5(1ES14.6)) - - 1714 FORMAT(13X,'in elem',4X,4(1ES14.6),0PF14.3,5(1ES14.6)) - - 1715 FORMAT(39X,'------------- ------------- ------------- ------------- ------------- ------------- ---------',/, & - 1X,'MAX (for output set): ',15X,3(ES14.6),14X,5(ES14.6),/, & - 1X,'MIN (for output set): ',15X,3(ES14.6),14X,5(ES14.6),//, & - 1X,'ABS (for output set): ',15X,3(ES14.6),14X,5(ES14.6),/) - ! BUSH >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1801 FORMAT(20X,A,'Element Strain-1 Strain-2 Strain-3 Strain-4 Strain-5 Strain-6' & ,/,20X,A,' ID') 1802 FORMAT(19X,I8,6(1ES14.6)) - 1812 FORMAT(16X,I8,6(1ES14.6)) - ! USERIN >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1901 FORMAT(20X,A,'Element Strain-1 Strain-2 Strain-3 Strain-4 Strain-5 Strain-6' & ,/,20X,A,' ID') 1902 FORMAT(19X,I8,6(1ES14.6)) - 1912 FORMAT(19X,I8,6(1ES14.6)) - ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 9300 FORMAT(' *ERROR 9300: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,' NO OUTPUT FORMAT AVAILABLE FOR ELEMENT TYPE = ',A) @@ -980,7 +832,7 @@ END SUBROUTINE WRITE_ELEM_STRAINS SUBROUTINE WRITE_OST_CSHEAR(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, & - WRITE_F06, WRITE_OP2, WRITE_ANS) + WRITE_F06, WRITE_OP2) ! TODO: calculate margin ! USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE @@ -995,7 +847,7 @@ SUBROUTINE WRITE_OST_CSHEAR(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, CHARACTER(LEN=128), INTENT(IN) :: TITLE ! the model TITLE CHARACTER(LEN=128), INTENT(IN) :: SUBTITLE ! the subcase SUBTITLE CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL - LOGICAL, INTENT(IN) :: WRITE_F06, WRITE_OP2, WRITE_ANS + LOGICAL, INTENT(IN) :: WRITE_F06, WRITE_OP2 INTEGER(LONG), INTENT(INOUT) :: ITABLE ! the current subtable number CHARACTER(119*BYTE) :: FILL ! Padding for output format @@ -1083,9 +935,9 @@ END SUBROUTINE WRITE_OST_CSHEAR !============================================================================== SUBROUTINE WRITE_OST_CTRIA3(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, & - WRITE_F06, WRITE_OP2, WRITE_ANS) + WRITE_F06, WRITE_OP2) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ANS, ERR, F06, OP2 + USE IOUNT1, ONLY : ERR, F06, OP2 USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, OGEL USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -1095,7 +947,7 @@ SUBROUTINE WRITE_OST_CTRIA3(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, CHARACTER(LEN=128), INTENT(IN) :: TITLE ! the model TITLE CHARACTER(LEN=128), INTENT(IN) :: SUBTITLE ! the subcase SUBTITLE CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL - LOGICAL, INTENT(IN) :: WRITE_F06, WRITE_OP2, WRITE_ANS + LOGICAL, INTENT(IN) :: WRITE_F06, WRITE_OP2 CHARACTER(119*BYTE) :: FILL ! Padding for output format @@ -1151,26 +1003,16 @@ SUBROUTINE WRITE_OST_CTRIA3(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, 1X,'ABS* : ',28x,3(ES13.5),9X,5(ES13.5),/, & 1X,'*for output set') - 1713 FORMAT(1X,I8,4X,'Anywhere',3X,4(1ES14.6),0PF14.3,5(1ES14.6)) - 1714 FORMAT(13X,'in elem',4X,4(1ES14.6),0PF14.3,5(1ES14.6)) - 1715 FORMAT(39X,'------------- ------------- ------------- ------------- ------------- ------------- ---------',/, & - 1X,'MAX (for output set): ',15X,3(ES14.6),14X,5(ES14.6),/, & - 1X,'MIN (for output set): ',15X,3(ES14.6),14X,5(ES14.6),//, & - 1X,'ABS (for output set): ',15X,3(ES14.6),14X,5(ES14.6),/) - IF(.TRUE.) THEN DO I=1,NUM K = K + 1 WRITE(F06,*) - IF (WRITE_ANS) WRITE(ANS,*) ! the J=1,10 loop is the upper layer & 2 transverse shear WRITE(F06,1703) EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,10) - IF (WRITE_ANS) WRITE(ANS,1713) EID_OUT_ARRAY(I,1), (OGEL(K,J),J=1,10) K = K + 1 ! the J=1,8 loop is the lower layer WRITE(F06,1704) (OGEL(K,J),J=1,8) - IF (WRITE_ANS) WRITE(ANS,1714) (OGEL(K,J),J=1,10) ENDDO ENDIF ! f06 @@ -1183,11 +1025,6 @@ SUBROUTINE WRITE_OST_CTRIA3(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, ENDIF - IF(WRITE_ANS) THEN - WRITE(ANS,1715) MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9),MAX_ANS(10), & - MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9),MIN_ANS(10), & - ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9),ABS_ANS(10) - ENDIF END SUBROUTINE WRITE_OST_CTRIA3 !============================================================================== diff --git a/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 b/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 index 10c44684..83efaab8 100644 --- a/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 +++ b/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 @@ -29,15 +29,14 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ! Writes blocks of element stresses for one subcase and one element type for elements that do not have PCOMP properties, including ! all 1-D, 2-D, 3-D elements. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, OP2 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OP2 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, MAX_NUM_STR, NDOFR, NUM_CB_DOFS, & NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE PARAMS, ONLY : PRTANS, STR_CID + USE PARAMS, ONLY : STR_CID USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELEM_STRESSES_BEGEND USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, GID_OUT_ARRAY, OGEL, POLY_FIT_ERR, POLY_FIT_ERR_INDEX USE MODEL_STUF, ONLY : ELEM_ONAME, ELMTYP, LABEL, SCNUM, STITLE, TITLE, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_LOC, STRE_OPT, STRE_OUT @@ -68,7 +67,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) INTEGER(LONG) :: I,J,L ! DO loop indices INTEGER(LONG) :: K ! Counter INTEGER(LONG) :: NCOLS ! Num of cols to write out - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELEM_STRESSES_BEGEND + REAL(DOUBLE) :: ABS_ANS(11) ! Max ABS for all element output REAL(DOUBLE) :: MAX_ANS(11) ! Max for all element output @@ -82,7 +81,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) INTEGER(LONG) :: ANALYSIS_CODE ! static/modal/time/etc. flag INTEGER(LONG) :: ELEMENT_TYPE ! the OP2 flag for the element LOGICAL :: FIELD_5_INT_FLAG ! flag to trigger FIELD5_INT_MODE vs. FIELD5_FLOAT_TIME_FREQ - LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_ANS ! flag + LOGICAL :: WRITE_F06, WRITE_OP2 ! flag INTEGER(LONG) :: FIELD5_INT_MODE ! int value for field 5 REAL(DOUBLE) :: FIELD5_FLOAT_TIME_FREQ ! float value for field 5 REAL(DOUBLE) :: FIELD6_EIGENVALUE ! float value for field 6 @@ -102,12 +101,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) INTEGER(LONG) :: CID ! coordinate system CHARACTER(4*BYTE) :: CEN_WORD ! the word "CEN/" (we need to cast the length) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -145,17 +139,12 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) FIELD6_EIGENVALUE = 0.0 WRITE_F06 = (STRE_OUT(1:1) == 'Y') WRITE_OP2 = (STRE_OUT(2:2) == 'Y') - WRITE_ANS = (PRTANS == 'Y') IF (IHEADER == 'Y') THEN IF (WRITE_F06) THEN WRITE(F06,*) WRITE(F06,*) ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,*) - ENDIF ! -- F06 header: OUTPUT FOR SUBCASE, EIGENVECTOR or CRAIG-BAMPTON DOF ISUBCASE_INDEX = 0 IF (SOL_NAME(1:7) == 'STATICS') THEN @@ -164,13 +153,11 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) FIELD5_INT_MODE = 1 ! temp FIELD5_INT_MODE = SCNUM(JSUB) IF (WRITE_F06) WRITE(F06,101) SCNUM(JSUB) - IF (WRITE_ANS) WRITE(ANS,101) SCNUM(JSUB) ELSE IF (SOL_NAME(1:8) == 'NLSTATIC') THEN ISUBCASE_INDEX = 1 ! statics ANALYSIS_CODE = 10 FIELD5_INT_MODE = SCNUM(JSUB) IF (WRITE_F06) WRITE(F06,101) SCNUM(JSUB) - IF (WRITE_ANS) WRITE(ANS,101) SCNUM(JSUB) ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN ISUBCASE_INDEX = 1 ! statics @@ -191,7 +178,6 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) FIELD5_INT_MODE = JSUB ! FIELD6_EIGENVALUE = ???? IF (WRITE_F06) WRITE(F06,102) JSUB - IF (WRITE_ANS) WRITE(ANS,102) JSUB ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ISUBCASE_INDEX = 1 ! modes @@ -214,15 +200,6 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ENDIF ENDIF ! write f06 - IF (WRITE_ANS) THEN - IF (JSUB <= NDOFR) THEN - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'acceleration', BDY_GRID, BDY_COMP - ELSE IF ((JSUB > NDOFR) .AND. (JSUB <= NDOFR+NVEC)) THEN - WRITE(ANS,104) JSUB, NUM_CB_DOFS, JSUB-NDOFR - ELSE - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'displacement', BDY_GRID, BDY_COMP - ENDIF - ENDIF ENDIF ISUBCASE = SCNUM(ISUBCASE_INDEX) @@ -232,206 +209,170 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) LABELI = LABEL(INT_SC_NUM) IF (WRITE_F06) THEN - IF (TITLE(INT_SC_NUM)(1:) /= ' ') THEN - WRITE(F06,201) TITLE(INT_SC_NUM) - ENDIF - - IF (STITLE(INT_SC_NUM)(1:) /= ' ') THEN - WRITE(F06,201) STITLE(INT_SC_NUM) - ENDIF - - IF (LABEL(INT_SC_NUM)(1:) /= ' ') THEN - WRITE(F06,201) LABEL(INT_SC_NUM) - ENDIF - ENDIF ! write f06 - IF (WRITE_F06) WRITE(F06,*) - IF (WRITE_ANS) WRITE(ANS,*) - - ! -- F06 1st 2 header lines for stress output description - IF ((TYPE(1:3) == 'BAR') .OR. (TYPE(1:4) == 'BEAM')) THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 13) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 29) + IF (TITLE(INT_SC_NUM)(1:) /= ' ') THEN + WRITE(F06,201) TITLE(INT_SC_NUM) ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 42), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 58), ONAME - ELSE IF (TYPE(1:4) == 'BUSH') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 11) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 27) + IF (STITLE(INT_SC_NUM)(1:) /= ' ') THEN + WRITE(F06,201) STITLE(INT_SC_NUM) ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 40), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 56), ONAME - ELSE IF (TYPE(1:4) == 'ELAS') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 11) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 27) + IF (LABEL(INT_SC_NUM)(1:) /= ' ') THEN + WRITE(F06,201) LABEL(INT_SC_NUM) ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 40), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 56), ONAME + WRITE(F06,*) - ELSE IF ((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN - IF (STRE_OPT == 'VONMISES') THEN + ! -- F06 1st 2 header lines for stress output description + IF ((TYPE(1:3) == 'BAR') .OR. (TYPE(1:4) == 'BEAM')) THEN IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF(STR_CID == -2) THEN - IF (WRITE_F06) WRITE(F06,312) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,312) FILL(1: 20) - ELSE - IF (WRITE_F06) WRITE(F06,302) FILL(1: 15) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 15) - ENDIF + WRITE(F06,302) FILL(1: 20) ELSE - IF(STR_CID == -2) THEN - IF (WRITE_F06) WRITE(F06,311) FILL(1: 32) - IF (WRITE_ANS) WRITE(ANS,311) FILL(1: 32) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 27) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 27) - ENDIF + WRITE(F06,301) FILL(1: 13) ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 55), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 55), ONAME - ELSE + WRITE(F06,401) FILL(1: 42), ONAME + + ELSE IF (TYPE(1:4) == 'BUSH') THEN IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF(STR_CID == -2) THEN - IF (WRITE_F06) WRITE(F06,312) FILL(1: 27) - IF (WRITE_ANS) WRITE(ANS,312) FILL(1: 27) + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 11) + ENDIF + WRITE(F06,401) FILL(1: 40), ONAME + + ELSE IF (TYPE(1:4) == 'ELAS') THEN + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 11) + ENDIF + WRITE(F06,401) FILL(1: 40), ONAME + + ELSE IF ((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN + IF (STRE_OPT == 'VONMISES') THEN + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + IF(STR_CID == -2) THEN + WRITE(F06,312) FILL(1: 20) + ELSE + WRITE(F06,302) FILL(1: 15) + ENDIF ELSE - IF (WRITE_F06) WRITE(F06,302) FILL(1: 22) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 22) + IF(STR_CID == -2) THEN + WRITE(F06,311) FILL(1: 32) + ELSE + WRITE(F06,301) FILL(1: 27) + ENDIF ENDIF + WRITE(F06,401) FILL(1: 55), ONAME ELSE - IF(STR_CID == -2) THEN - IF (WRITE_F06) WRITE(F06,311) FILL(1: 38) - IF (WRITE_ANS) WRITE(ANS,311) FILL(1: 38) + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + IF(STR_CID == -2) THEN + WRITE(F06,312) FILL(1: 27) + ELSE + WRITE(F06,302) FILL(1: 22) + ENDIF ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 33) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 33) + IF(STR_CID == -2) THEN + WRITE(F06,311) FILL(1: 38) + ELSE + WRITE(F06,301) FILL(1: 33) + ENDIF ENDIF + WRITE(F06,401) FILL(1: 61), ONAME ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 61), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 61), ONAME - ENDIF - ELSE IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 20) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 42) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 42) - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 71), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 71), ONAME + ELSE IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 42) + ENDIF + WRITE(F06,401) FILL(1: 71), ONAME - ELSE IF (TYPE(1:3) == 'ROD') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 13) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 29) - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 42), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 58), ONAME + ELSE IF (TYPE(1:3) == 'ROD') THEN + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 13) + ENDIF + WRITE(F06,401) FILL(1: 42), ONAME - ELSE IF (TYPE(1:5) == 'SHEAR') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 13) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 52) - ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 42), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 81), ONAME + ELSE IF (TYPE(1:5) == 'SHEAR') THEN + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 13) + ENDIF + WRITE(F06,401) FILL(1: 42), ONAME - ELSE IF (TYPE(1:5) == 'TRIA3') THEN - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - IF (WRITE_F06) WRITE(F06,302) FILL(1: 20) - IF (WRITE_ANS) WRITE(ANS,302) FILL(1: 36) - ELSE - IF (WRITE_F06) WRITE(F06,301) FILL(1: 36) - IF (WRITE_ANS) WRITE(ANS,301) FILL(1: 52) + ELSE IF (TYPE(1:5) == 'TRIA3') THEN + IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN + WRITE(F06,302) FILL(1: 20) + ELSE + WRITE(F06,301) FILL(1: 36) + ENDIF + WRITE(F06,401) FILL(1: 65), ONAME ENDIF - IF (WRITE_F06) WRITE(F06,401) FILL(1: 65), ONAME - IF (WRITE_ANS) WRITE(ANS,401) FILL(1: 81), ONAME - ENDIF - ! -- F06 header lines describing stress columns - IF (TYPE == 'BAR ') THEN - IF (BARTOR == 'Y') THEN - IF (WRITE_F06) WRITE(F06,1101) FILL(1:1), FILL(1:1) - IF (WRITE_ANS) WRITE(ANS,1101) FILL(1:16), FILL(1:16) - ELSE - IF (WRITE_F06) WRITE(F06,1102) FILL(1:1), FILL(1:1) - IF (WRITE_ANS) WRITE(ANS,1102) FILL(1:16), FILL(1:16) - ENDIF + ! -- F06 header lines describing stress columns + IF (TYPE == 'BAR ') THEN + IF (BARTOR == 'Y') THEN + WRITE(F06,1101) FILL(1:1), FILL(1:1) + ELSE + WRITE(F06,1102) FILL(1:1), FILL(1:1) + ENDIF - ELSE IF (TYPE(1:4) == 'ELAS') THEN - IF (WRITE_F06) WRITE(F06,1201) FILL(1:1), FILL(1:1) - IF (WRITE_ANS) WRITE(ANS,1201) FILL(1:16), FILL(1:16) + ELSE IF (TYPE(1:4) == 'ELAS') THEN + WRITE(F06,1201) FILL(1:1), FILL(1:1) - ELSE IF((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN - IF (STRE_OPT == 'VONMISES') THEN - IF (WRITE_F06) WRITE(F06,1301) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1301) FILL(1:16), FILL(1:16) - ELSE - IF (WRITE_F06) WRITE(F06,1302) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1302) FILL(1:16), FILL(1:16) - ENDIF + ELSE IF((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN + IF (STRE_OPT == 'VONMISES') THEN + WRITE(F06,1301) FILL(1: 1), FILL(1: 1) + ELSE + WRITE(F06,1302) FILL(1: 1), FILL(1: 1) + ENDIF - ELSE IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN - IF (STRE_OPT == 'VONMISES') THEN - IF (WRITE_F06) WRITE(F06,1401) FILL(1: 1), FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1401) FILL(1:16), FILL(1:16), FILL(1:16) - ELSE - IF (WRITE_F06) WRITE(F06,1402) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1402) FILL(1:16), FILL(1:16) - ENDIF + ELSE IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN + IF (STRE_OPT == 'VONMISES') THEN + WRITE(F06,1401) FILL(1: 1), FILL(1: 1), FILL(1: 1) + ELSE + WRITE(F06,1402) FILL(1: 1), FILL(1: 1) + ENDIF - ELSE IF (TYPE == 'ROD ') THEN - IF (WRITE_F06) WRITE(F06,1501) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1501) FILL(1:16), FILL(1:16) + ELSE IF (TYPE == 'ROD ') THEN + WRITE(F06,1501) FILL(1: 1), FILL(1: 1) + + ELSE IF (TYPE(1:5) == 'SHEAR') THEN + WRITE(F06,1601) FILL(1: 1), FILL(1: 1) + + ELSE IF (TYPE(1:5) == 'TRIA3') THEN + IF (STRE_OPT == 'VONMISES') THEN + WRITE(F06,1701) FILL(1: 1), FILL(1: 1), FILL(1: 1) + ELSE + WRITE(F06,1702) FILL(1: 1), FILL(1: 1) + ENDIF + + ELSE IF (TYPE == 'BUSH ') THEN + WRITE(F06,1801) FILL(1: 1), FILL(1: 1) + + ELSE IF (TYPE == 'USERIN ') THEN + WRITE(F06,1901) FILL(1: 1), FILL(1: 1) - ELSE IF (TYPE(1:5) == 'SHEAR') THEN - IF (WRITE_F06) WRITE(F06,1601) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1601) FILL(1:16), FILL(1:16), FILL(1:16) - ELSE IF (TYPE(1:5) == 'TRIA3') THEN - IF (STRE_OPT == 'VONMISES') THEN - IF (WRITE_F06) WRITE(F06,1701) FILL(1: 1), FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1701) FILL(1:16), FILL(1:16), FILL(1:16) - ELSE - IF (WRITE_F06) WRITE(F06,1702) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1702) FILL(1:16), FILL(1:16) ENDIF - ELSE IF (TYPE == 'BUSH ') THEN - IF (WRITE_F06) WRITE(F06,1801) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1801) FILL(1:16), FILL(1:16) - ELSE IF (TYPE == 'USERIN ') THEN - IF (WRITE_F06) WRITE(F06,1901) FILL(1: 1), FILL(1: 1) - IF (WRITE_ANS) WRITE(ANS,1901) FILL(1:16), FILL(1:16) - ENDIF + ENDIF ! write f06 + + + + + ENDIF ! Write the element stress output IF (TYPE == 'BAR ') THEN - CALL WRITE_BAR(NUM, FILL(1:1), FILL(1:16), ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE) + CALL WRITE_BAR(NUM, FILL(1:1), ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI, & + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_F06) ELSE IF (TYPE(1:4) == 'ELAS') THEN IF (WRITE_OP2) THEN @@ -451,8 +392,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, REAL(OGEL(I,1), 4), I=1,NUM) ENDIF ! end of op2 - WRITE(F06,1103) (FILL(1:1), EID_OUT_ARRAY(I,1), OGEL(I,1),I=1,NUM) - IF(WRITE_ANS) WRITE(ANS,1104) (FILL(1:16), EID_OUT_ARRAY(I,1),OGEL(I,1),I=1,NUM) + IF(WRITE_F06) WRITE(F06,1103) (FILL(1:1), EID_OUT_ARRAY(I,1), OGEL(I,1),I=1,NUM) ELSE IF((TYPE(1:4) == 'HEXA') .OR. (TYPE(1:5) == 'PENTA') .OR. (TYPE(1:5) == 'TETRA')) THEN ! 12345 @@ -521,30 +461,27 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) NCOLS = 8 ENDIF - K = 0 - DO I=1,NUM,NUM_PTS - K = K + 1 - ! Center - WRITE(F06,1303) EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,NCOLS) - ! Corner - DO L=1,NUM_PTS-1 + IF (WRITE_F06) THEN + K = 0 + DO I=1,NUM,NUM_PTS K = K + 1 - WRITE(F06,1306) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,NCOLS) + ! Center + WRITE(F06,1303) EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,NCOLS) + ! Corner + DO L=1,NUM_PTS-1 + K = K + 1 + WRITE(F06,1306) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,NCOLS) + ENDDO ENDDO - ENDDO - + ENDIF CALL GET_MAX_MIN_ABS_STR ( NUM, NCOLS, 'N', MAX_ANS, MIN_ANS, ABS_ANS ) - IF (STRE_OPT == 'VONMISES') THEN - WRITE(F06,1304) (MAX_ANS(J),J=1,7), (MIN_ANS(J),J=1,7), (ABS_ANS(J),J=1,7) - IF (WRITE_ANS) THEN - WRITE(ANS,1314) (MAX_ANS(J),J=1,7), (MIN_ANS(J),J=1,7), (ABS_ANS(J),J=1,7) - ENDIF - ELSE - WRITE(F06,1305) (MAX_ANS(J),J=1,8), (MIN_ANS(J),J=1,8), (ABS_ANS(J),J=1,8) - IF (WRITE_ANS) THEN - WRITE(ANS,1315) (MAX_ANS(J),J=1,8), (MIN_ANS(J),J=1,8), (ABS_ANS(J),J=1,8) + IF (WRITE_F06) THEN + IF (STRE_OPT == 'VONMISES') THEN + WRITE(F06,1304) (MAX_ANS(J),J=1,7), (MIN_ANS(J),J=1,7), (ABS_ANS(J),J=1,7) + ELSE + WRITE(F06,1305) (MAX_ANS(J),J=1,8), (MIN_ANS(J),J=1,8), (ABS_ANS(J),J=1,8) ENDIF ENDIF @@ -615,32 +552,27 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) 4 FORMAT(' *DEBUG: WRITE_CQUAD4-144: I=',I4, " K=", I4) K = K + 1 WRITE(ERR,4) I,K - WRITE(F06,*) - IF (WRITE_ANS) WRITE(ANS,*) - WRITE(F06,1403) FILL(1: 0), EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,10) - IF (WRITE_ANS) WRITE(ANS,1413) EID_OUT_ARRAY(I,1), (OGEL(K,J),J=1,10) + IF (WRITE_F06) WRITE(F06,*) + IF (WRITE_F06) WRITE(F06,1403) FILL(1: 0), EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,10) K = K + 1 - WRITE(F06,1404) FILL(1: 0), (OGEL(K,J),J=1,8) - IF (WRITE_ANS) WRITE(ANS,1414) (OGEL(K,J),J=1,8) + IF (WRITE_F06) WRITE(F06,1404) FILL(1: 0), (OGEL(K,J),J=1,8) DO L=1,NUM_PTS-1 K = K + 1 WRITE(ERR,4) I,K - WRITE(F06,*) - IF (WRITE_ANS) WRITE(ANS,*) + IF (WRITE_F06) WRITE(F06,*) IF (DABS(POLY_FIT_ERR(I+L)) >= 0.01D0) THEN - WRITE(F06,1405) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L), POLY_FIT_ERR_INDEX(I+L) + IF (WRITE_F06) THEN + WRITE(F06,1405) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L), & + POLY_FIT_ERR_INDEX(I+L) + ENDIF WRT_ERR_INDEX_NOTE(POLY_FIT_ERR_INDEX(I+L)) = 'Y' ELSE - WRITE(F06,1406) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L) - ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,1415) GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L), POLY_FIT_ERR_INDEX(I+L) + IF (WRITE_F06) WRITE(F06,1406) FILL(1: 0), GID_OUT_ARRAY(I,L+1),(OGEL(K,J),J=1,10), POLY_FIT_ERR(I+L) ENDIF K = K + 1 - WRITE(F06,1407) FILL(1: 0), (OGEL(K,J),J=1,8) - IF (WRITE_ANS) WRITE(ANS,1417) (OGEL(K,J),J=1,8) + IF (WRITE_F06) WRITE(F06,1407) FILL(1: 0), (OGEL(K,J),J=1,8) ENDDO ENDDO @@ -672,31 +604,23 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ! Get abs POLY_FIT_ERR ABS_ANS(11) = MAX( DABS(MAX_ANS(11)), DABS(MIN_ANS(11)) ) - IF ((STRE_LOC == 'CORNER ') .OR. (TYPE(1:5) == 'QUAD8')) THEN - WRITE(F06,1408) FILL(1: 0), FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & - MAX_ANS(10),MAX_ANS(11), & - FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & - MIN_ANS(10),MIN_ANS(11), & - FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & - ABS_ANS(10),ABS_ANS(11), FILL(1: 0) - ELSE - WRITE(F06,1408) FILL(1: 0), FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & - MAX_ANS(10),MAX_ANS(11), & - FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & - MIN_ANS(10),MIN_ANS(11), & - FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & - ABS_ANS(10),ABS_ANS(11), FILL(1: 0) - ENDIF - - IF (WRITE_ANS) THEN + IF (WRITE_F06) THEN IF ((STRE_LOC == 'CORNER ') .OR. (TYPE(1:5) == 'QUAD8')) THEN - WRITE(ANS,1418)MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9),MAX_ANS(10),MAX_ANS(11),& - MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9),MIN_ANS(10),MIN_ANS(11),& - ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9),ABS_ANS(10) + WRITE(F06,1408) FILL(1: 0), & + FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & + MAX_ANS(10),MAX_ANS(11), & + FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & + MIN_ANS(10),MIN_ANS(11), & + FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & + ABS_ANS(10),ABS_ANS(11), FILL(1: 0) ELSE - WRITE(ANS,1418)MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9),MAX_ANS(10),MAX_ANS(11),& - MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9),MIN_ANS(10),MIN_ANS(11),& - ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9),ABS_ANS(10),ABS_ANS(11) + WRITE(F06,1408) FILL(1: 0), & + FILL(1: 0), MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9), & + MAX_ANS(10),MAX_ANS(11), & + FILL(1: 0), MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9), & + MIN_ANS(10),MIN_ANS(11), & + FILL(1: 0), ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9), & + ABS_ANS(10),ABS_ANS(11), FILL(1: 0) ENDIF ENDIF @@ -707,7 +631,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ENDIF ENDDO - IF (WRITE_NOTES == 'Y') THEN + IF ((WRITE_NOTES == 'Y') .AND. (WRITE_F06)) THEN WRITE(F06,1498) DO I=1,MAX_NUM_STR IF (WRT_ERR_INDEX_NOTE(I) == 'Y') THEN @@ -717,18 +641,18 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) ENDIF ELSE IF (TYPE == 'ROD ') THEN - CALL WRITE_ROD (ISUBCASE, NUM, FILL(1:1), FILL(1:16), ITABLE, TITLEI, STITLEI, LABELI, & + CALL WRITE_ROD (ISUBCASE, NUM, FILL(1:1), ITABLE, TITLEI, STITLEI, LABELI, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_OP2 ) ELSE IF (TYPE(1:5) == 'SHEAR') THEN CALL WRITE_OES_CSHEAR(NUM, FILL, ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, & - WRITE_F06, WRITE_OP2, WRITE_ANS) + WRITE_F06, WRITE_OP2) ELSE IF (TYPE(1:5) == 'TRIA3') THEN CALL WRITE_OES_CTRIA3(NUM, FILL, ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, & - WRITE_F06, WRITE_OP2, WRITE_ANS) + WRITE_F06, WRITE_OP2) ELSE IF (TYPE == 'BUSH ') THEN IF (WRITE_OP2) THEN @@ -743,16 +667,18 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE,(REAL(OGEL(I,J),4),J=1,6), I=1,NUM) ENDIF - DO I=1,NUM - WRITE(F06,1802) EID_OUT_ARRAY(I,1),(OGEL(I,J),J=1,6) - IF (WRITE_ANS) WRITE(ANS,1812) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) - ENDDO + IF (WRITE_F06) THEN + DO I=1,NUM + WRITE(F06,1802) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) + ENDDO + ENDIF ELSE IF (TYPE == 'USERIN ') THEN - DO I=1,NUM - WRITE(F06,1902) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) - IF (WRITE_ANS) WRITE(ANS,1812) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) - ENDDO + IF (WRITE_F06) THEN + DO I=1,NUM + WRITE(F06,1902) EID_OUT_ARRAY(I,1), (OGEL(I,J),J=1,6) + ENDDO + ENDIF ELSE WRITE(ERR,9300) SUBR_NAME,TYPE @@ -761,12 +687,7 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) CALL OUTA_HERE ( 'Y' ) ! Coding error (elem type not valid) , so quit ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -811,8 +732,6 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) 1103 FORMAT(5(A,I8,1ES14.6)) - 1104 FORMAT(A,I8,1ES14.6) - ! 3D Elems >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1301 FORMAT(1X,A,' Elem Location Sigma-xx Sigma-yy Sigma-zz Tau-xy Tau-yz Tau-zx ', & @@ -840,21 +759,6 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) 1306 FORMAT(1X,A,10X,'GRD',I8,5X,8(1ES14.6)) - 1313 FORMAT(16X,I8,8(1ES14.6)) !todo ANS solid stress row - - 1314 FORMAT(28X,'------------- ------------- ------------- ------------- ------------- ------------- -------------',/, & - 1X,'MAX (for output set): ',7(ES14.6),/, & - 1X,'MIN (for output set): ',7(ES14.6),//, & - 1X,'ABS (for output set): ',7(ES14.6),/, & - 1X,'*for output set') - - 1315 FORMAT(28X,'------------- ------------- ------------- ------------- ------------- ------------- -------------', & - ' -------------',/, & - 1X,'MAX (for output set): ',8(ES14.6),/, & - 1X,'MIN (for output set): ',8(ES14.6),//, & - 1X,'ABS (for output set): ',8(ES14.6),/, & - 1X,'*for output set') - ! QUAD4 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1401 FORMAT(1X,A,' Elem Location Fibre Stresses In Element Coord System Principal Stresses (Zero Shear)', & ' Transverse Transverse % Poly',/,1X,A, & @@ -883,20 +787,6 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) 1X,A,'ABS* : ',25x,3(ES13.5),8X,5(ES13.5),E9.1,/, & 1X,A,'*for output set') - 1413 FORMAT(1X,I8,2X,'CENTER ',5X,4(1ES14.6),0PF14.3,5(1ES14.6)) - - 1414 FORMAT(9X,15X,4(1ES14.6),0PF14.3,3(1ES14.6)) - - 1415 FORMAT(21X,'GRID',I8,1X,4(1ES14.6),0PF9.3,5(1ES14.6),F13.2,'% (',I1,')') - - 1417 FORMAT(9X,15X,4(1ES14.6),0PF9.3,3(1ES14.6)) - - 1418 FORMAT(39X,'------------- ------------- ------------- ------------- ------------- ------------- -------------',& - ' ------------- -------------',/, & - 1X,'MAX (for output set): ',15X,3(ES14.6),14X,5(ES14.6),F14.2,/, & - 1X,'MIN (for output set): ',15X,3(ES14.6),14X,5(ES14.6),F14.2,//, & - 1X,'ABS (for output set): ',15X,3(ES14.6),14X,5(ES14.6),F14.2) - 1498 FORMAT(' NOTE: Explanation of errors in the polynomial fit to extrapolate element corner point stresses from values at the', & ' Gauss points:') @@ -936,31 +826,18 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHEADER, NUM_PTS, ITABLE ) 1X,'ABS* : ',28x,3(ES13.5),9X,5(ES13.5),/, & 1X,'*for output set') - 1713 FORMAT(1X,I8,4X,'Anywhere',3X,4(1ES14.6),0PF14.3,5(1ES14.6)) - - 1714 FORMAT(13X,'in elem',4X,4(1ES14.6),0PF14.3,5(1ES14.6)) - - 1715 FORMAT(39X,'------------- ------------- ------------- ------------- ------------- ------------- ---------',/, & - 1X,'MAX (for output set): ',15X,3(ES14.6),14X,5(ES14.6),/, & - 1X,'MIN (for output set): ',15X,3(ES14.6),14X,5(ES14.6),//, & - 1X,'ABS (for output set): ',15X,3(ES14.6),14X,5(ES14.6),/) - ! BUSH >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1801 FORMAT(20X,A,'Element Stress-1 Stress-2 Stress-3 Stress-4 Stress-5 Stress-6' & ,/,20X,A,' ID') 1802 FORMAT(19X,I8,8(1ES14.6)) - 1812 FORMAT(16X,I8,8(1ES14.6)) - ! USERIN >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1901 FORMAT(20X,A,'Element Stress-1 Stress-2 Stress-3 Stress-4 Stress-5 Stress-6' & ,/,20X,A,' ID') 1902 FORMAT(19X,I8,8(1ES14.6)) - 1912 FORMAT(17X,I8,8(1ES14.6)) - ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 9300 FORMAT(' *ERROR 9300: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,' NO OUTPUT FORMAT AVAILABLE FOR ELEMENT TYPE = ',A) @@ -971,7 +848,7 @@ END SUBROUTINE WRITE_ELEM_STRESSES SUBROUTINE WRITE_OES_CSHEAR(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, & - WRITE_F06, WRITE_OP2, WRITE_ANS) + WRITE_F06, WRITE_OP2) ! TODO: calculate margin ! USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE @@ -986,7 +863,7 @@ SUBROUTINE WRITE_OES_CSHEAR(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, CHARACTER(LEN=128), INTENT(IN) :: TITLE ! the model TITLE CHARACTER(LEN=128), INTENT(IN) :: SUBTITLE ! the subcase SUBTITLE CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL - LOGICAL, INTENT(IN) :: WRITE_F06, WRITE_OP2, WRITE_ANS + LOGICAL, INTENT(IN) :: WRITE_F06, WRITE_OP2 CHARACTER(128*BYTE) :: FILL ! Padding for output format INTEGER(LONG), INTENT(INOUT) :: ITABLE ! the current subtable number @@ -1073,9 +950,9 @@ END SUBROUTINE WRITE_OES_CSHEAR !============================================================================== SUBROUTINE WRITE_OES_CTRIA3 ( NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, & FIELD5_INT_MODE, FIELD6_EIGENVALUE , & - WRITE_F06, WRITE_OP2, WRITE_ANS) + WRITE_F06, WRITE_OP2) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ANS, ERR, F06, OP2 + USE IOUNT1, ONLY : ERR, F06, OP2 USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, OGEL USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE @@ -1085,7 +962,7 @@ SUBROUTINE WRITE_OES_CTRIA3 ( NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABE CHARACTER(LEN=128), INTENT(IN) :: TITLE ! the model TITLE CHARACTER(LEN=128), INTENT(IN) :: SUBTITLE ! the subcase SUBTITLE CHARACTER(LEN=128), INTENT(IN) :: LABEL ! the subcase LABEL - LOGICAL, INTENT(IN) :: WRITE_F06, WRITE_OP2, WRITE_ANS ! flags + LOGICAL, INTENT(IN) :: WRITE_F06, WRITE_OP2 ! flags CHARACTER(128*BYTE) :: FILL ! Padding for output format INTEGER(LONG), INTENT(INOUT) :: ITABLE ! the current subtable number @@ -1145,24 +1022,14 @@ SUBROUTINE WRITE_OES_CTRIA3 ( NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABE 1X,'ABS* : ',28x,3(ES13.5),9X,5(ES13.5),/, & 1X,'*for output set') - 1713 FORMAT(1X,I8,4X,'Anywhere',3X,4(1ES14.6),0PF14.3,5(1ES14.6)) - 1714 FORMAT(13X,'in elem',4X,4(1ES14.6),0PF14.3,5(1ES14.6)) - 1715 FORMAT(39X,'------------- ------------- ------------- ------------- ------------- ------------- ---------',/, & - 1X,'MAX (for output set): ',15X,3(ES14.6),14X,5(ES14.6),/, & - 1X,'MIN (for output set): ',15X,3(ES14.6),14X,5(ES14.6),//, & - 1X,'ABS (for output set): ',15X,3(ES14.6),14X,5(ES14.6),/) - DO I=1,NUM K = K + 1 WRITE(F06,*) - IF (WRITE_ANS) WRITE(ANS,*) ! the J=1,10 loop is the upper layer & 2 transverse shear WRITE(F06,1703) EID_OUT_ARRAY(I,1),(OGEL(K,J),J=1,10) - IF (WRITE_ANS) WRITE(ANS,1713) EID_OUT_ARRAY(I,1), (OGEL(K,J),J=1,10) K = K + 1 ! the J=1,8 loop is the lower layer WRITE(F06,1704) (OGEL(K,J),J=1,8) - IF (WRITE_ANS) WRITE(ANS,1714) (OGEL(K,J),J=1,10) ENDDO CALL GET_MAX_MIN_ABS_STR ( NUM, 10, 'Y', MAX_ANS, MIN_ANS, ABS_ANS ) @@ -1172,11 +1039,6 @@ SUBROUTINE WRITE_OES_CTRIA3 ( NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABE ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9),ABS_ANS(10) - IF (WRITE_ANS) THEN - WRITE(ANS,1715) MAX_ANS(2),MAX_ANS(3),MAX_ANS(4),MAX_ANS(6),MAX_ANS(7),MAX_ANS(8),MAX_ANS(9),MAX_ANS(10), & - MIN_ANS(2),MIN_ANS(3),MIN_ANS(4),MIN_ANS(6),MIN_ANS(7),MIN_ANS(8),MIN_ANS(9),MIN_ANS(10), & - ABS_ANS(2),ABS_ANS(3),ABS_ANS(4),ABS_ANS(6),ABS_ANS(7),ABS_ANS(8),ABS_ANS(9),ABS_ANS(10) - ENDIF END SUBROUTINE WRITE_OES_CTRIA3 !============================================================================== diff --git a/Source/LK9/L91/WRITE_FEMAP_ELFO_VECS.f90 b/Source/LK9/L91/WRITE_FEMAP_ELFO_VECS.f90 index 79af08d4..4832b3db 100644 --- a/Source/LK9/L91/WRITE_FEMAP_ELFO_VECS.f90 +++ b/Source/LK9/L91/WRITE_FEMAP_ELFO_VECS.f90 @@ -29,12 +29,11 @@ SUBROUTINE WRITE_FEMAP_ELFO_VECS ( ELEM_TYP, NUM_FEMAP_ROWS, FEMAP_SET_ID ) ! Writes element engineering forces to FEMAP neutral file for ROD, BAR,TRIA3, QUAD4, SHEAR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NEU + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NEU USE PARAMS, ONLY : SUPWARN USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FEMAP_ELFO_VECS_BEGEND USE WRITE_FEMAP_ELFO_VECS_USE_IFs @@ -63,7 +62,7 @@ SUBROUTINE WRITE_FEMAP_ELFO_VECS ( ELEM_TYP, NUM_FEMAP_ROWS, FEMAP_SET_ID ) INTEGER(LONG) :: ID(20) ! Vector ID's for FEMAP output INTEGER(LONG) :: VEC_ID_OFFSET ! Offset in determining output vector ID INTEGER(LONG) :: VEC_ID ! Vector ID for FEMAP output - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FEMAP_ELFO_VECS_BEGEND + ! Columns from FEMAP_EL_VECS REAL(DOUBLE) :: ELEM_VECS(NUM_FEMAP_ROWS,12) @@ -75,12 +74,7 @@ SUBROUTINE WRITE_FEMAP_ELFO_VECS ( ELEM_TYP, NUM_FEMAP_ROWS, FEMAP_SET_ID ) REAL(DOUBLE) :: VEC_MAX ! Max value in vector REAL(DOUBLE) :: VEC_MIN ! Min value in vector -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ELEM_NAME_LEN = LEN(ELEM_TYP) @@ -392,12 +386,7 @@ SUBROUTINE WRITE_FEMAP_ELFO_VECS ( ELEM_TYP, NUM_FEMAP_ROWS, FEMAP_SET_ID ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 b/Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 index 105984d6..0af5705c 100644 --- a/Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 +++ b/Source/LK9/L91/WRITE_FEMAP_GRID_VECS.f90 @@ -29,12 +29,11 @@ SUBROUTINE WRITE_FEMAP_GRID_VECS ( GRID_VEC, FEMAP_SET_ID, WHAT ) ! Writes grid related vectors to FEMAP neutral file (displ, applied load, SPC and MPC forces) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NEU + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NEU USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NCORD, NDOFG, NGRID USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : CORD, GRID, GRID_ID, INV_GRID_SEQ - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FEMAP_GRID_VECS_BEGEND USE WRITE_FEMAP_GRID_VECS_USE_IFs @@ -60,7 +59,7 @@ SUBROUTINE WRITE_FEMAP_GRID_VECS ( GRID_VEC, FEMAP_SET_ID, WHAT ) INTEGER(LONG) :: NUM_COMPS ! 6 if GRID_NUM is an physical grid, 1 if an SPOINT INTEGER(LONG) :: VEC_ID_OFFSET ! Offset in determining output vector ID INTEGER(LONG) :: VEC_ID ! Vector ID for FEMAP output - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FEMAP_GRID_VECS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: GRID_VEC(NDOFG) ! G-set Vector to process REAL(DOUBLE) :: DIS(3) ! Array of 3 translation components @@ -79,12 +78,7 @@ SUBROUTINE WRITE_FEMAP_GRID_VECS ( GRID_VEC, FEMAP_SET_ID, WHAT ) REAL(DOUBLE) :: VEC_MAX ! Max value in vector REAL(DOUBLE) :: VEC_MIN ! Min value in vector -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** TITLE1(1,1) = 'RSS' @@ -130,7 +124,7 @@ SUBROUTINE WRITE_FEMAP_GRID_VECS ( GRID_VEC, FEMAP_SET_ID, WHAT ) R3_VEC(I) = ZERO GRID_NUMS(I) = GRID_ID(INV_GRID_SEQ(I)) - CALL GET_GRID_NUM_COMPS ( GRID_NUMS(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Grid point, 6 DOF IDOFG = IDOFG + 1 ; T1_VEC(I) = GRID_VEC(IDOFG) IDOFG = IDOFG + 1 ; T2_VEC(I) = GRID_VEC(IDOFG) @@ -391,12 +385,7 @@ SUBROUTINE WRITE_FEMAP_GRID_VECS ( GRID_VEC, FEMAP_SET_ID, WHAT ) ENDDO WRITE(NEU,1007) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/WRITE_FEMAP_STRE_VECS.f90 b/Source/LK9/L91/WRITE_FEMAP_STRE_VECS.f90 index 4d9a7521..60e199f4 100644 --- a/Source/LK9/L91/WRITE_FEMAP_STRE_VECS.f90 +++ b/Source/LK9/L91/WRITE_FEMAP_STRE_VECS.f90 @@ -29,13 +29,12 @@ SUBROUTINE WRITE_FEMAP_STRE_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET ! Writes elem stress to FEMAP neutral file for ELAS, ROD, BAR, TRIA3, QUAD4, SHEAR, HEXA, PENTA, TETRA4 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NEU + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NEU USE PARAMS, ONLY : SUPWARN USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OPT USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FEMAP_STRE_VECS_BEGEND USE WRITE_FEMAP_STRE_VECS_USE_IFs @@ -65,7 +64,7 @@ SUBROUTINE WRITE_FEMAP_STRE_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET INTEGER(LONG) :: ID(22) ! Vector ID's for FEMAP output INTEGER(LONG) :: VEC_ID_OFFSET ! Offset in determining output vector ID INTEGER(LONG) :: VEC_ID ! Vector ID for FEMAP output - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FEMAP_STRE_VECS_BEGEND + ! One column from FEMAP_EL_VECS REAL(DOUBLE) :: ELEM_VEC(NUM_FEMAP_ROWS) @@ -74,12 +73,7 @@ SUBROUTINE WRITE_FEMAP_STRE_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET REAL(DOUBLE) :: VEC_MAX ! Max value in vector REAL(DOUBLE) :: VEC_MIN ! Min value in vector -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ELEM_NAME_LEN = LEN(ELEM_TYP) @@ -463,12 +457,7 @@ SUBROUTINE WRITE_FEMAP_STRE_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/WRITE_FEMAP_STRN_VECS.f90 b/Source/LK9/L91/WRITE_FEMAP_STRN_VECS.f90 index d4630642..624c7181 100644 --- a/Source/LK9/L91/WRITE_FEMAP_STRN_VECS.f90 +++ b/Source/LK9/L91/WRITE_FEMAP_STRN_VECS.f90 @@ -29,13 +29,12 @@ SUBROUTINE WRITE_FEMAP_STRN_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET ! Writes elem strain to FEMAP neutral file for TRIA3, QUAD4, SHEAR, HEXA, PENTA, TETRA4 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, NEU + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, NEU USE PARAMS, ONLY : SUPWARN USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OPT USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FEMAP_STRN_VECS_BEGEND USE WRITE_FEMAP_STRN_VECS_USE_IFs @@ -65,19 +64,13 @@ SUBROUTINE WRITE_FEMAP_STRN_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET INTEGER(LONG) :: ID(20) ! Vector ID's for FEMAP output INTEGER(LONG) :: VEC_ID_OFFSET ! Offset in determining output vector ID INTEGER(LONG) :: VEC_ID ! Vector ID for FEMAP output - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FEMAP_STRN_VECS_BEGEND + REAL(DOUBLE) :: ELEM_VEC(NUM_FEMAP_ROWS) ! One column from FEMAP_EL_VECS REAL(DOUBLE) :: VEC_ABS ! Abs value in vector REAL(DOUBLE) :: VEC_MAX ! Max value in vector REAL(DOUBLE) :: VEC_MIN ! Min value in vector -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF ! ********************************************************************************************************************************** ELEM_NAME_LEN = LEN(ELEM_TYP) @@ -276,12 +269,7 @@ SUBROUTINE WRITE_FEMAP_STRN_VECS ( ELEM_TYP, IS_PCOMP, NUM_FEMAP_ROWS, FEMAP_SET ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/WRITE_GRD_OP2_OUTPUTS.f90 b/Source/LK9/L91/WRITE_GRD_OP2_OUTPUTS.f90 index 76100e28..e53284bc 100644 --- a/Source/LK9/L91/WRITE_GRD_OP2_OUTPUTS.f90 +++ b/Source/LK9/L91/WRITE_GRD_OP2_OUTPUTS.f90 @@ -34,10 +34,9 @@ SUBROUTINE WRITE_GRD_OP2_OUTPUTS ( JSUB, NUM, WHAT, ITABLE, NEW_RESULT ) ! - velocity???? USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, OP2 + USE IOUNT1, ONLY : ERR, F06, OP2 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, INT_SC_NUM, SOL_NAME USE TIMDAT, ONLY : TSEC -! USE SUBR_BEGEND_LEVELS, ONLY : WRITE_GRD_PCH_OUTPUTS_BEGEND USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, OGEL USE MODEL_STUF, ONLY : GRID, LABEL, SCNUM, SUBLOD, STITLE, TITLE @@ -79,12 +78,7 @@ SUBROUTINE WRITE_GRD_OP2_OUTPUTS ( JSUB, NUM, WHAT, ITABLE, NEW_RESULT ) ! ********************************************************************************************************************************** ! TODO: assuming PLOT DEVICE_CODE = 1 -! ********************************************************************************************************************************** -! IF (WRT_LOG >= SUBR_BEGEND) THEN -! CALL OURTIM -! WRITE(F04,9001) SUBR_NAME,TSEC -! 9001 FORMAT(1X,A,' BEGN ',F10.3) -! ENDIF + ! ********************************************************************************************************************************** ! Make sure that WHAT is a valid value @@ -165,12 +159,7 @@ SUBROUTINE WRITE_GRD_OP2_OUTPUTS ( JSUB, NUM, WHAT, ITABLE, NEW_RESULT ) ! WRITE(OP2) (GID_OUT_ARRAY(I,1)*10+DEVICE_CODE, G_OR_S(I), (REAL(OGEL(I,J),4), J=1,6), I=1,NUM) CALL END_OP2_TABLE(ITABLE) -! ********************************************************************************************************************************** -! IF (WRT_LOG >= SUBR_BEGEND) THEN -! CALL OURTIM -! WRITE(F04,9002) SUBR_NAME,TSEC -! 9002 FORMAT(1X,A,' END ',F10.3) -! ENDIF + RETURN diff --git a/Source/LK9/L91/WRITE_GRD_PCH_OUTPUTS.f90 b/Source/LK9/L91/WRITE_GRD_PCH_OUTPUTS.f90 index ae8fbacc..330e3267 100644 --- a/Source/LK9/L91/WRITE_GRD_PCH_OUTPUTS.f90 +++ b/Source/LK9/L91/WRITE_GRD_PCH_OUTPUTS.f90 @@ -29,10 +29,9 @@ SUBROUTINE WRITE_GRD_PCH_OUTPUTS ( JSUB, NUM, WHAT ) ! Writes "punch" output for grid point related quantities (accels, displacements, eigenvectors, applied loads and SPC, MPC forces) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, PCH + USE IOUNT1, ONLY : ERR, F06, PCH USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, INT_SC_NUM, PCH_LINE_NUM, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_GRD_PCH_OUTPUTS_BEGEND USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, OGEL USE MODEL_STUF, ONLY : GRID, LABEL, SCNUM, SUBLOD, STITLE, TITLE @@ -49,14 +48,9 @@ SUBROUTINE WRITE_GRD_PCH_OUTPUTS ( JSUB, NUM, WHAT ) INTEGER(LONG), INTENT(IN) :: JSUB ! Solution vector number INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_GRD_PCH_OUTPUTS_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Make sure that WHAT is a valid value @@ -137,12 +131,7 @@ SUBROUTINE WRITE_GRD_PCH_OUTPUTS ( JSUB, NUM, WHAT ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 b/Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 index bbce9009..0a968236 100644 --- a/Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 +++ b/Source/LK9/L91/WRITE_GRD_PRT_OUTPUTS.f90 @@ -29,13 +29,11 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG ! Writes printed output for grid point related quantities (accels, displacements, eigenvectors, applied loads and SPC, MPC forces) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, PCH + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, PCH USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, INT_SC_NUM, MELGP, MOGEL, NDOFR, NVEC, NUM_CB_DOFS, & SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_GRD_PRT_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO - USE PARAMS, ONLY : PRTANS USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, MAXREQ, OGEL @@ -67,7 +65,7 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG INTEGER(LONG) :: BDY_DOF_NUM ! DOF number for BDY_GRID/BDY_COMP INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: LINES_WRITTEN ! Number of lines written for the grids - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_GRD_PRT_OUTPUTS_BEGEND + REAL(DOUBLE) :: ABS_ANS(6) ! Max Abs for all grids output for each of the 6 disp components REAL(DOUBLE) :: MAX_ANS(6) ! Max for all grids output for each of the 6 disp components @@ -78,12 +76,7 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG ! constr forces in subr this subr for grids that have no constr force INTRINSIC :: MAX, MIN, DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make sure that WHAT is a valid value @@ -192,58 +185,7 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG ENDIF ENDIF WRITE(F06,9501) - - IF (PRTANS == 'Y') THEN - WRITE(ANS,*) - WRITE(ANS,*) - IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - WRITE(ANS,9011) SCNUM(JVEC) - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN - WRITE(ANS,9011) SCNUM(JVEC) - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - WRITE(ANS,9012) JVEC - ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - WRITE(ANS,9012) JVEC - ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(ANS,9013) JVEC, NUM_CB_DOFS - ENDIF - - WRITE(ANS,*) - - IF (WHAT == 'DISP') THEN - - IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - WRITE(ANS,9322) - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN - WRITE(ANS,9322) - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - WRITE(ANS,9323) - ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - WRITE(ANS,9323) - ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(ANS,9324) - ENDIF - - ELSE IF (WHAT == 'OLOAD') THEN - - WRITE(ANS,9331) - IF (SUBLOD(INT_SC_NUM,2) > 0) THEN - WRITE(ANS,9332) - ENDIF - - ELSE IF (WHAT == 'SPCF') THEN - - WRITE(ANS,9341) - - ELSE IF (WHAT == 'MPCF') THEN - - WRITE(ANS,9351) - - ENDIF - - WRITE(ANS,9501) - - ENDIF + ENDIF @@ -332,10 +274,6 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG ENDDO ENDIF - IF (PRTANS == 'Y') THEN - WRITE(ANS,9901) GID_OUT_ARRAY(I,1),GID_OUT_ARRAY(I,2),(OGEL(I,J),J=1,6) - ENDIF - LINES_WRITTEN = LINES_WRITTEN + 1 ENDIF @@ -344,9 +282,6 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG IF (LINES_WRITTEN > 2) THEN WRITE(F06,9601) (MAX_ANS_CHAR(J),J=1,6), (MIN_ANS_CHAR(J),J=1,6), (ABS_ANS_CHAR(J),J=1,6) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9611) (MAX_ANS(J),J=1,6), (MIN_ANS(J),J=1,6), (ABS_ANS(J),J=1,6) - ENDIF ENDIF IF (DEBUG(92) == 0) THEN @@ -359,46 +294,23 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG IF (PRINT_TOTALS == 'Y') THEN IF (WHAT == 'OLOAD') THEN WRITE(F06,9701) (TOTALS_CHAR(J),J=1,6) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9791) (TOTALS(J),J=1,6) - ENDIF ELSE IF (WHAT == 'SPCF' ) THEN WRITE(F06,9702) (TOTALS_CHAR(J),J=1,6) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9792) (TOTALS(J),J=1,6) - ENDIF ELSE IF (WHAT == 'MPCF' ) THEN WRITE(F06,9703) (TOTALS_CHAR(J),J=1,6) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9793) (TOTALS(J),J=1,6) - ENDIF ENDIF ELSE IF (WHAT == 'OLOAD') THEN WRITE(F06,9711) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9711) - ENDIF ELSE IF (WHAT == 'SPCF' ) THEN WRITE(F06,9712) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9712) - ENDIF ELSE IF (WHAT == 'MPCF' ) THEN WRITE(F06,9713) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9713) - ENDIF ENDIF ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -411,8 +323,6 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG 9013 FORMAT(' OUTPUT FOR CRAIG-BAMPTON DOF ',I8,' OF ',I8,' (boundary ',A,' for grid',I8,' component',I2,')') - 9014 FORMAT(' OUTPUT FOR CRAIG-BAMPTON ACCEL OTM COL ',I8,' OF ',I8) - 9015 FORMAT(' OUTPUT FOR CRAIG-BAMPTON DOF ',I8,' OF ',I8,' (modal acceleration for mode ',I8,')') 9100 FORMAT(' *ERROR 9100: PROGRAMMING ERROR IN SUBROUTINE ',A & @@ -456,11 +366,6 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG 16X,'ABS* : ',6A14,/, & 16X,'*for output set') - 9611 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- -------------',/, & - 1X,'MAX (for output set): ',6(ES14.6),/, & - 1X,'MIN (for output set): ',6(ES14.6),//, & - 1X,'ABS (for output set): ',6(ES14.6)) - 9701 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- -------------',/, & 1X,'APPLIED FORCE TOTALS: ',6A14,/,3X,'(for output set)') @@ -470,15 +375,6 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG 9703 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- -------------',/, & 1X,' MPC FORCE TOTALS: ',6A14,/,5X,'(for output set)') - 9791 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- -------------',/, & - 1X,'APPLIED FORCE TOTALS: ',6(1ES14.6),/,3X,'(for output set)') - - 9792 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- -------------',/, & - 1X,' SPC FORCE TOTALS: ',6(1ES14.6),/,5X,'(for output set)') - - 9793 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- -------------',/, & - 1X,' MPC FORCE TOTALS: ',6(1ES14.6),/,5X,'(for output set)') - 9711 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- -------------',/, & 1X,'APPLIED FORCE TOTALS: not printed since all grids do not have the same global coordinate system') @@ -488,8 +384,6 @@ SUBROUTINE WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ALL_SAME_CID, WRITE_OG 9713 FORMAT(11X,' ------------- ------------- ------------- ------------- ------------- -------------',/, & 1X,' MPC FORCE TOTALS: not printed since all grids do not have the same global coordinate system') - 9901 FORMAT(6X,2(1X,I8),6(ES14.6)) - 9902 FORMAT(6X,2(1X,I8),6A) ! ********************************************************************************************************************************** diff --git a/Source/LK9/L91/WRITE_MEFFMASS.f90 b/Source/LK9/L91/WRITE_MEFFMASS.f90 index 74da6574..369a19da 100644 --- a/Source/LK9/L91/WRITE_MEFFMASS.f90 +++ b/Source/LK9/L91/WRITE_MEFFMASS.f90 @@ -28,12 +28,11 @@ SUBROUTINE WRITE_MEFFMASS ! Writes output for modal effective mass USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NVEC USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MEFFMASS_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, TWO, ONE_HUNDRED, PI - USE PARAMS, ONLY : PRTANS, PRTF06, PRTOP2 + USE PARAMS, ONLY : PRTF06, PRTOP2 USE DEBUG_PARAMETERS, ONLY : DEBUG USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, MEFFMASS USE MODEL_STUF, ONLY : MEFM_RB_MASS, LABEL, STITLE, TITLE @@ -48,7 +47,7 @@ SUBROUTINE WRITE_MEFFMASS CHARACTER(1*BYTE) :: IHDR = 'Y' ! Indicator of whether to write an output header INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MEFFMASS_BEGEND + REAL(DOUBLE) :: CYCLES ! Circular frequency of a mode REAL(DOUBLE) :: EPS1 ! Small number to compare against zero @@ -56,19 +55,12 @@ SUBROUTINE WRITE_MEFFMASS REAL(DOUBLE) :: MODES_PCT(6) ! Modal mass as % of total mass !LOGICAL :: WRITE_F06 ! flag !LOGICAL :: WRITE_OP2 ! flag - LOGICAL :: WRITE_ANS ! flag LOGICAL :: IS_LOW_PRECISION ! Print MPFACTOR, MEFFMASS values with 2 decimal places of accuracy rather than 6 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** - WRITE_ANS = (PRTANS == 'Y') IS_LOW_PRECISION = (DEBUG(174) == 0) !-------------------------------------------------- @@ -105,12 +97,6 @@ SUBROUTINE WRITE_MEFFMASS WRITE(F06,9108) ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,9202) MEFMCORD - WRITE(ANS,9207) - ENDIF - DO J=1,6 MEFM_TOTALS(J) = ZERO ENDDO @@ -124,10 +110,6 @@ SUBROUTINE WRITE_MEFFMASS WRITE(F06,9111) I, CYCLES, (MEFFMASS(I,J)/WTMASS,J=1,6) ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,9210) I, CYCLES, (MEFFMASS(I,J)/WTMASS,J=1,6) - ENDIF - DO J=1,6 MEFM_TOTALS(J) = MEFM_TOTALS(J) + MEFFMASS(I,J)/WTMASS ENDDO @@ -145,12 +127,7 @@ SUBROUTINE WRITE_MEFFMASS ELSE WRITE(F06,9117) (MEFM_RB_MASS(I,I),I=1,6) ENDIF - - IF (WRITE_ANS) THEN - WRITE(ANS,9212) (MEFM_TOTALS(J),J=1,6) - WRITE(ANS,9216) (MEFM_RB_MASS(I,I),I=1,6) - ENDIF - + ! For each of the 6 modal masses, calc % of total mass. ! A character variable is used to store the % so that blank percentages can ! be printed if zero modal mass exists for a component (T1 - R3) or @@ -247,12 +224,7 @@ SUBROUTINE WRITE_MEFFMASS WRITE(F06,9118) (CHAR_PCT(I),I=1,6) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -276,9 +248,6 @@ SUBROUTINE WRITE_MEFFMASS 2006 FORMAT(' *INFORMATION: CANNOT CALCULATE R3 MODAL EFFECTIVE MASS PERCENT OF MODEL IZZ SO IT IS LEFT BLANK') - 9101 FORMAT(' *ERROR 9101: PROGRAMMING ERROR IN SUBROUTINE ',A & - ,/,14X,' PARAM WTMASS SHOULD NOT BE ZERO BUT IS = ',1ES14.6) - 9102 FORMAT(14X,' E F F E C T I V E M O D A L M A S S E S O R W E I G H T S',/, & 14X,' (in coordinate system ',I8,')',/, & 14X,' Units are same as units for mass input in the Bulk Data Deck') @@ -315,19 +284,6 @@ SUBROUTINE WRITE_MEFFMASS ,'free mass (i.e. not counting mass at constrained DOF''s).',/, & ' Percentages are only printed for components that have finite model mass.',/, & ' -----') - 9202 FORMAT(21X,' E F F E C T I V E M O D A L M A S S E S O R W E I G H T S',/, & - 21X,' (in coordinate system ',I8,')',/, & - 21X,' Units are same as units for mass input in the Bulk Data Deck') - - 9207 FORMAT(20X,'MODE CYCLES T1 T2 T3 R1 R2 R3',/, & - 20X,' NUM') - - 9210 FORMAT(16X,I8,7(1ES14.6)) - - 9212 FORMAT(39X,' ------------ ------------ ------------ ------------ ------------ ------------',/, & - 10X,'Sum all modes:',14X,6(1ES14.6)) - - 9216 FORMAT(7X,'Total model mass:',14X,6(1ES14.6)) ! ********************************************************************************************************************************** diff --git a/Source/LK9/L91/WRITE_MPFACTOR.f90 b/Source/LK9/L91/WRITE_MPFACTOR.f90 index 3ad26ebd..76c0a3c0 100644 --- a/Source/LK9/L91/WRITE_MPFACTOR.f90 +++ b/Source/LK9/L91/WRITE_MPFACTOR.f90 @@ -28,15 +28,14 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) ! Writes output for modal participation factors USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NDOFG, NDOFR, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MPFACTOR_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO, PI USE DEBUG_PARAMETERS, ONLY : DEBUG USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, MPFACTOR_NR, MPFACTOR_N6 USE MODEL_STUF, ONLY : LABEL, STITLE, TITLE - USE PARAMS, ONLY : GRDPNT, MEFMCORD, MEFMGRID, MEFMLOC, MPFOUT, PRTANS, PRTF06, PRTOP2 + USE PARAMS, ONLY : GRDPNT, MEFMCORD, MEFMGRID, MEFMLOC, MPFOUT, PRTF06, PRTOP2 USE DOF_TABLES, ONLY : TDOFI USE WRITE_MPFACTOR_USE_IFs @@ -52,23 +51,16 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) INTEGER(LONG) :: R_SET_GRIDS(NDOFR)! Array of grids for the R-set INTEGER(LONG) :: R_SET_COMPS(NDOFR)! Array of displ components for the R-set INTEGER(LONG) :: R_SET_COL ! Col in TDOFI array where R-set exists - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MPFACTOR_BEGEND + REAL(DOUBLE) :: CYCLES ! Circular frequency of a mode !LOGICAL :: WRITE_F06 ! flag !LOGICAL :: WRITE_OP2 ! flag - LOGICAL :: WRITE_ANS ! flag LOGICAL :: IS_LOW_PRECISION ! Print MPFACTOR, MEFFMASS values with 2 decimal places of accuracy rather than 6 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** - WRITE_ANS = (PRTANS == 'Y') IS_LOW_PRECISION = (DEBUG(174) == 0) !-------------------------------------------------- @@ -96,10 +88,6 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) IF ((SOL_NAME(1:12) == 'GEN CB MODEL') .AND. (MPFOUT == 'R')) THEN WRITE(F06,9004) MEFMCORD - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,9014) MEFMCORD - ENDIF IF (IS_LOW_PRECISION) THEN WRITE(F06,9101) (I,I=1,NDOFR) @@ -121,11 +109,6 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) WRITE(F06,9302) I, CYCLES, (MPFACTOR_NR(I,J),J=1,NDOFR) ENDIF - IF (WRITE_ANS) THEN - ! Only <= 10 will fit in the DIF Excel spreadsheet - WRITE(ANS,9311) I, CYCLES, (MPFACTOR_NR(I,J),J=1,10) - ENDIF - ENDDO ELSE @@ -143,11 +126,6 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) WRITE(F06,9009) MEFMGRID ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,9015) MEFMCORD - ENDIF - IF (IS_LOW_PRECISION) THEN WRITE(F06,9501) ELSE @@ -164,25 +142,13 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) WRITE(F06,9504) I, CYCLES, (MPFACTOR_N6(I,J),J=1,6) ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,9513) I, CYCLES, (MPFACTOR_N6(I,J),J=1,6) - ENDIF - ENDDO ENDIF WRITE(F06,*) - IF (WRITE_ANS) THEN - WRITE(ANS,*) - ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -195,15 +161,9 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) 9004 FORMAT(13X,' M O D A L P A R T I C I P A T I O N F A C T O R S',/, & 13X,' (dimensionless, in coordinate sys ',I8,' with cols marked by R-set grid/comp)',/) - 9014 FORMAT(20X,' M O D A L P A R T I C I P A T I O N F A C T O R S',/, & - 20X,' (dimensionless, in coordinate sys ',I8,' with cols marked by R-set grid/comp)',/) - 9005 FORMAT(13X,' M O D A L P A R T I C I P A T I O N F A C T O R S',/, & 13X,' (dimensionless, in coordinate sys ',I8,')') - 9015 FORMAT(20X,' M O D A L P A R T I C I P A T I O N F A C T O R S',/, & - 20X,' (dimensionless, in coordinate sys ',I8,')') - 9006 FORMAT(14X,' Reference point is the basic coordinate system origin',/) 9007 FORMAT(14X,' Reference point is the PARAM GRDPNT grid: ',I8,/) @@ -226,8 +186,6 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) 9301 FORMAT(9X,I8,32767(1ES14.6)) - 9311 FORMAT(16X,I8,32767(1ES14.6)) - 9302 FORMAT(9X,I8,32767(1ES14.2)) 9501 FORMAT(13X,'MODE CYCLES T1 T2 T3 R1 R2 R3',/, & @@ -238,8 +196,6 @@ SUBROUTINE WRITE_MPFACTOR ! ( IHDR ) 9503 FORMAT(9X,I8,7(1ES14.6)) - 9513 FORMAT(16X,I8,7(1ES14.6)) - 9504 FORMAT(9X,I8,7(1ES14.2)) ! ********************************************************************************************************************************** diff --git a/Source/LK9/L91/WRITE_PLY_STRAINS.f90 b/Source/LK9/L91/WRITE_PLY_STRAINS.f90 index 0237afce..aa79576f 100644 --- a/Source/LK9/L91/WRITE_PLY_STRAINS.f90 +++ b/Source/LK9/L91/WRITE_PLY_STRAINS.f90 @@ -29,15 +29,13 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) ! Writes blocks of element ply strains for one subcase one element type for elements with PCOMP properties. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, OP2 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OP2 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, LPCOMP_PLIES, NDOFR, NUM_CB_DOFS, & NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE PARAMS, ONLY : PRTANS USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_PLY_STRAINS_BEGEND USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, FTNAME, OGEL USE MODEL_STUF, ONLY : ANY_FAILURE_THEORY, ELEM_ONAME, LABEL, PCOMP, SCNUM, STITLE, TITLE USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OPT @@ -60,7 +58,7 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) INTEGER(LONG) :: BDY_GRID ! Grid for a boundary DOF in CB analyses INTEGER(LONG) :: BDY_DOF_NUM ! DOF number for BDY_GRID/BDY_COMP INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_PLY_STRAINS_BEGEND + REAL(DOUBLE) :: ABS_ANS(10) ! Max ABS for all grids output for each of the 6 disp components REAL(DOUBLE) :: MAX_ANS(10) ! Max for all grids output for each of the 6 disp components @@ -92,12 +90,7 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) ELEMENT_TYPE = -1 DEVICE_CODE = 1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** FILL(1:) = ' ' @@ -216,65 +209,6 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) WRITE(F06,1404) FILL(1: 0), ONAME, FILL(1: 0), FILL(1: 0) ENDIF ENDIF - - IF (PRTANS == 'Y') THEN - WRITE(ANS,*) - WRITE(ANS,*) - IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - WRITE(ANS,101) SCNUM(JSUB) - - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN - WRITE(ANS,101) SCNUM(JSUB) - - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - WRITE(ANS,102) JSUB - - ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - WRITE(ANS,102) JSUB - - ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ! Write info on what CB DOF the output is for - - IF ((JSUB <= NDOFR) .OR. (JSUB >= NDOFR+NVEC)) THEN - IF (JSUB <= NDOFR) THEN - BDY_DOF_NUM = JSUB - ELSE - BDY_DOF_NUM = JSUB-(NDOFR+NVEC) - ENDIF - CALL GET_GRID_AND_COMP ( 'R ', BDY_DOF_NUM, BDY_GRID, BDY_COMP ) - ENDIF - - IF (JSUB <= NDOFR) THEN - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'acceleration', BDY_GRID, BDY_COMP - ELSE IF ((JSUB > NDOFR) .AND. (JSUB <= NDOFR+NVEC)) THEN - WRITE(ANS,104) JSUB, NUM_CB_DOFS, JSUB-NDOFR - ELSE - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'displacement', BDY_GRID, BDY_COMP - ENDIF - - ENDIF - - WRITE(ANS,*) - - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(ANS,302) FILL(1:16) - ELSE - WRITE(ANS,301) FILL(1:16) - ENDIF - IF (ANY_FAILURE_THEORY == 'N') THEN - IF (STRN_OPT == 'VONMISES') THEN - WRITE(ANS,1401) FILL(1:16), ONAME, FILL(1: 0), FILL(1: 0) - ELSE - WRITE(ANS,1402) FILL(1:16), ONAME, FILL(1: 0), FILL(1: 0) - ENDIF - ELSE - IF (STRN_OPT == 'VONMISES') THEN - WRITE(ANS,1403) FILL(1:16), ONAME, FILL(1: 0), FILL(1: 0) - ELSE - WRITE(ANS,1404) FILL(1:16), ONAME, FILL(1: 0), FILL(1: 0) - ENDIF - ENDIF - - ENDIF ENDIF @@ -338,13 +272,6 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) WRITE(F06,1408) FILL(1: 0), EID_OUT_ARRAY(I,2), (OGEL(I,J),J=1,9) ENDIF ENDIF - IF (PRTANS == 'Y') THEN - IF (ANY_FAILURE_THEORY == 'Y') THEN - WRITE(ANS,1416) EID_OUT_ARRAY(I,1), EID_OUT_ARRAY(I,2), (OGEL(I,J),J=1,9) - ELSE - WRITE(ANS,1416) EID_OUT_ARRAY(I,1), EID_OUT_ARRAY(I,2), (OGEL(I,J),J=1,9) - ENDIF - ENDIF ENDDO @@ -380,16 +307,8 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) FILL(1: 0) , (MIN_ANS(I),I=1,10), & FILL(1: 0) , (ABS_ANS(I),I=1,10), FILL(1: 0) - IF (PRTANS == 'Y') THEN - WRITE(ANS,1419) (MAX_ANS(I),I=1,10), (MIN_ANS(I),I=1,10), (ABS_ANS(I),I=1,10) - ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -451,14 +370,7 @@ SUBROUTINE WRITE_PLY_STRAINS ( JSUB, NUM, IHDR, ETYPE, ITABLE ) 1X,A,'ABS* : ',6X,3(1ES13.5),2X,2(1ES14.5),0PF9.3,3(1ES13.5),1ES10.2,/, & 1X,A,'*for output set') -!5011 FORMAT(11X,I8,I5,5(1ES14.6),0PF14.3,3(1ES14.6),1ES14.6) - 1416 FORMAT(11X,I8,I5,5(1ES14.6),0PF14.3,3(1ES14.6),1ES14.6) - 1419 FORMAT(30X,'------------- ------------- ------------- ------------- ------------- ------------- ------------- -------------',& - ' ------------- -------------',/,& - 1X,'MAX (for output set): ',1X,5(ES14.6),0PF14.3,4(ES14.6),/, & - 1X,'MIN (for output set): ',1X,5(ES14.6),0PF14.3,4(ES14.6),//, & - 1X,'ABS (for output set): ',1X,5(ES14.6),0PF14.3,4(ES14.6)) ! ********************************************************************************************************************************** diff --git a/Source/LK9/L91/WRITE_PLY_STRESSES.f90 b/Source/LK9/L91/WRITE_PLY_STRESSES.f90 index a6292949..b7769e3d 100644 --- a/Source/LK9/L91/WRITE_PLY_STRESSES.f90 +++ b/Source/LK9/L91/WRITE_PLY_STRESSES.f90 @@ -29,15 +29,13 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) ! Writes blocks of element ply stresses for one subcase one ! element type for elements with PCOMP properties. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06, OP2 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OP2 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, LPCOMP_PLIES, NDOFR, NUM_CB_DOFS, & SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE PARAMS, ONLY : PRTANS USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_PLY_STRESSES_BEGEND USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, FTNAME, OGEL USE MODEL_STUF, ONLY : ANY_FAILURE_THEORY, ELEM_ONAME, LABEL, PCOMP, SCNUM, STITLE, TITLE USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OPT @@ -60,7 +58,7 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) INTEGER(LONG) :: BDY_GRID ! Grid for a boundary DOF in CB analyses INTEGER(LONG) :: BDY_DOF_NUM ! DOF number for BDY_GRID/BDY_COMP INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_PLY_STRESSES_BEGEND + REAL(DOUBLE) :: ABS_ANS(10) ! Max ABS for all grids output for each of the 6 disp components REAL(DOUBLE) :: MAX_ANS(10) ! Max for all grids output for each of the 6 disp components @@ -84,7 +82,6 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) INTEGER(LONG) :: NTOTAL ! the number of bytes for all NVALUES INTEGER(LONG) :: ISUBCASE ! the subcase ID LOGICAL :: DEBUG_OP2 ! flag - LOGICAL :: WRITE_ANS ! flag INTRINSIC :: MAX, MIN, DABS @@ -93,15 +90,9 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) ANALYSIS_CODE = -1 ELEMENT_TYPE = -1 DEVICE_CODE = 1 - WRITE_ANS = (PRTANS == 'Y') DEBUG_OP2 = .FALSE. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** FILL(1:) = ' ' @@ -232,69 +223,6 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) WRITE(F06,1499) FILL(1: 0), FILL(1: 0), FILL(1: 0), FILL(1: 0) ENDIF ENDIF - - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,*) - IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - WRITE(ANS,101) SCNUM(JSUB) - - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1)) THEN - WRITE(ANS,101) SCNUM(JSUB) - - ELSE IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN - WRITE(ANS,101) JSUB - - ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - WRITE(ANS,102) JSUB - - ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ! Write info on what CB DOF the output is for - - IF ((JSUB <= NDOFR) .OR. (JSUB >= NDOFR+NUM_CB_DOFS)) THEN - IF (JSUB <= NDOFR) THEN - BDY_DOF_NUM = JSUB - ELSE - BDY_DOF_NUM = JSUB-(NDOFR+NUM_CB_DOFS) - ENDIF - CALL GET_GRID_AND_COMP ( 'R ', BDY_DOF_NUM, BDY_GRID, BDY_COMP ) - ENDIF - - IF (JSUB <= NDOFR) THEN - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'acceleration', BDY_GRID, BDY_COMP - ELSE IF ((JSUB > NDOFR) .AND. (JSUB <= NDOFR+NUM_CB_DOFS)) THEN - WRITE(ANS,104) JSUB, NUM_CB_DOFS, JSUB-NDOFR - ELSE - WRITE(ANS,103) JSUB, NUM_CB_DOFS, 'displacement', BDY_GRID, BDY_COMP - ENDIF - - ENDIF - - WRITE(ANS,*) - - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(ANS,302) FILL(1:16) - ELSE - WRITE(ANS,301) FILL(1:16) - ENDIF - IF (ANY_FAILURE_THEORY == 'N') THEN - IF (STRE_OPT == 'VONMISES') THEN - WRITE(ANS,1401) FILL(1:16), ONAME, FILL(1: 0), FILL(1: 0) - WRITE(ANS,1499) FILL(1: 0), FILL(1: 0), FILL(1: 0), FILL(1: 0) - ELSE - WRITE(ANS,1402) FILL(1:16), ONAME, FILL(1: 0), FILL(1: 0) - WRITE(ANS,1499) FILL(1: 0), FILL(1: 0), FILL(1: 0), FILL(1: 0) - ENDIF - ELSE - IF (STRE_OPT == 'VONMISES') THEN - WRITE(ANS,1403) FILL(1:16), ONAME, FILL(1: 0), FILL(1: 0) - WRITE(ANS,1499) FILL(1: 0), FILL(1: 0), FILL(1: 0), FILL(1: 0) - ELSE - WRITE(ANS,1404) FILL(1:16), ONAME, FILL(1: 0), FILL(1: 0) - WRITE(ANS,1499) FILL(1: 0), FILL(1: 0), FILL(1: 0), FILL(1: 0) - ENDIF - ENDIF - - ENDIF ENDIF @@ -358,13 +286,6 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) WRITE(F06,1408) FILL(1: 0), EID_OUT_ARRAY(I,2), (OGEL(I,J),J=1,9) ENDIF ENDIF - IF (PRTANS == 'Y') THEN - IF (ANY_FAILURE_THEORY == 'Y') THEN - WRITE(ANS,1416) EID_OUT_ARRAY(I,1), EID_OUT_ARRAY(I,2), (OGEL(I,J),J=1,9) - ELSE - WRITE(ANS,1416) EID_OUT_ARRAY(I,1), EID_OUT_ARRAY(I,2), (OGEL(I,J),J=1,9) - ENDIF - ENDIF ENDDO @@ -400,16 +321,8 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) FILL(1: 0) , (MIN_ANS(I),I=1,10), & FILL(1: 0) , (ABS_ANS(I),I=1,10), FILL(1: 0) - IF (PRTANS == 'Y') THEN - WRITE(ANS,1419) (MAX_ANS(I),I=1,10), (MIN_ANS(I),I=1,10), (ABS_ANS(I),I=1,10) - ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -478,13 +391,6 @@ SUBROUTINE WRITE_PLY_STRESSES ( JSUB, NUM, IHDR, ETYPE, ITABLE ) 1X,A,'ABS* : ',6X,3(1ES13.5),2X,2(1ES14.5),0PF9.3,3(1ES13.5),1ES10.2,/, & 1X,A,'*for output set') - 1416 FORMAT(11X,I8,I5,5(1ES14.6),0PF14.3,3(1ES14.6),1ES14.6) - - 1419 FORMAT(30X,'------------- ------------- ------------- ------------- ------------- ------------- ------------- -------------',& - ' ------------- -------------',/,& - 1X,'MAX (for output set): ',1X,5(ES14.6),0PF14.3,4(ES14.6),/, & - 1X,'MIN (for output set): ',1X,5(ES14.6),0PF14.3,4(ES14.6),//, & - 1X,'ABS (for output set): ',1X,5(ES14.6),0PF14.3,4(ES14.6)) ! ********************************************************************************************************************************** diff --git a/Source/LK9/L91/WRITE_ROD.f90 b/Source/LK9/L91/WRITE_ROD.f90 index 50dedd4a..03e98159 100644 --- a/Source/LK9/L91/WRITE_ROD.f90 +++ b/Source/LK9/L91/WRITE_ROD.f90 @@ -24,22 +24,20 @@ ! End MIT license text. - SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & + SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, ITABLE, & TITLE, SUBTITLE, LABEL, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_OP2) -! Routine for writing output to text files F06 and ANS for ROD element stresses. Up to 2 elements written per line of output. -! Data is first written to character variables and then that character variable is output the F06 and ANS. +! Routine for writing output to text files F06 for ROD element stresses. Up to 2 elements written per line of output. +! Data is first written to character variables and then that character variable is output the F06. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ANS, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ROD_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE LINK9_STUFF, ONLY : EID_OUT_ARRAY, MSPRNT, OGEL - USE PARAMS, ONLY : PRTANS USE WRITE_ROD_USE_IFs IMPLICIT NONE @@ -47,7 +45,6 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'WRITE_ROD' INTEGER(LONG), INTENT(IN) :: ISUBCASE ! the current subcase CHARACTER(LEN=*), INTENT(IN) :: FILL_F06 ! Padding for output format - CHARACTER(LEN=*), INTENT(IN) :: FILL_ANS ! Padding for output format INTEGER(LONG), INTENT(IN) :: ITABLE ! the current op2 subtable, should be -3, -5, ... CHARACTER(LEN=128), INTENT(IN) :: TITLE ! the model TITLE CHARACTER(LEN=128), INTENT(IN) :: SUBTITLE ! the subcase SUBTITLE @@ -59,8 +56,6 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & CHARACTER( 1*BYTE) :: MSFLAG ! If margin is negative, MSFLAG is an * CHARACTER(118*BYTE) :: RLINE_F06 ! Result of concatenating char. variables below to make a line of ! stress output for 1 or 2 CROD's - CHARACTER( 59*BYTE) :: RLINE_ANS ! Result of concatenating char. variables below to make a line of -! stress output for 1 CROD CHARACTER( 8*BYTE) :: REID1 ! Internal file: element ID of 1st CROD CHARACTER( 14*BYTE) :: RSTR11 ! Internal file: axial stress in 1st CROD @@ -84,19 +79,14 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ROD_BEGEND + REAL(DOUBLE) :: ABS_ANS(4) ! Max ABS for all grids output for each of the 6 disp components REAL(DOUBLE) :: MAX_ANS(4) ! Max for all grids output for each of the 6 disp components REAL(DOUBLE) :: MIN_ANS(4) ! Min for all grids output for each of the 6 disp components INTEGER(LONG) :: ELEM_TYPE ! should be 1=CROD, 3=CTUBE, 10=CONROD -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ELEM_TYPE = 1 ! CROD @@ -107,7 +97,6 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & DO I=1,NUM,2 RLINE_F06(1:) = ' ' - RLINE_ANS(1:) = ' ' REID1(1:) = ' ' RSTR11(1:) = ' ' @@ -195,29 +184,13 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & RLINE_F06 = REID1//RSTR11//RMS11//RMSF11//RSTR12//RMS12//RMSF12//REID2//RSTR21//RMS21//RMSF21//RSTR22//RMS22//RMSF22 WRITE(F06,2205) FILL_F06, RLINE_F06 - IF (PRTANS == 'Y') THEN - RLINE_ANS = REID1//RSTR11//RMS31//RSTR12//RMS32 - WRITE(ANS,2205) FILL_ANS, RLINE_ANS - IF (I+1 <= NUM) THEN - RLINE_ANS = REID2//RSTR21//RMS41//RSTR22//RMS42 - WRITE(ANS,2205) FILL_ANS, RLINE_ANS - ENDIF - ENDIF ENDDO CALL GET_MAX_MIN_ABS ( 1, 4 ) WRITE(F06,9104) (MAX_ANS(J),J=1,4),(MIN_ANS(J),J=1,4),(ABS_ANS(J),J=1,4) - IF (PRTANS == 'Y') THEN - WRITE(ANS,9114) (MAX_ANS(J),J=1,4),(MIN_ANS(J),J=1,4),(ABS_ANS(J),J=1,4) - ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -233,8 +206,6 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & 2204 FORMAT(A,A) 2205 FORMAT(A,A) - - 2215 FORMAT(A,I8,2(1ES14.6,4X,F10.3)) 9104 FORMAT( 1X,' ------------- --------- ------------- ---------',/, & 1X,'MAX* : ',ES14.6,ES10.2,1X,ES14.6,ES10.2/, & @@ -242,11 +213,6 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & 1X,'ABS* : ',ES14.6,ES10.2,1X,ES14.6,ES10.2,/, & 1X,'*for output set') -9114 FORMAT(11X,' ------------- ------------- ------------- -------------',/, & - 1X,'MAX (for output set): ',2(ES14.6,ES14.2),/, & - 1X,'MIN (for output set): ',2(ES14.6,ES14.2),//, & - 1X,'ABS (for output set): ',2(ES14.6,ES14.2)) - ! ********************************************************************************************************************************** ! ################################################################################################################################## @@ -309,7 +275,7 @@ END SUBROUTINE WRITE_ROD SUBROUTINE OUTPUT2_WRITE_OES_ROD(ISUBCASE, ELEM_TYPE, NUM, ITABLE, TITLE, SUBTITLE, LABEL, & FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_OP2) ! writes the CROD/CTUBE/CONROD stress/strain results. -! Data is first written to character variables and then that character variable is output the F06 and ANS. +! Data is first written to character variables and then that character variable is output the F06. ! ! Parameters ! ========== diff --git a/Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 b/Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 index 0dc1d10c..0d847433 100644 --- a/Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 +++ b/Source/LK9/L92/CALC_ELEM_NODE_FORCES.f90 @@ -29,10 +29,9 @@ SUBROUTINE CALC_ELEM_NODE_FORCES ! Calculates elem nodal forces in local elem coord system for one elem and one subcase for all element types. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, INT_SC_NUM, JTSUB, NCORD, NGRID, WARN_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CALC_ELEM_NODE_FORCES_BEGEND USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS USE MODEL_STUF, ONLY : AGRID, BGRID, CORD, EID, ELAS_COMP, ELDOF, ELGP, GRID, KE, KEG, KEO_BUSH, & @@ -52,7 +51,7 @@ SUBROUTINE CALC_ELEM_NODE_FORCES INTEGER(LONG) :: NCOLS ! Number of rows in element stiffness matrix INTEGER(LONG) :: NROWS ! Number of cols in element stiffness matrix INTEGER(LONG) :: NUM_COMPS_GRID_1 ! No. displ components for 1st grid on ELAS elems - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_ELEM_NODE_FORCES_BEGEND + REAL(DOUBLE) :: DUM1(3),DUM2(3) ! Intermediate variables REAL(DOUBLE) :: PHID, THETAD ! Outputs from subr GEN_T0L @@ -61,12 +60,7 @@ SUBROUTINE CALC_ELEM_NODE_FORCES REAL(DOUBLE) :: TET_GA_GB(3,3) ! Transpose of TE REAL(DOUBLE) :: TR(12,12) ! Matrix with 4 TE matrices on the diagonal -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** NROWS = ELDOF @@ -83,7 +77,7 @@ SUBROUTINE CALC_ELEM_NODE_FORCES IF (TYPE(1:4) == 'ELAS') THEN ! Calculate forces for ELAS1-4 elems I1 = ELAS_COMP(1) - CALL GET_GRID_NUM_COMPS ( AGRID(1), NUM_COMPS_GRID_1, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(1), NUM_COMPS_GRID_1, SUBR_NAME ) I2 = NUM_COMPS_GRID_1 + ELAS_COMP(2) PEL(I1) = KE(I1,I1)*UEL(I1) + KE(I1,I2)*UEL(I2) ! Note: KE is global and local for the ELAS elems PEL(I2) = KE(I2,I1)*UEL(I1) + KE(I2,I2)*UEL(I2) @@ -234,12 +228,7 @@ SUBROUTINE CALC_ELEM_NODE_FORCES WRITE(F06,5000) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/CALC_ELEM_STRAINS.f90 b/Source/LK9/L92/CALC_ELEM_STRAINS.f90 index 3865c327..3d80aaa7 100644 --- a/Source/LK9/L92/CALC_ELEM_STRAINS.f90 +++ b/Source/LK9/L92/CALC_ELEM_STRAINS.f90 @@ -30,11 +30,10 @@ SUBROUTINE CALC_ELEM_STRAINS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL, ! that will be written to the F06 file. USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : TYPE - USE SUBR_BEGEND_LEVELS, ONLY : CALC_ELEM_STRAINS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE CALC_ELEM_STRAINS_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE CALC_ELEM_STRAINS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL, ! called here so we can check that we don't try to write more rows INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_ELEM_STRAINS_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Calculate STRAIN for shell and solid elements @@ -80,12 +74,7 @@ SUBROUTINE CALC_ELEM_STRAINS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL, ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/CALC_ELEM_STRESSES.f90 b/Source/LK9/L92/CALC_ELEM_STRESSES.f90 index 2e3b3a14..c985cab5 100644 --- a/Source/LK9/L92/CALC_ELEM_STRESSES.f90 +++ b/Source/LK9/L92/CALC_ELEM_STRESSES.f90 @@ -30,11 +30,10 @@ SUBROUTINE CALC_ELEM_STRESSES ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL ! that will be written to the F06 file USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : TYPE - USE SUBR_BEGEND_LEVELS, ONLY : CALC_ELEM_STRESSES_BEGEND USE CONSTANTS_1, ONLY : ZERO USE CALC_ELEM_STRESSES_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE CALC_ELEM_STRESSES ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL ! called here so we can check that we don't try to write more rows INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_ELEM_STRESSES_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Calculate STRESS(4-6) for elements that have nonzero STRESS(4-6) @@ -80,12 +74,7 @@ SUBROUTINE CALC_ELEM_STRESSES ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OGEL ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/ELEM_STRE_STRN_ARRAYS.f90 b/Source/LK9/L92/ELEM_STRE_STRN_ARRAYS.f90 index fd7e70e3..a40492bb 100644 --- a/Source/LK9/L92/ELEM_STRE_STRN_ARRAYS.f90 +++ b/Source/LK9/L92/ELEM_STRE_STRN_ARRAYS.f90 @@ -39,10 +39,9 @@ SUBROUTINE ELEM_STRE_STRN_ARRAYS ( STR_PT_NUM ) ! the BAR element stresses at the 4 points on the cross-section have to be processed from the STRESS array generated here) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, INT_SC_NUM, JTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ELEM_STRE_STRN_ARRAYS_BEGEND USE CONSTANTS_1, ONLY : ZERO, one, four USE MODEL_STUF, ONLY : ALPVEC, BE1, BE2, BE3, DT, EM, EB, ES, ET, ELDOF, PEL, PHI_SQ, STRAIN, STRESS, SUBLOD, & TREF, TYPE, UEL, UEB, SE1, SE2, SE3, STE1, STE2, STE3, ELGP, ISOLID @@ -59,7 +58,7 @@ SUBROUTINE ELEM_STRE_STRN_ARRAYS ( STR_PT_NUM ) INTEGER(LONG), INTENT(IN) :: STR_PT_NUM ! Which point (3rd index in SEi matrices) this call is for INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: K ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELEM_STRE_STRN_ARRAYS_BEGEND + INTEGER(LONG) :: STR_CID_SOLID REAL(DOUBLE) :: ALPT(6) ! Col of ALPVEC times temperatures @@ -87,12 +86,7 @@ SUBROUTINE ELEM_STRE_STRN_ARRAYS ( STR_PT_NUM ) REAL(DOUBLE) :: TBAR ! Average elem temperature REAL(DOUBLE) :: STR_TENSOR(3,3) ! 2D stress or strain tensor -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC, ' STR_PT_NUM = ', STR_PT_NUM - 9001 FORMAT(1X,A,' BEGN ',F10.3, A, I8) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -458,12 +452,7 @@ SUBROUTINE ELEM_STRE_STRN_ARRAYS ( STR_PT_NUM ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/ELMDIS.f90 b/Source/LK9/L92/ELMDIS.f90 index 05597f46..d72d7741 100644 --- a/Source/LK9/L92/ELMDIS.f90 +++ b/Source/LK9/L92/ELMDIS.f90 @@ -29,12 +29,11 @@ SUBROUTINE ELMDIS ! Get displs for one element, one subcase from list of all displ's (in UG_COL). Transform them to local elem coords. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, INT_SC_NUM, meldof, MELGP, NCORD, NGRID USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START - USE SUBR_BEGEND_LEVELS, ONLY : ELMDIS_BEGEND USE MODEL_STUF, ONLY : AGRID, CAN_ELEM_TYPE_OFFSET, GRID, CORD, BGRID, ELGP, ELDOF, GRID_ID, OFFSET, OFFDIS, & SCNUM, TE, TYPE, UEB, UEG, UEL, UGG USE COL_VECS, ONLY : UG_COL @@ -64,7 +63,7 @@ SUBROUTINE ELMDIS INTEGER(LONG), PARAMETER :: PCOL = 1 ! An input to subr MATPUT, MATGET called herein INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: TDOF_ROW ! Row no. in array TDOF to find GDOF DOF number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMDIS_BEGEND + REAL(DOUBLE) :: DXI ! An offset distance in direction 1 REAL(DOUBLE) :: DYI ! An offset distance in direction 2 @@ -73,12 +72,7 @@ SUBROUTINE ELMDIS REAL(DOUBLE) :: DUM1(3),DUM2(3) ! Dummy arrays needed in transforming from global to basic coords REAL(DOUBLE) :: THETAD,PHID ! Returns from subr GEN_T0L (not used here) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -99,7 +93,7 @@ SUBROUTINE ELMDIS ! CALL CALC_TDOF_ROW_NUM ( AGRID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 ! TDOF has rows in grid point numerical order @@ -124,7 +118,7 @@ SUBROUTINE ELMDIS ! --------------------------------------------------------------------------------------------------------------------------- I2 = 0 ! (1) Transform global displs at grids to global displs at elem nodes DO I=1,ELGP ! First assume no offset at this node - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 UEG(I2) = UGG(I2) @@ -174,7 +168,7 @@ SUBROUTINE ELMDIS ENDDO I2 = I2 + NUM_COMPS ELSE ! If global is basic, get UEB terms directly from UEG - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 UEB(I2) = UEG(I2) @@ -219,12 +213,7 @@ SUBROUTINE ELMDIS CALL DEBUG_ELMDIS ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -260,7 +249,7 @@ SUBROUTINE DEBUG_ELMDIS I2 = 0 DO I=1,ELGP ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -271,7 +260,7 @@ SUBROUTINE DEBUG_ELMDIS I2 = 0 DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 ENDDO @@ -279,7 +268,7 @@ SUBROUTINE DEBUG_ELMDIS I2 = 0 DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 ENDDO @@ -287,7 +276,7 @@ SUBROUTINE DEBUG_ELMDIS I2 = 0 DO I=1,ELGP - CALL GET_GRID_NUM_COMPS ( AGRID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(I), NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS I2 = I2 + 1 ENDDO diff --git a/Source/LK9/L92/ELMDIS_PLY.f90 b/Source/LK9/L92/ELMDIS_PLY.f90 index bd2b9a94..64e55780 100644 --- a/Source/LK9/L92/ELMDIS_PLY.f90 +++ b/Source/LK9/L92/ELMDIS_PLY.f90 @@ -30,12 +30,11 @@ SUBROUTINE ELMDIS_PLY ! the laminate). Result goes back into UEL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, f06 + USE IOUNT1, ONLY : f06 USE SCONTR, ONLY : BLNK_SUB_NAM USE CONSTANTS_1, ONLY : CONV_DEG_RAD USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : ELGP, ELDOF, UEL, ZPLY - USE SUBR_BEGEND_LEVELS, ONLY : ELMDIS_PLY_BEGEND USE ELMDIS_PLY_USE_IFs @@ -44,16 +43,11 @@ SUBROUTINE ELMDIS_PLY CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ELMDIS_PLY' INTEGER(LONG) :: I,j ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ELMDIS_PLY_BEGEND + REAL(DOUBLE) :: DUM(6*ELGP) ! Intermediate variable in the calculation of UEL for the ply -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO I=1,ELGP @@ -70,12 +64,7 @@ SUBROUTINE ELMDIS_PLY ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/GET_COMP_SHELL_ALLOWS.f90 b/Source/LK9/L92/GET_COMP_SHELL_ALLOWS.f90 index 686d6ebb..aa40dd71 100644 --- a/Source/LK9/L92/GET_COMP_SHELL_ALLOWS.f90 +++ b/Source/LK9/L92/GET_COMP_SHELL_ALLOWS.f90 @@ -30,12 +30,10 @@ SUBROUTINE GET_COMP_SHELL_ALLOWS ( STRE_ALLOWABLES, STRN_ALLOWABLES ) ! data on the MATi Bulk Data entries in material processing subrs called by subr EMG. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE TIMDAT, ONLY : TSEC USE SCONTR, ONLY : BLNK_SUB_NAM USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM USE MODEL_STUF, ONLY : ULT_STRE, ULT_STRN - USE SUBR_BEGEND_LEVELS, ONLY : GET_COMP_SHELL_ALLOWS_BEGEND USE GET_COMP_SHELL_ALLOWS_USE_IFs @@ -43,17 +41,12 @@ SUBROUTINE GET_COMP_SHELL_ALLOWS ( STRE_ALLOWABLES, STRN_ALLOWABLES ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'GET_COMP_SHELL_ALLOWS' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_COMP_SHELL_ALLOWS_BEGEND + REAL(DOUBLE), INTENT(OUT) :: STRE_ALLOWABLES(9)! Stress allowables for the material REAL(DOUBLE), INTENT(OUT) :: STRN_ALLOWABLES(9)! Strain allowables for the material -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** STRE_ALLOWABLES(1) = ULT_STRE(1,1) ! Axis 1 tension stress allowable @@ -76,12 +69,7 @@ SUBROUTINE GET_COMP_SHELL_ALLOWS ( STRE_ALLOWABLES, STRN_ALLOWABLES ) STRN_ALLOWABLES(8) = ULT_STRN(8,3) ! Plane 13 shear strain allowable (from transv shear matl props) STRN_ALLOWABLES(9) = ULT_STRN(7,1) ! Plane 12 shear strain allowable -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 b/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 index ea40fba3..ef1a6214 100644 --- a/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 +++ b/Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90 @@ -31,11 +31,10 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) ! should be zero USE PENTIUM_II_KIND, ONLY : BYTE, SHORT, LONG, DOUBLE - USE IOUNT1, ONLY : ANS, ERR, F04, F06, OP2, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, OP2, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, GROUT_GPFO_BIT, IBIT, INT_SC_NUM, JTSUB, NDOFG, NDOFM, MELDOF, NDOFO, NDOFR,& NELE, NGRID, NUM_CB_DOFS, NVEC, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GP_FORCE_BALANCE_PROC_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE_HUNDRED USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -43,7 +42,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) GROUT, LABEL, PLY_NUM, PEG, PTE, SCNUM, STITLE, SUBLOD, TITLE, TYPE USE LINK9_STUFF, ONLY : GID_OUT_ARRAY USE COL_VECS, ONLY : FG_COL, PG_COL, QGm_COL, QGs_COL, QGr_COL, UG_COL - USE PARAMS, ONLY : EPSIL, PRTANS + USE PARAMS, ONLY : EPSIL USE CC_OUTPUT_DESCRIBERS, ONLY : GPFO_OUT USE GP_FORCE_BALANCE_PROC_USE_IFs @@ -76,7 +75,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) INTEGER(LONG) :: NUM_CONN_ELEMS ! The number of elements that are connected to a specific grid INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: TDOF_ROW ! Row no. in array TDOF to find GDOF DOF number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GP_FORCE_BALANCE_PROC_BEGEND + INTEGER(SHORT), DIMENSION(1) :: Udd = (/0220/) ! 0220 is the 4 digit ASCII code for a capital U double-dot @@ -100,7 +99,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) INTEGER(LONG) :: NROWS, NCOLS, NNODE_GPFORCE, INODE_GPFORCE, IERR ! GPFORCE table helper - LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_ANS, IS_GPFORCE_SUMMARY_INFO ! flags + LOGICAL :: WRITE_F06, WRITE_OP2, IS_GPFORCE_SUMMARY_INFO ! flags LOGICAL :: IS_MODES, IS_THERMAL, IS_APP, IS_SPC, IS_MPC INTEGER(LONG) :: ISUBCASE_INDEX ! helper to get the title/subcase @@ -124,32 +123,18 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) CHARACTER*8, ALLOCATABLE :: GPFORCE_ETYPE(:) ! currently unused REAL, ALLOCATABLE :: GPFORCE_FXYZ_MXYZ(:,:) ! currently unused -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! GPFORCE is unsupported for buckling decks IF (SOL_NAME(1:8) == "BUCKLING") THEN - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - ENDIF RETURN ENDIF ! Print some summary info for max abs value of GP force balance for each solution vector IS_GPFORCE_SUMMARY_INFO = (DEBUG(192) > 0) - ! Write problem answers (displs, etc) to filename.ANS as well as to filename.F06 - ! (where filename is the name of the DAT data file submitted to MYSTRAN). - ! This feature is generally only useful to the author when performing checkout of test problem answers - WRITE_ANS = (PRTANS == 'Y') - IS_THERMAL = (SUBLOD(INT_SC_NUM,2) > 0) IS_MODES = ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) @@ -270,45 +255,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) WRITE(F06,9200) ENDIF ENDIF - - IF (WRITE_ANS) THEN - WRITE(ANS,*) - WRITE(ANS,*) - IF (SOL_NAME(1:7) == 'STATICS') THEN - WRITE(ANS,9101) SCNUM(JVEC) - - ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - WRITE(ANS,9102) JVEC - - ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ! Write info on what CB DOF the output is for - - IF ((JVEC <= NDOFR) .OR. (JVEC >= NDOFR+NVEC)) THEN - IF (JVEC <= NDOFR) THEN - BNDY_DOF_NUM = JVEC - ELSE - BNDY_DOF_NUM = JVEC-(NDOFR+NVEC) - ENDIF - CALL GET_GRID_AND_COMP ( 'R ', BNDY_DOF_NUM, BNDY_GRID, BNDY_COMP ) - ENDIF - - IF (JVEC <= NDOFR) THEN - WRITE(ANS,9103) JVEC, NUM_CB_DOFS, 'acceleration', BNDY_GRID, BNDY_COMP - ELSE IF ((JVEC > NDOFR) .AND. (JVEC <= NDOFR+NVEC)) THEN - WRITE(ANS,9105) JVEC, NUM_CB_DOFS, JVEC-NDOFR - ELSE - WRITE(ANS,9103) JVEC, NUM_CB_DOFS, 'displacement', BNDY_GRID, BNDY_COMP - ENDIF - - ENDIF - - WRITE(ANS,*) - IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(ANS,8999) - ELSE - WRITE(ANS,9200) - ENDIF - - ENDIF + ENDIF ! Process grid point force balance output requests. @@ -356,7 +303,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) !FLUSH(ERR) IB = IAND(GROUT(I,INT_SC_NUM),IBIT(GROUT_GPFO_BIT)) GRID_NUM = GRID(I,1) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) IF ((IB > 0) .AND. (NUM_COMPS == 6)) THEN ! Do not do force balance for SPOINT's G_CID = GRID(I,3) @@ -442,7 +389,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) DO I=1,NGRID IB = IAND(GROUT(I,INT_SC_NUM),IBIT(GROUT_GPFO_BIT)) GRID_NUM = GRID(I,1) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) IF ((IB > 0) .AND. (NUM_COMPS == 6)) THEN ! Do not do force balance for SPOINT's G_CID = GRID(I,3) @@ -450,10 +397,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) WRITE(F06,9201) GRID_NUM, G_CID WRITE(F06,9202) ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,9201) GRID_NUM, G_CID - WRITE(ANS,9202) - ENDIF ! Get element equiv thermal loads so we can sub them from applied loads OPT(1) = 'N' ! OPT(1) is for calc of ME @@ -494,7 +437,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) ! get applied load, thermal load, SPC force, MPC force for a single node CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_NUM, IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -607,18 +550,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) ENDIF ENDIF - IF (WRITE_ANS) THEN - IF (IS_APP) WRITE(ANS,9203) (PG1(J),J=1,6) ! applied load - IF (IS_THERMAL) THEN - WRITE(ANS,9204) (-PTET(J),J=1,6) ! thermal - ENDIF - IF(IS_SPC) WRITE(ANS,9205) (QGs1(J),J=1,6) ! spc force - IF(IS_MPC) WRITE(ANS,9206) (QGm1(J),J=1,6) ! mpc force - IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN - WRITE(ANS,9207) (-FG1(J),J=1,6) ! inertia force - ENDIF - ENDIF - ! Calc elem forces OPT(1) = 'N' ! OPT(1) is for calc of ME OPT(2) = 'Y' ! OPT(2) is for calc of PTE @@ -666,9 +597,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) ENDIF INODE_GPFORCE = INODE_GPFORCE + 1 IF (WRITE_F06) WRITE(F06,9209) TYPE, EID, (-PEG1(L),L=1,6) ! element forces - IF (WRITE_ANS) THEN - WRITE(ANS,9209) TYPE, EID, (-PEG1(L),L=1,6) - ENDIF ENDIF ENDDO ENDDO @@ -708,19 +636,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) ENDDO ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,9210) - IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN - IF (NDOFO == 0) THEN - WRITE(ANS,9211) (TOTALS(J),J=1,6) - ELSE - WRITE(ANS,9310) (TOTALS(J),J=1,6) - ENDIF - ELSE - WRITE(ANS,9211) (TOTALS(J),J=1,6) ! KEEP THIS - ENDIF - ENDIF - ENDIF !FLUSH(F06) !FLUSH(ERR) @@ -739,7 +654,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) CALL COUNTER_PROGRESS(I) ENDDO WRITE(SC1,*) CR13 - IF (WRITE_F06 .OR. WRITE_ANS) THEN + IF (WRITE_F06) THEN CALL CALCULATE_GPFB_IMBALANCE(CHAR_PCT, MAX_ABS, MAX_ABS_PCT, MAX_ABS_GRID, MAX_ABS_ALL_GRDS) ENDIF @@ -821,15 +736,9 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER ) ENDIF FLUSH(OP2) FLUSH(F06) - !FLUSH(ANS) FLUSH(ERR) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -944,7 +853,7 @@ SUBROUTINE CALCULATE_GPFB_IMBALANCE(CHAR_PCT, MAX_ABS, MAX_ABS_PCT, MAX_ABS_GRID ! - calc % of grid force imbalance as a % of the largest ! force item in that component USE PENTIUM_II_KIND, ONLY : BYTE, SHORT, LONG, DOUBLE - USE IOUNT1, ONLY : ANS, F06 + USE IOUNT1, ONLY : F06 USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -978,16 +887,6 @@ SUBROUTINE CALCULATE_GPFB_IMBALANCE(CHAR_PCT, MAX_ABS, MAX_ABS_PCT, MAX_ABS_GRID ENDIF WRITE(F06,9218) (MAX_ABS_GRID(I),I=1,6) ENDIF - IF (WRITE_ANS) THEN - WRITE(ANS,9214) - WRITE(ANS,9202) - WRITE(ANS,9215) (MAX_ABS_ALL_GRDS(I),I=1,6) - IF (DEBUG(192) > 1) THEN - WRITE(ANS,9216) (MAX_ABS(I),I=1,6) - WRITE(ANS,9217) (CHAR_PCT(I),I=1,6) - ENDIF - WRITE(ANS,9218) (MAX_ABS_GRID(I),I=1,6) - ENDIF ENDIF 9202 FORMAT(1X, ' T1 T2 T3 R1 R2 R3',/) @@ -1011,7 +910,7 @@ END SUBROUTINE CALCULATE_GPFB_IMBALANCE SUBROUTINE OUTPUT2_WRITE_OGF(ISUBCASE, NUM, TITLE, SUBTITLE, LABEL, & ANALYSIS_CODE, FIELD5_INT_MODE, FIELD6_EIGENVALUE) ! writes the grid point force results header. -! Data is first written to character variables and then that character variable is output the F06 and ANS. +! Data is first written to character variables and then that character variable is output the F06. ! ! Parameters ! ========== diff --git a/Source/LK9/L92/INDEP_FAILURE_INDEX.f90 b/Source/LK9/L92/INDEP_FAILURE_INDEX.f90 index 80c12ea7..aacd5bcf 100644 --- a/Source/LK9/L92/INDEP_FAILURE_INDEX.f90 +++ b/Source/LK9/L92/INDEP_FAILURE_INDEX.f90 @@ -29,7 +29,7 @@ SUBROUTINE INDEP_FAILURE_INDEX ( STREi, STRNi, STRE_ALLOWABLES, STRN_ALLOWABLES, ! Calculates ply failure index based on failure criteria defined by the user on the PCOMP Bulk Data entry (e.g. max strain) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO @@ -37,7 +37,6 @@ SUBROUTINE INDEP_FAILURE_INDEX ( STREi, STRNi, STRE_ALLOWABLES, STRN_ALLOWABLES, USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : FAILURE_THEORY - USE SUBR_BEGEND_LEVELS, ONLY : INDEP_FAILURE_INDEX_BEGEND USE INDEP_FAILURE_INDEX_USE_IFs @@ -46,7 +45,7 @@ SUBROUTINE INDEP_FAILURE_INDEX ( STREi, STRNi, STRE_ALLOWABLES, STRN_ALLOWABLES, CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'INDEP_FAILURE_INDEX' INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = INDEP_FAILURE_INDEX_BEGEND + REAL(DOUBLE), INTENT(IN) :: STRE_ALLOWABLES(9)! Allowable stresses (incl tension and compr for normal stresses) REAL(DOUBLE), INTENT(IN) :: STRN_ALLOWABLES(9)! Allowable strains (incl tension and compr for normal stresses) @@ -60,12 +59,7 @@ SUBROUTINE INDEP_FAILURE_INDEX ( STREi, STRNi, STRE_ALLOWABLES, STRN_ALLOWABLES, REAL(DOUBLE) :: R,S,T ! Allowable shear stresses in planes 23, 13, 12 REAL(DOUBLE) :: RATIO(6) ! Ratios of stress or strain to an allowable -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -222,12 +216,7 @@ SUBROUTINE INDEP_FAILURE_INDEX ( STREi, STRNi, STRE_ALLOWABLES, STRN_ALLOWABLES, ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP1.f90 b/Source/LK9/L92/OFP1.f90 index 68b20fc1..89633306 100644 --- a/Source/LK9/L92/OFP1.f90 +++ b/Source/LK9/L92/OFP1.f90 @@ -29,13 +29,12 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N ! Processes grid point accel, displ and applied force output requests for one subcase. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, OT4 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OT4 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, GROUT_ACCE_BIT, GROUT_DISP_BIT, GROUT_OLOA_BIT, IBIT, INT_SC_NUM,& MELGP, MOGEL, NGRID, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP1_BEGEND USE CONSTANTS_1, ONLY : ZERO - USE PARAMS, ONLY : OTMSKIP, PRTANS, PRTNEU + USE PARAMS, ONLY : OTMSKIP, PRTNEU USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START USE MODEL_STUF, ONLY : ANY_ACCE_OUTPUT, ANY_DISP_OUTPUT, ANY_OLOA_OUTPUT, GROUT, GRID, GRID_ID USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, MAXREQ, OGEL @@ -48,7 +47,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N IMPLICIT NONE - LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH, WRITE_ANS ! flag + LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH ! flag CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'OFP1' CHARACTER(LEN=*) , INTENT(IN) :: WHAT ! Indicator whether to process displ or force output requests CHARACTER( 1*BYTE) :: ACCE_ALL_SAME_CID ! Indicator of whether all grids, for the output set, have the same @@ -80,7 +79,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N INTEGER(LONG) :: NUM ! Count of the number of rows added to array OGEL INTEGER(LONG) :: NUM_COMPS ! Either 6 or 1 depending on whether grid is a physical grid or a SPOINT INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP1_BEGEND + INTEGER(LONG) :: TDOF_ROW ! Row no. in array TDOF to find GDOF DOF number LOGICAL :: WRITE_NEU @@ -88,15 +87,9 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N WRITE(ERR,9000) "OFP1 - disp, accel and applied force output" 9000 FORMAT(' *DEBUG: RUNNING=', A) - WRITE_ANS = (PRTANS == 'Y') WRITE_NEU = (PRTNEU == 'Y') -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO I=1,MAXREQ @@ -154,7 +147,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N !xx CALL CALC_TDOF_ROW_NUM ( GRID_ID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -240,7 +233,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N GID_OUT_ARRAY(NUM,MELGP+1) = GRID(I,5) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -323,7 +316,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N GID_OUT_ARRAY(NUM,MELGP+1) = GRID(I,5) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -376,12 +369,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9003) SUBR_NAME,TSEC - 9003 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP2.f90 b/Source/LK9/L92/OFP2.f90 index 5adf1c94..b4ba235a 100644 --- a/Source/LK9/L92/OFP2.f90 +++ b/Source/LK9/L92/OFP2.f90 @@ -29,14 +29,13 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 ! Processes SPC and MPC force output requests for 1 subcase. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06, OT4 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, OT4 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, GROUT_SPCF_BIT, GROUT_MPCF_BIT, GROUT_GPFO_BIT, IBIT, INT_SC_NUM,& MELGP, MOGEL, NGRID, NDOFF, NDOFG, NDOFM, NDOFN, NDOFS, NDOFSA, NTERM_GMN, & NTERM_HMN, NTERM_KFS, NTERM_KFSD, NTERM_LMN, NTERM_MFS, NTERM_QS, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP2_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START, TDOFI USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL, GEN_MASS, MEFFMASS, MPFACTOR_N6 @@ -60,7 +59,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 IMPLICIT NONE - LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH, WRITE_ANS ! flag + LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH ! flag CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'OFP2' CHARACTER(LEN=*) , INTENT(IN) :: WHAT ! Indicator of whether to process output requests for SPC or MPC forces CHARACTER(LEN=*) , INTENT(IN) :: ZERO_GEN_STIFF ! Indicator of whether there are zero gen stiffs (can't calc MEFFMASS) @@ -104,7 +103,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 INTEGER(LONG) :: ROW_NUM_START ! DOF number where TDOF data begins for a grid INTEGER(LONG) :: SDOF ! S-set DOF number INTEGER(LONG) :: SADOF ! SA-set DOF number - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP2_BEGEND + INTEGER(LONG) :: TDOF_ROW ! Row no. in array TDOF to find GDOF DOF number REAL(DOUBLE) :: DEN ! Intermediate variable @@ -124,12 +123,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 9000 FORMAT(' *DEBUG: RUNNING=', A) 9003 FORMAT(' *DEBUG: ITABLE BAD=', i4) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -179,10 +173,8 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 ENDDO ENDIF - DO I=1,NDOFS - QSK_COL = ZERO - QSM_COL = ZERO - ENDDO + QSK_COL = ZERO + QSM_COL = ZERO IF ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2)) THEN IF (NTERM_KFSD > 0) THEN ! Calc QSK = KSFD*UF @@ -246,7 +238,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 !xx CALL CALC_TDOF_ROW_NUM ( GRID_ID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) !xx WRITE_OGEL(NUM) = 'N' ! Set WRITE_OGEL to 'Y' for all grids that have a component in S-set !xx DO J=1,NUM_COMPS @@ -342,7 +334,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 ENDDO K = 0 DO I=1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS K = K + 1 QGs_MEFM_SUM(J) = QGs_MEFM_SUM(J) + QGs_MEFM(K) @@ -380,7 +372,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 !xx CALL CALC_TDOF_ROW_NUM ( GRID_ID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'S' , S_SET_COL ) CALL TDOF_COL_NUM ( 'SA', SA_SET_COL ) @@ -557,7 +549,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 !xx CALL CALC_TDOF_ROW_NUM ( GRID_ID(I), ROW_NUM_START, 'N' ) CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, GRID_ID(I), IGRID ) ROW_NUM_START = TDOF_ROW_START(IGRID) - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J=1,NUM_COMPS CALL TDOF_COL_NUM ( 'G ', G_SET_COL ) TDOF_ROW = ROW_NUM_START + J - 1 @@ -635,12 +627,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -660,12 +647,6 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 9100 FORMAT(' *ERROR 9100: PROGRAMMING ERROR IN SUBROUTINE ',A & ,/,14X,' ILLEGAL INPUT FOR VARIABLE "WHAT" = ',A) - 9111 FORMAT(10X,' -------------- -------------- -------------- -------------- -------------- --------------',/, & - 1X,'ABS AUTOSPC FORCES :',6(ES15.6)) - - 9113 FORMAT(10X,' -------------- -------------- -------------- -------------- -------------- --------------',/, & - 1X,'AUTOSPC FORCE TOTALS:',6(ES15.6),/,5X,'(for output set)') - 9121 FORMAT(1X,'ABS AUTOSPC FORCES :',6(ES15.6)) 9123 FORMAT(1X,'AUTOSPC FORCE TOTALS:',6(ES15.6),/,5X,'(for output set)') diff --git a/Source/LK9/L92/OFP3.f90 b/Source/LK9/L92/OFP3.f90 index 1d1b0f96..b1198e10 100644 --- a/Source/LK9/L92/OFP3.f90 +++ b/Source/LK9/L92/OFP3.f90 @@ -29,13 +29,12 @@ SUBROUTINE OFP3 ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! Main driver routine for all element node (or engineering force) and stress and strain output requests for one subcase USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_FIJ, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_FIJ USE SCONTR, ONLY : BLNK_SUB_NAM, MFIJ, MOGEL USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : ANY_ELFE_OUTPUT, ANY_ELFN_OUTPUT, ANY_STRE_OUTPUT, ANY_STRN_OUTPUT USE LINK9_STUFF, ONLY : MAXREQ, OGEL - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_BEGEND USE OFP3_USE_IFs @@ -50,14 +49,9 @@ SUBROUTINE OFP3 ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), PARAMETER :: MERROR = 6 ! Number of error indicators used INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERROR(MERROR) ! Local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -111,12 +105,7 @@ SUBROUTINE OFP3 ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP3_ELFE_1D.f90 b/Source/LK9/L92/OFP3_ELFE_1D.f90 index edafc3ba..5539d21b 100644 --- a/Source/LK9/L92/OFP3_ELFE_1D.f90 +++ b/Source/LK9/L92/OFP3_ELFE_1D.f90 @@ -30,11 +30,10 @@ SUBROUTINE OFP3_ELFE_1D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! for later output in LINK9 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_ELFE_BIT, FATAL_ERR, IBIT, INT_SC_NUM, MBUG, MOGEL,& NELE, NCBAR, NCBUSH, NCELAS1, NCELAS2, NCELAS3, NCELAS4, NCROD, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_ELFE_1D_BEGEND USE CONSTANTS_1, ONLY : ZERO, HALF USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS USE PARAMS, ONLY : OTMSKIP, PRTNEU @@ -72,7 +71,7 @@ SUBROUTINE OFP3_ELFE_1D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! (this can be > NUM_ELEM since more than 1 row is written to OGEL ! for ELFORCE(NODE) - elem nodal forces) ! Indicator for output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_ELFE_1D_BEGEND + REAL(DOUBLE) :: DUM0(6,12) ! Intermediate matrix in a calc REAL(DOUBLE) :: DUM1(6) ! Intermediate matrix in a calc @@ -100,12 +99,7 @@ SUBROUTINE OFP3_ELFE_1D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) TABLE_NAME = "OEF ERR " ITABLE = 0 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -709,12 +703,7 @@ SUBROUTINE OFP3_ELFE_1D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) WRITE(F06,9201) TYPE, REQUEST, EID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP3_ELFE_2D.f90 b/Source/LK9/L92/OFP3_ELFE_2D.f90 index ad23073d..50197024 100644 --- a/Source/LK9/L92/OFP3_ELFE_2D.f90 +++ b/Source/LK9/L92/OFP3_ELFE_2D.f90 @@ -30,11 +30,10 @@ SUBROUTINE OFP3_ELFE_2D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! for later output in LINK9 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_ELFE_BIT, FATAL_ERR, IBIT, INT_SC_NUM, MBUG, MOGEL, & WARN_ERR, NELE, NCQUAD4, NCQUAD4K, NCSHEAR, NCTRIA3, NCTRIA3K, SOL_NAME, MAX_STRESS_POINTS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_ELFE_2D_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, FOUR USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS, FEMAP_EL_VECS USE PARAMS, ONLY : OTMSKIP, PRTNEU @@ -77,7 +76,7 @@ SUBROUTINE OFP3_ELFE_2D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG) :: NUM_PTS(METYPE) ! Num diff force points for one element integer(long) :: num_pcomp_elems ! number of elements that are composites (used to prevent output of engr ! forces for PCOMP elems until I fix that output) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_ELFE_2D_BEGEND + ! Stress index (1 through 9) where poly fit err is max INTEGER(LONG) :: STRESS_OUT_ERR_INDEX(MAX_STRESS_POINTS) @@ -104,12 +103,7 @@ SUBROUTINE OFP3_ELFE_2D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! Initialize TABLE_NAME = "OEF ERR " ITABLE = 0 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -497,12 +491,7 @@ SUBROUTINE OFP3_ELFE_2D ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) WRITE(F06,9201) TYPE, REQUEST, EID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP3_ELFN.f90 b/Source/LK9/L92/OFP3_ELFN.f90 index 0c006937..969659ee 100644 --- a/Source/LK9/L92/OFP3_ELFN.f90 +++ b/Source/LK9/L92/OFP3_ELFN.f90 @@ -29,15 +29,14 @@ SUBROUTINE OFP3_ELFN ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! Processes element node force output requests for one subcase, all element types USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_BUG, WRT_FIJ, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_FIJ, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_ELFN_BIT, ELDT_BUG_U_P_BIT, ELDT_F25_U_P_BIT, FATAL_ERR,NELE, IBIT, & INT_SC_NUM, MBUG, MOGEL, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_ELFN_BEGEND USE PARAMS, ONLY : ELFORCEN, OTMSKIP USE MODEL_STUF, ONLY : EDAT, EPNT, ETYPE, AGRID, EID, ELDT, ELGP, ELMTYP, ELOUT, METYPE, NUM_EMG_FATAL_ERRS, & - PEB, PEG, PEL, PLY_NUM, TYPE, SCNUM + PEB, PEG, PEL, PLY_NUM, TYPE, SCNUM, BGRID USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, EID_OUT_ARRAY, MAXREQ, OGEL USE OUTPUT4_MATRICES, ONLY : OTM_ELFN, TXT_ELFN @@ -71,16 +70,11 @@ SUBROUTINE OFP3_ELFN ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! (this can be > NUM_ELEM since more than 1 row is written to OGEL ! for ELFORCE(NODE) - elem nodal forces) ! Indicator for output of elem data to BUG file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_ELFN_BEGEND + INTRINSIC IAND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Process element node force requests for all elements @@ -177,7 +171,7 @@ SUBROUTINE OFP3_ELFN ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) DO L=1,6 OGEL(NUM_OGEL,L) = ZERO ENDDO - CALL GET_GRID_NUM_COMPS ( AGRID(K), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( BGRID(K), NUM_COMPS, SUBR_NAME ) DO L=1,NUM_COMPS I2 = I2 + 1 IF (ELFORCEN == 'LOCAL') THEN @@ -228,12 +222,7 @@ SUBROUTINE OFP3_ELFN ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) WRITE(F06,9201) TYPE, REQUEST, EID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 b/Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 index e4ab0965..6cb0ffb1 100644 --- a/Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 +++ b/Source/LK9/L92/OFP3_STRE_NO_PCOMP.f90 @@ -30,14 +30,13 @@ SUBROUTINE OFP3_STRE_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! for stresses for Craig-Bampton models) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_STRE_BIT, FATAL_ERR, IBIT, INT_SC_NUM, & MAX_STRESS_POINTS, MBUG, MOGEL, & NELE, NCBAR, NCBUSH, NCELAS1, NCELAS2, NCELAS3, NCELAS4, NCHEXA8, NCHEXA20, NCPENTA6, & NCPENTA15,NCTETRA4, NCTETRA10, NCQUAD4, NCQUAD4K, NCROD, NCSHEAR, NCTRIA3, NCTRIA3K, & SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_STRE_NO_PCOMP_BEGEND USE CONSTANTS_1, ONLY : ZERO, ONE, FOUR USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS USE PARAMS, ONLY : OTMSKIP, PRTNEU @@ -64,7 +63,6 @@ SUBROUTINE OFP3_STRE_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTEGER(LONG), INTENT(IN) :: ITE ! Unit number for text files for OTM row descriptors INTEGER(LONG), INTENT(IN) :: JVEC ! Solution vector number INTEGER(LONG), INTENT(INOUT) :: OT4_EROW ! Row number in OT4 file for elem related OTM descriptors - LOGICAL :: NEW_RESULT INTEGER(LONG) :: ELOUT_STRE ! If > 0, there are STRESS requests for some elems INTEGER(LONG) :: I,J,K,L,M ! DO loop indices INTEGER(LONG) :: IERROR = 0 ! Local error count @@ -84,7 +82,7 @@ SUBROUTINE OFP3_STRE_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! Stress index (1 through 9) where poly fit err is max INTEGER(LONG) :: STRESS_OUT_ERR_INDEX(MAX_STRESS_POINTS) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_STRE_NO_PCOMP_BEGEND + ! Array of %errs from subr POLYNOM_FIT_STRE_STRN (only NUM_PTS vals used) REAL(DOUBLE) :: STRESS_OUT_PCT_ERR(MAX_STRESS_POINTS) @@ -106,13 +104,7 @@ SUBROUTINE OFP3_STRE_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTRINSIC IAND ITABLE = 0 TABLE_NAME = "OES ERR " -! ********************************************************************************************************************************** - !NEW_RESULT = .TRUE. - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -895,12 +887,7 @@ SUBROUTINE OFP3_STRE_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) WRITE(F06,9201) TYPE, REQUEST, EID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP3_STRE_PCOMP.f90 b/Source/LK9/L92/OFP3_STRE_PCOMP.f90 index d52ac857..e369dd99 100644 --- a/Source/LK9/L92/OFP3_STRE_PCOMP.f90 +++ b/Source/LK9/L92/OFP3_STRE_PCOMP.f90 @@ -29,11 +29,10 @@ SUBROUTINE OFP3_STRE_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! Processes element ply stress output requests for PCOMP elements (TRIA3, QUAD4) for one subcase USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_STRE_BIT, FATAL_ERR, IBIT, INT_SC_NUM, MBUG, MOGEL, & NELE, NCQUAD4, NCSHEAR, NCTRIA3, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_STRE_PCOMP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS USE PARAMS, ONLY : OTMSKIP, PRTNEU @@ -71,7 +70,7 @@ SUBROUTINE OFP3_STRE_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! for ELFORCE(NODE) - elem nodal forces) ! Indicator for output of elem data to BUG file INTEGER(LONG) :: NUM_OTM_ENTRIES ! Number of entries in OGEL for a particular element type - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_STRE_PCOMP_BEGEND + INTEGER(LONG) :: ITABLE ! the op2 subtable number CHARACTER(8*BYTE) :: TABLE_NAME ! the op2 table name @@ -84,12 +83,7 @@ SUBROUTINE OFP3_STRE_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) IS_RESULT = .FALSE. TABLE_NAME = "OES1C" ITABLE = 0 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -395,12 +389,7 @@ SUBROUTINE OFP3_STRE_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) WRITE(F06,9201) TYPE, REQUEST, EID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 b/Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 index dee89dce..30d523fa 100644 --- a/Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 +++ b/Source/LK9/L92/OFP3_STRN_NO_PCOMP.f90 @@ -30,14 +30,13 @@ SUBROUTINE OFP3_STRN_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! for strains for Craig-Bampton models) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_STRN_BIT, FATAL_ERR, IBIT, INT_SC_NUM, & MAX_STRESS_POINTS, MBUG, MOGEL, & NELE, NCBAR, NCBUSH, NCELAS1, NCELAS2, NCELAS3, NCELAS4, NCHEXA8, NCHEXA20, NCPENTA6, & NCPENTA15,NCTETRA4, NCTETRA10, NCQUAD4, NCQUAD4K, NCROD, NCSHEAR, NCTRIA3, NCTRIA3K, & SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_STRN_NO_PCOMP_BEGEND USE CONSTANTS_1, ONLY : ZERO, TWO, FOUR USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS USE PARAMS, ONLY : OTMSKIP, PRTNEU @@ -83,7 +82,7 @@ SUBROUTINE OFP3_STRN_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! Strain index (1 through 9) where poly fit err is max INTEGER(LONG) :: STRAIN_OUT_ERR_INDEX(MAX_STRESS_POINTS) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_STRN_NO_PCOMP_BEGEND + ! Array of %errs from subr POLYNOM_FIT_STRE_STRN (only NUM_PTS vals used) REAL(DOUBLE) :: STRAIN_OUT_PCT_ERR(MAX_STRESS_POINTS) @@ -105,12 +104,7 @@ SUBROUTINE OFP3_STRN_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) INTRINSIC IAND ITABLE = 0 TABLE_NAME = "OES ERR " -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -709,12 +703,7 @@ SUBROUTINE OFP3_STRN_NO_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) WRITE(F06,9201) TYPE, REQUEST, EID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/OFP3_STRN_PCOMP.f90 b/Source/LK9/L92/OFP3_STRN_PCOMP.f90 index f7df779e..b50b436f 100644 --- a/Source/LK9/L92/OFP3_STRN_PCOMP.f90 +++ b/Source/LK9/L92/OFP3_STRN_PCOMP.f90 @@ -29,11 +29,10 @@ SUBROUTINE OFP3_STRN_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! Processes element ply strain output requests for PCOMP elements (TRIA3, QUAD4) for one subcase USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_BUG, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, ELOUT_STRN_BIT, FATAL_ERR, IBIT, INT_SC_NUM, MBUG, MOGEL, & NELE, NCQUAD4, NCSHEAR, NCTRIA3, SOL_NAME, WARN_ERR, SOL_NAME USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OFP3_STRN_PCOMP_BEGEND USE CONSTANTS_1, ONLY : ZERO USE FEMAP_ARRAYS, ONLY : FEMAP_EL_NUMS USE PARAMS, ONLY : OTMSKIP, PRTNEU @@ -71,7 +70,7 @@ SUBROUTINE OFP3_STRN_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) ! for ELFORCE(NODE) - elem nodal forces) ! Indicator for output of elem data to BUG file INTEGER(LONG) :: NUM_OTM_ENTRIES ! Number of entries in OGEL for a particular element type - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OFP3_STRN_PCOMP_BEGEND + INTEGER(LONG) :: ITABLE ! the op2 subtable number CHARACTER(8*BYTE) :: TABLE_NAME ! the op2 table name @@ -84,12 +83,7 @@ SUBROUTINE OFP3_STRN_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) IS_RESULT = .FALSE. TABLE_NAME = "OSTR1C" ITABLE = 0 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -396,12 +390,7 @@ SUBROUTINE OFP3_STRN_PCOMP ( JVEC, FEMAP_SET_ID, ITE, OT4_EROW ) WRITE(F06,9201) TYPE, REQUEST, EID ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/ONE_D_STRAIN_OUTPUTS.f90 b/Source/LK9/L92/ONE_D_STRAIN_OUTPUTS.f90 index 25a9fb66..9046ce11 100644 --- a/Source/LK9/L92/ONE_D_STRAIN_OUTPUTS.f90 +++ b/Source/LK9/L92/ONE_D_STRAIN_OUTPUTS.f90 @@ -31,7 +31,7 @@ SUBROUTINE ONE_D_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ! BAR, BUSH) and puts results into array OGEL for later output to F06 file. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO @@ -39,7 +39,6 @@ SUBROUTINE ONE_D_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE LINK9_STUFF, ONLY : MSPRNT, OGEL USE FEMAP_ARRAYS, ONLY : FEMAP_EL_VECS USE PARAMS, ONLY : PRTNEU - USE SUBR_BEGEND_LEVELS, ONLY : ONE_D_STRAIN_OUTPUTS_BEGEND USE ONE_D_STRAIN_OUTPUTS_USE_IFs @@ -54,7 +53,7 @@ SUBROUTINE ONE_D_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr INTEGER(LONG) :: ICOL ! An input to subr MARGIN, called by this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ONE_D_STRAIN_OUTPUTS_BEGEND + REAL(DOUBLE) :: C1,C2 ! Coords of point "C" on cross-section of a CBAR where strain is calc'd REAL(DOUBLE) :: D1,D2 ! Coords of point "D" on cross-section of a CBAR where strain is calc'd @@ -70,12 +69,7 @@ SUBROUTINE ONE_D_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTRINSIC DMAX1,DMIN1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** ! Calc engineering strains from array STRAIN and put into array OGEL @@ -234,12 +228,7 @@ SUBROUTINE ONE_D_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/ONE_D_STRESS_OUTPUTS.f90 b/Source/LK9/L92/ONE_D_STRESS_OUTPUTS.f90 index ee17597f..4f02e7a5 100644 --- a/Source/LK9/L92/ONE_D_STRESS_OUTPUTS.f90 +++ b/Source/LK9/L92/ONE_D_STRESS_OUTPUTS.f90 @@ -31,7 +31,7 @@ SUBROUTINE ONE_D_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ! BAR, BUSH) and puts results into array OGEL for later output to F06 file. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO @@ -39,7 +39,6 @@ SUBROUTINE ONE_D_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG USE LINK9_STUFF, ONLY : MSPRNT, OGEL USE FEMAP_ARRAYS, ONLY : FEMAP_EL_VECS USE PARAMS, ONLY : PRTNEU - USE SUBR_BEGEND_LEVELS, ONLY : ONE_D_STRESS_OUTPUTS_BEGEND USE ONE_D_STRESS_OUTPUTS_USE_IFs @@ -54,7 +53,7 @@ SUBROUTINE ONE_D_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr INTEGER(LONG) :: ICOL ! An input to subr MARGIN, called by this subr - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ONE_D_STRESS_OUTPUTS_BEGEND + REAL(DOUBLE) :: C1,C2 ! Coords of point "C" on cross-section of a CBAR where stress is calc'd REAL(DOUBLE) :: D1,D2 ! Coords of point "D" on cross-section of a CBAR where stress is calc'd @@ -70,12 +69,7 @@ SUBROUTINE ONE_D_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTRINSIC DMAX1,DMIN1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -233,12 +227,7 @@ SUBROUTINE ONE_D_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/POLYNOM_FIT_STRE_STRN.f90 b/Source/LK9/L92/POLYNOM_FIT_STRE_STRN.f90 index 36fd2464..1ffcf7a9 100644 --- a/Source/LK9/L92/POLYNOM_FIT_STRE_STRN.f90 +++ b/Source/LK9/L92/POLYNOM_FIT_STRE_STRN.f90 @@ -31,14 +31,13 @@ SUBROUTINE POLYNOM_FIT_STRE_STRN ( STR_IN, NROW, NCOL, STR_OUT, STR_OUT_PCT_ERR, ! fit returned from subr SURFACE_FIT, called herein. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS, MAX_STRESS_POINTS USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, TWO, THREE USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : EID, ELGP, TYPE, XEL USE PARAMS, ONLY : Q4SURFIT, QUAD4TYP - USE SUBR_BEGEND_LEVELS, ONLY : POLYNOM_FIT_STRE_STRN_BEGEND USE POLYNOM_FIT_STRE_STRN_USE_IFs @@ -58,7 +57,7 @@ SUBROUTINE POLYNOM_FIT_STRE_STRN ( STR_IN, NROW, NCOL, STR_OUT, STR_OUT_PCT_ERR, INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: OUNT(2) ! Output units for SURFACE_FIT INTEGER(LONG) :: SF_IERR ! Output error indicator from subr SURFACE_FIT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = POLYNOM_FIT_STRE_STRN_BEGEND + REAL(DOUBLE), INTENT(IN) :: STR_IN(NROW,NCOL) ! Input stress/strain vals. NROW are num of diff stress/strain vals and ! NCOL are number of points to use in the poly fit for one value @@ -91,12 +90,7 @@ SUBROUTINE POLYNOM_FIT_STRE_STRN ( STR_IN, NROW, NCOL, STR_OUT, STR_OUT_PCT_ERR, REAL(DOUBLE) :: XEP(NCOL-1,3) ! Parametric coords of NCOL points REAL(DOUBLE) :: WO(NCOL-1) ! Values of the function to fit at the output data points -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MESSAGE(1:) = ' ' @@ -196,12 +190,7 @@ SUBROUTINE POLYNOM_FIT_STRE_STRN ( STR_IN, NROW, NCOL, STR_OUT, STR_OUT_PCT_ERR, ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/POLY_FAILURE_INDEX.f90 b/Source/LK9/L92/POLY_FAILURE_INDEX.f90 index 87fe6125..a16e5043 100644 --- a/Source/LK9/L92/POLY_FAILURE_INDEX.f90 +++ b/Source/LK9/L92/POLY_FAILURE_INDEX.f90 @@ -29,7 +29,7 @@ SUBROUTINE POLY_FAILURE_INDEX ( STREi, STRE_ALLOWABLES, FAILURE_INDEX ) ! Calculates failure index based on polynomial failure criteria (HILL, HOFF, TSAI), STRESS array and ultimate stresses USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, HALF, ONE, TWO @@ -37,7 +37,6 @@ SUBROUTINE POLY_FAILURE_INDEX ( STREi, STRE_ALLOWABLES, FAILURE_INDEX ) USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL USE MODEL_STUF, ONLY : FAILURE_THEORY - USE SUBR_BEGEND_LEVELS, ONLY : POLY_FAILURE_INDEX_BEGEND USE POLY_FAILURE_INDEX_USE_IFs @@ -46,7 +45,7 @@ SUBROUTINE POLY_FAILURE_INDEX ( STREi, STRE_ALLOWABLES, FAILURE_INDEX ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'POLY_FAILURE_INDEX' INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = POLY_FAILURE_INDEX_BEGEND + REAL(DOUBLE), INTENT(IN) :: STRE_ALLOWABLES(9)! Allowable stresses (incl tension and compr for normal stresses) REAL(DOUBLE), INTENT(IN) :: STREi(6) ! 6 components of stress @@ -63,12 +62,7 @@ SUBROUTINE POLY_FAILURE_INDEX ( STREi, STRE_ALLOWABLES, FAILURE_INDEX ) REAL(DOUBLE) :: X,Y,Z ! X = XT if sig1 > 0 or X = XC if sig1 < 0, etc REAL(DOUBLE) :: R,S,T ! Allowable shear stresses in planes 23, 13, 12 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -215,12 +209,7 @@ SUBROUTINE POLY_FAILURE_INDEX ( STREi, STRE_ALLOWABLES, FAILURE_INDEX ) ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/SHELL_ENGR_FORCE_OGEL.f90 b/Source/LK9/L92/SHELL_ENGR_FORCE_OGEL.f90 index f407d2ec..74980760 100644 --- a/Source/LK9/L92/SHELL_ENGR_FORCE_OGEL.f90 +++ b/Source/LK9/L92/SHELL_ENGR_FORCE_OGEL.f90 @@ -30,10 +30,9 @@ SUBROUTINE SHELL_ENGR_FORCE_OGEL ( NUM1 ) ! (conversion factor from stress to engr force) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHELL_ENGR_FORCE_OGEL_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : FCONV, STRESS USE LINK9_STUFF, ONLY : MAXREQ, MAXREQ, OGEL @@ -46,14 +45,9 @@ SUBROUTINE SHELL_ENGR_FORCE_OGEL ( NUM1 ) INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr INTEGER(LONG) :: I ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHELL_ENGR_FORCE_OGEL_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** NUM1 = NUM1 + 1 @@ -73,12 +67,7 @@ SUBROUTINE SHELL_ENGR_FORCE_OGEL ( NUM1 ) OGEL(NUM1,I) = FCONV(3)*STRESS(I) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/SHELL_STRAIN_OUTPUTS.f90 b/Source/LK9/L92/SHELL_STRAIN_OUTPUTS.f90 index 92c1b724..177ee3ae 100644 --- a/Source/LK9/L92/SHELL_STRAIN_OUTPUTS.f90 +++ b/Source/LK9/L92/SHELL_STRAIN_OUTPUTS.f90 @@ -30,10 +30,9 @@ SUBROUTINE SHELL_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ! QUAD4, SHEAR) and puts results into array OGEL for later output to F06 file. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHELL_STRAIN_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : ANY_FAILURE_THEORY, FAILURE_THEORY, PCOMP_PROPS, STRAIN, STRESS, TYPE, ZS USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OPT @@ -54,7 +53,7 @@ SUBROUTINE SHELL_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: NUM_ROWS ! Number of rows of stress for an element (plates have 2 ZS vals) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHELL_STRAIN_OUTPUTS_BEGEND + REAL(DOUBLE) :: ANGLE ! Angle of prin strains in plate elems (calc'd in subr PRINCIPAL_2D) REAL(DOUBLE) :: FAILURE_INDEX ! Failure index (scalar value) @@ -72,12 +71,7 @@ SUBROUTINE SHELL_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTRINSIC DMAX1,DMIN1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -284,12 +278,7 @@ SUBROUTINE SHELL_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/SHELL_STRESS_OUTPUTS.f90 b/Source/LK9/L92/SHELL_STRESS_OUTPUTS.f90 index c3771068..6f84e842 100644 --- a/Source/LK9/L92/SHELL_STRESS_OUTPUTS.f90 +++ b/Source/LK9/L92/SHELL_STRESS_OUTPUTS.f90 @@ -30,10 +30,9 @@ SUBROUTINE SHELL_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ! QUAD4, SHEAR) and puts results into array OGEL for later output to F06 file USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SHELL_STRESS_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : ANY_FAILURE_THEORY, FAILURE_THEORY, PCOMP_PROPS, STRAIN, STRESS, TYPE, ZS USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OPT @@ -54,7 +53,7 @@ SUBROUTINE SHELL_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: NUM_ROWS ! Number of rows of stress for an element (plates have 2 ZS vals) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SHELL_STRESS_OUTPUTS_BEGEND + REAL(DOUBLE) :: ANGLE ! Angle of prin stresses in plate elems (calc'd in subr PRINCIPAL_2D) REAL(DOUBLE) :: FAILURE_INDEX ! Failure index (scalar value) @@ -72,12 +71,7 @@ SUBROUTINE SHELL_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTRINSIC DMAX1,DMIN1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -270,12 +264,7 @@ SUBROUTINE SHELL_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/SOLID_STRAIN_OUTPUTS.f90 b/Source/LK9/L92/SOLID_STRAIN_OUTPUTS.f90 index 5143116a..8bcb0e0e 100644 --- a/Source/LK9/L92/SOLID_STRAIN_OUTPUTS.f90 +++ b/Source/LK9/L92/SOLID_STRAIN_OUTPUTS.f90 @@ -29,10 +29,9 @@ SUBROUTINE SOLID_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ! Calculates element specific strain outputs from array STRESS (generated in subr ELEM_STRE_STRN_ARRAYS) for solid elements USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLID_STRAIN_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : STRAIN, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_OPT @@ -52,7 +51,7 @@ SUBROUTINE SOLID_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr INTEGER(LONG) :: J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLID_STRAIN_OUTPUTS_BEGEND + REAL(DOUBLE) :: MEAN ! Mean strains REAL(DOUBLE) :: PRINCIPAL_STRAIN(3)! Principal strains @@ -63,12 +62,7 @@ SUBROUTINE SOLID_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTRINSIC DMAX1,DMIN1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -125,12 +119,7 @@ SUBROUTINE SOLID_STRAIN_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/SOLID_STRESS_OUTPUTS.f90 b/Source/LK9/L92/SOLID_STRESS_OUTPUTS.f90 index a8a78aea..fdb0cf3f 100644 --- a/Source/LK9/L92/SOLID_STRESS_OUTPUTS.f90 +++ b/Source/LK9/L92/SOLID_STRESS_OUTPUTS.f90 @@ -29,10 +29,9 @@ SUBROUTINE SOLID_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ! Calculates element specific stress outputs from array STRESS (generated in subr ELEM_STRE_STRN_ARRAYS) for solid elements USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SOLID_STRESS_OUTPUTS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : STRESS, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRE_OPT @@ -52,7 +51,7 @@ SUBROUTINE SOLID_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTEGER(LONG), INTENT(IN) :: NUM_FEMAP_ROWS ! Number of rows that will be written to FEMAP arrays INTEGER(LONG), INTENT(INOUT) :: NUM1 ! Cum rows written to OGEL prior to running this subr INTEGER(LONG) :: J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SOLID_STRESS_OUTPUTS_BEGEND + REAL(DOUBLE) :: MEAN ! Mean stresses REAL(DOUBLE) :: PRINCIPAL_STRESS(3)! Principal stresses @@ -63,12 +62,7 @@ SUBROUTINE SOLID_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG INTRINSIC DMAX1,DMIN1 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + WRITE_NEU = (PRTNEU == 'Y') ! ********************************************************************************************************************************** @@ -125,12 +119,7 @@ SUBROUTINE SOLID_STRESS_OUTPUTS ( SIZE_ALLOCATED, NUM1, NUM_FEMAP_ROWS, WRITE_OG ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/STR_TENSOR_TRANSFORM.f90 b/Source/LK9/L92/STR_TENSOR_TRANSFORM.f90 index b08bfc8a..46882b94 100644 --- a/Source/LK9/L92/STR_TENSOR_TRANSFORM.f90 +++ b/Source/LK9/L92/STR_TENSOR_TRANSFORM.f90 @@ -61,10 +61,9 @@ SUBROUTINE STR_TENSOR_TRANSFORM ( STRESS_TENSOR, STRESS_CORD_SYS ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE USE SCONTR, ONLY : BLNK_SUB_NAM, NCORD - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : CORD, RCORD, TE - USE SUBR_BEGEND_LEVELS, ONLY : STR_TENSOR_TRANSFORM_BEGEND USE STR_TENSOR_TRANSFORM_USE_IFs @@ -76,7 +75,7 @@ SUBROUTINE STR_TENSOR_TRANSFORM ( STRESS_TENSOR, STRESS_CORD_SYS ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: ICORD ! Internal coord system ID for STRESS_CORD_SYS INTEGER(LONG) :: K ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STR_TENSOR_TRANSFORM_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: STRESS_TENSOR(3,3)! 2D stress tensor (eqn 6 above) REAL(DOUBLE) :: DUM33(3,3) ! Intermediate array used in calc outputs @@ -85,12 +84,7 @@ SUBROUTINE STR_TENSOR_TRANSFORM ( STRESS_TENSOR, STRESS_CORD_SYS ) REAL(DOUBLE) :: TES(3,3) ! Transform matrix from local elem coords to stress output coords REAL(DOUBLE) :: TSE(3,3) ! TES' -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Get transformation matrix T0S from stress coord sys to basic if it exists @@ -146,12 +140,7 @@ SUBROUTINE STR_TENSOR_TRANSFORM ( STRESS_TENSOR, STRESS_CORD_SYS ) CALL MATMULT_FFF (TSE, DUM33, 3, 3, 3, STRESS_TENSOR ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/SUSER1.f90 b/Source/LK9/L92/SUSER1.f90 index febbaeb8..4b415708 100644 --- a/Source/LK9/L92/SUSER1.f90 +++ b/Source/LK9/L92/SUSER1.f90 @@ -29,10 +29,9 @@ SUBROUTINE SUSER1 ! Calc's stresses for user supplied subroutine elements USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SUSER1_BEGEND USE MODEL_STUF, ONLY : TYPE USE SUSER1_USE_IFs @@ -41,14 +40,9 @@ SUBROUTINE SUSER1 CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'SUSER1' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SUSER1_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** WRITE(ERR,9204) SUBR_NAME,TYPE @@ -56,12 +50,7 @@ SUBROUTINE SUSER1 FATAL_ERR = FATAL_ERR + 1 CALL OUTA_HERE ( 'Y' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/L92/TRANSFORM_NODE_FORCES.f90 b/Source/LK9/L92/TRANSFORM_NODE_FORCES.f90 index 35810216..fae2f81b 100644 --- a/Source/LK9/L92/TRANSFORM_NODE_FORCES.f90 +++ b/Source/LK9/L92/TRANSFORM_NODE_FORCES.f90 @@ -30,10 +30,9 @@ SUBROUTINE TRANSFORM_NODE_FORCES ( COORD_SYS ) ! every time this subr is called since that transformation must be done if either basic global is the final system anyway. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MELGP, NCORD USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : TRANSFORM_NODE_FORCES_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : CAN_ELEM_TYPE_OFFSET, GRID, CORD, BGRID, ELDOF, ELGP, OFFDIS, OFFSET, PEB, PEG, PEL, TE, & TYPE @@ -57,7 +56,7 @@ SUBROUTINE TRANSFORM_NODE_FORCES ( COORD_SYS ) INTEGER(LONG), PARAMETER :: NCOL = 1 ! An input to subr MATPUT, MATGET called herein INTEGER(LONG) :: PROW ! An input to subr MATPUT, MATGET called herein INTEGER(LONG), PARAMETER :: PCOL = 1 ! An input to subr MATPUT, MATGET called herein - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = TRANSFORM_NODE_FORCES_BEGEND + REAL(DOUBLE) :: DXI ! An offset distance in direction 1 REAL(DOUBLE) :: DYI ! An offset distance in direction 2 @@ -68,12 +67,7 @@ SUBROUTINE TRANSFORM_NODE_FORCES ( COORD_SYS ) REAL(DOUBLE) :: DUM3(ELDOF) ! Dummy arrays needed in transforming from global to basic coords REAL(DOUBLE) :: THETAD,PHID ! Returns from subr GEN_T0L (not used here) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** NROWS = ELDOF @@ -160,12 +154,7 @@ SUBROUTINE TRANSFORM_NODE_FORCES ( COORD_SYS ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/LINK9/ALLOCATE_FEMAP_DATA.f90 b/Source/LK9/LINK9/ALLOCATE_FEMAP_DATA.f90 index ffad3376..dc2c0820 100644 --- a/Source/LK9/LINK9/ALLOCATE_FEMAP_DATA.f90 +++ b/Source/LK9/LINK9/ALLOCATE_FEMAP_DATA.f90 @@ -31,9 +31,8 @@ SUBROUTINE ALLOCATE_FEMAP_DATA ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_FEMAP_COLS, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_FEMAP_DATA_BEGEND USE FEMAP_ARRAYS, ONLY : FEMAP_EL_VECS, FEMAP_EL_NUMS USE ALLOCATE_FEMAP_DATA_USE_IFs @@ -50,7 +49,7 @@ SUBROUTINE ALLOCATE_FEMAP_DATA ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! STAT from ALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_FEMAP_DATA_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -62,12 +61,7 @@ SUBROUTINE ALLOCATE_FEMAP_DATA ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RDOUBLE = REAL(DOUBLE) @@ -99,7 +93,6 @@ SUBROUTINE ALLOCATE_FEMAP_DATA ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NROWS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS FEMAP_EL_NUMS(I,1) = 0 FEMAP_EL_NUMS(I,2) = 0 @@ -123,7 +116,6 @@ SUBROUTINE ALLOCATE_FEMAP_DATA ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(NROWS)*REAL(NCOLS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS DO J=1,NCOLS FEMAP_EL_VECS(I,J) = ZERO @@ -145,12 +137,7 @@ SUBROUTINE ALLOCATE_FEMAP_DATA ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/LINK9/ALLOCATE_LINK9_STUF.f90 b/Source/LK9/LINK9/ALLOCATE_LINK9_STUF.f90 index 93a6cbbf..22e2665c 100644 --- a/Source/LK9/LINK9/ALLOCATE_LINK9_STUF.f90 +++ b/Source/LK9/LINK9/ALLOCATE_LINK9_STUF.f90 @@ -31,9 +31,8 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, TWO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MELGP, MMSPRNT, MOGEL, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_LINK9_STUF_BEGEND USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, EID_OUT_ARRAY, FTNAME, MAXREQ, MSPRNT, OGEL, POLY_FIT_ERR, & POLY_FIT_ERR_INDEX @@ -50,7 +49,7 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Nunber of rows in array NAME being allocated INTEGER(LONG) :: NCOLS ! Nunber of cols in array NAME being allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_LINK9_STUF_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -62,12 +61,7 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RDOUBLE = REAL(DOUBLE) @@ -91,7 +85,6 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MAXREQ)*REAL(MELGP)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, MELGP+1, SUBR_BEGEND ) DO I=1,MAXREQ DO J=1,MELGP+1 GID_OUT_ARRAY(I,J) = 0 @@ -119,7 +112,6 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) MB_ALLOCATED = RLONG*TWO*REAL(MAXREQ)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 2, SUBR_BEGEND ) DO I=1,MAXREQ EID_OUT_ARRAY(I,1) = 0 EID_OUT_ARRAY(I,2) = 1 ! Set number of plies to 1 so that we don't have to worry about it @@ -145,7 +137,6 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) IF (IERR == 0) THEN MB_ALLOCATED =REAL(LEN(FTNAME)*MAXREQ)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,MAXREQ FTNAME(I) = 'none' ENDDO @@ -171,7 +162,6 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) IF (IERR == 0) THEN MB_ALLOCATED =REAL(LEN(MSPRNT)*MAXREQ*MMSPRNT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, MMSPRNT, SUBR_BEGEND ) DO I=1,MAXREQ DO J=1,MMSPRNT MSPRNT(I,J)(1:) = ' ' @@ -199,7 +189,6 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MAXREQ)*REAL(MOGEL)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, MOGEL, SUBR_BEGEND ) DO I=1,MAXREQ DO J=1,MOGEL OGEL(I,J) = ZERO @@ -227,7 +216,6 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MAXREQ)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,MAXREQ POLY_FIT_ERR(I) = ZERO ENDDO @@ -253,7 +241,6 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) MB_ALLOCATED = BYTE*REAL(MAXREQ)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,MAXREQ POLY_FIT_ERR_INDEX(I) = 0 ENDDO @@ -273,12 +260,7 @@ SUBROUTINE ALLOCATE_LINK9_STUF ( CALLING_SUBR ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/LINK9/DEALLOCATE_FEMAP_DATA.f90 b/Source/LK9/LINK9/DEALLOCATE_FEMAP_DATA.f90 index b6029fc0..19e40084 100644 --- a/Source/LK9/LINK9/DEALLOCATE_FEMAP_DATA.f90 +++ b/Source/LK9/LINK9/DEALLOCATE_FEMAP_DATA.f90 @@ -30,10 +30,9 @@ SUBROUTINE DEALLOCATE_FEMAP_DATA USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_FEMAP_DATA_BEGEND USE FEMAP_ARRAYS, ONLY : FEMAP_EL_VECS, FEMAP_EL_NUMS USE DEALLOCATE_FEMAP_DATA_USE_IFs @@ -45,18 +44,13 @@ SUBROUTINE DEALLOCATE_FEMAP_DATA INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_FEMAP_DATA_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -67,7 +61,6 @@ SUBROUTINE DEALLOCATE_FEMAP_DATA DEALLOCATE (FEMAP_EL_NUMS,STAT=IERR) NAME = 'FEMAP_EL_NUMS' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -79,7 +72,6 @@ SUBROUTINE DEALLOCATE_FEMAP_DATA DEALLOCATE (FEMAP_EL_VECS,STAT=IERR) NAME = 'FEMAP_EL_VECS' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -93,12 +85,7 @@ SUBROUTINE DEALLOCATE_FEMAP_DATA CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/LINK9/DEALLOCATE_LINK9_STUF.f90 b/Source/LK9/LINK9/DEALLOCATE_LINK9_STUF.f90 index de07e5e6..8ab321f2 100644 --- a/Source/LK9/LINK9/DEALLOCATE_LINK9_STUF.f90 +++ b/Source/LK9/LINK9/DEALLOCATE_LINK9_STUF.f90 @@ -30,10 +30,9 @@ SUBROUTINE DEALLOCATE_LINK9_STUF USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_LINK9_STUF_BEGEND USE LINK9_STUFF, ONLY : GID_OUT_ARRAY, EID_OUT_ARRAY, FTNAME, MSPRNT, OGEL, POLY_FIT_ERR, & POLY_FIT_ERR_INDEX @@ -46,18 +45,13 @@ SUBROUTINE DEALLOCATE_LINK9_STUF INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_LINK9_STUF_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -68,7 +62,6 @@ SUBROUTINE DEALLOCATE_LINK9_STUF DEALLOCATE (GID_OUT_ARRAY,STAT=IERR) NAME = 'GID_OUT_ARRAY' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -82,7 +75,6 @@ SUBROUTINE DEALLOCATE_LINK9_STUF DEALLOCATE (EID_OUT_ARRAY,STAT=IERR) NAME = 'EID_OUT_ARRAY' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -96,7 +88,6 @@ SUBROUTINE DEALLOCATE_LINK9_STUF DEALLOCATE (FTNAME,STAT=IERR) NAME = 'FTNAME ' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -110,7 +101,6 @@ SUBROUTINE DEALLOCATE_LINK9_STUF DEALLOCATE (MSPRNT,STAT=IERR) NAME = 'MSPRNT ' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -124,7 +114,6 @@ SUBROUTINE DEALLOCATE_LINK9_STUF DEALLOCATE (OGEL,STAT=IERR) NAME = 'OGEL ' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -138,7 +127,6 @@ SUBROUTINE DEALLOCATE_LINK9_STUF DEALLOCATE (POLY_FIT_ERR,STAT=IERR) NAME = 'POLY_FIT_ERR ' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -152,7 +140,6 @@ SUBROUTINE DEALLOCATE_LINK9_STUF DEALLOCATE (POLY_FIT_ERR_INDEX,STAT=IERR) NAME = 'POLY_FIT_ERR_INDEX ' CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) IF (IERR /= 0) THEN WRITE(ERR,992) NAME,SUBR_NAME WRITE(F06,992) NAME,SUBR_NAME @@ -166,12 +153,7 @@ SUBROUTINE DEALLOCATE_LINK9_STUF CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/LINK9/LINK9.f90 b/Source/LK9/LINK9/LINK9.f90 index 24a60429..c7767f2a 100644 --- a/Source/LK9/LINK9/LINK9.f90 +++ b/Source/LK9/LINK9/LINK9.f90 @@ -29,19 +29,19 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Main driver for calculating outputs requested in Case Control once the G-set unknowns have been solved for in prior LINK's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR - USE IOUNT1, ONLY : ANS, ERR, F04, F06, F25, L1E, L1M, L1R, L2A, L2B, L2C, L2D, L2I, L2J, L2R, L2S, & + USE IOUNT1, ONLY : ERR, F06, F25, L1E, L1M, L1R, L2A, L2B, L2C, L2D, L2I, L2J, L2R, L2S, & L5A, L5B, NEU, OT4, OU4, PCH, SC1 - USE IOUNT1, ONLY : ANSFIL, F06FIL, F25FIL, LINK1B, LINK1E, LINK1M, LINK1R, LINK2A, LINK2B, LINK2C, LINK2D, & + USE IOUNT1, ONLY : F06FIL, F25FIL, LINK1B, LINK1E, LINK1M, LINK1R, LINK2A, LINK2B, LINK2C, LINK2D, & LINK2I, LINK2J, LINK2R, LINK2S, LINK5A, LINK5B, MOT4 , MOU4 , NEUFIL, OT4FIL, OU4FIL, & PCHFIL USE IOUNT1, ONLY : L1ASTAT, L1ESTAT, L1MSTAT, L1RSTAT, L2ASTAT, L2BSTAT, L2CSTAT, L2ISTAT, L2JSTAT, L2RSTAT, & L2SSTAT, OT4STAT, OU4STAT, PCHSTAT - USE IOUNT1, ONLY : ANS_MSG, F25_MSG, L1E_MSG, L1M_MSG, L1R_MSG, L2A_MSG, L2B_MSG, L2C_MSG, L2D_MSG, L2I_MSG, & + USE IOUNT1, ONLY : F25_MSG, L1E_MSG, L1M_MSG, L1R_MSG, L2A_MSG, L2B_MSG, L2C_MSG, L2D_MSG, L2I_MSG, & L2J_MSG, L2R_MSG, L2S_MSG, L5A_MSG, L5B_MSG, NEU_MSG, PCH_MSG, & OT4_MSG, OU4_MSG, OT4_GRD_OTM, OT4_ELM_OTM, OU4_GRD_OTM, OU4_ELM_OTM @@ -61,10 +61,9 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ELDT_F25_U_P_BIT USE CC_OUTPUT_DESCRIBERS, ONLY : DISP_OUT, ACCE_OUT, OLOA_OUT, SPCF_OUT, MPCF_OUT, FORC_OUT, GPFO_OUT, STRE_OUT, STRN_OUT - USE TIMDAT, ONLY : YEAR, MONTH, DAY, HOUR, MINUTE, SEC, SFRAC, STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LINK9_BEGEND + USE TIMDAT, ONLY : STIME USE CONSTANTS_1, ONLY : ZERO, ONE - USE PARAMS, ONLY : EPSIL, MPFOUT, SUPINFO, SUPWARN, WTMASS, PRTANS, PRTF06, PRTOP2, PRTNEU + USE PARAMS, ONLY : EPSIL, MPFOUT, SUPINFO, SUPWARN, WTMASS, PRTF06, PRTOP2, PRTNEU USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP USE COL_VECS, ONLY : FG_COL, UG_COL, PG_COL, PM_COL, PS_COL, QSYS_COL, QGm_COL, QGr_COL, QGs_COL, QR_COL, & PHIXG_COL, PHIXN_COL @@ -91,10 +90,11 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) USE DEBUG_PARAMETERS, ONLY : DEBUG USE LINK9_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE - LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH, WRITE_ANS, WRITE_NEU ! flag + LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH, WRITE_NEU ! flag LOGICAL :: LEXIST ! .TRUE. if a file exists LOGICAL :: LOPEN ! .TRUE. if a file is opened @@ -109,7 +109,6 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CHARACTER( 1*BYTE) :: ZERO_GEN_STIFF ! Indicator of whether there are zero gen stiffs (can't calc MEFFMASS) CHARACTER(24*BYTE) :: MESSAG ! File description. Input to subr UNFORMATTED_OPEN - CHARACTER(54*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER( 1*BYTE) :: NULL_COL ! An output from subr GET_SPARSE_CRS_COL CHARACTER( 1*BYTE) :: PROC_PG_OUTPUT ! 'Y' in general. However, for BUCKLING, set to 'N' for eigen subcase CHARACTER( 1*BYTE) :: READ_SPCARRAYS ! ='Y' if we need to read KSF, etc. See test below. @@ -158,7 +157,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) INTEGER(LONG) :: SC_STRE_OUTPUT ! = 1 if requests for output of elem stresses in a particular S/C INTEGER(LONG) :: SC_STRN_OUTPUT ! = 1 if requests for output of elem strains in a particular S/C INTEGER(LONG) :: XTIME ! Time stamp read from an unformatted file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LINK9_BEGEND + 1 + REAL(DOUBLE) :: EPS1 ! Small number to compare against zero REAL(DOUBLE) :: UGV ! A G-set vector read from file L5A @@ -187,7 +186,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) EPS1 = EPSIL(1) WRITE_NEU = (PRTNEU == 'Y') - ! setup PRTANS, PRTF06, PRTNEU, PRTOP2 + ! setup PRTF06, PRTNEU, PRTOP2 !IF (DEBUG(200) > 0) THEN ! PRTNEU = 'Y' !ENDIF @@ -230,29 +229,19 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) WRITE_F06 = (DISP_OUT(1:1) == 'Y') WRITE_OP2 = (DISP_OUT(2:2) == 'Y') WRITE_PCH = (DISP_OUT(3:3) == 'Y') - WRITE_ANS = (PRTANS == 'Y') - IF (WRITE_ANS) THEN - INQUIRE (FILE=ANSFIL, OPENED=LOPEN) - IF (.NOT.LOPEN) THEN ! Otherwise we assume it is positioned at its end and ready for write - CALL FILE_OPEN ( ANS, ANSFIL, OUNT, 'OLD', ANS_MSG, 'WRITE_STIME', 'FORMATTED', 'READWRITE', 'REWIND', 'Y', 'Y', 'Y' ) - ENDIF - ENDIF IF (WRITE_PCH) THEN INQUIRE (FILE=PCHFIL, OPENED=LOPEN) IF (.NOT.LOPEN) THEN ! Otherwise we assume it is positioned at its end and ready for write - CALL FILE_OPEN ( PCH, PCHFIL, OUNT, 'OLD', PCH_MSG, 'WRITE_STIME', 'FORMATTED', 'READWRITE', 'REWIND', 'Y', 'Y', 'Y' ) + CALL FILE_OPEN ( PCH, PCHFIL, OUNT, 'OLD', PCH_MSG, 'WRITE_STIME', 'FORMATTED', 'READWRITE', 'REWIND', 'Y', 'Y' ) ENDIF ENDIF ! Write info to text files WRITE(ERR,150) LINKNO WRITE(F06,150) LINKNO - IF (WRT_LOG > 0) THEN - WRITE(F04,150) LINKNO - ENDIF ! Read LINK1A file - CALL READ_L1A ( 'KEEP', 'Y' ) + CALL READ_L1A ( 'KEEP' ) ! Check COMM for successful completion of prior LINKs IF (RESTART == 'Y') THEN @@ -268,9 +257,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ! Before reading file data in subr LINK9S, deallocate all of those arrays and then allocate them fresh - CALL OURTIM - MODNAM = 'DEALLOCATE ARRAYS BEFORE READING LINK9S' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('DEALLOCATE ARRAYS BEFORE READING LINK9S') ! Deallocate data in file LINK1D CALL DEALLOCATE_MODEL_STUF ( 'SCNUM' ) CALL DEALLOCATE_MODEL_STUF ( 'TITLES' ) @@ -291,9 +278,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL DEALLOCATE_MODEL_STUF ( 'PPNT, PDATA, PTYPE' ) CALL DEALLOCATE_MODEL_STUF ( 'PLOAD4_3D_DATA' ) - CALL OURTIM - MODNAM = 'ALLOCATE ARRAYS FOR DATA READ IN LINK9S' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR DATA READ IN LINK9S') ! Allocate data to be read in LINK9S from file LINK1D CALL ALLOCATE_MODEL_STUF ( 'SCNUM', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'TITLES', SUBR_NAME ) @@ -315,9 +300,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL ALLOCATE_MODEL_STUF ( 'PLOAD4_3D_DATA', SUBR_NAME ) ! Read LINK9S data - CALL OURTIM - MODNAM = 'READ MODEL DATA ARRAYS' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ MODEL DATA ARRAYS') CALL LINK9S ! Determine MAXREQ (max number of output requests) so we can allocate memory to arrays below @@ -336,13 +319,9 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (NTERM_PG > 0) THEN - CALL OURTIM - MODNAM = 'ALLOCATING SPARSE ARRAYS FOR PG LOADS' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATING SPARSE ARRAYS FOR PG LOADS') - CALL OURTIM - MODNAM = 'READ PG LOADS' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ PG LOADS') CLOSE_IT = 'N' CALL READ_MATRIX_1 ( LINK1E, L1E, 'N', CLOSE_IT, 'KEEP', L1E_MSG, 'PG', NTERM_PG, 'Y', NDOFG, & I_PG, J_PG, PG) @@ -395,12 +374,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (NTERM_KFSD > 0) THEN - CALL OURTIM - MODNAM = 'ALLOCATE ARRAYS FOR, AND READ, KSFD' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC - CALL OURTIM - MODNAM = 'READ KSFD MATRIX' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR, AND READ, KSFD') + CALL LINK_MESSAGE('READ KSFD MATRIX') CLOSE_IT = 'Y' CLOSE_STAT = 'KEEP' CALL READ_MATRIX_1 (LINK2B,L2B,'N',CLOSE_IT,CLOSE_STAT,L2B_MSG,'KSFD',NTERM_KFSD,'Y',NDOFS,I_KSFD,J_KSFD,KSFD) @@ -411,12 +386,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (NTERM_KFS > 0) THEN - CALL OURTIM - MODNAM = 'ALLOCATE ARRAYS FOR, AND READ, KSF' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC - CALL OURTIM - MODNAM = 'READ KSF MATRIX' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR, AND READ, KSF') + CALL LINK_MESSAGE('READ KSF MATRIX') CLOSE_IT = 'Y' CLOSE_STAT = 'KEEP' CALL READ_MATRIX_1 (LINK2B,L2B,'N',CLOSE_IT,CLOSE_STAT,L2B_MSG,'KSF ',NTERM_KFS ,'Y',NDOFS,I_KSF ,J_KSF ,KSF ) @@ -427,12 +398,9 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN - CALL OURTIM ! Allocate and read MSF - MODNAM = 'ALLOCATE ARRAYS FOR, AND READ, MSF' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC - CALL OURTIM - MODNAM = 'READ MSF MATRIX' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + ! Allocate and read MSF + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR, AND READ, MSF') + CALL LINK_MESSAGE('READ MSF MATRIX') CLOSE_IT = 'Y' CALL READ_MATRIX_1 ( LINK2S, L2S, 'N', CLOSE_IT, L2SSTAT, L2S_MSG, 'MSF', NTERM_MFS , 'Y', NDOFS, & I_MSF , J_MSF , MSF ) @@ -442,12 +410,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (NTERM_QSYS > 0) THEN ! Note this will be 0 unless this is STATICS - CALL OURTIM - MODNAM = 'ALLOCATE ARRAYS FOR, AND READ, QSYS' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC - CALL OURTIM - MODNAM = 'READ QSYS MATRIX' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR, AND READ, QSYS') + CALL LINK_MESSAGE('READ QSYS MATRIX') CLOSE_IT = 'Y' CALL READ_MATRIX_1 ( LINK2C, L2C, 'N', CLOSE_IT, L2CSTAT, L2C_MSG, 'QSYS', NTERM_QSYS, 'Y', NDOFS, & I_QSYS, J_QSYS, QSYS ) @@ -462,12 +426,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (NTERM_PS > 0) THEN - CALL OURTIM - MODNAM = 'ALLOCATE SPARSE ARRAYS FOR PS LOADS' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC - CALL OURTIM - MODNAM = 'READ PS LOADS' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE SPARSE ARRAYS FOR PS LOADS') + CALL LINK_MESSAGE('READ PS LOADS') CLOSE_IT = 'N' CALL READ_MATRIX_1 ( LINK2D, L2D, 'N', CLOSE_IT, 'KEEP', L2D_MSG, 'PS', NTERM_PS, 'Y', NDOFS, & I_PS, J_PS, PS) @@ -484,9 +444,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (NTERM_GMN > 0) THEN - CALL OURTIM ! Allocate and read GMN and create GMNt - MODNAM = 'READ GMN MATRIX' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + ! Allocate and read GMN and create GMNt + CALL LINK_MESSAGE('READ GMN MATRIX') CLOSE_IT = 'Y' CALL ALLOCATE_SPARSE_MAT ( 'GMN', NDOFM, NTERM_GMN, SUBR_NAME ) CALL READ_MATRIX_1 ( LINK2A, L2A, 'N', CLOSE_IT, 'KEEP', L2A_MSG, 'GMN', NTERM_GMN, 'Y', NDOFM & @@ -498,9 +457,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (NTERM_HMN > 0) THEN ! Allocate and read HMN if there are any terms in it. - CALL OURTIM - MODNAM = 'READ HMN MATRIX' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ HMN MATRIX') CLOSE_IT = 'Y' CALL ALLOCATE_SPARSE_MAT ( 'HMN', NDOFM, NTERM_HMN, SUBR_NAME ) CALL READ_MATRIX_1 ( LINK2J, L2J, 'N', CLOSE_IT, L2JSTAT, L2J_MSG, 'HMN', NTERM_HMN, 'Y', NDOFM & @@ -509,9 +466,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (NTERM_LMN > 0) THEN ! Allocate and read LMN if there are any terms in it. - CALL OURTIM - MODNAM = 'READ LMN MATRIX' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ LMN MATRIX') CLOSE_IT = 'Y' CALL ALLOCATE_SPARSE_MAT ( 'LMN', NDOFM, NTERM_LMN, SUBR_NAME ) CALL READ_MATRIX_1 ( LINK2R, L2R, 'N', CLOSE_IT, 'KEEP', L2R_MSG, 'LMN', NTERM_LMN, 'Y', NDOFM & @@ -525,9 +480,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Read MGG mass matrix if this is a dynamics solution and GP force balance is requested IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN IF (ANY_GPFO_OUTPUT > 0) THEN - CALL OURTIM - MODNAM = 'ALLOCATE SPARSE ARRAYS FOR MGG MASS ARRAYS' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE SPARSE ARRAYS FOR MGG MASS ARRAYS') CALL ALLOCATE_SPARSE_MAT ( 'MGG', NDOFG, NTERM_MGG, SUBR_NAME ) IF (NTERM_MGG > 0) THEN CLOSE_IT = 'Y' @@ -541,9 +494,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Read MLL mass matrix if this is a dynamics solution and GP force balance is requested. IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN IF (ANY_GPFO_OUTPUT > 0) THEN - CALL OURTIM - MODNAM = 'ALLOCATE SPARSE ARRAYS FOR MLL MASS ARRAYS' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE SPARSE ARRAYS FOR MLL MASS ARRAYS') CALL ALLOCATE_SPARSE_MAT ( 'MLL', NDOFL, NTERM_MLL, SUBR_NAME ) IF (NTERM_MLL > 0) THEN CLOSE_IT = 'Y' @@ -557,11 +508,11 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) !xx ANY_U_P_OUTPUT = IAND(OELDT,IBIT(ELDT_F25_U_P_BIT)) !xx IF (ANY_U_P_OUTPUT > 0) THEN -!xx CALL FILE_OPEN ( F25, F25FIL, OUNT, 'REPLACE', F25_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) +!xx CALL FILE_OPEN ( F25, F25FIL, OUNT, 'REPLACE', F25_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) !xx ENDIF ! Open data files for reading displacements (will be read below in loop over number of subcases/vectors) - CALL FILE_OPEN ( L5A, LINK5A, OUNT, 'OLD', L5A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L5A, LINK5A, OUNT, 'OLD', L5A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! If this is an eigenvalue problem, determine if there are modes with zero gen stiffness. If so, cannot calc modal masses ! or modal participation factors (but only do this if not a CB soln since MPFACTOR and MEFFMASS were calc'd in LINK6 for CB) @@ -619,7 +570,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Open FEMAP neutral file for writing, if WRITE_NEU, and write FEMAP data block 100 IF (WRITE_NEU) THEN WRITE(CTIME,9000) STIME - CALL FILE_OPEN ( NEU, NEUFIL, OUNT, 'REPLACE', NEU_MSG, 'WRITE_STIME', 'FORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( NEU, NEUFIL, OUNT, 'REPLACE', NEU_MSG, 'WRITE_STIME', 'FORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) FEMAP_BLK = ' 100' WRITE(NEU,9001) WRITE(NEU,9011) FEMAP_BLK @@ -682,8 +633,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) FATAL_ERR = FATAL_ERR + 1 CALL OUTA_HERE ( 'Y' ) ELSE - CALL FILE_OPEN (OU4(IUE),OU4FIL(IUE),OUNT,'REPLACE', OU4_MSG(IUE),'NEITHER','UNFORMATTED','WRITE','REWIND','Y','N', 'Y') - CALL FILE_OPEN (OU4(IUG),OU4FIL(IUG),OUNT,'REPLACE', OU4_MSG(IUG),'NEITHER','UNFORMATTED','WRITE','REWIND','Y','N', 'Y') + CALL FILE_OPEN (OU4(IUE),OU4FIL(IUE),OUNT,'REPLACE', OU4_MSG(IUE),'NEITHER','UNFORMATTED','WRITE','REWIND','Y','N') + CALL FILE_OPEN (OU4(IUG),OU4FIL(IUG),OUNT,'REPLACE', OU4_MSG(IUG),'NEITHER','UNFORMATTED','WRITE','REWIND','Y','N') ENDIF ! Get index for file unit nos for elem/grid related OTM text files @@ -702,12 +653,12 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) FATAL_ERR = FATAL_ERR + 1 CALL OUTA_HERE ( 'Y' ) ELSE - CALL FILE_OPEN (OT4(ITE), OT4FIL(ITE), OUNT,'REPLACE', OT4_MSG(ITE),'NEITHER','FORMATTED','WRITE','REWIND','Y','N', 'Y') - CALL FILE_OPEN (OT4(ITG), OT4FIL(ITG), OUNT,'REPLACE', OT4_MSG(ITG),'NEITHER','FORMATTED','WRITE','REWIND','Y','N', 'Y') + CALL FILE_OPEN (OT4(ITE), OT4FIL(ITE), OUNT,'REPLACE', OT4_MSG(ITE),'NEITHER','FORMATTED','WRITE','REWIND','Y','N') + CALL FILE_OPEN (OT4(ITG), OT4FIL(ITG), OUNT,'REPLACE', OT4_MSG(ITG),'NEITHER','FORMATTED','WRITE','REWIND','Y','N') ENDIF IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN ! We need cols of PHIXG to process NDOFR+NVEC cols of GPFO - CALL FILE_OPEN ( L5B, LINK5B, OUNT, 'OLD', L5B_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L5B, LINK5B, OUNT, 'OLD', L5B_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF ENDIF @@ -751,16 +702,6 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) WRITE(NEU,9011) FEMAP_BLK ENDIF - IF (WRT_LOG >= SUBR_BEGEND) THEN - IF ((SOL_NAME(1: 7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & - ((SOL_NAME(1: 8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - WRITE(F04,9095) JVEC - ELSE IF ((SOL_NAME(1: 5) == 'MODES') .OR. ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2))) THEN - WRITE(F04,9096) JVEC - ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - WRITE(F04,9097) JVEC - ENDIF - ENDIF IF ((SOL_NAME(1:8) == 'BUCKLING') .OR. (SOL_NAME(1:8) == 'DIFFEREN')) THEN JTSUB = 1 @@ -779,20 +720,19 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) SC_MPCF_OUTPUT = IAND(OGROUT(INT_SC_NUM),IBIT(GROUT_MPCF_BIT)) SC_GPFO_OUTPUT = IAND(OGROUT(INT_SC_NUM),IBIT(GROUT_GPFO_BIT)) - CALL OURTIM ! Write message to screen + ! Write message to screen IF ((SOL_NAME(1: 7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC') .OR. & ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 1))) THEN - MODNAM = 'READ G-SET DISPLACEMENTS, Subcase' + CALL LINK_MESSAGE_I('READ G-SET DISPLACEMENTS, Subcase', JVEC) ELSE IF ((SOL_NAME(1: 5) == 'MODES') .OR. ((SOL_NAME(1:8) == 'BUCKLING') .AND. (LOAD_ISTEP == 2))) THEN - MODNAM = 'READ G-SET EIGENVECTORS, Eigenvec' + CALL LINK_MESSAGE_I('READ G-SET EIGENVECTORS, Eigenvec', JVEC) ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - MODNAM = 'READ G-SET CB VECTORS, CB vector' + CALL LINK_MESSAGE_I('READ G-SET CB VECTORS, CB vector', JVEC) ENDIF - WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC ! Read the displ's for the DOF for this subcase/eigenvector CALL DEALLOCATE_COL_VEC ( 'UG_COL' ) CALL ALLOCATE_COL_VEC ( 'UG_COL', NDOFG, SUBR_NAME ) @@ -800,7 +740,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) READ(L5A,IOSTAT=IOCHK) UGV IF (IOCHK /=0) THEN REC_NO = I - 1 - CALL READERR (IOCHK, LINK5A, L5A_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR (IOCHK, LINK5A, L5A_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF UG_COL(I) = UGV @@ -814,7 +754,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) READ(L5B,IOSTAT=IOCHK) PHIXGV IF (IOCHK /=0) THEN REC_NO = I - 1 - CALL READERR (IOCHK, LINK5B, L5B_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR (IOCHK, LINK5B, L5B_MSG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF PHIXG_COL(I) = PHIXGV @@ -834,9 +774,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ITABLE = -1 IF ((SC_ACCE_OUTPUT > 0) .OR. (WRITE_NEU)) THEN IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - CALL OURTIM - MODNAM = 'PROCESS ACCEL OUTPUT REQUESTS, "' - WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('PROCESS ACCEL OUTPUT REQUESTS, "',JVEC) CALL OFP1 ( JVEC, 'ACCE', SC_ACCE_OUTPUT, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, NEW_RESULT ) ! NEW_RESULT = .FALSE. ELSE @@ -850,9 +788,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Process displacement output requests IF ((SC_DISP_OUTPUT > 0) .OR. (WRITE_NEU)) THEN - CALL OURTIM - MODNAM = 'PROCESS DISPL OUTPUT REQUESTS, "' - WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('PROCESS DISPL OUTPUT REQUESTS, "',JVEC) CALL OFP1 ( JVEC, 'DISP', SC_DISP_OUTPUT, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, NEW_RESULT ) ! NEW_RESULT = .FALSE. ENDIF @@ -864,9 +800,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (PROC_PG_OUTPUT == 'Y') THEN IF ((SC_OLOA_OUTPUT > 0) .OR. (SC_GPFO_OUTPUT > 0) .OR. (WRITE_NEU)) THEN IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'BUCKLING') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - CALL OURTIM - MODNAM = 'PROCESS APPLIED LOAD OUTPUT REQS, "' - WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('PROCESS APPLIED LOAD OUTPUT REQS, "',JVEC) CALL GET_SPARSE_CRS_COL ('PG_COL ',JVEC , NTERM_PG, NDOFG, NSUB, I_PG, J_PG, PG, ONE, PG_COL, NULL_COL) CALL OFP1 ( JVEC, 'OLOAD', SC_OLOA_OUTPUT, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, NEW_RESULT ) ! NEW_RESULT = .FALSE. @@ -909,9 +843,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDDO ENDIF - CALL OURTIM - MODNAM = 'PROCESS SPC FORCE OUTPUT REQUESTS, "' - WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('PROCESS SPC FORCE OUTPUT REQUESTS, "',JVEC) CALL ALLOCATE_COL_VEC ( 'QGs_COL', NDOFG, SUBR_NAME ) CALL OFP2 ( JVEC, 'SPCF', SC_SPCF_OUTPUT, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, NEW_RESULT ) ! NEW_RESULT = .FALSE. @@ -933,9 +865,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ENDIF - CALL OURTIM - MODNAM = 'PROCESS MPC FORCE OUTPUT REQUESTS, "' - WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('PROCESS MPC FORCE OUTPUT REQUESTS, "',JVEC) CALL ALLOCATE_COL_VEC ( 'QGm_COL', NDOFG, SUBR_NAME ) CALL OFP2 ( JVEC, 'MPCF', SC_MPCF_OUTPUT, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, NEW_RESULT ) ! NEW_RESULT = .FALSE. @@ -990,9 +920,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF - CALL OURTIM - MODNAM = 'PROCESS G.P. FORCE BALANCE REQUESTS, "' - WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('PROCESS G.P. FORCE BALANCE REQUESTS, "',JVEC) CALL GP_FORCE_BALANCE_PROC ( JVEC, 'Y' ) CALL DEALLOCATE_COL_VEC ( 'FG_COL' ) CALL DEALLOCATE_COL_VEC ( 'QGr_COL' ) @@ -1013,9 +941,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF((SC_ELFE_OUTPUT > 0) .OR. (SC_ELFN_OUTPUT > 0) .OR. (SC_STRE_OUTPUT > 0) .OR. (SC_STRN_OUTPUT > 0) .OR. & ! (ANY_U_P_OUTPUT > 0) .OR. (WRITE_NEU)) THEN - CALL OURTIM - MODNAM = 'PROCESS ELEM FORCE/STRESS REQUESTS, "' - WRITE(SC1,9093) LINKNO,MODNAM,JVEC,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE_I('PROCESS ELEM FORCE/STRESS REQUESTS, "',JVEC) IF ((DEBUG(176) == 0) .AND. (JVEC == 1)) THEN WRITE(ERR,98980) WRITE(ERR,98988) DEBUG(176) @@ -1048,7 +974,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) MESSAG = 'STIME ' IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, LINK1E, MESSAG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1E, MESSAG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Can't read STIME from PG loads file ENDIF ENDIF @@ -1060,7 +986,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) MESSAG = 'STIME ' IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, LINK2D, MESSAG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK2D, MESSAG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Can't read STIME from PS loads file ENDIF ENDIF @@ -1077,7 +1003,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) !ENDIF IF (WRITE_NEU) THEN WRITE(NEU,9001) ! End of FEMAP block 451 indicator - CALL FILE_CLOSE ( NEU, NEUFIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( NEU, NEUFIL, 'KEEP' ) ENDIF CALL DEALLOCATE_COL_VEC ( 'PG_COL' ) @@ -1204,7 +1130,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Close OTM text files (unformatted OU4 files closed in subr CLOSE_LIJFILES) IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN DO I=1,MOT4 - CALL FILE_CLOSE ( OT4(I), OT4FIL(I), OT4STAT(I), 'Y' ) + CALL FILE_CLOSE ( OT4(I), OT4FIL(I), OT4STAT(I) ) ENDDO ENDIF @@ -1227,9 +1153,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Call OUTPUT4 processor to process output requests for OUTPUT4 matrices generated in this link IF (NUM_OU4_REQUESTS > 0) THEN - CALL OURTIM - MODNAM = 'WRITE OUTPUT4 MATRICES ' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE OUTPUT4 MATRICES ') WRITE(F06,*) CALL OUTPUT4_PROC ( SUBR_NAME ) ENDIF @@ -1352,7 +1276,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! Write data to L1A - CALL WRITE_L1A ( L1ASTAT, 'Y', 'Y' ) + CALL WRITE_L1A ( L1ASTAT, 'Y' ) ! Do file inquire, if requested @@ -1364,9 +1288,9 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) INQUIRE ( FILE=F25FIL, EXIST=LEXIST, OPENED=LOPEN ) IF (LOPEN) THEN - CALL FILE_CLOSE ( F25, F25FIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( F25, F25FIL, 'KEEP' ) ELSE - CALL FILE_CLOSE ( F25, F25FIL, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( F25, F25FIL, 'DELETE' ) ENDIF ! Check allocation status of allocatable arrays, if requested @@ -1377,25 +1301,17 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ENDIF - ! Write LINK9 end to F04, F06 + ! Write LINK9 end to F06 CALL OURTIM - IF (WRT_LOG > 0) THEN - WRITE(F04,151) LINKNO - ENDIF WRITE(F06,151) LINKNO - ! Close ANS but leave the closing of BUG, ERR, F04, F06 files until after LINK9 returns to MYSTRAN.for - IF (WRITE_ANS) THEN - CALL FILE_CLOSE ( ANS, ANSFIL, 'KEEP', 'Y' ) - ELSE - CALL FILE_CLOSE ( ANS, ANSFIL, 'DELETE', 'Y' ) - ENDIF + ! Leave the closing of BUG, ERR, F06 files until after LINK9 returns to MYSTRAN.for ! Close some files IF ((SOL_NAME(1:8) == 'BUCKLING') .OR. (SOL_NAME(1:8) == 'DIFFEREN') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - CALL FILE_CLOSE ( L1E, LINK1E, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1E, LINK1E, 'KEEP' ) ELSE - CALL FILE_CLOSE ( L1E, LINK1E, L1ESTAT, 'Y' ) + CALL FILE_CLOSE ( L1E, LINK1E, L1ESTAT ) ENDIF ! Write LINK9 end to screen @@ -1488,10 +1404,6 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) 9055 FORMAT('The heading "LOCATION" for stresses and strains only has significance for the elements that allow output of these',/,& 'quantities at specific locations as specified on the Case Control STRESS, STRAIN entries (see MYSTRAN Users Manual)') - 9092 FORMAT(1X,I2,'/',A54,8X,2X,I2,':',I2,':',I2,'.',I3) - - 9093 FORMAT(1X,I2,'/',A54,I8,2X,I2,':',I2,':',I2,'.',I3) - 9095 FORMAT(1X,'********** Subcase No. ',I8,' **********') 9096 FORMAT(1X,'********** Eigenvector No. ',I8,' **********') @@ -1693,7 +1605,7 @@ END SUBROUTINE WRITE_OTM_TO_F06 SUBROUTINE GET_FG_INERTIA_FORCES USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06, LINK2I, L2I, L2I_MSG, L2ISTAT + USE IOUNT1, ONLY : ERR, F06, LINK2I, L2I, L2I_MSG, L2ISTAT USE SCONTR, ONLY : NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, NDOFN, NDOFO, NDOFS, NDOFR, NTERM_MLL USE SPARSE_MATRICES, ONLY : I_MLL, J_MLL, MLL, SYM_MLL USE EIGEN_MATRICES_1, ONLY : EIGEN_VAL @@ -1846,8 +1758,6 @@ SUBROUTINE GET_FG_INERTIA_FORCES RETURN -! ********************************************************************************************************************************** - 9092 FORMAT(1X,I2,'/',A54,8X,2X,I2,':',I2,':',I2,'.',I3) ! ********************************************************************************************************************************** diff --git a/Source/LK9/LINK9/LINK9S.f90 b/Source/LK9/LINK9/LINK9S.f90 index 63f09355..54fd3386 100644 --- a/Source/LK9/LINK9/LINK9S.f90 +++ b/Source/LK9/LINK9/LINK9S.f90 @@ -30,7 +30,7 @@ SUBROUTINE LINK9S USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, & + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, & L1D , L1G , L1K , L1Q , & LINK1D , LINK1G , LINK1K , LINK1Q , & L1D_MSG, L1G_MSG, L1K_MSG, L1Q_MSG, & @@ -46,7 +46,6 @@ SUBROUTINE LINK9S USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : CBMIN3, CBMIN4, IORQ1M, IORQ1S, IORQ1B, IORQ2B, IORQ2T - USE SUBR_BEGEND_LEVELS, ONLY : LINK9S_BEGEND USE MODEL_STUF, ONLY : BAROFF, BUSHOFF, EDAT, EOFF, EPNT, ESORT1, ESORT2, ETYPE, PLATEOFF, PLATETHICK, VVEC USE MODEL_STUF, ONLY : MATANGLE, MATL, RMATL, PBAR, RPBAR, PBEAM, RPBEAM, PBUSH, RPBUSH, PCOMP, RPCOMP, PELAS, & @@ -74,14 +73,9 @@ SUBROUTINE LINK9S INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: REC_NO ! Record number of a record read from a file INTEGER(LONG) :: UNT ! Unit number of a file to be read - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = LINK9S_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -96,7 +90,7 @@ SUBROUTINE LINK9S UNT = L1D MESSAG = L1D_MSG - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read subcase numbers, titling, load request data @@ -293,9 +287,9 @@ SUBROUTINE LINK9S IF (INT2 /= ANY_STRE_OUTPUT) CALL DATA_SET_SIZE_ERROR ( LINK1D, NAME_Is, 'NSUB', NSUB, INT2 ) IF ((SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:8) /= 'NLSTATIC')) THEN - CALL FILE_CLOSE ( L1D, LINK1D, L1DSTAT, 'Y' ) + CALL FILE_CLOSE ( L1D, LINK1D, L1DSTAT ) ELSE - CALL FILE_CLOSE ( L1D, LINK1D, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1D, LINK1D, 'KEEP' ) ENDIF ! ********************************************************************************************************************************** @@ -305,7 +299,7 @@ SUBROUTINE LINK9S UNT = L1G MESSAG = L1G_MSG - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read ETYPE, EPNT, ESORT1 ESORT,2, EOFF @@ -899,9 +893,9 @@ SUBROUTINE LINK9S ENDDO IF ((SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:8) /= 'NLSTATIC')) THEN - CALL FILE_CLOSE ( L1G, LINK1G, L1GSTAT, 'Y' ) + CALL FILE_CLOSE ( L1G, LINK1G, L1GSTAT ) ELSE - CALL FILE_CLOSE ( L1G, LINK1G, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1G, LINK1G, 'KEEP' ) ENDIF ! ********************************************************************************************************************************** @@ -915,7 +909,7 @@ SUBROUTINE LINK9S IF (NTCARD > 0) THEN - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read TPNT @@ -984,9 +978,9 @@ SUBROUTINE LINK9S ENDDO IF ((SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:8) /= 'NLSTATIC')) THEN - CALL FILE_CLOSE ( L1K, LINK1K, L1KSTAT, 'Y' ) + CALL FILE_CLOSE ( L1K, LINK1K, L1KSTAT ) ELSE - CALL FILE_CLOSE ( L1K, LINK1K, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1K, LINK1K, 'KEEP' ) ENDIF ENDIF @@ -1004,7 +998,7 @@ SUBROUTINE LINK9S IF (NPCARD > 0) THEN - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read PPNT @@ -1085,21 +1079,16 @@ SUBROUTINE LINK9S ENDDO IF ((SOL_NAME(1:8) /= 'BUCKLING') .AND. (SOL_NAME(1:8) /= 'NLSTATIC')) THEN - CALL FILE_CLOSE ( L1Q, LINK1Q, L1QSTAT, 'Y' ) + CALL FILE_CLOSE ( L1Q, LINK1Q, L1QSTAT ) ELSE - CALL FILE_CLOSE ( L1Q, LINK1Q, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1Q, LINK1Q, 'KEEP' ) ENDIF ENDIF ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/LK9/LINK9/MAXREQ_OGEL.f90 b/Source/LK9/LINK9/MAXREQ_OGEL.f90 index 4def0367..0a95a558 100644 --- a/Source/LK9/LINK9/MAXREQ_OGEL.f90 +++ b/Source/LK9/LINK9/MAXREQ_OGEL.f90 @@ -29,11 +29,10 @@ SUBROUTINE MAXREQ_OGEL ! Count number of output requests to determine required leading dimension of array OGEL so memory can be allocated to it USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, IBIT, LSUB, NDOFG, NELE, NGRID, METYPE, SOL_NAME USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MAXREQ_OGEL_BEGEND USE MODEL_STUF, ONLY : ELMTYP, ELOUT, ESORT2, ETYPE, GROUT, MEFFMASS_CALC, MPFACTOR_CALC, NELGP, NUM_PLIES, & PCOMP_PROPS, SCNUM, TYPE USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC, FORC_LOC @@ -60,16 +59,11 @@ SUBROUTINE MAXREQ_OGEL INTEGER(LONG) :: MAXELOUT ! Max of MAXELOUT_SC for all subcases INTEGER(LONG) :: NREQ_EL(METYPE,0:15) ! No. of requests in ELOUT for each bit of ELOUT for 1 subcase INTEGER(LONG) :: NREQ_GR(0:15) ! No. of requests in GROUT for each bit of GROUT for 1 subcase - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MAXREQ_OGEL_BEGEND + INTRINSIC :: IAND, MAX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -208,12 +202,7 @@ SUBROUTINE MAXREQ_OGEL IF (DEBUG(91) == 1) CALL MAXREQ_OGEL_DEB ( '31' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/MAIN/GET_INI_FILNAM.f90 b/Source/MAIN/GET_INI_FILNAM.f90 index b9cfe463..af2b89bd 100644 --- a/Source/MAIN/GET_INI_FILNAM.f90 +++ b/Source/MAIN/GET_INI_FILNAM.f90 @@ -31,7 +31,7 @@ SUBROUTINE GET_INI_FILNAM ( MYSTRAN_DIR, MYSTRAN_DIR_LEN, INIFIL_NAME_LEN ) ! Gets name (incl path) of the MYSTRAN.INI initialization file. USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, F04, INIFIL, WRT_LOG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, INIFIL USE SCONTR, ONLY : BLNK_SUB_NAM, PROG_NAME USE TIMDAT, ONLY : TSEC diff --git a/Source/MAIN/MYSTRAN.f90 b/Source/MAIN/MYSTRAN.f90 index 0b51fefc..1d79966e 100644 --- a/Source/MAIN/MYSTRAN.f90 +++ b/Source/MAIN/MYSTRAN.f90 @@ -69,15 +69,15 @@ PROGRAM MYSTRAN USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, IN0, IN1, L1A, NEU, SC1 + USE IOUNT1, ONLY : BUG, ERR, F06, IN0, IN1, L1A, NEU, SC1 USE IOUNT1, ONLY : F06FIL, IN0FIL, INFILE, NEUFIL USE IOUNT1, ONLY : IN0_MSG, IN1_MSG, L1A_MSG - USE IOUNT1, ONLY : BUGSTAT, BUGSTAT_OLD, ERRSTAT, ERRSTAT_OLD, F04STAT, F04STAT_OLD, PCHSTAT, OP2STAT + USE IOUNT1, ONLY : BUGSTAT, BUGSTAT_OLD, ERRSTAT, ERRSTAT_OLD, PCHSTAT, OP2STAT - USE IOUNT1, ONLY : LEN_INPUT_FNAME, LEN_RESTART_FNAME,LINK1A, WRT_LOG, BUGOUT, RESTART_FILNAM + USE IOUNT1, ONLY : LEN_INPUT_FNAME, LEN_RESTART_FNAME,LINK1A, BUGOUT, RESTART_FILNAM USE SCONTR, ONLY : COMM, FATAL_ERR, LINKNO_START, LSETLN, LSETS, LSUB, NDOFL, NSETS, NSUB, NTSUB, & PROG_NAME, RESTART, SETLEN, SOL_NAME, WARN_ERR @@ -173,7 +173,7 @@ PROGRAM MYSTRAN IF (LINKNO_START == 0) THEN ! Open input data file (FEM model) for reading - CALL FILE_OPEN ( IN1, INFILE, OUNT, 'OLD', IN1_MSG, 'NEITHER', 'FORMATTED', 'READ', 'REWIND', 'N', 'N', 'N' ) + CALL FILE_OPEN ( IN1, INFILE, OUNT, 'OLD', IN1_MSG, 'NEITHER', 'FORMATTED', 'READ', 'REWIND', 'N', 'N' ) CALL IS_THIS_A_RESTART ! Only check if RESTART entry is in E.C. (need for subr MYSTRAN_FILES) REWIND (IN1) @@ -181,12 +181,12 @@ PROGRAM MYSTRAN ! Process INCLUDE entries in whole DAT file here to create the IN0 file CALL PROCESS_INCLUDE_FILES ( NUM_INCL_FILES ) IF (NUM_INCL_FILES > 0) THEN - CALL FILE_CLOSE ( IN1, INFILE, 'KEEP', 'Y' ) - CALL FILE_CLOSE ( IN0, INFILE, 'KEEP', 'Y' ) - CALL FILE_OPEN ( IN1, IN0FIL, OUNT, 'OLD', IN0_MSG, 'NEITHER', 'FORMATTED', 'READ', 'REWIND', 'N', 'N', 'N' ) + CALL FILE_CLOSE ( IN1, INFILE, 'KEEP' ) + CALL FILE_CLOSE ( IN0, INFILE, 'KEEP' ) + CALL FILE_OPEN ( IN1, IN0FIL, OUNT, 'OLD', IN0_MSG, 'NEITHER', 'FORMATTED', 'READ', 'REWIND', 'N', 'N' ) INFILE(1:) = IN0FIL(1:) ELSE - CALL FILE_CLOSE ( IN0, INFILE, 'DELETE', 'Y' ) + CALL FILE_CLOSE ( IN0, INFILE, 'DELETE' ) REWIND (IN1) ENDIF @@ -197,18 +197,16 @@ PROGRAM MYSTRAN BUGSTAT_OLD = BUGSTAT ! Default value from module IOUNT1 ERRSTAT_OLD = ERRSTAT ! Default value from module IOUNT1 - F04STAT_OLD = F04STAT ! Default value from module IOUNT1 ELSE ! This is a RESTART I1 = LEN_RESTART_FNAME LINK1A(1:I1) = RESTART_FILNAM(1:I1) LINK1A(I1+1:) = 'L1A' - CALL READ_L1A ( 'KEEP', 'N' ) + CALL READ_L1A ( 'KEEP' ) BUGSTAT_OLD = BUGSTAT ! Old value from LINK1A ERRSTAT_OLD = ERRSTAT ! Old value from LINK1A - F04STAT_OLD = F04STAT ! Old value from LINK1A NSUB = 0 ! Initialize items read from L1A that could be changed in the RESTART NTSUB = 0 @@ -378,21 +376,12 @@ PROGRAM MYSTRAN ENDIF ENDIF - IF (WRT_LOG > 0) THEN - F04STAT = 'KEEP' - ELSE - IF (F04STAT_OLD == 'KEEP ') THEN - F04STAT = 'KEEP' - ELSE - F04STAT = 'DELETE' - ENDIF - ENDIF !xx IF (WRITE_NEU) THEN -!xx CALL FILE_CLOSE ( NEU, NEUFIL, 'KEEP', 'Y' ) +!xx CALL FILE_CLOSE ( NEU, NEUFIL, 'KEEP' ) !xx ENDIF -! Write MYSTRAN END to BUG, ERR, F04, F06 and then close those files +! Write MYSTRAN END to BUG, ERR, F06 and then close those files WRITE(F06,*) CALL CPU_TIME ( TIME_END ) @@ -403,14 +392,13 @@ PROGRAM MYSTRAN CALL OURDAT WRITE(BUG,152) MONTH,DAY,YEAR,HOUR,MINUTE,SEC,SFRAC WRITE(ERR,152) MONTH,DAY,YEAR,HOUR,MINUTE,SEC,SFRAC - WRITE(F04,152) MONTH,DAY,YEAR,HOUR,MINUTE,SEC,SFRAC WRITE(F06,152) MONTH,DAY,YEAR,HOUR,MINUTE,SEC,SFRAC IF (( DEBUG(193) == 100) .OR. (DEBUG(193) == 999)) THEN CALL FILE_INQUIRE ( 'near end of MAIN' ) ENDIF - CALL CLOSE_OUTFILES ( BUGSTAT, ERRSTAT, F04STAT, OP2STAT, PCHSTAT ) + CALL CLOSE_OUTFILES ( BUGSTAT, ERRSTAT, OP2STAT, PCHSTAT ) ! Close LIJ files diff --git a/Source/MAIN/MYSTRAN_FILES.f90 b/Source/MAIN/MYSTRAN_FILES.f90 index 6dc038eb..ad85c6c7 100644 --- a/Source/MAIN/MYSTRAN_FILES.f90 +++ b/Source/MAIN/MYSTRAN_FILES.f90 @@ -27,16 +27,16 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC) ! Sets all MYSTRAN file names. Opens all files and closes and deletes them so that no confusion about files if MYSTRAN aborts -! Reopen ANS, BUG, ERR, F04, F06 +! Reopen BUG, ERR, F06 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, MOT4, MOU4, WRT_BUG, WRT_ERR, WRT_LOG, LEN_INPUT_FNAME, & + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, MOT4, MOU4, WRT_BUG, WRT_ERR, LEN_INPUT_FNAME, & LEN_RESTART_FNAME, RESTART_FILNAM USE IOUNT1, ONLY : OU4_EXT, OT4_EXT - USE IOUNT1, ONLY : ANS, BUG, EIN, ENF, ERR, F04, F06, IN0, PCH, SC1, & + USE IOUNT1, ONLY : BUG, EIN, ENF, ERR, F06, IN0, PCH, SC1, & SEQ, SPC, & L1A, L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, & L1K, L1L, L1M, L1N, L1O, L1P, L1Q, L1R, L1S, L1T, & @@ -46,7 +46,7 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START L3A, L4A, L4B, L4C, L4D, L5A, L5B, & NEU, F21, F22, F23, F24, F25, OP2, OT4, OU4 - USE IOUNT1, ONLY : ANSFIL, BUGFIL, EINFIL, ENFFIL, ERRFIL, F04FIL, F06FIL, IN0FIL, INFILE, PCHFIL, & + USE IOUNT1, ONLY : BUGFIL, EINFIL, ENFFIL, ERRFIL, F06FIL, IN0FIL, INFILE, PCHFIL, & OT4FIL, SEQFIL, SPCFIL, & LINK1A, LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, & LINK1K, LINK1L, LINK1M, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1R, LINK1S, LINK1T, & @@ -56,7 +56,7 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START LINK3A, LINK4A, LINK4B, LINK4C, LINK4D, LINK5A, LINK5B, & NEUFIL, F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, OP2FIL, OT4FIL, OU4FIL - USE IOUNT1, ONLY : ANS_MSG, BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F04_MSG, F06_MSG, IN0_MSG, OT4_MSG, PCH_MSG, & + USE IOUNT1, ONLY : BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F06_MSG, IN0_MSG, OT4_MSG, PCH_MSG, & SEQ_MSG, L1A_MSG, L1B_MSG, L1C_MSG, L1D_MSG, L1E_MSG, L1F_MSG, L1G_MSG, L1H_MSG, L1I_MSG, & L1J_MSG, L1K_MSG, L1L_MSG, L1M_MSG, L1N_MSG, L1O_MSG, L1P_MSG, L1Q_MSG, L1R_MSG, L1S_MSG, & L1T_MSG, L1U_MSG, L1V_MSG, L1W_MSG, L1X_MSG, L1Y_MSG, L1Z_MSG, & @@ -67,7 +67,6 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START USE SCONTR, ONLY : BLNK_SUB_NAM, RESTART USE TIMDAT, ONLY : TSEC, stime - USE SUBR_BEGEND_LEVELS, ONLY : MYSTRAN_FILES_BEGEND USE MYSTRAN_FILES_USE_IFs @@ -78,7 +77,7 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'MYSTRAN_FILES' CHARACTER(FILE_NAM_MAXLEN*BYTE) :: FILNAM ! Name of the input file or restart file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MYSTRAN_FILES_BEGEND + INTEGER(LONG), INTENT(IN) :: START_HOUR ! The hour when MYSTRAN started. INTEGER(LONG), INTENT(IN) :: START_MINUTE ! The minute when MYSTRAN started. INTEGER(LONG), INTENT(IN) :: START_SEC ! The second when MYSTRAN started. @@ -107,43 +106,9 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START ! Form file names then open them and close and delete them. In this way, we can get rid of all of these files before ! we begin and start anew. -! Formatted files. Note: for F04, ANS, ERR, F06, BUG reopen them after deleting any old version and write STIME +! Formatted files. Note: for ERR, F06, BUG reopen them after deleting any old version and write STIME - F04FIL(1:I1) = FILNAM(1:I1) - F04FIL(I1+1:) = 'F04' - IF (F04 /= SC1) THEN - INQUIRE ( FILE=F04FIL, EXIST=FILE_EXIST ) - IF (FILE_EXIST) THEN - IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( F04, F04FIL, OUNT,'OLD ', F04_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N','N') - WRITE(F04,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - CALL FILE_CLOSE ( F04, F04FIL,'KEEP','N') - CALL FILE_OPEN ( F04, F04FIL, OUNT,'OLD ', F04_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N','N') - ELSE - CALL FILE_OPEN ( F04, F04FIL, OUNT,'REPLACE', F04_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE ( F04, F04FIL,'DELETE','N') - CALL FILE_OPEN ( F04, F04FIL, OUNT,'NEW', F04_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','N') - WRITE(F04,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - ENDIF - WRITE(F04,*) - ELSE - CALL FILE_OPEN ( F04, F04FIL, OUNT,'NEW', F04_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','Y') - IF(RESTART == 'Y') THEN - WRITE(F04,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - ELSE - WRITE(F04,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - ENDIF - WRITE(F04,*) - ENDIF - ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - WRITE(F04,*) - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF ! ********************************************************************************************************************************** EINFIL(1:I1) = FILNAM(1:I1) @@ -158,19 +123,18 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=F06FIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( F06, F06FIL, OUNT,'OLD ', F06_MSG,'NEITHER' ,'FORMATTED','READWRITE','APPEND','N','N','Y') + CALL FILE_OPEN ( F06, F06FIL, OUNT,'OLD ', F06_MSG,'NEITHER' ,'FORMATTED','READWRITE','APPEND','N','N') WRITE(F06,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - CALL FILE_CLOSE ( F06, F06FIL,'KEEP','Y') - CALL FILE_OPEN ( F06, F06FIL, OUNT,'OLD ', F06_MSG,'NEITHER' ,'FORMATTED','READWRITE','APPEND','N','N','Y') + CALL FILE_CLOSE ( F06, F06FIL,'KEEP') + CALL FILE_OPEN ( F06, F06FIL, OUNT,'OLD ', F06_MSG,'NEITHER' ,'FORMATTED','READWRITE','APPEND','N','N') ELSE - CALL FILE_OPEN ( F06, F06FIL, OUNT,'UNKNOWN', F06_MSG,'NEITHER' ,'FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F06, F06FIL,'DELETE','Y') - CALL FILE_OPEN ( F06, F06FIL, OUNT,'NEW' , F06_MSG,'WRITE_STIME','FORMATTED','WRITE' ,'REWIND','Y','Y','Y') + CALL FILE_OPEN ( F06, F06FIL, OUNT,'UNKNOWN', F06_MSG,'NEITHER' ,'FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( F06, F06FIL,'DELETE') + CALL FILE_OPEN ( F06, F06FIL, OUNT,'NEW' , F06_MSG,'WRITE_STIME','FORMATTED','WRITE' ,'REWIND','Y','Y') WRITE(F06,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ENDIF - WRITE(F04,*) ELSE - CALL FILE_OPEN ( F06, F06FIL, OUNT,'NEW', F06_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','Y') + CALL FILE_OPEN ( F06, F06FIL, OUNT,'NEW', F06_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y') IF(RESTART == 'Y') THEN WRITE(F06,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ELSE @@ -185,17 +149,16 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=IN0FIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'OLD ', IN0_MSG,'NEITHER','FORMATTED','WRITE','APPEND','N','N','Y') - CALL FILE_CLOSE ( IN0, IN0FIL,'KEEP','Y') - CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'OLD ', IN0_MSG,'NEITHER','FORMATTED','WRITE','APPEND','N','N','Y') + CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'OLD ', IN0_MSG,'NEITHER','FORMATTED','WRITE','APPEND','N','N') + CALL FILE_CLOSE ( IN0, IN0FIL,'KEEP') + CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'OLD ', IN0_MSG,'NEITHER','FORMATTED','WRITE','APPEND','N','N') ELSE - CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'REPLACE', IN0_MSG,'NEITHER','FORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( IN0, IN0FIL,'DELETE','Y') - CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'NEW', IN0_MSG,'NEITHER','FORMATTED','WRITE','REWIND','N','N','N') + CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'REPLACE', IN0_MSG,'NEITHER','FORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( IN0, IN0FIL,'DELETE') + CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'NEW', IN0_MSG,'NEITHER','FORMATTED','WRITE','REWIND','N','N') ENDIF - WRITE(F04,*) ELSE - CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'NEW', IN0_MSG,'NEITHER','FORMATTED','WRITE','REWIND','N','N','N') + CALL FILE_OPEN ( IN0, IN0FIL, OUNT,'NEW', IN0_MSG,'NEITHER','FORMATTED','WRITE','REWIND','N','N') ENDIF ENDIF @@ -205,25 +168,23 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=BUGFIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'OLD ', BUG_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N','Y') + CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'OLD ', BUG_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N') WRITE(BUG,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - CALL FILE_CLOSE ( BUG, BUGFIL,'KEEP','Y') - CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'OLD ', BUG_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N','Y') + CALL FILE_CLOSE ( BUG, BUGFIL,'KEEP') + CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'OLD ', BUG_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N') ELSE - CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'REPLACE', BUG_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( BUG, BUGFIL,'DELETE','Y') - CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'NEW', BUG_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','Y') + CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'REPLACE', BUG_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( BUG, BUGFIL,'DELETE') + CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'NEW', BUG_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y') WRITE(BUG,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ENDIF - WRITE(F04,*) ELSE - CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'NEW', BUG_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','Y') + CALL FILE_OPEN ( BUG, BUGFIL, OUNT,'NEW', BUG_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y') IF(RESTART == 'Y') THEN WRITE(BUG,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ELSE WRITE(BUG,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ENDIF - WRITE(F04,*) ENDIF ENDIF @@ -233,48 +194,23 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=ERRFIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'OLD ', ERR_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N','Y') + CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'OLD ', ERR_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N') WRITE(ERR,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - CALL FILE_CLOSE ( ERR, ERRFIL,'KEEP','Y') - CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'OLD ', ERR_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N','Y') + CALL FILE_CLOSE ( ERR, ERRFIL,'KEEP') + CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'OLD ', ERR_MSG,'NEITHER','FORMATTED','READWRITE','APPEND','N','N') ELSE - CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'REPLACE', ERR_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( ERR, ERRFIL,'DELETE','Y') - CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'NEW', ERR_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','Y') + CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'REPLACE', ERR_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( ERR, ERRFIL,'DELETE') + CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'NEW', ERR_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y') WRITE(ERR,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ENDIF - WRITE(F04,*) ELSE - CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'NEW', ERR_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','Y') + CALL FILE_OPEN ( ERR, ERRFIL, OUNT,'NEW', ERR_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y') IF(RESTART == 'Y') THEN WRITE(ERR,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ELSE WRITE(ERR,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ENDIF - WRITE(F04,*) - ENDIF - ENDIF - - ANSFIL(1:I1) = FILNAM(1:I1) - ANSFIL(I1+1:) = 'ANS' - IF (ANS /= SC1) THEN - INQUIRE ( FILE=ANSFIL, EXIST=FILE_EXIST ) - IF (FILE_EXIST) THEN - IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( ANS, ANSFIL, OUNT,'OLD ', ANS_MSG,'NEITHER' ,'FORMATTED','READWRITE','APPEND','N','N','Y') - WRITE(ANS,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - CALL FILE_CLOSE ( ANS, ANSFIL,'KEEP','Y') - ELSE - CALL FILE_OPEN ( ANS, ANSFIL, OUNT,'REPLACE', ANS_MSG,'NEITHER' ,'FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( ANS, ANSFIL,'DELETE','Y') - CALL FILE_OPEN ( ANS, ANSFIL, OUNT,'NEW' , ANS_MSG,'WRITE_STIME','FORMATTED','WRITE' ,'REWIND','Y','Y','Y') - WRITE(ANS,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - ENDIF - WRITE(F04,*) - ELSE - CALL FILE_OPEN ( ANS, ANSFIL, OUNT,'NEW', ANS_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','Y') - WRITE(ANS,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - WRITE(F04,*) ENDIF ENDIF @@ -284,20 +220,18 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=PCHFIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( PCH, PCHFIL, OUNT,'OLD ', PCH_MSG,'NEITHER' ,'FORMATTED','READWRITE','APPEND','N','N','Y') + CALL FILE_OPEN ( PCH, PCHFIL, OUNT,'OLD ', PCH_MSG,'NEITHER' ,'FORMATTED','READWRITE','APPEND','N','N') WRITE(PCH,170) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - CALL FILE_CLOSE ( PCH, PCHFIL,'KEEP','Y') + CALL FILE_CLOSE ( PCH, PCHFIL,'KEEP') ELSE - CALL FILE_OPEN ( PCH, PCHFIL, OUNT,'REPLACE', PCH_MSG,'NEITHER' ,'FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( PCH, PCHFIL,'DELETE','Y') - CALL FILE_OPEN ( PCH, PCHFIL, OUNT,'NEW' , PCH_MSG,'WRITE_STIME','FORMATTED','WRITE' ,'REWIND','Y','Y','Y') + CALL FILE_OPEN ( PCH, PCHFIL, OUNT,'REPLACE', PCH_MSG,'NEITHER' ,'FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( PCH, PCHFIL,'DELETE') + CALL FILE_OPEN ( PCH, PCHFIL, OUNT,'NEW' , PCH_MSG,'WRITE_STIME','FORMATTED','WRITE' ,'REWIND','Y','Y') WRITE(PCH,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE ENDIF - WRITE(F04,*) ELSE - CALL FILE_OPEN ( PCH, PCHFIL, OUNT,'NEW', PCH_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y','Y') + CALL FILE_OPEN ( PCH, PCHFIL, OUNT,'NEW', PCH_MSG,'WRITE_STIME','FORMATTED','WRITE','REWIND','Y','Y') WRITE(PCH,150) START_MONTH, START_DAY, START_YEAR, START_HOUR, START_MINUTE, START_SEC, START_SFRAC, INFILE - WRITE(F04,*) ENDIF ENDIF @@ -306,13 +240,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1A, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1A, LINK1A, OUNT,'OLD ', L1A_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1A, LINK1A,'KEEP','Y') + CALL FILE_OPEN ( L1A, LINK1A, OUNT,'OLD ', L1A_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1A, LINK1A,'KEEP') ELSE - CALL FILE_OPEN ( L1A, LINK1A, OUNT,'REPLACE', L1A_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1A, LINK1A,'DELETE','Y') + CALL FILE_OPEN ( L1A, LINK1A, OUNT,'REPLACE', L1A_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1A, LINK1A,'DELETE') ENDIF - WRITE(F04,*) ENDIF NEUFIL(1:I1) = FILNAM(1:I1) @@ -320,13 +253,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=NEUFIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( NEU, NEUFIL, OUNT,'OLD ', NEU_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( NEU, NEUFIL,'KEEP','Y') + CALL FILE_OPEN ( NEU, NEUFIL, OUNT,'OLD ', NEU_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( NEU, NEUFIL,'KEEP') ELSE - CALL FILE_OPEN ( NEU, NEUFIL, OUNT,'REPLACE', NEU_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( NEU, NEUFIL,'DELETE','Y') + CALL FILE_OPEN ( NEU, NEUFIL, OUNT,'REPLACE', NEU_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( NEU, NEUFIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF SEQFIL(1:I1) = FILNAM(1:I1) @@ -334,13 +266,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=SEQFIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( SEQ, SEQFIL, OUNT,'OLD ', SEQ_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( SEQ, SEQFIL,'KEEP','Y') + CALL FILE_OPEN ( SEQ, SEQFIL, OUNT,'OLD ', SEQ_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( SEQ, SEQFIL,'KEEP') ELSE - CALL FILE_OPEN ( SEQ, SEQFIL, OUNT,'REPLACE', SEQ_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( SEQ, SEQFIL,'DELETE','Y') + CALL FILE_OPEN ( SEQ, SEQFIL, OUNT,'REPLACE', SEQ_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( SEQ, SEQFIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF SPCFIL(1:I1) = FILNAM(1:I1) @@ -348,13 +279,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=SPCFIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( SPC, SPCFIL, OUNT,'OLD ', SPC_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( SPC, SPCFIL,'KEEP','Y') + CALL FILE_OPEN ( SPC, SPCFIL, OUNT,'OLD ', SPC_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( SPC, SPCFIL,'KEEP') ELSE - CALL FILE_OPEN ( SPC, SPCFIL, OUNT,'REPLACE', SPC_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( SPC, SPCFIL,'DELETE','Y') + CALL FILE_OPEN ( SPC, SPCFIL, OUNT,'REPLACE', SPC_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE ( SPC, SPCFIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF DO I=1,MOT4 @@ -363,13 +293,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=OT4FIL(I), EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN (OT4(I), OT4FIL(I), OUNT,'OLD ', OT4_MSG(I),'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE (OT4(I), OT4FIL(I),'KEEP','Y') + CALL FILE_OPEN (OT4(I), OT4FIL(I), OUNT,'OLD ', OT4_MSG(I),'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE (OT4(I), OT4FIL(I),'KEEP') ELSE - CALL FILE_OPEN (OT4(I), OT4FIL(I), OUNT,'REPLACE', OT4_MSG(I),'NEITHER','FORMATTED','READWRITE','REWIND','N','N','Y') - CALL FILE_CLOSE (OT4(I), OT4FIL(I),'DELETE','Y') + CALL FILE_OPEN (OT4(I), OT4FIL(I), OUNT,'REPLACE', OT4_MSG(I),'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE (OT4(I), OT4FIL(I),'DELETE') ENDIF - WRITE(F04,*) ENDIF ENDDO @@ -380,13 +309,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=OP2FIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( OP2, OP2FIL, OUNT,'OLD ', OP2_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( OP2, OP2FIL,'KEEP','Y') + CALL FILE_OPEN ( OP2, OP2FIL, OUNT,'OLD ', OP2_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( OP2, OP2FIL,'KEEP') ELSE - CALL FILE_OPEN ( OP2, OP2FIL, OUNT,'REPLACE', OP2_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( OP2, OP2FIL,'DELETE','Y') + CALL FILE_OPEN ( OP2, OP2FIL, OUNT,'REPLACE', OP2_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( OP2, OP2FIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF F21FIL(1:I1) = FILNAM(1:I1) @@ -394,13 +322,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=F21FIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( F21, F21FIL, OUNT,'OLD ', F21_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F21, F21FIL,'KEEP','Y') + CALL FILE_OPEN ( F21, F21FIL, OUNT,'OLD ', F21_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F21, F21FIL,'KEEP') ELSE - CALL FILE_OPEN ( F21, F21FIL, OUNT,'REPLACE', F21_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F21, F21FIL,'DELETE','Y') + CALL FILE_OPEN ( F21, F21FIL, OUNT,'REPLACE', F21_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F21, F21FIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF F22FIL(1:I1) = FILNAM(1:I1) @@ -408,13 +335,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=F22FIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( F22, F22FIL, OUNT,'OLD ', F22_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F22, F22FIL,'KEEP','Y') + CALL FILE_OPEN ( F22, F22FIL, OUNT,'OLD ', F22_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F22, F22FIL,'KEEP') ELSE - CALL FILE_OPEN ( F22, F22FIL, OUNT,'REPLACE', F22_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F22, F22FIL,'DELETE','Y') + CALL FILE_OPEN ( F22, F22FIL, OUNT,'REPLACE', F22_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F22, F22FIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF F23FIL(1:I1) = FILNAM(1:I1) @@ -422,13 +348,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=F23FIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( F23, F23FIL, OUNT,'OLD ', F23_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F23, F23FIL,'KEEP','Y') + CALL FILE_OPEN ( F23, F23FIL, OUNT,'OLD ', F23_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F23, F23FIL,'KEEP') ELSE - CALL FILE_OPEN ( F23, F23FIL, OUNT,'REPLACE', F23_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F23, F23FIL,'DELETE','Y') + CALL FILE_OPEN ( F23, F23FIL, OUNT,'REPLACE', F23_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F23, F23FIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF F24FIL(1:I1) = FILNAM(1:I1) @@ -436,13 +361,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=F24FIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( F24, F24FIL, OUNT,'OLD ', F24_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F24, F24FIL,'KEEP','Y') + CALL FILE_OPEN ( F24, F24FIL, OUNT,'OLD ', F24_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F24, F24FIL,'KEEP') ELSE - CALL FILE_OPEN ( F24, F24FIL, OUNT,'REPLACE', F24_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F24, F24FIL,'DELETE','Y') + CALL FILE_OPEN ( F24, F24FIL, OUNT,'REPLACE', F24_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F24, F24FIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF F25FIL(1:I1) = FILNAM(1:I1) @@ -450,13 +374,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=F25FIL, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( F25, F25FIL, OUNT,'OLD ', F25_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F25, F25FIL,'KEEP','Y') + CALL FILE_OPEN ( F25, F25FIL, OUNT,'OLD ', F25_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F25, F25FIL,'KEEP') ELSE - CALL FILE_OPEN ( F25, F25FIL, OUNT,'REPLACE', F25_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( F25, F25FIL,'DELETE','Y') + CALL FILE_OPEN ( F25, F25FIL, OUNT,'REPLACE', F25_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( F25, F25FIL,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1B(1:I1) = FILNAM(1:I1) @@ -464,13 +387,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1B, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1B, LINK1B, OUNT,'OLD ', L1B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1B, LINK1B,'KEEP','Y') + CALL FILE_OPEN ( L1B, LINK1B, OUNT,'OLD ', L1B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1B, LINK1B,'KEEP') ELSE - CALL FILE_OPEN ( L1B, LINK1B, OUNT,'REPLACE', L1B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1B, LINK1B,'DELETE','Y') + CALL FILE_OPEN ( L1B, LINK1B, OUNT,'REPLACE', L1B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1B, LINK1B,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1C(1:I1) = FILNAM(1:I1) @@ -478,13 +400,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1C, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1C, LINK1C, OUNT,'OLD ', L1C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1C, LINK1C,'KEEP','Y') + CALL FILE_OPEN ( L1C, LINK1C, OUNT,'OLD ', L1C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1C, LINK1C,'KEEP') ELSE - CALL FILE_OPEN ( L1C, LINK1C, OUNT,'REPLACE', L1C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1C, LINK1C,'DELETE','Y') + CALL FILE_OPEN ( L1C, LINK1C, OUNT,'REPLACE', L1C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1C, LINK1C,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1D(1:I1) = FILNAM(1:I1) @@ -492,13 +413,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1D, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1D, LINK1D, OUNT,'OLD ', L1D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1D, LINK1D,'KEEP','Y') + CALL FILE_OPEN ( L1D, LINK1D, OUNT,'OLD ', L1D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1D, LINK1D,'KEEP') ELSE - CALL FILE_OPEN ( L1D, LINK1D, OUNT,'REPLACE', L1D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1D, LINK1D,'DELETE','Y') + CALL FILE_OPEN ( L1D, LINK1D, OUNT,'REPLACE', L1D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1D, LINK1D,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1E(1:I1) = FILNAM(1:I1) @@ -506,13 +426,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1E, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1E, LINK1E, OUNT,'OLD ', L1E_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1E, LINK1E,'KEEP','Y') + CALL FILE_OPEN ( L1E, LINK1E, OUNT,'OLD ', L1E_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1E, LINK1E,'KEEP') ELSE - CALL FILE_OPEN ( L1E, LINK1E, OUNT,'REPLACE', L1E_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1E, LINK1E,'DELETE','Y') + CALL FILE_OPEN ( L1E, LINK1E, OUNT,'REPLACE', L1E_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1E, LINK1E,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1F(1:I1) = FILNAM(1:I1) @@ -520,13 +439,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1F, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1F, LINK1F, OUNT,'OLD ', L1F_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1F, LINK1F,'KEEP','Y') + CALL FILE_OPEN ( L1F, LINK1F, OUNT,'OLD ', L1F_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1F, LINK1F,'KEEP') ELSE - CALL FILE_OPEN ( L1F, LINK1F, OUNT,'REPLACE', L1F_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1F, LINK1F,'DELETE','Y') + CALL FILE_OPEN ( L1F, LINK1F, OUNT,'REPLACE', L1F_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1F, LINK1F,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1G(1:I1) = FILNAM(1:I1) @@ -534,13 +452,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1G, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1G, LINK1G, OUNT,'OLD ', L1G_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1G, LINK1G,'KEEP','Y') + CALL FILE_OPEN ( L1G, LINK1G, OUNT,'OLD ', L1G_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1G, LINK1G,'KEEP') ELSE - CALL FILE_OPEN ( L1G, LINK1G, OUNT,'REPLACE', L1G_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1G, LINK1G,'DELETE','Y') + CALL FILE_OPEN ( L1G, LINK1G, OUNT,'REPLACE', L1G_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1G, LINK1G,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1H(1:I1) = FILNAM(1:I1) @@ -548,13 +465,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1H, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1H, LINK1H, OUNT,'OLD ', L1H_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1H, LINK1H,'KEEP','Y') + CALL FILE_OPEN ( L1H, LINK1H, OUNT,'OLD ', L1H_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1H, LINK1H,'KEEP') ELSE - CALL FILE_OPEN ( L1H, LINK1H, OUNT,'REPLACE', L1H_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1H, LINK1H,'DELETE','Y') + CALL FILE_OPEN ( L1H, LINK1H, OUNT,'REPLACE', L1H_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1H, LINK1H,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1I(1:I1) = FILNAM(1:I1) @@ -562,13 +478,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1I, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1I, LINK1I, OUNT,'OLD ', L1I_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1I, LINK1I,'KEEP','Y') + CALL FILE_OPEN ( L1I, LINK1I, OUNT,'OLD ', L1I_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1I, LINK1I,'KEEP') ELSE - CALL FILE_OPEN ( L1I, LINK1I, OUNT,'REPLACE', L1I_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1I, LINK1I,'DELETE','Y') + CALL FILE_OPEN ( L1I, LINK1I, OUNT,'REPLACE', L1I_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1I, LINK1I,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1J(1:I1) = FILNAM(1:I1) @@ -576,13 +491,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1J, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1J, LINK1J, OUNT,'OLD ', L1J_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1J, LINK1J,'KEEP','Y') + CALL FILE_OPEN ( L1J, LINK1J, OUNT,'OLD ', L1J_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1J, LINK1J,'KEEP') ELSE - CALL FILE_OPEN ( L1J, LINK1J, OUNT,'REPLACE', L1J_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1J, LINK1J,'DELETE','Y') + CALL FILE_OPEN ( L1J, LINK1J, OUNT,'REPLACE', L1J_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1J, LINK1J,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1K(1:I1) = FILNAM(1:I1) @@ -590,13 +504,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1K, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1K, LINK1K, OUNT,'OLD ', L1K_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1K, LINK1K,'KEEP','Y') + CALL FILE_OPEN ( L1K, LINK1K, OUNT,'OLD ', L1K_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1K, LINK1K,'KEEP') ELSE - CALL FILE_OPEN ( L1K, LINK1K, OUNT,'REPLACE', L1K_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1K, LINK1K,'DELETE','Y') + CALL FILE_OPEN ( L1K, LINK1K, OUNT,'REPLACE', L1K_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1K, LINK1K,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1L(1:I1) = FILNAM(1:I1) @@ -604,13 +517,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1L, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1L, LINK1L, OUNT,'OLD ', L1L_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1L, LINK1L,'KEEP','Y') + CALL FILE_OPEN ( L1L, LINK1L, OUNT,'OLD ', L1L_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1L, LINK1L,'KEEP') ELSE - CALL FILE_OPEN ( L1L, LINK1L, OUNT,'REPLACE', L1L_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1L, LINK1L,'DELETE','Y') + CALL FILE_OPEN ( L1L, LINK1L, OUNT,'REPLACE', L1L_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1L, LINK1L,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1M(1:I1) = FILNAM(1:I1) @@ -618,13 +530,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1M, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1M, LINK1M, OUNT,'OLD ', L1M_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1M, LINK1M,'KEEP','Y') + CALL FILE_OPEN ( L1M, LINK1M, OUNT,'OLD ', L1M_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1M, LINK1M,'KEEP') ELSE - CALL FILE_OPEN ( L1M, LINK1M, OUNT,'REPLACE', L1M_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1M, LINK1M,'DELETE','Y') + CALL FILE_OPEN ( L1M, LINK1M, OUNT,'REPLACE', L1M_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1M, LINK1M,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1N(1:I1) = FILNAM(1:I1) @@ -632,13 +543,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1N, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1N, LINK1N, OUNT,'OLD ', L1N_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1N, LINK1N,'KEEP','Y') + CALL FILE_OPEN ( L1N, LINK1N, OUNT,'OLD ', L1N_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1N, LINK1N,'KEEP') ELSE - CALL FILE_OPEN ( L1N, LINK1N, OUNT,'REPLACE', L1N_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1N, LINK1N,'DELETE','Y') + CALL FILE_OPEN ( L1N, LINK1N, OUNT,'REPLACE', L1N_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1N, LINK1N,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1O(1:I1) = FILNAM(1:I1) @@ -646,13 +556,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1O, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1O, LINK1O, OUNT,'OLD ', L1O_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1O, LINK1O,'KEEP','Y') + CALL FILE_OPEN ( L1O, LINK1O, OUNT,'OLD ', L1O_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1O, LINK1O,'KEEP') ELSE - CALL FILE_OPEN ( L1O, LINK1O, OUNT,'REPLACE', L1O_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1O, LINK1O,'DELETE','Y') + CALL FILE_OPEN ( L1O, LINK1O, OUNT,'REPLACE', L1O_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1O, LINK1O,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1P(1:I1) = FILNAM(1:I1) @@ -660,13 +569,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1P, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1P, LINK1P, OUNT,'OLD ', L1P_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1P, LINK1P,'KEEP','Y') + CALL FILE_OPEN ( L1P, LINK1P, OUNT,'OLD ', L1P_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1P, LINK1P,'KEEP') ELSE - CALL FILE_OPEN ( L1P, LINK1P, OUNT,'REPLACE', L1P_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1P, LINK1P,'DELETE','Y') + CALL FILE_OPEN ( L1P, LINK1P, OUNT,'REPLACE', L1P_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1P, LINK1P,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1Q(1:I1) = FILNAM(1:I1) @@ -674,13 +582,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1Q, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1Q, LINK1Q, OUNT,'OLD ', L1Q_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1Q, LINK1Q,'KEEP','Y') + CALL FILE_OPEN ( L1Q, LINK1Q, OUNT,'OLD ', L1Q_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1Q, LINK1Q,'KEEP') ELSE - CALL FILE_OPEN ( L1Q, LINK1Q, OUNT,'REPLACE', L1Q_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1Q, LINK1Q,'DELETE','Y') + CALL FILE_OPEN ( L1Q, LINK1Q, OUNT,'REPLACE', L1Q_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1Q, LINK1Q,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1R(1:I1) = FILNAM(1:I1) @@ -688,13 +595,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1R, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1R, LINK1R, OUNT,'OLD ', L1R_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1R, LINK1R,'KEEP','Y') + CALL FILE_OPEN ( L1R, LINK1R, OUNT,'OLD ', L1R_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1R, LINK1R,'KEEP') ELSE - CALL FILE_OPEN ( L1R, LINK1R, OUNT,'REPLACE', L1R_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1R, LINK1R,'DELETE','Y') + CALL FILE_OPEN ( L1R, LINK1R, OUNT,'REPLACE', L1R_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1R, LINK1R,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1S(1:I1) = FILNAM(1:I1) @@ -702,13 +608,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1S, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1S, LINK1S, OUNT,'OLD ', L1S_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1S, LINK1S,'KEEP','Y') + CALL FILE_OPEN ( L1S, LINK1S, OUNT,'OLD ', L1S_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1S, LINK1S,'KEEP') ELSE - CALL FILE_OPEN ( L1S, LINK1S, OUNT,'REPLACE', L1S_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1S, LINK1S,'DELETE','Y') + CALL FILE_OPEN ( L1S, LINK1S, OUNT,'REPLACE', L1S_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1S, LINK1S,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1T(1:I1) = FILNAM(1:I1) @@ -716,13 +621,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1T, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1T, LINK1T, OUNT,'OLD ', L1T_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1T, LINK1T,'KEEP','Y') + CALL FILE_OPEN ( L1T, LINK1T, OUNT,'OLD ', L1T_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1T, LINK1T,'KEEP') ELSE - CALL FILE_OPEN ( L1T, LINK1T, OUNT,'REPLACE', L1T_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1T, LINK1T,'DELETE','Y') + CALL FILE_OPEN ( L1T, LINK1T, OUNT,'REPLACE', L1T_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1T, LINK1T,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1U(1:I1) = FILNAM(1:I1) @@ -730,13 +634,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1U, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1U, LINK1U, OUNT,'OLD ', L1U_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1U, LINK1U,'KEEP','Y') + CALL FILE_OPEN ( L1U, LINK1U, OUNT,'OLD ', L1U_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1U, LINK1U,'KEEP') ELSE - CALL FILE_OPEN ( L1U, LINK1U, OUNT,'REPLACE', L1U_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1U, LINK1U,'DELETE','Y') + CALL FILE_OPEN ( L1U, LINK1U, OUNT,'REPLACE', L1U_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1U, LINK1U,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1V(1:I1) = FILNAM(1:I1) @@ -744,13 +647,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1V, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1V, LINK1V, OUNT,'OLD ', L1V_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1V, LINK1V,'KEEP','Y') + CALL FILE_OPEN ( L1V, LINK1V, OUNT,'OLD ', L1V_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1V, LINK1V,'KEEP') ELSE - CALL FILE_OPEN ( L1V, LINK1V, OUNT,'REPLACE', L1V_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1V, LINK1V,'DELETE','Y') + CALL FILE_OPEN ( L1V, LINK1V, OUNT,'REPLACE', L1V_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1V, LINK1V,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1W(1:I1) = FILNAM(1:I1) @@ -758,13 +660,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1W, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1W, LINK1W, OUNT,'OLD ', L1W_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1W, LINK1W,'KEEP','Y') + CALL FILE_OPEN ( L1W, LINK1W, OUNT,'OLD ', L1W_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1W, LINK1W,'KEEP') ELSE - CALL FILE_OPEN ( L1W, LINK1W, OUNT,'REPLACE', L1W_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1W, LINK1W,'DELETE','Y') + CALL FILE_OPEN ( L1W, LINK1W, OUNT,'REPLACE', L1W_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1W, LINK1W,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1X(1:I1) = FILNAM(1:I1) @@ -772,13 +673,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1X, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1X, LINK1X, OUNT,'OLD ', L1X_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1X, LINK1X,'KEEP','Y') + CALL FILE_OPEN ( L1X, LINK1X, OUNT,'OLD ', L1X_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1X, LINK1X,'KEEP') ELSE - CALL FILE_OPEN ( L1X, LINK1X, OUNT,'REPLACE', L1X_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1X, LINK1X,'DELETE','Y') + CALL FILE_OPEN ( L1X, LINK1X, OUNT,'REPLACE', L1X_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1X, LINK1X,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1Y(1:I1) = FILNAM(1:I1) @@ -786,13 +686,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1Y, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1Y, LINK1Y, OUNT,'OLD ', L1Y_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1Y, LINK1Y,'KEEP','Y') + CALL FILE_OPEN ( L1Y, LINK1Y, OUNT,'OLD ', L1Y_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1Y, LINK1Y,'KEEP') ELSE - CALL FILE_OPEN ( L1Y, LINK1Y, OUNT,'REPLACE', L1Y_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1Y, LINK1Y,'DELETE','Y') + CALL FILE_OPEN ( L1Y, LINK1Y, OUNT,'REPLACE', L1Y_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1Y, LINK1Y,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK1Z(1:I1) = FILNAM(1:I1) @@ -800,13 +699,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK1Z, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L1Z, LINK1Z, OUNT,'OLD ', L1Z_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1Z, LINK1Z,'KEEP','Y') + CALL FILE_OPEN ( L1Z, LINK1Z, OUNT,'OLD ', L1Z_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1Z, LINK1Z,'KEEP') ELSE - CALL FILE_OPEN ( L1Z, LINK1Z, OUNT,'REPLACE', L1Z_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L1Z, LINK1Z,'DELETE','Y') + CALL FILE_OPEN ( L1Z, LINK1Z, OUNT,'REPLACE', L1Z_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L1Z, LINK1Z,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2A(1:I1) = FILNAM(1:I1) @@ -814,13 +712,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2A, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2A, LINK2A, OUNT,'OLD ', L2A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2A, LINK2A,'KEEP','Y') + CALL FILE_OPEN ( L2A, LINK2A, OUNT,'OLD ', L2A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2A, LINK2A,'KEEP') ELSE - CALL FILE_OPEN ( L2A, LINK2A, OUNT,'REPLACE', L2A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2A, LINK2A,'DELETE','Y') + CALL FILE_OPEN ( L2A, LINK2A, OUNT,'REPLACE', L2A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2A, LINK2A,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2B(1:I1) = FILNAM(1:I1) @@ -828,13 +725,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2B, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2B, LINK2B, OUNT,'OLD ', L2B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2B, LINK2B,'KEEP','Y') + CALL FILE_OPEN ( L2B, LINK2B, OUNT,'OLD ', L2B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2B, LINK2B,'KEEP') ELSE - CALL FILE_OPEN ( L2B, LINK2B, OUNT,'REPLACE', L2B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2B, LINK2B,'DELETE','Y') + CALL FILE_OPEN ( L2B, LINK2B, OUNT,'REPLACE', L2B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2B, LINK2B,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2C(1:I1) = FILNAM(1:I1) @@ -842,13 +738,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2C, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2C, LINK2C, OUNT,'OLD ', L2C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2C, LINK2C,'KEEP','Y') + CALL FILE_OPEN ( L2C, LINK2C, OUNT,'OLD ', L2C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2C, LINK2C,'KEEP') ELSE - CALL FILE_OPEN ( L2C, LINK2C, OUNT,'REPLACE', L2C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2C, LINK2C,'DELETE','Y') + CALL FILE_OPEN ( L2C, LINK2C, OUNT,'REPLACE', L2C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2C, LINK2C,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2D(1:I1) = FILNAM(1:I1) @@ -856,13 +751,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2D, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2D, LINK2D, OUNT,'OLD ', L2D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2D, LINK2D,'KEEP','Y') + CALL FILE_OPEN ( L2D, LINK2D, OUNT,'OLD ', L2D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2D, LINK2D,'KEEP') ELSE - CALL FILE_OPEN ( L2D, LINK2D, OUNT,'REPLACE', L2D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2D, LINK2D,'DELETE','Y') + CALL FILE_OPEN ( L2D, LINK2D, OUNT,'REPLACE', L2D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2D, LINK2D,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2E(1:I1) = FILNAM(1:I1) @@ -870,13 +764,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2E, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2E, LINK2E, OUNT,'OLD ', L2E_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2E, LINK2E,'KEEP','Y') + CALL FILE_OPEN ( L2E, LINK2E, OUNT,'OLD ', L2E_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2E, LINK2E,'KEEP') ELSE - CALL FILE_OPEN ( L2E, LINK2E, OUNT,'REPLACE', L2E_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2E, LINK2E,'DELETE','Y') + CALL FILE_OPEN ( L2E, LINK2E, OUNT,'REPLACE', L2E_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2E, LINK2E,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2F(1:I1) = FILNAM(1:I1) @@ -884,13 +777,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2F, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2F, LINK2F, OUNT,'OLD ', L2F_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2F, LINK2F,'KEEP','Y') + CALL FILE_OPEN ( L2F, LINK2F, OUNT,'OLD ', L2F_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2F, LINK2F,'KEEP') ELSE - CALL FILE_OPEN ( L2F, LINK2F, OUNT,'REPLACE', L2F_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2F, LINK2F,'DELETE','Y') + CALL FILE_OPEN ( L2F, LINK2F, OUNT,'REPLACE', L2F_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2F, LINK2F,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2G(1:I1) = FILNAM(1:I1) @@ -898,13 +790,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2G, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2G, LINK2G, OUNT,'OLD ', L2G_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2G, LINK2G,'KEEP','Y') + CALL FILE_OPEN ( L2G, LINK2G, OUNT,'OLD ', L2G_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2G, LINK2G,'KEEP') ELSE - CALL FILE_OPEN ( L2G, LINK2G, OUNT,'REPLACE', L2G_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2G, LINK2G,'DELETE','Y') + CALL FILE_OPEN ( L2G, LINK2G, OUNT,'REPLACE', L2G_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2G, LINK2G,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2H(1:I1) = FILNAM(1:I1) @@ -912,13 +803,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2H, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2H, LINK2H, OUNT,'OLD ', L2H_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2H, LINK2H,'KEEP','Y') + CALL FILE_OPEN ( L2H, LINK2H, OUNT,'OLD ', L2H_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2H, LINK2H,'KEEP') ELSE - CALL FILE_OPEN ( L2H, LINK2H, OUNT,'REPLACE', L2H_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2H, LINK2H,'DELETE','Y') + CALL FILE_OPEN ( L2H, LINK2H, OUNT,'REPLACE', L2H_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2H, LINK2H,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2I(1:I1) = FILNAM(1:I1) @@ -926,13 +816,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2I, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2I, LINK2I, OUNT,'OLD ', L2I_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2I, LINK2I,'KEEP','Y') + CALL FILE_OPEN ( L2I, LINK2I, OUNT,'OLD ', L2I_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2I, LINK2I,'KEEP') ELSE - CALL FILE_OPEN ( L2I, LINK2I, OUNT,'REPLACE', L2I_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2I, LINK2I,'DELETE','Y') + CALL FILE_OPEN ( L2I, LINK2I, OUNT,'REPLACE', L2I_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2I, LINK2I,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2J(1:I1) = FILNAM(1:I1) @@ -940,13 +829,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2J, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2J, LINK2J, OUNT,'OLD ', L2J_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2J, LINK2J,'KEEP','Y') + CALL FILE_OPEN ( L2J, LINK2J, OUNT,'OLD ', L2J_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2J, LINK2J,'KEEP') ELSE - CALL FILE_OPEN ( L2J, LINK2J, OUNT,'REPLACE', L2J_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2J, LINK2J,'DELETE','Y') + CALL FILE_OPEN ( L2J, LINK2J, OUNT,'REPLACE', L2J_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2J, LINK2J,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2K(1:I1) = FILNAM(1:I1) @@ -954,13 +842,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2K, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2K, LINK2K, OUNT,'OLD ', L2K_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2K, LINK2K,'KEEP','Y') + CALL FILE_OPEN ( L2K, LINK2K, OUNT,'OLD ', L2K_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2K, LINK2K,'KEEP') ELSE - CALL FILE_OPEN ( L2K, LINK2K, OUNT,'REPLACE', L2K_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2K, LINK2K,'DELETE','Y') + CALL FILE_OPEN ( L2K, LINK2K, OUNT,'REPLACE', L2K_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2K, LINK2K,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2L(1:I1) = FILNAM(1:I1) @@ -968,13 +855,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2L, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2L, LINK2L, OUNT,'OLD ', L2L_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2L, LINK2L,'KEEP','Y') + CALL FILE_OPEN ( L2L, LINK2L, OUNT,'OLD ', L2L_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2L, LINK2L,'KEEP') ELSE - CALL FILE_OPEN ( L2L, LINK2L, OUNT,'REPLACE', L2L_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2L, LINK2L,'DELETE','Y') + CALL FILE_OPEN ( L2L, LINK2L, OUNT,'REPLACE', L2L_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2L, LINK2L,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2M(1:I1) = FILNAM(1:I1) @@ -982,13 +868,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2M, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2M, LINK2M, OUNT,'OLD ', L2M_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2M, LINK2M,'KEEP','Y') + CALL FILE_OPEN ( L2M, LINK2M, OUNT,'OLD ', L2M_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2M, LINK2M,'KEEP') ELSE - CALL FILE_OPEN ( L2M, LINK2M, OUNT,'REPLACE', L2M_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2M, LINK2M,'DELETE','Y') + CALL FILE_OPEN ( L2M, LINK2M, OUNT,'REPLACE', L2M_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2M, LINK2M,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2N(1:I1) = FILNAM(1:I1) @@ -996,13 +881,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2N, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2N, LINK2N, OUNT,'OLD ', L2N_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2N, LINK2N,'KEEP','Y') + CALL FILE_OPEN ( L2N, LINK2N, OUNT,'OLD ', L2N_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2N, LINK2N,'KEEP') ELSE - CALL FILE_OPEN ( L2N, LINK2N, OUNT,'REPLACE', L2N_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2N, LINK2N,'DELETE','Y') + CALL FILE_OPEN ( L2N, LINK2N, OUNT,'REPLACE', L2N_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2N, LINK2N,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2O(1:I1) = FILNAM(1:I1) @@ -1010,13 +894,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2O, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2O, LINK2O, OUNT,'OLD ', L2O_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2O, LINK2O,'KEEP','Y') + CALL FILE_OPEN ( L2O, LINK2O, OUNT,'OLD ', L2O_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2O, LINK2O,'KEEP') ELSE - CALL FILE_OPEN ( L2O, LINK2O, OUNT,'REPLACE', L2O_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2O, LINK2O,'DELETE','Y') + CALL FILE_OPEN ( L2O, LINK2O, OUNT,'REPLACE', L2O_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2O, LINK2O,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2P(1:I1) = FILNAM(1:I1) @@ -1024,13 +907,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2P, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2P, LINK2P, OUNT,'OLD ', L2P_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2P, LINK2P,'KEEP','Y') + CALL FILE_OPEN ( L2P, LINK2P, OUNT,'OLD ', L2P_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2P, LINK2P,'KEEP') ELSE - CALL FILE_OPEN ( L2P, LINK2P, OUNT,'REPLACE', L2P_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2P, LINK2P,'DELETE','Y') + CALL FILE_OPEN ( L2P, LINK2P, OUNT,'REPLACE', L2P_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2P, LINK2P,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2Q(1:I1) = FILNAM(1:I1) @@ -1038,13 +920,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2Q, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2Q, LINK2Q, OUNT,'OLD ', L2Q_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2Q, LINK2Q,'KEEP','Y') + CALL FILE_OPEN ( L2Q, LINK2Q, OUNT,'OLD ', L2Q_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2Q, LINK2Q,'KEEP') ELSE - CALL FILE_OPEN ( L2Q, LINK2Q, OUNT,'REPLACE', L2Q_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2Q, LINK2Q,'DELETE','Y') + CALL FILE_OPEN ( L2Q, LINK2Q, OUNT,'REPLACE', L2Q_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2Q, LINK2Q,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2R(1:I1) = FILNAM(1:I1) @@ -1052,13 +933,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2R, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2R, LINK2R, OUNT,'OLD ', L2R_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2R, LINK2R,'KEEP','Y') + CALL FILE_OPEN ( L2R, LINK2R, OUNT,'OLD ', L2R_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2R, LINK2R,'KEEP') ELSE - CALL FILE_OPEN ( L2R, LINK2R, OUNT,'REPLACE', L2R_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2R, LINK2R,'DELETE','Y') + CALL FILE_OPEN ( L2R, LINK2R, OUNT,'REPLACE', L2R_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2R, LINK2R,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2S(1:I1) = FILNAM(1:I1) @@ -1066,13 +946,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2S, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2S, LINK2S, OUNT,'OLD ', L2S_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2S, LINK2S,'KEEP','Y') + CALL FILE_OPEN ( L2S, LINK2S, OUNT,'OLD ', L2S_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2S, LINK2S,'KEEP') ELSE - CALL FILE_OPEN ( L2S, LINK2S, OUNT,'REPLACE', L2S_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2S, LINK2S,'DELETE','Y') + CALL FILE_OPEN ( L2S, LINK2S, OUNT,'REPLACE', L2S_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2S, LINK2S,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK2T(1:I1) = FILNAM(1:I1) @@ -1080,13 +959,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK2T, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L2T, LINK2T, OUNT,'OLD ', L2T_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2T, LINK2T,'KEEP','Y') + CALL FILE_OPEN ( L2T, LINK2T, OUNT,'OLD ', L2T_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2T, LINK2T,'KEEP') ELSE - CALL FILE_OPEN ( L2T, LINK2T, OUNT,'REPLACE', L2T_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L2T, LINK2T,'DELETE','Y') + CALL FILE_OPEN ( L2T, LINK2T, OUNT,'REPLACE', L2T_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L2T, LINK2T,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK3A(1:I1) = FILNAM(1:I1) @@ -1094,13 +972,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK3A, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L3A, LINK3A, OUNT,'OLD ', L3A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L3A, LINK3A,'KEEP','Y') + CALL FILE_OPEN ( L3A, LINK3A, OUNT,'OLD ', L3A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L3A, LINK3A,'KEEP') ELSE - CALL FILE_OPEN ( L3A, LINK3A, OUNT,'REPLACE', L3A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L3A, LINK3A,'DELETE','Y') + CALL FILE_OPEN ( L3A, LINK3A, OUNT,'REPLACE', L3A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L3A, LINK3A,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK4A(1:I1) = FILNAM(1:I1) @@ -1108,13 +985,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK4A, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L4A, LINK4A, OUNT,'OLD ', L4A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L4A, LINK4A,'KEEP','Y') + CALL FILE_OPEN ( L4A, LINK4A, OUNT,'OLD ', L4A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L4A, LINK4A,'KEEP') ELSE - CALL FILE_OPEN ( L4A, LINK4A, OUNT,'REPLACE', L4A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L4A, LINK4A,'DELETE','Y') + CALL FILE_OPEN ( L4A, LINK4A, OUNT,'REPLACE', L4A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L4A, LINK4A,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK4B(1:I1) = FILNAM(1:I1) @@ -1122,13 +998,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK4B, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L4B, LINK4B, OUNT,'OLD ', L4B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L4B, LINK4B,'KEEP','Y') + CALL FILE_OPEN ( L4B, LINK4B, OUNT,'OLD ', L4B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L4B, LINK4B,'KEEP') ELSE - CALL FILE_OPEN ( L4B, LINK4B, OUNT,'REPLACE', L4B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L4B, LINK4B,'DELETE','Y') + CALL FILE_OPEN ( L4B, LINK4B, OUNT,'REPLACE', L4B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L4B, LINK4B,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK4C(1:I1) = FILNAM(1:I1) @@ -1136,13 +1011,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK4C, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L4C, LINK4C, OUNT,'OLD ', L4C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L4C, LINK4C,'KEEP','Y') + CALL FILE_OPEN ( L4C, LINK4C, OUNT,'OLD ', L4C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L4C, LINK4C,'KEEP') ELSE - CALL FILE_OPEN ( L4C, LINK4C, OUNT,'REPLACE', L4C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L4C, LINK4C,'DELETE','Y') + CALL FILE_OPEN ( L4C, LINK4C, OUNT,'REPLACE', L4C_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L4C, LINK4C,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK4D(1:I1) = FILNAM(1:I1) @@ -1150,13 +1024,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK4D, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L4D, LINK4D, OUNT,'OLD ', L4D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L4D, LINK4D,'KEEP','Y') + CALL FILE_OPEN ( L4D, LINK4D, OUNT,'OLD ', L4D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L4D, LINK4D,'KEEP') ELSE - CALL FILE_OPEN ( L4D, LINK4D, OUNT,'REPLACE', L4D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L4D, LINK4D,'DELETE','Y') + CALL FILE_OPEN ( L4D, LINK4D, OUNT,'REPLACE', L4D_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L4D, LINK4D,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK5A(1:I1) = FILNAM(1:I1) @@ -1164,13 +1037,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK5A, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L5A, LINK5A, OUNT,'OLD ', L5A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L5A, LINK5A,'KEEP','Y') + CALL FILE_OPEN ( L5A, LINK5A, OUNT,'OLD ', L5A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L5A, LINK5A,'KEEP') ELSE - CALL FILE_OPEN ( L5A, LINK5A, OUNT,'REPLACE', L5A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L5A, LINK5A,'DELETE','Y') + CALL FILE_OPEN ( L5A, LINK5A, OUNT,'REPLACE', L5A_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L5A, LINK5A,'DELETE') ENDIF - WRITE(F04,*) ENDIF LINK5B(1:I1) = FILNAM(1:I1) @@ -1178,13 +1050,12 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=LINK5B, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN - CALL FILE_OPEN ( L5B, LINK5B, OUNT,'OLD ', L5B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L5B, LINK5B,'KEEP','Y') + CALL FILE_OPEN ( L5B, LINK5B, OUNT,'OLD ', L5B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L5B, LINK5B,'KEEP') ELSE - CALL FILE_OPEN ( L5B, LINK5B, OUNT,'REPLACE', L5B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( L5B, LINK5B,'DELETE','Y') + CALL FILE_OPEN ( L5B, LINK5B, OUNT,'REPLACE', L5B_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( L5B, LINK5B,'DELETE') ENDIF - WRITE(F04,*) ENDIF DO I=1,MOU4 @@ -1193,22 +1064,16 @@ SUBROUTINE MYSTRAN_FILES ( START_MONTH, START_DAY, START_YEAR, START_HOUR, START INQUIRE ( FILE=OU4FIL(I), EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN IF (RESTART == 'Y') THEN ! Keep these until after reading Exec Cont and finding out which ones - CALL FILE_OPEN ( OU4(I), OU4FIL(I), OUNT,'OLD ', OU4_MSG(I),'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( OU4(I), OU4FIL(I),'KEEP','Y') ! will be needed. Then close those and 'KEEP' them + CALL FILE_OPEN ( OU4(I), OU4FIL(I), OUNT,'OLD ', OU4_MSG(I),'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( OU4(I), OU4FIL(I),'KEEP') ! will be needed. Then close those and 'KEEP' them ELSE - CALL FILE_OPEN ( OU4(I), OU4FIL(I), OUNT,'REPLACE', OU4_MSG(I),'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') - CALL FILE_CLOSE ( OU4(I), OU4FIL(I),'DELETE','Y') + CALL FILE_OPEN ( OU4(I), OU4FIL(I), OUNT,'REPLACE', OU4_MSG(I),'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') + CALL FILE_CLOSE ( OU4(I), OU4FIL(I),'DELETE') ENDIF - WRITE(F04,*) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/MAIN/PROCESS_INCLUDE_FILES.f90 b/Source/MAIN/PROCESS_INCLUDE_FILES.f90 index 41ca7fd9..210f24b2 100644 --- a/Source/MAIN/PROCESS_INCLUDE_FILES.f90 +++ b/Source/MAIN/PROCESS_INCLUDE_FILES.f90 @@ -31,10 +31,9 @@ SUBROUTINE PROCESS_INCLUDE_FILES ( NUM_INCL_FILES ) ! the INCLUDE files. This file then becomes the input file by re-opening it as INFILE (the normal input file) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN0, IN1, INC, INFILE, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN0, IN1, INC, INFILE USE SCONTR, ONLY : BLNK_SUB_NAM, EC_ENTRY_LEN, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PROCESS_INCLUDE_FILES_BEGEND USE PROCESS_INCLUDE_FILES_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE PROCESS_INCLUDE_FILES ( NUM_INCL_FILES ) INTEGER(LONG) :: CHAR_COL ! Column number on CARD where character CHAR is found INTEGER(LONG) :: IERR = 0 ! Error indicator. INTEGER(LONG) :: IOCHK ! IOSTAT error number when reading a Case Control card from unit IN1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PROCESS_INCLUDE_FILES_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize @@ -93,12 +87,7 @@ SUBROUTINE PROCESS_INCLUDE_FILES ( NUM_INCL_FILES ) ENDDO main -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/MAIN/READ_INI.f90 b/Source/MAIN/READ_INI.f90 index d8e29415..9cec5480 100644 --- a/Source/MAIN/READ_INI.f90 +++ b/Source/MAIN/READ_INI.f90 @@ -28,15 +28,13 @@ SUBROUTINE READ_INI ( INI_EXIST ) ! Processes MYSTRAN.INI file, which contains default values for things such as the default drive, directory that the input file ! (and all output) will go. Also can change where some output files will go (to screen or printer rather than disk). This later -! feature is useful for debugging. For example, the F04 file unit could be changed from its default value to 6 (console) and then -! all output that goes to the F04 file will be printed on the console. This could locate the subr where a job is crashing if -! INI variable WRT_LOG is set to a high number (like 99) +! feature is useful for debugging. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, DEFDIR, INIFIL, SC1, MOU4, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, DEFDIR, INIFIL, SC1, MOU4, WRT_ERR - USE IOUNT1, ONLY : ANS, BUG, ERR, F04, F06, IN0, IN1, INI, L1A, NEU, & + USE IOUNT1, ONLY : BUG, ERR, F06, IN0, IN1, INI, L1A, NEU, & SEQ, SPC, & F21, F22, F23, F24, F25, & L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, L1K, & @@ -46,7 +44,7 @@ SUBROUTINE READ_INI ( INI_EXIST ) L2K, L2L, L2M, L2N, L2O, L2P, L2Q, L2R, L2S, L2T, & L3A, L4A, L4B, L4C, L4D, L5A, L5B, OP2, OU4 - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ANSSTAT, BUGSTAT, ERRSTAT, F04STAT, F06STAT, IN0STAT, IN1STAT, & + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, BUGSTAT, ERRSTAT, F06STAT, IN0STAT, IN1STAT, & L1ASTAT, NEUSTAT, SEQSTAT, SPCSTAT, & F21STAT, F22STAT, F23STAT, F24STAT, F25STAT, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1JSTAT, L1KSTAT, & @@ -88,7 +86,6 @@ SUBROUTINE READ_INI ( INI_EXIST ) INTEGER(LONG) :: LINE_NUMBER ! Line number in the INI file INTEGER(LONG) :: MYSTRAN_DIR_LEN ! Length of MYSTRAN_DIR (not including trailing blanks) INTEGER(LONG) :: OUNT(2) ! File units to write messages to - INTEGER(LONG) :: WRT_LOG_NEW ! Value of WRT_LOG read from MYSTRAN.INI file ! ********************************************************************************************************************************** ! Default units for writing errors the screen (until LINK1A is read) @@ -110,12 +107,6 @@ SUBROUTINE READ_INI ( INI_EXIST ) PERM_ECHO = ECHO ECHO = 'NONE ' -! Use WRT_LOG_NEW name to read WRT_LOG until we are through reading INI file. This is done since F04FIL not opened -! yet and subr begin/end times cannot be written to that file until after files are opened. - - WRT_LOG = 0 - WRT_LOG_NEW = 0 - ! Initialize array that will say whether an error message has been written for a card field DO I=1,10 @@ -141,7 +132,7 @@ SUBROUTINE READ_INI ( INI_EXIST ) ELSE OPEN (INI,FILE=INIFIL,STATUS='OLD',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, INIFIL, OUNT, 'N' ) + CALL OPNERR ( IOCHK, INIFIL, OUNT ) DO WRITE(SC1,* ) ' Cannot open MYSTRAN.INI file. Continue? (Y/N)' WRITE(SC1,* ) ' If Y, Then default values will be used' @@ -212,11 +203,6 @@ SUBROUTINE READ_INI ( INI_EXIST ) CALL CARD_FLDS_NOT_BLANK0 ( JCARD_08, 0,3,4,5,6,7,8,9, WRT_HDR, WRT_CARD ) CALL CRDERR0 ( CARD, FLD_ERR_MSG ) - ELSE IF (CARD(1:8) == 'WRT_LOG ') THEN - CALL I4FLD0 ( JCARD_08(2), JF(2), WRT_LOG_NEW, WRT_HDR, WRT_CARD, FLD_ERR_MSG ) - CALL CARD_FLDS_NOT_BLANK0 ( JCARD_08, 0,3,4,5,6,7,8,9, WRT_HDR, WRT_CARD ) - CALL CRDERR0 ( CARD, FLD_ERR_MSG ) - ELSE IF (CARD(1:8) == 'ALLFILES') THEN DUMUNIT = 0 CALL READ_INI_LINE ( 'ALLFILES', DUMUNIT, ALL_CLOSE_STAT, WRT_HDR, WRT_CARD, FLD_ERR_MSG ) @@ -226,18 +212,12 @@ SUBROUTINE READ_INI ( INI_EXIST ) DUMSTAT(1:) = ' ' CALL READ_INI_LINE ( 'SC1', SC1, DUMSTAT, WRT_HDR, WRT_CARD, FLD_ERR_MSG ) - ELSE IF (CARD(1:3) == 'ANS') THEN ! 02 (NOTE: ANSSTAT not allowed to be changed here) - CALL READ_INI_LINE ( 'ANS', ANS, ANSSTAT, WRT_HDR, WRT_CARD, FLD_ERR_MSG ) - ELSE IF (CARD(1:3) == 'BUG') THEN ! 03 (NOTE: BUGSTAT not allowed to be changed here) CALL READ_INI_LINE ( 'BUG', BUG, BUGSTAT, WRT_HDR, WRT_CARD, FLD_ERR_MSG ) ELSE IF (CARD(1:3) == 'ERR') THEN ! 04 CALL READ_INI_LINE ( 'ERR', ERR, ERRSTAT, WRT_HDR, WRT_CARD, FLD_ERR_MSG ) - ELSE IF (CARD(1:3) == 'F04') THEN ! 05 - CALL READ_INI_LINE ( 'F04', F04, F04STAT, WRT_HDR, WRT_CARD, FLD_ERR_MSG ) - ELSE IF (CARD(1:3) == 'F06') THEN ! 06 (NOTE: F06STAT not allowed to be changed here) DUMSTAT(1:) = ' ' CALL READ_INI_LINE ( 'F06', F06, DUMSTAT, WRT_HDR, WRT_CARD, FLD_ERR_MSG ) @@ -454,14 +434,13 @@ SUBROUTINE READ_INI ( INI_EXIST ) ENDDO - CALL FILE_CLOSE ( INI, INIFIL, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( INI, INIFIL, 'KEEP' ) ENDIF -! Reset ECHO and WRT_LOG +! Reset ECHO ECHO = PERM_ECHO - WRT_LOG = WRT_LOG_NEW ! Reset close status of files, if ALL_CLOSE_STAT is KEEP @@ -819,7 +798,6 @@ SUBROUTINE CARD_FLDS_NOT_BLANK0 ( JCARD_08, FLD2, FLD3, FLD4, FLD5, FLD6, FLD7, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : PROG_NAME - USE IOUNT1, ONLY : F04 IMPLICIT NONE @@ -942,7 +920,7 @@ SUBROUTINE CRDERR0 ( CARD, FLD_ERR_MSG ) ! Prints Bulk Data card errors and warnings USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR USE SCONTR, ONLY : IERRFL IMPLICIT NONE @@ -988,7 +966,7 @@ SUBROUTINE LEFT_ADJ_BDFLD0 ( CHR8_FLD ) ! Shifts an 8 character string so that it is left adjusted USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC @@ -1026,7 +1004,7 @@ SUBROUTINE C8FLD0 ( JCARDI_08, IFLD, C8INP ) ! Reads a field of CHARACTER data that can be 1 to 8 chars in length USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06 USE SCONTR, ONLY : IERRFL, FATAL_ERR IMPLICIT NONE diff --git a/Source/MAIN/READ_INPUT_FILE_NAME.f90 b/Source/MAIN/READ_INPUT_FILE_NAME.f90 index 85298bf0..97616515 100644 --- a/Source/MAIN/READ_INPUT_FILE_NAME.f90 +++ b/Source/MAIN/READ_INPUT_FILE_NAME.f90 @@ -38,7 +38,7 @@ SUBROUTINE READ_INPUT_FILE_NAME ( INI_EXIST ) ! If the input file is filename.bdf, then that complete name must be supplied USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, DEFDIR, INFILE, & + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, DEFDIR, INFILE, & LEN_INPUT_FNAME, SC1 USE SCONTR, ONLY : PROG_NAME diff --git a/Source/Modules/ARPACK/ARPACK_LANCZOS_EIG.f b/Source/Modules/ARPACK/ARPACK_LANCZOS_EIG.f index 894838c3..ae164e98 100644 --- a/Source/Modules/ARPACK/ARPACK_LANCZOS_EIG.f +++ b/Source/Modules/ARPACK/ARPACK_LANCZOS_EIG.f @@ -3,11 +3,10 @@ MODULE ARPACK_LANCZOS_EIG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, SOL_NAME USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : EIG_MSGLVL - USE SUBR_BEGEND_LEVELS, ONLY : ARPACK_BEGEND USE SuperLU_STUF, ONLY : SLU_FACTORS, SLU_INFO USE PARAMS, ONLY : SOLLIB USE ARPACK_UTIL @@ -20,12 +19,12 @@ MODULE ARPACK_LANCZOS_EIG USE OURTIM_Interface USE MATMULT_SFF_Interface USE ARPACK_INFO_MSG_Interface + USE LINK_MESSAGE_Interface character(1*byte), parameter :: cr13_a = char(13) CHARACTER(44*BYTE) :: MODNAM1 ! Name to write to screen to describe module being run. CHARACTER(44*BYTE) :: MODNAM2 ! Name to write to screen to describe module being run. - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = ARPACK_BEGEND c c\SCCS Information: @(#) c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 @@ -512,7 +511,6 @@ subroutine dsband( rvec, howmny, select, d, z, ldz, sigma, CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DSBAND' - INTEGER(LONG) :: SUBR_BEGEND = ARPACK_BEGEND c c %------------------% c | Scalar Arguments | @@ -587,12 +585,6 @@ subroutine dsband( rvec, howmny, select, d, z, ldz, sigma, c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF ierr = 0 ! ********************************************************************************************************************************** ! B 05/24/04 //////////////////////////////////////////////////////////B @@ -684,14 +676,12 @@ subroutine dsband( rvec, howmny, select, d, z, ldz, sigma, if (eig_lap_mat_type(1:3) == 'DGB') then - call ourtim -! write(sc1,4092) linkno,modnam1,hour,minute,sec,sfrac +! CALL LINK_MESSAGE(modnam1) call dgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr) else if (eig_lap_mat_type(1:3) == 'DPB') then - call ourtim -! write(sc1,4092) linkno,modnam2,hour,minute,sec,sfrac +! CALL LINK_MESSAGE(modnam2) call dpbtrf ( 'U', n, ku, rfac, ku+1, ierr ) do i=1,n iwork(i) = i ! Pivot indices (no pivoting in DPBTRF) @@ -732,14 +722,12 @@ subroutine dsband( rvec, howmny, select, d, z, ldz, sigma, if (eig_lap_mat_type(1:3) == 'DGB') then - call ourtim -! write(sc1,4092) linkno,modnam1,hour,minute,sec,sfrac +! CALL LINK_MESSAGE(modnam1) call dgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr) else if (eig_lap_mat_type(1:3) == 'DPB') then - call ourtim -! write(sc1,4092) linkno,modnam2,hour,minute,sec,sfrac +! CALL LINK_MESSAGE(modnam2) call dpbtrf ( 'U', n, ku, rfac, ku+1, ierr ) do i=1,n iwork(i) = i ! Pivot indices (no pivoting in DPBTRF) @@ -821,7 +809,6 @@ subroutine dsband( rvec, howmny, select, d, z, ldz, sigma, dsaupd_loop_count = dsaupd_loop_count + 1 endif write(sc1,12345,advance='no') iter+1,dsaupd_loop_count,ido,cr13_a - Write(f04, 9876) iter+1, dsaupd_loop_count, ido c Write(f06,*) 'In ARPACK_LANCZOS_EIG: type = ', type ! ********************************************************************** @@ -1161,27 +1148,18 @@ subroutine dsband( rvec, howmny, select, d, z, ldz, sigma, ! ********************************************************************************************************************************** 12345 format(5X,'Iteration',i4,' Rev comm loop',i4,' with IDO =',i3,a) - 9876 format(7X,'Iteration',i4,' Rev comm loop',i4,' with IDO =',i3) - 4907 FORMAT(/,22X,A & ,/,7X,'1',12X,'2',12X,'3',12X,'4',12X,'5',12X,'6',12X, & '7',12X,'8',12X,'9',12X,'10') 4908 FORMAT(10(1X,1ES12.5)) - 4092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - 98710 FORMAT(' dsaupd loop count = ',I4,' ido = ',i4,', "type" = ',I3, & ', using ',a,' LAPACK matrices',/) 99990 FORMAT('********************************************************** &***************************') -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -1197,8 +1175,7 @@ SUBROUTINE ARP_DEB ( WHICH, N, IDO, IPNTR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : PROG_NAME, FATAL_ERR, WARN_ERR - USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, WRT_LOG, ERR, - & F04, F06 + USE IOUNT1, ONLY : WRT_BUG, WRT_ERR, ERR, F06 IMPLICIT NONE @@ -1804,12 +1781,7 @@ subroutine dsaupd c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -2032,12 +2004,6 @@ subroutine dsaupd c 9000 continue c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -2361,12 +2327,6 @@ subroutine dseupd (rvec , howmny, select, d , c | Executable Statements | c %-----------------------% -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF ! ********************************************************************************************************************************** @@ -2926,12 +2886,6 @@ subroutine dseupd (rvec , howmny, select, d , c 9000 continue c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -3241,12 +3195,7 @@ subroutine dsaup2 c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -3929,12 +3878,6 @@ subroutine dsaup2 c 9000 continue -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -4054,12 +3997,7 @@ subroutine dsesrt (which, apply, n, x, na, a, lda) c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -4172,12 +4110,6 @@ subroutine dsesrt (which, apply, n, x, na, a, lda) c 9000 continue -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -4341,12 +4273,7 @@ subroutine dsgets ( ishift, which, kev, np, ritz, bounds, shifts ) c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -4419,12 +4346,6 @@ subroutine dsgets ( ishift, which, kev, np, ritz, bounds, shifts ) & '_sgets: Associated Ritz estimates') end if c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -4528,12 +4449,7 @@ subroutine dsortr (which, apply, n, x1, x2) c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -4662,12 +4578,6 @@ subroutine dsortr (which, apply, n, x1, x2) c 9000 continue c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -4703,12 +4613,7 @@ subroutine dstats c | Executable Statements | c %-----------------------% -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -4735,12 +4640,6 @@ subroutine dstats tmvopx = 0.0D+0 tmvbx = 0.0D+0 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -4954,12 +4853,7 @@ subroutine dgetv0 c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** c @@ -5183,12 +5077,6 @@ subroutine dgetv0 c 9000 continue c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -5494,12 +5382,7 @@ subroutine dsaitr c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -6071,12 +5954,6 @@ subroutine dsaitr c 9000 continue c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -6298,12 +6175,7 @@ subroutine dsapps c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -6616,12 +6488,6 @@ subroutine dsapps c 9000 continue c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -6745,12 +6611,7 @@ subroutine dsconv (n, ritz, bounds, tol, nconv) c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -6777,12 +6638,6 @@ subroutine dsconv (n, ritz, bounds, tol, nconv) call cpu_time (t1) tsconv = tsconv + (t1 - t0) c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -6935,12 +6790,7 @@ subroutine dseigt c | Executable Statements | c %-----------------------% c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -6984,12 +6834,6 @@ subroutine dseigt c 9000 continue c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+3) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -7160,12 +7004,7 @@ subroutine dstqrb ( n, d, e, z, work, info ) c .. c .. executable statements .. c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+4) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -7607,12 +7446,6 @@ subroutine dstqrb ( n, d, e, z, work, info ) c 190 continue c -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+4) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/Modules/BANDIT/BANDIT_FILES.f90 b/Source/Modules/BANDIT/BANDIT_FILES.f90 index bc3d14df..9ab8ebd6 100644 --- a/Source/Modules/BANDIT/BANDIT_FILES.f90 +++ b/Source/Modules/BANDIT/BANDIT_FILES.f90 @@ -105,56 +105,56 @@ SUBROUTINE BANDIT_FILES ( IOU6, IOU7, IOU8, IOU9, IOU11, IOU12, IOU13, IOU14, IO INQUIRE ( FILE=BANDIT_OUT, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU6 , BANDIT_OUT, OUNT,'REPLACE', OUT_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU6 , BANDIT_OUT,'DELETE','N') + CALL FILE_OPEN ( IOU6 , BANDIT_OUT, OUNT,'REPLACE', OUT_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU6 , BANDIT_OUT,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F07, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU7 , BANDIT_F07, OUNT,'REPLACE', F07_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU7 , BANDIT_F07,'DELETE','N') + CALL FILE_OPEN ( IOU7 , BANDIT_F07, OUNT,'REPLACE', F07_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU7 , BANDIT_F07,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F08, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU8 , BANDIT_F08, OUNT,'REPLACE', F08_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU8 , BANDIT_F08,'DELETE','N') + CALL FILE_OPEN ( IOU8 , BANDIT_F08, OUNT,'REPLACE', F08_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU8 , BANDIT_F08,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F09, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU9 , BANDIT_F09, OUNT,'REPLACE', F09_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU9 , BANDIT_F09,'DELETE','N') + CALL FILE_OPEN ( IOU9 , BANDIT_F09, OUNT,'REPLACE', F09_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU9 , BANDIT_F09,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F11, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU11, BANDIT_F11, OUNT,'REPLACE', F11_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU11, BANDIT_F11,'DELETE','N') + CALL FILE_OPEN ( IOU11, BANDIT_F11, OUNT,'REPLACE', F11_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU11, BANDIT_F11,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F14, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU14, BANDIT_F14, OUNT,'REPLACE', F14_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU14, BANDIT_F14,'DELETE','N') + CALL FILE_OPEN ( IOU14, BANDIT_F14, OUNT,'REPLACE', F14_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU14, BANDIT_F14,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F15, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU15, BANDIT_F15, OUNT,'REPLACE', F15_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU15, BANDIT_F15,'DELETE','N') + CALL FILE_OPEN ( IOU15, BANDIT_F15, OUNT,'REPLACE', F15_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU15, BANDIT_F15,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F16, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU16, BANDIT_F16, OUNT,'REPLACE', F16_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU16, BANDIT_F16,'DELETE','N') + CALL FILE_OPEN ( IOU16, BANDIT_F16, OUNT,'REPLACE', F16_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU16, BANDIT_F16,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F17, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU17, BANDIT_F17, OUNT,'REPLACE', F17_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU17, BANDIT_F17,'DELETE','N') + CALL FILE_OPEN ( IOU17, BANDIT_F17, OUNT,'REPLACE', F17_MSG,'NEITHER','FORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU17, BANDIT_F17,'DELETE') ENDIF @@ -168,14 +168,14 @@ SUBROUTINE BANDIT_FILES ( IOU6, IOU7, IOU8, IOU9, IOU11, IOU12, IOU13, IOU14, IO INQUIRE ( FILE=BANDIT_F12, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU12, BANDIT_F12, OUNT,'REPLACE', F12_MSG,'NEITHER','UNFORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU12, BANDIT_F12,'DELETE','N') + CALL FILE_OPEN ( IOU12, BANDIT_F12, OUNT,'REPLACE', F12_MSG,'NEITHER','UNFORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU12, BANDIT_F12,'DELETE') ENDIF INQUIRE ( FILE=BANDIT_F13, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( IOU13, BANDIT_F13, OUNT,'REPLACE', F13_MSG,'NEITHER','UNFORMATTED','READWRITE','REWIND','N','N','N') - CALL FILE_CLOSE( IOU13, BANDIT_F13,'DELETE','N') + CALL FILE_OPEN ( IOU13, BANDIT_F13, OUNT,'REPLACE', F13_MSG,'NEITHER','UNFORMATTED','READWRITE','REWIND','N','N') + CALL FILE_CLOSE( IOU13, BANDIT_F13,'DELETE') ENDIF ! ********************************************************************************************************************************** diff --git a/Source/Modules/BANDIT/BANDIT_MODULE.f b/Source/Modules/BANDIT/BANDIT_MODULE.f index 9fce88b0..ac738ce3 100644 --- a/Source/Modules/BANDIT/BANDIT_MODULE.f +++ b/Source/Modules/BANDIT/BANDIT_MODULE.f @@ -3,15 +3,11 @@ MODULE BANDIT_MODULE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BANDIT_BEGEND USE PARAMS, ONLY : DELBAN - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = BANDIT_BEGEND - ! Notes: ! ------ @@ -245,7 +241,7 @@ MODULE BANDIT_MODULE ! ################################################################################################################################## ! B////////////////////////////////////////////////////////////////////B SUBROUTINE BANDIT ( MYSTRAN_NGRID, NEW_BW, DEN, IER ) - USE IOUNT1, ONLY : WRT_LOG, IN1 + USE IOUNT1, ONLY : IN1 ! E////////////////////////////////////////////////////////////////////E c c Gordon C. Everstine, Gaithersburg, MD, geversti@comcast.net @@ -388,11 +384,6 @@ SUBROUTINE BANDIT ( MYSTRAN_NGRID, NEW_BW, DEN, IER ) integer KOM(MEM) ! B////////////////////////////////////////////////////////////////////B - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF ! E////////////////////////////////////////////////////////////////////E C @@ -591,11 +582,6 @@ SUBROUTINE BANDIT ( MYSTRAN_NGRID, NEW_BW, DEN, IER ) 9000 continue - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN ! E////////////////////////////////////////////////////////////////////E @@ -1755,7 +1741,7 @@ END SUBROUTINE ELTYPE SUBROUTINE FINISH(KUMP,IER) C ! B////////////////////////////////////////////////////////////////////B - USE IOUNT1, ONLY : WRT_LOG, SEQ + USE IOUNT1, ONLY : SEQ ! E////////////////////////////////////////////////////////////////////B C TERMINATE JOB AFTER FATAL ERROR. C THE SUBSEQUENT EXECUTION OF NASTRAN IS PREVENTED BY ERASING UNIT 8. @@ -4772,7 +4758,7 @@ END SUBROUTINE SCAT SUBROUTINE SEQGP(NORIG,ILD,NEW,JUMP) C ! B////////////////////////////////////////////////////////////////////B - USE IOUNT1, ONLY : WRT_LOG, SEQ + USE IOUNT1, ONLY : SEQ ! E////////////////////////////////////////////////////////////////////E C WRITE SEQGP BULK DATA CARDS ON 7 and 8. C diff --git a/Source/Modules/DEBUG_PARAMETERS.f90 b/Source/Modules/DEBUG_PARAMETERS.f90 index 3a72739f..1412adfe 100644 --- a/Source/Modules/DEBUG_PARAMETERS.f90 +++ b/Source/Modules/DEBUG_PARAMETERS.f90 @@ -141,10 +141,6 @@ MODULE DEBUG_PARAMETERS ! DEBUG 67 Not used ! DEBUG 80 > 0 print LAPACK_S scale factors, in subr EQUILIBRATE, used to equilibrate the stiffness matrices -! DEBUG 81 = 1 print data from subr MATADD_SSS_NTERM -! 2 print data from subr MATADD_SSS -! 3 print data from both subrs - ! DEBUG 82 = 1 print data from subr MATMULT_SFF ! DEBUG 83 = 1 print data from subr MATMULT_SFS_NTERM @@ -185,8 +181,6 @@ MODULE DEBUG_PARAMETERS ! DEBUG 106 > 0 write info on all files in subr WRITE_ALLOC_MEM_TABLE (if 0 only write for those arrays that have memory ! allocated to them -! DEBUG 107 > 0 write allocated memory in F04 file with 6 decimal points (3 if DEBUG(107) = 0) - ! DEBUG 108 > 0 write EDAT table ! DEBUG 109 > 0 write debug info in subr ELMDIS @@ -273,10 +267,6 @@ MODULE DEBUG_PARAMETERS ! DEBUG 199 > 0 check matrix times its inverse = identity matrix in -! DEBUG 200 > 0 write problem answers (displs, etc) to filename.ANS as well as to filename.F06 (where filename is the name -! of the DAT data deck submitted to MYSTRAN. This feature is generally only useful to the author when -! performing checkout of test problem answers - ! DEBUG 201 /= 0 allow SOL = BUCKLING or DIFFEREN to run even if some elements are not coded for these soln's ! DEBUG 202 > 0 calculate RB and constant strain sanity checks on strain-displacement matrices diff --git a/Source/Modules/IOUNT1.f90 b/Source/Modules/IOUNT1.f90 index 4bb59232..cbaa68cb 100644 --- a/Source/Modules/IOUNT1.f90 +++ b/Source/Modules/IOUNT1.f90 @@ -55,12 +55,10 @@ MODULE IOUNT1 ! Following are the variable names for all files (except for units SC1, SCR, which do not have file names) used by Program - CHARACTER(FILE_NAM_MAXLEN*BYTE) :: ANSFIL ! (filename.ANS) On ly has answers from LINK9 CHARACTER(FILE_NAM_MAXLEN*BYTE) :: BUGFIL ! (filename.BUG) Debug file: ELDATA C.C. request elem debug info CHARACTER(FILE_NAM_MAXLEN*BYTE) :: EINFIL ! (filename.EIN) Eigenvector scale factors (used to change signs) CHARACTER(FILE_NAM_MAXLEN*BYTE) :: ENFFIL ! (filename.ENF) Enforced displs - file for DOF's that are enforced CHARACTER(FILE_NAM_MAXLEN*BYTE) :: ERRFIL ! (filename.ERR) Error file: error messages written (and to F06) - CHARACTER(FILE_NAM_MAXLEN*BYTE) :: F04FIL ! (filename.F04) Log file (subroutine begin/end times) CHARACTER(FILE_NAM_MAXLEN*BYTE) :: F06FIL ! (filename.F06) Output file CHARACTER(FILE_NAM_MAXLEN*BYTE) :: IN0FIL ! (filename.F06) Input file with all INCLUDE files CHARACTER(FILE_NAM_MAXLEN*BYTE) :: INFILE ! (filename.DAT) Input file @@ -143,13 +141,11 @@ MODULE IOUNT1 ! are PARAMETER. These are files that the user would not want to be deleted (BUGFIL would want to be kept but only if something ! has been written to it - CHARACTER( 8*BYTE) :: ANSSTAT = 'DELETE ' ! close status for file ANSFIL CHARACTER( 8*BYTE) :: BUGSTAT = 'DELETE ' ! close status for file BUGFIL CHARACTER( 8*BYTE) :: EINSTAT = 'KEEP ' ! close status for file EINFIL CHARACTER( 8*BYTE) :: ENFSTAT = 'KEEP ' ! close status for file ENFFIL CHARACTER( 8*BYTE) :: ERRSTAT = 'KEEP ' ! close status for file ERRFIL - CHARACTER( 8*BYTE) :: F04STAT = 'DELETE ' ! close status for file F06FIL - CHARACTER( 8*BYTE) :: F06STAT = 'KEEP ' ! close status for file F04FIL + CHARACTER( 8*BYTE) :: F06STAT = 'KEEP ' ! close status for file F06FIL CHARACTER( 8*BYTE) :: IN0STAT = 'KEEP ' ! close status for file INFILE plus all INCLUDE files CHARACTER( 8*BYTE) :: IN1STAT = 'KEEP ' ! close status for file INFILE CHARACTER( 8*BYTE) :: IN4STAT = 'KEEP ' ! close status for file IN4FIL @@ -227,16 +223,13 @@ MODULE IOUNT1 CHARACTER( 8*BYTE) :: BUGSTAT_OLD = 'DELETE ' ! close status for file BUGFIL for use in restart CHARACTER( 8*BYTE) :: ERRSTAT_OLD = 'DELETE ' ! close status for file ERRFIL for use in restart - CHARACTER( 8*BYTE) :: F04STAT_OLD = 'DELETE ' ! close status for file F04FIL for use in restart ! The following are messages that describe what the files are (no message for SC1) - CHARACTER( 64*BYTE) :: ANS_MSG = 'PROBLEM ANSWERS' CHARACTER( 64*BYTE) :: BUG_MSG = 'ELEMENT DEBUG OUTPUT FILE' CHARACTER( 64*BYTE) :: EIN_MSG = 'EIGENVEC NUMBERS FOR SIGN CHANGE' CHARACTER( 64*BYTE) :: ENF_MSG = 'ENFORCED DISPL FOR ALL DOFs FILE' CHARACTER( 64*BYTE) :: ERR_MSG = 'ERROR FILE' - CHARACTER( 64*BYTE) :: F04_MSG = 'F04 LOG FILE' CHARACTER( 64*BYTE) :: F06_MSG = 'PROGRAM OUTPUT DATA FILE' CHARACTER( 64*BYTE) :: IN0_MSG = 'PROGRAM INPUT DATA FILE WITH ALL INCLUDE FILES' CHARACTER( 64*BYTE) :: IN1_MSG = 'PROGRAM INPUT DATA FILE' @@ -331,12 +324,10 @@ MODULE IOUNT1 INTEGER(LONG) :: SC1 = 6 ! Unit no. for screen - INTEGER(LONG) :: ANS = 1 ! Unit no. for answer file INTEGER(LONG) :: BUG = 2 ! Unit no. for debug output file INTEGER(LONG) :: EIN = 1001 ! Unit no. for text file w/ eigenvec scale facs (if supplied) INTEGER(LONG) :: ENF = 1002 ! Unit no. for text file w/ enforced displ for all grids/comps INTEGER(LONG) :: ERR = 3 ! Unit no. for error file - INTEGER(LONG) :: F04 = 4 ! Unit no. for log file INTEGER(LONG) :: F06 = 7 ! Unit no. for output file INTEGER(LONG) :: IN0 = 1003 ! Unit no. for input file with all INCLUDE files INTEGER(LONG) :: IN1 = 8 ! Unit no. for input file @@ -424,7 +415,7 @@ MODULE IOUNT1 ! Unit no's. for scratch files INTEGER(LONG) :: SCR(9) = (/991,992,993,994,995,996,997,998,999/) -! The following are indicators of whether to write to BUG, ERR, F04 +! The following are indicators of whether to write to BUG, ERR INTEGER(LONG) :: WRT_BUG(0:MBUG-1) = (/(0, I=0,MBUG-1)/) ! WRT_BUG specifies what to write to the BUG file. Set by C.C. ELDATA @@ -434,14 +425,10 @@ MODULE IOUNT1 INTEGER(LONG) :: WRT_ERR = 1 ! WRT_ERR says whether to write ERR file or not - INTEGER(LONG) :: WRT_LOG = 0 ! WRT_LOG specifies the level of detail to be written to the LOG file ! Description of files: ! --------------------- -! ANSFIL is a formatted file containing only the answers from LINK9. It is only generated if a DEBUG parameter is set and is -! used in checkout of MYSTRAN (for comparing answers to the archive answers) - ! BUGFIL is a formatted file containing element data written if ELDATA Case Control requests are made ! EINFIL is a formatted file containing scale factors to apply to eigenvectors (after renormalization according to EIGR/EIGRL @@ -451,8 +438,6 @@ MODULE IOUNT1 ! ERRFIL is a formatted file containing all warning and error messages (also written to F06FIL) -! F04FIL is a formatted file containing subr begin/end times (log file) - ! F06FIL is a formatted file containing the normal output from MYSTRAN ! OP2FIL is an unformatted file containing: diff --git a/Source/Modules/LAPACK/LAPACK_BLAS_AUX.f b/Source/Modules/LAPACK/LAPACK_BLAS_AUX.f index 7808cdde..ba3f88a4 100644 --- a/Source/Modules/LAPACK/LAPACK_BLAS_AUX.f +++ b/Source/Modules/LAPACK/LAPACK_BLAS_AUX.f @@ -5,19 +5,16 @@ MODULE LAPACK_BLAS_AUX ! This is the set of LAPACK auxiliary routines called by other LAPACK subroutines USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE PARAMS, ONLY : NOCOUNTS USE OUTA_HERE_Interface character(1*byte), parameter :: cr13_lba = char(13) - - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = LAPACK_BEGEND - + CONTAINS ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> @@ -2622,12 +2619,7 @@ SUBROUTINE DTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX, * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ** Test the input parameters. @@ -2848,11 +2840,6 @@ SUBROUTINE DTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX, * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -3708,12 +3695,7 @@ SUBROUTINE DLACON( N, V, X, ISGN, EST, KASE, itmax ) ! My itmax * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF( KASE.EQ.0 ) THEN @@ -3832,11 +3814,6 @@ SUBROUTINE DLACON( N, V, X, ISGN, EST, KASE, itmax ) ! My itmax * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -9829,12 +9806,7 @@ SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** * INFO = 0 @@ -10369,13 +10341,6 @@ SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, * 12345 format(5X,'Iteration number ',i4,' : J = ',i8,' to ',i8, a) -! ********************************************************************************************************************************** - 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/Modules/LAPACK/LAPACK_GIV_MGIV_EIG.f b/Source/Modules/LAPACK/LAPACK_GIV_MGIV_EIG.f index 8de6bbf3..30c668dc 100644 --- a/Source/Modules/LAPACK/LAPACK_GIV_MGIV_EIG.f +++ b/Source/Modules/LAPACK/LAPACK_GIV_MGIV_EIG.f @@ -3,23 +3,18 @@ MODULE LAPACK_GIV_MGIV_EIG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, - & SFRAC, STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND + USE TIMDAT, ONLY : TSEC USE LAPACK_BLAS_AUX USE LAPACK_MISCEL ! This contains DSTEQR, used in this module USE OURTIM_Interface USE OUTA_HERE_Interface - + USE LINK_MESSAGE_Interface + character(1*byte), parameter :: cr13_lge = char(13) - CHARACTER(44*BYTE), PRIVATE :: MODNAM ! Name to write to screen to describe module being run. - - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = LAPACK_BEGEND - ! This is a set of LAPACK routines for solving for all, or some, eigenvalues and, possibly, some eigenvectors of: ! Ax = (Lambda)Bx (1) @@ -276,14 +271,6 @@ SUBROUTINE DSBGVX_GIV_MGIV ( JOBZ, RANGE, UPLO, N, KA, KB, AB, * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** ! Initialize eig_num do i=1,n @@ -333,17 +320,17 @@ SUBROUTINE DSBGVX_GIV_MGIV ( JOBZ, RANGE, UPLO, N, KA, KB, AB, * * Form a split Cholesky factorization of B. * - call ourtim if (method(1:3) == 'GIV') then if (sol_name(1:8) == 'BUCKLING') then - modnam = ' CHOLESKY FACTORIZATION OF DIFFER STIFF MATRIX' + CALL LINK_MESSAGE( + $ ' CHOLESKY FACTORIZATION OF DIFFER STIFF MATRIX') else - modnam = ' CHOLESKY FACTORIZATION OF MASS MATRIX' + CALL LINK_MESSAGE( + $ ' CHOLESKY FACTORIZATION OF MASS MATRIX') endif else if (method(1:4) == 'MGIV') then - modnam = ' CHOLESKY FACTORIZATION OF STIFF MATRIX' + CALL LINK_MESSAGE(' CHOLESKY FACTORIZATION OF STIFF MATRIX') endif - WRITE(SC1,4092) linkno,modnam,hour,minute,sec,sfrac CALL DPBSTF( UPLO, N, KB, BB, LDBB, INFO ) IF( INFO.NE.0 ) THEN INFO = N + INFO @@ -352,17 +339,13 @@ SUBROUTINE DSBGVX_GIV_MGIV ( JOBZ, RANGE, UPLO, N, KA, KB, AB, * * Transform problem to standard eigenvalue problem. * - call ourtim - modnam = ' TRANSFORM TO STANDARD EIGENVALUE PROBLEM' - WRITE(SC1,4092) linkno,modnam,hour,minute,sec,sfrac + CALL LINK_MESSAGE(' TRANSFORM TO STANDARD EIGENVALUE PROBLEM') CALL DSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ, $ WORK, IINFO ) * * Reduce symmetric band matrix to tridiagonal form. * - call ourtim - modnam = ' REDUCE SYMM BAND MATRIX TO TRIDIAG FORM' - WRITE(SC1,4092) linkno,modnam,hour,minute,sec,sfrac + CALL LINK_MESSAGE(' REDUCE SYMM BAND MATRIX TO TRIDIAG FORM') INDD = 1 INDE = INDD + N INDWRK = INDE + N @@ -529,16 +512,6 @@ SUBROUTINE DSBGVX_GIV_MGIV ( JOBZ, RANGE, UPLO, N, KA, KB, AB, 50 CONTINUE END IF - 4092 FORMAT(1X,I2,'/',A44,18X,2X,I2,':',I2,':',I2,'.',I3) - -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DSBGVX @@ -726,14 +699,6 @@ SUBROUTINE DPBSTF( UPLO, N, KD, AB, LDAB, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -860,14 +825,6 @@ SUBROUTINE DPBSTF( UPLO, N, KD, AB, LDAB, INFO ) 50 CONTINUE INFO = J -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DPBSTF @@ -992,14 +949,6 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters * @@ -2264,12 +2213,6 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * GO TO 490 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN * @@ -2406,14 +2349,6 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters * @@ -2850,12 +2785,6 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, 240 CONTINUE END IF * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN * @@ -3094,14 +3023,6 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * INFO = 0 * @@ -3580,12 +3501,6 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, IF( TOOFEW ) $ INFO = INFO + 2 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN * @@ -3745,14 +3660,6 @@ SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * @@ -3978,14 +3885,6 @@ SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, 150 CONTINUE 160 CONTINUE * -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DSTEIN @@ -4117,14 +4016,6 @@ SUBROUTINE DLAGTF( N, A, LAMBDA, B, C, TOL, D, IN, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * INFO = 0 IF( N.LT.0 ) THEN @@ -4195,14 +4086,6 @@ SUBROUTINE DLAGTF( N, A, LAMBDA, B, C, TOL, D, IN, INFO ) * RETURN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * End of DLAGTF * diff --git a/Source/Modules/LAPACK/LAPACK_LANCZOS_EIG.f b/Source/Modules/LAPACK/LAPACK_LANCZOS_EIG.f index 9fdf77de..4dd56f4b 100644 --- a/Source/Modules/LAPACK/LAPACK_LANCZOS_EIG.f +++ b/Source/Modules/LAPACK/LAPACK_LANCZOS_EIG.f @@ -3,16 +3,12 @@ MODULE LAPACK_LANCZOS_EIG USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE LAPACK_BLAS_AUX - USE SUBR_BEGEND_LEVELS, ONLY : ARPACK_BEGEND USE OURTIM_Interface - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = ARPACK_BEGEND - ! This is the set of LAPACK routines used by the Lanczos algorithm contained in module ARPACK_LANCZOS_EIG ! The following routines are contained: @@ -122,14 +118,6 @@ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input arguments * @@ -166,14 +154,6 @@ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) END IF 10 CONTINUE -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DGEQR2 @@ -299,14 +279,6 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input arguments * @@ -389,14 +361,6 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, A( I, I ) = AII 10 CONTINUE -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+2) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DORM2R diff --git a/Source/Modules/LAPACK/LAPACK_LIN_EQN_DGB.f b/Source/Modules/LAPACK/LAPACK_LIN_EQN_DGB.f index 8be5ba80..19a8e300 100644 --- a/Source/Modules/LAPACK/LAPACK_LIN_EQN_DGB.f +++ b/Source/Modules/LAPACK/LAPACK_LIN_EQN_DGB.f @@ -3,11 +3,10 @@ MODULE LAPACK_LIN_EQN_DGB USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : LINKNO, BLNK_SUB_NAM USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE OURTIM_Interface @@ -16,8 +15,6 @@ MODULE LAPACK_LIN_EQN_DGB character(1*byte), parameter :: cr13_dgb = char(13) CHARACTER(44*BYTE), PRIVATE :: MODNAM ! Name to write to screen to describe module being run. - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = LAPACK_BEGEND - ! This is a set of LAPACK routines for factorization and solution of linear eqns for general band matrices ! DGBTRF: Driver to compute a LU factorization of a real m-by-n band matrix A using partial pivoting with row interchanges. @@ -157,14 +154,6 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * KV is the number of superdiagonals in the factor U, allowing for * fill-in @@ -495,14 +484,6 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * 12345 format(5X,'Block ',i8,' of ',i8,'. Factoring rows 1 thru: ',i8,a) -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DGBTRF @@ -613,14 +594,6 @@ SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -712,14 +685,6 @@ SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, END IF END IF -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DGBTRS @@ -838,14 +803,6 @@ SUBROUTINE DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * KV is the number of superdiagonals in the factor U, allowing for * fill-in. @@ -939,14 +896,6 @@ SUBROUTINE DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO ) END IF 40 CONTINUE -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DGBTF2 diff --git a/Source/Modules/LAPACK/LAPACK_LIN_EQN_DGE.f b/Source/Modules/LAPACK/LAPACK_LIN_EQN_DGE.f index 6843efcb..60fb6e62 100644 --- a/Source/Modules/LAPACK/LAPACK_LIN_EQN_DGE.f +++ b/Source/Modules/LAPACK/LAPACK_LIN_EQN_DGE.f @@ -3,12 +3,11 @@ MODULE LAPACK_LIN_EQN_DGE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : LINKNO, BLNK_SUB_NAM USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, STIME, TSEC USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE OURTIM_Interface @@ -16,8 +15,6 @@ MODULE LAPACK_LIN_EQN_DGE CHARACTER(44*BYTE), PRIVATE :: MODNAM ! Name to write to screen to describe module being run. - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = LAPACK_BEGEND - ! This is the set of LAPACK routines for solving equations ! AX = B @@ -123,14 +120,6 @@ SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -210,14 +199,6 @@ SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) END IF RETURN * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * End of DGETRF * END SUBROUTINE DGETRF @@ -312,14 +293,6 @@ SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -427,14 +400,6 @@ SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) WORK( 1 ) = IWS RETURN * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * End of DGETRF * END SUBROUTINE DGETRI @@ -528,14 +493,6 @@ SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * INFO = 0 @@ -600,14 +557,6 @@ SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * RETURN * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * End of DGETRS * END SUBROUTINE DGETRS @@ -695,14 +644,6 @@ SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * INFO = 0 @@ -757,14 +698,6 @@ SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) 10 CONTINUE RETURN * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * End of DGETF2 * END SUBROUTINE DGETF2 diff --git a/Source/Modules/LAPACK/LAPACK_LIN_EQN_DPB.f b/Source/Modules/LAPACK/LAPACK_LIN_EQN_DPB.f index f5f4f021..fe69084e 100644 --- a/Source/Modules/LAPACK/LAPACK_LIN_EQN_DPB.f +++ b/Source/Modules/LAPACK/LAPACK_LIN_EQN_DPB.f @@ -3,18 +3,15 @@ MODULE LAPACK_LIN_EQN_DPB USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE PARAMS, ONLY : NOCOUNTS character(1*byte), parameter :: cr13_dpb = char(13) - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = LAPACK_BEGEND - ! This is the set of LAPACK routines for solving equations ! Ax = B @@ -141,14 +138,6 @@ SUBROUTINE DPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * INFO = 0 @@ -224,11 +213,6 @@ SUBROUTINE DPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) * ! ********************************************************************************************************************************** 9000 continue - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -366,14 +350,6 @@ SUBROUTINE DPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * .. * .. Executable Statements .. * -! ********************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************** * Test the input parameters. * INFO = 0 @@ -638,11 +614,6 @@ SUBROUTINE DPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -768,14 +739,6 @@ SUBROUTINE DPBTF2( UPLO, N, KD, AB, LDAB, INFO ) * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * INFO = 0 @@ -871,11 +834,6 @@ SUBROUTINE DPBTF2( UPLO, N, KD, AB, LDAB, INFO ) * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -974,14 +932,6 @@ SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO ) * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * INFO = 0 @@ -1065,11 +1015,6 @@ SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO ) * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -1187,14 +1132,6 @@ SUBROUTINE DPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * INFO = 0 @@ -1291,11 +1228,6 @@ SUBROUTINE DPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -1393,14 +1325,6 @@ SUBROUTINE DPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO, INTRINSIC MAX * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -1470,11 +1394,6 @@ SUBROUTINE DPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO, * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -1563,14 +1482,6 @@ SUBROUTINE DPTTRF_MYSTRAN( N, D, E, INFO ) * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * INFO = 0 @@ -1660,11 +1571,6 @@ SUBROUTINE DPTTRF_MYSTRAN( N, D, E, INFO ) * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -1826,14 +1732,6 @@ SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO ) * .. * .. Executable Statements .. * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * Test the input parameters. * INFO = 0 @@ -2204,11 +2102,6 @@ SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO ) * ! ********************************************************************************************************************************** 9000 continue ! My lines - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/Modules/LAPACK/LAPACK_MISCEL.f b/Source/Modules/LAPACK/LAPACK_MISCEL.f index 2ea522f5..c105baea 100644 --- a/Source/Modules/LAPACK/LAPACK_MISCEL.f +++ b/Source/Modules/LAPACK/LAPACK_MISCEL.f @@ -3,19 +3,15 @@ MODULE LAPACK_MISCEL USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE LAPACK_LIN_EQN_DPB USE OURTIM_Interface - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = LAPACK_BEGEND - ! This is a set of LAPACK routines that are used in several other modules but are not BLAS or auxiliary routines ! The routines included herein are: @@ -125,14 +121,6 @@ SUBROUTINE DSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -208,14 +196,6 @@ SUBROUTINE DSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO ) CALL DSCAL( IMAX, ONE / SIGMA, D, 1 ) END IF * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DSTEV @@ -326,14 +306,6 @@ SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -380,14 +352,6 @@ SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, CALL DTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, $ LDB ) * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DTRTRS diff --git a/Source/Modules/LAPACK/LAPACK_STD_EIG_1.f b/Source/Modules/LAPACK/LAPACK_STD_EIG_1.f index 529a9225..9042f9db 100644 --- a/Source/Modules/LAPACK/LAPACK_STD_EIG_1.f +++ b/Source/Modules/LAPACK/LAPACK_STD_EIG_1.f @@ -3,11 +3,10 @@ MODULE LAPACK_STD_EIG_1 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : LINKNO, BLNK_SUB_NAM USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & SFRAC, STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE LAPACK_MISCEL ! This contains DSTEQR, used in this module @@ -16,8 +15,6 @@ MODULE LAPACK_STD_EIG_1 CHARACTER(44*BYTE), PRIVATE :: MODNAM ! Name to write to screen to describe module being run. - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND =LAPACK_BEGEND+10 - ! This is a set of LAPACK routines for solving for all of the eigenvalues ! and, possibly, all eigenvectors of: @@ -150,14 +147,6 @@ SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters. * @@ -258,14 +247,6 @@ SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) WORK( 1 ) = MAX( 3*N-1, LOPT ) * -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DSYEV @@ -425,14 +406,6 @@ SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input parameters * @@ -564,14 +537,6 @@ SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * WORK( 1 ) = IWS -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DSYTRD @@ -668,14 +633,6 @@ SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * .. * .. Executable Statements .. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** * * Test the input arguments * @@ -752,14 +709,6 @@ SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) END IF END IF -! ********************************************************************************************************************************** - 9000 IF (WRT_LOG >= SUBR_BEGEND+1) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - -! ********************************************************************************************************************************** RETURN * * End of DORGTR diff --git a/Source/Modules/LAPACK/LAPACK_SYM_MAT_INV.f b/Source/Modules/LAPACK/LAPACK_SYM_MAT_INV.f index 9446ade3..9f942c4e 100644 --- a/Source/Modules/LAPACK/LAPACK_SYM_MAT_INV.f +++ b/Source/Modules/LAPACK/LAPACK_SYM_MAT_INV.f @@ -3,19 +3,15 @@ MODULE LAPACK_SYM_MAT_INV USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : HOUR, MINUTE, SEC, & TSEC - USE SUBR_BEGEND_LEVELS, ONLY : LAPACK_BEGEND USE LAPACK_BLAS_AUX USE LAPACK_LIN_EQN_DPB ! Subr DPOTF2 USE OURTIM_Interface - INTEGER(LONG), PARAMETER, PRIVATE :: SUBR_BEGEND = LAPACK_BEGEND - ! This is a set of LAPACK routines that are used in inverting symmetric matrices (not band matrices) CONTAINS diff --git a/Source/Modules/PARAMS.f90 b/Source/Modules/PARAMS.f90 index 0290ce2f..8a0670e3 100644 --- a/Source/Modules/PARAMS.f90 +++ b/Source/Modules/PARAMS.f90 @@ -144,12 +144,11 @@ MODULE PARAMS ! ---------------------------------------------------------------------------------------------------------------------------------- CHARACTER( 1*BYTE) :: PRTALL = 'N' ! 'Y', 'N' flag to write all output for all files regardless of other flags - CHARACTER( 1*BYTE) :: PRTANS = 'N' ! 'Y', 'N' flag to write all ans outputs regardless of other flags besides PRTALL CHARACTER( 1*BYTE) :: PRTF06 = 'N' ! 'Y', 'N' flag to write all f06 outputs regardless of other flags besides PRTALL CHARACTER( 1*BYTE) :: PRTNEU = 'N' ! 'Y', 'N' flag to write all neu outputs regardless of other flags besides PRTALL CHARACTER( 1*BYTE) :: PRTOP2 = 'N' ! 'Y', 'N' flag to write all op2 outputs regardless of other flags besides PRTALL -! case 1: PRTALL=Y, PRTOP2=N -> all op2 output will be created and all ans/neu output +! case 1: PRTALL=Y, PRTOP2=N -> all op2 output will be created and all neu output ! case 2: PRTALL=N, PRTOP2=Y -> all op2 output will be created ! case 3: PRTALL=N, PRTOP2=N -> do whatever the case control says ! ---------------------------------------------------------------------------------------------------------------------------------- diff --git a/Source/Modules/SCONTR.f90 b/Source/Modules/SCONTR.f90 index c71e7c3c..6bc14654 100644 --- a/Source/Modules/SCONTR.f90 +++ b/Source/Modules/SCONTR.f90 @@ -1,28 +1,28 @@ ! ################################################################################################################################## -! Begin MIT license text. +! Begin MIT license text. ! _______________________________________________________________________________________________________ - -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) - -! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and ! associated documentation files (the "Software"), to deal in the Software without restriction, including ! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to -! the following conditions: - -! The above copyright notice and this permission notice shall be included in all copies or substantial -! portions of the Software and documentation. - -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -! THE SOFTWARE. +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. ! _______________________________________________________________________________________________________ - -! End MIT license text. + +! End MIT license text. MODULE SCONTR @@ -30,17 +30,17 @@ MODULE SCONTR USE PENTIUM_II_KIND, ONLY : BYTE, LONG, SINGLE, DOUBLE USE CONSTANTS_1, ONLY : ZERO - + IMPLICIT NONE SAVE INTEGER(LONG), PRIVATE :: I ! Only use is in implied DO loops below to initialize variables - + INTEGER(LONG), PARAMETER :: NCCCD = 31 ! Max number of words in array CC_CMD_DESCRIBERS ! System control / counters - + CHARACTER( 7*BYTE), PARAMETER :: PROG_NAME = 'MYSTRAN' ! This computer program's name CHARACTER( 31*BYTE), PARAMETER :: BLNK_SUB_NAM = ' ' ! Blank subr name @@ -54,17 +54,17 @@ MODULE SCONTR CHARACTER( 1*BYTE) :: ELESORT_RUN = 'N' ! 'Y'/'N' indicator of whether subr ELESORT has run CHARACTER( 1*BYTE) :: EPSIL1_SET = 'N' ! 'Y'/'N' indicator of whether EPSIL(1) is in B.D. deck CHARACTER( 6*BYTE) :: ENFORCED = 'N' ! If 'Y' then this is a run where all DOF's are SE-set - CHARACTER( 5*BYTE) :: FACTORED_MATRIX = 'none ' ! Name of matrix that has been decomposed into + CHARACTER( 5*BYTE) :: FACTORED_MATRIX = 'none ' ! Name of matrix that has been decomposed into ! triangular factors (e.g.'KLL ') - CHARACTER( 1*BYTE) :: IERRFL(10) = (/('N', I=1,10)/) ! 'Y', 'N' indicates errs in Bulk Data card fields - CHARACTER( 1*BYTE) :: IMB_BLANK(2:9) = (/('N', I=2, 9)/) ! 'Y', 'N' indicates imbedded blanks in B.D. field + CHARACTER( 1*BYTE) :: IERRFL(10) = (/('N', I=1,10)/) ! 'Y', 'N' indicates errs in Bulk Data card fields + CHARACTER( 1*BYTE) :: IMB_BLANK(2:9) = (/('N', I=2, 9)/) ! 'Y', 'N' indicates imbedded blanks in B.D. field CHARACTER( 1*BYTE) :: PRINTENV = 'N' ! 'Y' if Software Passport env vars are to be printed CHARACTER( 1*BYTE) :: RESTART = 'N' ! 'Y' if run is a restart CHARACTER( 16*BYTE) :: SOL_NAME = ' '! Name for the solution (e.g. 'STATICS') CHARACTER( 2*BYTE) :: TSET_CHR_LEN = ' ' ! Char len of entries in TSET CHARACTER( 1*BYTE) :: UNLOCK = 'N' ! Y or N indicator for whether program will run -! unlimited size problems +! unlimited size problems INTEGER(LONG) :: IBIT(0:15) = (/(2**I, I=0,15)/) INTEGER(LONG) :: JF(10) = (/( I, I=1,10)/) @@ -77,12 +77,12 @@ MODULE SCONTR INTEGER(LONG), PARAMETER :: MAX_INTEGER_LEN = 10 ! Max number of digits in any integer to keep integers <= 4 bytes INTEGER(LONG), PARAMETER :: NUM_TRIA_ORDERS = 3 ! Num of triangular integration orders for isoparametric elems - INTEGER(LONG) :: BANDIT_ERR = 0 ! Error report from Bandit + INTEGER(LONG) :: BANDIT_ERR = 0 ! Error report from Bandit INTEGER(LONG) :: DEMO_GRID_LIMIT = 10 ! Max number of grids allowed in demo ver of the program INTEGER(LONG) :: FATAL_ERR = 0 ! Fatal err count from input (Exec & Case Control, Bulk Data) - INTEGER(LONG) :: WARN_ERR = 0 ! Warn err count from input (Exec & Case Control, Bulk Data) + INTEGER(LONG) :: WARN_ERR = 0 ! Warn err count from input (Exec & Case Control, Bulk Data) - INTEGER(LONG) :: INT_SC_NUM = 0 ! Internal subcase number + INTEGER(LONG) :: INT_SC_NUM = 0 ! Internal subcase number INTEGER(LONG) :: JTSUB = 0 ! Internal thermal array col no. corresponding to INT_SC_NUM INTEGER(LONG) :: KLL_SDIA = 0 ! Number of super-diagonals in matrix KLL @@ -90,19 +90,19 @@ MODULE SCONTR INTEGER(LONG) :: KMSM_SDIA = 0 ! Number of super-diagonals in matrix KMSM INTEGER(LONG) :: KOO_SDIA = 0 ! Number of super-diagonals in matrix KOO INTEGER(LONG) :: KRRcb_SDIA = 0 ! Number of super-diagonals in matrix KRRcb - + INTEGER(LONG) :: KMAT_BW = 0 ! 6 times grid BW returned from subr BANDIT called in subr LINK1 - INTEGER(LONG) :: LINKNO = 0 ! LINK num being run + INTEGER(LONG) :: LINKNO = 0 ! LINK num being run INTEGER(LONG) :: LINKNO_L1A = 0 ! LINK num MYSTRAN was executing when file LINK1A was written INTEGER(LONG) :: LINKNO_START = 0 ! LINK num to start MYSTRAN with. Normally this is LINK 1 ! however, if the program was terminated abnormally right as ! a new LINK is beginning, this allows a "restart" - + INTEGER(LONG) :: LBAROFF = 0 ! Max allow num of CBAR, CBEAM offset vectors (see note (1)) INTEGER(LONG) :: LBUSHOFF = 0 ! Max allow num of CBUSH offset vectors (see note (1)) - INTEGER(LONG) :: LCMASS = 0 ! Max allow num of CMASSi Bulk Data cards (see note (1)) - INTEGER(LONG) :: LCONM2 = 0 ! Max allow num of CONM2 Bulk Data cards (see note (1)) + INTEGER(LONG) :: LCMASS = 0 ! Max allow num of CMASSi Bulk Data cards (see note (1)) + INTEGER(LONG) :: LCONM2 = 0 ! Max allow num of CONM2 Bulk Data cards (see note (1)) INTEGER(LONG) :: LCORD = 0 ! Max allow num of CORD Bulk Data cards (see note (1)) INTEGER(LONG) :: LDOFG = 0 ! Max allow num of G-set DOF's (checked against NDOFG) INTEGER(LONG) :: LEDAT = 0 ! Max allow num of element connection data (see note (1)) @@ -114,7 +114,7 @@ MODULE SCONTR INTEGER(LONG) :: LIND_GRDS_MPCS = 0 ! Max allow num of independent grids on MPC's and rigid elems INTEGER(LONG) :: LLOADC = 0 ! Max no. of pairs of (load fac/load mag) over all LOAD B.D. cards ! incl the pair defined by the LOAD card set ID and overall scale -! factor. Counted by subr LOADB0 based on info from subr BD_LOAD0 +! factor. Counted by subr LOADB0 based on info from subr BD_LOAD0 INTEGER(LONG) :: LLOADR = 0 ! Max allow num of LOAD Bulk Data cards (see note (1)) INTEGER(LONG) :: LMATANGLE = 0 ! Max allow num of plate elem matl angles (see note (1)) INTEGER(LONG) :: LMATL = 0 ! Max allow num of matl Bulk Data cards (see note (1)) @@ -128,7 +128,7 @@ MODULE SCONTR INTEGER(LONG) :: LPBUSH = 0 ! Max allow num of PBUSH Bulk Data cards (see note (1)) INTEGER(LONG) :: LPCOMP = 0 ! Max allow num of PCOMP Bulk Data cards (see note (1)) INTEGER(LONG) :: LPCOMP_PLIES = 0 ! Max allow num of plies for any PCOMP entry - INTEGER(LONG) :: LPDAT = 0 ! Max allow num of rows for array PDATA + INTEGER(LONG) :: LPDAT = 0 ! Max allow num of rows for array PDATA INTEGER(LONG) :: LPELAS = 0 ! Max allow num of PELAS Bulk Data cards (see note (1)) INTEGER(LONG) :: LPLATEOFF = 0 ! Max allow num of plate elem offsets (see note (1)) INTEGER(LONG) :: LPLATETHICK = 0 ! Max allow num of plate elem thicknesses (see note (1)) @@ -143,8 +143,8 @@ MODULE SCONTR INTEGER(LONG) :: LPUSERIN = 0 ! Max allow num of PUSERIN Bulk Data cards (see note (1)) INTEGER(LONG) :: LRFORCE = 0 ! Max allow num of RFORCE Bulk data entries (see note (1)) INTEGER(LONG) :: LRIGEL = 0 ! Max allow num of rigid elems (see note (1)) - INTEGER(LONG) :: LSEQ = 0 ! Max allow num of rows for arrays SEQ1, SEQ2 - INTEGER(LONG) :: LSETLN = 0 ! Max allow num of chars in SET definitions (see Note (1)) + INTEGER(LONG) :: LSEQ = 0 ! Max allow num of rows for arrays SEQ1, SEQ2 + INTEGER(LONG) :: LSETLN = 0 ! Max allow num of chars in SET definitions (see Note (1)) INTEGER(LONG) :: LSETS = 0 ! Max allow num of Case Control SET's (see Note (1)) INTEGER(LONG) :: LSLOAD = 0 ! Max allow num of SLOAD pairs (see Note (1)) INTEGER(LONG) :: LSNORM = 0 ! Max allow num of SNORM Bulk Data cards (see Note (1)) @@ -159,7 +159,7 @@ MODULE SCONTR INTEGER(LONG) :: LTERM_KGG = 0 ! Max allow num of terms in matrix KGG (see note (1)) INTEGER(LONG) :: LTERM_KGGD = 0 ! Max allow num of terms in matrix KGGD (see note (1)) INTEGER(LONG) :: LTERM_MGGE = 0 ! Max allow num of terms in matrix MGG for elems (see note (1)) - INTEGER(LONG) :: LVVEC = 0 ! Max allow num of v vectors (CBAR) (see Note (1)) + INTEGER(LONG) :: LVVEC = 0 ! Max allow num of v vectors (CBAR) (see Note (1)) INTEGER(LONG) :: MAX_ELEM_DEGREE = 0 ! Max number of elements connected to any one grid INTEGER(LONG) :: MAX_GAUSS_POINTS = 0 ! Max number of Gauss pts for any element @@ -213,54 +213,54 @@ MODULE SCONTR INTEGER(LONG) :: NCUSER1 = 0 ! Count of no. of CUSER1 elems INTEGER(LONG) :: NCUSERIN = 0 ! Count of no. of CUSERIN elems - INTEGER(LONG) :: NDOFA = 0 ! Count of no. of DOF's in the A-set + INTEGER(LONG) :: NDOFA = 0 ! Count of no. of DOF's in the A-set INTEGER(LONG) :: NDOF_EIG = 0 ! DOF size to replace NDOFL for eigprob to avoid zero mass modes - INTEGER(LONG) :: NDOFF = 0 ! Count of no. of DOF's in the F-set - INTEGER(LONG) :: NDOFG = 0 ! Count of no. of DOF's in the G-set - INTEGER(LONG) :: NDOFL = 0 ! Count of no. of DOF's in the L-set - INTEGER(LONG) :: NDOFM = 0 ! Count of no. of DOF's in the M-set - INTEGER(LONG) :: NDOFN = 0 ! Count of no. of DOF's in the N-set - INTEGER(LONG) :: NDOFO = 0 ! Count of no. of DOF's in the O-set - INTEGER(LONG) :: NDOFR = 0 ! Count of no. of DOF's in the R-set - INTEGER(LONG) :: NDOFS = 0 ! Count of no. of DOF's in the S-set + INTEGER(LONG) :: NDOFF = 0 ! Count of no. of DOF's in the F-set + INTEGER(LONG) :: NDOFG = 0 ! Count of no. of DOF's in the G-set + INTEGER(LONG) :: NDOFL = 0 ! Count of no. of DOF's in the L-set + INTEGER(LONG) :: NDOFM = 0 ! Count of no. of DOF's in the M-set + INTEGER(LONG) :: NDOFN = 0 ! Count of no. of DOF's in the N-set + INTEGER(LONG) :: NDOFO = 0 ! Count of no. of DOF's in the O-set + INTEGER(LONG) :: NDOFR = 0 ! Count of no. of DOF's in the R-set + INTEGER(LONG) :: NDOFS = 0 ! Count of no. of DOF's in the S-set INTEGER(LONG) :: NDOFSA = 0 ! Count of no. of DOF's in the S-set constr to 0 via AUTOSPC - INTEGER(LONG) :: NDOFSB = 0 ! Count of no. of DOF's in the S-set constr to 0 on SPC/SPC1 cards - INTEGER(LONG) :: NDOFSE = 0 ! Count of no. of DOF's in the S-set with enforced displacement + INTEGER(LONG) :: NDOFSB = 0 ! Count of no. of DOF's in the S-set constr to 0 on SPC/SPC1 cards + INTEGER(LONG) :: NDOFSE = 0 ! Count of no. of DOF's in the S-set with enforced displacement INTEGER(LONG) :: NDOFSG = 0 ! Count of no. of DOF's in the S-set perm SPC'd on GRID cards INTEGER(LONG) :: NDOFSZ = 0 ! NDOFSB + NDOFSG Count of no. of DOF's in the S-set with 0 displ INTEGER(LONG) :: NEDAT = 0 ! Count of no. of terms in EDAT array INTEGER(LONG) :: NELE = 0 ! Count of no. of elastic elems INTEGER(LONG) :: NFORCE = 0 ! Count of no. of FORCE/MOMENT Bulk Data cards - INTEGER(LONG) :: NGRAV = 0 ! Count of no. of GRAV Bulk Data cards - INTEGER(LONG) :: NGRDSET = 0 ! Count of no. of GRDSET Bulk Data cards - INTEGER(LONG) :: NGRID = 0 ! Count of no. of GRID Bulk Data cards + INTEGER(LONG) :: NGRAV = 0 ! Count of no. of GRAV Bulk Data cards + INTEGER(LONG) :: NGRDSET = 0 ! Count of no. of GRDSET Bulk Data cards + INTEGER(LONG) :: NGRID = 0 ! Count of no. of GRID Bulk Data cards INTEGER(LONG) :: NIND_GRDS_MPCS = 0 ! Count of no. of independent grids on MPC's and rigid elems - INTEGER(LONG) :: NLOAD = 0 ! Count of no. of LOAD Bulk Data cards + INTEGER(LONG) :: NLOAD = 0 ! Count of no. of LOAD Bulk Data cards INTEGER(LONG) :: NMATANGLE = 0 ! Count of no. of matl property angles on plate elem conn entries - INTEGER(LONG) :: NMATL = 0 ! Count of no. of matl Bulk Data cards - INTEGER(LONG) :: NMPC = 0 ! Count of no. of MPC Bulk Data cards + INTEGER(LONG) :: NMATL = 0 ! Count of no. of matl Bulk Data cards + INTEGER(LONG) :: NMPC = 0 ! Count of no. of MPC Bulk Data cards INTEGER(LONG) :: NMPCADD = 0 ! Count of no. of MPCADD cards - INTEGER(LONG) :: NPBAR = 0 ! Count of no. of PBAR Bulk Data cards - INTEGER(LONG) :: NPBARL = 0 ! Count of no. of PBARL Bulk Data cards - INTEGER(LONG) :: NPBEAM = 0 ! Count of no. of PBEAM Bulk Data cards - INTEGER(LONG) :: NPBUSH = 0 ! Count of no. of PBUSH Bulk Data cards - INTEGER(LONG) :: NPCARD = 0 ! Count of no. of PLOAD1, PLOAD2 cards written to filename.L1Q - INTEGER(LONG) :: NPCOMP = 0 ! Count of no. of PCOMP Bulk Data cards + INTEGER(LONG) :: NPBAR = 0 ! Count of no. of PBAR Bulk Data cards + INTEGER(LONG) :: NPBARL = 0 ! Count of no. of PBARL Bulk Data cards + INTEGER(LONG) :: NPBEAM = 0 ! Count of no. of PBEAM Bulk Data cards + INTEGER(LONG) :: NPBUSH = 0 ! Count of no. of PBUSH Bulk Data cards + INTEGER(LONG) :: NPCARD = 0 ! Count of no. of PLOAD1, PLOAD2 cards written to filename.L1Q + INTEGER(LONG) :: NPCOMP = 0 ! Count of no. of PCOMP Bulk Data cards INTEGER(LONG) :: NPDAT = 0 ! Count of no. of rows that go into array PDATA - INTEGER(LONG) :: NPELAS = 0 ! Count of no. of PELAS Bulk Data cards + INTEGER(LONG) :: NPELAS = 0 ! Count of no. of PELAS Bulk Data cards INTEGER(LONG) :: NPLATEOFF = 0 ! Count of no. of plate element offsets on plate elem conn entries INTEGER(LONG) :: NPLATETHICK = 0 ! Count of no. of plate thicknesses on plate elem conn entries INTEGER(LONG) :: NPLOTEL = 0 ! Count of no. of PLOTEL - INTEGER(LONG) :: NPLOAD = 0 ! Count of no. of PLOADi Bulk Data cards + INTEGER(LONG) :: NPLOAD = 0 ! Count of no. of PLOADi Bulk Data cards INTEGER(LONG) :: NPLOAD4_3D = 0 ! Count of no. of PLOAD4 entries that are for solid elements - INTEGER(LONG) :: NPMASS = 0 ! Count of no. of PMASS Bulk Data cards - INTEGER(LONG) :: NPROD = 0 ! Count of no. of PROD Bulk Data cards + INTEGER(LONG) :: NPMASS = 0 ! Count of no. of PMASS Bulk Data cards + INTEGER(LONG) :: NPROD = 0 ! Count of no. of PROD Bulk Data cards INTEGER(LONG) :: NPSHEAR = 0 ! Count of no. of PSHEAR Bulk Data cards - INTEGER(LONG) :: NPSHEL = 0 ! Count of no. of PSHELL Bulk Data cards - INTEGER(LONG) :: NPSOLID = 0 ! Count of no. of PSOLID Bulk Data cards - INTEGER(LONG) :: NPUSER1 = 0 ! Count of no. of PUSER1 Bulk Data cards - INTEGER(LONG) :: NPUSERIN = 0 ! Count of no. of PUSER1 Bulk Data cards + INTEGER(LONG) :: NPSHEL = 0 ! Count of no. of PSHELL Bulk Data cards + INTEGER(LONG) :: NPSOLID = 0 ! Count of no. of PSOLID Bulk Data cards + INTEGER(LONG) :: NPUSER1 = 0 ! Count of no. of PUSER1 Bulk Data cards + INTEGER(LONG) :: NPUSERIN = 0 ! Count of no. of PUSER1 Bulk Data cards INTEGER(LONG) :: NRBAR = 0 ! Count of no. of RBAR rigid elems INTEGER(LONG) :: NRBE1 = 0 ! Count of no. of RBE1 rigid elems INTEGER(LONG) :: NRBE2 = 0 ! Count of no. of RBE2 rigid elems @@ -284,18 +284,18 @@ MODULE SCONTR INTEGER(LONG) :: NROWS_TXT_STRE = 0 ! Num of rows for TXT INTEGER(LONG) :: NROWS_TXT_STRN = 0 ! Num of rows for TXT INTEGER(LONG) :: NRSPLINE = 0 ! Count of no. of RSPLINE elements - INTEGER(LONG) :: NSEQ = 0 ! Count of no. of grid points that are on SEQGP Bulk Data cards - INTEGER(LONG) :: NSETS = 0 ! Count of no. of SET's in Case Control - INTEGER(LONG) :: NSLOAD = 0 ! Count of no. of SLOAD pairs (point/mag) - INTEGER(LONG) :: NSNORM = 0 ! Count of no. of SNORM Bulk Data cards - INTEGER(LONG) :: NSPC = 0 ! Count of no. of SPC cards written to filename.L1O - INTEGER(LONG) :: NSPC1 = 0 ! Count of no. of SPC1 cards written to filename.L1O + INTEGER(LONG) :: NSEQ = 0 ! Count of no. of grid points that are on SEQGP Bulk Data cards + INTEGER(LONG) :: NSETS = 0 ! Count of no. of SET's in Case Control + INTEGER(LONG) :: NSLOAD = 0 ! Count of no. of SLOAD pairs (point/mag) + INTEGER(LONG) :: NSNORM = 0 ! Count of no. of SNORM Bulk Data cards + INTEGER(LONG) :: NSPC = 0 ! Count of no. of SPC cards written to filename.L1O + INTEGER(LONG) :: NSPC1 = 0 ! Count of no. of SPC1 cards written to filename.L1O INTEGER(LONG) :: NSPCADD = 0 ! Count of no. of SPCADD cards INTEGER(LONG) :: NSPOINT = 0 ! Count of no. of SPOINT's INTEGER(LONG) :: NUM_SPCSIDS = 0 ! The number of SPC set ID's called for in an execution - INTEGER(LONG) :: NSUB = 0 ! Count of no. of subcases + INTEGER(LONG) :: NSUB = 0 ! Count of no. of subcases INTEGER(LONG) :: NTCARD = 0 ! Count of no. of TEMP/TEMPRB/TEMPP1 cards written to filename.L1K - INTEGER(LONG) :: NTDAT = 0 ! Count of no. of rows that go into array TDATA + INTEGER(LONG) :: NTDAT = 0 ! Count of no. of rows that go into array TDATA INTEGER(LONG) :: NTERM_ALL = 0 ! Count of no. of terms in ALL matrix INTEGER(LONG) :: NTERM_CG_LTM = 0 ! Count of no. of terms in CG_LDS_LTMcb matrix INTEGER(LONG) :: NTERM_DLR = 0 ! Count of no. of terms in DLR matrix @@ -397,7 +397,7 @@ MODULE SCONTR INTEGER(LONG) :: NTERM_RMN = 0 ! Count of no. of terms in RMN matrix INTEGER(LONG) :: NTERM_ULL = 0 ! Count of no. of terms in ULL matrix INTEGER(LONG) :: NTERM_ULLI = 0 ! Count of no. of terms in ULLI matrix - INTEGER(LONG) :: NTSUB = 0 ! Count of no. of subcases with a thermal load + INTEGER(LONG) :: NTSUB = 0 ! Count of no. of subcases with a thermal load INTEGER(LONG) :: NUM_CB_DOFS = 0 ! Num of Craig-Bampton DOF's (2*NDOFR+NVEC) INTEGER(LONG) :: NUM_EIGENS = 0 ! Num of eigenvals calc'd (may be > NVEC) INTEGER(LONG) :: NUM_KLLD_DIAG_ZEROS = 0 ! Num of zeros on the diagonal of the KLLD stiff matrix @@ -417,14 +417,14 @@ MODULE SCONTR INTEGER(LONG) :: NVVEC = 0 ! Count of the no. of v vectors (CBAR) INTEGER(LONG) :: PCH_LINE_NUM = 0 ! Line number in PCH ("punch") file INTEGER(LONG) :: SETLEN = 0 ! Count of the number characters in SET definitions - INTEGER(LONG) :: TRIA_ORDER_NUMS(NUM_TRIA_ORDERS) = (/1,3,7/) + INTEGER(LONG) :: TRIA_ORDER_NUMS(NUM_TRIA_ORDERS) = (/1,3,7/) ! Triangular isoparametric integration orders - INTEGER(LONG), PARAMETER :: DEDAT_Q4_MATANG_KEY = 6 ! Delta in EDAT for QUAD4 to get from EID to the matl angle key + INTEGER(LONG), PARAMETER :: DEDAT_Q4_MATANG_KEY = 6 ! Delta in EDAT for QUAD4 to get from EID to the matl angle key INTEGER(LONG), PARAMETER :: DEDAT_Q4_POFFS_KEY = 8 ! Delta in EDAT for QUAD4 to get from EID to the offset key INTEGER(LONG), PARAMETER :: DEDAT_Q4_SHELL_KEY = 9 ! Delta in EDAT for QUAD4 to get from EID to the shell/pcomp key INTEGER(LONG), PARAMETER :: DEDAT_Q4_THICK_KEY = 10 ! Delta in EDAT for QUAD4 to get from EID to the thickness key - INTEGER(LONG), PARAMETER :: DEDAT_T3_MATANG_KEY = 5 ! Delta in EDAT for TRIA3 to get from EID to the matl angle key + INTEGER(LONG), PARAMETER :: DEDAT_T3_MATANG_KEY = 5 ! Delta in EDAT for TRIA3 to get from EID to the matl angle key INTEGER(LONG), PARAMETER :: DEDAT_T3_POFFS_KEY = 7 ! Delta in EDAT for TRIA3 to get from EID to the offset key INTEGER(LONG), PARAMETER :: DEDAT_T3_SHELL_KEY = 8 ! Delta in EDAT for TRIA3 to get from EID to the shell/pcomp key INTEGER(LONG), PARAMETER :: DEDAT_T3_THICK_KEY = 9 ! Delta in EDAT for TRIA3 to get from EID to the thickness key @@ -438,9 +438,9 @@ MODULE SCONTR INTEGER(LONG), PARAMETER :: MAX_ORDER_TRIA = 7 ! Max order that can be used when subr ORDER_TRIA is called INTEGER(LONG), PARAMETER :: MAX_TOKEN_LEN = 8 ! Max length (chars) of tokens in SET's INTEGER(LONG), PARAMETER :: MBUG = 10 ! No. of kinds BUG outputs (dimension of WRT_BUG) - INTEGER(LONG), PARAMETER :: MCMASS = 7 ! No. cols allowed in dimensioning array CMASS - INTEGER(LONG), PARAMETER :: MCONM2 = 3 ! No. cols allowed in dimensioning array CONM2 - INTEGER(LONG), PARAMETER :: MCORD = 5 ! No. cols allowed in dimensioning array CORD + INTEGER(LONG), PARAMETER :: MCMASS = 7 ! No. cols allowed in dimensioning array CMASS + INTEGER(LONG), PARAMETER :: MCONM2 = 3 ! No. cols allowed in dimensioning array CONM2 + INTEGER(LONG), PARAMETER :: MCORD = 5 ! No. cols allowed in dimensioning array CORD INTEGER(LONG), PARAMETER :: MEDAT_CBAR = 8 ! No. terms that go into EDAT array for CBAR elems INTEGER(LONG), PARAMETER :: MEDAT_CBEAM = 8 ! No. terms that go into EDAT array for CBEAM elems INTEGER(LONG), PARAMETER :: MEDAT_CBUSH = 9 ! No. terms that go into EDAT array for CBEAM elems @@ -482,8 +482,8 @@ MODULE SCONTR INTEGER(LONG), PARAMETER :: MMSPRNT = 3 ! No. cols allowed in dimensioning array MSPRNT INTEGER(LONG), PARAMETER :: MOGEL = 12 ! No. cols allowed in dimensioning array OGEL INTEGER(LONG), PARAMETER :: MPDAT_PLOAD1 = 2 ! No. pressures on PLOAD1 Bulk Data card - INTEGER(LONG), PARAMETER :: MPDAT_PLOAD2 = 1 ! No. pressures on PLOAD2 Bulk Data card - INTEGER(LONG), PARAMETER :: MPDAT_PLOAD4 = 4 ! No. pressuresa on PLOAD4 Bulk Data card + INTEGER(LONG), PARAMETER :: MPDAT_PLOAD2 = 1 ! No. pressures on PLOAD2 Bulk Data card + INTEGER(LONG), PARAMETER :: MPDAT_PLOAD4 = 4 ! No. pressuresa on PLOAD4 Bulk Data card INTEGER(LONG), PARAMETER :: MPBAR = 3 ! No. cols allowed in dimensioning array PBAR INTEGER(LONG), PARAMETER :: MPBARLU = 6 ! Max num of dec places in format for writing PBAR equivs of PBARL INTEGER(LONG), PARAMETER :: MPBEAM = 4 ! No. cols allowed in dimensioning array PBEAM @@ -500,8 +500,8 @@ MODULE SCONTR INTEGER(LONG), PARAMETER :: MPSOLID = 6 ! No. cols allowed in dimensioning array PSOLID INTEGER(LONG), PARAMETER :: MPUSER1 = 2 ! No. cols allowed in dimensioning array PUSER1 INTEGER(LONG), PARAMETER :: MPUSERIN = 2 ! No. cols allowed in dimensioning array PUSERIN - INTEGER(LONG), PARAMETER :: MRCONM2 = 10 ! No. cols allowed in dimensioning array RCONM2 - INTEGER(LONG), PARAMETER :: MRCORD = 12 ! No. cols allowed in dimensioning array RCORD + INTEGER(LONG), PARAMETER :: MRCONM2 = 10 ! No. cols allowed in dimensioning array RCONM2 + INTEGER(LONG), PARAMETER :: MRCORD = 12 ! No. cols allowed in dimensioning array RCORD INTEGER(LONG), PARAMETER :: MRGRID = 3 ! No. cols allowed in dimensioning array RGRID INTEGER(LONG), PARAMETER :: MRMATLC = 30 ! No. cols allowed in dimensioning array RMATL INTEGER(LONG), PARAMETER :: MRSNORM = 3 ! No. cols allowed in dimensioning array RSNORM @@ -528,7 +528,7 @@ MODULE SCONTR INTEGER(LONG), PARAMETER :: MUSERIN_MAT_NAMES = 4 ! No. cols allowed in dimensioning array USERIN_MAT_NAMES ! Parameters used to denote bit positions in subcase arrays GROUT, ELOUT and ELDT. Note: if any of these change here, the changes -! must be reflected in subr SUBCASE_PROC which assumes the following assignments since it uses IBIT(J), J = 0, 1, 2... and not the +! must be reflected in subr SUBCASE_PROC which assumes the following assignments since it uses IBIT(J), J = 0, 1, 2... and not the ! named variables below. GROUT, ELOUT and ELDT all have 16 bits with the following ones used: INTEGER(LONG), PARAMETER :: GROUT_ACCE_BIT = 5 ! Bit pos in OGROUT, GROUT for G.P. accel print requests @@ -569,6 +569,8 @@ MODULE SCONTR INTEGER(LONG) :: COUNTER_PERC = ZERO ! Current percentage of the counter. INTEGER(LONG) :: COUNTER_TOTAL = ZERO ! Max value of the counter INTEGER(LONG) :: COUNTER_STARTED = ZERO ! Timestamp of counter start + INTEGER(LONG) :: COUNTER_UPDATED = ZERO ! Timestamp of counter update + INTEGER(LONG) :: COUNTER_LIMITER = ZERO ! Counter updates this second CHARACTER(:), ALLOCATABLE :: COUNTER_PREFIX CHARACTER(LEN=20) :: COUNTER_FMT diff --git a/Source/Modules/SUBR_BEGEND_LEVELS.f90 b/Source/Modules/SUBR_BEGEND_LEVELS.f90 deleted file mode 100644 index 02bd76d1..00000000 --- a/Source/Modules/SUBR_BEGEND_LEVELS.f90 +++ /dev/null @@ -1,646 +0,0 @@ -! ################################################################################################################################## -! Begin MIT license text. -! _______________________________________________________________________________________________________ - -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) - -! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and -! associated documentation files (the "Software"), to deal in the Software without restriction, including -! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to -! the following conditions: - -! The above copyright notice and this permission notice shall be included in all copies or substantial -! portions of the Software and documentation. - -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -! THE SOFTWARE. -! _______________________________________________________________________________________________________ - -! End MIT license text. - - MODULE SUBR_BEGEND_LEVELS - -! These variables are used in subrs to decide if the begin/end times of the subr are to be written to the F04 file - - USE PENTIUM_II_KIND, ONLY : LONG - - IMPLICIT NONE - - SAVE - -! Values used in deciding whether subroutine begin/end times are printed in the log file. The file MYSTRAN.INI can have a value for -! variable PRBEGEND. If a subroutine has a value for the xxx_BEGEND, below, that is equal to, or less than, then the -! begin/end times for that subroutine will be printed in the log file. Note that the xxx_BEGEND parameters, below, all are in the -! format of where xxx is the subroutine name. - - INTEGER(LONG), PARAMETER, PRIVATE :: ALLOCATE_BEGEND = 8 - INTEGER(LONG), PARAMETER, PRIVATE :: DATA_DECK_BEGEND = 8 - INTEGER(LONG), PARAMETER, PRIVATE :: ELEM_BEGEND = 4 - INTEGER(LONG), PARAMETER, PRIVATE :: LINK_BEGEND = 1 - - INTEGER(LONG), PARAMETER :: MYSTRAN_FILES_BEGEND = 0 - INTEGER(LONG), PARAMETER :: PROCESS_INCLUDE_FILES_BEGEND = 0 - - INTEGER(LONG), PARAMETER :: ELMDAT_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELMGM1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELMGM2_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELMGM3_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: EMG_BEGEND = ELEM_BEGEND - INTEGER(LONG), PARAMETER :: GET_ELEM_AGRID_BGRID_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: GET_ELEM_ONAME_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: GET_ELGP_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: GET_PCOMP_SECT_PROPS_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: GET_MATANGLE_FROM_CID_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: GRID_ELEM_CONN_TABLE_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ROT_COMP_ELEM_AXES_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SHELL_ABD_MATRICES_BEGEND = ELEM_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: ELMOFF_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELMOUT_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: ELMTLB_BEGEND = ELEM_BEGEND + 2 - - INTEGER(LONG), PARAMETER :: BAR1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: BEAM_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: BREL1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: BUSH_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELAS1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: KUSER1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: PINFLG_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: ROD1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: USERIN_BEGEND = ELEM_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: CALC_PHI_SQ_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: GET_ELEM_NUM_PLIES_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: TMEM1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: TPLT1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: TPLT2_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: TREL1_BEGEND = ELEM_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: QDEL1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: QMEM1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: QPLT1_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: QPLT2_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: QPLT3_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: QSHEAR_BEGEND = ELEM_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: HEXA_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: PENTA_BEGEND = ELEM_BEGEND + 1 - INTEGER(LONG), PARAMETER :: TETRA_BEGEND = ELEM_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: BBDKQ_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: BBMIN3_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: BBMIN4_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: BCHECK_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: B3D_ISOPARAMETRIC_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: BMQMEM_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: BSMIN3_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: BSMIN4_BEGEND = ELEM_BEGEND + 3 - - INTEGER(LONG), PARAMETER :: MIN4SH_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: ORDER_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: SHP_BEGEND = ELEM_BEGEND + 3 - - INTEGER(LONG), PARAMETER :: JACOBIAN_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: MATERIAL_PROPS_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: MATGET_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: MATPUT_BEGEND = ELEM_BEGEND + 3 - INTEGER(LONG), PARAMETER :: MATL_TRANSFORM_MATRIX_BEGEND = ELEM_BEGEND + 2 - INTEGER(LONG), PARAMETER :: ROT_AXES_MATL_TO_LOC_BEGEND = ELEM_BEGEND + 2 - - INTEGER(LONG), PARAMETER :: CSHIFT_BEGEND = DATA_DECK_BEGEND+1 - INTEGER(LONG), PARAMETER :: EC_DEBUG_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: EC_IN4FIL_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: EC_OUTPUT4_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: EC_PARTN_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: ELEPRO_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: FFIELD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: FFIELD2_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: LOADB_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LOADB_RESTART_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LOADB0_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LOADC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LOADC0_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LOADE_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LOADE0_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REPLACE_TABS_W_BLANKS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_INCLUDE_FILNAM_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: RW_INCLUDE_FILES_BEGEND = LINK_BEGEND + 8 - - INTEGER(LONG), PARAMETER :: BD_ASET_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_ASET1_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_BAROR0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_BAROR_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_BEAMOR0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_BEAMOR_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CBAR0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CBAR_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CBUSH0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CBUSH_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CELAS_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CHEXA0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CHEXA_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CMASS_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CONM2_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CONROD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CORD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CPENTA0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CPENTA_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CQUAD0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CQUAD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CROD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CSHEAR_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CTETRA0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CTETRA_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CTRIA0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CTRIA_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CUSER1_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CUSERIN0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_CUSERIN_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_DEBUG_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_EIG_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_FORMOM_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_GRAV_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_GRDSET_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_GRDSET0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_GRID_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_IMBEDDED_BLANK_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_LOAD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_LOAD0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_MATL_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_MPC0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_MPC_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_MPCADD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_MPCADD0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_NLPARM_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PARAM_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PARAM0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PARVEC_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PARVEC1_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PBAR_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PBARL_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PBEAM_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PBush_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PCOMP_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PCOMP0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PCOMP1_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PCOMP10_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PELAS_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PLOAD2_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PLOAD4_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PLOTEL_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PMASS_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PROD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PSHEAR_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PSHEL_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PSOLID_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PUSER1_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_PUSERIN_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_RBAR_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_RBE1_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_RBE2_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_RBE30_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_RBE3_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_RSPLINE0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_RSPLINE_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_RFORCE_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SEQGP_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SLOAD0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SLOAD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SPC_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SPC1_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SPCADD0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SPCADD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SPOINT0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SPOINT_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_SUPORT_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_TEMP_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_TEMPD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_TEMPRP_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_USET_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: BD_USET1_BEGEND = DATA_DECK_BEGEND - - INTEGER(LONG), PARAMETER :: CC_ACCE_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_DISP_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_ECHO_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_ELDA_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_ELFO_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_ENFO_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_GPFO_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_LABE_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_LOAD_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_MEFM_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_MPF_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_METH_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_MPC_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_MPCF_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_NLPARM_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_OLOA_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_OUTPUTS_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_SET_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_SET0_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_SPC_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_SPCF_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_STRE_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_STRN_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_SUBC_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_SUBT_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_TEMP_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CC_TITL_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CHK_CC_CMD_DESCRIBERS_BEGEND = DATA_DECK_BEGEND - - INTEGER(LONG), PARAMETER :: CORD_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CORD1_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CORD2_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: DOF_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: GRID_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: RDOF_BEGEND = LINK_BEGEND + 6 - INTEGER(LONG), PARAMETER :: OU4_PARTVEC_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SEQ_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: TDOF_COL_NUM_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: TSET_PROC_FOR_MPCS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: TSET_PROC_FOR_OMITS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: TSET_PROC_FOR_RIGELS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: TSET_PROC_FOR_SPCS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: USET_PROC_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: CONM2_PROC_1_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CONM2_PROC_2_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELEM_PROP_MATL_IIDS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELEM_TRANSFORM_LBG_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: ELESORT_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELSAVE_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: GPWG_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: GPWG_PMOI_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: GPWG_USERIN_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: RB_DISP_MATRIX_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SUBCASE_PROC_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: EPTL_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: FORCE_MOM_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: GET_GRID_6X6_MASS_BEGEND = LINK_BEGEND + 5 - INTEGER(LONG), PARAMETER :: GRAV_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MPC_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: PRESSURE_DATA_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: RFORCE_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: RSPLINE_PROC_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: RIGID_ELEM_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SLOAD_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: TEMPERATURE_DATA_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: YS_ARRAY_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: EMP_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: EMP0_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ESP_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ESP0_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ESP0_FINAL_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: KGG_SINGULARITY_PROC_BEGEND = LINK_BEGEND + 5 - INTEGER(LONG), PARAMETER :: MGGC_MASS_MATRIX_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MGGS_MASS_MATRIX_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SPARSE_KGG_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SPARSE_KGGD_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SPARSE_MGG_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SPARSE_PG_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SPARSE_RMG_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: CHAR_FLD_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CHECK_BAR_MOIs_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CRDERR_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: GET_ANSID_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: GET_SETID_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: I4FLD_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: IP6CHK_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LEFT_ADJ_BDFLD_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MKCARD_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MKJCARD_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: NEXTC_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: NEXTC0_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: NEXTC2_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: NEXTC20_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: R4FLD_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: R8FLD_BEGEND = DATA_DECK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: STOKEN_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: TOKCHK_BEGEND = DATA_DECK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: ALLOCATE_EMS_ARRAYS_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_L1_MGG_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_STF_ARRAYS_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_TEMPLATE_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_L1_MGG_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_EMS_ARRAYS_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_STF_ARRAYS_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_TEMPLATE_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: LINK1_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: LINK1_RESTART_DATA_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: PRINT_CONSTANTS_1_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: WRITE_ENF_TO_L1O_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: ALLOCATE_L2_GMN_2_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_L2_GOA_2_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_L2_GMN_2_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_L2_GOA_2_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: LINK2_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: REDUCE_G_NM_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_N_FS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_F_AO_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_A_LR_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_KGG_TO_KNN_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_KNN_TO_KFF_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_KFF_TO_KAA_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_KAA_TO_KLL_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_KGGD_TO_KNND_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_KNND_TO_KFFD_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_KFFD_TO_KAAD_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_KAAD_TO_KLLD_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_MGG_TO_MNN_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_MNN_TO_MFF_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_MFF_TO_MAA_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_MAA_TO_MLL_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_PG_TO_PN_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_PN_TO_PF_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_PF_TO_PA_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: REDUCE_PA_TO_PL_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SOLVE_GMN_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SOLVE_GOA_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SOLVE_UO0_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: STIFF_MAT_EQUIL_CHK_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: EPSCALC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LINK3_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: REFINE_SOL_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: VECINORM_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: CALC_GEN_MASS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: EIG_GIV_MGIV_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: EIG_INV_PWR_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: EIG_LANCZOS_ARPACK_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: EIG_SUMMARY_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: INVERT_EIGENS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LINK4_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: RENORM_ON_MASS_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: BUILD_A_LR_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: BUILD_F_AO_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: BUILD_G_NM_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: BUILD_N_FS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: EXPAND_PHIXA_TO_PHIXG_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LINK5_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: RENORM_BEGEND = LINK_BEGEND + 2 - - INTEGER(LONG), PARAMETER :: ALLOCATE_L6_2_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: CALC_CB_MEFM_MPF_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CALC_KRRcb_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CALC_MRN_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CALC_MRRcb_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CALC_PHIZL_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: DEALLOCATE_L6_2_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: INTERFACE_FORCE_LTM_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LINK6_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: MERGE_KXX_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MERGE_LTM_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MERGE_MXX_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MERGE_PHIXA_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: NET_CG_LOADS_LTM_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SOLVE_DLR_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SOLVE_PHIZL1_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: BAR_MARGIN_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: GET_MAX_MIN_ABS_STR_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: PRINCIPAL_2D_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: PRINCIPAL_3D_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: ROD_MARGIN_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_FEMAP_ELFO_VECS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_FEMAP_GRID_VECS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_FEMAP_STRE_VECS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_FEMAP_STRN_VECS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_MEFFMASS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_MPFACTOR_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_PLY_STRAINS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_PLY_STRESSES_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_BAR_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_ELEM_ENGR_FORCE_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_ELEM_NODE_FORCE_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_ELEM_STRESSES_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_ELEM_STRAINS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_GRD_PCH_OUTPUTS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_GRD_PRT_OUTPUTS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: WRITE_ROD_BEGEND = LINK_BEGEND + ELEM_BEGEND - - INTEGER(LONG), PARAMETER :: CALC_ELEM_NODE_FORCES_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CALC_ELEM_STRESSES_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CALC_ELEM_STRAINS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELEM_STRE_STRN_ARRAYS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: POLYNOM_FIT_STRE_STRN_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: SHELL_ENGR_FORCE_OGEL_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SHELL_STRAIN_OUTPUTS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SHELL_STRESS_OUTPUTS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SOLID_STRAIN_OUTPUTS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SOLID_STRESS_OUTPUTS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ELMDIS_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: ELMDIS_PLY_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: GET_COMP_SHELL_ALLOWS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: GP_FORCE_BALANCE_PROC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: INDEP_FAILURE_INDEX_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP1_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP2_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP3_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP3_ELFN_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP3_ELFE_1D_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP3_ELFE_2D_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP3_STRE_NO_PCOMP_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP3_STRE_PCOMP_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP3_STRN_NO_PCOMP_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OFP3_STRN_PCOMP_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ONE_D_STRAIN_OUTPUTS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: ONE_D_STRESS_OUTPUTS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: POLY_FAILURE_INDEX_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SUSER1_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: STR_TENSOR_TRANSFORM_BEGEND = LINK_BEGEND + ELEM_BEGEND - INTEGER(LONG), PARAMETER :: TRANSFORM_NODE_FORCES_BEGEND = LINK_BEGEND + ELEM_BEGEND - - INTEGER(LONG), PARAMETER :: ALLOCATE_FEMAP_DATA_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_LINK9_STUF_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_FEMAP_DATA_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_LINK9_STUF_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: LINK9_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: LINK9S_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MAXREQ_OGEL_BEGEND = LINK_BEGEND + 1 - - INTEGER(LONG), PARAMETER :: ALLOCATE_CB_ELM_OTM_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_CB_GRD_OTM_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_COL_VEC_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_DOF_TABLES_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_EIGEN1_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_FULL_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_IN4_FILES_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_LAPACK_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_MISC_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_MODEL_STUF_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_NL_PARAMS_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_RBGLOBAL_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_SCR_CCS_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_SCR_CRS_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_SPARSE_ALG_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ALLOCATE_SPARSE_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: ARRAY_SIZE_ERROR_1_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: BANDGEN_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: BANDSIZ_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CALC_TDOF_ROW_START_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: CALC_VEC_SORT_ORDER_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: CARD_FLDS_NOT_BLANK_BEGEND = DATA_DECK_BEGEND - INTEGER(LONG), PARAMETER :: CHECK_MAT_INVERSE_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: CLOSE_LIJFILES_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: CLOSE_OUTFILES_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: CNT_NONZ_IN_FULL_MAT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: COND_NUM_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: CONVERT_INT_TO_CHAR_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: CONVERT_VEC_COORD_SYS_BEGEND = LINK_BEGEND + 4 - INTEGER(LONG), PARAMETER :: CROSS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: CRS_NONSYM_TO_CRS_SYM_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: CRS_SYM_TO_CRS_NONSYM_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: DATA_SET_NAME_ERROR_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: DATA_SET_SIZE_ERROR_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: DEALLOCATE_CB_ELM_OTM_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_CB_GRD_OTM_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_COL_VEC_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_DOF_TABLES_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_EIGEN1_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_IN4_FILES_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_FULL_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_LAPACK_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_MISC_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_MODEL_STUF_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_NL_PARAMS_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_RBGLOBAL_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_SCR_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_SPARSE_ALG_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: DEALLOCATE_SPARSE_MAT_BEGEND = ALLOCATE_BEGEND - INTEGER(LONG), PARAMETER :: EQUILIBRATE_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: FBS_LAPACK_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: FBS_SUPRLU_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: FILE_INQUIRE_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: FILE_OPEN_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: FILERR_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: FULL_TO_SPARSE_CRS_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: GET_COMMAND_LINE_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: GEN_T0L_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: GET_ARRAY_ROW_NUM_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: GET_CHAR_STRING_END_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: GET_FORMATTED_INTEGER_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: GET_GRID_AND_COMP_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: GET_GRID_NUM_COMPS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: GET_I_MAT_FROM_I2_MAT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: GET_I2_MAT_FROM_I_MAT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: GET_MACHINE_PARAMS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: GET_MATRIX_DIAG_STATS_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: GET_MAX_NUM_ELM_GRIDS_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: GET_SPARSE_CRS_COL_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: GET_SPARSE_CRS_ROW_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: GET_SPARSE_MAT_TERM_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: GET_UG_123_IN_GRD_ORD_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: GET_VEC_MIN_MAX_ABS_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: INVERT_FF_MAT_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: MATADD_FFF_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATADD_SSS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATADD_SSS_NTERM_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATMULT_FFF_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATMULT_FFF_T_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATMULT_SFF_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATMULT_SFS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATMULT_SFS_NTERM_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATMULT_SSS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATMULT_SSS_NTERM_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MATRIX_VECTOR_OP_BEGEND = LINK_BEGEND + 2 - INTEGER(LONG), PARAMETER :: MATTRNSP_SS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: MAX_MEMORY_AVAILABLE_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: MERGE_COL_VECS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MERGE_MAT_COLS_SSS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: MERGE_MAT_ROWS_SSS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: OPEN_OUTFILES_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: OPNERR_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: OURDAT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: OURTIM_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: OUTA_HERE_BEGEND = LINK_BEGEND - INTEGER(LONG), PARAMETER :: OUTPUT4_PROC_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: PARAM_CORDS_ACT_CORDS_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: PARSE_CHAR_STRING_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: PARTITION_FF_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: PARTITION_SS_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: PARTITION_SS_NTERM_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: PARTITION_VEC_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: PLANE_COORD_TRANS_21_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: PROJ_VEC_ONTO_PLANE_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: PRT_MATS_ON_RESTART_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_CL_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: RESTART_DATA_FOR_L3_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: RESTART_DATA_FOR_L5_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: READ_DOF_TABLES_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_IN4_FULL_MAT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_L1A_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_L1M_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_L1Z_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_MATRIX_1_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_MATRIX_2_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READ_XTIME_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: READERR_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: RIGID_BODY_DISP_MAT_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: ROW_AT_COLJ_BEGEND_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: SORT_GRID_RGRID_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_INT1_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_INT1_REAL1_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_INT1_REAL3_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_INT2_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_INT2_REAL1_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_INT3_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_INT3_CHAR2_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_REAL1_INT1_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORT_TDOF_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SORTLEN_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SPARSE_CRS_SPARSE_CCS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SPARSE_CRS_TERM_COUNT_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SPARSE_CRS_TO_FULL_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SPARSE_MAT_DIAG_ZEROS_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SPARSE_NONSYM_TO_SYM_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: STMERR_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: SURFACE_FIT_BEGEND = LINK_BEGEND + 8 - INTEGER(LONG), PARAMETER :: SYM_MAT_DECOMP_LAPACK_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: SYM_MAT_DECOMP_SUPRLU_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: TIME_INIT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: VECTOR_NORM_BEGEND = LINK_BEGEND + 3 - INTEGER(LONG), PARAMETER :: WRITE_ALLOC_MEM_TABLE_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_DOF_TABLES_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_EDAT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_ELM_OT4_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_FIJFIL_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_FILNAM_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_GRD_OT4_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_GRID_COORDS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_INTEGER_VEC_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_L1A_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_L1M_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_L1Z_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_MATRIX_1_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_MATRIX_BY_COLS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_MATRIX_BY_ROWS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_MEM_SUM_TO_F04_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_OU4_FULL_MAT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_OU4_SPARSE_MAT_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_PARTNd_MAT_HDRS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_SPARSE_CRS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_TDOF_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_TSET_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_USERIN_BD_CARDS_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_USET_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_USETSTR_BEGEND = LINK_BEGEND + 10 - INTEGER(LONG), PARAMETER :: WRITE_VECTOR_BEGEND = LINK_BEGEND + 10 - - INTEGER(LONG), PARAMETER :: ARPACK_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: BANDIT_BEGEND = LINK_BEGEND + 1 - INTEGER(LONG), PARAMETER :: LAPACK_BEGEND = LINK_BEGEND + 1 - - END MODULE SUBR_BEGEND_LEVELS diff --git a/Source/USE_IFs/ALLOCATE_CB_ELM_OTM_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_CB_ELM_OTM_USE_IFs.f90 index 21d83f50..fa0b4533 100644 --- a/Source/USE_IFs/ALLOCATE_CB_ELM_OTM_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_CB_ELM_OTM_USE_IFs.f90 @@ -30,6 +30,5 @@ MODULE ALLOCATE_CB_ELM_OTM_USE_IFs USE OURTIM_Interface USE OUTA_HERE_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface END MODULE ALLOCATE_CB_ELM_OTM_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_CB_GRD_OTM_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_CB_GRD_OTM_USE_IFs.f90 index 2546827c..6dabaa49 100644 --- a/Source/USE_IFs/ALLOCATE_CB_GRD_OTM_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_CB_GRD_OTM_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE ALLOCATE_CB_GRD_OTM_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE ALLOCATE_CB_GRD_OTM_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_EMS_ARRAYS_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_EMS_ARRAYS_USE_IFs.f90 index ea3ab46c..fd5dbeeb 100644 --- a/Source/USE_IFs/ALLOCATE_EMS_ARRAYS_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_EMS_ARRAYS_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE ALLOCATE_EMS_ARRAYS_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE ALLOCATE_EMS_ARRAYS_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_FEMAP_DATA_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_FEMAP_DATA_USE_IFs.f90 index 9317587c..af10911b 100644 --- a/Source/USE_IFs/ALLOCATE_FEMAP_DATA_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_FEMAP_DATA_USE_IFs.f90 @@ -30,6 +30,5 @@ MODULE ALLOCATE_FEMAP_DATA_USE_IFs USE OURTIM_Interface USE OUTA_HERE_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface END MODULE ALLOCATE_FEMAP_DATA_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_IN4_FILES_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_IN4_FILES_USE_IFs.f90 index 4725a3a2..cfe480c6 100644 --- a/Source/USE_IFs/ALLOCATE_IN4_FILES_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_IN4_FILES_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE ALLOCATE_IN4_FILES_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE ALLOCATE_IN4_FILES_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_L1_MGG_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_L1_MGG_USE_IFs.f90 index e93feb89..dc7644f6 100644 --- a/Source/USE_IFs/ALLOCATE_L1_MGG_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_L1_MGG_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE ALLOCATE_L1_MGG_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE ALLOCATE_L1_MGG_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_L6_2_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_L6_2_USE_IFs.f90 index cecd6132..8fa4177b 100644 --- a/Source/USE_IFs/ALLOCATE_L6_2_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_L6_2_USE_IFs.f90 @@ -30,6 +30,5 @@ MODULE ALLOCATE_L6_2_USE_IFs USE OURTIM_Interface USE OUTA_HERE_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface END MODULE ALLOCATE_L6_2_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_LINK9_STUF_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_LINK9_STUF_USE_IFs.f90 index 32338fec..362701c0 100644 --- a/Source/USE_IFs/ALLOCATE_LINK9_STUF_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_LINK9_STUF_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE ALLOCATE_LINK9_STUF_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE ALLOCATE_LINK9_STUF_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_MODEL_STUF_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_MODEL_STUF_USE_IFs.f90 index 436c1e74..b0d88771 100644 --- a/Source/USE_IFs/ALLOCATE_MODEL_STUF_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_MODEL_STUF_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE ALLOCATE_MODEL_STUF_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE ALLOCATE_MODEL_STUF_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_STF_ARRAYS_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_STF_ARRAYS_USE_IFs.f90 index 14d0f4b9..3d50f1fc 100644 --- a/Source/USE_IFs/ALLOCATE_STF_ARRAYS_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_STF_ARRAYS_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE ALLOCATE_STF_ARRAYS_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE ALLOCATE_STF_ARRAYS_USE_IFs diff --git a/Source/USE_IFs/ALLOCATE_TEMPLATE_USE_IFs.f90 b/Source/USE_IFs/ALLOCATE_TEMPLATE_USE_IFs.f90 index a0e7b958..a346e6db 100644 --- a/Source/USE_IFs/ALLOCATE_TEMPLATE_USE_IFs.f90 +++ b/Source/USE_IFs/ALLOCATE_TEMPLATE_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE ALLOCATE_TEMPLATE_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE ALLOCATE_TEMPLATE_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_EMS_ARRAYS_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_EMS_ARRAYS_USE_IFs.f90 index e0e580ec..ff224d58 100644 --- a/Source/USE_IFs/DEALLOCATE_EMS_ARRAYS_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_EMS_ARRAYS_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_EMS_ARRAYS_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_EMS_ARRAYS_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_FEMAP_DATA_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_FEMAP_DATA_USE_IFs.f90 index 4cd1875c..d756044c 100644 --- a/Source/USE_IFs/DEALLOCATE_FEMAP_DATA_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_FEMAP_DATA_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_FEMAP_DATA_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_FEMAP_DATA_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_L1_MGG_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_L1_MGG_USE_IFs.f90 index abc927c5..08caa498 100644 --- a/Source/USE_IFs/DEALLOCATE_L1_MGG_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_L1_MGG_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_L1_MGG_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_L1_MGG_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_LINK9_STUF_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_LINK9_STUF_USE_IFs.f90 index 0c9dbba0..d5b4cb8f 100644 --- a/Source/USE_IFs/DEALLOCATE_LINK9_STUF_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_LINK9_STUF_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_LINK9_STUF_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_LINK9_STUF_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_MODEL_STUF_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_MODEL_STUF_USE_IFs.f90 index 5efd8e6c..f8980376 100644 --- a/Source/USE_IFs/DEALLOCATE_MODEL_STUF_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_MODEL_STUF_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_MODEL_STUF_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_MODEL_STUF_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_SCR_MAT_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_SCR_MAT_USE_IFs.f90 index 21f6c944..37c4d67a 100644 --- a/Source/USE_IFs/DEALLOCATE_SCR_MAT_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_SCR_MAT_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_SCR_MAT_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_SCR_MAT_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_SPARSE_MAT_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_SPARSE_MAT_USE_IFs.f90 index 1ae1e085..b652c79d 100644 --- a/Source/USE_IFs/DEALLOCATE_SPARSE_MAT_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_SPARSE_MAT_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_SPARSE_MAT_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_SPARSE_MAT_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_STF_ARRAYS_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_STF_ARRAYS_USE_IFs.f90 index 4b96c25e..11b0aea4 100644 --- a/Source/USE_IFs/DEALLOCATE_STF_ARRAYS_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_STF_ARRAYS_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_STF_ARRAYS_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_STF_ARRAYS_USE_IFs diff --git a/Source/USE_IFs/DEALLOCATE_TEMPLATE_USE_IFs.f90 b/Source/USE_IFs/DEALLOCATE_TEMPLATE_USE_IFs.f90 index a3254aa6..4b4ec67e 100644 --- a/Source/USE_IFs/DEALLOCATE_TEMPLATE_USE_IFs.f90 +++ b/Source/USE_IFs/DEALLOCATE_TEMPLATE_USE_IFs.f90 @@ -29,7 +29,6 @@ MODULE DEALLOCATE_TEMPLATE_USE_IFs USE OURTIM_Interface USE ALLOCATED_MEMORY_Interface - USE WRITE_MEM_SUM_TO_F04_Interface USE OUTA_HERE_Interface END MODULE DEALLOCATE_TEMPLATE_USE_IFs diff --git a/Source/USE_IFs/MATADD_SSS_NTERM_USE_IFs.f90 b/Source/USE_IFs/MATADD_SSS_NTERM_USE_IFs.f90 index cc1501a6..e2efa9af 100644 --- a/Source/USE_IFs/MATADD_SSS_NTERM_USE_IFs.f90 +++ b/Source/USE_IFs/MATADD_SSS_NTERM_USE_IFs.f90 @@ -29,7 +29,5 @@ MODULE MATADD_SSS_NTERM_USE_IFs USE OURTIM_Interface USE OUTA_HERE_Interface - USE ALLOCATE_SPARSE_ALG_Interface - USE DEALLOCATE_SPARSE_ALG_Interface END MODULE MATADD_SSS_NTERM_USE_IFs diff --git a/Source/USE_IFs/MATADD_SSS_USE_IFs.f90 b/Source/USE_IFs/MATADD_SSS_USE_IFs.f90 index 98c184ee..7854a734 100644 --- a/Source/USE_IFs/MATADD_SSS_USE_IFs.f90 +++ b/Source/USE_IFs/MATADD_SSS_USE_IFs.f90 @@ -28,8 +28,5 @@ MODULE MATADD_SSS_USE_IFs ! USE Interface statements for all subroutines called by SUBROUTINE MATADD_SSS USE OURTIM_Interface - USE ALLOCATE_SPARSE_ALG_Interface - USE ARRAY_SIZE_ERROR_1_Interface - USE DEALLOCATE_SPARSE_ALG_Interface END MODULE MATADD_SSS_USE_IFs diff --git a/Source/USE_IFs/OPNERR_USE_IFs.f90 b/Source/USE_IFs/OPNERR_USE_IFs.f90 index 8fb9a75f..ac186427 100644 --- a/Source/USE_IFs/OPNERR_USE_IFs.f90 +++ b/Source/USE_IFs/OPNERR_USE_IFs.f90 @@ -27,7 +27,6 @@ MODULE OPNERR_USE_IFs ! USE Interface statements for all subroutines called by SUBROUTINE OPNERR - USE OURTIM_Interface USE WRITE_FILNAM_Interface USE OUTA_HERE_Interface diff --git a/Source/USE_IFs/WRITE_MEM_SUM_TO_F04_USE_IFs.f90 b/Source/USE_IFs/WRITE_MEM_SUM_TO_F04_USE_IFs.f90 deleted file mode 100644 index edb8681f..00000000 --- a/Source/USE_IFs/WRITE_MEM_SUM_TO_F04_USE_IFs.f90 +++ /dev/null @@ -1,31 +0,0 @@ -! Begin MIT license text. -! _______________________________________________________________________________________________________ - -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) - -! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and -! associated documentation files (the "Software"), to deal in the Software without restriction, including -! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to -! the following conditions: - -! The above copyright notice and this permission notice shall be included in all copies or substantial -! portions of the Software and documentation. - -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -! THE SOFTWARE. -! _______________________________________________________________________________________________________ - -! End MIT license text. - - MODULE WRITE_MEM_SUM_TO_F04_USE_IFs - -! USE Interface statements for all subroutines called by SUBROUTINE WRITE_MEM_SUM_TO_F04 -! No subrs CALL'd by SUBROUTINE WRITE_MEM_SUM_TO_F04 - - END MODULE WRITE_MEM_SUM_TO_F04_USE_IFs diff --git a/Source/UTIL/ALLOCATED_MEMORY.f90 b/Source/UTIL/ALLOCATED_MEMORY.f90 index 7ff629d9..af11bc85 100644 --- a/Source/UTIL/ALLOCATED_MEMORY.f90 +++ b/Source/UTIL/ALLOCATED_MEMORY.f90 @@ -38,7 +38,7 @@ SUBROUTINE ALLOCATED_MEMORY ( ARRAY_NAME, MB_ALLOCATED, WHAT, WRITE_TABLE, CURRE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : SUPINFO diff --git a/Source/UTIL/ALLOCATE_CB_ELM_OTM.f90 b/Source/UTIL/ALLOCATE_CB_ELM_OTM.f90 index 24b62db6..2c2420e7 100644 --- a/Source/UTIL/ALLOCATE_CB_ELM_OTM.f90 +++ b/Source/UTIL/ALLOCATE_CB_ELM_OTM.f90 @@ -30,7 +30,7 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) ! model generation runs and allocates memory to the arrays USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, & ELOUT_ELFE_BIT, ELOUT_ELFN_BIT, ELOUT_STRE_BIT, ELOUT_STRN_BIT, & @@ -45,7 +45,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC USE OUTPUT4_MATRICES, ONLY : OTM_ELFE, OTM_ELFN, OTM_STRE, OTM_STRN, TXT_ELFE, TXT_ELFN, TXT_STRE, TXT_STRN USE PARAMS, ONLY : OTMSKIP - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_CB_ELM_OTM_BEGEND USE ALLOCATE_CB_ELM_OTM_USE_IFs @@ -65,7 +64,7 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) INTEGER(LONG) :: NCOLS ! Number of cols in OTM matrix INTEGER(LONG) :: NROWS_MAT ! Number of rows in OTM matrix INTEGER(LONG) :: NROWS_TXT ! Number of rows in TXT mmatrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_CB_ELM_OTM_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -75,12 +74,7 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) INTRINSIC :: IAND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -173,7 +167,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS_MAT)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_MAT, NCOLS, SUBR_BEGEND ) DO I=1,NROWS_MAT DO J=1,NCOLS OTM_ELFE(I,J) = ZERO @@ -198,7 +191,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(NROWS_TXT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_TXT, 1, SUBR_BEGEND ) DO I=1,NROWS_TXT TXT_ELFE(I)(1:) = ' ' ENDDO @@ -242,7 +234,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS_MAT)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_MAT, NCOLS, SUBR_BEGEND ) DO I=1,NROWS_MAT DO J=1,NCOLS OTM_ELFN(I,J) = ZERO @@ -267,7 +258,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(NROWS_TXT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_TXT, 1, SUBR_BEGEND ) DO I=1,NROWS_TXT TXT_ELFN(I)(1:) = ' ' ENDDO @@ -336,7 +326,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS_MAT)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_MAT, NCOLS, SUBR_BEGEND ) DO I=1,NROWS_MAT DO J=1,NCOLS OTM_STRE(I,J) = ZERO @@ -361,7 +350,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(NROWS_TXT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_TXT, 1, SUBR_BEGEND ) DO I=1,NROWS_TXT TXT_STRE(I)(1:) = ' ' ENDDO @@ -421,7 +409,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS_MAT)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_MAT, NCOLS, SUBR_BEGEND ) DO I=1,NROWS_MAT DO J=1,NCOLS OTM_STRN(I,J) = ZERO @@ -446,7 +433,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(NROWS_TXT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_TXT, 1, SUBR_BEGEND ) DO I=1,NROWS_TXT TXT_STRN(I)(1:) = ' ' ENDDO @@ -475,12 +461,6 @@ SUBROUTINE ALLOCATE_CB_ELM_OTM ( NAME_IN ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME, TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/UTIL/ALLOCATE_CB_GRD_OTM.f90 b/Source/UTIL/ALLOCATE_CB_GRD_OTM.f90 index e5a3bbe8..3244bdab 100644 --- a/Source/UTIL/ALLOCATE_CB_GRD_OTM.f90 +++ b/Source/UTIL/ALLOCATE_CB_GRD_OTM.f90 @@ -30,7 +30,7 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) ! model generation runs and allocates memory to the arrays USE PENTIUM_II_KIND - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC, & GROUT_ACCE_BIT, GROUT_DISP_BIT, GROUT_SPCF_BIT, GROUT_MPCF_BIT, & IBIT, NDOFR, NGRID, NUM_CB_DOFS, NVEC, & @@ -41,7 +41,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) USE PARAMS, ONLY : OTMSKIP USE MODEL_STUF, ONLY : GRID, GROUT USE OUTPUT4_MATRICES, ONLY : OTM_ACCE, OTM_DISP, OTM_MPCF, OTM_SPCF, TXT_ACCE, TXT_DISP, TXT_MPCF, TXT_SPCF - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_CB_GRD_OTM_BEGEND USE ALLOCATE_CB_GRD_OTM_USE_IFs @@ -58,7 +57,7 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) INTEGER(LONG) :: NCOLS ! Number of cols in OTM matrix INTEGER(LONG) :: NROWS_MAT ! Number of rows in OTM matrix INTEGER(LONG) :: NROWS_TXT ! Number of rows in TXT mmatrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_CB_GRD_OTM_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -68,12 +67,7 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) INTRINSIC :: IAND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -104,7 +98,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS_MAT)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_MAT, NCOLS, SUBR_BEGEND ) DO I=1,NROWS_MAT DO J=1,NCOLS OTM_ACCE(I,J) = ZERO @@ -129,7 +122,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(NROWS_TXT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_TXT, 1, SUBR_BEGEND ) DO I=1,NROWS_TXT TXT_ACCE(I)(1:) = ' ' ENDDO @@ -168,7 +160,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS_MAT)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_MAT, NCOLS, SUBR_BEGEND ) DO I=1,NROWS_MAT DO J=1,NCOLS OTM_DISP(I,J) = ZERO @@ -193,7 +184,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(NROWS_TXT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_TXT, 1, SUBR_BEGEND ) DO I=1,NROWS_TXT TXT_DISP(I)(1:) = ' ' ENDDO @@ -234,7 +224,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS_MAT)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_MAT, NCOLS, SUBR_BEGEND ) DO I=1,NROWS_MAT DO J=1,NCOLS OTM_MPCF(I,J) = ZERO @@ -259,7 +248,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(NROWS_TXT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_TXT, 1, SUBR_BEGEND ) DO I=1,NROWS_TXT TXT_MPCF(I)(1:) = ' ' ENDDO @@ -300,7 +288,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS_MAT)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_MAT, NCOLS, SUBR_BEGEND ) DO I=1,NROWS_MAT DO J=1,NCOLS OTM_SPCF(I,J) = ZERO @@ -325,7 +312,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) IF (IERR == 0) THEN MB_ALLOCATED = REAL(NROWS_TXT)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS_TXT, 1, SUBR_BEGEND ) DO I=1,NROWS_TXT TXT_SPCF(I)(1:) = ' ' ENDDO @@ -352,12 +338,6 @@ SUBROUTINE ALLOCATE_CB_GRD_OTM ( NAME_IN ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME, TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/UTIL/ALLOCATE_COL_VEC.f90 b/Source/UTIL/ALLOCATE_COL_VEC.f90 index 6b4731fd..b1696350 100644 --- a/Source/UTIL/ALLOCATE_COL_VEC.f90 +++ b/Source/UTIL/ALLOCATE_COL_VEC.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_COL_VEC ( NAME, NROWS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_COL_VEC_BEGEND USE OUTPUT4_MATRICES, ONLY : OU4_MAT_COL_GRD_COMP, OU4_MAT_ROW_GRD_COMP USE COL_VECS, ONLY : UG_COL, UN_COL, UM_COL, UF_COL, US_COL, UA_COL, UO_COL, UO0_COL, UR_COL, UL_COL, YSe, & FG_COL, FN_COL, FM_COL, FF_COL, FS_COL, FA_COL, FO_COL, FL_COL, FR_COL, & @@ -50,14 +49,13 @@ SUBROUTINE ALLOCATE_COL_VEC ( NAME, NROWS, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_COL_VEC' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Subr that called this one CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows for matrix NAME INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_COL_VEC_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -67,12 +65,7 @@ SUBROUTINE ALLOCATE_COL_VEC ( NAME, NROWS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = ZERO @@ -943,16 +936,6 @@ SUBROUTINE ALLOCATE_COL_VEC ( NAME, NROWS, CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -968,9 +951,6 @@ SUBROUTINE ALLOCATE_COL_VEC ( NAME, NROWS, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/ALLOCATE_DOF_TABLES.f90 b/Source/UTIL/ALLOCATE_DOF_TABLES.f90 index 0b66d95e..87f00816 100644 --- a/Source/UTIL/ALLOCATE_DOF_TABLES.f90 +++ b/Source/UTIL/ALLOCATE_DOF_TABLES.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_DOF_TABLES ( NAME, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, SIX, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LDOFG, LGRID, MTDOF, MTSET, NUM_USET, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_DOF_TABLES_BEGEND USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START, TDOFI, TSET, USET USE ALLOCATE_DOF_TABLES_USE_IFs @@ -44,14 +43,13 @@ SUBROUTINE ALLOCATE_DOF_TABLES ( NAME, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_DOF_TABLES' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows in array INTEGER(LONG) :: NCOLS ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_DOF_TABLES_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -61,12 +59,7 @@ SUBROUTINE ALLOCATE_DOF_TABLES ( NAME, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = ZERO @@ -228,17 +221,6 @@ SUBROUTINE ALLOCATE_DOF_TABLES ( NAME, CALLING_SUBR ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF - RETURN ! ********************************************************************************************************************************** @@ -253,9 +235,6 @@ SUBROUTINE ALLOCATE_DOF_TABLES ( NAME, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/ALLOCATE_EIGEN1_MAT.f90 b/Source/UTIL/ALLOCATE_EIGEN1_MAT.f90 index a7f55eb9..9eea3e77 100644 --- a/Source/UTIL/ALLOCATE_EIGEN1_MAT.f90 +++ b/Source/UTIL/ALLOCATE_EIGEN1_MAT.f90 @@ -31,10 +31,9 @@ SUBROUTINE ALLOCATE_EIGEN1_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_EIGEN1_MAT_BEGEND USE EIGEN_MATRICES_1 , ONLY : EIGEN_VAL, EIGEN_VEC, GEN_MASS, MODE_NUM, MEFFMASS, MPFACTOR_N6, MPFACTOR_NR USE ALLOCATE_EIGEN1_MAT_USE_IFs @@ -44,14 +43,13 @@ SUBROUTINE ALLOCATE_EIGEN1_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_EIGEN1_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows to allocate to matrix NAME INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols to allocate to matrix NAME INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_EIGEN1_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -63,12 +61,7 @@ SUBROUTINE ALLOCATE_EIGEN1_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RNROWS = REAL(NROWS) @@ -259,17 +252,6 @@ SUBROUTINE ALLOCATE_EIGEN1_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF - RETURN ! ********************************************************************************************************************************** @@ -284,10 +266,6 @@ SUBROUTINE ALLOCATE_EIGEN1_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE ALLOCATE_EIGEN1_MAT diff --git a/Source/UTIL/ALLOCATE_FULL_MAT.f90 b/Source/UTIL/ALLOCATE_FULL_MAT.f90 index e800b71f..e4eb85e1 100644 --- a/Source/UTIL/ALLOCATE_FULL_MAT.f90 +++ b/Source/UTIL/ALLOCATE_FULL_MAT.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_FULL_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_FULL_MAT_BEGEND USE FULL_MATRICES, ONLY : KGG_FULL, KNN_FULL, KNM_FULL, KMM_FULL, MNN_FULL, MNM_FULL, MMM_FULL, PN_FULL, PM_FULL, & KFF_FULL, KFS_FULL, KSS_FULL, MFF_FULL, MFS_FULL, MSS_FULL, PF_FULL, PS_FULL, & KAA_FULL, KAO_FULL, KOO_FULL, MAA_FULL, MAO_FULL, MOO_FULL, PA_FULL, PO_FULL, & @@ -49,14 +48,13 @@ SUBROUTINE ALLOCATE_FULL_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_FULL_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG), INTENT(IN) :: NROWS ! Nunber of rows in array NAME being allocated INTEGER(LONG), INTENT(IN) :: NCOLS ! Nunber of cols in array NAME being allocated INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_FULL_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -68,12 +66,7 @@ SUBROUTINE ALLOCATE_FULL_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RNROWS = REAL(NROWS) @@ -1001,16 +994,6 @@ SUBROUTINE ALLOCATE_FULL_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*RNROWS*RNCOLS/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -1026,10 +1009,6 @@ SUBROUTINE ALLOCATE_FULL_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE ALLOCATE_FULL_MAT diff --git a/Source/UTIL/ALLOCATE_IN4_FILES.f90 b/Source/UTIL/ALLOCATE_IN4_FILES.f90 index 47566e7b..3b6a3a8b 100644 --- a/Source/UTIL/ALLOCATE_IN4_FILES.f90 +++ b/Source/UTIL/ALLOCATE_IN4_FILES.f90 @@ -29,12 +29,11 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) ! Allocate arrays for IN4 files (USERIN elements) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN4FIL, IN4FIL_NUM, LNUM_IN4_FILES, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN4FIL, IN4FIL_NUM, LNUM_IN4_FILES, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE INPUTT4_MATRICES, ONLY : IN4_COL_MAP, IN4_MAT - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_IN4_FILES_BEGEND USE ALLOCATE_IN4_FILES_USE_IFs @@ -50,7 +49,7 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR = 0 ! STAT from DEALLOCATE INTEGER(LONG) :: JERR = 0 ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_IN4_FILES_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -61,12 +60,7 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) REAL(DOUBLE) :: RNCOLS ! Real value of NCOLS REAL(DOUBLE) :: RNROWS ! Real value of NROWS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RNROWS = REAL(NROWS) @@ -90,7 +84,6 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*REAL(LNUM_IN4_FILES)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LNUM_IN4_FILES, 1, SUBR_BEGEND ) DO I=1,LNUM_IN4_FILES IN4FIL(I)(1:) = ' ' ENDDO @@ -113,7 +106,6 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*REAL(LNUM_IN4_FILES)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LNUM_IN4_FILES, 1, SUBR_BEGEND ) DO I=1,LNUM_IN4_FILES IN4FIL_NUM(I) = 0 ENDDO @@ -137,7 +129,6 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*RNROWS*RNCOLS/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, NCOLS, SUBR_BEGEND ) DO I=1,NROWS DO J=1,NCOLS IN4_MAT(I,J) = ZERO @@ -164,7 +155,6 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*RNROWS/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NROWS, 1, SUBR_BEGEND ) DO I=1,NROWS IN4_COL_MAP(I) = 0 ENDDO @@ -193,12 +183,7 @@ SUBROUTINE ALLOCATE_IN4_FILES ( NAME_IN, NROWS, NCOLS, CALLING_SUBR ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/ALLOCATE_LAPACK_MAT.f90 b/Source/UTIL/ALLOCATE_LAPACK_MAT.f90 index f314a4df..8ffb8afe 100644 --- a/Source/UTIL/ALLOCATE_LAPACK_MAT.f90 +++ b/Source/UTIL/ALLOCATE_LAPACK_MAT.f90 @@ -30,12 +30,11 @@ SUBROUTINE ALLOCATE_LAPACK_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE, ONEPP6 - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : WINAMEM - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_LAPACK_MAT_BEGEND USE ARPACK_MATRICES_1 , ONLY : IWORK, RFAC, RESID, SELECT, VBAS, WORKD, WORKL USE LAPACK_DPB_MATRICES, ONLY : ABAND, BBAND, LAPACK_S, RES @@ -47,14 +46,13 @@ SUBROUTINE ALLOCATE_LAPACK_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_LAPACK_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Name of matrix to be allocated CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in array to be allocated INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols in array to be allocated INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_LAPACK_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -66,12 +64,7 @@ SUBROUTINE ALLOCATE_LAPACK_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RNROWS = REAL(NROWS) @@ -379,16 +372,6 @@ SUBROUTINE ALLOCATE_LAPACK_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -409,10 +392,6 @@ SUBROUTINE ALLOCATE_LAPACK_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) 9199 FORMAT(' Memory needed for ',A,' = ',F13.6,' MB') - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE ALLOCATE_LAPACK_MAT diff --git a/Source/UTIL/ALLOCATE_MISC_MAT.f90 b/Source/UTIL/ALLOCATE_MISC_MAT.f90 index a4a2adb7..6cfb8ff5 100644 --- a/Source/UTIL/ALLOCATE_MISC_MAT.f90 +++ b/Source/UTIL/ALLOCATE_MISC_MAT.f90 @@ -31,11 +31,10 @@ SUBROUTINE ALLOCATE_MISC_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFA, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE MISC_MATRICES, ONLY : UG_T123_MAT - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_MISC_MAT_BEGEND USE ALLOCATE_MISC_MAT_USE_IFs @@ -44,14 +43,13 @@ SUBROUTINE ALLOCATE_MISC_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_MISC_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows to allocate to matrix NAME INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols to allocate to matrix NAME INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_MISC_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -63,12 +61,7 @@ SUBROUTINE ALLOCATE_MISC_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RNROWS = REAL(NROWS) @@ -121,16 +114,6 @@ SUBROUTINE ALLOCATE_MISC_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -146,9 +129,6 @@ SUBROUTINE ALLOCATE_MISC_MAT ( NAME, NROWS, NCOLS, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/ALLOCATE_MODEL_STUF.f90 b/Source/UTIL/ALLOCATE_MODEL_STUF.f90 index 1dc94b73..b9e11643 100644 --- a/Source/UTIL/ALLOCATE_MODEL_STUF.f90 +++ b/Source/UTIL/ALLOCATE_MODEL_STUF.f90 @@ -30,7 +30,7 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, TWO, THREE, SIX, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE SCONTR, ONLY : LBAROFF, LBUSHOFF, LCMASS, LCONM2, LCORD, LEDAT, LELE, LFORCE, LGRAV, LGRID, & LIND_GRDS_MPCS, LLOADC, LLOADR, LMATANGLE, LMATL, LMPC, LMPCADDC, LMPCADDR, LPBAR, LPBEAM,& @@ -46,7 +46,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) USE SCONTR, ONLY : NDOFG, NGRID, NMPC, NPCOMP, NPLOAD4_3D, NRBAR, NRBE1, NRBE2, NSPC, NTSUB, NUM_MPCSIDS, & NUM_SPCSIDS USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_MODEL_STUF_BEGEND USE MODEL_STUF, ONLY : AGRID, BE1, BE2, BE3, BGRID, DOFPIN, DT, ME, OFFDIS, OFFDIS_O, OFFDIS_B, OFFDIS_G, OFFSET,& KE, KEG, KED, KEM, PEB, PEG, PEL, PPE, PRESS, PTE, SE1, SE2, SE3, STE1, STE2, STE3, & @@ -92,7 +91,7 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NCOLS ! Number of cols allocated INTEGER(LONG) :: NROWS ! Number of rows allocated - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_MODEL_STUF_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -105,12 +104,7 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** RBYTE = REAL(BYTE) @@ -135,7 +129,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSETS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSETS, 1, SUBR_BEGEND ) DO I=1,LSETS SETS_IDS(I) = 0 ENDDO @@ -160,7 +153,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RBYTE*REAL(LEN(ALL_SETS_ARRAY))*REAL(LSETLN)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 1, LSETLN, SUBR_BEGEND ) DO I=1,LSETLN ALL_SETS_ARRAY(I)(1:) = ' ' ENDDO @@ -185,7 +177,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RBYTE*REAL(LEN(ONE_SET_ARRAY)*LSETLN)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 1, LSETLN, SUBR_BEGEND ) DO I=1,LSETLN ONE_SET_ARRAY(I)(1:) = ' ' ENDDO @@ -212,7 +203,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RBYTE*REAL(LEN(TITLE)*LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB TITLE(I)(1:) = ' ' ENDDO @@ -237,7 +227,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RBYTE*REAL(LEN(STITLE)*LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB STITLE(I)(1:) = ' ' ENDDO @@ -262,7 +251,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RBYTE*REAL(LEN(LABEL)*LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB LABEL(I)(1:) = ' ' ENDDO @@ -289,7 +277,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_ACCE = 0 ENDDO @@ -314,7 +301,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_DISP = 0 ENDDO @@ -339,7 +325,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_ELFE = 0 ENDDO @@ -364,7 +349,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_ELFN = 0 ENDDO @@ -389,7 +373,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_GPFO = 0 ENDDO @@ -414,7 +397,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_MPCF = 0 ENDDO @@ -439,7 +421,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_OLOA = 0 ENDDO @@ -464,7 +445,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_SPCF = 0 ENDDO @@ -489,7 +469,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_STRE = 0 ENDDO @@ -514,7 +493,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SC_STRN = 0 ENDDO @@ -541,7 +519,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SCNUM(I) = 0 ENDDO @@ -568,7 +545,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)*TWO/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 2, SUBR_BEGEND ) DO I=1,LSUB SUBLOD(I,1) = 0 SUBLOD(I,2) = 0 @@ -595,7 +571,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB SPCSETS(I) = 0 ENDDO @@ -619,7 +594,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB MPCSETS(I) = 0 ENDDO @@ -646,7 +620,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSEQ)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSEQ, 1, SUBR_BEGEND ) DO I=1,LSEQ SEQ1(I) = 0 ENDDO @@ -671,7 +644,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSEQ)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSEQ, 1, SUBR_BEGEND ) DO I=1,LSEQ SEQ2(I) = 0 ENDDO @@ -698,7 +670,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LFORCE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LFORCE, 1, SUBR_BEGEND ) DO I=1,LFORCE FORMOM_SIDS(I) = 0 ENDDO @@ -725,7 +696,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPLOAD)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPLOAD, 1, SUBR_BEGEND ) DO I=1,LPLOAD PRESS_SIDS(I) = 0 ENDDO @@ -752,7 +722,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LGRAV)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRAV, 1, SUBR_BEGEND ) DO I=1,LGRAV GRAV_SIDS(I) = 0 ENDDO @@ -779,7 +748,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LLOADR)*REAL(LLOADC)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LLOADR, LLOADC, SUBR_BEGEND ) DO I=1,LLOADR DO J=1,LLOADC LOAD_SIDS(I,J) = 0 @@ -806,7 +774,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LLOADR)*REAL(LLOADC)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LLOADR, LLOADC, SUBR_BEGEND ) DO I=1,LLOADR DO J=1,LLOADC LOAD_FACS(I,J) = ZERO @@ -835,7 +802,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LMPC)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LMPC, 1, SUBR_BEGEND ) DO I=1,LMPC MPC_SIDS(I) = 0 ENDDO @@ -862,7 +828,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NUM_MPCSIDS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NUM_MPCSIDS, 1, SUBR_BEGEND ) DO I=1,NUM_MPCSIDS MPCSIDS(I) = 0 ENDDO @@ -889,7 +854,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LMPCADDR)*REAL(LMPCADDC)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LMPCADDR, LMPCADDC, SUBR_BEGEND ) DO I=1,LMPCADDR DO J=1,LMPCADDC MPCADD_SIDS(I,J) = 0 @@ -918,7 +882,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LRFORCE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LRFORCE, 1, SUBR_BEGEND ) DO I=1,LRFORCE RFORCE_SIDS(I) = 0 ENDDO @@ -945,7 +908,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSLOAD)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSLOAD, 1, SUBR_BEGEND ) DO I=1,LSLOAD SLOAD_SIDS(I) = 0 ENDDO @@ -972,7 +934,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSPC)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSPC, 1, SUBR_BEGEND ) DO I=1,LSPC SPC_SIDS(I) = 0 ENDDO @@ -997,7 +958,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSPC1)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSPC1, 1, SUBR_BEGEND ) DO I=1,LSPC1 SPC1_SIDS(I) = 0 ENDDO @@ -1024,7 +984,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NUM_SPCSIDS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NUM_SPCSIDS, 1, SUBR_BEGEND ) DO I=1,NUM_SPCSIDS SPCSIDS(I) = 0 ENDDO @@ -1051,7 +1010,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSPCADDR)*REAL(LSPCADDC)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSPCADDR, LSPCADDC, SUBR_BEGEND ) DO I=1,LSPCADDR DO J=1,LSPCADDC SPCADD_SIDS(I,J) = 0 @@ -1080,7 +1038,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RBYTE*REAL(LEN(ETYPE))*REAL(LELE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, 1, SUBR_BEGEND ) DO I=1,LELE ETYPE(I)(1:) = ' ' ENDDO @@ -1105,7 +1062,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LEDAT)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LEDAT, 1, SUBR_BEGEND ) DO I=1,LEDAT EDAT(I) = 0 ENDDO @@ -1130,7 +1086,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL((LELE+1))/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE+1, 1, SUBR_BEGEND ) DO I=1,LELE+1 EPNT(I) = 0 ENDDO @@ -1157,7 +1112,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LELE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, 1, SUBR_BEGEND ) DO I=1,LELE EOFF(I) = 'N' ENDDO @@ -1184,7 +1138,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LMATL)*REAL(MMATL)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LMATL, MMATL, SUBR_BEGEND ) DO I=1,LMATL DO J=1,MMATL MATL(I,J) = 0 @@ -1211,7 +1164,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LMATL)*REAL(MRMATLC)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LMATL, MRMATLC, SUBR_BEGEND ) DO I=1,LMATL DO J=1,MRMATLC RMATL(I,J) = ZERO @@ -1238,7 +1190,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPBAR)*REAL(MPBAR)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPBAR, MPBAR, SUBR_BEGEND ) DO I=1,LPBAR DO J=1,MPBAR PBAR(I,J) = 0 @@ -1265,7 +1216,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPBAR)*REAL(MRPBAR)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPBAR, MRPBAR, SUBR_BEGEND ) DO I=1,LPBAR DO J=1,MRPBAR RPBAR(I,J) = ZERO @@ -1292,7 +1242,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPBEAM)*REAL(MPBEAM)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPBEAM, MPBEAM, SUBR_BEGEND ) DO I=1,LPBEAM DO J=1,MPBEAM PBEAM(I,J) = 0 @@ -1319,7 +1268,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPBEAM)*REAL(MRPBEAM)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPBEAM, MRPBEAM, SUBR_BEGEND ) DO I=1,LPBEAM DO J=1,MRPBEAM RPBEAM(I,J) = ZERO @@ -1346,7 +1294,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPBUSH)*REAL(MPBUSH)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPBUSH, MPBUSH, SUBR_BEGEND ) DO I=1,LPBUSH DO J=1,MPBUSH PBUSH(I,J) = 0 @@ -1373,7 +1320,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPBUSH)*REAL(MRPBUSH)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPBUSH, MRPBUSH, SUBR_BEGEND ) DO I=1,LPBUSH DO J=1,MRPBUSH RPBUSH(I,J) = ZERO @@ -1400,7 +1346,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPCOMP)*REAL(MPCOMP0+MPCOMP_PLIES*LPCOMP_PLIES)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPCOMP, MPCOMP0+MPCOMP_PLIES*LPCOMP_PLIES, SUBR_BEGEND ) DO I=1,LPCOMP DO J=1,MPCOMP0+MPCOMP_PLIES*LPCOMP_PLIES PCOMP(I,J) = 0 @@ -1427,7 +1372,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPCOMP)*REAL(MRPCOMP0+MRPCOMP_PLIES*LPCOMP_PLIES)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPCOMP, MRPCOMP0+MRPCOMP_PLIES*LPCOMP_PLIES, SUBR_BEGEND ) DO I=1,LPCOMP DO J=1,MRPCOMP0+MRPCOMP_PLIES*LPCOMP_PLIES RPCOMP(I,J) = ZERO @@ -1454,7 +1398,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPELAS)*REAL(MPELAS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPELAS, MPELAS, SUBR_BEGEND ) DO I=1,LPELAS DO J=1,MPELAS PELAS(I,J) = 0 @@ -1481,7 +1424,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPELAS)*REAL(MRPELAS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPELAS, MRPELAS, SUBR_BEGEND ) DO I=1,LPELAS DO J=1,MRPELAS RPELAS(I,J) = ZERO @@ -1508,7 +1450,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPROD)*REAL(MPROD)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPROD, MPROD, SUBR_BEGEND ) DO I=1,LPROD DO J=1,MPROD PROD(I,J) = 0 @@ -1535,7 +1476,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPROD)*REAL(MRPROD)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPROD, MRPROD, SUBR_BEGEND ) DO I=1,LPROD DO J=1,MRPROD RPROD(I,J) = ZERO @@ -1562,7 +1502,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPSHEAR)*REAL(MPSHEAR)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPSHEAR, MPSHEAR, SUBR_BEGEND ) DO I=1,LPSHEAR DO J=1,MPSHEAR PSHEAR(I,J) = 0 @@ -1589,7 +1528,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPSHEAR)*REAL(MRPSHEAR)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPSHEAR, MRPSHEAR, SUBR_BEGEND ) DO I=1,LPSHEAR DO J=1,MRPSHEAR RPSHEAR(I,J) = ZERO @@ -1616,7 +1554,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPSHEL)*REAL(MPSHEL)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPSHEL, MPSHEL, SUBR_BEGEND ) DO I=1,LPSHEL DO J=1,MPSHEL PSHEL(I,J) = 0 @@ -1643,7 +1580,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPSHEL)*REAL(MRPSHEL)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPSHEL, MRPSHEL, SUBR_BEGEND ) DO I=1,LPSHEL DO J=1,MRPSHEL RPSHEL(I,J) = ZERO @@ -1670,7 +1606,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPSOLID)*REAL(MPSOLID)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPSOLID, MPSOLID, SUBR_BEGEND ) DO I=1,LPSOLID DO J=1,MPSOLID PSOLID(I,J) = 0 @@ -1697,7 +1632,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPUSER1)*REAL(MPUSER1)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPUSER1, MPUSER1, SUBR_BEGEND ) DO I=1,LPUSER1 DO J=1,MPUSER1 PUSER1(I,J) = 0 @@ -1724,7 +1658,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPUSER1)*REAL(MRPUSER1)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPUSER1, MRPUSER1, SUBR_BEGEND ) DO I=1,LPUSER1 DO J=1,MRPUSER1 RPUSER1(I,J) = ZERO @@ -1751,7 +1684,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPUSERIN)*REAL(MPUSERIN)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPUSERIN, MPUSERIN, SUBR_BEGEND ) DO I=1,LPUSERIN DO J=1,MPUSERIN PUSERIN(I,J) = 0 @@ -1778,7 +1710,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPUSERIN)*REAL(MUSERIN_MAT_NAMES)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPUSERIN, MUSERIN_MAT_NAMES, SUBR_BEGEND ) DO I=1,LPUSERIN DO J=1,MUSERIN_MAT_NAMES USERIN_MAT_NAMES(I,J)(1:) = ' ' @@ -1807,7 +1738,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(USERIN_NUM_ACT_GRDS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, USERIN_NUM_ACT_GRDS, 1, SUBR_BEGEND ) DO I=1,USERIN_NUM_ACT_GRDS USERIN_ACT_GRIDS(I) = 0 ENDDO @@ -1832,7 +1762,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(USERIN_NUM_ACT_GRDS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, USERIN_NUM_ACT_GRDS, 1, SUBR_BEGEND ) DO I=1,USERIN_NUM_ACT_GRDS USERIN_ACT_COMPS(I) = 0 ENDDO @@ -1859,7 +1788,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LVVEC)*THREE/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LVVEC, 3, SUBR_BEGEND ) DO I=1,LVVEC DO J=1,3 VVEC(I,J) = ZERO @@ -1886,7 +1814,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LBAROFF)*SIX/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LBAROFF, 6, SUBR_BEGEND ) DO I=1,LBAROFF DO J=1,6 BAROFF(I,J) = ZERO @@ -1913,7 +1840,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LBUSHOFF)*SIX/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LBUSHOFF, 6, SUBR_BEGEND ) DO I=1,LBUSHOFF DO J=1,6 BUSHOFF(I,J) = ZERO @@ -1940,7 +1866,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPLATEOFF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPLATEOFF, 1, SUBR_BEGEND ) DO I=1,LPLATEOFF PLATEOFF(I) = ZERO ENDDO @@ -1965,7 +1890,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPLATETHICK)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPLATETHICK, 1, SUBR_BEGEND ) DO I=1,LPLATETHICK PLATETHICK(I) = ZERO ENDDO @@ -1990,7 +1914,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LMATANGLE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LMATANGLE, 1, SUBR_BEGEND ) DO I=1,LMATANGLE MATANGLE(I) = ZERO ENDDO @@ -2017,7 +1940,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LGRID)*REAL(MGRID)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRID, MGRID, SUBR_BEGEND ) DO I=1,LGRID DO J=1,MGRID GRID(I,J) = 0 @@ -2044,7 +1966,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LGRID)*REAL(MRGRID)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRID, MRGRID, SUBR_BEGEND ) DO I=1,LGRID DO J=1,MRGRID RGRID(I,J) = ZERO @@ -2073,7 +1994,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LCORD)*REAL(MCORD)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LCORD, MCORD, SUBR_BEGEND ) DO I=1,LCORD DO J=1,MCORD CORD(I,J) = 0 @@ -2100,7 +2020,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LCORD)*REAL(MRCORD)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LCORD, MRCORD, SUBR_BEGEND ) DO I=1,LCORD DO J=1,MRCORD RCORD(I,J) = ZERO @@ -2129,7 +2048,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LCMASS)*REAL(MCMASS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LCMASS, MCMASS, SUBR_BEGEND ) DO I=1,LCMASS DO J=1,MCMASS CMASS(I,J) = 0 @@ -2156,7 +2074,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LPMASS)*REAL(MPMASS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPMASS, MPMASS, SUBR_BEGEND ) DO I=1,LPMASS DO J=1,MPMASS PMASS(I,J) = 0 @@ -2183,7 +2100,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LCMASS)*REAL(MRPMASS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LCMASS, MRPMASS, SUBR_BEGEND ) DO I=1,LPMASS DO J=1,MRPMASS RPMASS(I,J) = ZERO @@ -2212,7 +2128,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LCONM2)*REAL(MCONM2)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LCONM2, MCONM2, SUBR_BEGEND ) DO I=1,LCONM2 DO J=1,MCONM2 CONM2(I,J) = 0 @@ -2239,7 +2154,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LCONM2)*REAL(MRCONM2)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LCONM2, MRCONM2, SUBR_BEGEND ) DO I=1,LCONM2 DO J=1,MRCONM2 RCONM2(I,J) = ZERO @@ -2268,7 +2182,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LELE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, 1, SUBR_BEGEND ) DO I=1,LELE ESORT1(I) = 0 ENDDO @@ -2295,7 +2208,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LELE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, 1, SUBR_BEGEND ) DO I=1,LELE ESORT2(I) = 0 ENDDO @@ -2322,7 +2234,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LGRID)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRID, 1, SUBR_BEGEND ) DO I=1,LGRID GRID_ID(I) = 0 ENDDO @@ -2349,7 +2260,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LGRID)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRID, 1, SUBR_BEGEND ) DO I=1,LGRID GRID_SEQ(I) = 0 ENDDO @@ -2374,7 +2284,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LGRID)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRID, 1, SUBR_BEGEND ) DO I=1,LGRID INV_GRID_SEQ(I) = 0 ENDDO @@ -2402,7 +2311,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSNORM)*REAL(MSNORM)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSNORM, MSNORM, SUBR_BEGEND ) DO I=1,LSNORM DO J=1,MSNORM SNORM(I,J) = 0 @@ -2429,7 +2337,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LSNORM)*REAL(MRSNORM)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSNORM, MRSNORM, SUBR_BEGEND ) DO I=1,LSNORM DO J=1,MRSNORM RSNORM(I,J) = ZERO @@ -2458,7 +2365,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NGRID)*REAL(MGRID_SNORM)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NGRID, MGRID_SNORM, SUBR_BEGEND ) DO I=1,NGRID DO J=1,MGRID_SNORM GRID_SNORM(I,J) = ZERO @@ -2487,7 +2393,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*THREE*THREE*REAL(LCORD)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, 3*LCORD, SUBR_BEGEND ) DO I=1,3 DO J=1,3 DO K=1,LCORD @@ -2518,7 +2423,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB OGROUT(I) = 0 ENDDO @@ -2543,7 +2447,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LGRID)*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRID, LSUB, SUBR_BEGEND ) DO I=1,LGRID DO J=1,LSUB GROUT(I,J) = 0 @@ -2570,7 +2473,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LSUB, 1, SUBR_BEGEND ) DO I=1,LSUB OELOUT(I) = 0 ENDDO @@ -2595,7 +2497,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LELE)*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, LSUB, SUBR_BEGEND ) DO I=1,LELE DO J=1,LSUB ELOUT(I,J) = 0 @@ -2624,7 +2525,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LELE)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, 1, SUBR_BEGEND ) DO I=1,LELE ELDT(I) = 0 ENDDO @@ -2651,7 +2551,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(NDOFG)*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NDOFG, LSUB, SUBR_BEGEND ) DO I=1,NDOFG DO J=1,LSUB SYS_LOAD(I,J) = ZERO @@ -2680,7 +2579,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LGRID)*REAL(NTSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRID, NTSUB, SUBR_BEGEND ) DO I=1,LGRID DO J=1,NTSUB GTEMP(I,J) = GTEMP_INIT @@ -2709,7 +2607,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RBYTE*REAL(LEN(CGTEMP))*REAL(LGRID)*REAL(NTSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LGRID, NTSUB, SUBR_BEGEND ) DO I=1,LGRID DO J=1,NTSUB CGTEMP(I,J) = CGTEMP_ERR @@ -2738,7 +2635,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LELE)*REAL(NTSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, NTSUB, SUBR_BEGEND ) DO I=1,LELE DO J=1,NTSUB ETEMP(I,J) = ETEMP_INIT @@ -2767,7 +2663,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RBYTE*REAL(LEN(CETEMP))*REAL(LELE)*REAL(NTSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, NTSUB, SUBR_BEGEND ) DO I=1,LELE DO J=1,NTSUB CETEMP(I,J) = CETEMP_ERR @@ -2796,7 +2691,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LELE)*REAL(NTSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, NTSUB, SUBR_BEGEND ) DO I=1,LELE DO J=1,NTSUB TPNT(I,J) = 0 @@ -2823,7 +2717,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LTDAT)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LTDAT, 1, SUBR_BEGEND ) DO I=1,LTDAT TDATA(I) = ZERO ENDDO @@ -2850,7 +2743,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LELE)*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LELE, LSUB, SUBR_BEGEND ) DO I=1,LELE DO J=1,LSUB PPNT(I,J) = 0 @@ -2877,7 +2769,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(LPDAT)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPDAT, 1, SUBR_BEGEND ) DO I=1,LPDAT PDATA(I) = ZERO ENDDO @@ -2902,7 +2793,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = REAL(BYTE)*REAL(LPDAT)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPDAT, 1, SUBR_BEGEND ) DO I=1,LELE PTYPE(I) = ' ' ENDDO @@ -2929,7 +2819,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NPLOAD4_3D)*REAL(MPLOAD4_3D_DATA)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LPDAT, 1, SUBR_BEGEND ) DO I=1,NPLOAD4_3D DO J=1,MPLOAD4_3D_DATA PLOAD4_3D_DATA(I,J) = 0 @@ -2958,7 +2847,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELGP+1)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELGP+1, 1, SUBR_BEGEND ) DO I=1,MELGP+1 AGRID(I) = 0 ENDDO @@ -2983,7 +2871,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(3)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, MELDOF*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,MELDOF DO K=1,MAX_STRESS_POINTS+1 @@ -3012,7 +2899,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(3)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, MELDOF*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,MELDOF DO K=1,MAX_STRESS_POINTS+1 @@ -3041,7 +2927,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(3)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, MELDOF*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,MELDOF DO K=1,MAX_STRESS_POINTS+1 @@ -3070,7 +2955,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELGP+1)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELGP+1, 1, SUBR_BEGEND ) DO I=1,MELGP+1 BGRID(I) = 0 ENDDO @@ -3095,7 +2979,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, 1, SUBR_BEGEND ) DO I=1,MELDOF DOFPIN(I) = 0 ENDDO @@ -3120,7 +3003,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MDT)*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MDT, LSUB, SUBR_BEGEND ) DO I=1,MDT DO J=1,LSUB DT(I,J) = ZERO @@ -3147,7 +3029,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELDOF)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, MELDOF, SUBR_BEGEND ) DO I=1,MELDOF DO J=1,MELDOF KE(I,J) = ZERO @@ -3174,7 +3055,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELDOF)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, MELDOF, SUBR_BEGEND ) DO I=1,MELDOF DO J=1,MELDOF KEG(I,J) = ZERO @@ -3201,7 +3081,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELDOF)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, MELDOF, SUBR_BEGEND ) DO I=1,MELDOF DO J=1,MELDOF KED(I,J) = ZERO @@ -3228,7 +3107,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELDOF)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, MELDOF, SUBR_BEGEND ) DO I=1,MELDOF DO J=1,MELDOF KEM(I,J) = ZERO @@ -3255,7 +3133,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELDOF)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, MELDOF, SUBR_BEGEND ) DO I=1,MELDOF DO J=1,MELDOF ME(I,J) = ZERO @@ -3282,7 +3159,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MOFFSET)*REAL(3)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MOFFSET, 3, SUBR_BEGEND ) DO I=1,MOFFSET DO J=1,3 OFFDIS(I,J) = ZERO @@ -3309,7 +3185,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MOFFSET)*REAL(3)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MOFFSET, 3, SUBR_BEGEND ) DO I=1,MOFFSET DO J=1,3 OFFDIS_O(I,J) = ZERO @@ -3336,7 +3211,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MOFFSET)*REAL(3)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MOFFSET, 3, SUBR_BEGEND ) DO I=1,MOFFSET DO J=1,3 OFFDIS_B(I,J) = ZERO @@ -3363,7 +3237,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MOFFSET)*REAL(3)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MOFFSET, 3, SUBR_BEGEND ) DO I=1,MOFFSET DO J=1,3 OFFDIS_G(I,J) = ZERO @@ -3390,7 +3263,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MOFFSET)*REAL(3)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MOFFSET, 1, SUBR_BEGEND ) DO I=1,MOFFSET OFFSET(I)(1:) = 'N' ENDDO @@ -3415,7 +3287,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, 1, SUBR_BEGEND ) DO I=1,MELDOF PEB(I) = 0 ENDDO @@ -3440,7 +3311,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, 1, SUBR_BEGEND ) DO I=1,MELDOF PEG(I) = 0 ENDDO @@ -3465,7 +3335,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, 1, SUBR_BEGEND ) DO I=1,MELDOF PEL(I) = 0 ENDDO @@ -3490,7 +3359,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELDOF)*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, LSUB, SUBR_BEGEND ) DO I=1,MELDOF DO J=1,LSUB PPE(I,J) = ZERO @@ -3517,7 +3385,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MPRESS)*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MPRESS, LSUB, SUBR_BEGEND ) DO I=1,MPRESS DO J=1,LSUB PRESS(I,J) = ZERO @@ -3544,7 +3411,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELDOF)*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, LSUB, SUBR_BEGEND ) DO I=1,MELDOF DO J=1,LSUB PTE(I,J) = ZERO @@ -3571,7 +3437,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(3)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, MELDOF*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,MELDOF DO K=1,MAX_STRESS_POINTS+1 @@ -3600,7 +3465,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(3)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, MELDOF*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,MELDOF DO K=1,MAX_STRESS_POINTS+1 @@ -3629,7 +3493,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(3)*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, MELDOF*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,MELDOF DO K=1,MAX_STRESS_POINTS+1 @@ -3658,7 +3521,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*THREE*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, LSUB*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,LSUB DO K=1,MAX_STRESS_POINTS+1 @@ -3687,7 +3549,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*THREE*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, LSUB*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,LSUB DO K=1,MAX_STRESS_POINTS+1 @@ -3716,7 +3577,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*THREE*REAL(LSUB)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, 3, LSUB*MAX_STRESS_POINTS+1, SUBR_BEGEND ) DO I=1,3 DO J=1,LSUB DO K=1,MAX_STRESS_POINTS+1 @@ -3745,7 +3605,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, 1, SUBR_BEGEND ) DO I=1,MELDOF UEB(I) = 0 ENDDO @@ -3770,7 +3629,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, 1, SUBR_BEGEND ) DO I=1,MELDOF UEG(I) = 0 ENDDO @@ -3795,7 +3653,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, 1, SUBR_BEGEND ) DO I=1,MELDOF UEL(I) = 0 ENDDO @@ -3820,7 +3677,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(MELDOF)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELDOF, 1, SUBR_BEGEND ) DO I=1,MELDOF UGG(I) = 0 ENDDO @@ -3845,7 +3701,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELGP+1)*REAL(3)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELGP+1, 3, SUBR_BEGEND ) DO I=1,MELGP+1 DO J=1,3 XEB(I,J) = ZERO @@ -3872,7 +3727,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELGP)*REAL(3)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MELGP, 3, SUBR_BEGEND ) DO I=1,MELGP DO J=1,3 XEL(I,J) = ZERO @@ -3899,7 +3753,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RDOUBLE*REAL(MELGP)*REAL(3)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, MAX_GAUSS_POINTS*MAX_GAUSS_POINTS, 3, SUBR_BEGEND ) DO I=1,MAX_GAUSS_POINTS DO J=1,2 XGL(I,J) = ZERO @@ -3928,7 +3781,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LRIGEL)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LRIGEL, 1, SUBR_BEGEND ) DO I=1,LRIGEL RIGID_ELEM_IDS(I) = 0 ENDDO @@ -3955,7 +3807,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(LIND_GRDS_MPCS)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, LIND_GRDS_MPCS, 1, SUBR_BEGEND ) DO I=1,LIND_GRDS_MPCS MPC_IND_GRIDS(I) = 0 ENDDO @@ -3982,7 +3833,6 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) MB_ALLOCATED = RLONG*REAL(NGRID)*REAL(MAX_ELEM_DEGREE+2)/ONEPP6 IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'ALLOC', MB_ALLOCATED, NGRID, MAX_ELEM_DEGREE+2, SUBR_BEGEND ) DO I=1,NGRID DO J=1,MAX_ELEM_DEGREE+2 GRID_ELEM_CONN_ARRAY(I,J) = 0 @@ -4013,12 +3863,7 @@ SUBROUTINE ALLOCATE_MODEL_STUF ( NAME_IN, CALLING_SUBR ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME, TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/ALLOCATE_NL_PARAMS.f90 b/Source/UTIL/ALLOCATE_NL_PARAMS.f90 index 5e55f2a5..bdccaf40 100644 --- a/Source/UTIL/ALLOCATE_NL_PARAMS.f90 +++ b/Source/UTIL/ALLOCATE_NL_PARAMS.f90 @@ -29,13 +29,12 @@ SUBROUTINE ALLOCATE_NL_PARAMS ( CALLING_SUBR ) ! Allocate arrays for nonlinear params USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LSUB, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE DEBUG_PARAMETERS, ONLY : DEBUG USE NONLINEAR_PARAMS, ONLY : NL_SID - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_NL_PARAMS_BEGEND USE ALLOCATE_NL_PARAMS_USE_IFs @@ -44,14 +43,13 @@ SUBROUTINE ALLOCATE_NL_PARAMS ( CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_NL_PARAMS' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows in array INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_NL_PARAMS_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -61,12 +59,7 @@ SUBROUTINE ALLOCATE_NL_PARAMS ( CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Allocate array NL_SID @@ -107,16 +100,6 @@ SUBROUTINE ALLOCATE_NL_PARAMS ( CALLING_SUBR ) MB_ALLOCATED = REAL(LONG)*REAL(NROWS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -129,9 +112,6 @@ SUBROUTINE ALLOCATE_NL_PARAMS ( CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/ALLOCATE_RBGLOBAL.f90 b/Source/UTIL/ALLOCATE_RBGLOBAL.f90 index d2601e9b..6cfe1465 100644 --- a/Source/UTIL/ALLOCATE_RBGLOBAL.f90 +++ b/Source/UTIL/ALLOCATE_RBGLOBAL.f90 @@ -31,11 +31,10 @@ SUBROUTINE ALLOCATE_RBGLOBAL ( SET, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : NDOFG, NDOFN, NDOFF, NDOFA, NDOFL, NDOFR, BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_RBGLOBAL_BEGEND USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_NSET, RBGLOBAL_FSET, RBGLOBAL_ASET, RBGLOBAL_LSET, & TR6_CG, TR6_MEFM, TR6_0 @@ -47,14 +46,13 @@ SUBROUTINE ALLOCATE_RBGLOBAL ( SET, CALLING_SUBR ) CHARACTER(LEN=*), INTENT(IN) :: SET ! Set name of the displ matrix CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(14*BYTE) :: NAME ! Specific array name used for output error message - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows in array INTEGER(LONG), PARAMETER :: NCOLS = 6 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_RBGLOBAL_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -64,12 +62,7 @@ SUBROUTINE ALLOCATE_RBGLOBAL ( SET, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = ZERO @@ -292,16 +285,6 @@ SUBROUTINE ALLOCATE_RBGLOBAL ( SET, CALLING_SUBR ) MB_ALLOCATED = REAL(DOUBLE)*REAL(NROWS)*REAL(NCOLS)/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -317,10 +300,6 @@ SUBROUTINE ALLOCATE_RBGLOBAL ( SET, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE ALLOCATE_RBGLOBAL diff --git a/Source/UTIL/ALLOCATE_SCR_CCS_MAT.f90 b/Source/UTIL/ALLOCATE_SCR_CCS_MAT.f90 index 5247cc74..7099a2df 100644 --- a/Source/UTIL/ALLOCATE_SCR_CCS_MAT.f90 +++ b/Source/UTIL/ALLOCATE_SCR_CCS_MAT.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_SCR_CCS_MAT ( NAME, NCOLS, NTERMS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_SCR_CCS_MAT_BEGEND USE SCRATCH_MATRICES , ONLY : I_CCS1, J_CCS1, CCS1, I_CCS2, J_CCS2, CCS2, I_CCS3, J_CCS3, CCS3 USE ALLOCATE_SCR_CCS_MAT_USE_IFs @@ -44,7 +43,6 @@ SUBROUTINE ALLOCATE_SCR_CCS_MAT ( NAME, NCOLS, NTERMS, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_SCR_CCS_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME CHARACTER(6*BYTE) :: NAMEO ! Array name (used for output error message) INTEGER(LONG), INTENT(IN) :: NCOLS ! Number of cols for matrix CCSi @@ -52,7 +50,7 @@ SUBROUTINE ALLOCATE_SCR_CCS_MAT ( NAME, NCOLS, NTERMS, CALLING_SUBR ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_SCR_CCS_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -62,12 +60,7 @@ SUBROUTINE ALLOCATE_SCR_CCS_MAT ( NAME, NCOLS, NTERMS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = ZERO @@ -283,16 +276,6 @@ SUBROUTINE ALLOCATE_SCR_CCS_MAT ( NAME, NCOLS, NTERMS, CALLING_SUBR ) MB_ALLOCATED = (REAL(LONG)*REAL(NCOLS + 1 + NTERMS) + REAL(DOUBLE)*REAL(NTERMS))/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NCOLS, NTERMS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NCOLS, NTERMS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -308,9 +291,6 @@ SUBROUTINE ALLOCATE_SCR_CCS_MAT ( NAME, NCOLS, NTERMS, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' col,',I12,' nonzero, T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' col,',I12,' nonzero, T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/ALLOCATE_SCR_CRS_MAT.f90 b/Source/UTIL/ALLOCATE_SCR_CRS_MAT.f90 index b1e45745..954dcaeb 100644 --- a/Source/UTIL/ALLOCATE_SCR_CRS_MAT.f90 +++ b/Source/UTIL/ALLOCATE_SCR_CRS_MAT.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_SCR_CRS_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_SCR_CRS_MAT_BEGEND USE SCRATCH_MATRICES , ONLY : I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CRS3, J_CRS3, CRS3 USE ALLOCATE_SCR_CRS_MAT_USE_IFs @@ -44,7 +43,6 @@ SUBROUTINE ALLOCATE_SCR_CRS_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_SCR_CRS_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME CHARACTER(6*BYTE) :: NAMEO ! Array name (used for output error message) INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows for matrix CRSi @@ -52,7 +50,7 @@ SUBROUTINE ALLOCATE_SCR_CRS_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_SCR_CRS_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -62,12 +60,7 @@ SUBROUTINE ALLOCATE_SCR_CRS_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = ZERO @@ -283,16 +276,6 @@ SUBROUTINE ALLOCATE_SCR_CRS_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) MB_ALLOCATED = (REAL(LONG)*REAL(NROWS + 1 + NTERMS) + REAL(DOUBLE)*REAL(NTERMS))/ONEPP6 CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NTERMS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NTERMS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -308,10 +291,6 @@ SUBROUTINE ALLOCATE_SCR_CRS_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' nonzero, T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' nonzero, T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE ALLOCATE_SCR_CRS_MAT diff --git a/Source/UTIL/ALLOCATE_SPARSE_ALG.f90 b/Source/UTIL/ALLOCATE_SPARSE_ALG.f90 index 2ffb54c8..6c0c1b8d 100644 --- a/Source/UTIL/ALLOCATE_SPARSE_ALG.f90 +++ b/Source/UTIL/ALLOCATE_SPARSE_ALG.f90 @@ -31,10 +31,9 @@ SUBROUTINE ALLOCATE_SPARSE_ALG ( NAME, NROW1, NROW2, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_SPARSE_ALG_BEGEND USE SPARSE_ALG_ARRAYS, ONLY : ALG, AROW, J_AROW, LOGICAL_VEC, REAL_VEC USE ALLOCATE_SPARSE_ALG_USE_IFs @@ -44,7 +43,6 @@ SUBROUTINE ALLOCATE_SPARSE_ALG ( NAME, NROW1, NROW2, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_SPARSE_ALG' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG), INTENT(IN) :: NROW1 ! Number of rows, or starting row num, to allocate to matrix NAME INTEGER(LONG), INTENT(IN) :: NROW2 ! End row number in allocation @@ -53,7 +51,7 @@ SUBROUTINE ALLOCATE_SPARSE_ALG ( NAME, NROW1, NROW2, CALLING_SUBR ) INTEGER(LONG) :: JERR ! Local error indicator INTEGER(LONG) :: NROWS ! Number of rows in array INTEGER(LONG), PARAMETER :: NCOLS = 1 ! Number of cols in array - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_SPARSE_ALG_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -63,12 +61,7 @@ SUBROUTINE ALLOCATE_SPARSE_ALG ( NAME, NROW1, NROW2, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = ZERO @@ -210,16 +203,6 @@ SUBROUTINE ALLOCATE_SPARSE_ALG ( NAME, NROW1, NROW2, CALLING_SUBR ) TOT_MB_MEM_ALLOC = TOT_MB_MEM_ALLOC + MB_ALLOCATED CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -235,9 +218,6 @@ SUBROUTINE ALLOCATE_SPARSE_ALG ( NAME, NROW1, NROW2, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ERRORS WERE FOUND (',A,') WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/ALLOCATE_SPARSE_MAT.f90 b/Source/UTIL/ALLOCATE_SPARSE_MAT.f90 index b292cf47..8fd2727d 100644 --- a/Source/UTIL/ALLOCATE_SPARSE_MAT.f90 +++ b/Source/UTIL/ALLOCATE_SPARSE_MAT.f90 @@ -30,11 +30,10 @@ SUBROUTINE ALLOCATE_SPARSE_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONEPP6 - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFM, NDOFO, NDOFS, NDOFR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : ALLOCATE_SPARSE_MAT_BEGEND USE SPARSE_MATRICES , ONLY : I_KGG , J_KGG , KGG , I_MGG , J_MGG , MGG , I_PG , J_PG , PG , & I_KGGD , J_KGGD , KGGD , & @@ -91,7 +90,6 @@ SUBROUTINE ALLOCATE_SPARSE_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ALLOCATE_SPARSE_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME CHARACTER(6*BYTE) :: NAME1 ! Array name (used for output error message) CHARACTER(6*BYTE) :: NAME2 ! Array name (used for output error message) @@ -100,7 +98,7 @@ SUBROUTINE ALLOCATE_SPARSE_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ALLOCATE_SPARSE_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array @@ -110,12 +108,7 @@ SUBROUTINE ALLOCATE_SPARSE_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) INTRINSIC :: REAL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MB_ALLOCATED = (REAL(LONG)*REAL(NROWS + 1 + NTERMS) + REAL(DOUBLE)*REAL(NTERMS))/ONEPP6 @@ -7041,16 +7034,6 @@ SUBROUTINE ALLOCATE_SPARSE_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, MB_ALLOCATED, 'ALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NTERMS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) SUBR_NAME, TSEC, MB_ALLOCATED, NAMEL, NROWS, NTERMS, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -7067,9 +7050,6 @@ SUBROUTINE ALLOCATE_SPARSE_MAT ( NAME, NROWS, NTERMS, CALLING_SUBR ) 1699 FORMAT(' THE SUBR IN WHICH THESE ALLOCATION ERRORS WERE FOUND (',A,')' & ,/,14X,' WAS CALLED BY SUBR ',A) - 9002 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',I12,' row,',I12,' nonzero, T:',F10.3) - - 9004 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',I12,' row,',I12,' nonzero, T:',F13.6) 12345 FORMAT(7X,'Equate ',A5,' with ',I8,' rows ',A) diff --git a/Source/UTIL/ARRAY_SIZE_ERROR_1.f90 b/Source/UTIL/ARRAY_SIZE_ERROR_1.f90 index 73fa1be1..7b814cb5 100644 --- a/Source/UTIL/ARRAY_SIZE_ERROR_1.f90 +++ b/Source/UTIL/ARRAY_SIZE_ERROR_1.f90 @@ -29,10 +29,9 @@ SUBROUTINE ARRAY_SIZE_ERROR_1 ( INP_SUBR_NAME, NTERM_VAL, MATIN_NAME ) ! Print error and quit when a subr tries to exceed allocated number of terms when storing/retrieving terms in an array USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ARRAY_SIZE_ERROR_1_BEGEND USE ARRAY_SIZE_ERROR_1_USE_IFs @@ -43,14 +42,9 @@ SUBROUTINE ARRAY_SIZE_ERROR_1 ( INP_SUBR_NAME, NTERM_VAL, MATIN_NAME ) CHARACTER(LEN=*), INTENT(IN) :: MATIN_NAME ! Name of matrix (for output message purposes) INTEGER(LONG), INTENT(IN) :: NTERM_VAL ! Size of the array that was exceeded - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ARRAY_SIZE_ERROR_1_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** WRITE(ERR,937) INP_SUBR_NAME, NTERM_VAL, MATIN_NAME @@ -58,12 +52,7 @@ SUBROUTINE ARRAY_SIZE_ERROR_1 ( INP_SUBR_NAME, NTERM_VAL, MATIN_NAME ) FATAL_ERR = FATAL_ERR + 1 CALL OUTA_HERE ( 'Y' ) ! Coding error (attempt to exceed allocated array size), so quit -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/AUTOSPC_SUMMARY_MSGS.f90 b/Source/UTIL/AUTOSPC_SUMMARY_MSGS.f90 index e588ff71..53e34f40 100644 --- a/Source/UTIL/AUTOSPC_SUMMARY_MSGS.f90 +++ b/Source/UTIL/AUTOSPC_SUMMARY_MSGS.f90 @@ -29,7 +29,7 @@ SUBROUTINE AUTOSPC_SUMMARY_MSGS ( ASPC_SUM_MSG1, ASPC_SUM_MSG2, ASPC_SUM_MSG3, W ! Write summary of AUTOSPC action at several times in an execution USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE PARAMS, ONLY : AUTOSPC_RAT USE AUTOSPC_SUMMARY_MSGS_USE_IFs ! Added 2019/07/14 diff --git a/Source/UTIL/BAILOUT_CHECK.f90 b/Source/UTIL/BAILOUT_CHECK.f90 index 77fd4bc3..f470dc83 100644 --- a/Source/UTIL/BAILOUT_CHECK.f90 +++ b/Source/UTIL/BAILOUT_CHECK.f90 @@ -34,13 +34,13 @@ FUNCTION BAILOUT_CHECK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, NTERMS, I_M ! Writes messages to F06 and ERR. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1 + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, LINKNO - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL, MAXRATIO USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM - + USE LINK_MESSAGE_Interface + IMPLICIT NONE LOGICAL :: BAILOUT_CHECK @@ -54,7 +54,6 @@ FUNCTION BAILOUT_CHECK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, NTERMS, I_M ! where the singularity occurs is referenced). If it is not a MYSTRAN ! set designator it should be blank CHARACTER(LEN=*) , INTENT(IN) :: PRT_ERRS ! If not 'N', print singularity errors - CHARACTER(54*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER( 1*BYTE) :: NONPOS_DEF ! Indicates matrix was nonpositive definite INTEGER(LONG), INTENT(IN) :: NROWS ! Number of rows in sparse matrix MATIN @@ -80,9 +79,7 @@ FUNCTION BAILOUT_CHECK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, NTERMS, I_M ! Calculate and print ratios of diag to factor diag (if they are zero or negative or > MAXRATIO). - CALL OURTIM - MODNAM = 'CALC MAX RATIO OF MATRIX DIAGONAL TO FACTOR DIAGONAL' - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC MAX RATIO OF MATRIX DIAGONAL TO FACTOR DIAGONAL') CALL COUNTER_INIT(" Getting diagonal of matrix, row", NROWS) DO I=1,NROWS ! First, get diagonal terms from MATIN @@ -173,8 +170,6 @@ FUNCTION BAILOUT_CHECK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, NTERMS, I_M 984 FORMAT(' *INFORMATION: THE MAXIMUM ABSOLUTE VALUE OF THE RATIO OF MATRIX DIAGONAL TO FACTOR DIAG FOR MATRIX ',A,' = ',1ES14.6) - 3092 FORMAT(1X,I2,'/',A54,8X,2X,I2,':',I2,':',I2,'.',I3) - 9811 FORMAT(' THIS IS FOR ROW AND COL IN THE MATRIX FOR GRID POINT ',I8,' COMP ',I3,'. THE CALLING SUBR WAS: ',A,/) 9812 FORMAT(' THIS IS FOR ROW AND COL ',I8,' IN THE MATRIX. THE CALLING SUBR WAS: ',A,/) diff --git a/Source/UTIL/BANDGEN_LAPACK_DGB.f90 b/Source/UTIL/BANDGEN_LAPACK_DGB.f90 index ded501ca..d23064cc 100644 --- a/Source/UTIL/BANDGEN_LAPACK_DGB.f90 +++ b/Source/UTIL/BANDGEN_LAPACK_DGB.f90 @@ -31,12 +31,11 @@ SUBROUTINE BANDGEN_LAPACK_DGB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN ! rows of MATOUT are not used in storing MATIN terms (they must be needed in the ARPACK algorithm for other purposes?) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SPARSTOR - USE SUBR_BEGEND_LEVELS, ONLY : BANDGEN_BEGEND USE BANDGEN_LAPACK_DGB_USE_IFs @@ -60,17 +59,12 @@ SUBROUTINE BANDGEN_LAPACK_DGB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN INTEGER(LONG) :: K ! Counter INTEGER(LONG) :: MATOUT_DIAG_ROW_NUM ! Number of the row, in mATOUT, where the diagonal of MATIN goes INTEGER(LONG) :: NUM_TERMS_ROW_I ! Number of terms in MATIN matrix in row I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BANDGEN_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM_MATIN) ! Array of terms in sparse matrix MATIN REAL(DOUBLE) , INTENT(INOUT) :: MATOUT(3*KD+1,N) ! Array of terms in band matrix MATOUT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -121,12 +115,7 @@ SUBROUTINE BANDGEN_LAPACK_DGB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN WRITE(SC1,*) CR13 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/BANDGEN_LAPACK_DPB.f90 b/Source/UTIL/BANDGEN_LAPACK_DPB.f90 index 3d13e98d..62892a63 100644 --- a/Source/UTIL/BANDGEN_LAPACK_DPB.f90 +++ b/Source/UTIL/BANDGEN_LAPACK_DPB.f90 @@ -30,12 +30,11 @@ SUBROUTINE BANDGEN_LAPACK_DPB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN ! (determined in subr BANDSIZ) and can be stored (upper triangle) in array MATOUT with KD+1 rows and N cols USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SPARSTOR - USE SUBR_BEGEND_LEVELS, ONLY : BANDGEN_BEGEND USE BANDGEN_LAPACK_DPB_USE_IFs @@ -58,17 +57,12 @@ SUBROUTINE BANDGEN_LAPACK_DPB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: K ! Counter INTEGER(LONG) :: NUM_TERMS_ROW_I ! Number of terms in MATIN matrix in row I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BANDGEN_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM_MATIN) ! Array of terms in sparse matrix MATIN REAL(DOUBLE) , INTENT(INOUT) :: MATOUT(KD+1,N) ! Array of terms in band matrix MATOUT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** !xx WRITE(SC1, * ) ! Advance 1 line for screen messages @@ -103,12 +97,7 @@ SUBROUTINE BANDGEN_LAPACK_DPB ( MATIN_NAME, N, KD, NTERM_MATIN, I_MATIN, J_MATIN ENDDO WRITE(SC1,*) CR13 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/BANDSIZ.f90 b/Source/UTIL/BANDSIZ.f90 index 4ed092d5..85dcb2b5 100644 --- a/Source/UTIL/BANDSIZ.f90 +++ b/Source/UTIL/BANDSIZ.f90 @@ -30,10 +30,9 @@ SUBROUTINE BANDSIZ ( N, NTERM_MATIN, I_MATIN, J_MATIN, KD ) ! LAPACK routines that will be used to decompose it. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : BANDSIZ_BEGEND USE BANDSIZ_USE_IFs @@ -52,14 +51,9 @@ SUBROUTINE BANDSIZ ( N, NTERM_MATIN, I_MATIN, J_MATIN, KD ) INTEGER(LONG) :: K ! Counter INTEGER(LONG) :: KD_TEMP ! Temporary value of in calculation of KD INTEGER(LONG) :: NUM_TERMS_ROW_I ! Number of terms in MATIN matrix in row I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = BANDSIZ_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -84,12 +78,7 @@ SUBROUTINE BANDSIZ ( N, NTERM_MATIN, I_MATIN, J_MATIN, KD ) ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/CALC_TDOF_ROW_START.f90 b/Source/UTIL/CALC_TDOF_ROW_START.f90 index 75c5fcb2..e407a80f 100644 --- a/Source/UTIL/CALC_TDOF_ROW_START.f90 +++ b/Source/UTIL/CALC_TDOF_ROW_START.f90 @@ -30,12 +30,11 @@ SUBROUTINE CALC_TDOF_ROW_START ( PRTDEB ) USE PENTIUM_II_KIND, ONLY : LONG USE SCONTR, ONLY : BLNK_SUB_NAM, NGRID - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOF_ROW_START USE DEBUG_PARAMETERS, ONLY : DEBUG USE MODEL_STUF, ONLY : GRID_ID - USE SUBR_BEGEND_LEVELS, ONLY : CALC_TDOF_ROW_START_BEGEND USE CALC_TDOF_ROW_START_USE_IFs @@ -46,14 +45,9 @@ SUBROUTINE CALC_TDOF_ROW_START ( PRTDEB ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: NUM_COMPS ! Number of displ components (1 for SPOINT, 6 for physical grid) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_TDOF_ROW_START_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** IF ((DEBUG(183) > 0) .AND. (PRTDEB == 'Y')) THEN @@ -62,7 +56,7 @@ SUBROUTINE CALC_TDOF_ROW_START ( PRTDEB ) TDOF_ROW_START(1) = 1 DO I=2,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I-1), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I-1, NUM_COMPS, SUBR_NAME ) TDOF_ROW_START(I) = TDOF_ROW_START(I-1) + NUM_COMPS ENDDO @@ -72,12 +66,7 @@ SUBROUTINE CALC_TDOF_ROW_START ( PRTDEB ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/CALC_VEC_SORT_ORDER.f90 b/Source/UTIL/CALC_VEC_SORT_ORDER.f90 index dec26b7d..ce9266e1 100644 --- a/Source/UTIL/CALC_VEC_SORT_ORDER.f90 +++ b/Source/UTIL/CALC_VEC_SORT_ORDER.f90 @@ -30,10 +30,8 @@ SUBROUTINE CALC_VEC_SORT_ORDER ( VEC, SORT_ORDER, SORT_INDICES ) ! actually sorted. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CALC_VEC_SORT_ORDER_BEGEND USE CALC_VEC_SORT_ORDER_USE_IFs @@ -44,16 +42,11 @@ SUBROUTINE CALC_VEC_SORT_ORDER ( VEC, SORT_ORDER, SORT_INDICES ) ! are satisfied, SORT_ORDER is returned as null INTEGER(LONG), INTENT(OUT) :: SORT_INDICES(3) ! Indices of VEC in the order from lowest value component to highest - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CALC_VEC_SORT_ORDER_BEGEND + REAL(DOUBLE), INTENT(IN) :: VEC(3) ! A 3 component vector -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** SORT_ORDER = ' ' @@ -100,12 +93,7 @@ SUBROUTINE CALC_VEC_SORT_ORDER ( VEC, SORT_ORDER, SORT_INDICES ) SORT_INDICES(3) = 1 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/CARD_FLDS_NOT_BLANK.f90 b/Source/UTIL/CARD_FLDS_NOT_BLANK.f90 index fae07454..d83be514 100644 --- a/Source/UTIL/CARD_FLDS_NOT_BLANK.f90 +++ b/Source/UTIL/CARD_FLDS_NOT_BLANK.f90 @@ -29,11 +29,10 @@ SUBROUTINE CARD_FLDS_NOT_BLANK ( JCARD, FLD2, FLD3, FLD4, FLD5, FLD6, FLD7, FLD8 ! Prepares message when some fields of a Bulk data card that should be blank, aren't USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, JCARD_LEN, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : CARD_FLDS_NOT_BLANK_BEGEND USE CARD_FLDS_NOT_BLANK_USE_IFs @@ -55,14 +54,9 @@ SUBROUTINE CARD_FLDS_NOT_BLANK ( JCARD, FLD2, FLD3, FLD4, FLD5, FLD6, FLD7, FLD8 INTEGER(LONG), INTENT(IN) :: FLD9 ! Refers to field 9 of a B.D. card. If /= 0, then check this field INTEGER(LONG) :: ALL_FLDS(2:9) ! Array of the FLDi (2 through 9) INTEGER(LONG) :: I,J ! Do loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CARD_FLDS_NOT_BLANK_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Set ALL_FLDS @@ -144,12 +138,7 @@ SUBROUTINE CARD_FLDS_NOT_BLANK ( JCARD, FLD2, FLD3, FLD4, FLD5, FLD6, FLD7, FLD8 ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/CLOSE_LIJFILES.f90 b/Source/UTIL/CLOSE_LIJFILES.f90 index ce9da281..e29b2918 100644 --- a/Source/UTIL/CLOSE_LIJFILES.f90 +++ b/Source/UTIL/CLOSE_LIJFILES.f90 @@ -30,7 +30,7 @@ SUBROUTINE CLOSE_LIJFILES ( CLOSE_STAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, RESTART - USE IOUNT1, ONLY : MOU4, WRT_ERR, WRT_LOG, ERR, F06, & + USE IOUNT1, ONLY : MOU4, WRT_ERR, ERR, F06, & L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, L1K, & L1L, L1M, L1N, L1O, L1P, L1Q, L1R, L1S, L1T, L1U, & L1V, L1W, L1X, L1Y, L1Z, & @@ -38,7 +38,7 @@ SUBROUTINE CLOSE_LIJFILES ( CLOSE_STAT ) L2K, L2L, L2M, L2N, L2O, L2P, L2Q, L2R, L2S, L2T, & L3A, L4A, L4B, L4C, L4D, L5A, L5B, OU4 - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, & + USE IOUNT1, ONLY : WRT_ERR, & LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, LINK1K, & LINK1L, LINK1M, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1R, LINK1S, LINK1T, LINK1U, & LINK1V, LINK1W, LINK1X, LINK1Y, LINK1Z, & @@ -46,7 +46,7 @@ SUBROUTINE CLOSE_LIJFILES ( CLOSE_STAT ) LINK2K, LINK2L, LINK2M, LINK2N, LINK2O, LINK2P, LINK2Q, LINK2R, LINK2S, LINK2T, & LINK3A, LINK4A, LINK4B, LINK4C, LINK4D, LINK5A, LINK5B, OU4FIL - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, & + USE IOUNT1, ONLY : WRT_ERR, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1JSTAT, L1KSTAT, & L1LSTAT, L1MSTAT, L1NSTAT, L1OSTAT, L1PSTAT, L1QSTAT, L1RSTAT, L1SSTAT, L1TSTAT, L1USTAT, & L1VSTAT, L1WSTAT, L1XSTAT, L1YSTAT, L1ZSTAT, & @@ -405,14 +405,14 @@ SUBROUTINE CLOSE_LIJFILES ( CLOSE_STAT ) INQUIRE(FILE=OU4FIL(I),EXIST=LEXIST,OPENED=LOPND) IF (LEXIST) THEN IF (LOPND) THEN - CALL FILE_CLOSE ( OU4(I), OU4FIL(I), OU4STAT(I), 'Y' ) + CALL FILE_CLOSE ( OU4(I), OU4FIL(I), OU4STAT(I) ) ELSE OPEN (OU4(I),FILE=OU4FIL(I),STATUS='OLD',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, OU4FIL(I), OUNT, 'Y' ) + CALL OPNERR ( IOCHK, OU4FIL(I), OUNT ) CALL OUTA_HERE ( 'Y' ) ELSE - CALL FILE_CLOSE ( OU4(I), OU4FIL(I), OU4STAT(I), 'Y' ) + CALL FILE_CLOSE ( OU4(I), OU4FIL(I), OU4STAT(I) ) ENDIF ENDIF ENDIF @@ -444,14 +444,14 @@ SUBROUTINE CLOSE_THIS_FILE ( UNT, FILNAM, STATUS ) INQUIRE(FILE=FILNAM,EXIST=LEXIST,OPENED=LOPND) IF (LEXIST) THEN IF (LOPND) THEN - CALL FILE_CLOSE ( UNT, FILNAM, STATUS, 'Y' ) + CALL FILE_CLOSE ( UNT, FILNAM, STATUS ) ELSE OPEN (UNT,FILE=FILNAM,STATUS='OLD',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR ( IOCHK, FILNAM, OUNT, 'Y' ) + CALL OPNERR ( IOCHK, FILNAM, OUNT ) CALL OUTA_HERE ( 'Y' ) ELSE - CALL FILE_CLOSE ( UNT, FILNAM, STATUS, 'Y' ) + CALL FILE_CLOSE ( UNT, FILNAM, STATUS ) ENDIF ENDIF ENDIF diff --git a/Source/UTIL/CLOSE_OUTFILES.f90 b/Source/UTIL/CLOSE_OUTFILES.f90 index be0d3b8f..0ddd53cf 100644 --- a/Source/UTIL/CLOSE_OUTFILES.f90 +++ b/Source/UTIL/CLOSE_OUTFILES.f90 @@ -24,13 +24,13 @@ ! End MIT license text. - SUBROUTINE CLOSE_OUTFILES ( BUG_CLOSE_STAT, ERR_CLOSE_STAT, F04_CLOSE_STAT, OP2_CLOSE_STAT, PCH_CLOSE_STAT ) + SUBROUTINE CLOSE_OUTFILES ( BUG_CLOSE_STAT, ERR_CLOSE_STAT, OP2_CLOSE_STAT, PCH_CLOSE_STAT ) -! Closes BUGFIL, ERRFIL, F04FIL, F06FIL +! Closes BUGFIL, ERRFIL, F06FIL USE PENTIUM_II_KIND, ONLY : BYTE - USE IOUNT1, ONLY : BUG , ERR , F04 , F06 , OP2 , PCH ,SC1, WRT_LOG, & - BUGFIL, ERRFIL, F04FIL, F06FIL, OP2FIL, PCHFIL + USE IOUNT1, ONLY : BUG , ERR , F06 , OP2 , PCH ,SC1, & + BUGFIL, ERRFIL, F06FIL, OP2FIL, PCHFIL USE CLOSE_OUTFILES_USE_IFs @@ -38,40 +38,31 @@ SUBROUTINE CLOSE_OUTFILES ( BUG_CLOSE_STAT, ERR_CLOSE_STAT, F04_CLOSE_STAT, OP2_ CHARACTER(LEN=*), INTENT(IN) :: BUG_CLOSE_STAT ! Input value for close status for BUG CHARACTER(LEN=*), INTENT(IN) :: ERR_CLOSE_STAT ! Input value for close status for ERR - CHARACTER(LEN=*), INTENT(IN) :: F04_CLOSE_STAT ! Input value for close status for F04 CHARACTER(LEN=*), INTENT(IN) :: OP2_CLOSE_STAT ! Input value for close status for OP2 CHARACTER(LEN=*), INTENT(IN) :: PCH_CLOSE_STAT ! Input value for close status for PCH ! ********************************************************************************************************************************** ! close standard output files first IF (F06 /= SC1) THEN - CALL FILE_CLOSE ( F06, F06FIL, 'KEEP', 'Y' ) - ENDIF - - IF (F04 /= SC1) THEN - IF (WRT_LOG > 0) THEN - CALL FILE_CLOSE ( F04, F04FIL, 'KEEP', 'Y' ) - ELSE - CALL FILE_CLOSE ( F04, F04FIL, F04_CLOSE_STAT, 'Y' ) - ENDIF + CALL FILE_CLOSE ( F06, F06FIL, 'KEEP' ) ENDIF IF (OP2 /= SC1) THEN CALL END_OP2_TABLES() - CALL FILE_CLOSE ( OP2, OP2FIL, OP2_CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( OP2, OP2FIL, OP2_CLOSE_STAT ) ENDIF IF (PCH /= SC1) THEN - CALL FILE_CLOSE ( PCH, PCHFIL, PCH_CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( PCH, PCHFIL, PCH_CLOSE_STAT ) ENDIF ! close error/log files last IF (BUG /= SC1) THEN - CALL FILE_CLOSE ( BUG, BUGFIL, BUG_CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( BUG, BUGFIL, BUG_CLOSE_STAT ) ENDIF IF (ERR /= SC1) THEN - CALL FILE_CLOSE ( ERR, ERRFIL, ERR_CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( ERR, ERRFIL, ERR_CLOSE_STAT ) ENDIF ! ********************************************************************************************************************************** diff --git a/Source/UTIL/CNT_NONZ_IN_FULL_MAT.f90 b/Source/UTIL/CNT_NONZ_IN_FULL_MAT.f90 index b1f380bc..aad19997 100644 --- a/Source/UTIL/CNT_NONZ_IN_FULL_MAT.f90 +++ b/Source/UTIL/CNT_NONZ_IN_FULL_MAT.f90 @@ -31,12 +31,11 @@ SUBROUTINE CNT_NONZ_IN_FULL_MAT ( MATIN_NAME, MATIN, NROWS, NCOLS, SYM, NTERM_NO ! If SYM = 'Y' then only terms in MATIN upper triangle are used in the count USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : EPSIL, SUPINFO, TINY USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : CNT_NONZ_IN_FULL_MAT_BEGEND USE CNT_NONZ_IN_FULL_MAT_USE_IFs @@ -51,17 +50,12 @@ SUBROUTINE CNT_NONZ_IN_FULL_MAT ( MATIN_NAME, MATIN, NROWS, NCOLS, SYM, NTERM_NO INTEGER(LONG), INTENT(OUT) :: NTERM_NONZERO ! Number of nonzero (or significant) values in the matrix INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: JSTART ! A computed DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CNT_NONZ_IN_FULL_MAT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NROWS,NCOLS)! Input full matrix REAL(DOUBLE) , INTENT(OUT) :: SMALL ! Filter for small terms -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF (DEBUG(196) == 0) THEN @@ -93,12 +87,7 @@ SUBROUTINE CNT_NONZ_IN_FULL_MAT ( MATIN_NAME, MATIN, NROWS, NCOLS, SYM, NTERM_NO ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/COND_NUM.f90 b/Source/UTIL/COND_NUM.f90 index 5c0ccee6..1dc7089e 100644 --- a/Source/UTIL/COND_NUM.f90 +++ b/Source/UTIL/COND_NUM.f90 @@ -30,12 +30,11 @@ SUBROUTINE COND_NUM ( MATIN_NAME, N, KD, K_INORM, MATIN_FAC, RCOND ) ! Uses the triangular factor of the matrix, which is called MATIN_FAC. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : ITMAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : COND_NUM_BEGEND USE LAPACK_LIN_EQN_DPB ! Interface module not needed for subr DPBCON. This is "CONTAIN'ed" in module LAPACK_LIN_EQN_DPB, which is "USE'd" above @@ -56,19 +55,14 @@ SUBROUTINE COND_NUM ( MATIN_NAME, N, KD, K_INORM, MATIN_FAC, RCOND ) ! = 0: successful exit ! < 0: if INFO = -i, the i-th arg had an illegal value - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = COND_NUM_BEGEND + REAL(DOUBLE), INTENT(IN) :: K_INORM ! The infinity-norm of the matrix whose name is MATIN_NAME REAL(DOUBLE), INTENT(IN) :: MATIN_FAC(KD+1,N) ! The upper triangular factor of the matrix whose name is MATIN_NAME REAL(DOUBLE), INTENT(OUT) :: RCOND ! The recip of the condition number of matrix whose name is MATIN_NAME REAL(DOUBLE) :: WORK(3*N) ! Workspace array -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -91,12 +85,7 @@ SUBROUTINE COND_NUM ( MATIN_NAME, N, KD, K_INORM, MATIN_FAC, RCOND ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/CONVERT_INT_TO_CHAR.f90 b/Source/UTIL/CONVERT_INT_TO_CHAR.f90 index de001b6a..ad97681a 100644 --- a/Source/UTIL/CONVERT_INT_TO_CHAR.f90 +++ b/Source/UTIL/CONVERT_INT_TO_CHAR.f90 @@ -29,10 +29,9 @@ SUBROUTINE CONVERT_INT_TO_CHAR ( INT_NUM, CHAR_VALUE ) ! Convert an integer 1, 2, 3, 4, 5 or 6 to character '1', '2' ... '6' USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CONVERT_INT_TO_CHAR_BEGEND USE CONVERT_INT_TO_CHAR_USE_IFs @@ -42,14 +41,9 @@ SUBROUTINE CONVERT_INT_TO_CHAR ( INT_NUM, CHAR_VALUE ) CHARACTER(1*BYTE), INTENT(OUT) :: CHAR_VALUE ! If INT_NUM = 1, then CHAR_VALUE = '1', etc INTEGER(LONG), INTENT(IN) :: INT_NUM ! Integer 1, 2, 3, 4, 5 O5 6 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CONVERT_INT_TO_CHAR_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -81,12 +75,7 @@ SUBROUTINE CONVERT_INT_TO_CHAR ( INT_NUM, CHAR_VALUE ) CHAR_VALUE = '6' ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/CONVERT_VEC_COORD_SYS.f90 b/Source/UTIL/CONVERT_VEC_COORD_SYS.f90 index ced0c5a7..d09711e7 100644 --- a/Source/UTIL/CONVERT_VEC_COORD_SYS.f90 +++ b/Source/UTIL/CONVERT_VEC_COORD_SYS.f90 @@ -31,11 +31,10 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) ! system. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, NCORD, NDOFG, NGRID USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : CORD, RCORD, GRID, GRID_ID, INV_GRID_SEQ - USE SUBR_BEGEND_LEVELS, ONLY : CONVERT_VEC_COORD_SYS_BEGEND USE CONVERT_VEC_COORD_SYS_USE_IFs @@ -53,7 +52,7 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) INTEGER(LONG) :: JCORD ! Internal coord system number for either GCID or NCID INTEGER(LONG) :: JFLD ! Used in error message to indicate a coord sys ID undefined INTEGER(LONG) :: NUM_COMPS ! No. displ components (1 for SPOINT, 6 for actual grid) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CONVERT_VEC_COORD_SYS_BEGEND + REAL(DOUBLE), INTENT(IN) :: INPUT_VEC(NDOFG) ! G-set input vector to be transformed from global to NCID REAL(DOUBLE), INTENT(OUT) :: OUTPUT_VEC(NDOFG) ! Transformed output vector @@ -68,12 +67,7 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) REAL(DOUBLE) :: T_0_GCID(3,3) ! Coord transformation matrix from basic to GCID system REAL(DOUBLE) :: T_0_NCID(3,3) ! Coord transformation matrix from basic to NCID system -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Set OUTPUT_VEC = INPUT_VEC in case no transformation is done (e.g. all grids have basic global and transformed system is basic) @@ -88,7 +82,7 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) DO K=1,NGRID AGRID = GRID_ID(INV_GRID_SEQ(K)) - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(K), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Only 6 comp grids need transforming CALL GET_ARRAY_ROW_NUM ( 'GRID_ID', SUBR_NAME, NGRID, GRID_ID, AGRID, GRID_ID_ROW_NUM ) @@ -156,7 +150,7 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) DO K=1,NGRID AGRID = GRID_ID(INV_GRID_SEQ(K)) - CALL GET_GRID_NUM_COMPS ( AGRID, NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(K), NUM_COMPS, SUBR_NAME ) IF (NUM_COMPS == 6) THEN ! Only 6 comp grids need transforming @@ -194,12 +188,7 @@ SUBROUTINE CONVERT_VEC_COORD_SYS ( MESSAG, INPUT_VEC, OUTPUT_VEC, NCID ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/COUNTER_PROGRESS.f90 b/Source/UTIL/COUNTER_PROGRESS.f90 index bcfc1efb..be4cda62 100644 --- a/Source/UTIL/COUNTER_PROGRESS.f90 +++ b/Source/UTIL/COUNTER_PROGRESS.f90 @@ -1,27 +1,27 @@ ! ################################################################################################################################## -! Begin MIT license text. +! Begin MIT license text. ! _______________________________________________________________________________________________________ - -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) - -! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and ! associated documentation files (the "Software"), to deal in the Software without restriction, including ! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to -! the following conditions: - -! The above copyright notice and this permission notice shall be included in all copies or substantial -! portions of the Software and documentation. - -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -! THE SOFTWARE. +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. ! _______________________________________________________________________________________________________ - + ! End MIT license text. ! This subroutine increases the progress of a counter by some amount. @@ -30,40 +30,62 @@ ! performance impact. ! Arguments: -! NEW_VALUE: the new value for the counter. -SUBROUTINE COUNTER_PROGRESS(NEW_VALUE) +! NEW_VALUE_OR_NEGATIVE: the new value for the counter, or a negative for 100% (force-finish) +SUBROUTINE COUNTER_PROGRESS(NEW_VALUE_OR_NEGATIVE) USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE USE SCONTR, ONLY : COUNTER_VALUE, COUNTER_PERC, COUNTER_TOTAL, & - COUNTER_STARTED, COUNTER_PREFIX, COUNTER_FMT + COUNTER_STARTED, COUNTER_PREFIX, COUNTER_FMT, & + COUNTER_UPDATED, COUNTER_LIMITER USE IOUNT1, ONLY : SC1 USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : NOCOUNTS - + USE COUNTER_PROGRESS_USE_IFs IMPLICIT NONE - INTEGER(LONG), INTENT(IN) :: NEW_VALUE + INTEGER(LONG), INTENT(IN) :: NEW_VALUE_OR_NEGATIVE INTEGER(LONG) :: NEW_PERC, ETA, NEW_TIME, ELAPSED, & ETA_HOURS, ETA_MINS, ETA_SECS, & - ELAPSED_HOURS, ELAPSED_MINS, ELAPSED_SECS + ELAPSED_HOURS, ELAPSED_MINS, ELAPSED_SECS, & + NEW_VALUE REAL(DOUBLE) :: SPEED + LOGICAL :: FORCED_PRINT, PERC_CHANGED, TOO_MANY ! Do nothing if NOCOUNTS is set IF (NOCOUNTS == 'Y') THEN RETURN END IF + IF (NEW_VALUE_OR_NEGATIVE < 0) THEN + NEW_VALUE = COUNTER_TOTAL + ELSE + NEW_VALUE = NEW_VALUE_OR_NEGATIVE + END IF + ! Compute the new percentage NEW_PERC = FLOOR(100.0 * NEW_VALUE / COUNTER_TOTAL) - + FORCED_PRINT = NEW_VALUE == 0 .OR. NEW_VALUE == COUNTER_TOTAL + PERC_CHANGED = NEW_PERC /= COUNTER_PERC + TOO_MANY = .FALSE. ! Check if there has been a change, or if the amount is zero - IF (NEW_VALUE == 0 .OR. NEW_PERC /= COUNTER_PERC .OR. NEW_VALUE == COUNTER_TOTAL) THEN + IF (FORCED_PRINT .OR. PERC_CHANGED) THEN ! Compute elapsed time, 0 means we're too fast CALL UNIX_TIME(NEW_TIME) ELAPSED = NEW_TIME - COUNTER_STARTED + ! Zero the counter limiter if the current second has changed + IF (COUNTER_UPDATED /= NEW_TIME) THEN + COUNTER_LIMITER = 0 + END IF + ! Limit to two non-forced updates + TOO_MANY = COUNTER_LIMITER >= 1 + END IF + + IF (FORCED_PRINT .OR. (PERC_CHANGED .AND. .NOT. TOO_MANY)) THEN + COUNTER_LIMITER = COUNTER_LIMITER + 1 + COUNTER_UPDATED = NEW_TIME ! Okay, percentage change. Let's do this. ! First, print the basic string. WRITE(SC1, 4000, ADVANCE="NO") CHAR(13) diff --git a/Source/UTIL/CROSS.f90 b/Source/UTIL/CROSS.f90 index b93e664d..2390bc69 100644 --- a/Source/UTIL/CROSS.f90 +++ b/Source/UTIL/CROSS.f90 @@ -29,10 +29,8 @@ SUBROUTINE CROSS ( A, B, C ) ! Cross product of 3x1 vectors: C = A (x) B USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : CROSS_BEGEND USE CROSS_USE_IFs @@ -40,30 +38,20 @@ SUBROUTINE CROSS ( A, B, C ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'CROSS' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CROSS_BEGEND + REAL(DOUBLE), INTENT(IN) :: A(3) ! Components of input vector A REAL(DOUBLE), INTENT(IN) :: B(3) ! Components of input vector B REAL(DOUBLE), INTENT(OUT) :: C(3) ! Components of output vector C -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** 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) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/CRS_NONSYM_TO_CRS_SYM.f90 b/Source/UTIL/CRS_NONSYM_TO_CRS_SYM.f90 index 8fc44d68..f52d50dc 100644 --- a/Source/UTIL/CRS_NONSYM_TO_CRS_SYM.f90 +++ b/Source/UTIL/CRS_NONSYM_TO_CRS_SYM.f90 @@ -52,11 +52,10 @@ SUBROUTINE CRS_NONSYM_TO_CRS_SYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, ! terms on, and above, the diagonal of A are stored in B. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : CRS_NONSYM_TO_CRS_SYM_BEGEND USE CRS_NONSYM_TO_CRS_SYM_USE_IFs @@ -78,17 +77,12 @@ SUBROUTINE CRS_NONSYM_TO_CRS_SYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, INTEGER(LONG) :: KEND_A ! Index into array I_A where a row of matrix A ends INTEGER(LONG) :: KTERM_B ! Count of number of nonzero terms put into output matrix B INTEGER(LONG) :: A_NTERM_ROW_I ! Number of terms in a row of input matrix A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CRS_NONSYM_TO_CRS_SYM_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NTERM_A) ! Real nonzero values in input matrix A REAL(DOUBLE) , INTENT(OUT) :: B(NTERM_B) ! Real nonzero values in output matrix B -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -121,12 +115,7 @@ SUBROUTINE CRS_NONSYM_TO_CRS_SYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, KBEG_A = KEND_A + 1 ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/CRS_SYM_TO_CRS_NONSYM.f90 b/Source/UTIL/CRS_SYM_TO_CRS_NONSYM.f90 index 1e056ca5..50732742 100644 --- a/Source/UTIL/CRS_SYM_TO_CRS_NONSYM.f90 +++ b/Source/UTIL/CRS_SYM_TO_CRS_NONSYM.f90 @@ -52,11 +52,10 @@ SUBROUTINE CRS_SYM_TO_CRS_NONSYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, ! a square input matrix. The relationship is not checked herein. In addition, symmetry of the input matrix is assumed. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : CRS_SYM_TO_CRS_NONSYM_BEGEND USE CRS_SYM_TO_CRS_NONSYM_USE_IFs @@ -81,19 +80,14 @@ SUBROUTINE CRS_SYM_TO_CRS_NONSYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: I2_A(NTERM_A) ! Row numbers of the terms in A INTEGER(LONG) :: K ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = CRS_SYM_TO_CRS_NONSYM_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NTERM_A) ! Real nonzero values in input matrix A REAL(DOUBLE) , INTENT(OUT) :: B(NTERM_B) ! Real nonzero values in output matrix B CHARACTER(LEN=LEN(NAME_A)+7+LEN("Calculating : row")) :: COUNTER_TEMPLATE -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -157,12 +151,7 @@ SUBROUTINE CRS_SYM_TO_CRS_NONSYM ( NAME_A, NROW_A, NTERM_A, I_A, J_A, A, NAME_B, ENDDO i_do WRITE(SC1,*) CR13 -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/DATA_SET_NAME_ERROR.f90 b/Source/UTIL/DATA_SET_NAME_ERROR.f90 index 33ce1f66..19711566 100644 --- a/Source/UTIL/DATA_SET_NAME_ERROR.f90 +++ b/Source/UTIL/DATA_SET_NAME_ERROR.f90 @@ -30,7 +30,7 @@ SUBROUTINE DATA_SET_NAME_ERROR ( DATA_NAME_ShouldBe, FILNAM, DATA_NAME_Is ) ! and then aborts USE PENTIUM_II_KIND, ONLY : LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : FATAL_ERR USE DATA_SET_NAME_ERROR_USE_IFs diff --git a/Source/UTIL/DATA_SET_SIZE_ERROR.f90 b/Source/UTIL/DATA_SET_SIZE_ERROR.f90 index b098aad8..b90eecfb 100644 --- a/Source/UTIL/DATA_SET_SIZE_ERROR.f90 +++ b/Source/UTIL/DATA_SET_SIZE_ERROR.f90 @@ -30,7 +30,7 @@ SUBROUTINE DATA_SET_SIZE_ERROR ( FILNAM, DATA_SET_NAME, DATA_NAME, INT1, INT2 ) ! and then aborts USE PENTIUM_II_KIND, ONLY : LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06, LINK1A + USE IOUNT1, ONLY : WRT_ERR, ERR, F06, LINK1A USE SCONTR, ONLY : FATAL_ERR USE DATA_SET_SIZE_ERROR_USE_IFs diff --git a/Source/UTIL/DEALLOCATE_CB_ELM_OTM.f90 b/Source/UTIL/DEALLOCATE_CB_ELM_OTM.f90 index 4dc38497..8289ea05 100644 --- a/Source/UTIL/DEALLOCATE_CB_ELM_OTM.f90 +++ b/Source/UTIL/DEALLOCATE_CB_ELM_OTM.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_CB_ELM_OTM ( NAME ) ! Deallocates memory from the elem related OTM (Output Transformation Matrices) used in Craig-Bampton model generation USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_CB_ELM_OTM_BEGEND USE OUTPUT4_MATRICES USE DEALLOCATE_CB_ELM_OTM_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_CB_ELM_OTM ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_CB_ELM_OTM' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_CB_ELM_OTM_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -114,16 +107,6 @@ SUBROUTINE DEALLOCATE_CB_ELM_OTM ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -133,9 +116,6 @@ SUBROUTINE DEALLOCATE_CB_ELM_OTM ( NAME ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_CB_GRD_OTM.f90 b/Source/UTIL/DEALLOCATE_CB_GRD_OTM.f90 index 499f7044..4e409dd1 100644 --- a/Source/UTIL/DEALLOCATE_CB_GRD_OTM.f90 +++ b/Source/UTIL/DEALLOCATE_CB_GRD_OTM.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_CB_GRD_OTM ( NAME ) ! Deallocates memory from the grid related OTM (Output Transformation Matrices) used in Craig-Bampton model generation USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_CB_GRD_OTM_BEGEND USE OUTPUT4_MATRICES, ONLY : OTM_ACCE, OTM_DISP, OTM_MPCF, OTM_SPCF USE DEALLOCATE_CB_GRD_OTM_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_CB_GRD_OTM ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_CB_GRD_OTM' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_CB_GRD_OTM_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -125,16 +118,6 @@ SUBROUTINE DEALLOCATE_CB_GRD_OTM ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -144,9 +127,6 @@ SUBROUTINE DEALLOCATE_CB_GRD_OTM ( NAME ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_COL_VEC.f90 b/Source/UTIL/DEALLOCATE_COL_VEC.f90 index 7b52f6d1..d5080556 100644 --- a/Source/UTIL/DEALLOCATE_COL_VEC.f90 +++ b/Source/UTIL/DEALLOCATE_COL_VEC.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_COL_VEC ( NAME ) ! Deallocate arrays for 1-D column vectors USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_COL_VEC_BEGEND USE OUTPUT4_MATRICES, ONLY : OU4_MAT_COL_GRD_COMP, OU4_MAT_ROW_GRD_COMP USE COL_VECS, ONLY : UG_COL, UN_COL, UM_COL, UF_COL, US_COL, UA_COL, UO_COL, UO0_COL, UR_COL, UL_COL, YSe, & FG_COL, FN_COL, FM_COL, FF_COL, FS_COL, FA_COL, FO_COL, FL_COL, FR_COL, & @@ -49,22 +48,16 @@ SUBROUTINE DEALLOCATE_COL_VEC ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_COL_VEC' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_COL_VEC_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -527,16 +520,6 @@ SUBROUTINE DEALLOCATE_COL_VEC ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -546,10 +529,6 @@ SUBROUTINE DEALLOCATE_COL_VEC ( NAME ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) - ! ********************************************************************************************************************************** END SUBROUTINE DEALLOCATE_COL_VEC diff --git a/Source/UTIL/DEALLOCATE_DOF_TABLES.f90 b/Source/UTIL/DEALLOCATE_DOF_TABLES.f90 index 762629f6..0a65f1e7 100644 --- a/Source/UTIL/DEALLOCATE_DOF_TABLES.f90 +++ b/Source/UTIL/DEALLOCATE_DOF_TABLES.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_DOF_TABLES ( NAME ) ! DEallocate arrays used for MYSTRAN DOF tables USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_DOF_TABLES_BEGEND USE DOF_TABLES, ONLY : TDOFI, TDOF_ROW_START, TDOF, TSET USE DEALLOCATE_DOF_TABLES_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_DOF_TABLES ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_DOF_TABLES' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_DOF_TABLES_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -128,16 +121,6 @@ SUBROUTINE DEALLOCATE_DOF_TABLES ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -146,10 +129,7 @@ SUBROUTINE DEALLOCATE_DOF_TABLES ( NAME ) ,/,14X,' NAME OF ARRAY TO BE ',A,' IS INCORRECT. INPUT NAME WAS ',A) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_EIGEN1_MAT.f90 b/Source/UTIL/DEALLOCATE_EIGEN1_MAT.f90 index ae02e5f6..891a3059 100644 --- a/Source/UTIL/DEALLOCATE_EIGEN1_MAT.f90 +++ b/Source/UTIL/DEALLOCATE_EIGEN1_MAT.f90 @@ -30,11 +30,10 @@ SUBROUTINE DEALLOCATE_EIGEN1_MAT ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_EIGEN1_MAT_BEGEND USE EIGEN_MATRICES_1 , ONLY : EIGEN_VAL, EIGEN_VEC, GEN_MASS, MODE_NUM, MEFFMASS, MPFACTOR_N6, MPFACTOR_NR USE DEALLOCATE_EIGEN1_MAT_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_EIGEN1_MAT ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_EIGEN1_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_EIGEN1_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -158,16 +151,6 @@ SUBROUTINE DEALLOCATE_EIGEN1_MAT ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -177,9 +160,6 @@ SUBROUTINE DEALLOCATE_EIGEN1_MAT ( NAME ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_FULL_MAT.f90 b/Source/UTIL/DEALLOCATE_FULL_MAT.f90 index 05324fb9..cb31bd2e 100644 --- a/Source/UTIL/DEALLOCATE_FULL_MAT.f90 +++ b/Source/UTIL/DEALLOCATE_FULL_MAT.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_FULL_MAT ( NAME ) ! Deallocates 2D full arrays (see comments in module FULL_MATRICES) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_FULL_MAT_BEGEND USE FULL_MATRICES, ONLY : KNN_FULL, KNM_FULL, KMM_FULL, MNN_FULL, MNM_FULL, MMM_FULL, PN_FULL, PM_FULL, & KFF_FULL, KFS_FULL, KSS_FULL, MFF_FULL, MFS_FULL, MSS_FULL, PF_FULL, PS_FULL, & KAA_FULL, KAO_FULL, KOO_FULL, MAA_FULL, MAO_FULL, MOO_FULL, PA_FULL, PO_FULL, & @@ -48,22 +47,16 @@ SUBROUTINE DEALLOCATE_FULL_MAT ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_FULL_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_FULL_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -495,16 +488,6 @@ SUBROUTINE DEALLOCATE_FULL_MAT ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -514,9 +497,6 @@ SUBROUTINE DEALLOCATE_FULL_MAT ( NAME ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_IN4_FILES.f90 b/Source/UTIL/DEALLOCATE_IN4_FILES.f90 index 6cdb1483..9935d7a7 100644 --- a/Source/UTIL/DEALLOCATE_IN4_FILES.f90 +++ b/Source/UTIL/DEALLOCATE_IN4_FILES.f90 @@ -29,13 +29,12 @@ SUBROUTINE DEALLOCATE_IN4_FILES ( NAME ) ! Deallocate arrays for IN4 files (USERIN elements) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, IN4FIL, IN4FIL_NUM, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, IN4FIL, IN4FIL_NUM, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO USE INPUTT4_MATRICES, ONLY : IN4_COL_MAP, IN4_MAT - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_IN4_FILES_BEGEND USE DEALLOCATE_IN4_FILES_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_IN4_FILES ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_IN4_FILES' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! 14 bytes of NAME (or padded blanks - for F04 output) INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_IN4_FILES_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Deallocate IN4 files @@ -106,25 +99,11 @@ SUBROUTINE DEALLOCATE_IN4_FILES ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF - RETURN ! ********************************************************************************************************************************** 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_LAPACK_MAT.f90 b/Source/UTIL/DEALLOCATE_LAPACK_MAT.f90 index d68e563c..4f81afc5 100644 --- a/Source/UTIL/DEALLOCATE_LAPACK_MAT.f90 +++ b/Source/UTIL/DEALLOCATE_LAPACK_MAT.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_LAPACK_MAT ( NAME ) ! Deallocate matrices used in LAPACK band form USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_LAPACK_MAT_BEGEND USE ARPACK_MATRICES_1 , ONLY : IWORK, RFAC, RESID, SELECT, VBAS, WORKD, WORKL USE LAPACK_DPB_MATRICES, ONLY : ABAND, BBAND, LAPACK_S, RES @@ -44,22 +43,16 @@ SUBROUTINE DEALLOCATE_LAPACK_MAT ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_LAPACK_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Name of matrix to be allocated - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_LAPACK_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -207,16 +200,6 @@ SUBROUTINE DEALLOCATE_LAPACK_MAT ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -226,9 +209,7 @@ SUBROUTINE DEALLOCATE_LAPACK_MAT ( NAME ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_MISC_MAT.f90 b/Source/UTIL/DEALLOCATE_MISC_MAT.f90 index 51a8e641..7e6481ff 100644 --- a/Source/UTIL/DEALLOCATE_MISC_MAT.f90 +++ b/Source/UTIL/DEALLOCATE_MISC_MAT.f90 @@ -30,12 +30,11 @@ SUBROUTINE DEALLOCATE_MISC_MAT ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO USE MISC_MATRICES, ONLY : UG_T123_MAT - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_MISC_MAT_BEGEND USE DEALLOCATE_MISC_MAT_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_MISC_MAT ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_MISC_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_MISC_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -92,16 +85,6 @@ SUBROUTINE DEALLOCATE_MISC_MAT ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -111,9 +94,6 @@ SUBROUTINE DEALLOCATE_MISC_MAT ( NAME ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 b/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 index ad29b594..dcbb58fd 100644 --- a/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 +++ b/Source/UTIL/DEALLOCATE_MODEL_STUF.f90 @@ -29,11 +29,10 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) ! DEallocates arrays defined in module MODEL_STUF (see comments there for definition of these matrices) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_MODEL_STUF_BEGEND USE MODEL_STUF, ONLY : AGRID, BE1, BE2, BE3, BGRID, DOFPIN, DT, KE, KEG, KED, KEM, ME, & OFFDIS, OFFDIS_B, OFFDIS_G, OFFDIS_O, OFFSET, PEB, PEG, PEL, PPE, PRESS, PTE, & @@ -74,18 +73,13 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_MODEL_STUF_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -97,7 +91,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SETS_IDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -110,7 +103,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ALL_SETS_ARRAY,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -123,7 +115,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ONE_SET_ARRAY,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -138,7 +129,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (TITLE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -151,7 +141,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (STITLE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -164,7 +153,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (LABEL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -179,7 +167,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_ACCE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -192,7 +179,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_DISP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -205,7 +191,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_ELFE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -218,7 +203,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_ELFN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -231,7 +215,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_GPFO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -244,7 +227,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_MPCF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -257,7 +239,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_OLOA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -270,7 +251,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_SPCF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -283,7 +263,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_STRE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -296,7 +275,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SC_STRN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -311,7 +289,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SCNUM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -326,7 +303,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SUBLOD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -341,7 +317,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SPCSETS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -354,7 +329,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (MPCSETS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -369,7 +343,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SEQ1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -382,7 +355,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SEQ2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -397,7 +369,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (FORMOM_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -412,7 +383,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PRESS_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -427,7 +397,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (GRAV_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -442,7 +411,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (LOAD_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -455,7 +423,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (LOAD_FACS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -470,7 +437,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (MPC_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -485,7 +451,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (MPCSIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -500,7 +465,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (MPCADD_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -515,7 +479,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RFORCE_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -530,7 +493,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SLOAD_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -545,7 +507,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SPC_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -558,7 +519,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SPC1_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -573,7 +533,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SPCSIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -588,7 +547,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SPCADD_SIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -603,7 +561,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ETYPE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -616,7 +573,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (EDAT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -629,7 +585,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (EPNT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -644,7 +599,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (EOFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -659,7 +613,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (MATL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -672,7 +625,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RMATL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -685,7 +637,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PBAR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -698,7 +649,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPBAR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -711,7 +661,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PBEAM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -724,7 +673,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPBEAM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -737,7 +685,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PBUSH,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -750,7 +697,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPBUSH,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -763,7 +709,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PCOMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -776,7 +721,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPCOMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -789,7 +733,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PELAS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -802,7 +745,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPELAS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -815,7 +757,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PROD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -828,7 +769,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPROD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -841,7 +781,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PSHEAR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -854,7 +793,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPSHEAR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -867,7 +805,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PSHEL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -880,7 +817,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPSHEL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -893,7 +829,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PSOLID,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -906,7 +841,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PUSER1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -919,7 +853,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPUSER1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -932,7 +865,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PUSERIN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -945,7 +877,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (USERIN_MAT_NAMES,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -960,7 +891,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (USERIN_ACT_COMPS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -973,7 +903,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (USERIN_ACT_GRIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -988,7 +917,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (VVEC,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1001,7 +929,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (BAROFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1014,7 +941,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (BUSHOFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1027,7 +953,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PLATEOFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1040,7 +965,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PLATETHICK,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1053,7 +977,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (MATANGLE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1068,7 +991,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (GRID,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1081,7 +1003,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RGRID,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1096,7 +1017,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (CORD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1109,7 +1029,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RCORD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1124,7 +1043,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (CMASS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1137,7 +1055,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PMASS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1150,7 +1067,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RPMASS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1165,7 +1081,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (CONM2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1178,7 +1093,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RCONM2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1193,7 +1107,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ESORT1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1208,7 +1121,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ESORT2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1223,7 +1135,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (GRID_ID,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1238,7 +1149,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (GRID_SEQ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1251,7 +1161,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (INV_GRID_SEQ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1266,7 +1175,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SNORM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1279,7 +1187,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RSNORM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1294,7 +1201,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (GRID_SNORM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1309,7 +1215,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (TN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1324,7 +1229,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (OGROUT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1337,7 +1241,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (GROUT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1350,7 +1253,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (OELOUT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1363,7 +1265,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ELOUT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1378,7 +1279,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ELDT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1393,7 +1293,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SYS_LOAD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1408,7 +1307,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (GTEMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1423,7 +1321,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (CGTEMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1438,7 +1335,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ETEMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1453,7 +1349,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (CETEMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1468,7 +1363,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (TPNT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1481,7 +1375,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (TDATA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1496,7 +1389,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PPNT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1509,7 +1401,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PDATA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1522,7 +1413,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PTYPE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1537,7 +1427,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PLOAD4_3D_DATA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1552,7 +1441,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (AGRID,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1565,7 +1453,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (BE1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1578,7 +1465,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (BE2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1591,7 +1477,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (BE3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1604,7 +1489,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (BGRID,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1617,7 +1501,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (DOFPIN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1630,7 +1513,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (DT,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1643,7 +1525,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (KE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1656,7 +1537,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (KEG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1669,7 +1549,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (KED,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1682,7 +1561,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (KEM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1695,7 +1573,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (ME,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1708,7 +1585,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (OFFDIS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1721,7 +1597,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (OFFDIS_O,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1734,7 +1609,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (OFFDIS_B,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1747,7 +1621,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (OFFDIS_G,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1760,7 +1633,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (OFFSET,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1773,7 +1645,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PEB,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1786,7 +1657,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PEG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1799,7 +1669,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PEL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1812,7 +1681,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PPE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1825,7 +1693,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PRESS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1838,7 +1705,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (PTE,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1851,7 +1717,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SE1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1864,7 +1729,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SE2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1877,7 +1741,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (SE3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1890,7 +1753,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (STE1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1903,7 +1765,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (STE2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1916,7 +1777,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (STE3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1929,7 +1789,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (UEB,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1942,7 +1801,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (UEG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1955,7 +1813,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (UEL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1968,7 +1825,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (UGG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1981,7 +1837,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (XEB,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1994,7 +1849,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (XEL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2007,7 +1861,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (XGL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2022,7 +1875,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (RIGID_ELEM_IDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2037,7 +1889,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (MPC_IND_GRIDS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2052,7 +1903,6 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) DEALLOCATE (GRID_ELEM_CONN_ARRAY,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2075,12 +1925,7 @@ SUBROUTINE DEALLOCATE_MODEL_STUF ( NAME_IN ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME, TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/DEALLOCATE_NL_PARAMS.f90 b/Source/UTIL/DEALLOCATE_NL_PARAMS.f90 index be7ac38c..626bbf29 100644 --- a/Source/UTIL/DEALLOCATE_NL_PARAMS.f90 +++ b/Source/UTIL/DEALLOCATE_NL_PARAMS.f90 @@ -29,13 +29,12 @@ SUBROUTINE DEALLOCATE_NL_PARAMS ! Deallocate arrays for nonlinear params USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LSUB, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO USE NONLINEAR_PARAMS, ONLY : NL_SID - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_NL_PARAMS_BEGEND USE DEALLOCATE_NL_PARAMS_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_NL_PARAMS CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_NL_PARAMS' CHARACTER(24*BYTE) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_NL_PARAMS_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -86,25 +79,12 @@ SUBROUTINE DEALLOCATE_NL_PARAMS ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN ! ********************************************************************************************************************************** 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_RBGLOBAL.f90 b/Source/UTIL/DEALLOCATE_RBGLOBAL.f90 index abeb9468..a77d7fd6 100644 --- a/Source/UTIL/DEALLOCATE_RBGLOBAL.f90 +++ b/Source/UTIL/DEALLOCATE_RBGLOBAL.f90 @@ -30,12 +30,11 @@ SUBROUTINE DEALLOCATE_RBGLOBAL ( SET ) ! stiffness matrix equilibrium checks. The TR6 matrices are used in transforming some Craig-Bampton matrices USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_RBGLOBAL_BEGEND USE RIGID_BODY_DISP_MATS, ONLY : RBGLOBAL_GSET, RBGLOBAL_NSET, RBGLOBAL_FSET, RBGLOBAL_ASET, RBGLOBAL_LSET, & TR6_CG, TR6_MEFM, TR6_0 @@ -46,22 +45,16 @@ SUBROUTINE DEALLOCATE_RBGLOBAL ( SET ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_RBGLOBAL' CHARACTER(LEN=*), INTENT(IN) :: SET ! Set name of the displ matrix CHARACTER(13*BYTE) :: NAME ! Specific array name used for output error message - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_RBGLOBAL_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -183,16 +176,6 @@ SUBROUTINE DEALLOCATE_RBGLOBAL ( SET ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -202,9 +185,6 @@ SUBROUTINE DEALLOCATE_RBGLOBAL ( SET ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_SCR_MAT.f90 b/Source/UTIL/DEALLOCATE_SCR_MAT.f90 index cb0afa1b..43209bae 100644 --- a/Source/UTIL/DEALLOCATE_SCR_MAT.f90 +++ b/Source/UTIL/DEALLOCATE_SCR_MAT.f90 @@ -29,11 +29,10 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) ! Deallocates sparse CRS or sparse CCS scratch matrices USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_SCR_MAT_BEGEND USE SCRATCH_MATRICES , ONLY : I_CRS1, J_CRS1, CRS1, I_CRS2, J_CRS2, CRS2, I_CRS3, J_CRS3, CRS3, & I_CCS1, J_CCS1, CCS1, I_CCS2, J_CCS2, CCS2, I_CCS3, J_CCS3, CCS3 @@ -47,18 +46,13 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_SCR_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -70,7 +64,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (I_CRS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -83,7 +76,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (J_CRS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -96,7 +88,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (CRS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -111,7 +102,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (I_CRS2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -124,7 +114,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (J_CRS2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -137,7 +126,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (CRS2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -152,7 +140,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (I_CRS3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -165,7 +152,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (J_CRS3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -178,7 +164,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (CRS3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -193,7 +178,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (I_CCS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -206,7 +190,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (J_CCS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -219,7 +202,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (CCS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -234,7 +216,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (I_CCS2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -247,7 +228,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (J_CCS2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -260,7 +240,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (CCS2,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -275,7 +254,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (I_CCS3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -288,7 +266,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (J_CCS3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -301,7 +278,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) DEALLOCATE (CCS3,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -324,12 +300,6 @@ SUBROUTINE DEALLOCATE_SCR_MAT ( NAME_IN ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME, TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/UTIL/DEALLOCATE_SPARSE_ALG.f90 b/Source/UTIL/DEALLOCATE_SPARSE_ALG.f90 index f795bc09..fa5f3ad1 100644 --- a/Source/UTIL/DEALLOCATE_SPARSE_ALG.f90 +++ b/Source/UTIL/DEALLOCATE_SPARSE_ALG.f90 @@ -30,11 +30,10 @@ SUBROUTINE DEALLOCATE_SPARSE_ALG ( NAME ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_SPARSE_ALG_BEGEND USE SPARSE_ALG_ARRAYS, ONLY : ALG, AROW, J_AROW, LOGICAL_VEC, REAL_VEC USE DEALLOCATE_SPARSE_ALG_USE_IFs @@ -43,22 +42,16 @@ SUBROUTINE DEALLOCATE_SPARSE_ALG ( NAME ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_SPARSE_ALG' CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name of the matrix to be allocated in sparse format - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAMEO INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_SPARSE_ALG_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -136,16 +129,6 @@ SUBROUTINE DEALLOCATE_SPARSE_ALG ( NAME ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -155,9 +138,6 @@ SUBROUTINE DEALLOCATE_SPARSE_ALG ( NAME ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/DEALLOCATE_SPARSE_MAT.f90 b/Source/UTIL/DEALLOCATE_SPARSE_MAT.f90 index fc31689c..2841aed4 100644 --- a/Source/UTIL/DEALLOCATE_SPARSE_MAT.f90 +++ b/Source/UTIL/DEALLOCATE_SPARSE_MAT.f90 @@ -29,12 +29,11 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) ! Deallocate arrays for MYSTRAN sparse matrices USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, TOT_MB_MEM_ALLOC USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS - USE SUBR_BEGEND_LEVELS, ONLY : DEALLOCATE_SPARSE_MAT_BEGEND USE SPARSE_MATRICES , ONLY : I_KGG , J_KGG , KGG , I_MGG , J_MGG , MGG , I_PG , J_PG , PG , & I_KGGD , J_KGGD , KGGD , & @@ -90,22 +89,16 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'DEALLOCATE_SPARSE_MAT' CHARACTER(LEN=*), INTENT(IN) :: NAME_IN ! Array name (used for output error message) CHARACTER(6*BYTE) :: NAME ! Array name (used for output error message) - CHARACTER(14*BYTE) :: NAMEL ! First 14 bytes of NAME INTEGER(LONG) :: IERR ! STAT from DEALLOCATE INTEGER(LONG) :: JERR ! Local error indicator - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = DEALLOCATE_SPARSE_MAT_BEGEND + REAL(DOUBLE) :: CUR_MB_ALLOCATED ! MB of memory that is currently allocated to ARRAY_NAME when subr ! ALLOCATED_MEMORY is called (before entering MB_ALLOCATED into array ! ALLOCATED_ARRAY_MEM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** JERR = 0 @@ -120,7 +113,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KGG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -133,7 +125,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KGG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -146,7 +137,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KGG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -161,7 +151,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KGGD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -174,7 +163,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KGGD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -187,7 +175,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KGGD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -202,7 +189,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MGG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -215,7 +201,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MGG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -228,7 +213,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MGG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -243,7 +227,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -256,7 +239,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -269,7 +251,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -284,7 +265,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_RMG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -297,7 +277,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_RMG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -310,7 +289,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (RMG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -328,7 +306,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KNN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -341,7 +318,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KNN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -354,7 +330,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KNN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -369,7 +344,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KNM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -382,7 +356,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KNM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -395,7 +368,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KNM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -410,7 +382,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -423,7 +394,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -436,7 +406,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -451,7 +420,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -464,7 +432,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -477,7 +444,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -492,7 +458,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KNND,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -505,7 +470,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KNND,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -518,7 +482,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KNND,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -533,7 +496,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KNMD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -546,7 +508,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KNMD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -559,7 +520,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KNMD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -574,7 +534,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KMND,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -587,7 +546,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KMND,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -600,7 +558,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KMND,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -615,7 +572,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KMMD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -628,7 +584,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KMMD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -641,7 +596,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KMMD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -656,7 +610,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MNN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -669,7 +622,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MNN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -682,7 +634,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MNN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -697,7 +648,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MNM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -710,7 +660,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MNM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -723,7 +672,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MNM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -738,7 +686,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -751,7 +698,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -764,7 +710,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -779,7 +724,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -792,7 +736,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -805,7 +748,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -820,7 +762,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -833,7 +774,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -846,7 +786,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -861,7 +800,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -874,7 +812,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -887,7 +824,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -902,7 +838,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_RMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -915,7 +850,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_RMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -928,7 +862,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (RMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -943,7 +876,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_RMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -956,7 +888,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_RMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -969,7 +900,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (RMM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -984,7 +914,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_GMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -997,7 +926,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_GMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1010,7 +938,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (GMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1025,7 +952,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_GMNt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1038,7 +964,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_GMNt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1051,7 +976,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (GMNt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1066,7 +990,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_HMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1079,7 +1002,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_HMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1092,7 +1014,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (HMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1107,7 +1028,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_LMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1120,7 +1040,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_LMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1133,7 +1052,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (LMN,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1151,7 +1069,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1164,7 +1081,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1177,7 +1093,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1192,7 +1107,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KFS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1205,7 +1119,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KFS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1218,7 +1131,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KFS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1233,7 +1145,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KSF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1246,7 +1157,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KSF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1259,7 +1169,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KSF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1274,7 +1183,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KSS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1287,7 +1195,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KSS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1300,7 +1207,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KSS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1315,7 +1221,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KFSe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1328,7 +1233,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KFSe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1341,7 +1245,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KFSe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1356,7 +1259,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KSSe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1369,7 +1271,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KSSe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1382,7 +1283,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KSSe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1397,7 +1297,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KFFD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1410,7 +1309,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KFFD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1423,7 +1321,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KFFD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1438,7 +1335,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KFSD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1451,7 +1347,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KFSD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1464,7 +1359,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KFSD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1479,7 +1373,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KSFD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1492,7 +1385,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KSFD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1505,7 +1397,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KSFD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1520,7 +1411,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KSSD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1533,7 +1423,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KSSD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1546,7 +1435,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KSSD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1561,7 +1449,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KFSDe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1574,7 +1461,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KFSDe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1587,7 +1473,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KFSDe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1602,7 +1487,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KSSDe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1615,7 +1499,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KSSDe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1628,7 +1511,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KSSDe,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1643,7 +1525,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1656,7 +1537,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1669,7 +1549,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MFF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1684,7 +1563,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MFS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1697,7 +1575,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MFS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1710,7 +1587,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MFS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1725,7 +1601,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MSF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1738,7 +1613,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MSF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1751,7 +1625,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MSF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1766,7 +1639,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MSS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1779,7 +1651,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MSS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1792,7 +1663,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MSS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1807,7 +1677,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1820,7 +1689,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1833,7 +1701,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PF,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1848,7 +1715,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1861,7 +1727,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1874,7 +1739,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1889,7 +1753,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PF_TMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1902,7 +1765,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PF_TMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1915,7 +1777,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PF_TMP,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1930,7 +1791,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PFYS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1943,7 +1803,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PFYS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1956,7 +1815,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PFYS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1971,7 +1829,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PFYS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1984,7 +1841,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PFYS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -1997,7 +1853,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PFYS1,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2012,7 +1867,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_QSYS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2025,7 +1879,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_QSYS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2038,7 +1891,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (QSYS,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2056,7 +1908,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KAA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2069,7 +1920,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KAA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2082,7 +1932,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KAA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2097,7 +1946,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KAO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2110,7 +1958,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KAO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2123,7 +1970,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KAO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2138,7 +1984,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KOO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2151,7 +1996,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KOO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2164,7 +2008,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KOO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2179,7 +2022,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KOOs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2192,7 +2034,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KOOs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2205,7 +2046,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KOOs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2220,7 +2060,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KAAD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2233,7 +2072,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KAAD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2246,7 +2084,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KAAD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2261,7 +2098,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KAOD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2274,7 +2110,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KAOD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2287,7 +2122,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KAOD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2302,7 +2136,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KOOD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2315,7 +2148,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KOOD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2328,7 +2160,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KOOD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2343,7 +2174,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KOODs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2356,7 +2186,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KOODs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2369,7 +2198,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KOODs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2384,7 +2212,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MAA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2397,7 +2224,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MAA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2410,7 +2236,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MAA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2425,7 +2250,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MAO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2438,7 +2262,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MAO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2451,7 +2274,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MAO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2466,7 +2288,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MOO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2479,7 +2300,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MOO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2492,7 +2312,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MOO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2507,7 +2326,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2520,7 +2338,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2533,7 +2350,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2548,7 +2364,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2561,7 +2376,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2574,7 +2388,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PO,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2589,7 +2402,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_GOA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2602,7 +2414,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_GOA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2615,7 +2426,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (GOA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2630,7 +2440,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_GOAt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2643,7 +2452,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_GOAt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2656,7 +2464,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (GOAt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2674,7 +2481,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KLL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2687,7 +2493,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KLL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2700,7 +2505,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KLL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2715,7 +2519,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KLLs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2728,7 +2531,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KLLs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2741,7 +2543,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KLLs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2756,7 +2557,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KRL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2769,7 +2569,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KRL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2782,7 +2581,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KRL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2797,7 +2595,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2810,7 +2607,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2823,7 +2619,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2838,7 +2633,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KLLD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2851,7 +2645,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KLLD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2864,7 +2657,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KLLD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2879,7 +2671,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KLLDn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2892,7 +2683,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KLLDn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2905,7 +2695,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KLLDn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2920,7 +2709,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KLLDs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2933,7 +2721,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KLLDs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2946,7 +2733,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KLLDs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2961,7 +2747,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KRLD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2974,7 +2759,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KRLD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -2987,7 +2771,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KRLD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3002,7 +2785,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KRRD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3015,7 +2797,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KRRD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3028,7 +2809,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KRRD,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3043,7 +2823,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MLL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3056,7 +2835,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MLL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3069,7 +2847,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MLL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3084,7 +2861,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MLLn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3097,7 +2873,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MLLn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3110,7 +2885,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MLLn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3125,7 +2899,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MLLs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3138,7 +2911,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MLLs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3151,7 +2923,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MLLs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3166,7 +2937,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MLR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3179,7 +2949,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MLR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3192,7 +2961,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MLR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3207,7 +2975,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MPF0 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3220,7 +2987,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MPF0 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3233,7 +2999,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MPF0 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3248,7 +3013,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MRL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3261,7 +3025,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MRL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3274,7 +3037,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MRL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3289,7 +3051,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3302,7 +3063,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3315,7 +3075,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3330,7 +3089,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3343,7 +3101,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3356,7 +3113,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PL,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3371,7 +3127,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3384,7 +3139,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3397,7 +3151,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3412,7 +3165,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KMSM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3425,7 +3177,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KMSM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3438,7 +3189,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KMSM,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3453,7 +3203,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KMSMn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3466,7 +3215,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KMSMn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3479,7 +3227,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KMSMn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3494,7 +3241,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KMSMs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3507,7 +3253,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KMSMs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3520,7 +3265,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KMSMs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3535,7 +3279,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_DLR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3548,7 +3291,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_DLR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3561,7 +3303,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (DLR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3576,7 +3317,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_DLRt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3589,7 +3329,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_DLRt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3602,7 +3341,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (DLRt,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3617,7 +3355,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_CG_LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3630,7 +3367,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_CG_LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3643,7 +3379,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (CG_LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3658,7 +3393,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PHIZL ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3671,7 +3405,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PHIZL ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3684,7 +3417,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PHIZL ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3699,7 +3431,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PHIZL1 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3712,7 +3443,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PHIZL1 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3725,7 +3455,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PHIZL1 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3740,7 +3469,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PHIZL1t ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3753,7 +3481,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PHIZL1t ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3766,7 +3493,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PHIZL1t ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3781,7 +3507,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PHIZL2 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3794,7 +3519,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PHIZL2 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3807,7 +3531,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PHIZL2 ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3822,7 +3545,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_IF_LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3835,7 +3557,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_IF_LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3848,7 +3569,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (IF_LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3863,7 +3583,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_IRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3876,7 +3595,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_IRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3889,7 +3607,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (IRR,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3904,7 +3621,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PHIXA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3917,7 +3633,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PHIXA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3930,7 +3645,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PHIXA,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3945,7 +3659,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_PHIXG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3958,7 +3671,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_PHIXG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3971,7 +3683,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (PHIXG,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3986,7 +3697,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KRRcb,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -3999,7 +3709,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KRRcb,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4012,7 +3721,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KRRcb,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4027,7 +3735,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KRRcbn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4040,7 +3747,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KRRcbn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4053,7 +3759,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KRRcbn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4068,7 +3773,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KRRcbs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4081,7 +3785,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KRRcbs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4094,7 +3797,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KRRcbs,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4109,7 +3811,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_KXX ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4122,7 +3823,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_KXX ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4135,7 +3835,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (KXX ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4150,7 +3849,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4163,7 +3861,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4176,7 +3873,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (LTM ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4191,7 +3887,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MRN ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4204,7 +3899,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MRN ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4217,7 +3911,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MRN ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4232,7 +3925,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MRRcb,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4245,7 +3937,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MRRcb,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4258,7 +3949,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MRRcb,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4273,7 +3963,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MRRcbn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4286,7 +3975,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MRRcbn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4299,7 +3987,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MRRcbn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4314,7 +4001,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MXX ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4327,7 +4013,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MXX ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4340,7 +4025,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MXX ,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4355,7 +4039,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (I_MXXn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4368,7 +4051,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (J_MXXn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4381,7 +4063,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) DEALLOCATE (MXXn,STAT=IERR) IF (IERR == 0) THEN CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - CALL WRITE_MEM_SUM_TO_F04 ( NAME, 'DEALLOC', -CUR_MB_ALLOCATED, 0, 0, SUBR_BEGEND ) ELSE WRITE(ERR,992) NAME, SUBR_NAME WRITE(F06,992) NAME, SUBR_NAME @@ -4409,16 +4090,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) ! ********************************************************************************************************************************** CALL ALLOCATED_MEMORY ( NAME, ZERO, 'DEALLOC', 'Y', CUR_MB_ALLOCATED, SUBR_NAME ) - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - NAMEL(1:LEN(NAMEL)) = ' ' - NAMEL(1:) = NAME(1:) - IF (DEBUG(107) == 0) THEN - WRITE(F04,9003) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) SUBR_NAME, TSEC, -CUR_MB_ALLOCATED, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF RETURN @@ -4428,9 +4099,6 @@ SUBROUTINE DEALLOCATE_SPARSE_MAT ( NAME_IN ) 992 FORMAT(' *ERROR 992: CANNOT DEALLOCATE MEMORY FROM ARRAY ',A,' IN SUBROUTINE ',A) - 9003 FORMAT(1X,A,' END ',F10.3,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9005 FORMAT(1X,A,' END ',F10.3,F13.6,' MB ',A15,':',39X,'T:',F13.6) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/FBS_LAPACK.f90 b/Source/UTIL/FBS_LAPACK.f90 index f54402ed..85ad113e 100644 --- a/Source/UTIL/FBS_LAPACK.f90 +++ b/Source/UTIL/FBS_LAPACK.f90 @@ -35,7 +35,7 @@ SUBROUTINE FBS_LAPACK ( EQUED, NROWS, MATIN_SDIA, EQUIL_SCALE_FACS, INOUT_COL ) ! (3) Scales the solution vector if requested USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, STIME, TSEC USE CONSTANTS_1, ONLY : ZERO @@ -44,7 +44,6 @@ SUBROUTINE FBS_LAPACK ( EQUED, NROWS, MATIN_SDIA, EQUIL_SCALE_FACS, INOUT_COL ) USE DEBUG_PARAMETERS, ONLY : DEBUG, NDEBUG USE MACHINE_PARAMS, ONLY : MACH_EPS, MACH_SFMIN USE LAPACK_LIN_EQN_DPB - USE SUBR_BEGEND_LEVELS, ONLY : FBS_LAPACK_BEGEND USE SYM_MAT_DECOMP_LAPACK_USE_IFs @@ -68,19 +67,14 @@ SUBROUTINE FBS_LAPACK ( EQUED, NROWS, MATIN_SDIA, EQUIL_SCALE_FACS, INOUT_COL ) ! > 0: if INFO = i, the leading minor of order i is not pos def ! and the factorization (in DPBTRS) could not be completed. INTEGER(LONG), PARAMETER :: NUM_COLS = 1 ! Number of vectors to solve in this call - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FBS_LAPACK_BEGEND + REAL(DOUBLE) , INTENT(IN) :: EQUIL_SCALE_FACS(NROWS) ! LAPACK_S values to return to calling subr REAL(DOUBLE) , INTENT(INOUT) :: INOUT_COL(NROWS) ! INOUT input vector -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Scale the INOUT vector if requested @@ -117,12 +111,7 @@ SUBROUTINE FBS_LAPACK ( EQUED, NROWS, MATIN_SDIA, EQUIL_SCALE_FACS, INOUT_COL ) ,/,14X,' LAPACK SUBR XERBLA SHOULD HAVE REPORTED AN ERROR ON AN ILLEGAL ARGUMENT IN A CALL TO LAPACK SUBR ' & ,/,15X,A,' (OR A SUBR CALLED BY IT) AND THEN ABORTED') -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/FBS_SUPRLU.f90 b/Source/UTIL/FBS_SUPRLU.f90 index e974c1e8..3480ea22 100644 --- a/Source/UTIL/FBS_SUPRLU.f90 +++ b/Source/UTIL/FBS_SUPRLU.f90 @@ -35,13 +35,12 @@ SUBROUTINE FBS_SUPRLU ( CALLING_SUBR, MATIN_NAME, NROWS, NTERMS, I_MATIN, J_MATI ! (3) Scales the solution vector if requested USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : CRS_CCS USE SCRATCH_MATRICES, ONLY : I_CCS1, J_CCS1, CCS1 - USE SUBR_BEGEND_LEVELS, ONLY : FBS_SUPRLU_BEGEND USE SuperLU_STUF, ONLY : SLU_FACTORS USE FBS_SUPRLU_USE_IFs @@ -60,17 +59,12 @@ SUBROUTINE FBS_SUPRLU ( CALLING_SUBR, MATIN_NAME, NROWS, NTERMS, I_MATIN, J_MATI INTEGER(LONG), INTENT(INOUT) :: INFO ! Output from SuperLU routine - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FBS_SUPRLU_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERMS) ! A small number to compare real zero REAL(DOUBLE) , INTENT(IN) :: RHS_COL(NROWS) ! RHS column for which the FBS is solving -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -104,12 +98,7 @@ SUBROUTINE FBS_SUPRLU ( CALLING_SUBR, MATIN_NAME, NROWS, NTERMS, I_MATIN, J_MATI CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/FILERR.f90 b/Source/UTIL/FILERR.f90 index 8a9cf99b..f24073ec 100644 --- a/Source/UTIL/FILERR.f90 +++ b/Source/UTIL/FILERR.f90 @@ -24,33 +24,20 @@ ! End MIT license text. - SUBROUTINE FILERR ( OUNT, WRITE_F04 ) + SUBROUTINE FILERR ( OUNT ) ! Writes message about file open errors and errors reading data USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM - USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FILERR_BEGEND - - USE FILERR_USE_IFs + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 IMPLICIT NONE - - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'FILERR' - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FILERR_BEGEND -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** DO I=1,2 @@ -61,12 +48,7 @@ SUBROUTINE FILERR ( OUNT, WRITE_F04 ) ! ********************************************************************************************************************************** 900 FORMAT(/,' PROCESSING TERMINATED DUE TO ABOVE FILE OPEN/READ ERRORS.') -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/FILE_CLOSE.f90 b/Source/UTIL/FILE_CLOSE.f90 index 8cb09e47..d0aca946 100644 --- a/Source/UTIL/FILE_CLOSE.f90 +++ b/Source/UTIL/FILE_CLOSE.f90 @@ -24,53 +24,26 @@ ! End MIT license text. - SUBROUTINE FILE_CLOSE ( UNIT, FILNAM, CLOSE_STAT, WRITE_F04 ) + SUBROUTINE FILE_CLOSE ( UNIT, FILNAM, CLOSE_STAT ) ! Closes files and writes message if the close fails - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, F04, SC1 - USE SCONTR, ONLY : BLNK_SUB_NAM - USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FILE_OPEN_BEGEND + USE PENTIUM_II_KIND, ONLY : LONG + USE IOUNT1, ONLY : SC1 USE FILE_CLOSE_USE_IFs IMPLICIT NONE - - LOGICAL :: FILE_EXIST - LOGICAL :: FILE_OPND - - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'FILE_CLOSE' -!xx CHARACTER(FILE_NAM_MAXLEN*BYTE), INTENT(IN) :: FILNAM ! File name CHARACTER(LEN=*) , INTENT(IN) :: FILNAM ! File name CHARACTER(LEN=*) , INTENT(IN) :: CLOSE_STAT ! Status for close - CHARACTER(LEN=*) , INTENT(IN) :: WRITE_F04 ! If 'Y' write to F04, otherwise do not - CHARACTER( 6*BYTE) :: NAM_CLS - CHARACTER( 3*BYTE) :: UNIT_NAME = '???' ! Extension of FILNAM (e.g. F06, etc) INTEGER(LONG), INTENT(IN) :: UNIT ! File unit number - INTEGER(LONG) :: DEC_PT ! Position in FILNAM where '.' exists INTEGER(LONG) :: IOCHK ! IOSTAT error number when closing a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FILE_OPEN_BEGEND -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - INQUIRE(FILE=FILNAM,OPENED=FILE_OPND) - IF (UNIT /= F04) THEN - DEC_PT = INDEX(FILNAM,'.',.TRUE.) - IF (DEC_PT > 0) THEN - UNIT_NAME = FILNAM(DEC_PT+1:DEC_PT+4) - ENDIF - INQUIRE(FILE=FILNAM,EXIST=FILE_EXIST) - NAM_CLS(1:) = CLOSE_STAT - WRITE(F04,9001) SUBR_NAME, TSEC, FILE_EXIST, FILE_OPND, NAM_CLS, UNIT_NAME - ENDIF - 9001 FORMAT(1X,A,' BEGN ',F10.3,2L2,',',1X,A6,1X,',',44X,', Closing file unit: ',A) - ENDIF + + ! ********************************************************************************************************************************** CLOSE ( UNIT,STATUS=CLOSE_STAT,IOSTAT=IOCHK ) @@ -82,16 +55,6 @@ SUBROUTINE FILE_CLOSE ( UNIT, FILNAM, CLOSE_STAT, WRITE_F04 ) STOP ENDIF -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - IF (UNIT /= F04) THEN - INQUIRE(FILE=FILNAM,EXIST=FILE_EXIST) - INQUIRE(FILE=FILNAM,OPENED=FILE_OPND) - WRITE(F04,9002) SUBR_NAME,TSEC,FILE_EXIST,FILE_OPND - ENDIF - 9002 FORMAT(1X,A,' END ',F10.3,2L2) - ENDIF RETURN diff --git a/Source/UTIL/FILE_INQUIRE.f90 b/Source/UTIL/FILE_INQUIRE.f90 index 838ce1d5..9c85a996 100644 --- a/Source/UTIL/FILE_INQUIRE.f90 +++ b/Source/UTIL/FILE_INQUIRE.f90 @@ -29,9 +29,9 @@ SUBROUTINE FILE_INQUIRE ( MESSAGE ) ! Inquires about whether files are opened. Writes results to file F06 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, MOT4, MOU4, OU4_EXT, OT4_EXT, WRT_LOG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, MOT4, MOU4, OU4_EXT, OT4_EXT - USE IOUNT1, ONLY : ANS, BUG, EIN, ENF, ERR, F04, F06, IN0, IN1, NEU, & + USE IOUNT1, ONLY : BUG, EIN, ENF, ERR, F06, IN0, IN1, NEU, & PCH, SEQ, SC1, SPC, & F21, F22, F23, F24, F25, & L1A, L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, & @@ -42,7 +42,7 @@ SUBROUTINE FILE_INQUIRE ( MESSAGE ) L3A, L4A, L4B, L4C, L4D, L5A, L5B, OP2, OT4, OU4, & MAX_FIL - USE IOUNT1, ONLY : ANSFIL, BUGFIL, EINFIL, ENFFIL, ERRFIL, F04FIL, F06FIL, IN0FIL, INFILE, NEUFIL, & + USE IOUNT1, ONLY : BUGFIL, EINFIL, ENFFIL, ERRFIL, F06FIL, IN0FIL, INFILE, NEUFIL, & PCHFIL, SEQFIL, SPCFIL, & F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, & LINK1A, LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, & @@ -54,7 +54,6 @@ SUBROUTINE FILE_INQUIRE ( MESSAGE ) USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : FILE_INQUIRE_BEGEND USE FILE_INQUIRE_USE_IFs @@ -72,23 +71,16 @@ SUBROUTINE FILE_INQUIRE ( MESSAGE ) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: UNT(100) ! Unit number of a MYSTRAN file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FILE_INQUIRE_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** FIL( 1) = 'SC1' ; UNT( 1) = SC1 ! SC1 - don't need to do INQUIRE on it - FIL( 2) = 'ANS' ; UNT( 2) = ANS ; FILNAM( 2) = ANSFIL FIL( 3) = 'BUG' ; UNT( 3) = BUG ; FILNAM( 3) = BUGFIL FIL( 4) = 'EIN' ; UNT( 4) = EIN ; FILNAM( 4) = EINFIL FIL( 5) = 'ENF' ; UNT( 5) = ENF ; FILNAM( 5) = ENFFIL FIL( 6) = 'ERR' ; UNT( 6) = ERR ; FILNAM( 6) = ERRFIL - FIL( 7) = 'F04' ; UNT( 7) = F04 ; FILNAM( 7) = F04FIL FIL( 8) = 'F06' ; UNT( 8) = F06 ; FILNAM( 8) = F06FIL FIL( 9) = 'L1A' ; UNT( 9) = L1A ; FILNAM( 9) = LINK1A FIL( 10) = 'IN0' ; UNT( 10) = IN0 ; FILNAM( 10) = IN0FIL @@ -193,12 +185,7 @@ SUBROUTINE FILE_INQUIRE ( MESSAGE ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/FILE_OPEN.f90 b/Source/UTIL/FILE_OPEN.f90 index c723de6e..b20424ef 100644 --- a/Source/UTIL/FILE_OPEN.f90 +++ b/Source/UTIL/FILE_OPEN.f90 @@ -24,7 +24,7 @@ ! End MIT license text. - SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTION, POSITION, WRITE_L1A, WRITE_VER, WRITE_F04) + SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTION, POSITION, WRITE_L1A, WRITE_VER) ! Opens formatted files that have STIME for read or write. If open for read, check STIME. If open for write, write STIME ! If file needs to be opened for READWRITE, this subr needs to be called twice: @@ -75,8 +75,6 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI ! Y/N : write to L1A??? ! WRITE_VER : str1 ! Y/N : write to VER??? - ! WRITE_F04 : str1 - ! Y/N : write to F04 ! ! Unused ! ------- @@ -92,23 +90,19 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI ! ! Examples ! -------- - ! FILE_OPEN ( OP2, OP2FIL, OUNT,'OLD ', OP2_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') + ! FILE_OPEN ( OP2, OP2FIL, OUNT,'OLD ', OP2_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N') ! USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ANS, F04, F06, IN1, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : F06, IN1, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, PROG_NAME USE TIMDAT, ONLY : STIME, TSEC USE DEBUG_PARAMETERS USE MYSTRAN_Version, ONLY : MYSTRAN_VER_NUM, MYSTRAN_VER_MONTH, MYSTRAN_VER_DAY, MYSTRAN_VER_YEAR, MYSTRAN_AUTHOR, & MYSTRAN_COMMENT - USE SUBR_BEGEND_LEVELS, ONLY : FILE_OPEN_BEGEND USE FILE_OPEN_USE_IFs IMPLICIT NONE - - LOGICAL :: FILE_EXIST - LOGICAL :: FILE_OPND CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'FILE_OPEN' CHARACTER(LEN=*), INTENT(IN) :: ACTION ! File description @@ -118,7 +112,6 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI CHARACTER(LEN=*), INTENT(IN) :: POSITION ! File error message CHARACTER(LEN=*), INTENT(IN) :: STATUS ! File status indicator (NEW, OLD, REPLACE) CHARACTER(LEN=*), INTENT(IN) :: RW_STIME ! Indicator of whether to read or write STIME - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) CHARACTER(LEN=*), INTENT(IN) :: WRITE_L1A ! 'Y'/'N' Arg passed to subr OUTA_HERE CHARACTER(LEN=*), INTENT(IN) :: WRITE_VER ! 'Y'/'N' Arg to tell whether to write MYSTRAN version info CHARACTER( 9*BYTE) :: NAM_ACT @@ -126,37 +119,17 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI CHARACTER( 6*BYTE) :: NAM_POS CHARACTER( 7*BYTE) :: NAM_STA CHARACTER(11*BYTE) :: NAM_RWS - CHARACTER( 3*BYTE) :: UNIT_NAME = '???' ! Extension of FILNAM (e.g. F06, etc) INTEGER(LONG), INTENT(IN) :: UNIT ! Unit number file is attached to INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to. Input to subr FILE_OPEN - INTEGER(LONG) :: DEC_PT ! Position in FILNAM where '.' exists INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IERR ! Error count INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening/reading a file INTEGER(LONG) :: REC_NO ! Record number when reading a file INTEGER(LONG) :: XTIME ! Time stamp read from file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FILE_OPEN_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - INQUIRE(FILE=FILNAM, OPENED=FILE_OPND) - IF ((UNIT /= F04) .AND. (UNIT /= IN1)) THEN - DEC_PT = INDEX(FILNAM,'.',.TRUE.) - IF (DEC_PT > 0) THEN - UNIT_NAME = FILNAM(DEC_PT+1:DEC_PT+4) - ENDIF - INQUIRE(FILE=FILNAM, EXIST=FILE_EXIST) - NAM_STA(1:) = STATUS - NAM_FOR(1:) = FORMAT - NAM_ACT(1:) = ACTION - NAM_POS(1:) = POSITION - NAM_RWS(1:) = RW_STIME - WRITE(F04,9001) SUBR_NAME, TSEC, FILE_EXIST, FILE_OPND, NAM_STA, NAM_FOR, NAM_ACT, NAM_POS, NAM_RWS, UNIT_NAME - ENDIF - 9001 FORMAT(1X,A,' BEGN ',F10.3,2L2,',',1X,A7,',',1X,A11,',',1X,A9,',',1X,A6,',',1X,A11,', Opening file unit: ',A) - ENDIF + + ! ********************************************************************************************************************************** ! Check inputs for sensibility (coding errors if wrong) @@ -278,11 +251,11 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI ENDIF IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT, WRITE_F04 ) + CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) IERR = IERR + 1 ELSE IF (XTIME /= STIME) THEN - CALL STMERR ( XTIME, FILNAM, OUNT, 'Y' ) + CALL STMERR ( XTIME, FILNAM, OUNT ) IERR = IERR +1 ENDIF ENDIF @@ -293,35 +266,20 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI WRITE(UNIT) STIME ENDIF IF (WRITE_VER == 'Y') THEN - IF (UNIT == ANS) THEN - WRITE(UNIT,118) PROG_NAME, MYSTRAN_VER_NUM, MYSTRAN_VER_MONTH, MYSTRAN_VER_DAY, MYSTRAN_VER_YEAR, & - MYSTRAN_AUTHOR - ELSE - WRITE(UNIT,117) PROG_NAME, MYSTRAN_VER_NUM, MYSTRAN_VER_MONTH, MYSTRAN_VER_DAY, MYSTRAN_VER_YEAR, & - MYSTRAN_AUTHOR, MYSTRAN_COMMENT - ENDIF + WRITE(UNIT,117) PROG_NAME, MYSTRAN_VER_NUM, MYSTRAN_VER_MONTH, MYSTRAN_VER_DAY, MYSTRAN_VER_YEAR, & + MYSTRAN_AUTHOR, MYSTRAN_COMMENT ENDIF ENDIF ELSE - CALL OPNERR ( IOCHK, FILNAM, OUNT, 'Y' ) + CALL OPNERR ( IOCHK, FILNAM, OUNT ) IERR = IERR +1 ENDIF IF (IERR > 0) THEN - CALL FILERR ( OUNT, WRITE_F04 ) + CALL FILERR ( OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - IF ((UNIT /= F04) .AND. (UNIT /= IN1)) THEN - INQUIRE(FILE=FILNAM,EXIST=FILE_EXIST) - INQUIRE(FILE=FILNAM,OPENED=FILE_OPND) - WRITE(F04,9002) SUBR_NAME,TSEC,FILE_EXIST,FILE_OPND - ENDIF - 9002 FORMAT(1X,A,' END ',F10.3,2L2) - ENDIF RETURN diff --git a/Source/UTIL/FULL_TO_SPARSE_CRS.f90 b/Source/UTIL/FULL_TO_SPARSE_CRS.f90 index 444950fb..1dbcf10f 100644 --- a/Source/UTIL/FULL_TO_SPARSE_CRS.f90 +++ b/Source/UTIL/FULL_TO_SPARSE_CRS.f90 @@ -30,12 +30,11 @@ SUBROUTINE FULL_TO_SPARSE_CRS ( MATIN_NAME, N, M, MATIN_FULL, NTERM_ALLOC, SMALL ! Converts matrices in full format to sparse (compressed row storage) format USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : FULL_TO_SPARSE_CRS_BEGEND USE FULL_TO_SPARSE_CRS_USE_IFs @@ -55,7 +54,7 @@ SUBROUTINE FULL_TO_SPARSE_CRS ( MATIN_NAME, N, M, MATIN_FULL, NTERM_ALLOC, SMALL INTEGER(LONG) :: JSTART ! Starting value for a DO loop INTEGER(LONG) :: KTERM ! Counter INTEGER(LONG) :: ROW_I_NTERMS ! No. terms in row I of output matrix MATOUT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = FULL_TO_SPARSE_CRS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN_FULL(N,M) ! Real nonzero values in input matrix MATIN REAL(DOUBLE) , INTENT(IN) :: SMALL ! Terms < SMALL are filtered out (both here and in calling subr) @@ -63,12 +62,7 @@ SUBROUTINE FULL_TO_SPARSE_CRS ( MATIN_NAME, N, M, MATIN_FULL, NTERM_ALLOC, SMALL INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** 34568 FORMAT(' I, J, MATIN_FULL(I,J) = ', 2i8, 1es14.6) @@ -112,12 +106,7 @@ SUBROUTINE FULL_TO_SPARSE_CRS ( MATIN_NAME, N, M, MATIN_FULL, NTERM_ALLOC, SMALL CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GEN_T0L.f90 b/Source/UTIL/GEN_T0L.f90 index ebf34e7b..96d0d7e1 100644 --- a/Source/UTIL/GEN_T0L.f90 +++ b/Source/UTIL/GEN_T0L.f90 @@ -68,11 +68,10 @@ SUBROUTINE GEN_T0L (RGRID_ROW, ICORD, THETAD, PHID, T0L ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE CONSTANTS_1, ONLY : ZERO, ONE, ONE80, PI - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, f06 + USE IOUNT1, ONLY : WRT_ERR, f06 USE SCONTR, ONLY : BLNK_SUB_NAM USE PARAMS, ONLY : EPSIL USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GEN_T0L_BEGEND USE MODEL_STUF, ONLY : RGRID, CORD, RCORD USE GEN_T0L_USE_IFs @@ -88,7 +87,7 @@ SUBROUTINE GEN_T0L (RGRID_ROW, ICORD, THETAD, PHID, T0L ) ! the grid whose transformation we seek. INTEGER(LONG), INTENT(IN) :: ICORD ! Internal coord ID for coord sys L INTEGER(LONG) :: I,J,K ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GEN_T0L_BEGEND + REAL(DOUBLE), INTENT(OUT) :: THETAD,PHID ! Azimuth and elevation angles (deg) for cylindrical/spherical coord sys REAL(DOUBLE), INTENT(OUT) :: T0L(3,3) ! 3 x 3 coord transformation matrix described above @@ -107,12 +106,7 @@ SUBROUTINE GEN_T0L (RGRID_ROW, ICORD, THETAD, PHID, T0L ) INTRINSIC :: DASIN, DATAN2, DSIN, DCOS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -241,12 +235,7 @@ SUBROUTINE GEN_T0L (RGRID_ROW, ICORD, THETAD, PHID, T0L ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_ARRAY_ROW_NUM.f90 b/Source/UTIL/GET_ARRAY_ROW_NUM.f90 index 8f4df876..a9a4e675 100644 --- a/Source/UTIL/GET_ARRAY_ROW_NUM.f90 +++ b/Source/UTIL/GET_ARRAY_ROW_NUM.f90 @@ -42,11 +42,10 @@ SUBROUTINE GET_ARRAY_ROW_NUM ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY, EXT_ID, R USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, f06 + USE IOUNT1, ONLY : WRT_ERR, ERR, f06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE, TWO - USE SUBR_BEGEND_LEVELS, ONLY : GET_ARRAY_ROW_NUM_BEGEND USE GET_ARRAY_ROW_NUM_USE_IFs @@ -63,18 +62,13 @@ SUBROUTINE GET_ARRAY_ROW_NUM ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY, EXT_ID, R INTEGER(LONG) :: HI, LO ! Used to bound the range of N where EXT_ID is expected to be found INTEGER(LONG) :: LAST ! Previous value of N in the search INTEGER(LONG) :: N ! When the search is completed, N is the ROW_NUM we ara looking for - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_ARRAY_ROW_NUM_BEGEND + INTEGER(LONG) :: TMP_N ! Real value of (DBL_HI + DBL_LO + 1.D0)/2.D0 INTEGER(LONG) :: TMP_HI ! Real value of HI INTEGER(LONG) :: TMP_LO ! Real value of LO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -124,12 +118,7 @@ SUBROUTINE GET_ARRAY_ROW_NUM ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY, EXT_ID, R ROW_NUM = N -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -142,43 +131,3 @@ SUBROUTINE GET_ARRAY_ROW_NUM ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY, EXT_ID, R END SUBROUTINE GET_ARRAY_ROW_NUM - SUBROUTINE ASSERT_ARRAY_SORTED ( ARRAY_NAME, CALLING_SUBR, ASIZE, ARRAY ) - ! Checks and asserts that the array is sorted - ! This check was previously internal to GET_ARRAY_ROW_NUM, however that function is usually called in large loops - ! leading to much longer runtimes. - ! - ! ********************************************************************************************************************************** - - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, f06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - - USE GET_ARRAY_ROW_NUM_USE_IFs - - IMPLICIT NONE - - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'ASSERT_ARRAY_SORTED' - CHARACTER(LEN=*), INTENT(IN) :: ARRAY_NAME ! Name of array to be searched - CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Name of subr that called this one - - INTEGER(LONG), INTENT(IN) :: ASIZE ! Size of ARRAY - INTEGER(LONG), INTENT(IN) :: ARRAY(ASIZE) ! Array to search - INTEGER(LONG) :: N ! Loop index - ! ********************************************************************************************************************************** - - ! Make sure array is sorted into numerically increasing order - - DO N=2,ASIZE - IF (ARRAY(N) < ARRAY(N-1)) THEN - FATAL_ERR = FATAL_ERR + 1 - WRITE(ERR,920) CALLING_SUBR, ARRAY_NAME - WRITE(F06,920) CALLING_SUBR, ARRAY_NAME - CALL OUTA_HERE ( 'Y' ) - ENDIF - ENDDO - RETURN - ! ********************************************************************************************************************************** - 920 FORMAT(' *ERROR 920: PROGRAMMING ERROR IN SUBROUTINE ',A & - ,/,14X,' INPUT ARRAY ',A,' MUST BE SORTED IN NUMERICALLY INCREASING ORDER FOR THIS SUBR TO WORK') - - END SUBROUTINE ASSERT_ARRAY_SORTED diff --git a/Source/UTIL/GET_CHAR_STRING_END.f90 b/Source/UTIL/GET_CHAR_STRING_END.f90 index 8ba35259..2ea3f4a2 100644 --- a/Source/UTIL/GET_CHAR_STRING_END.f90 +++ b/Source/UTIL/GET_CHAR_STRING_END.f90 @@ -29,10 +29,8 @@ SUBROUTINE GET_CHAR_STRING_END ( CHAR_STRING, IEND ) ! Searches integer array ARRAY to find column where data ends (IEND) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_CHAR_STRING_END_BEGEND USE GET_CHAR_STRING_END_USE_IFs @@ -43,14 +41,9 @@ SUBROUTINE GET_CHAR_STRING_END ( CHAR_STRING, IEND ) INTEGER(LONG) , INTENT(OUT) :: IEND ! Col where CHAR_STRING stops having non blanks INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_CHAR_STRING_END_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** IEND = LEN(CHAR_STRING) @@ -61,12 +54,7 @@ SUBROUTINE GET_CHAR_STRING_END ( CHAR_STRING, IEND ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_FORMATTED_INTEGER.f90 b/Source/UTIL/GET_FORMATTED_INTEGER.f90 index ef70d721..1921a16d 100644 --- a/Source/UTIL/GET_FORMATTED_INTEGER.f90 +++ b/Source/UTIL/GET_FORMATTED_INTEGER.f90 @@ -29,10 +29,8 @@ SUBROUTINE GET_FORMATTED_INTEGER ( INT, CHAR_INT, NUM_CHARS, NUM_DIGITS ) ! Converts an integer to a character value with comma format (e.g. 12345 becomes char value 12,345) and writes result to unit UNT USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_LOG, F04 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_FORMATTED_INTEGER_BEGEND USE GET_FORMATTED_INTEGER_USE_IFs @@ -45,18 +43,13 @@ SUBROUTINE GET_FORMATTED_INTEGER ( INT, CHAR_INT, NUM_CHARS, NUM_DIGITS ) CHARACTER(WORD_LEN*BYTE), INTENT(OUT) :: CHAR_INT ! Integer formatted to have comma's (36879 becomes 36,879) CHARACTER(WORD_LEN*BYTE) :: TEMP_CHAR_INT ! Temporary value of CHAR_INT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_FORMATTED_INTEGER_BEGEND + INTEGER(LONG), INTENT(IN) :: INT ! Integer to be converted to formated value in CHAR_INT INTEGER(LONG), INTENT(OUT) :: NUM_CHARS ! Num of non blank chars in CHAR_INT after formatting w/ commas INTEGER(LONG), INTENT(OUT) :: NUM_DIGITS ! Number of digits in INT INTEGER(LONG) :: I,J,K ! DO loop indices or counters -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize @@ -135,12 +128,7 @@ SUBROUTINE GET_FORMATTED_INTEGER ( INT, CHAR_INT, NUM_CHARS, NUM_DIGITS ) !xx ENDIF !xx ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_GRID_AND_COMP.f90 b/Source/UTIL/GET_GRID_AND_COMP.f90 index 57077442..6848d871 100644 --- a/Source/UTIL/GET_GRID_AND_COMP.f90 +++ b/Source/UTIL/GET_GRID_AND_COMP.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_GRID_AND_COMP ( X_SET, DOF_NUM, GRIDV, COMPV ) ! Gets the grid and displ component (1-6) numbers for a DOF listed in array TDOFI. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_GRID_AND_COMP_BEGEND USE DOF_TABLES, ONLY : TDOFI USE GET_GRID_AND_COMP_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE GET_GRID_AND_COMP ( X_SET, DOF_NUM, GRIDV, COMPV ) INTEGER(LONG), INTENT(OUT) :: GRIDV ! Grid num corresponding to DOF_NUM in array TDOFI, col X_SET_COL_NUM INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: X_SET_COL_NUM ! Col number, in TDOFI array, of the X-set DOF list - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_GRID_AND_COMP_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -73,12 +67,7 @@ SUBROUTINE GET_GRID_AND_COMP ( X_SET, DOF_NUM, GRIDV, COMPV ) ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_GRID_NUM_COMPS.f90 b/Source/UTIL/GET_GRID_NUM_COMPS.f90 index 3c6eb95f..8077ae74 100644 --- a/Source/UTIL/GET_GRID_NUM_COMPS.f90 +++ b/Source/UTIL/GET_GRID_NUM_COMPS.f90 @@ -23,74 +23,29 @@ ! _______________________________________________________________________________________________________ ! End MIT license text. + + + SUBROUTINE GET_GRID_NUM_COMPS ( IGRID, NUM_COMPS, CALLING_SUBR ) - SUBROUTINE GET_GRID_NUM_COMPS ( GRID_NUM, NUM_COMPS, CALLING_SUBR ) - -! Gets the number of components for a "grid" number from array GRID by testing GRID(I,6) +! Gets the number of components for a "grid" number from array GRID by testing GRID(IGRID,6) ! If GRID(I,6) is 6 then this is a physical grid with 6 comps of displ and if GRID(I,6) is 1 then this is an SPOINT. - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NGRID - USE TIMDAT, ONLY : TSEC + USE PENTIUM_II_KIND, ONLY : LONG USE MODEL_STUF, ONLY : GRID - USE SUBR_BEGEND_LEVELS, ONLY : GET_GRID_NUM_COMPS_BEGEND - - USE GET_GRID_NUM_COMPS_USE_IFs IMPLICIT NONE - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'GET_GRID_NUM_COMPS' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Subr that called this one - INTEGER(LONG), INTENT(IN) :: GRID_NUM ! A grid number (calling subr checked that it is an actual grid) + INTEGER(LONG), INTENT(IN) :: IGRID ! An internal grid number INTEGER(LONG), INTENT(OUT) :: NUM_COMPS ! 6 if GRID_NUM is an physical grid, 1 if an SPOINT - INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_GRID_NUM_COMPS_BEGEND - -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF ! ********************************************************************************************************************************** -! Initialize outputs - - NUM_COMPS = 0 - -! Calc NUM_COMPS - - DO I=1,NGRID - IF (GRID(I,1) == GRID_NUM) THEN - NUM_COMPS = GRID(I,6) - EXIT - ENDIF - ENDDO - -! Error if NUM_COMPS not 1 or 6 - - IF ((NUM_COMPS /= 1) .AND. (NUM_COMPS /= 6)) THEN - FATAL_ERR = FATAL_ERR + 1 - WRITE(ERR,950) SUBR_NAME, CALLING_SUBR, GRID_NUM, NUM_COMPS - WRITE(F06,950) SUBR_NAME, CALLING_SUBR, GRID_NUM, NUM_COMPS - CALL OUTA_HERE ( 'Y' ) - ENDIF - -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + NUM_COMPS = GRID(IGRID, 6) + RETURN -! ********************************************************************************************************************************** - 950 FORMAT(' *ERROR 945: PROGRAMMING ERROR IN SUBROUTINE ',A,' CALLED BY SUBROUTINE ',A & - ,/,14X,' FOR GRID ',I8,' THE NUMBER OF DISPL COMPONENTS IS ',I8,' BUT MUST BE EITHER 1 (SPOINT) OR 6 (GRID)') - ! ********************************************************************************************************************************** - END SUBROUTINE GET_GRID_NUM_COMPS \ No newline at end of file + END SUBROUTINE GET_GRID_NUM_COMPS \ No newline at end of file diff --git a/Source/UTIL/GET_I2_MAT_FROM_I_MAT.f90 b/Source/UTIL/GET_I2_MAT_FROM_I_MAT.f90 index f383a31b..42a504d0 100644 --- a/Source/UTIL/GET_I2_MAT_FROM_I_MAT.f90 +++ b/Source/UTIL/GET_I2_MAT_FROM_I_MAT.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_I2_MAT_FROM_I_MAT ( MAT_NAME, NROWS, NTERMS, I_MAT, I2_MAT ) ! This subr does the inverse of subr GET_I_MAT_FROM_I2_MAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_I2_MAT_FROM_I_MAT_BEGEND USE GET_I2_MAT_FROM_I_MAT_USE_IFs @@ -47,14 +46,9 @@ SUBROUTINE GET_I2_MAT_FROM_I_MAT ( MAT_NAME, NROWS, NTERMS, I_MAT, I2_MAT ) INTEGER(LONG), INTENT(OUT) :: I2_MAT(NTERMS) ! Row numbers for terms in matrix MAT INTEGER(LONG) :: I,J,K ! DO loop indices or counters INTEGER(LONG) :: NUM_IN_ROW_I ! Number of nonzero terms in row I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_I2_MAT_FROM_I_MAT_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize @@ -77,12 +71,7 @@ SUBROUTINE GET_I2_MAT_FROM_I_MAT ( MAT_NAME, NROWS, NTERMS, I_MAT, I2_MAT ) ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_I_MAT_FROM_I2_MAT.f90 b/Source/UTIL/GET_I_MAT_FROM_I2_MAT.f90 index f60d3820..430fe6df 100644 --- a/Source/UTIL/GET_I_MAT_FROM_I2_MAT.f90 +++ b/Source/UTIL/GET_I_MAT_FROM_I2_MAT.f90 @@ -32,10 +32,9 @@ SUBROUTINE GET_I_MAT_FROM_I2_MAT ( MAT_NAME, NROWS, NTERMS, I2_MAT, I_MAT ) ! This subr creates I_MAT from a given I2_MAT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_I_MAT_FROM_I2_MAT_BEGEND USE GET_I_MAT_FROM_I2_MAT_USE_IFs @@ -53,14 +52,9 @@ SUBROUTINE GET_I_MAT_FROM_I2_MAT ( MAT_NAME, NROWS, NTERMS, I2_MAT, I_MAT ) INTEGER(LONG) :: IROW_OLD ! Previous value of IROW INTEGER(LONG) :: KTERM ! Count of number of nonzero terms read from FILNAM INTEGER(LONG) :: MAT_ERR = 0 ! Error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_I_MAT_FROM_I2_MAT_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** IF (NTERMS > 0) THEN @@ -107,12 +101,7 @@ SUBROUTINE GET_I_MAT_FROM_I2_MAT ( MAT_NAME, NROWS, NTERMS, I2_MAT, I_MAT ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_MACHINE_PARAMS.f90 b/Source/UTIL/GET_MACHINE_PARAMS.f90 index e2e9cf59..a0b1ace1 100644 --- a/Source/UTIL/GET_MACHINE_PARAMS.f90 +++ b/Source/UTIL/GET_MACHINE_PARAMS.f90 @@ -29,11 +29,10 @@ SUBROUTINE GET_MACHINE_PARAMS ! Use LAPACK function DLAMCH to get machine parameters for the users' computer USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE - USE SUBR_BEGEND_LEVELS, ONLY : GET_MACHINE_PARAMS_BEGEND USE MACHINE_PARAMS, ONLY : MACH_BASE, MACH_EMAX, MACH_EMIN, MACH_EPS, MACH_PREC, MACH_RMAX, MACH_RMIN, MACH_RND, & MACH_SFMIN, MACH_T, MACH_LARGE_NUM USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -45,17 +44,12 @@ SUBROUTINE GET_MACHINE_PARAMS CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'GET_MACHINE_PARAMS' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_MACHINE_PARAMS_BEGEND + REAL(DOUBLE) :: DLAMCH EXTERNAL :: DLAMCH - ! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MACH_EPS = DLAMCH ('E') @@ -91,12 +85,7 @@ SUBROUTINE GET_MACHINE_PARAMS WRITE(F06,*) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_MATRIX_DIAG_STATS.f90 b/Source/UTIL/GET_MATRIX_DIAG_STATS.f90 index 27a77a9f..3fbc3741 100644 --- a/Source/UTIL/GET_MATRIX_DIAG_STATS.f90 +++ b/Source/UTIL/GET_MATRIX_DIAG_STATS.f90 @@ -33,13 +33,12 @@ SUBROUTINE GET_MATRIX_DIAG_STATS ( MAT_NAME, INPUT_SET, NROWS, NTERM, I_KIN, J_K USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NGRID - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : AUTOSPC_RAT, EPSIL USE DOF_TABLES, ONLY : TDOFI USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : GET_MATRIX_DIAG_STATS_BEGEND USE GET_MATRIX_DIAG_STATS_USE_IFs @@ -78,7 +77,7 @@ SUBROUTINE GET_MATRIX_DIAG_STATS ( MAT_NAME, INPUT_SET, NROWS, NTERM, I_KIN, J_K INTEGER(LONG) :: TDOFI_ROW_OA_MAX ! Row/Col in TDOFI where MAX_OA_DIAG_TERM is INTEGER(LONG) :: TDOFI_ROW_MIN ! Row/Col in TDOFI where MIN_DIAG_TERM is INTEGER(LONG) :: TDOFI_ROW_MINP ! Row/Col in TDOFI where MINP_DIAG_TERM is - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_MATRIX_DIAG_STATS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: KIN(NTERM) ! Nonzero terms in the stiffness matrix REAL(DOUBLE) , INTENT(OUT) :: KIN_DIAG(NROWS) ! Diagonal terms from KIN @@ -94,12 +93,7 @@ SUBROUTINE GET_MATRIX_DIAG_STATS ( MAT_NAME, INPUT_SET, NROWS, NTERM, I_KIN, J_K INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** EPS1 = EPSIL(1) @@ -374,12 +368,7 @@ SUBROUTINE GET_MATRIX_DIAG_STATS ( MAT_NAME, INPUT_SET, NROWS, NTERM, I_KIN, J_K ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_SPARSE_CRS_COL.f90 b/Source/UTIL/GET_SPARSE_CRS_COL.f90 index 1d4ec71a..5d8ca02c 100644 --- a/Source/UTIL/GET_SPARSE_CRS_COL.f90 +++ b/Source/UTIL/GET_SPARSE_CRS_COL.f90 @@ -30,11 +30,10 @@ SUBROUTINE GET_SPARSE_CRS_COL ( MATIN_NAME, COL_NUM, NTERM, NROWS, NCOLS, I_MATI ! arrays, multiplies it by BETA, and puts result into array OUT_VEC. Sets NULL_COL to 'Y' if result is null. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : GET_SPARSE_CRS_COL_BEGEND USE GET_SPARSE_CRS_COL_USE_IFs @@ -53,18 +52,13 @@ SUBROUTINE GET_SPARSE_CRS_COL ( MATIN_NAME, COL_NUM, NTERM, NROWS, NCOLS, I_MATI INTEGER(LONG) :: I,J,K ! DO loop indices or counters INTEGER(LONG) :: NUM_TERMS_IN_ROW ! No. terms in a row of MATIN. Each term will be checked to see if it ! belongs to col number COL_NUM - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_SPARSE_CRS_COL_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM) ! Nonzero terms in matrix MATIN REAL(DOUBLE) , INTENT(IN) :: BETA ! Scalar multiplier for row from MATIN REAL(DOUBLE) , INTENT(OUT) :: OUT_VEC(NROWS) ! Output vector containing the terms from col COL_NUM of MATIN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -103,12 +97,7 @@ SUBROUTINE GET_SPARSE_CRS_COL ( MATIN_NAME, COL_NUM, NTERM, NROWS, NCOLS, I_MATI ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_SPARSE_CRS_ROW.f90 b/Source/UTIL/GET_SPARSE_CRS_ROW.f90 index 47963c86..c8930060 100644 --- a/Source/UTIL/GET_SPARSE_CRS_ROW.f90 +++ b/Source/UTIL/GET_SPARSE_CRS_ROW.f90 @@ -30,11 +30,10 @@ SUBROUTINE GET_SPARSE_CRS_ROW ( MATIN_NAME, ROW_NUM, NTERM, NROWS, NCOLS, I_MATI ! arrays, multiplies it by BETA, and puts result into array OUT_VEC. Sets NULL_ROW to 'Y' if result is null. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : GET_SPARSE_CRS_ROW_BEGEND USE GET_SPARSE_CRS_ROW_USE_IFs @@ -52,18 +51,13 @@ SUBROUTINE GET_SPARSE_CRS_ROW ( MATIN_NAME, ROW_NUM, NTERM, NROWS, NCOLS, I_MATI INTEGER(LONG), INTENT(IN ) :: ROW_NUM ! Row number for the row to get in MATIN INTEGER(LONG) :: J,K ! DO loop indices or counters INTEGER(LONG) :: NUM_TERMS_IN_ROW ! No. terms in row ROW_NUM of MATIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_SPARSE_CRS_ROW_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM) ! Nonzero terms in matrix MATIN REAL(DOUBLE) , INTENT(IN) :: BETA ! Scalar multiplier for row from MATIN REAL(DOUBLE) , INTENT(OUT) :: OUT_VEC(NCOLS) ! Output vector containing the terms from row ROW_NUM of MATIN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -95,12 +89,7 @@ SUBROUTINE GET_SPARSE_CRS_ROW ( MATIN_NAME, ROW_NUM, NTERM, NROWS, NCOLS, I_MATI ENDDO ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_SPARSE_MAT_TERM.f90 b/Source/UTIL/GET_SPARSE_MAT_TERM.f90 index 9307ff95..87cf7820 100644 --- a/Source/UTIL/GET_SPARSE_MAT_TERM.f90 +++ b/Source/UTIL/GET_SPARSE_MAT_TERM.f90 @@ -29,11 +29,10 @@ SUBROUTINE GET_SPARSE_MAT_TERM ( MATIN_NAME, I_MATIN, J_MATIN, MATIN, IROW, JCOL ! Given a row/col index, gets the real value from a sparse CRS matrix USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : GET_SPARSE_MAT_TERM_BEGEND USE GET_SPARSE_MAT_TERM_USE_IFs @@ -51,17 +50,12 @@ SUBROUTINE GET_SPARSE_MAT_TERM ( MATIN_NAME, I_MATIN, J_MATIN, MATIN, IROW, JCOL INTEGER(LONG) :: NUM_TERMS_IN_ROW ! No. terms in row IROW of MATIN INTEGER(LONG) :: J ! DO loop index INTEGER(LONG) :: K ! Counter - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_SPARSE_MAT_TERM_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERMS) ! Real vals in sparse matrix MATIN REAL(DOUBLE) , INTENT(OUT) :: MATIN_VAL -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize output value @@ -94,12 +88,7 @@ SUBROUTINE GET_SPARSE_MAT_TERM ( MATIN_NAME, I_MATIN, J_MATIN, MATIN, IROW, JCOL K = K + 1 ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 b/Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 index c79aedd4..5608f9f1 100644 --- a/Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 +++ b/Source/UTIL/GET_UG_123_IN_GRD_ORD.f90 @@ -30,14 +30,13 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) ! NGRID x 3 array where T1 is col1, T2 is col 2 and T3 is col3 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG, NGRID USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : GRID_ID USE DOF_TABLES, ONLY : TDOFI USE COL_VECS, ONLY : UG_COL USE MISC_MATRICES, ONLY : UG_T123_MAT - USE SUBR_BEGEND_LEVELS, ONLY : GET_UG_123_IN_GRD_ORD_BEGEND USE GET_UG_123_IN_GRD_ORD_USE_IFs @@ -45,7 +44,7 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'GET_UG_123_IN_GRD_ORD' - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_UG_123_IN_GRD_ORD_BEGEND + INTEGER(LONG), INTENT(OUT) :: IERR ! Local error indicator INTEGER(LONG) :: GRDS_GLOBAL(NGRID)! INTEGER(LONG) :: I,J ! DO loop indices @@ -53,12 +52,6 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) INTEGER(LONG) :: IDOFG ! Count of G-set DOF's (1 to NDOFG) INTEGER(LONG) :: NUM_COMPS ! 6 if GRID_NUM is an physical grid, 1 if an SPOINT -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF ! ********************************************************************************************************************************** IERR = 0 @@ -68,7 +61,7 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) IGRID = 0 IDOFG = 0 DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS IDOFG = IDOFG + 1 IF (IDOFG > NDOFG) CALL ARRAY_SIZE_ERROR_1 ( SUBR_NAME, IDOFG, 'TDOFI' ) @@ -100,7 +93,7 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) IDOFG = 0 DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) j_do2: DO J = 1,NUM_COMPS IDOFG = IDOFG + 1 IF (J <= 3) THEN ! We only want the 3 translations (or 1 if SPOINT) @@ -113,12 +106,7 @@ SUBROUTINE GET_UG_123_IN_GRD_ORD ( IERR ) ! Sort GRDS_GLOBAL and UG_T123_MAT so that GRDS_GLOBAL is in numerical grid order CALL SORT_INT1_REAL3 ( SUBR_NAME, 'GRDS_GLOBAL and UG_T123_MAT', NGRID, GRDS_GLOBAL, UG_T123_MAT ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/GET_VEC_MIN_MAX_ABS.f90 b/Source/UTIL/GET_VEC_MIN_MAX_ABS.f90 index 8e02c946..dfd8fad4 100644 --- a/Source/UTIL/GET_VEC_MIN_MAX_ABS.f90 +++ b/Source/UTIL/GET_VEC_MIN_MAX_ABS.f90 @@ -29,10 +29,9 @@ SUBROUTINE GET_VEC_MIN_MAX_ABS ( NROWS, ID_LIST, VECTOR, VEC_MIN, VEC_MAX, VEC_A ! Gets the MIN, MAX and ABS values from a column vector and the grids associated with the MIN and MAX USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04 + USE IOUNT1, ONLY : WRT_ERR, ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : GET_VEC_MIN_MAX_ABS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE MACHINE_PARAMS, ONLY : MACH_LARGE_NUM @@ -47,7 +46,7 @@ SUBROUTINE GET_VEC_MIN_MAX_ABS ( NROWS, ID_LIST, VECTOR, VEC_MIN, VEC_MAX, VEC_A INTEGER(LONG), INTENT(OUT) :: ID_MAX ! ID where vector is max INTEGER(LONG), INTENT(OUT) :: ID_MIN ! ID where vector is min INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = GET_VEC_MIN_MAX_ABS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: VECTOR(NROWS) ! Values to scan for MIN, MAX, ABS REAL(DOUBLE) , INTENT(OUT) :: VEC_ABS ! Abs value in vector @@ -56,12 +55,7 @@ SUBROUTINE GET_VEC_MIN_MAX_ABS ( NROWS, ID_LIST, VECTOR, VEC_MIN, VEC_MAX, VEC_A INTRINSIC :: MAX, MIN, DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -95,12 +89,7 @@ SUBROUTINE GET_VEC_MIN_MAX_ABS ( NROWS, ID_LIST, VECTOR, VEC_MIN, VEC_MAX, VEC_A VEC_ABS = MAX( DABS(VEC_MAX), DABS(VEC_MIN) ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/INVERT_FF_MAT.f90 b/Source/UTIL/INVERT_FF_MAT.f90 index 80f0e845..3b3b6e81 100644 --- a/Source/UTIL/INVERT_FF_MAT.f90 +++ b/Source/UTIL/INVERT_FF_MAT.f90 @@ -29,10 +29,9 @@ SUBROUTINE INVERT_FF_MAT ( CALLING_SUBR, MAT_A_NAME, A, NROWS, INFO ) ! Invert symmetric matrix A which is stored in full format. The return has the inverse of the matrix in array A USE PENTIUM_II_KIND, ONLY : DOUBLE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : INVERT_FF_MAT_BEGEND USE LAPACK_SYM_MAT_INV USE INVERT_FF_MAT_USE_IFs @@ -49,17 +48,10 @@ SUBROUTINE INVERT_FF_MAT ( CALLING_SUBR, MAT_A_NAME, A, NROWS, INFO ) ! < 0: if INFO = -i, the i-th argument had an illegal value ! > 0: if INFO = i, the leading minor of order i is not pos definite INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG) , PARAMETER :: SUBR_BEGEND = INVERT_FF_MAT_BEGEND - REAL(DOUBLE) , INTENT(INOUT) :: A(NROWS,NROWS) ! Matrix to invert. Inverted matrix returned in A -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! In DPOTRF A has the matrix to invert as input and the triangular factor of A coming out. In DPOTRI A has the tria factor of the @@ -93,12 +85,7 @@ SUBROUTINE INVERT_FF_MAT ( CALLING_SUBR, MAT_A_NAME, A, NROWS, INFO ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/Interfaces/WRITE_MEM_SUM_TO_F04_Interface.f90 b/Source/UTIL/LINK_MESSAGE.f90 similarity index 60% rename from Source/Interfaces/WRITE_MEM_SUM_TO_F04_Interface.f90 rename to Source/UTIL/LINK_MESSAGE.f90 index 1b469e8f..6e7cde79 100644 --- a/Source/Interfaces/WRITE_MEM_SUM_TO_F04_Interface.f90 +++ b/Source/UTIL/LINK_MESSAGE.f90 @@ -1,4 +1,4 @@ -! ############################################################################################################################### +! ################################################################################################################################## ! Begin MIT license text. ! _______________________________________________________________________________________________________ @@ -23,33 +23,68 @@ ! _______________________________________________________________________________________________________ ! End MIT license text. + + SUBROUTINE LINK_MESSAGE(MODNAM) + + USE IOUNT1, ONLY : SC1 + USE SCONTR, ONLY : LINKNO + USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC + + USE OURTIM_Interface + + IMPLICIT NONE - MODULE WRITE_MEM_SUM_TO_F04_Interface + CHARACTER(LEN=*), INTENT(IN) :: MODNAM ! Name to write to screen to describe module being run - INTERFACE +! ********************************************************************************************************************************** - SUBROUTINE WRITE_MEM_SUM_TO_F04 ( NAME, WHAT, MB_MEM, NROWS, NCOLS, SUBR_BEGEND ) + CALL OURTIM + WRITE(SC1,1096) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 - USE SCONTR, ONLY : TOT_MB_MEM_ALLOC - USE DEBUG_PARAMETERS, ONLY : DEBUG + RETURN - IMPLICIT NONE +! ********************************************************************************************************************************** + + 1096 FORMAT(1X,I2,'/',A,T69,I2,':',I2,':',I2,'.',I3) + + + END SUBROUTINE LINK_MESSAGE + + + + + + + + + + SUBROUTINE LINK_MESSAGE_I(MODNAM, I) - CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name that has MB_ALLOCATED mem allocated - CHARACTER(LEN=*), INTENT(IN) :: WHAT ! Whether to write allocated or deallocated memory + USE PENTIUM_II_KIND, ONLY : LONG + USE IOUNT1, ONLY : SC1 + USE SCONTR, ONLY : LINKNO + USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC + + USE OURTIM_Interface + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: MODNAM ! Name to write to screen to describe module being run + INTEGER(LONG), INTENT(IN) :: I ! A number displayed after the string + + +! ********************************************************************************************************************************** + + CALL OURTIM - INTEGER(LONG) , INTENT(IN) :: NCOLS ! Number of cols for matrix NAME - INTEGER(LONG) , INTENT(IN) :: NROWS ! Number of rows for matrix NAME - INTEGER(LONG) , INTENT(IN) :: SUBR_BEGEND ! SUBR_BEGEND value from calling subr + WRITE(SC1,1097) LINKNO,MODNAM,I,HOUR,MINUTE,SEC,SFRAC - REAL(DOUBLE) , INTENT(IN) :: MB_MEM ! Megabytes of mmemory allocated to array NAME + RETURN - END SUBROUTINE WRITE_MEM_SUM_TO_F04 +! ********************************************************************************************************************************** - END INTERFACE + 1097 FORMAT(1X,I2,'/',A,T59,I8,2X,I2,':',I2,':',I2,'.',I3) - END MODULE WRITE_MEM_SUM_TO_F04_Interface + END SUBROUTINE LINK_MESSAGE_I diff --git a/Source/UTIL/MATADD_FFF.f90 b/Source/UTIL/MATADD_FFF.f90 index 07fe6093..d7cc528c 100644 --- a/Source/UTIL/MATADD_FFF.f90 +++ b/Source/UTIL/MATADD_FFF.f90 @@ -31,13 +31,12 @@ SUBROUTINE MATADD_FFF ( A, B, NROW, NCOL, ALPHA, BETA, ITRNSPB, C) ! User must make certain that matrices A and B have the same number of rows and cols USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARAMS, ONLY : EPSIL - USE SUBR_BEGEND_LEVELS, ONLY : MATADD_FFF_BEGEND USE MATADD_FFF_USE_IFs @@ -49,7 +48,7 @@ SUBROUTINE MATADD_FFF ( A, B, NROW, NCOL, ALPHA, BETA, ITRNSPB, C) INTEGER(LONG), INTENT(IN) :: NCOL ! Number of cols in matrces A, B, C INTEGER(LONG), INTENT(IN) :: ITRNSPB ! Transpose indicator for matrix B INTEGER(LONG) :: I,J ! DO loop indices or counters - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATADD_FFF_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NROW,NCOL) ! Input matrix A REAL(DOUBLE) , INTENT(IN) :: B(NROW,NCOL) ! Input matrix B @@ -58,12 +57,7 @@ SUBROUTINE MATADD_FFF ( A, B, NROW, NCOL, ALPHA, BETA, ITRNSPB, C) REAL(DOUBLE) , INTENT(OUT) :: C(NROW,NCOL) ! Output matrix C - ! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -113,12 +107,7 @@ SUBROUTINE MATADD_FFF ( A, B, NROW, NCOL, ALPHA, BETA, ITRNSPB, C) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MATADD_SSS.f90 b/Source/UTIL/MATADD_SSS.f90 index 67179a55..2d8a7739 100644 --- a/Source/UTIL/MATADD_SSS.f90 +++ b/Source/UTIL/MATADD_SSS.f90 @@ -24,7 +24,8 @@ ! End MIT license text. - SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, MAT_B_NAME, NTERM_B, I_B, J_B, B, BETA, & + SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, & + MAT_B_NAME, NTERM_B, I_B, J_B, B, BETA, & MAT_C_NAME, NTERM_C, I_C, J_C, C ) !/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -43,14 +44,9 @@ SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, MAT_B_NA ! symmetric and have only terms on and above its diagonal in array C. Thus, this subr cannot add 2 matrices where one is stored ! symmetric and the other is not. The user is required to ensure that this is the case. - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR + USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE + USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE CONSTANTS_1, ONLY : ZERO - USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SPARSE_ALG_ARRAYS, ONLY : LOGICAL_VEC, REAL_VEC - USE SUBR_BEGEND_LEVELS, ONLY : MATADD_SSS_BEGEND USE MATADD_SSS_USE_IFs @@ -60,7 +56,6 @@ SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, MAT_B_NA CHARACTER(LEN=*), INTENT(IN) :: MAT_A_NAME ! Name of matrix A CHARACTER(LEN=*), INTENT(IN) :: MAT_B_NAME ! Name of matrix B CHARACTER(LEN=*), INTENT(IN) :: MAT_C_NAME ! Name of matrix C - CHARACTER( 2*BYTE) :: ALG ! Which algorithm is used in solving for the terms in a row of C INTEGER(LONG), INTENT(IN ) :: NROWS ! Number of rows in input matrices A and B INTEGER(LONG), INTENT(IN ) :: NTERM_A ! Number of nonzero terms in input matrix A @@ -72,20 +67,7 @@ SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, MAT_B_NA INTEGER(LONG), INTENT(IN ) :: J_B(NTERM_B) ! Col no's for nonzero terms in matrix B INTEGER(LONG), INTENT(OUT) :: I_C(NROWS+1) ! I_C(I+1) - I_C(I) = no. terms in row I of matrix C INTEGER(LONG), INTENT(OUT) :: J_C(NTERM_C) ! Col no's for nonzero terms in matrix C - INTEGER(LONG) :: I,J ! DO loop indices or counters - INTEGER(LONG) :: KTERM_C ! Count of number of terms as they are entered into arrays J_C and C - INTEGER(LONG) :: MAXIMAX_COL_NUM_A ! Highest col number in matrix A for any row - INTEGER(LONG) :: MAXIMAX_COL_NUM_B ! Highest col number in matrix B for any row - INTEGER(LONG) :: MAXIMAX_COL_NUM_C ! Highest col number in matrix C for any row - INTEGER(LONG) :: MAX_COL_NUM_A ! Highest col number in matrix A for one row - INTEGER(LONG) :: MAX_COL_NUM_B ! Highest col number in matrix B for one row - INTEGER(LONG) :: MAX_COL_NUM_C ! Highest col number in matrix C for one row - INTEGER(LONG) :: MIN_COL_NUM_A ! Lowest col number in matrix A for one row - INTEGER(LONG) :: MIN_COL_NUM_B ! Lowest col number in matrix B for one row - INTEGER(LONG) :: MIN_COL_NUM_C ! Lowest col number in matrix C for one row - INTEGER(LONG) :: NUM_A_ROW_I ! Num terms in row I of A matrix - INTEGER(LONG) :: NUM_B_ROW_I ! Num terms in row I of B matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATADD_SSS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero terms in matrix A REAL(DOUBLE) , INTENT(IN ) :: B(NTERM_B) ! Nonzero terms in matrix B @@ -93,319 +75,73 @@ SUBROUTINE MATADD_SSS ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, A, ALPHA, MAT_B_NA REAL(DOUBLE) , INTENT(IN ) :: BETA ! Scalar multiplier for matrix B REAL(DOUBLE) , INTENT(OUT) :: C(NTERM_C) ! Nonzero terms in matrix C -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - -! ********************************************************************************************************************************** -! Initialize outputs - - DO I=1,NROWS+1 - I_C(I) = 0 - ENDDO - - DO I=1,NTERM_C - J_C(I) = 0 - C(I) = ZERO - ENDDO - - IF ((DEBUG(81) == 2) .OR. (DEBUG(81) == 3)) CALL MATADD_SSS_DEB ( '1', ' ' ) - -! Determine the highest col number in arrays J_A and J_B - - MAXIMAX_COL_NUM_A = 0 - DO I=1,NTERM_A - IF (J_A(I) > MAXIMAX_COL_NUM_A) THEN - MAXIMAX_COL_NUM_A = J_A(I) - ENDIF - ENDDO - - MAXIMAX_COL_NUM_B = 0 - DO I=1,NTERM_B - IF (J_B(I) > MAXIMAX_COL_NUM_B) THEN - MAXIMAX_COL_NUM_B = J_B(I) - ENDIF - ENDDO - - MAXIMAX_COL_NUM_C = MAX ( MAXIMAX_COL_NUM_A, MAXIMAX_COL_NUM_B ) - -! Allocate memory to array LOGICAL_VEC, REAL_VEC (will have as many terms as MAXIMAX_COL_NUM_C and will be initialized to .FALSE.) -! In the code below, terms in range MIN_COL_NUM_C to MAX_COL_NUM_C will get reset to .TRUE. if there will be a nonzero term -! in a column of C. The variables MIN_COL_NUM_C and MAX_COL_NUM_C get calculated in the DO loop below for each row of C.) - - CALL ALLOCATE_SPARSE_ALG ( 'LOGICAL_VEC', 1, MAXIMAX_COL_NUM_C, SUBR_NAME ) - CALL ALLOCATE_SPARSE_ALG ( 'REAL_VEC', 1, MAXIMAX_COL_NUM_C, SUBR_NAME ) - -! Add matrices A and B to get matrix C (in sparse, compressed row storage, format) - - I_C(1) = 1 - - KTERM_C = 0 - DO I=1,NROWS ! Cycle over rows of A and B to find terms in matrix C - - NUM_A_ROW_I = I_A(I+1) - I_A(I) ! Number of nonzero terms in row I of matrix A - NUM_B_ROW_I = I_B(I+1) - I_B(I) ! Number of nonzero terms in row I of matrix B - -a_nor_b: IF ((NUM_A_ROW_I == 0) .AND. (NUM_B_ROW_I == 0)) THEN ! This row of A and also of B is null, so C will have no terms - ALG = 'NN' - MIN_COL_NUM_A = 0 - MAX_COL_NUM_A = 0 - MIN_COL_NUM_B = 0 - MAX_COL_NUM_B = 0 - MIN_COL_NUM_C = 0 - MAX_COL_NUM_C = 0 - I_C(I+1) = I_C(I) - ENDIF a_nor_b - -a_no_b: IF ((NUM_A_ROW_I /= 0) .AND. (NUM_B_ROW_I == 0)) THEN ! This row of A is not null but row of B is null - ALG = 'YN' - MIN_COL_NUM_B = 0 - MAX_COL_NUM_B = 0 - MIN_COL_NUM_A = J_A(I_A(I)) - MAX_COL_NUM_A = J_A(I_A(I+1)-1) - MIN_COL_NUM_C = MIN_COL_NUM_A - MAX_COL_NUM_C = MAX_COL_NUM_A - IF (KTERM_C > NTERM_C) CALL ARRAY_SIZE_ERROR_1 ( SUBR_NAME, NTERM_C, MAT_C_NAME ) - I_C(I+1) = I_C(I) + NUM_A_ROW_I - DO J=I_A(I),I_A(I+1)-1 - KTERM_C = KTERM_C + 1 - J_C(KTERM_C) = J_A(J) - C(KTERM_C) = ALPHA*A(J) - ENDDO - ENDIF a_no_b - -b_no_a: IF ((NUM_A_ROW_I == 0) .AND. (NUM_B_ROW_I /= 0)) THEN ! This row of A is null but row of B is not null - ALG = 'NY' - MIN_COL_NUM_A = 0 - MAX_COL_NUM_A = 0 - MIN_COL_NUM_B = J_B(I_B(I)) - MAX_COL_NUM_B = J_B(I_B(I+1)-1) - MIN_COL_NUM_C = MIN_COL_NUM_B - MAX_COL_NUM_C = MAX_COL_NUM_B - IF (KTERM_C > NTERM_C) CALL ARRAY_SIZE_ERROR_1 ( SUBR_NAME, NTERM_C, MAT_C_NAME ) - I_C(I+1) = I_C(I) + NUM_B_ROW_I - DO J=I_B(I),I_B(I+1)-1 - KTERM_C = KTERM_C + 1 - J_C(KTERM_C) = J_B(J) - C(KTERM_C) = BETA*B(J) - ENDDO - ENDIF b_no_a + INTEGER(LONG) :: ROW + INTEGER(LONG) :: P_A + INTEGER(LONG) :: P_B + INTEGER(LONG) :: COL_A + INTEGER(LONG) :: COL_B + INTEGER(LONG) :: CNT + REAL(DOUBLE) :: V + + -a_and_b: IF ((NUM_A_ROW_I /= 0) .AND. (NUM_B_ROW_I /= 0)) THEN ! This row of A and of B is not null. - - - ALG = 'YY' - MIN_COL_NUM_C = MAX (MAXIMAX_COL_NUM_A,MAXIMAX_COL_NUM_B)! For each row of the matrices, the following code finds the - MAX_COL_NUM_C = 0 ! range of cols (MIN_COL_NUM_C to MAX_COL_NUM_C) over which - - MIN_COL_NUM_A = J_A(I_A(I)) - MAX_COL_NUM_A = J_A(I_A(I+1)-1) - - MIN_COL_NUM_B = J_B(I_B(I)) - MAX_COL_NUM_B = J_B(I_B(I+1)-1) - - MIN_COL_NUM_C = MIN ( MIN_COL_NUM_A, MIN_COL_NUM_B ) - MAX_COL_NUM_C = MAX ( MAX_COL_NUM_A, MAX_COL_NUM_B ) - - DO J=1,MAXIMAX_COL_NUM_C ! Initialize LOGICAL_VEC, REAL_VEC before calc'ing them below - LOGICAL_VEC(J) = .FALSE. - REAL_VEC(J) = ZERO - ENDDO - - DO J=I_A(I),I_A(I+1)-1 - LOGICAL_VEC(J_A(J)) = .TRUE. - REAL_VEC(J_A(J)) = REAL_VEC(J_A(J)) + ALPHA*A(J) - ENDDO - - DO J=I_B(I),I_B(I+1)-1 - LOGICAL_VEC(J_B(J)) = .TRUE. - REAL_VEC(J_B(J)) = REAL_VEC(J_B(J)) + BETA*B(J) - ENDDO - - I_C(I+1) = I_C(I) ! Update I_C - DO J=MIN_COL_NUM_C,MAX_COL_NUM_C - IF (LOGICAL_VEC(J)) THEN - I_C(I+1) = I_C(I+1) + 1 - ENDIF - ENDDO - - DO J=MIN_COL_NUM_C,MAX_COL_NUM_C - IF (LOGICAL_VEC(J)) THEN - KTERM_C = KTERM_C + 1 - IF (KTERM_C > NTERM_C) CALL ARRAY_SIZE_ERROR_1 ( SUBR_NAME, NTERM_C, MAT_C_NAME ) - J_C(KTERM_C) = J - C(KTERM_C) = REAL_VEC(J) - ENDIF - ENDDO - - ENDIF a_and_b - - IF (ALG /= 'NN') THEN - IF ((DEBUG(81) == 2) .OR. (DEBUG(81) == 3)) CALL MATADD_SSS_DEB ( '3', ALG ) - ENDIF - - ENDDO - - CALL DEALLOCATE_SPARSE_ALG ( 'LOGICAL_VEC' ) - CALL DEALLOCATE_SPARSE_ALG ( 'REAL_VEC' ) - - IF ((DEBUG(81) == 2) .OR. (DEBUG(81) == 3)) CALL MATADD_SSS_DEB ( '9', ' ' ) ! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF - - RETURN - -! ********************************************************************************************************************************** - -! ################################################################################################################################## - CONTAINS - -! ################################################################################################################################## - - SUBROUTINE MATADD_SSS_DEB ( WHICH, ALG ) - - CHARACTER(LEN=*), INTENT(IN) :: ALG ! Which algorithm is used - CHARACTER( 1*BYTE) :: WHICH ! Decides what to print out for this call to this subr - - INTEGER(LONG) :: DELTA_NTERM_C ! Number of terms in a row of matrix C - INTEGER(LONG) :: II,JJ,KK ! Local DO loop index - INTEGER(LONG) :: I,J,K ! Local DO loop index - -! ********************************************************************************************************************************** - IF (WHICH == '1') THEN - - WRITE(F06,*) - WRITE(F06,1011) - WRITE(F06,1012) - WRITE(F06,1013) - WRITE(F06,1014) MAT_A_NAME, MAT_B_NAME, MAT_C_NAME - WRITE(F06,1015) NROWS, NTERM_A, NROWS, NTERM_B, NTERM_C - WRITE(F06,1016) ALPHA, BETA - WRITE(F06,1017) - WRITE(F06,*) - - ELSE IF (WHICH == '2') THEN - - ELSE IF (WHICH == '3') THEN - - WRITE(F06,1021) - WRITE(F06,1022) I - WRITE(F06,1024) - WRITE(F06,*) + CNT = 0 + I_C(1) = 1 - DELTA_NTERM_C = I_C(I+1) - I_C(I) - DO JJ=1,DELTA_NTERM_C - KK = KTERM_C - DELTA_NTERM_C + JJ - IF (JJ == 1) THEN - WRITE(F06,1031) I, ALG, MIN_COL_NUM_A, MAX_COL_NUM_A, MIN_COL_NUM_B, MAX_COL_NUM_B, MIN_COL_NUM_C, MAX_COL_NUM_C,& - I_C(I), KK, J_C(KK), C(KK) + DO ROW=1,NROWS + P_A = I_A(ROW) + P_B = I_B(ROW) + + DO WHILE(P_A < I_A(ROW+1) .OR. P_B < I_B(ROW+1)) + + ! Sentinel when A's row is exhausted + IF (P_A < I_A(ROW+1)) then + COL_A = J_A(P_A) ELSE - WRITE(F06,1032) KK, J_C(KK), C(KK) + COL_A = HUGE(0) + ENDIF + ! Sentinel when B's row is exhausted + IF (P_B < I_B(ROW+1)) then + COL_B = J_B(P_B) + ELSE + COL_B = HUGE(0) ENDIF - ENDDO - WRITE(F06,*) - - ELSE IF (WHICH == '4') THEN - - ELSE IF (WHICH == '5') THEN - - ELSE IF (WHICH == '6') THEN - - ELSE IF (WHICH == '7') THEN - - ELSE IF (WHICH == '8') THEN - - ELSE IF (WHICH == '9') THEN - WRITE(F06,*) - WRITE(F06,1091) MAT_C_NAME - DO I=1,NROWS+1 ! The number of rows in C is the same as that in A - WRITE(F06,9192) I,I_C(I) - ENDDO - WRITE(F06,*) - WRITE(F06,1093) - DO KK=1,NTERM_C - WRITE(F06,1094) KK, J_C(KK), C(KK) + + IF (COL_A < COL_B) THEN ! Only A has an entry in this column + CNT = CNT + 1 + C(CNT) = ALPHA * A(P_A) + J_C(CNT) = COL_A + P_A = P_A + 1 + ELSE IF (COL_B < COL_A) THEN ! Only B has an entry in this column + CNT = CNT + 1 + C(CNT) = BETA * B(P_B) + J_C(CNT) = COL_B + P_B = P_B + 1 + ELSE ! Both have an entry — add + V = ALPHA * A(P_A) + BETA * B(P_B) + CNT = CNT + 1 + C(CNT) = V + J_C(CNT) = COL_A + P_A = P_A + 1 + P_B = P_B + 1 + ENDIF + ENDDO - WRITE(F06,*) - WRITE(F06,1095) - - ENDIF - -! ********************************************************************************************************************************** - 1011 FORMAT(' __________________________________________________________________________________________________________________',& - '_________________' ,//,& - ' :::::::::::::::::::::::::::::::::::::::START DEBUG(81) OUTPUT FROM SUBROUTINE MATADD_SSS::::::::::::::::::::::::::',& - ':::::::::::::::::',/) - - 1012 FORMAT(' SSS SPARSE MATRIX ADD ROUTINE: Add sparse matrices A and B in Compressed Row Storage (CRS) format to obtain CRS', & -' sparse matrix C.',/,' ------------------------------') - - 1013 FORMAT(' A and B must be stored in the same format with regard to symmetry (if one is stored symmetric, with only terms on' ,& -' and above the',/,' diagonal, the other must be also stored as symmetric.',/) - - 1014 FORMAT(42X,' The name of CRS formatted matrix A is: ',A ,/,& - 42x,' The name of CRS formatted matrix B is: ',A ,/,& - 42x,' The name of CRS formatted matrix C is: ',A,/) - - 1015 FORMAT(30X,' Matrix A has ',I8,' rows and ' ,I12,' nonzero terms' ,/,& - 30X,' Matrix B has ',I8,' rows and ' ,I12,' nonzero terms' ,/,& - 30X,' Matrix C will have same number of rows and ',I12,' nonzero terms*' ,/,& - 22X,'*(as detrmined by subr MATADD_SSS_NTERM which had to have been run prior to this subr)'/) - - 1016 FORMAT(' Add ',1ES14.6,' times matrix A to ',1ES14.6,' times matrix B to obtain matrix C',/) - - 1017 FORMAT( & -' Alg YN (below) is for the case where A has terms in the row being processed but B does not' ,/,& -' Alg NY (below) is for the case where B has terms in the row being processed but A does not' ,/,& -' Alg YY (below) is for the case where both A and B have nonzero terms in the row being processed' ,//,& -' Output is only given for non null rows of matrix C') - - 1021 FORMAT(' ******************************************************************************************************************',& - '*****************') - - 1022 FORMAT(27X,' W O R K I N G O N R O W ',I8,' O F O U T P U T M A T R I X C',//) - - 1024 FORMAT(20X,'Col Num Range For Col Num Range For Col Num Range For Data For Nonzeros For This Row For Matrix C:',/,& - 20X,'Nonzero Terms In A Nonzero Terms In B Nonzero Terms In C Row Start Index Col Nums Values' ,/,& -6X,'Row Alg Min Col Max Col Min Col Max Col Min Col Max Col I_C(I) K J_C(K) C(K)' ,/,& - 19X,'------------------ ------------------ ------------------ ---------------------------------------------') - - - 1031 FORMAT(1X,I8,4X,A2, 4X,I8,2X,I8, 4X,I8,2X,I8, 4X,I8,2X,I8,2X, I10,I10,I10,1ES17.6) - - 1032 FORMAT(93X,2I10,1ES17.6) - - 1091 FORMAT(' ******************************************************************************************************************',& - '*****************' ,/,& - ' SUMMARY: Compressed Row Storage (CRS) format of matrix C = ',A,':',/,' -------' ,//,& - ' 1) Index, L, and array I_C(L) for matrix C, where I_C(L+1) - I_C(L) is the number of nonzero terms in row L of' ,& - ' matrix C.',/,' (also, I_C(L) is the index, K, in array C(K) where row L begins - up to, but not including, the' ,& - ' last entry in I_C(L)).',/) - - 9192 FORMAT(' L, I_C(L) = ',2I12) + + I_C(ROW+1) = CNT + 1 + + ENDDO - 1093 FORMAT(' 2) Index, K, and arrays J_C(K) and C(K). C(K) are the nonzeros in matrix C and J_C(K) is the col number in matrix', & - ' C for term C(K).',/) - 1094 FORMAT(' K, J_C(K), C(K) = ',2I12,1ES15.6) - 1095 FORMAT(' ::::::::::::::::::::::::::::::::::::::END DEBUG(81) OUTPUT FROM SUBROUTINE MATADD_SSS:::::::::::::::::::::::::::::',& - ':::::::::::::::::' ,/,& - ' __________________________________________________________________________________________________________________',& - '_________________',/) + + RETURN ! ********************************************************************************************************************************** - END SUBROUTINE MATADD_SSS_DEB END SUBROUTINE MATADD_SSS diff --git a/Source/UTIL/MATADD_SSS_NTERM.f90 b/Source/UTIL/MATADD_SSS_NTERM.f90 index 1eb4395d..75687e07 100644 --- a/Source/UTIL/MATADD_SSS_NTERM.f90 +++ b/Source/UTIL/MATADD_SSS_NTERM.f90 @@ -39,14 +39,11 @@ SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, MAT_B ! symmetric and have only terms on and above its diagonal in array C. Thus, this subr cannot add 2 matrices where one is stored ! symmetric and the other is not. The user is required to ensure that this is the case. - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, WARN_ERR + USE PENTIUM_II_KIND, ONLY : LONG + USE IOUNT1, ONLY : ERR, F06 + USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE PARAMS, ONLY : SUPWARN USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SPARSE_ALG_ARRAYS, ONLY : LOGICAL_VEC - USE SUBR_BEGEND_LEVELS, ONLY : MATADD_SSS_NTERM_BEGEND USE MATADD_SSS_NTERM_USE_IFs @@ -60,7 +57,6 @@ SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, MAT_B ! or nonsym (all terms) CHARACTER(LEN=*), INTENT(IN) :: SYM_B ! Flag for whether matrix B is stored sym (terms on and above diag) ! or nonsym (all terms) - CHARACTER( 2*BYTE) :: ALG ! Which algorithm is used in solving for the terms in a row of C INTEGER(LONG), INTENT(IN ) :: NROWS ! Number of rows in input matrices A and B INTEGER(LONG), INTENT(IN ) :: NTERM_A ! Number of nonzero terms in input matrix A @@ -70,27 +66,18 @@ SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, MAT_B INTEGER(LONG), INTENT(IN ) :: J_A(NTERM_A) ! Col no's for nonzero terms in matrix A INTEGER(LONG), INTENT(IN ) :: J_B(NTERM_B) ! Col no's for nonzero terms in matrix B INTEGER(LONG), INTENT(OUT) :: NTERM_C ! Number of nonzero terms in output matrix C - INTEGER(LONG) :: DELTA_NTERM_C ! Number of terms that will go into matrix C for one row - INTEGER(LONG) :: I,J ! DO loop indices or counters - INTEGER(LONG) :: MAXIMAX_COL_NUM_A ! Highest col number in matrix A for any row - INTEGER(LONG) :: MAXIMAX_COL_NUM_B ! Highest col number in matrix B for any row - INTEGER(LONG) :: MAXIMAX_COL_NUM_C ! Highest col number in matrix C for any row - INTEGER(LONG) :: MAX_COL_NUM_A ! Highest col number in matrix A for one row - INTEGER(LONG) :: MAX_COL_NUM_B ! Highest col number in matrix B for one row - INTEGER(LONG) :: MAX_COL_NUM_C ! Highest col number in matrix C for one row - INTEGER(LONG) :: MIN_COL_NUM_A ! Lowest col number in matrix A for one row - INTEGER(LONG) :: MIN_COL_NUM_B ! Lowest col number in matrix B for one row - INTEGER(LONG) :: MIN_COL_NUM_C ! Lowest col number in matrix C for one row - INTEGER(LONG) :: NUM_A_ROW_I ! Num terms in row I of A matrix - INTEGER(LONG) :: NUM_B_ROW_I ! Num terms in row I of B matrix - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATADD_SSS_NTERM_BEGEND + + + + INTEGER(LONG) :: ROW + INTEGER(LONG) :: P_A + INTEGER(LONG) :: P_B + INTEGER(LONG) :: COL_A + INTEGER(LONG) :: COL_B + INTEGER(LONG) :: CNT + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make sure that input matrices A and B are stored in same format @@ -102,143 +89,50 @@ SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, MAT_B CALL OUTA_HERE ( 'Y' ) ENDIF -! Initialize outputs - - NTERM_C = 0 - - IF ((DEBUG(81) == 1) .OR. (DEBUG(81) == 3)) CALL MATADD_SSS_NTERM_DEB ( '1', ' ' ) -! Determine the highest col number in arrays J_A and J_B - MAXIMAX_COL_NUM_A = 0 - DO I=1,NTERM_A - IF (J_A(I) > MAXIMAX_COL_NUM_A) THEN - MAXIMAX_COL_NUM_A = J_A(I) - ENDIF - ENDDO + CNT = 0 + + DO ROW=1,NROWS + P_A = I_A(ROW) + P_B = I_B(ROW) + + DO WHILE(P_A < I_A(ROW+1) .OR. P_B < I_B(ROW+1)) + + ! Sentinel when A's row is exhausted + IF (P_A < I_A(ROW+1)) then + COL_A = J_A(P_A) + ELSE + COL_A = HUGE(0) + ENDIF + ! Sentinel when B's row is exhausted + IF (P_B < I_B(ROW+1)) then + COL_B = J_B(P_B) + ELSE + COL_B = HUGE(0) + ENDIF - MAXIMAX_COL_NUM_B = 0 - DO I=1,NTERM_B - IF (J_B(I) > MAXIMAX_COL_NUM_B) THEN - MAXIMAX_COL_NUM_B = J_B(I) - ENDIF + + IF (COL_A < COL_B) THEN ! Only A has an entry in this column + CNT = CNT + 1 + P_A = P_A + 1 + ELSE IF (COL_B < COL_A) THEN ! Only B has an entry in this column + CNT = CNT + 1 + P_B = P_B + 1 + ELSE ! Both have an entry + CNT = CNT + 1 + P_A = P_A + 1 + P_B = P_B + 1 + ENDIF + + ENDDO + ENDDO - MAXIMAX_COL_NUM_C = MAX ( MAXIMAX_COL_NUM_A, MAXIMAX_COL_NUM_B ) - -! Write warning if these MAXIMAX_COL_NUM_A /= MAXIMAX_COL_NUM_B -! -! IF (MAXIMAX_COL_NUM_A /= MAXIMAX_COL_NUM_B) THEN -! WARN_ERR = WARN_ERR + 1 -! WRITE(ERR,1700) MAT_A_NAME, MAT_B_NAME, SUBR_NAME, MAT_A_NAME, MAXIMAX_COL_NUM_A, MAT_B_NAME, MAXIMAX_COL_NUM_B -! IF (SUPWARN == 'N') THEN -! WRITE(F06,1700) MAT_A_NAME, MAT_B_NAME, SUBR_NAME, MAT_A_NAME, MAXIMAX_COL_NUM_A, MAT_B_NAME, MAXIMAX_COL_NUM_B -! ENDIF -! ENDIF -! - IF ((DEBUG(81) == 1) .OR. (DEBUG(81) == 3)) CALL MATADD_SSS_NTERM_DEB ( '2', ' ' ) - -! Allocate memory to array LOGICAL_VEC (it will have as many terms as MAXIMAX_COL_NUM_C and will be initialized to .FALSE.) -! In the code below, terms in range MIN_COL_NUM_C to MAX_COL_NUM_C will get reset to .TRUE. if there will be a nonzero term -! in a column of C. The variables MIN_COL_NUM_C and MAX_COL_NUM_C get calculated in the DO loop below for each row of C.) - - CALL ALLOCATE_SPARSE_ALG ( 'LOGICAL_VEC', 1, MAXIMAX_COL_NUM_C, SUBR_NAME ) - -! Count number of terms (NTERM_C) that will go into output matrix C - - DO I=1,NROWS ! Cycle over rows of A and B to find terms in matrix C - - NUM_A_ROW_I = I_A(I+1) - I_A(I) ! Number of nonzero terms in row I of matrix A - NUM_B_ROW_I = I_B(I+1) - I_B(I) ! Number of nonzero terms in row I of matrix B - -a_nor_b: IF ((NUM_A_ROW_I == 0) .AND. (NUM_B_ROW_I == 0)) THEN ! This row of A and also of B is null, so C will have no terms - ALG = 'NN' - MIN_COL_NUM_A = 0 - MAX_COL_NUM_A = 0 - MIN_COL_NUM_B = 0 - MAX_COL_NUM_B = 0 - MIN_COL_NUM_C = 0 - MAX_COL_NUM_C = 0 - DELTA_NTERM_C = 0 - ENDIF a_nor_b - -a_no_b: IF ((NUM_A_ROW_I /= 0) .AND. (NUM_B_ROW_I == 0)) THEN ! This row of A is not null but row of B is null - ALG = 'YN' - MIN_COL_NUM_B = 0 - MAX_COL_NUM_B = 0 - MIN_COL_NUM_A = J_A(I_A(I)) - MAX_COL_NUM_A = J_A(I_A(I+1)-1) - MIN_COL_NUM_C = MIN_COL_NUM_A - MAX_COL_NUM_C = MAX_COL_NUM_A - DELTA_NTERM_C = NUM_A_ROW_I ! so DELTA_NTERM_C is only the num of terms in A for this row - NTERM_C = NTERM_C + NUM_A_ROW_I - ENDIF a_no_b - -b_no_a: IF ((NUM_A_ROW_I == 0) .AND. (NUM_B_ROW_I /= 0)) THEN ! This row of A is null but row of B is not null - ALG = 'NY' - MIN_COL_NUM_A = 0 - MAX_COL_NUM_A = 0 - MIN_COL_NUM_B = J_B(I_B(I)) - MAX_COL_NUM_B = J_B(I_B(I+1)-1) - MIN_COL_NUM_C = MIN_COL_NUM_B - MAX_COL_NUM_C = MAX_COL_NUM_B - DELTA_NTERM_C = NUM_B_ROW_I ! so DELTA_NTERM_C is only the num of terms in A for this row - NTERM_C = NTERM_C + NUM_B_ROW_I - ENDIF b_no_a + NTERM_C = CNT -a_and_b: IF ((NUM_A_ROW_I /= 0) .AND. (NUM_B_ROW_I /= 0)) THEN ! This row of A and of B is not null. - ALG = 'YY' - MIN_COL_NUM_C = MAX (MAXIMAX_COL_NUM_A,MAXIMAX_COL_NUM_B)! For each row of the matrices, the following code finds the - MAX_COL_NUM_C = 0 ! range of cols (MIN_COL_NUM_C to MAX_COL_NUM_C) over which - MIN_COL_NUM_A = J_A(I_A(I)) - MAX_COL_NUM_A = J_A(I_A(I+1)-1) - - MIN_COL_NUM_B = J_B(I_B(I)) - MAX_COL_NUM_B = J_B(I_B(I+1)-1) - - MIN_COL_NUM_C = MIN ( MIN_COL_NUM_A, MIN_COL_NUM_B ) - MAX_COL_NUM_C = MAX ( MAX_COL_NUM_A, MAX_COL_NUM_B ) - - DO J=1,MAXIMAX_COL_NUM_C ! Initialize LOGICAL_VEC before calc'ing it below - LOGICAL_VEC(J) = .FALSE. - ENDDO - - DO J=I_A(I),I_A(I+1)-1 - LOGICAL_VEC(J_A(J)) = .TRUE. - ENDDO - - DO J=I_B(I),I_B(I+1)-1 - LOGICAL_VEC(J_B(J)) = .TRUE. - ENDDO - - DELTA_NTERM_C = 0 ! LOGICAL_VEC now has T for each col that will have a term in - DO J=MIN_COL_NUM_C,MAX_COL_NUM_C ! matrix A+B. Count the T's in LOGICAL_VEC. This will be the - IF (LOGICAL_VEC(J)) THEN ! number of nonzero terms in this row for matrix A+B - DELTA_NTERM_C = DELTA_NTERM_C + 1 - ENDIF - ENDDO - NTERM_C = NTERM_C + DELTA_NTERM_C ! Update NTERM_C, the total count of nonzero's in A+B - - ENDIF a_and_b - - IF (ALG /= 'NN') THEN - IF ((DEBUG(81) == 1) .OR. (DEBUG(81) == 3)) CALL MATADD_SSS_NTERM_DEB ( '3', ALG ) - ENDIF - - ENDDO - - CALL DEALLOCATE_SPARSE_ALG ( 'LOGICAL_VEC' ) - - IF ((DEBUG(81) == 1) .OR. (DEBUG(81) == 3)) CALL MATADD_SSS_NTERM_DEB ( '9', ' ' ) - -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN @@ -247,116 +141,7 @@ SUBROUTINE MATADD_SSS_NTERM ( NROWS, MAT_A_NAME, NTERM_A, I_A, J_A, SYM_A, MAT_B ,/,14X,' INPUT MATRICES ',A,' AND ',A,' MUST BOTH BE STORED IN THE SAME FORMAT (SYM MUST BE BOTH "Y" OR "N").' & ,/,14X,' HOWEVER, MATRIX ',A,' HAS SYM = ',A,' AND MATRIX ',A,' HAS SYM = ',A) - 1700 FORMAT(' *WARNING : POSSIBLE INCOMPATIBILITY IN ADDING MATRIX ',A,' AND MATRIX ',A,' FOUND IN SUBR ',A & - ,/,14X,' THE HIGHEST NUMBER OF A NONZERO COLUMN IN MATRIX ',A,' IS COL NUMBER ',I8,' AND' & - ,/,14X,' THE HIGHEST NUMBER OF A NONZERO COLUMN IN MATRIX ',A,' IS COL NUMBER ',I8,'.' & - ,/,14X,' THIS IS NOT NECESSARILY AN ERROR, ONLY A NOTE TO THE PROGRAMMER THAT ITS SENSIBILITY BE VERIFIED.' & - ,/,14X,' THE MOST COMMON CAUSE FOR THIS MESSAGE IS THAT ONE OF THE SPARSE MATRICES HAS NULL COLS ON THE', & - ' RIGHT SIDE OF THE MATRIX',/) ! ********************************************************************************************************************************** -! ################################################################################################################################## - - CONTAINS - -! ################################################################################################################################## - - SUBROUTINE MATADD_SSS_NTERM_DEB ( WHICH, ALG ) - - CHARACTER(LEN=*) , INTENT(IN) :: ALG ! Which algorithm is used - CHARACTER( 1*BYTE), INTENT(IN) :: WHICH ! Decides what to print out for this call to this subr - -! ********************************************************************************************************************************** - IF (WHICH == '1') THEN - - WRITE(F06,*) - WRITE(F06,1011) - WRITE(F06,1012) - WRITE(F06,1013) - WRITE(F06,1014) MAT_A_NAME, MAT_B_NAME, MAT_C_NAME - WRITE(F06,1015) NROWS, NTERM_A, NROWS, NTERM_B - WRITE(F06,1019) - WRITE(F06,*) - - ELSE IF (WHICH == '2') THEN - - WRITE(F06,1021) - WRITE(F06,1022) - WRITE(F06,1024) - WRITE(F06,*) - ELSE IF (WHICH == '3') THEN - - WRITE(F06,1031) I, ALG, MIN_COL_NUM_A, MAX_COL_NUM_A, MIN_COL_NUM_B, MAX_COL_NUM_B, MIN_COL_NUM_C, MAX_COL_NUM_C,& - DELTA_NTERM_C, NTERM_C - - ELSE IF (WHICH == '4') THEN - - ELSE IF (WHICH == '5') THEN - - ELSE IF (WHICH == '6') THEN - - ELSE IF (WHICH == '7') THEN - - ELSE IF (WHICH == '8') THEN - - ELSE IF (WHICH == '9') THEN - - WRITE(F06,*) - WRITE(F06,1091) MAT_C_NAME, NTERM_C - - ENDIF - -! ********************************************************************************************************************************** - 1011 FORMAT(' ___________________________________________________________________________________________________________________'& - ,'________________' ,//,& - ' ::::::::::::::::::::::::::::::::::::START DEBUG(81) OUTPUT FROM SUBROUTINE MATADD_SSS_NTERM:::::::::::::::::::::::',& - ':::::::::::::::::',/) - - 1012 FORMAT(' SSS SETUP FOR SPARSE MATRIX ADD ROUTINE: Determine memory required for Compressed Row Storage (CRS) formatted', & -' matrix C resulting',/,' ---------------------------------------',/,' from the addition of two CRS matrices A and B',/) - - 1013 FORMAT(' A and B must be stored in the same format with regard to symmetry (if one is stored symmetric, with only terms on' ,& -' and above the',/,' diagonal, the other must be also stored as symmetric.',/) - - 1014 FORMAT(42X,' The name of CRS formatted matrix A is: ',A ,/,& - 42x,' The name of CRS formatted matrix B is: ',A ,/,& - 42x,' The name of CRS formatted matrix C is: ',A,/) - - 1015 FORMAT(30X,' Matrix A has ',I8,' rows and ' ,I12,' nonzero terms' ,/,& - 30X,' Matrix B has ',I8,' rows and ' ,I12,' nonzero terms',/) - - 1019 FORMAT( & -' Alg YN (below) is for the case where A has terms in the row being processed but B does not' ,/,& -' Alg NY (below) is for the case where B has terms in the row being processed but A does not' ,/,& -' Alg YY (below) is for the case where both A and B have nonzero terms in the row being processed' ,//,& -' Output is only given for non null rows of matrix C') - - 1021 FORMAT(' *******************************************************************************************************************'& - ,'****************') - - 1022 FORMAT(1X,'D E T E R M I N I N G T H E N U M B E R N O N Z E R O S T E R M S N E E D E D F O R M A T R I X C'& - ,//) - - 1024 FORMAT(20X,'Col Num Range For Col Num Range For Col Num Range For Data For Nonzeros For This Row Of Matrix C:' ,/,& - 20X,'Nonzero Terms In A Nonzero Terms In B Nonzero Terms In C Number Terms Accumulative' ,/,& -6X,'Row Alg Min Col Max Col Min Col Max Col Min Col Max Col In This Row Number Terms' ,/,& - 19X,'------------------ ------------------ ------------------ ---------------------------------------------') - - - 1031 FORMAT(1X,I8,4X,A2,4X,I8,2X,I8,4X,I8,2X,I8,4X,I8,2X,I8,11X,I8,11X,I8,I10) - - 1091 FORMAT(' *******************************************************************************************************************'& - ,'****************' ,/,& - ' SUMMARY: Matrix C = ',A,' will have ',I12,' nonzero terms',/) - - 1095 FORMAT(' :::::::::::::::::::::::::::::::::::END DEBUG(81) OUTPUT FROM SUBROUTINE MATADD_SSS_NTERM::::::::::::::::::::::::::',& - ':::::::::::::::::' ,/,& - ' ___________________________________________________________________________________________________________________'& - ,'________________',/) - -! ********************************************************************************************************************************** - - END SUBROUTINE MATADD_SSS_NTERM_DEB - END SUBROUTINE MATADD_SSS_NTERM diff --git a/Source/UTIL/MATMULT_FFF.f90 b/Source/UTIL/MATMULT_FFF.f90 index 6724e47e..875ee982 100644 --- a/Source/UTIL/MATMULT_FFF.f90 +++ b/Source/UTIL/MATMULT_FFF.f90 @@ -30,11 +30,9 @@ SUBROUTINE MATMULT_FFF ( A, B, NROWA, NCOLA, NCOLB, C ) ! NOTE: User is responsible for making sure that A and B are conformable USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_FFF_BEGEND USE MATMULT_FFF_USE_IFs @@ -47,18 +45,13 @@ SUBROUTINE MATMULT_FFF ( A, B, NROWA, NCOLA, NCOLB, C ) INTEGER(LONG), INTENT(IN) :: NCOLB ! No. cols in input matrix B INTEGER(LONG) :: I,J,K ! DO loop indices or counters INTEGER(LONG) :: NROWB ! - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_FFF_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NROWA,NCOLA) ! Input matrix A REAL(DOUBLE) , INTENT(IN) :: B(NCOLA,NCOLB) ! Input matrix B REAL(DOUBLE) , INTENT(OUT) :: C(NROWA,NCOLB) ! Output matrix C - ! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -82,12 +75,7 @@ SUBROUTINE MATMULT_FFF ( A, B, NROWA, NCOLA, NCOLB, C ) ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MATMULT_FFF_T.f90 b/Source/UTIL/MATMULT_FFF_T.f90 index de813751..02132706 100644 --- a/Source/UTIL/MATMULT_FFF_T.f90 +++ b/Source/UTIL/MATMULT_FFF_T.f90 @@ -30,11 +30,9 @@ SUBROUTINE MATMULT_FFF_T ( A, B, NROWA, NCOLA, NCOLB, C ) ! NOTE: User is responsible for making sure that A(t) and B are conformable USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_FFF_T_BEGEND USE MATMULT_FFF_T_USE_IFs @@ -49,18 +47,13 @@ SUBROUTINE MATMULT_FFF_T ( A, B, NROWA, NCOLA, NCOLB, C ) INTEGER(LONG) :: NROWB ! No. rows in input matrix B INTEGER(LONG) :: NROWA_T ! No. rows in A' (ranspose) INTEGER(LONG) :: NCOLA_T ! No. cols in A' (ranspose) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_FFF_T_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NROWA,NCOLA) ! Input matrix A REAL(DOUBLE) , INTENT(IN) :: B(NROWA,NCOLB) ! Input matrix B REAL(DOUBLE) , INTENT(OUT) :: C(NCOLA,NCOLB) ! Output matrix C -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -86,12 +79,7 @@ SUBROUTINE MATMULT_FFF_T ( A, B, NROWA, NCOLA, NCOLB, C ) ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MATMULT_SFF.f90 b/Source/UTIL/MATMULT_SFF.f90 index e2074d93..bf75d628 100644 --- a/Source/UTIL/MATMULT_SFF.f90 +++ b/Source/UTIL/MATMULT_SFF.f90 @@ -48,10 +48,8 @@ SUBROUTINE MATMULT_SFF ( MAT_A_NAME, NROWS_A, NCOLS_A, NTERM_A, SYM_A, I_A, J_A, ! This subr determines real array C USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SFF_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -89,23 +87,15 @@ SUBROUTINE MATMULT_SFF ( MAT_A_NAME, NROWS_A, NCOLS_A, NTERM_A, SYM_A, I_A, J_A, INTEGER(LONG) :: NHITS ! Number of "hits" of terms in a row of A existing where terms in ! a col of B exist when a row of A is multiplied by a col of B INTEGER(LONG) :: NTERM_AROW ! Number of nonzero terms in AROW (one row of A) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SFF_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero values in matrix A REAL(DOUBLE) , INTENT(IN ) :: B(NROWS_B,NCOLS_B)! Real values in matrix B REAL(DOUBLE) , INTENT(OUT) :: C(NROWS_A,NCOLS_B)! Real values in matrix c REAL(DOUBLE) , INTENT(IN ) :: CONS ! Constant multiplier in cons*A*B to get C REAL(DOUBLE) :: EPS1 ! A small value to compare to zero - real(double) :: tsec_beg ! - real(double) :: tsec_end ! -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - tsec_beg = tsec + ! ********************************************************************************************************************************** ! Initialize outputs @@ -242,13 +232,6 @@ SUBROUTINE MATMULT_SFF ( MAT_A_NAME, NROWS_A, NCOLS_A, NTERM_A, SYM_A, I_A, J_A, IF (DEBUG(82) == 1) CALL MATMULT_SFF_DEB ( '9', ' ' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - tsec_end = tsec - WRITE(F04,9003) SUBR_NAME,TSEC,tsec_end-tsec_beg - 9003 FORMAT(1X,A,' END ',F10.3,' (',f6.3,' sec elapsed time for subr MATMULT_SFF)') - ENDIF RETURN ! ********************************************************************************************************************************** diff --git a/Source/UTIL/MATMULT_SFS.f90 b/Source/UTIL/MATMULT_SFS.f90 index ec6b9071..4c55ddc9 100644 --- a/Source/UTIL/MATMULT_SFS.f90 +++ b/Source/UTIL/MATMULT_SFS.f90 @@ -62,10 +62,9 @@ SUBROUTINE MATMULT_SFS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, MAT_B_ ! This subr determines integer arrays I_C and J_C and real array C USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SFS_BEGEND USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : EPSIL USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -104,7 +103,7 @@ SUBROUTINE MATMULT_SFS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, MAT_B_ INTEGER(LONG) :: NTERM_AROW ! Number of nonzero terms in AROW (one row of A) INTEGER(LONG) :: ROW_AT_COLJ_BEG(NROW_A)! jth term is row number in MATIN where col j nonzeros begin INTEGER(LONG) :: ROW_AT_COLJ_END(NROW_A)! jth term is row number in MATIN where col j nonzeros end - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SFS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: CONS ! Constant multiplier in cons*A*B to get C REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero values in matrix A @@ -117,12 +116,7 @@ SUBROUTINE MATMULT_SFS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, MAT_B_ INTRINSIC :: MAX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -236,12 +230,7 @@ SUBROUTINE MATMULT_SFS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, MAT_B_ IF ((DEBUG(83) == 2) .OR. (DEBUG(83) == 3)) CALL MATMULT_SFS_DEB ( '9', ' ' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MATMULT_SFS_NTERM.f90 b/Source/UTIL/MATMULT_SFS_NTERM.f90 index 7b4c5eaa..6bad0c08 100644 --- a/Source/UTIL/MATMULT_SFS_NTERM.f90 +++ b/Source/UTIL/MATMULT_SFS_NTERM.f90 @@ -48,10 +48,9 @@ SUBROUTINE MATMULT_SFS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, MAT ! used to allocate memory for arrays J_C and C prior to calling subr MATMULT_SFS so that it can it can do the sparse matrix multiply USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SFS_NTERM_BEGEND USE PARAMS, ONLY : EPSIL USE SPARSE_ALG_ARRAYS, ONLY : J_AROW USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -88,19 +87,14 @@ SUBROUTINE MATMULT_SFS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, MAT INTEGER(LONG) :: NTERM_AROW ! Number of nonzero terms in AROW (one row of A) INTEGER(LONG) :: ROW_AT_COLJ_BEG(NROW_A)! jth term is row number in MATIN where col j nonzeros begin INTEGER(LONG) :: ROW_AT_COLJ_END(NROW_A)! jth term is row number in MATIN where col j nonzeros end - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SFS_NTERM_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: B(NROW_B,NCOL_B) ! Real values in matrix B INTRINSIC :: MAX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -230,12 +224,7 @@ SUBROUTINE MATMULT_SFS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, MAT CALL DEALLOCATE_SPARSE_ALG ( 'J_AROW' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MATMULT_SSS.f90 b/Source/UTIL/MATMULT_SSS.f90 index 48f21017..8e27d1d2 100644 --- a/Source/UTIL/MATMULT_SSS.f90 +++ b/Source/UTIL/MATMULT_SSS.f90 @@ -77,11 +77,10 @@ SUBROUTINE MATMULT_SSS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, ! J_AROW is needed to give the column numbers, from matrix A (for one row), that the terms in array AROW are for. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SSS_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE MATMULT_SSS_USE_IFs @@ -125,7 +124,7 @@ SUBROUTINE MATMULT_SSS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, INTEGER(LONG) :: NTERM_AROW ! Number of nonzero terms in AROW (one row of A) INTEGER(LONG) :: A_ROW_COLJ_BEG(NROW_A)! jth term is row number in array A where col j nonzeros begin INTEGER(LONG) :: A_ROW_COLJ_END(NROW_A)! jth term is row number in MATIN where col j nonzeros end - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SSS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: CONS ! Constant multiplier in cons*A*B to get C REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero values in matrix A @@ -137,12 +136,7 @@ SUBROUTINE MATMULT_SSS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, INTRINSIC :: MAX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make sure B is stored as nonsym (all terms) @@ -269,12 +263,7 @@ SUBROUTINE MATMULT_SSS ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, A, IF ((DEBUG(84) == 2) .OR. (DEBUG(84) == 3)) CALL MATMULT_SSS_DEB ( '9', ' ' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MATMULT_SSS_NTERM.f90 b/Source/UTIL/MATMULT_SSS_NTERM.f90 index ba0ee122..8fc46f44 100644 --- a/Source/UTIL/MATMULT_SSS_NTERM.f90 +++ b/Source/UTIL/MATMULT_SSS_NTERM.f90 @@ -58,10 +58,9 @@ SUBROUTINE MATMULT_SSS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, ! matrix multiply USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : MATMULT_SSS_NTERM_BEGEND USE SPARSE_ALG_ARRAYS, ONLY : J_AROW USE DEBUG_PARAMETERS, ONLY : DEBUG @@ -104,16 +103,11 @@ SUBROUTINE MATMULT_SSS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, INTEGER(LONG) :: NHITS_TOT_FOR_ROW_OF_A ! Num of "hits" of terms in a col of A existing where terms in any ! row of B exist when a row of A is multiplied by al cols of B INTEGER(LONG) :: NTERM_AROW ! Max number of nonzero terms in one row of A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATMULT_SSS_NTERM_BEGEND + INTRINSIC :: MAX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make sure B is stored as nonsym (all terms) @@ -254,12 +248,7 @@ SUBROUTINE MATMULT_SSS_NTERM ( MAT_A_NAME, NROW_A, NTERM_A, SYM_A, I_A, J_A, CALL DEALLOCATE_SPARSE_ALG ( 'J_AROW' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MATTRNSP_SS.f90 b/Source/UTIL/MATTRNSP_SS.f90 index d8fe14b3..f8cc9d9e 100644 --- a/Source/UTIL/MATTRNSP_SS.f90 +++ b/Source/UTIL/MATTRNSP_SS.f90 @@ -50,11 +50,10 @@ SUBROUTINE MATTRNSP_SS ( NROWA, NCOLA, NTERM, MAT_A_NAME, I_A, J_A, A, MAT_AT_NA ! AT is a real array of the nonzero terms in matrix AT (same values as in A but arranged differently). USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MATTRNSP_SS_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE MATTRNSP_SS_USE_IFs @@ -74,19 +73,14 @@ SUBROUTINE MATTRNSP_SS ( NROWA, NCOLA, NTERM, MAT_A_NAME, I_A, J_A, A, MAT_AT_NA INTEGER(LONG), INTENT(OUT) :: J_AT(NTERM) ! Col numbers for nonzero terms in AT INTEGER(LONG) :: I,J ! DO loop indices or counters INTEGER(LONG) :: ISTART ! Starting value of I when looking for row number of a term in MATIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MATTRNSP_SS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NTERM) ! Real nonzero values in input matrix A REAL(DOUBLE) , INTENT(OUT) :: AT(NTERM) ! Real nonzero values in output matrix AT INTEGER(LONG) :: TMP, COL ! temp variables for storage in loops INTEGER(LONG) :: CUMSUM ! cumulative sum -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -143,12 +137,7 @@ SUBROUTINE MATTRNSP_SS ( NROWA, NCOLA, NTERM, MAT_A_NAME, I_A, J_A, A, MAT_AT_NA IF ((DEBUG(85) == 1) .OR. (DEBUG(85) == 3)) CALL MATTRNSP_SS_DEB ( '2', ' ' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MERGE_COL_VECS.f90 b/Source/UTIL/MERGE_COL_VECS.f90 index 4c35dd3f..7f9aeb46 100644 --- a/Source/UTIL/MERGE_COL_VECS.f90 +++ b/Source/UTIL/MERGE_COL_VECS.f90 @@ -34,11 +34,10 @@ SUBROUTINE MERGE_COL_VECS ( IN1_COL, IN1_NDOF, UIN1, IN2_COL, IN2_NDOF, UIN2 & ! and processing is stopped. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_COL_VECS_BEGEND USE DOF_TABLES, ONLY : TDOFI USE MERGE_COL_VECS_USE_IFs @@ -57,19 +56,14 @@ SUBROUTINE MERGE_COL_VECS ( IN1_COL, IN1_NDOF, UIN1, IN2_COL, IN2_NDOF, UIN2 & INTEGER(LONG) :: IN1_DOF ! IN1_COL DOF number in array TDOFI of a term in UIN1 INTEGER(LONG) :: IN2_DOF ! IN2_COL DOF number in array TDOFI of a term in UIN2 INTEGER(LONG) :: OUT_DOF ! OUT_COL DOF number in array TDOFI of a term in UOUT - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_COL_VECS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: UIN1(IN1_NDOF) ! Input vector for IN1_COL displ set REAL(DOUBLE) , INTENT(IN ) :: UIN2(IN2_NDOF) ! Input vector for IN2_COL displ set REAL(DOUBLE) , INTENT(OUT) :: UOUT(OUT_NDOF) ! Output vector for OUT_COL displ set -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -108,12 +102,7 @@ SUBROUTINE MERGE_COL_VECS ( IN1_COL, IN1_NDOF, UIN1, IN2_COL, IN2_NDOF, UIN2 & ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MERGE_MAT_COLS_SSS.f90 b/Source/UTIL/MERGE_MAT_COLS_SSS.f90 index 1076e451..2a9ff8ec 100644 --- a/Source/UTIL/MERGE_MAT_COLS_SSS.f90 +++ b/Source/UTIL/MERGE_MAT_COLS_SSS.f90 @@ -34,12 +34,11 @@ SUBROUTINE MERGE_MAT_COLS_SSS ( MAT_A_NAME, NTERM_A, I_A, J_A, A, SYM_A, NCOL_A, ! of B can be inferred from the array J_B) USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_MAT_COLS_SSS_BEGEND USE MERGE_MAT_COLS_SSS_USE_IFs @@ -73,19 +72,13 @@ SUBROUTINE MERGE_MAT_COLS_SSS ( MAT_A_NAME, NTERM_A, I_A, J_A, A, SYM_A, NCOL_A, INTEGER(LONG) :: NUM_IN_ROW_OF_A ! Num terms in a row of A matrix INTEGER(LONG) :: NUM_IN_ROW_OF_B ! Num terms in a row of B matrix INTEGER(LONG) :: NUM_IN_ROW_OF_C ! Num terms in a row of C matrix - INTEGER(LONG) , PARAMETER :: SUBR_BEGEND = MERGE_MAT_COLS_SSS_BEGEND REAL(DOUBLE) , INTENT(IN) :: A(NTERM_A) ! Nonzero terms in matrix A REAL(DOUBLE) , INTENT(IN) :: B(NTERM_B) ! Nonzero terms in matrix B REAL(DOUBLE) , INTENT(OUT) :: C(NTERM_A+NTERM_B) ! Nonzero terms in matrix C REAL(DOUBLE) :: C_ROW(NTERM_A+NTERM_B) ! Real values of C in 1 row (can't be any more in 1 row than this) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Make sure that input matrices A and B, and output matrix C, are stored in same format @@ -160,12 +153,7 @@ SUBROUTINE MERGE_MAT_COLS_SSS ( MAT_A_NAME, NTERM_A, I_A, J_A, A, SYM_A, NCOL_A, IF (DEBUG(102) > 0) CALL MERGE_MAT_COLS_SSS_DEB ( '9' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/MERGE_MAT_ROWS_SSS.f90 b/Source/UTIL/MERGE_MAT_ROWS_SSS.f90 index 185290fb..7de2f099 100644 --- a/Source/UTIL/MERGE_MAT_ROWS_SSS.f90 +++ b/Source/UTIL/MERGE_MAT_ROWS_SSS.f90 @@ -31,13 +31,12 @@ SUBROUTINE MERGE_MAT_ROWS_SSS ( MAT_A_NAME, NROW_A, NTERM_A, I_A, J_A, A, MERGE_ ! Merges rows of 2 sparse CRS matrices, which have the same number of cols, into a new sparse CRS matrix USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE SPARSE_ALG_ARRAYS, ONLY : LOGICAL_VEC, REAL_VEC - USE SUBR_BEGEND_LEVELS, ONLY : MERGE_MAT_ROWS_SSS_BEGEND USE MERGE_MAT_ROWS_SSS_USE_IFs @@ -71,18 +70,13 @@ SUBROUTINE MERGE_MAT_ROWS_SSS ( MAT_A_NAME, NROW_A, NTERM_A, I_A, J_A, A, MERGE_ INTEGER(LONG) :: NUM_IN_ROW_OF_C ! Num terms in a row of C matrix INTEGER(LONG) :: ROW_NUM_A ! Row number in matrix A INTEGER(LONG) :: ROW_NUM_B ! Row number in matrix B - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = MERGE_MAT_ROWS_SSS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Nonzero terms in matrix A REAL(DOUBLE) , INTENT(IN ) :: B(NTERM_B) ! Nonzero terms in matrix B REAL(DOUBLE) , INTENT(OUT) :: C(NTERM_A+NTERM_B) ! Nonzero terms in matrix C -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** NROW_C = NROW_A + NROW_B @@ -119,12 +113,7 @@ SUBROUTINE MERGE_MAT_ROWS_SSS ( MAT_A_NAME, NROW_A, NTERM_A, I_A, J_A, A, MERGE_ ENDIF ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/OPEN_OUTFILES.f90 b/Source/UTIL/OPEN_OUTFILES.f90 index 77a71d45..707869e1 100644 --- a/Source/UTIL/OPEN_OUTFILES.f90 +++ b/Source/UTIL/OPEN_OUTFILES.f90 @@ -26,13 +26,13 @@ SUBROUTINE OPEN_OUTFILES -! Opens BUGFIL, ERRFIL, F04FIL, F06FIL and, after checking STIME, closes the file so it can be reopened with APPEND. +! Opens BUGFIL, ERRFIL, F06FIL and, after checking STIME, closes the file so it can be reopened with APPEND. ! This subr is intended for opening these files USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG , ERR , F04 , F06 , SC1, BUGOUT, FILE_NAM_MAXLEN, & - BUGFIL , ERRFIL , F04FIL , F06FIL , & - BUG_MSG, ERR_MSG, F04_MSG, F06_MSG + USE IOUNT1, ONLY : BUG , ERR , F06 , SC1, BUGOUT, FILE_NAM_MAXLEN, & + BUGFIL , ERRFIL , F06FIL , & + BUG_MSG, ERR_MSG, F06_MSG USE TIMDAT, ONLY : STIME, TSEC USE OPEN_OUTFILES_USE_IFs @@ -58,9 +58,7 @@ SUBROUTINE OPEN_OUTFILES IERR(I) = 0 ENDDO -! Open BUG, ERR, F04, F06 files, check STIME, and position file at end - - CALL OPENIT ( F04FIL, F04, 'F04', F04_MSG, IERR(1) ) +! Open BUG, ERR, F06 files, check STIME, and position file at end CALL OPENIT ( BUGFIL, BUG, 'BUG', BUG_MSG, IERR(2) ) @@ -72,7 +70,7 @@ SUBROUTINE OPEN_OUTFILES DO I=1,4 IF (IERR(I) > 0) THEN - CALL FILERR ( OUNT, 'Y' ) + CALL FILERR ( OUNT ) QUIT = 'Y' ENDIF ENDDO @@ -91,7 +89,7 @@ SUBROUTINE OPENIT ( FILNAM, UNIT, UNIT_NAME, FILE_MSG, IERR0 ) ! Opens formatted files - USE IOUNT1, ONLY : F04, FILE_NAM_MAXLEN + USE IOUNT1, ONLY : FILE_NAM_MAXLEN USE SCONTR, ONLY : LINKNO, FATAL_ERR USE TIMDAT, ONLY : MONTH,DAY,YEAR,HOUR,MINUTE,SEC,SFRAC @@ -124,9 +122,9 @@ SUBROUTINE OPENIT ( FILNAM, UNIT, UNIT_NAME, FILE_MSG, IERR0 ) INQUIRE (FILE=FILNAM,OPENED=FILE_OPND) ! If it is opened we assume it is already positioned at the end IF (.NOT.FILE_OPND) THEN IF (UNIT /= SC1) THEN ! Open file, check STIME, close file and then reopen as APPEND - CALL FILE_OPEN ( UNIT, FILNAM, OUNT, 'OLD', FILE_MSG, 'READ_STIME', 'FORMATTED', 'READ' , 'REWIND','Y','N', 'Y') - CALL FILE_CLOSE ( UNIT, FILNAM, 'KEEP', 'Y' ) - CALL FILE_OPEN ( UNIT, FILNAM, OUNT, 'OLD', FILE_MSG, 'NEITHER' , 'FORMATTED', 'READWRITE', 'APPEND','Y','N', 'Y') + CALL FILE_OPEN ( UNIT, FILNAM, OUNT, 'OLD', FILE_MSG, 'READ_STIME', 'FORMATTED', 'READ' , 'REWIND','Y','N') + CALL FILE_CLOSE ( UNIT, FILNAM, 'KEEP' ) + CALL FILE_OPEN ( UNIT, FILNAM, OUNT, 'OLD', FILE_MSG, 'NEITHER' , 'FORMATTED', 'READWRITE', 'APPEND','Y','N') ENDIF ENDIF ELSE diff --git a/Source/UTIL/OPNERR.f90 b/Source/UTIL/OPNERR.f90 index ffa059f2..2b3ab884 100644 --- a/Source/UTIL/OPNERR.f90 +++ b/Source/UTIL/OPNERR.f90 @@ -24,15 +24,12 @@ ! End MIT license text. - SUBROUTINE OPNERR ( IOCHK, FILNAM, OUNT, WRITE_F04 ) + SUBROUTINE OPNERR ( IOCHK, FILNAM, OUNT ) ! Prints error messages when IOSTAT is not zero on a file OPEN. - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F04FIL - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, RESTART - USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : OPNERR_BEGEND + USE PENTIUM_II_KIND, ONLY : LONG + USE SCONTR, ONLY : FATAL_ERR, RESTART USE OPNERR_USE_IFs @@ -41,24 +38,14 @@ SUBROUTINE OPNERR ( IOCHK, FILNAM, OUNT, WRITE_F04 ) LOGICAL :: FILE_EXIST ! True if FILNAM exists LOGICAL :: FILE_OPENED ! True if FILNAM is open - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'OPNERR' CHARACTER(LEN=*), INTENT(IN) :: FILNAM ! File name - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG), INTENT(IN) :: IOCHK ! IOSTAT error number when opening/reading a file INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OPNERR_BEGEND + -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - INQUIRE (FILE=F04FIL,OPENED=FILE_OPENED) - IF (.NOT.FILE_OPENED) THEN - WRITE(F04,9001) SUBR_NAME,TSEC - ENDIF - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! IOCHK < 0 is due to EOF/EOR during open. IOCHK > 0 is due to error during open. @@ -114,15 +101,6 @@ SUBROUTINE OPNERR ( IOCHK, FILNAM, OUNT, WRITE_F04 ) CALL OUTA_HERE ( 'N' ) ENDIF -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - INQUIRE (FILE=F04FIL,OPENED=FILE_OPENED) - IF (.NOT.FILE_OPENED) THEN - WRITE(F04,9002) SUBR_NAME,TSEC - ENDIF - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/UTIL/OUTA_HERE.f90 b/Source/UTIL/OUTA_HERE.f90 index 46e2261f..4d0fcbc8 100644 --- a/Source/UTIL/OUTA_HERE.f90 +++ b/Source/UTIL/OUTA_HERE.f90 @@ -30,35 +30,26 @@ SUBROUTINE OUTA_HERE ( WRITE_TO_L1A ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUGOUT, F04, F06FIL, SC1, WRT_LOG, & - BUGSTAT, BUGSTAT_OLD, ERRSTAT, ERRSTAT_OLD, F04STAT, F04STAT_OLD, & + USE IOUNT1, ONLY : BUGOUT, F06FIL, SC1, & + BUGSTAT, BUGSTAT_OLD, ERRSTAT, ERRSTAT_OLD, & OP2STAT, PCHSTAT, L1ASTAT USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, LINKNO, WARN_ERR USE TIMDAT, ONLY : TSEC USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : OUTA_HERE_BEGEND USE OUTA_HERE_USE_IFs IMPLICIT NONE - - LOGICAL :: FILE_OPND ! Output from INQUIRE intrinsic function + CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'OUTA_HERE' CHARACTER( 1*BYTE), INTENT(IN) :: WRITE_TO_L1A ! Y/N indicator of whether to call subr WRITE_L1A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OUTA_HERE_BEGEND + ! ********************************************************************************************************************************** - INQUIRE(UNIT=F04,OPENED=FILE_OPND) - IF (FILE_OPND) THEN - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM -!xx WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF - ENDIF + ! Write data to LINK1A, if we are in LINK1 @@ -79,7 +70,7 @@ SUBROUTINE OUTA_HERE ( WRITE_TO_L1A ) WRITE(SC1,9999) CALL WRITE_FILNAM ( F06FIL, SC1, 1 ) - CALL WRITE_L1A ( L1ASTAT, 'N', 'N' ) + CALL WRITE_L1A ( L1ASTAT, 'N' ) ! Set close status for output files @@ -103,15 +94,6 @@ SUBROUTINE OUTA_HERE ( WRITE_TO_L1A ) ENDIF ENDIF - IF (WRT_LOG > 0) THEN - F04STAT = 'KEEP' - ELSE - IF (F04STAT_OLD == 'KEEP ') THEN - F04STAT = 'KEEP' - ELSE - F04STAT = 'DELETE' - ENDIF - ENDIF ELSE @@ -120,7 +102,7 @@ SUBROUTINE OUTA_HERE ( WRITE_TO_L1A ) ENDIF - CALL CLOSE_OUTFILES ( BUGSTAT, ERRSTAT, F04STAT, OP2STAT, PCHSTAT ) + CALL CLOSE_OUTFILES ( BUGSTAT, ERRSTAT, OP2STAT, PCHSTAT ) STOP diff --git a/Source/UTIL/OUTPUT4_MATRIX_MSGS.f90 b/Source/UTIL/OUTPUT4_MATRIX_MSGS.f90 index 7b8bac90..778d9cb4 100644 --- a/Source/UTIL/OUTPUT4_MATRIX_MSGS.f90 +++ b/Source/UTIL/OUTPUT4_MATRIX_MSGS.f90 @@ -100,8 +100,8 @@ SUBROUTINE OUTPUT4_MATRIX_MSGS ( OUNT ) ENDDO WRITE(F06,*) CALL FILE_OPEN ( OU4(I), OU4FIL(I), OUNT, 'REPLACE', OU4_MSG(I), 'NEITHER', 'UNFORMATTED', 'WRITE', 'REWIND', & - 'Y', 'N', 'Y') - CALL FILE_CLOSE ( OU4(I), OU4FIL(I), 'KEEP', 'Y' ) + 'Y', 'N') + CALL FILE_CLOSE ( OU4(I), OU4FIL(I), 'KEEP' ) ENDIF ENDDO WRITE(F06,*) diff --git a/Source/UTIL/OUTPUT4_PROC.f90 b/Source/UTIL/OUTPUT4_PROC.f90 index 16f3bf57..7074c069 100644 --- a/Source/UTIL/OUTPUT4_PROC.f90 +++ b/Source/UTIL/OUTPUT4_PROC.f90 @@ -35,7 +35,7 @@ SUBROUTINE OUTPUT4_PROC ( CALLING_SUBR ) ! This subr does not process the grid and/or element related Output Transformation Matrices (OTM's). That is done in LINK9 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, MOU4, OU4, OU4_MSG, OU4FIL, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, MOU4, OU4, OU4_MSG, OU4FIL USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR , & NTERM_CG_LTM, NTERM_DLR , NTERM_IF_LTM, NTERM_KLL , & @@ -98,7 +98,6 @@ SUBROUTINE OUTPUT4_PROC ( CALLING_SUBR ) I_PA , J_PA , PA , I_PG , J_PG , PG , I_PL , J_PL , PL USE FULL_MATRICES, ONLY : PHIZG_FULL - USE SUBR_BEGEND_LEVELS, ONLY : OUTPUT4_PROC_BEGEND USE OUTPUT4_PROC_USE_IFs @@ -125,14 +124,9 @@ SUBROUTINE OUTPUT4_PROC ( CALLING_SUBR ) INTEGER(LONG) :: VAL_C ! Non-zero vals in OU4_PARTVEC_ROWS INTEGER(LONG) :: VAL_R ! Non-zero vals in OU4_PARTVEC_COLS INTEGER(LONG) :: UNT ! - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = OUTPUT4_PROC_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** DO I=1,NUM_OU4_REQUESTS @@ -1327,12 +1321,7 @@ SUBROUTINE OUTPUT4_PROC ( CALLING_SUBR ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/PARAM_CORDS_ACT_CORDS.f90 b/Source/UTIL/PARAM_CORDS_ACT_CORDS.f90 index c197eb52..a5b64f50 100644 --- a/Source/UTIL/PARAM_CORDS_ACT_CORDS.f90 +++ b/Source/UTIL/PARAM_CORDS_ACT_CORDS.f90 @@ -31,12 +31,11 @@ SUBROUTINE PARAM_CORDS_ACT_CORDS ( NROW, IORD, XEP, XEA ) ! matrices were calculated to element corner nodes USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : BUG, ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : BUG, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MAX_ORDER_GAUSS USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : TYPE, XEL - USE SUBR_BEGEND_LEVELS, ONLY : PARAM_CORDS_ACT_CORDS_BEGEND IMPLICIT NONE @@ -44,17 +43,12 @@ SUBROUTINE PARAM_CORDS_ACT_CORDS ( NROW, IORD, XEP, XEA ) INTEGER(LONG), INTENT(IN) :: IORD ! Gaussian integration order to be used in obtaining the PSH shape fcns INTEGER(LONG), INTENT(IN) :: NROW ! Number of rows in XEP, XEA - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARAM_CORDS_ACT_CORDS_BEGEND + REAL(DOUBLE), INTENT(IN) :: XEP(NROW,3) ! Parametric coords of NCOL points REAL(DOUBLE), INTENT(OUT) :: XEA(NROW,3) ! Actual local element coords corresponding to XEP -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF ((TYPE(1:5) == 'QUAD4') .OR. (TYPE(1:5) == 'QUAD8')) THEN @@ -66,12 +60,7 @@ SUBROUTINE PARAM_CORDS_ACT_CORDS ( NROW, IORD, XEP, XEA ) call outa_here ( 'y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/PARSE_CHAR_STRING.f90 b/Source/UTIL/PARSE_CHAR_STRING.f90 index c4e9f68c..ccb9e721 100644 --- a/Source/UTIL/PARSE_CHAR_STRING.f90 +++ b/Source/UTIL/PARSE_CHAR_STRING.f90 @@ -37,11 +37,10 @@ SUBROUTINE PARSE_CHAR_STRING ( CHAR_STRING, STRING_LEN, MAX_WORDS, MWLEN, NUM_WO ! WORDS(5) = VONMISES USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, WARN_ERR USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS - USE SUBR_BEGEND_LEVELS, ONLY : PARSE_CHAR_STRING_BEGEND USE PARSE_CHAR_STRING_USE_IFs @@ -64,14 +63,8 @@ SUBROUTINE PARSE_CHAR_STRING ( CHAR_STRING, STRING_LEN, MAX_WORDS, MWLEN, NUM_WO INTEGER(LONG) :: CHAR_COUNT ! Index into CHAR_STRING to a character in that string (not ' ' or ',') INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: WORD_LEN ! Length of one of the words in CHAR_STRING (must be <= MWLEN) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARSE_CHAR_STRING_BEGEND + -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF ! ********************************************************************************************************************************** ! Initialize @@ -181,12 +174,7 @@ SUBROUTINE PARSE_CHAR_STRING ( CHAR_STRING, STRING_LEN, MAX_WORDS, MWLEN, NUM_WO WRITE(F06,*) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + ! ********************************************************************************************************************************** 9998 FORMAT(' THE WORDS FROM THE STRING ARE PRINTED BELOW:',/) diff --git a/Source/UTIL/PARTITION_FF.f90 b/Source/UTIL/PARTITION_FF.f90 index c1714c9e..f5d649c4 100644 --- a/Source/UTIL/PARTITION_FF.f90 +++ b/Source/UTIL/PARTITION_FF.f90 @@ -45,11 +45,10 @@ SUBROUTINE PARTITION_FF ( MAT_A_NAME, NROW_A, NCOL_A, A, ROW_PART_VEC, COL_PART_ USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : PARTITION_FF_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARTITION_FF_USE_IFs @@ -69,7 +68,6 @@ SUBROUTINE PARTITION_FF ( MAT_A_NAME, NROW_A, NCOL_A, A, ROW_PART_VEC, COL_PART_ INTEGER(LONG) , INTENT(IN) :: NROW_B ! No. rows in B INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IB,JB ! Counters - INTEGER(LONG) , PARAMETER :: SUBR_BEGEND = PARTITION_FF_BEGEND REAL(DOUBLE) , INTENT(IN ) :: A(NROW_A,NCOL_A) ! Input matrix @@ -77,12 +75,7 @@ SUBROUTINE PARTITION_FF ( MAT_A_NAME, NROW_A, NCOL_A, A, ROW_PART_VEC, COL_PART_ INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC,MAT_A_NAME,MAT_B_NAME - 9001 FORMAT(1X,A,' BEGIN',F10.3,' Input matrix is ',A,'. Partitioned output matrix is ',A) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -124,12 +117,7 @@ SUBROUTINE PARTITION_FF ( MAT_A_NAME, NROW_A, NCOL_A, A, ROW_PART_VEC, COL_PART_ CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/PARTITION_SS.f90 b/Source/UTIL/PARTITION_SS.f90 index b001546c..473194d9 100644 --- a/Source/UTIL/PARTITION_SS.f90 +++ b/Source/UTIL/PARTITION_SS.f90 @@ -62,11 +62,10 @@ SUBROUTINE PARTITION_SS ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, J_A, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : PARTITION_SS_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE PARTITION_SS_USE_IFs @@ -118,7 +117,7 @@ SUBROUTINE PARTITION_SS ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, J_A, INTEGER(LONG) :: NCOL_B ! Number of columns in the output matrix INTEGER(LONG) :: ROW_AT_COLJ_BEG(NCOL_A)! jth term is row number in A where col j nonzeros begin INTEGER(LONG) :: ROW_AT_COLJ_END(NCOL_A)! jth term is row number in A where col j nonzeros end - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARTITION_SS_BEGEND + REAL(DOUBLE) , INTENT(IN ) :: A(NTERM_A) ! Input matrix nonzero terms REAL(DOUBLE) , INTENT(OUT) :: B(NTERM_B) ! Output matrix nonzero terms @@ -128,12 +127,7 @@ SUBROUTINE PARTITION_SS ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, J_A, INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC,MAT_A_NAME,MAT_B_NAME - 9001 FORMAT(1X,A,' BEGN ',F10.3,' Input matrix is ',A,'. Partitioned output matrix is ',A) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -325,12 +319,7 @@ SUBROUTINE PARTITION_SS ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, J_A, IF ((DEBUG(86) == 1) .OR. (DEBUG(86) == 3)) CALL PARTITION_SS_DEB ( '7' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/PARTITION_SS_NTERM.f90 b/Source/UTIL/PARTITION_SS_NTERM.f90 index ab70446a..aac44d5e 100644 --- a/Source/UTIL/PARTITION_SS_NTERM.f90 +++ b/Source/UTIL/PARTITION_SS_NTERM.f90 @@ -54,12 +54,11 @@ SUBROUTINE PARTITION_SS_NTERM ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, TSEC USE SPARSE_ALG_ARRAYS, ONLY : ALG, J_AROW USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : PARTITION_SS_NTERM_BEGEND USE PARTITION_SS_NTERM_USE_IFs @@ -105,18 +104,13 @@ SUBROUTINE PARTITION_SS_NTERM ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, INTEGER(LONG) :: NROW_B ! No. rows in B INTEGER(LONG) :: ROW_AT_COLJ_BEG(NCOL_A)! jth term is row number in MATIN where col j nonzeros begin INTEGER(LONG) :: ROW_AT_COLJ_END(NCOL_A)! jth term is row number in MATIN where col j nonzeros end - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARTITION_SS_NTERM_BEGEND + CHARACTER(LEN=LEN(" Det. part. size of BBBB, row")) :: COUNTER_TEMPLATE INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC,MAT_A_NAME,MAT_B_NAME - 9001 FORMAT(1X,A,' BEGN ',F10.3,' Input matrix is ',A,'. Determine memory to allocate to sparse arrays for partition ',A) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -330,12 +324,7 @@ SUBROUTINE PARTITION_SS_NTERM ( MAT_A_NAME, NTERM_A, NROW_A, NCOL_A, SYM_A, I_A, CALL DEALLOCATE_SPARSE_ALG ( 'ALG' ) CALL DEALLOCATE_SPARSE_ALG ( 'J_AROW' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/PARTITION_VEC.f90 b/Source/UTIL/PARTITION_VEC.f90 index 137b1909..f2c14ecb 100644 --- a/Source/UTIL/PARTITION_VEC.f90 +++ b/Source/UTIL/PARTITION_VEC.f90 @@ -31,10 +31,9 @@ SUBROUTINE PARTITION_VEC ( NDOF_X, CSET_X, CSET_1, CSET_2, PART_VEC ) ! The 2's are for the DOF's belonging to displ set CSET_2 (the compliment of CSET_1 in CSET_X) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFG USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PARTITION_VEC_BEGEND USE DOF_TABLES, ONLY : TDOFI USE PARTITION_VEC_USE_IFs @@ -53,14 +52,9 @@ SUBROUTINE PARTITION_VEC ( NDOF_X, CSET_X, CSET_1, CSET_2, PART_VEC ) INTEGER(LONG) :: SET_X ! Col no. in array TDOFI where the DOF list is for CSET_X INTEGER(LONG) :: SET_1 ! Col no. in array TDOFI where the DOF list is for CSET_1 INTEGER(LONG) :: SET_2 ! Col no. in array TDOFI where the DOF list is for CSET_2 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PARTITION_VEC_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -96,12 +90,7 @@ SUBROUTINE PARTITION_VEC ( NDOF_X, CSET_X, CSET_1, CSET_2, PART_VEC ) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/PLANE_COORD_TRANS_21.f90 b/Source/UTIL/PLANE_COORD_TRANS_21.f90 index 3f85e618..a60ac3d3 100644 --- a/Source/UTIL/PLANE_COORD_TRANS_21.f90 +++ b/Source/UTIL/PLANE_COORD_TRANS_21.f90 @@ -34,11 +34,9 @@ SUBROUTINE PLANE_COORD_TRANS_21 ( THETA, T21, CALLING_SUBR ) ! | W2 | | 0 0 1 | | W1 | USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ONE, ZERO - USE SUBR_BEGEND_LEVELS, ONLY : PLANE_COORD_TRANS_21_BEGEND USE PLANE_COORD_TRANS_21_USE_IFs @@ -47,7 +45,7 @@ SUBROUTINE PLANE_COORD_TRANS_21 ( THETA, T21, CALLING_SUBR ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'PLANE_COORD_TRANS_21' CHARACTER(LEN=*), INTENT(IN) :: CALLING_SUBR ! Subr that called this one - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PLANE_COORD_TRANS_21_BEGEND + REAL(DOUBLE), INTENT(IN) :: THETA ! Angle from x axis of system 1 to x axis of system 2 REAL(DOUBLE), INTENT(OUT) :: T21(3,3) ! Transformation matrix which will transform a vector, U1, in coord sys @@ -55,12 +53,7 @@ SUBROUTINE PLANE_COORD_TRANS_21 ( THETA, T21, CALLING_SUBR ) INTRINSIC :: DSIN, DCOS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Row 1 @@ -82,12 +75,7 @@ SUBROUTINE PLANE_COORD_TRANS_21 ( THETA, T21, CALLING_SUBR ) T21(3,3) = ONE -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/PROJ_VEC_ONTO_PLANE.f90 b/Source/UTIL/PROJ_VEC_ONTO_PLANE.f90 index 95fe91c1..43c06cfe 100644 --- a/Source/UTIL/PROJ_VEC_ONTO_PLANE.f90 +++ b/Source/UTIL/PROJ_VEC_ONTO_PLANE.f90 @@ -30,10 +30,9 @@ SUBROUTINE PROJ_VEC_ONTO_PLANE ( VEC_A, VEC_B, VEC_C ) ! Result is VEC_C USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : PROJ_VEC_ONTO_PLANE_BEGEND USE PROJ_VEC_ONTO_PLANE_USE_IFs @@ -42,31 +41,21 @@ SUBROUTINE PROJ_VEC_ONTO_PLANE ( VEC_A, VEC_B, VEC_C ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'PROJ_VEC_ONTO_PLANE' INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PROJ_VEC_ONTO_PLANE_BEGEND + REAL(DOUBLE) , INTENT(IN) :: VEC_A(3) ! Vector to be projected REAL(DOUBLE) , INTENT(IN) :: VEC_B(3) ! Vector normal to the plane onto which VEC_A is to be projected REAL(DOUBLE) , INTENT(OUT) :: VEC_C(3) ! Vector projection of VEC_A onto plane to which VEC_B is normal REAL(DOUBLE) :: VEC_DUM(3) ! Dummy vector in the calc of VEC_C -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** CALL CROSS ( VEC_A, VEC_B, VEC_DUM ) CALL CROSS ( VEC_B, VEC_DUM, VEC_C ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/PRT_MATS_ON_RESTART.f90 b/Source/UTIL/PRT_MATS_ON_RESTART.f90 index df81e553..8ba696a6 100644 --- a/Source/UTIL/PRT_MATS_ON_RESTART.f90 +++ b/Source/UTIL/PRT_MATS_ON_RESTART.f90 @@ -30,7 +30,7 @@ SUBROUTINE PRT_MATS_ON_RESTART USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1 USE IOUNT1, ONLY : L1E , L1H , L1J , L1L , L1R , L2A , L2B , L2C , L2D , L2E , & L2F , L2G , L2H , L2I , L2J , L2K , L2L , L2M , L2N , L2O , & @@ -71,7 +71,6 @@ SUBROUTINE PRT_MATS_ON_RESTART I_PA , J_PA , PA ,I_PG , J_PG , PG ,I_PL , J_PL , PL ,I_PS , J_PS , PS , & I_QSYS, J_QSYS, QSYS,I_RMG , J_RMG , RMG - USE SUBR_BEGEND_LEVELS, ONLY : PRT_MATS_ON_RESTART_BEGEND USE PRT_MATS_ON_RESTART_USE_IFs @@ -93,7 +92,7 @@ SUBROUTINE PRT_MATS_ON_RESTART INTEGER(LONG) :: NUM_SOLNS ! NSUB for statics, NVEC for eigenvalues, etc INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: REC_NO ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = PRT_MATS_ON_RESTART_BEGEND + REAL(DOUBLE) :: KAA_DIAG(NDOFA) ! Diagonal of KAA REAL(DOUBLE) :: KGG_DIAG(NDOFG) ! Diagonal of KGG @@ -105,12 +104,7 @@ SUBROUTINE PRT_MATS_ON_RESTART REAL(DOUBLE) :: KLL_MAX_DIAG ! Max diag term from KLL REAL(DOUBLE) :: KRR_MAX_DIAG ! Max diag term from KRR -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN @@ -158,7 +152,7 @@ SUBROUTINE PRT_MATS_ON_RESTART INQUIRE ( FILE=LINK1H, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'OLD', L1H_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1H, LINK1H, OUNT, 'OLD', L1H_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) CALL ALLOCATE_COL_VEC ( 'YSe', NDOFS, SUBR_NAME ) REC_NO = 0 @@ -167,7 +161,7 @@ SUBROUTINE PRT_MATS_ON_RESTART REC_NO = REC_NO + 1 READ(L1H,IOSTAT=IOCHK) YSe(I) IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK1H, L1H_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK1H, L1H_MSG, REC_NO, OUNT ) IERROR = IERROR + 1 ENDIF ENDDO @@ -179,7 +173,7 @@ SUBROUTINE PRT_MATS_ON_RESTART ENDIF CALL WRITE_VECTOR ( 'S-SET ENFORCED DISPL VECTOR', 'DISPL', NDOFS, YSe) - CALL FILE_CLOSE ( L1H, LINK1H, L1HSTAT, 'Y' ) + CALL FILE_CLOSE ( L1H, LINK1H, L1HSTAT ) CALL DEALLOCATE_COL_VEC ( 'YSe' ) ELSE @@ -381,7 +375,7 @@ SUBROUTINE PRT_MATS_ON_RESTART INQUIRE ( FILE=LINK2F, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( L2F, LINK2F, OUNT, 'OLD', L2F_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L2F, LINK2F, OUNT, 'OLD', L2F_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) DO J=1,NUM_SOLNS CALL ALLOCATE_COL_VEC ( 'UO0_COL', NDOFO, SUBR_NAME ) @@ -392,7 +386,7 @@ SUBROUTINE PRT_MATS_ON_RESTART REC_NO = REC_NO + 1 READ(L2F,IOSTAT=IOCHK) UO0_COL(I) IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK2F, L2F_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK2F, L2F_MSG, REC_NO, OUNT ) IERROR = IERROR + 1 ENDIF ENDDO @@ -407,7 +401,7 @@ SUBROUTINE PRT_MATS_ON_RESTART CALL DEALLOCATE_COL_VEC ( 'UO0_COL' ) ENDDO - CALL FILE_CLOSE ( L2F, LINK2F, L2FSTAT, 'Y' ) + CALL FILE_CLOSE ( L2F, LINK2F, L2FSTAT ) ELSE @@ -674,7 +668,7 @@ SUBROUTINE PRT_MATS_ON_RESTART INQUIRE ( FILE=LINK3A, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'OLD', L3A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L3A, LINK3A, OUNT, 'OLD', L3A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) DO J=1,NUM_SOLNS CALL ALLOCATE_COL_VEC ( 'UL_COL', NDOFL, SUBR_NAME ) @@ -685,7 +679,7 @@ SUBROUTINE PRT_MATS_ON_RESTART REC_NO = REC_NO + 1 READ(L3A,IOSTAT=IOCHK) UL_COL(I) IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK3A, L3A_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK3A, L3A_MSG, REC_NO, OUNT ) IERROR = IERROR + 1 ENDIF ENDDO @@ -700,7 +694,7 @@ SUBROUTINE PRT_MATS_ON_RESTART CALL DEALLOCATE_COL_VEC ( 'UL_COL' ) ENDDO - CALL FILE_CLOSE ( L3A, LINK3A, L3ASTAT, 'Y' ) + CALL FILE_CLOSE ( L3A, LINK3A, L3ASTAT ) ELSE @@ -721,7 +715,7 @@ SUBROUTINE PRT_MATS_ON_RESTART INQUIRE ( FILE=LINK5A, EXIST=FILE_EXIST ) IF (FILE_EXIST) THEN - CALL FILE_OPEN ( L5A, LINK5A, OUNT, 'OLD', L5A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L5A, LINK5A, OUNT, 'OLD', L5A_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) DO J=1,NUM_SOLNS CALL ALLOCATE_COL_VEC ( 'UG_COL', NDOFG, SUBR_NAME ) @@ -732,7 +726,7 @@ SUBROUTINE PRT_MATS_ON_RESTART REC_NO = REC_NO + 1 READ(L5A,IOSTAT=IOCHK) UG_COL(I) IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, LINK5A, L5A_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, LINK5A, L5A_MSG, REC_NO, OUNT ) IERROR = IERROR + 1 ENDIF ENDDO @@ -747,7 +741,7 @@ SUBROUTINE PRT_MATS_ON_RESTART CALL DEALLOCATE_COL_VEC ( 'UG_COL' ) ENDDO - CALL FILE_CLOSE ( L5A, LINK5A, L5ASTAT, 'Y' ) + CALL FILE_CLOSE ( L5A, LINK5A, L5ASTAT ) ELSE @@ -761,12 +755,7 @@ SUBROUTINE PRT_MATS_ON_RESTART ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/READERR.f90 b/Source/UTIL/READERR.f90 index f17465c4..96517ee3 100644 --- a/Source/UTIL/READERR.f90 +++ b/Source/UTIL/READERR.f90 @@ -24,38 +24,29 @@ ! End MIT license text. - SUBROUTINE READERR (IOCHK, FILNAM, MESSAG, REC_NO, OUNT, WRITE_F04 ) + SUBROUTINE READERR (IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) ! Writes message about errors encountered when reading files - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, SC1 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : READERR_BEGEND + USE PENTIUM_II_KIND, ONLY : LONG + USE IOUNT1, ONLY : SC1 + USE SCONTR, ONLY : FATAL_ERR USE READERR_USE_IFs IMPLICIT NONE - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'READERR' CHARACTER(LEN=*), INTENT(IN) :: MESSAG ! File description. Used for error messaging CHARACTER(LEN=*), INTENT(IN) :: FILNAM ! File name - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG), INTENT(IN) :: IOCHK ! IOSTAT error number when opening/reading a file INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to INTEGER(LONG), INTENT(IN) :: REC_NO ! Indicator of record number when error encountered reading file INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IEND ! End col for MESSAG - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READERR_BEGEND + -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! First, truncate trailing blanks in MESSAG @@ -123,12 +114,7 @@ SUBROUTINE READERR (IOCHK, FILNAM, MESSAG, REC_NO, OUNT, WRITE_F04 ) FATAL_ERR = FATAL_ERR + 1 -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/READ_CHK.f90 b/Source/UTIL/READ_CHK.f90 index 7853311f..8f5c1b61 100644 --- a/Source/UTIL/READ_CHK.f90 +++ b/Source/UTIL/READ_CHK.f90 @@ -43,7 +43,7 @@ SUBROUTINE READ_CHK (IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) ! ********************************************************************************************************************************** IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF diff --git a/Source/UTIL/READ_DOF_TABLES.f90 b/Source/UTIL/READ_DOF_TABLES.f90 index 525ecd2c..283de289 100644 --- a/Source/UTIL/READ_DOF_TABLES.f90 +++ b/Source/UTIL/READ_DOF_TABLES.f90 @@ -29,10 +29,9 @@ SUBROUTINE READ_DOF_TABLES ! Reads DOF table data (TSET, TDOF, TDOFI) from file LINK1C USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06, L1C, LINK1C, L1C_MSG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, ERR, F06, L1C, LINK1C, L1C_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, DATA_NAM_LEN, MTDOF, NDOFG, NGRID USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : READ_DOF_TABLES_BEGEND USE DOF_TABLES, ONLY : TDOFI, TDOF, TSET USE READ_DOF_TABLES_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE READ_DOF_TABLES INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening or reading a file INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: REC_NO ! Record number when reading a file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_DOF_TABLES_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Make units for writing errors the error file and output file @@ -65,7 +59,7 @@ SUBROUTINE READ_DOF_TABLES ! Open L1C and read data. Skip data sets we don't need by reading them but not saving them - CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'OLD', L1C_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'OLD', L1C_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ! Read TSET array @@ -135,14 +129,9 @@ SUBROUTINE READ_DOF_TABLES ENDDO ENDDO - CALL FILE_CLOSE ( L1C, LINK1C, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1C, LINK1C, 'KEEP' ) + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/UTIL/READ_IN4_FULL_MAT.f90 b/Source/UTIL/READ_IN4_FULL_MAT.f90 index e835ee17..12d6cc90 100644 --- a/Source/UTIL/READ_IN4_FULL_MAT.f90 +++ b/Source/UTIL/READ_IN4_FULL_MAT.f90 @@ -29,12 +29,11 @@ SUBROUTINE READ_IN4_FULL_MAT ( ELEM_TYP, ELEM_ID, MAT_NAME_IN, NRI, NCI, UNT, FI ! Reads a matrix that is in full NASTRAN OUTPUT4 format from file FILNAM attached to unit UNT USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE MODEL_STUF, ONLY : NUM_EMG_FATAL_ERRS - USE SUBR_BEGEND_LEVELS, ONLY : READ_IN4_FULL_MAT_BEGEND USE READ_IN4_FULL_MAT_USE_IFs @@ -67,19 +66,14 @@ SUBROUTINE READ_IN4_FULL_MAT ( ELEM_TYP, ELEM_ID, MAT_NAME_IN, NRI, NCI, UNT, FI INTEGER(LONG) :: NC ! From matrix trailer. Should be NCOLS+1 INTEGER(LONG) :: PREC ! Matrix precision (2 indicates double precision) INTEGER(LONG) :: REC_NUM ! - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_IN4_FULL_MAT_BEGEND + REAL(DOUBLE), ALLOCATABLE :: CCS1_COL(:) ! One column of MAT REAL(DOUBLE), INTENT(OUT) :: MAT_FULL(NRI,NCI) ! Array of terms in matrix MAT REAL(DOUBLE) :: RJUNK ! Values read from file for matrix other than the one we want !xx REAL(DOUBLE) :: Z0 ! Zero values read from matrix trailer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** MAT_NUM = 0 @@ -215,12 +209,7 @@ SUBROUTINE READ_IN4_FULL_MAT ( ELEM_TYP, ELEM_ID, MAT_NAME_IN, NRI, NCI, UNT, FI CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/READ_L1A.f90 b/Source/UTIL/READ_L1A.f90 index 29bf8ba9..9a926377 100644 --- a/Source/UTIL/READ_L1A.f90 +++ b/Source/UTIL/READ_L1A.f90 @@ -24,16 +24,16 @@ ! End MIT license text. - SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) + SUBROUTINE READ_L1A ( CLOSE_STAT ) ! Reads in data that is in formatted file LINK1A, which is read by all LINK's after LINK1, as they begin. This text file contains ! the names of files opened for a run, the "counter" info (e.g. NGRID, number of grids, etc), solution number, PARAM's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : MOT4, MOU4, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : MOT4, MOU4, WRT_ERR - USE IOUNT1, ONLY : ANS, BUG, EIN, ENF, ERR, F04, F06, IN0, IN1, INI, & + USE IOUNT1, ONLY : BUG, EIN, ENF, ERR, F06, IN0, IN1, INI, & L1A, NEU, OT4, PCH, SEQ, SPC, SC1, & F21, F22, F23, F24, F25, & L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, L1K, & @@ -43,7 +43,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) L2K, L2L, L2M, L2N, L2O, L2P, L2Q, L2R, L2S, L2T, & L3A, L4A, L4B, L4C, L4D, L5A, L5B, OP2, OU4 - USE IOUNT1, ONLY : ANSSTAT, BUGSTAT, EINSTAT, ENFSTAT, ERRSTAT, F04STAT, F06STAT, IN0STAT, IN1STAT, INISTAT, & + USE IOUNT1, ONLY : BUGSTAT, EINSTAT, ENFSTAT, ERRSTAT, F06STAT, IN0STAT, IN1STAT, INISTAT, & L1ASTAT, NEUSTAT, OT4STAT, PCHSTAT, SEQSTAT, SPCSTAT, & F21STAT, F22STAT, F23STAT, F24STAT, F25STAT, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1JSTAT, L1KSTAT, & @@ -53,7 +53,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) L2KSTAT, L2LSTAT, L2MSTAT, L2NSTAT, L2OSTAT, L2PSTAT, L2QSTAT, L2RSTAT, L2SSTAT, L2TSTAT, & L3ASTAT, L4ASTAT, L4BSTAT, L4CSTAT, L4DSTAT, L5ASTAT, L5BSTAT, OP2STAT, OU4STAT - USE IOUNT1, ONLY : ANSFIL, BUGFIL, EINFIL, ENFFIL, ERRFIL, F04FIL, F06FIL, IN0FIL, INIFIL, LINK1A, & + USE IOUNT1, ONLY : BUGFIL, EINFIL, ENFFIL, ERRFIL, F06FIL, IN0FIL, INIFIL, LINK1A, & NEUFIL, OT4FIL, PCHFIL, SEQFIL, SPCFIL, F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, & LINK1A, LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, & LINK1K, LINK1L, LINK1M, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1R, LINK1S, LINK1T, & @@ -62,7 +62,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) LINK2K, LINK2L, LINK2M, LINK2N, LINK2O, LINK2P, LINK2Q, LINK2R, LINK2S, LINK2T, & LINK3A, LINK4A, LINK4B, LINK4C, LINK4D, LINK5A, LINK5B, OP2FIL, OU4FIL - USE IOUNT1, ONLY : ANS_MSG, BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F04_MSG, F06_MSG, IN0_MSG, IN1_MSG, INI_MSG, & + USE IOUNT1, ONLY : BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F06_MSG, IN0_MSG, IN1_MSG, INI_MSG, & L1A_MSG, NEU_MSG, OT4_MSG, PCH_MSG, SEQ_MSG, SPC_MSG, & F21_MSG, F22_MSG, F23_MSG, F24_MSG, F25_MSG, & L1B_MSG, L1C_MSG, L1D_MSG, L1E_MSG, L1F_MSG, L1G_MSG, L1H_MSG, L1I_MSG, L1J_MSG, L1K_MSG, & @@ -78,7 +78,6 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : READ_L1A_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE READ_L1A_USE_IFs @@ -88,7 +87,6 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'READ_L1A' CHARACTER(LEN=*), INTENT(IN) :: CLOSE_STAT ! STATUS when closing file LINK1A - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) CHARACTER(80*BYTE) :: MESSAG ! File description. Used for error messaging INTEGER(LONG), PARAMETER :: NUMIO = 304 ! Number of terms in IOCHKI array @@ -98,14 +96,9 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) INTEGER(LONG) :: OUNT(2) ! File units to write messages to INTEGER(LONG) :: REC_NO ! Indicator of record number when error encountered reading file INTEGER(LONG) :: XTIME ! Time stamp read from file LINK1A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_L1A_BEGEND + -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Default units for writing errors the screen (until LINK1A is read) @@ -122,8 +115,8 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) OPEN (L1A,FILE=LINK1A,STATUS='OLD',IOSTAT=IOCHKI(1),ACTION='READWRITE') IF (IOCHKI(1) /= 0) THEN - CALL OPNERR ( IOCHKI(1), LINK1A, OUNT, WRITE_F04 ) - CALL FILERR ( OUNT, WRITE_F04 ) + CALL OPNERR ( IOCHKI(1), LINK1A, OUNT ) + CALL FILERR ( OUNT ) CALL OUTA_HERE ( 'Y' ) ! Can't open file LINK1A, so quit ENDIF @@ -134,12 +127,12 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) READ(L1A,110,IOSTAT=IOCHKI(1)) XTIME IF (IOCHKI(1) /= 0) THEN REC_NO = -99 - CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT, WRITE_F04 ) + CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT ) JERR = JERR + 1 ELSE IF (RESTART == 'N') THEN IF (XTIME /= STIME) THEN - CALL STMERR ( XTIME, LINK1A, OUNT, WRITE_F04 ) + CALL STMERR ( XTIME, LINK1A, OUNT ) JERR = JERR +1 ENDIF ELSE @@ -153,7 +146,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) READ(L1A,110,IOSTAT=IOCHKI(1)) LINKNO_L1A IF (IOCHKI(1) /= 0) THEN REC_NO = -99 - CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT, WRITE_F04 ) + CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT ) JERR = JERR + 1 ENDIF @@ -163,7 +156,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) READ(L1A,120,IOSTAT=IOCHKI(1)) SOL_NAME IF (IOCHKI(1) /= 0) THEN REC_NO = -99 - CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT, WRITE_F04 ) + CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT ) JERR = JERR + 1 ENDIF @@ -177,12 +170,10 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) READ(L1A,140,IOSTAT=IOCHKI( 1)) SC1 - READ(L1A,151,IOSTAT=IOCHKI( 2)) ANS,ANSSTAT,ANS_MSG,ANSFIL READ(L1A,151,IOSTAT=IOCHKI( 3)) BUG,BUGSTAT,BUG_MSG,BUGFIL READ(L1A,151,IOSTAT=IOCHKI( 4)) EIN,EINSTAT,EIN_MSG,EINFIL READ(L1A,151,IOSTAT=IOCHKI( 5)) ENF,ENFSTAT,ENF_MSG,ENFFIL READ(L1A,151,IOSTAT=IOCHKI( 6)) ERR,ERRSTAT,ERR_MSG,ERRFIL - READ(L1A,151,IOSTAT=IOCHKI( 7)) F04,F04STAT,F04_MSG,F04FIL READ(L1A,151,IOSTAT=IOCHKI( 8)) F06,F06STAT,F06_MSG,F06FIL READ(L1A,151,IOSTAT=IOCHKI( 9)) IN0,IN0STAT,IN0_MSG,IN0FIL READ(L1A,151,IOSTAT=IOCHKI( 10)) L1A,L1ASTAT,L1A_MSG,LINK1A @@ -266,7 +257,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) DO I=1,71+MOT4+MOU4 IF (IOCHKI(I) /= 0) THEN REC_NO = I - CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT, WRITE_F04 ) + CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT ) JERR = JERR + 1 ENDIF ENDDO @@ -586,7 +577,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) DO I=1,NUMIO IF (IOCHKI(I) /= 0) THEN REC_NO = I - CALL READERR ( IOCHKI(I), LINK1A, MESSAG, REC_NO, OUNT, WRITE_F04 ) + CALL READERR ( IOCHKI(I), LINK1A, MESSAG, REC_NO, OUNT ) JERR = JERR + 1 ENDIF ENDDO @@ -617,7 +608,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) DO I=1,14 IF (IOCHKI(I) /= 0) THEN REC_NO = I - CALL READERR ( IOCHKI(I), LINK1A, MESSAG, REC_NO, OUNT, WRITE_F04 ) + CALL READERR ( IOCHKI(I), LINK1A, MESSAG, REC_NO, OUNT ) JERR = JERR + 1 ENDIF ENDDO @@ -628,13 +619,13 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) READ(L1A,103,IOSTAT=IOCHKI(1)) (COMM(I),I=0,49) IF (IOCHKI(1) /= 0) THEN REC_NO = -99 - CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT, WRITE_F04 ) + CALL READERR ( IOCHKI(1), LINK1A, MESSAG, REC_NO, OUNT ) JERR = JERR + 1 ENDIF ! Finished reading L1A, so close: - CALL FILE_CLOSE ( L1A, LINK1A, CLOSE_STAT, WRITE_F04 ) + CALL FILE_CLOSE ( L1A, LINK1A, CLOSE_STAT ) ! Check JERR and stop if > 0 @@ -643,12 +634,7 @@ SUBROUTINE READ_L1A ( CLOSE_STAT, WRITE_F04 ) CALL OUTA_HERE ( 'Y' ) ! Errors reading file LINK1A, so quit ENDIF -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/READ_L1M.f90 b/Source/UTIL/READ_L1M.f90 index 955e9d21..c2b93d5a 100644 --- a/Source/UTIL/READ_L1M.f90 +++ b/Source/UTIL/READ_L1M.f90 @@ -31,8 +31,7 @@ SUBROUTINE READ_L1M ( IERROR ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : LINKNO, NUM_EIGENS - USE IOUNT1, ONLY : ERR, F06, L1M, L1M_MSG, L1MSTAT, LINK1M, SC1, WRT_ERR, WRT_LOG - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, STIME, TSEC + USE IOUNT1, ONLY : ERR, F06, L1M, L1M_MSG, L1MSTAT, LINK1M, SC1, WRT_ERR USE EIGEN_MATRICES_1 , ONLY : EIGEN_VAL, GEN_MASS, MODE_NUM USE MODEL_STUF, ONLY : EIG_COMP, EIG_CRIT, EIG_FRQ1, EIG_FRQ2, EIG_GRID, EIG_METH, EIG_MSGLVL, EIG_LAP_MAT_TYPE, & @@ -40,11 +39,11 @@ SUBROUTINE READ_L1M ( IERROR ) MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT USE READ_L1M_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE CHARACTER(24*BYTE) :: ENAME(20) ! Array of names of recirds read from file LINK1M - CHARACTER(54*BYTE) :: MODNAM ! Name to write to screen to describe module being run INTEGER(LONG), INTENT(OUT) :: IERROR ! Error count INTEGER(LONG) :: I ! DO loop index @@ -62,11 +61,9 @@ SUBROUTINE READ_L1M ( IERROR ) OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1M, LINK1M, OUNT, 'OLD', L1M_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1M, LINK1M, OUNT, 'OLD', L1M_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) - CALL OURTIM - MODNAM = 'READ EIGENVALUE DATA FROM PRIOR LINK' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('READ EIGENVALUE DATA FROM PRIOR LINK') READ(L1M,IOSTAT=IOCHK( 1)) EIG_SID READ(L1M,IOSTAT=IOCHK( 2)) EIG_METH @@ -116,7 +113,7 @@ SUBROUTINE READ_L1M ( IERROR ) REC_NO = REC_NO + 1 IF (IOCHK(I) /= 0) THEN IERROR = IERROR + 1 - CALL READERR ( IOCHK(I), LINK1M, ENAME(I), REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK(I), LINK1M, ENAME(I), REC_NO, OUNT ) ENDIF ENDDO @@ -125,14 +122,11 @@ SUBROUTINE READ_L1M ( IERROR ) READ(L1M,IOSTAT=IOCHK(1)) MODE_NUM(I), EIGEN_VAL(I), GEN_MASS(I) IF (IOCHK(1) /= 0) THEN IERROR = IERROR + 1 - CALL READERR ( IOCHK(1), LINK1M, L1M_MSG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK(1), LINK1M, L1M_MSG, REC_NO, OUNT ) ENDIF ENDDO - CALL FILE_CLOSE ( L1M, LINK1M, 'KEEP', 'Y' ) - -! ********************************************************************************************************************************** - 9092 FORMAT(1X,I2,'/',A54,8X,2X,I2,':',I2,':',I2,'.',I3) + CALL FILE_CLOSE ( L1M, LINK1M, 'KEEP' ) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/READ_L1Z.f90 b/Source/UTIL/READ_L1Z.f90 index 0724d3cb..74100d64 100644 --- a/Source/UTIL/READ_L1Z.f90 +++ b/Source/UTIL/READ_L1Z.f90 @@ -30,11 +30,10 @@ SUBROUTINE READ_L1Z ! Checks are made to ensure that nothing has changed that would violate the restart rules USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, L1Z, LINK1Z, L1Z_MSG + USE IOUNT1, ONLY : ERR, F06, L1Z, LINK1Z, L1Z_MSG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NSUB, SOL_NAME USE TIMDAT, ONLY : STIME, TSEC USE MODEL_STUF, ONLY : CC_EIGR_SID, MPCSET, SPCSET, SUBLOD - USE SUBR_BEGEND_LEVELS, ONLY : READ_L1Z_BEGEND USE READ_L1Z_USE_IFs @@ -53,20 +52,15 @@ SUBROUTINE READ_L1Z INTEGER(LONG) :: SPCSET_OLD ! SPC set ID from original run that is being restarted INTEGER(LONG) :: SUBLOD1_OLD ! Load set ID (for 1 subcase) from original run that is being restarted INTEGER(LONG) :: SUBLOD2_OLD ! Temp set ID (for 1 subcase) from original run that is being restarted - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_L1Z_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1Z, LINK1Z, OUNT, 'OLD', L1Z_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1Z, LINK1Z, OUNT, 'OLD', L1Z_MSG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) IERROR = 0 @@ -127,12 +121,7 @@ SUBROUTINE READ_L1Z CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/READ_MATRIX_1.f90 b/Source/UTIL/READ_MATRIX_1.f90 index 9875afd1..7d64c29a 100644 --- a/Source/UTIL/READ_MATRIX_1.f90 +++ b/Source/UTIL/READ_MATRIX_1.f90 @@ -48,12 +48,11 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : READ_MATRIX_1_BEGEND USE READ_MATRIX_1_USE_IFs @@ -84,7 +83,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME INTEGER(LONG) :: NUM_TERMS ! Head rec read from files that denotes how many records in FILNAM INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: REC_NO ! Record number when reading FILNAM - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_MATRIX_1_BEGEND + REAL(DOUBLE) , INTENT(OUT) :: MATOUT(NTERM) ! Real values for matrix MATOUT REAL(DOUBLE) :: RVAL ! Real values read from FILNAM @@ -93,12 +92,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Quick return if there are no terms in the matrix @@ -120,7 +114,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME OUNT(2) = F06 IF (OPND == 'N') THEN - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF ! Should we read NTERM from file before reading matrix? @@ -129,7 +123,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME READ(UNT,IOSTAT=IOCHK) NUM_TERMS IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Can't read NUM_TERMS from file, so quit ENDIF IF (NUM_TERMS /= NTERM) THEN @@ -157,7 +151,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME ELSE REC_NO = K ENDIF - CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) READ_ERR = READ_ERR + 1 ! Error reading IROW, JCOL, RVAL record from unit UNT CYCLE k_do1 ELSE @@ -195,7 +189,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME ENDIF IF (CLOSE_IT == 'Y') THEN - CALL FILE_CLOSE ( UNT, FILNAM, CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( UNT, FILNAM, CLOSE_STAT ) ENDIF ! Check sensibility of I_MATOUT @@ -213,12 +207,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME WRITE(F06,103) NAME, NAME, NAME, NROWS ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN @@ -255,7 +244,7 @@ SUBROUTINE READ_MATRIX_1 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME SUBROUTINE CHECK_SPARSE_CRS_I ( MAT_A_NAME, CALLING_SUBR, NROWS_A, NTERM_A, I_A, DEBUG_NUM ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE DEBUG_PARAMETERS, ONLY : DEBUG IMPLICIT NONE diff --git a/Source/UTIL/READ_MATRIX_2.f90 b/Source/UTIL/READ_MATRIX_2.f90 index e2654595..c6989b3f 100644 --- a/Source/UTIL/READ_MATRIX_2.f90 +++ b/Source/UTIL/READ_MATRIX_2.f90 @@ -47,11 +47,10 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME ! MATOUT(1 - NTERMS) : k-th value is the k-th nonzero value in the matrix USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : READ_MATRIX_2_BEGEND USE READ_MATRIX_2_USE_IFs @@ -79,7 +78,7 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME INTEGER(LONG) :: OLD_ROW_NUM ! A variable used to tell when a new row of MATOUT is being read INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN INTEGER(LONG) :: REC_NO ! Record number when reading FILNAM - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_MATRIX_2_BEGEND + REAL(DOUBLE) , INTENT(OUT) :: MATOUT(NTERMS) ! Real values for matrix MATOUT @@ -87,12 +86,7 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME INTRINSIC DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -109,7 +103,7 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME OUNT(2) = F06 IF (OPND == 'N') THEN - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'OLD', MESSAG, 'READ_STIME', 'UNFORMATTED', 'READ', 'REWIND', 'Y', 'N' ) ENDIF ! Should we read NTERMS from file before reading matrix? @@ -118,7 +112,7 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME READ(UNT,IOSTAT=IOCHK) NUM_TERMS IF (IOCHK /= 0) THEN REC_NO = 1 - CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) CALL OUTA_HERE ( 'Y' ) ! Can't read NUM_TERMS fro file, so quit ENDIF IF (NUM_TERMS /= NTERMS) THEN @@ -144,7 +138,7 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME ELSE REC_NO = K ENDIF - CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT, 'Y' ) + CALL READERR ( IOCHK, FILNAM, MESSAG, REC_NO, OUNT ) IERROR = IERROR + 1 ENDIF IF (I2_MATOUT(K) > OLD_ROW_NUM) THEN @@ -160,15 +154,10 @@ SUBROUTINE READ_MATRIX_2 ( FILNAM, UNT, OPND, CLOSE_IT, CLOSE_STAT, MESSAG, NAME ENDIF IF (CLOSE_IT == 'Y') THEN - CALL FILE_CLOSE ( UNT, FILNAM, CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( UNT, FILNAM, CLOSE_STAT ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/READ_XTIME.f90 b/Source/UTIL/READ_XTIME.f90 index 55717df7..7c7f7cbb 100644 --- a/Source/UTIL/READ_XTIME.f90 +++ b/Source/UTIL/READ_XTIME.f90 @@ -29,10 +29,9 @@ SUBROUTINE READ_XTIME ( UNT, FILNAM, MESSAG, OUNT ) ! Reads STIME from an unformatted file and calls READERR if there is an error condition USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : READ_XTIME_BEGEND USE READ_XTIME_USE_IFs @@ -46,29 +45,19 @@ SUBROUTINE READ_XTIME ( UNT, FILNAM, MESSAG, OUNT ) INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening/reading a file INTEGER(LONG) :: XTIME ! Time stamp read from an unformatted file - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = READ_XTIME_BEGEND + -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF + ! ********************************************************************************************************************************* REWIND (UNT) READ(UNT,IOSTAT=IOCHK) XTIME IF (IOCHK /= 0) THEN - CALL READERR ( IOCHK, FILNAM, MESSAG, 1, OUNT, 'Y' ) + CALL READERR ( IOCHK, FILNAM, MESSAG, 1, OUNT ) CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/RESTART_DATA_FOR_L3.f90 b/Source/UTIL/RESTART_DATA_FOR_L3.f90 index 31095dd3..a732ab27 100644 --- a/Source/UTIL/RESTART_DATA_FOR_L3.f90 +++ b/Source/UTIL/RESTART_DATA_FOR_L3.f90 @@ -29,13 +29,12 @@ SUBROUTINE RESTART_DATA_FOR_L3 ! Reads matrices needed when a restart is made in LINK3 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE IOUNT1, ONLY : L2G, LINK2G, L2G_MSG, L2GSTAT USE IOUNT1, ONLY : L2H, LINK2H, L2H_MSG, L2HSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, NDOFL, NTERM_KLL, NTERM_PL USE TIMDAT, ONLY : TSEC USE SPARSE_MATRICES, ONLY : I_KLL , J_KLL , KLL ,I_PL , J_PL , PL - USE SUBR_BEGEND_LEVELS, ONLY : RESTART_DATA_FOR_L3_BEGEND USE RESTART_DATA_FOR_L3_USE_IFs @@ -51,14 +50,9 @@ SUBROUTINE RESTART_DATA_FOR_L3 INTEGER(LONG) :: IERR ! Local error count - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RESTART_DATA_FOR_L3_BEGEND + -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF + ! ********************************************************************************************************************************** IERR = 0 @@ -100,12 +94,7 @@ SUBROUTINE RESTART_DATA_FOR_L3 CALL OUTA_HERE ( 'Y' ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/RIGID_BODY_DISP_MAT.f90 b/Source/UTIL/RIGID_BODY_DISP_MAT.f90 index e507bdfe..90b0c363 100644 --- a/Source/UTIL/RIGID_BODY_DISP_MAT.f90 +++ b/Source/UTIL/RIGID_BODY_DISP_MAT.f90 @@ -30,11 +30,9 @@ SUBROUTINE RIGID_BODY_DISP_MAT ( GRD_COORDS, REF_COORDS, RB_DISP ) ! are relative to REF_GRID and are in basic coords USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE - USE SUBR_BEGEND_LEVELS, ONLY : RIGID_BODY_DISP_MAT_BEGEND USE RIGID_BODY_DISP_MAT_USE_IFs @@ -43,7 +41,7 @@ SUBROUTINE RIGID_BODY_DISP_MAT ( GRD_COORDS, REF_COORDS, RB_DISP ) CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'RIGID_BODY_DISP_MAT' INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = RIGID_BODY_DISP_MAT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: GRD_COORDS(3) ! Coords of grid point for which the RB matrix is to be formulated REAL(DOUBLE) , INTENT(IN) :: REF_COORDS(3) ! Coords of reference grid (grid about which the RB disps occur) @@ -52,12 +50,7 @@ SUBROUTINE RIGID_BODY_DISP_MAT ( GRD_COORDS, REF_COORDS, RB_DISP ) REAL(DOUBLE) :: YBAR ! Basic Y coordinate of GRID_NUM relative to REF_GRID REAL(DOUBLE) :: ZBAR ! Basic Z coordinate of GRID_NUM relative to REF_GRID -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -92,12 +85,7 @@ SUBROUTINE RIGID_BODY_DISP_MAT ( GRD_COORDS, REF_COORDS, RB_DISP ) RB_DISP(3,4) = YBAR RB_DISP(3,5) = -XBAR -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/ROW_AT_COLJ_BEGEND.f90 b/Source/UTIL/ROW_AT_COLJ_BEGEND.f90 index 45555773..4ccc31de 100644 --- a/Source/UTIL/ROW_AT_COLJ_BEGEND.f90 +++ b/Source/UTIL/ROW_AT_COLJ_BEGEND.f90 @@ -32,10 +32,9 @@ SUBROUTINE ROW_AT_COLJ_BEGEND ( NAME, NROWS, NCOLS, NTERM, I_A, J_A, ROW_AT_COLJ ! ROW_AT_COLJ_END is an array that gives, for each col of sparse CRS input matrix A, the last row no. of nonzero terms in that col. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : ROW_AT_COLJ_BEGEND_BEGEND USE ROW_AT_COLJ_BEGEND_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE ROW_AT_COLJ_BEGEND ( NAME, NROWS, NCOLS, NTERM, I_A, J_A, ROW_AT_COLJ INTEGER(LONG) :: COL_NUM ! A column number from J_MATIN INTEGER(LONG) :: I,J,K ! DO loop indices or counters INTEGER(LONG) :: NTERM_ROW_I ! Number of terms in matrix A row I - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = ROW_AT_COLJ_BEGEND_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -102,12 +96,7 @@ SUBROUTINE ROW_AT_COLJ_BEGEND ( NAME, NROWS, NCOLS, NTERM, I_A, J_A, ROW_AT_COLJ ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SET_FILE_CLOSE_STAT.f90 b/Source/UTIL/SET_FILE_CLOSE_STAT.f90 index 2d29a883..98af534a 100644 --- a/Source/UTIL/SET_FILE_CLOSE_STAT.f90 +++ b/Source/UTIL/SET_FILE_CLOSE_STAT.f90 @@ -32,7 +32,7 @@ SUBROUTINE SET_FILE_CLOSE_STAT ( CLOSE_STAT ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERRSTAT, F04STAT, SEQSTAT, SPCSTAT, L1ASTAT, & + USE IOUNT1, ONLY : WRT_ERR, ERRSTAT, SEQSTAT, SPCSTAT, L1ASTAT, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1TSTAT, L1JSTAT, & L1KSTAT, L1LSTAT, L1MSTAT, L1NSTAT, L1OSTAT, L1PSTAT, L1QSTAT, L1RSTAT, L1SSTAT, L1USTAT, & L1VSTAT, L1WSTAT, L1XSTAT, L1YSTAT, L1ZSTAT, & diff --git a/Source/UTIL/SET_SPARSE_MAT_SYM.f90 b/Source/UTIL/SET_SPARSE_MAT_SYM.f90 index e9c26d9f..23d5bb9c 100644 --- a/Source/UTIL/SET_SPARSE_MAT_SYM.f90 +++ b/Source/UTIL/SET_SPARSE_MAT_SYM.f90 @@ -28,7 +28,7 @@ SUBROUTINE SET_SPARSE_MAT_SYM ! Sets symmetry indicators for sparse matrices depending on Bulk Data PARAM SPARSTOR - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE PARAMS, ONLY : SPARSTOR, SUPINFO diff --git a/Source/UTIL/SORTLEN.f90 b/Source/UTIL/SORTLEN.f90 index 9e85fa78..8b08453e 100644 --- a/Source/UTIL/SORTLEN.f90 +++ b/Source/UTIL/SORTLEN.f90 @@ -29,11 +29,10 @@ SUBROUTINE SORTLEN ( NLEN, JCT ) ! Calculates shell sort length parameter, JCT USE PENTIUM_II_KIND, ONLY : LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE CONSTANTS_1, ONLY : TWO USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORTLEN_BEGEND USE SORTLEN_USE_IFs @@ -46,16 +45,11 @@ SUBROUTINE SORTLEN ( NLEN, JCT ) INTEGER(LONG) :: MAX_JCT ! Max practical value of JCT to use in sort by the calling procedure. ! Values of JCT > MAX_JCT will not cause any error, but will introduce ! inefficiency into the sort (a DO loop will run excessively). - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORTLEN_BEGEND + INTRINSIC DLOG -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -109,12 +103,7 @@ SUBROUTINE SORTLEN ( NLEN, JCT ) JCT = MAX_JCT ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_GRID_RGRID.f90 b/Source/UTIL/SORT_GRID_RGRID.f90 index 2972029f..aa557eac 100644 --- a/Source/UTIL/SORT_GRID_RGRID.f90 +++ b/Source/UTIL/SORT_GRID_RGRID.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_GRID_RGRID ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) ! (in column 1 of IARRAY) is in numerically increasing order USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MGRID, MRGRID USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_GRID_RGRID_BEGEND USE SORT_GRID_RGRID_USE_IFs @@ -56,17 +55,12 @@ SUBROUTINE SORT_GRID_RGRID ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data ! to be in sort order. SORT_MAX is max value - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_GRID_RGRID_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE,MRGRID)! Array RGRID REAL(DOUBLE) :: RDUM1 ! Dummy values in RARRAY used when switching RARRAY rows during sort -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -131,12 +125,7 @@ SUBROUTINE SORT_GRID_RGRID ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_INT1.f90 b/Source/UTIL/SORT_INT1.f90 index 7c2abd35..2b7dad46 100644 --- a/Source/UTIL/SORT_INT1.f90 +++ b/Source/UTIL/SORT_INT1.f90 @@ -29,11 +29,10 @@ SUBROUTINE SORT_INT1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY ) ! Performs shell sort on integer array IARRAY (of size NSIZE) to put it into numerically increasing order USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT1_BEGEND USE SORT_INT1_USE_IFs @@ -54,14 +53,9 @@ SUBROUTINE SORT_INT1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY ) INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT1_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -121,12 +115,7 @@ SUBROUTINE SORT_INT1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY ) ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_INT1_REAL1.f90 b/Source/UTIL/SORT_INT1_REAL1.f90 index 6ff4ba76..88a24bcb 100644 --- a/Source/UTIL/SORT_INT1_REAL1.f90 +++ b/Source/UTIL/SORT_INT1_REAL1.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_INT1_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) ! along with IARRAY. Both arrays ore of size NSIZE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT1_REAL1_BEGEND USE SORT_INT1_REAL1_USE_IFs @@ -55,17 +54,12 @@ SUBROUTINE SORT_INT1_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT1_REAL1_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE) ! Array of real values REAL(DOUBLE) :: RDUM ! Dummy values in RARRAY used when switching RARRAY rows during the sort. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -126,12 +120,7 @@ SUBROUTINE SORT_INT1_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_INT1_REAL3.f90 b/Source/UTIL/SORT_INT1_REAL3.f90 index d2c20905..bdf20aad 100644 --- a/Source/UTIL/SORT_INT1_REAL3.f90 +++ b/Source/UTIL/SORT_INT1_REAL3.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_INT1_REAL3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) ! along with IARRAY. Both arrays have NSIZE rows USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT1_REAL3_BEGEND USE SORT_INT1_REAL3_USE_IFs @@ -55,17 +54,12 @@ SUBROUTINE SORT_INT1_REAL3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT1_REAL3_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE,3) ! Array of real values REAL(DOUBLE) :: RDUM ! Dummy values in RARRAY used when switching RARRAY rows during the sort. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -128,12 +122,7 @@ SUBROUTINE SORT_INT1_REAL3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, RARRAY ) ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_INT2.f90 b/Source/UTIL/SORT_INT2.f90 index 3dba90da..c560bd99 100644 --- a/Source/UTIL/SORT_INT2.f90 +++ b/Source/UTIL/SORT_INT2.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_INT2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2 ) ! IARRAY2 along with IARRAY1. Both arrays are of size NSIZE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT2_BEGEND USE SORT_INT2_USE_IFs @@ -56,14 +55,9 @@ SUBROUTINE SORT_INT2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2 ) INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT2_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -124,12 +118,7 @@ SUBROUTINE SORT_INT2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2 ) ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_INT2_REAL1.f90 b/Source/UTIL/SORT_INT2_REAL1.f90 index 43bfa7d5..2b93f5cd 100644 --- a/Source/UTIL/SORT_INT2_REAL1.f90 +++ b/Source/UTIL/SORT_INT2_REAL1.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_INT2_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, RARR ! array RARRAY along with IARRAY1. All arrays are of size NSIZE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT2_REAL1_BEGEND USE SORT_INT2_REAL1_USE_IFs @@ -56,17 +55,12 @@ SUBROUTINE SORT_INT2_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, RARR INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT2_REAL1_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE) ! Array of real values REAL(DOUBLE) :: RDUM ! Dummy values in RARRAY used when switching RARRAY rows during the sort -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -130,12 +124,7 @@ SUBROUTINE SORT_INT2_REAL1 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, RARR ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_INT3.f90 b/Source/UTIL/SORT_INT3.f90 index 5bb0e26c..08f9ee32 100644 --- a/Source/UTIL/SORT_INT3.f90 +++ b/Source/UTIL/SORT_INT3.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_INT3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARRAY3 ) ! IARRAY2 and IARRAY3 along with IARRAY1. All 3 arrays are of size NSIZE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT3_BEGEND USE SORT_INT3_USE_IFs @@ -57,14 +56,9 @@ SUBROUTINE SORT_INT3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARRAY3 ) INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT3_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -128,12 +122,7 @@ SUBROUTINE SORT_INT3 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARRAY3 ) ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_INT3_CHAR2.f90 b/Source/UTIL/SORT_INT3_CHAR2.f90 index ff2be350..79f7bff1 100644 --- a/Source/UTIL/SORT_INT3_CHAR2.f90 +++ b/Source/UTIL/SORT_INT3_CHAR2.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_INT3_CHAR2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARR ! IARRAY2, IARRAY3 and character arrays CARRAY1, CARRAY2 along with IARRAY1. All arrays are of size NSIZE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_INT3_CHAR2_BEGEND USE SORT_INT3_CHAR2_USE_IFs @@ -61,14 +60,9 @@ SUBROUTINE SORT_INT3_CHAR2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARR INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_INT3_CHAR2_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -137,12 +131,7 @@ SUBROUTINE SORT_INT3_CHAR2 ( CALLING_SUBR, MESSAG, NSIZE, IARRAY1, IARRAY2, IARR ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_REAL1_INT1.f90 b/Source/UTIL/SORT_REAL1_INT1.f90 index 8def25be..578b587a 100644 --- a/Source/UTIL/SORT_REAL1_INT1.f90 +++ b/Source/UTIL/SORT_REAL1_INT1.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_REAL1_INT1 ( CALLING_SUBR, MESSAG, NSIZE, RARRAY, IARRAY ) ! along with RARRAY. Both arrays are of size NSIZE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_REAL1_INT1_BEGEND USE SORT_REAL1_INT1_USE_IFs @@ -55,17 +54,12 @@ SUBROUTINE SORT_REAL1_INT1 ( CALLING_SUBR, MESSAG, NSIZE, RARRAY, IARRAY ) INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_REAL1_INT1_BEGEND + REAL(DOUBLE), INTENT(INOUT) :: RARRAY(NSIZE) ! Array of real values REAL(DOUBLE) :: RDUM ! Dummy values in RARRAY used when switching RARRAY rows during sort. -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -126,12 +120,7 @@ SUBROUTINE SORT_REAL1_INT1 ( CALLING_SUBR, MESSAG, NSIZE, RARRAY, IARRAY ) ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SORT_TDOF.f90 b/Source/UTIL/SORT_TDOF.f90 index 77e48532..2e862c0d 100644 --- a/Source/UTIL/SORT_TDOF.f90 +++ b/Source/UTIL/SORT_TDOF.f90 @@ -30,11 +30,10 @@ SUBROUTINE SORT_TDOF ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, ICOL ) ! has MTDOF columns (which is the number of columns in array TDOF) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MTDOF USE PARAMS, ONLY : SORT_MAX USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SORT_TDOF_BEGEND USE SORT_TDOF_USE_IFs @@ -56,14 +55,9 @@ SUBROUTINE SORT_TDOF ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, ICOL ) INTEGER(LONG) :: N ! An array index INTEGER(LONG) :: SORTPK ! Intermediate variable used in setting a DO loop range. INTEGER(LONG) :: SORT_NUM ! How many times the sort has to be performed in order for the data - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SORT_TDOF_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Call SORTLEN to calculate the shell sort parameter JCT @@ -124,12 +118,7 @@ SUBROUTINE SORT_TDOF ( CALLING_SUBR, MESSAG, NSIZE, IARRAY, ICOL ) ENDDO outer -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SPARSE_CRS_SPARSE_CCS.f90 b/Source/UTIL/SPARSE_CRS_SPARSE_CCS.f90 index ec72ad94..96ff5b41 100644 --- a/Source/UTIL/SPARSE_CRS_SPARSE_CCS.f90 +++ b/Source/UTIL/SPARSE_CRS_SPARSE_CCS.f90 @@ -29,11 +29,10 @@ SUBROUTINE SPARSE_CRS_SPARSE_CCS ( NROWS_A, NCOLS_A, NTERMS_A, MAT_A_NAME, I_A, ! Converts matrices in sparse compressed row storage (CRS) format to sparse compressed column storage (CCS) format USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_CRS_SPARSE_CCS_BEGEND USE DEBUG_PARAMETERS, ONLY : DEBUG USE SPARSE_CRS_SPARSE_CCS_USE_IFs @@ -57,19 +56,14 @@ SUBROUTINE SPARSE_CRS_SPARSE_CCS ( NROWS_A, NCOLS_A, NTERMS_A, MAT_A_NAME, I_A, INTEGER(LONG) :: I2_A(NTERMS_A) ! Array of row numbers for each term in A INTEGER(LONG) :: COL_J_NUM_TERMS ! Number of terms in col J of output matrix B INTEGER(LONG) :: ROW_I_NUM_TERMS ! Number of terms in row I of input matrix A - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_CRS_SPARSE_CCS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: A(NTERMS_A) ! Real nonzero values in input matrix A REAL(DOUBLE) , INTENT(OUT) :: B(NTERMS_A) ! Real nonzero values in output matrix B CHARACTER(LEN=LEN(MAT_A_NAME)+LEN(MAT_B_NAME)+7+LEN("Extracting -> col")) :: COUNTER_TEMPLATE -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -127,12 +121,7 @@ SUBROUTINE SPARSE_CRS_SPARSE_CCS ( NROWS_A, NCOLS_A, NTERMS_A, MAT_A_NAME, I_A, IF ((DEBUG(87) == 1) .OR. (DEBUG(87) == 3)) CALL CRS_CCS_DEB ( '2' ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SPARSE_CRS_TERM_COUNT.f90 b/Source/UTIL/SPARSE_CRS_TERM_COUNT.f90 index 4b16807d..4c37fe11 100644 --- a/Source/UTIL/SPARSE_CRS_TERM_COUNT.f90 +++ b/Source/UTIL/SPARSE_CRS_TERM_COUNT.f90 @@ -30,10 +30,9 @@ SUBROUTINE SPARSE_CRS_TERM_COUNT ( NROWS, NTERM_IN, MATIN_NAME, I_MATIN, J_MATIN ! of terms from a matrix stored as sparse nonsym that will be in the same matrix stored as sparse sym. USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04 + USE IOUNT1, ONLY : WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_CRS_TERM_COUNT_BEGEND USE SPARSE_CRS_TERM_COUNT_USE_IFs @@ -48,14 +47,9 @@ SUBROUTINE SPARSE_CRS_TERM_COUNT ( NROWS, NTERM_IN, MATIN_NAME, I_MATIN, J_MATIN INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERM_IN) ! Col numbers for nonzero terms in MATIN INTEGER(LONG), INTENT(OUT) :: NTERM_OUT ! Number of nonzero terms in output matrix, MATOUT INTEGER(LONG) :: I,K ! DO loop indices or counters - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_CRS_TERM_COUNT_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -75,12 +69,7 @@ SUBROUTINE SPARSE_CRS_TERM_COUNT ( NROWS, NTERM_IN, MATIN_NAME, I_MATIN, J_MATIN ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SPARSE_CRS_TO_FULL.f90 b/Source/UTIL/SPARSE_CRS_TO_FULL.f90 index 325db67f..b2310afe 100644 --- a/Source/UTIL/SPARSE_CRS_TO_FULL.f90 +++ b/Source/UTIL/SPARSE_CRS_TO_FULL.f90 @@ -29,12 +29,11 @@ SUBROUTINE SPARSE_CRS_TO_FULL ( MATIN_NAME, NTERM_IN, NROWS, NCOLS, SYM_IN, I_MA ! Converts matrices in sparse compressed row storage format to full format USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_CRS_TO_FULL_BEGEND USE SPARSE_CRS_TO_FULL_USE_IFs @@ -51,17 +50,12 @@ SUBROUTINE SPARSE_CRS_TO_FULL ( MATIN_NAME, NTERM_IN, NROWS, NCOLS, SYM_IN, I_MA INTEGER(LONG), INTENT(IN) :: J_MATIN(NTERM_IN) ! Col numbers for nonzero terms in MATIN INTEGER(LONG) :: I,J,K ! DO loop indices or counters INTEGER(LONG) :: ROW_I_NTERMS ! No. terms in row I of input matrix MATIN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_CRS_TO_FULL_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM_IN) ! Real nonzero values in input matrix MATIN REAL(DOUBLE) , INTENT(OUT) :: MATOUT(NROWS,NCOLS) ! Real nonzero values in output matrix MATOUT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Initialize outputs @@ -104,12 +98,7 @@ SUBROUTINE SPARSE_CRS_TO_FULL ( MATIN_NAME, NTERM_IN, NROWS, NCOLS, SYM_IN, I_MA IF( DEBUG(205) > 0) CALL DEBUG_CRS_TO_FULL -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SPARSE_MAT_DIAG_ZEROS.f90 b/Source/UTIL/SPARSE_MAT_DIAG_ZEROS.f90 index 5e762bf6..aa81f047 100644 --- a/Source/UTIL/SPARSE_MAT_DIAG_ZEROS.f90 +++ b/Source/UTIL/SPARSE_MAT_DIAG_ZEROS.f90 @@ -29,11 +29,10 @@ SUBROUTINE SPARSE_MAT_DIAG_ZEROS ( NAME, NROWS_A, NTERM_A, I_A, J_A, NUM_A_DIAG_ ! Determines the number of zero diagonal terms in an input matrix that is stored in compressed row storage format (CRS format) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE DEBUG_PARAMETERS, ONLY : DEBUG - USE SUBR_BEGEND_LEVELS, ONLY : SPARSE_MAT_DIAG_ZEROS_BEGEND USE SPARSE_MAT_DIAG_ZEROS_USE_IFs @@ -53,14 +52,9 @@ SUBROUTINE SPARSE_MAT_DIAG_ZEROS ( NAME, NROWS_A, NTERM_A, I_A, J_A, NUM_A_DIAG_ INTEGER(LONG), INTENT(OUT) :: NUM_A_DIAG_ZEROS ! Number of zero diagonal terms in input matrix A INTEGER(LONG) :: I,K ! DO loop indices INTEGER(LONG) :: ZERO_DIAGS(NROWS_A)! Row numbers where there are zero diag terms - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SPARSE_MAT_DIAG_ZEROS_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize outputs @@ -104,12 +98,7 @@ SUBROUTINE SPARSE_MAT_DIAG_ZEROS ( NAME, NROWS_A, NTERM_A, I_A, J_A, NUM_A_DIAG_ WRITE(F06,101) (ZERO_DIAGS(I),I=1,NUM_A_DIAG_ZEROS) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/STMERR.f90 b/Source/UTIL/STMERR.f90 index c356025d..07f7e553 100644 --- a/Source/UTIL/STMERR.f90 +++ b/Source/UTIL/STMERR.f90 @@ -24,36 +24,28 @@ ! End MIT license text. - SUBROUTINE STMERR ( XTIME, FILNAM, OUNT, WRITE_F04 ) + SUBROUTINE STMERR ( XTIME, FILNAM, OUNT ) ! Prints error messages when the wrong time stamp, STIME, is read as the first record in a file that has been opened - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : FILE_NAM_MAXLEN, WRT_ERR, WRT_LOG, ERR, F04, F06 - USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR - USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : STMERR_BEGEND + USE PENTIUM_II_KIND, ONLY : LONG + USE IOUNT1, ONLY : FILE_NAM_MAXLEN + USE SCONTR, ONLY : FATAL_ERR + USE TIMDAT, ONLY : STIME USE STMERR_USE_IFs IMPLICIT NONE - CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'STMERR' CHARACTER(LEN=*), INTENT(IN) :: FILNAM ! File name - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG), INTENT(IN) :: OUNT(2) ! File units to write messages to INTEGER(LONG), INTENT(IN) :: XTIME ! Time stamp read from file LINK1A INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IEND ! Index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = STMERR_BEGEND + -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** DO I=FILE_NAM_MAXLEN,1,-1 @@ -70,12 +62,7 @@ SUBROUTINE STMERR ( XTIME, FILNAM, OUNT, WRITE_F04 ) FATAL_ERR = FATAL_ERR + 1 -! ********************************************************************************************************************************** - IF ((WRT_LOG >= SUBR_BEGEND) .AND. (WRITE_F04 == 'Y')) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SURFACE_FIT.f90 b/Source/UTIL/SURFACE_FIT.f90 index 3d0427bc..c35f2b74 100644 --- a/Source/UTIL/SURFACE_FIT.f90 +++ b/Source/UTIL/SURFACE_FIT.f90 @@ -31,11 +31,10 @@ SUBROUTINE SURFACE_FIT ( NUM_FITS, NUM_COEFFS, XI, YI, WI, XO, YO, WO, DEB, MESS ! WF(X,Y) = B(0) + B(1)*X + B(2)*Y + B(3)*XY + B(4)*X^2 + B(5)*Y^2 USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE - USE SUBR_BEGEND_LEVELS, ONLY : SURFACE_FIT_BEGEND USE LSQ_MYSTRAN USE SURFACE_FIT_USE_IFs @@ -53,7 +52,7 @@ SUBROUTINE SURFACE_FIT ( NUM_FITS, NUM_COEFFS, XI, YI, WI, XO, YO, WO, DEB, MESS INTEGER(LONG) :: I,J ! DO loop indices INTEGER(LONG) :: IFAULT ! Return code from subr REGCF INTEGER(LONG), PARAMETER :: MAX_COEFFS = 6 ! Maximum number of coefficients coded for ther polynomial fit - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SURFACE_FIT_BEGEND + LOGICAL :: LINDEP(MAX_COEFFS) @@ -83,12 +82,7 @@ SUBROUTINE SURFACE_FIT ( NUM_FITS, NUM_COEFFS, XI, YI, WI, XO, YO, WO, DEB, MESS REAL(DOUBLE), PARAMETER :: WT = ONE ! Parameter -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** IERR = 0 @@ -207,12 +201,7 @@ SUBROUTINE SURFACE_FIT ( NUM_FITS, NUM_COEFFS, XI, YI, WI, XO, YO, WO, DEB, MESS IF (DEB > 0) CALL DEB_SURFACE_FIT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SYM_MAT_DECOMP_LAPACK.f90 b/Source/UTIL/SYM_MAT_DECOMP_LAPACK.f90 index 61136222..a646b3b1 100644 --- a/Source/UTIL/SYM_MAT_DECOMP_LAPACK.f90 +++ b/Source/UTIL/SYM_MAT_DECOMP_LAPACK.f90 @@ -33,18 +33,18 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! actual work USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06 + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FACTORED_MATRIX, FATAL_ERR, LINKNO - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, STIME, TSEC + USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO, ONE, ONEPP6 USE PARAMS, ONLY : BAILOUT, EPSIL, SUPINFO USE LAPACK_DPB_MATRICES, ONLY : ABAND, LAPACK_S USE DEBUG_PARAMETERS, ONLY : DEBUG, NDEBUG USE LAPACK_LIN_EQN_DPB - USE SUBR_BEGEND_LEVELS, ONLY : SYM_MAT_DECOMP_LAPACK_BEGEND USE SYM_MAT_DECOMP_LAPACK_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'SYM_MAT_DECOMP_LAPACK' @@ -64,7 +64,6 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N CHARACTER(LEN=*) , INTENT(IN) :: PRT_ERRS ! If not 'N', print singularity errors CHARACTER( 1*BYTE), PARAMETER :: INORM = 'I' ! Indicates to calculate the infinity norm via LAPACK function DLANSB - CHARACTER(54*BYTE) :: MODNAM ! Name to write to screen to describe module being run CHARACTER( 1*BYTE) :: QUIT_ON_POS_INFO ! Indicator of whether to quit if output value of INFO is found to be > 0 CHARACTER( 1*BYTE), PARAMETER :: UPLO = 'U' ! Indicates upper triang part of matrix is stored @@ -86,7 +85,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IIMAX ! Row/Col in MATIN where max diagonal term occurs INTEGER(LONG) :: IIMIN ! Row/Col in MATIN where min diagonal term occurs - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SYM_MAT_DECOMP_LAPACK_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERMS) ! A small number to compare real zero REAL(DOUBLE) , INTENT(OUT) :: RCOND ! Recrip of cond no. of MATIN. Determined in subr COND_NUM @@ -109,12 +108,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N INTRINSIC :: DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Deallocate ABAND in case it is already allocated @@ -132,9 +126,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! Determine bandwidth of matrix - CALL OURTIM - MODNAM = 'CALC BANDWIDTH OF MATRIX ' // MATIN_NAME(1:) - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC BANDWIDTH OF MATRIX ' // MATIN_NAME(1:)) CALL BANDSIZ ( NROWS, NTERMS, I_MATIN, J_MATIN, MATIN_SDIA ) MB_TO_ALLOCATE = (REAL(DOUBLE))*(REAL(MATIN_SDIA+1))*(REAL(NROWS))/ONEPP6 WRITE(SC1,3094) MATIN_NAME, MATIN_SDIA+1, MB_TO_ALLOCATE @@ -156,17 +148,13 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! Allocate array ABAND (matrix in band form for LAPACK) - CALL OURTIM - MODNAM = 'ALLOCATE ARRAYS FOR LAPACK BAND FORM OF ' // MATIN_NAME(1:) - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('ALLOCATE ARRAYS FOR LAPACK BAND FORM OF ' // MATIN_NAME(1:)) CALL ALLOCATE_LAPACK_MAT ( 'ABAND', MATIN_SDIA+1, NROWS, SUBR_NAME ) CALL ALLOCATE_LAPACK_MAT ( 'LAPACK_S', NROWS, 1, SUBR_NAME ) ! Put MATIN matrix into ABAND form required by LAPACK band matrix. - CALL OURTIM - MODNAM = 'PUT INTO LAPACK BAND FORM: MATRIX ' // MATIN_NAME(1:) - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('PUT INTO LAPACK BAND FORM: MATRIX ' // MATIN_NAME(1:)) CALL BANDGEN_LAPACK_DPB ( MATIN_NAME, NROWS, MATIN_SDIA, NTERMS, I_MATIN, J_MATIN, MATIN, ABAND, SUBR_NAME ) ! Output ABAND, if requested @@ -181,9 +169,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! of errors in the solution. Use array S for workspace in the calculation. IF (CALC_COND_NUM == 'Y') THEN - CALL OURTIM - MODNAM = 'CALC INFINITY NORM OF MATRIX ' // MATIN_NAME(1:) - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC INFINITY NORM OF MATRIX ' // MATIN_NAME(1:)) !xx WRITE(SC1, * ) K_INORM = DLANSB ( INORM, UPLO, NROWS, MATIN_SDIA, ABAND, MATIN_SDIA+1, LAPACK_S ) WRITE(F06,3005) MATIN_NAME, K_INORM @@ -192,9 +178,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! Get max & min diagonals from the original matrix. Code assumes all diag terms positive IF (MATIN_DIAG_RAT == 'Y') THEN - CALL OURTIM - MODNAM = 'GET MAX/MIN DIAGONALS OF MATRIX ' // MATIN_NAME(1:) - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GET MAX/MIN DIAGONALS OF MATRIX ' // MATIN_NAME(1:)) MAXKII = ZERO IIMAX = 0 @@ -226,9 +210,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! Equilibrate matrix, if user requested it via input arg EQUIL_MATIN ! TEMPORARILY REMOVE THIS CODE. IT WAS CAUSING ERRORS - FAILURES DUE TO RATIO OF MATRIX DIAG TO FACTOR DIAG WHEN EQUILIBRATED ! IF (EQUIL_MATIN == 'Y') THEN -! CALL OURTIM -! MODNAM = 'EQUILIBRATING (IF NEEDED) MATRIX ' // MATIN_NAME(1:) -! WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC +! CALL LINK_MESSAGE('EQUILIBRATING (IF NEEDED) MATRIX ' // MATIN_NAME(1:)) ! CALL EQUILIBRATE( MATIN_NAME, MATIN_SET, NROWS, MATIN_SDIA, ABAND, LAPACK_S, EQUED, SCOND ) ! ENDIF @@ -246,9 +228,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! Get max & min diagonals from the equilibrated matrix. Code assumes all diag terms positive IF ((EQUED == 'Y') .AND. (MATIN_DIAG_RAT == 'Y')) THEN - CALL OURTIM - MODNAM = 'GET MAX/MIN DIAGONALS OF EQUILIBRATED MATRIX' // MATIN_NAME(1:) - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('GET MAX/MIN DIAGONALS OF EQUILIBRATED MATRIX' // MATIN_NAME(1:)) MAXKII = ZERO IIMAX = 0 @@ -287,9 +267,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! Perform factorization of matrix. ABAND is the original matrix going into the decomp routine and is the upper triangular factor on ! exit. - CALL OURTIM - MODNAM = 'LAPACK TRIANGULAR FACTORIZATION OF MATRIX ' // MATIN_NAME(1:) - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('LAPACK TRIANGULAR FACTORIZATION OF MATRIX ' // MATIN_NAME(1:)) CALL DPBTRF ( UPLO, NROWS, MATIN_SDIA, ABAND, MATIN_SDIA+1, INFO ) CALLED_SUBR = 'DPBTRF' @@ -357,9 +335,7 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N RCOND = ZERO IF (CALC_COND_NUM == 'Y') THEN - CALL OURTIM - MODNAM = 'CALC RECIP OF COND NUM OF MATRIX ' // MATIN_NAME(1:) - WRITE(SC1,3092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('CALC RECIP OF COND NUM OF MATRIX ' // MATIN_NAME(1:)) CALL COND_NUM ( MATIN_NAME, NROWS, MATIN_SDIA, K_INORM, ABAND, RCOND ) ENDIF @@ -401,19 +377,12 @@ SUBROUTINE SYM_MAT_DECOMP_LAPACK ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N 3011 FORMAT(' *INFORMATION: RATIO OF MAX TO MIN DIAGONALS IN THE EQUILIBRATED MATRIX ',A11,' = ',1ES13.6,/) - 3092 FORMAT(1X,I2,'/',A54,8X,2X,I2,':',I2,':',I2,'.',I3) - 3094 FORMAT(5X,' Bandwidth of ',A,' = ',I8,' and requires ',F10.3,' MB of memory') 99999 FORMAT(/,' PROCESSING TERMINATED DUE TO ABOVE MESSAGES AND BULK DATA PARAMETER BAILOUT = ',I7) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/SYM_MAT_DECOMP_SUPRLU.f90 b/Source/UTIL/SYM_MAT_DECOMP_SUPRLU.f90 index 879a1317..bfec31e4 100644 --- a/Source/UTIL/SYM_MAT_DECOMP_SUPRLU.f90 +++ b/Source/UTIL/SYM_MAT_DECOMP_SUPRLU.f90 @@ -29,14 +29,13 @@ SUBROUTINE SYM_MAT_DECOMP_SUPRLU ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ! Decomposes a symmetric band matrix into triangular factors. The input matrix, MATIN, is stored in CRS sparse format USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, ERR, F04, F06, SC1 + USE IOUNT1, ONLY : ERR, F06, SC1 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : CRS_CCS, SPARSTOR, BAILOUT USE SCRATCH_MATRICES, ONLY : I_CCS1, J_CCS1, CCS1 USE SuperLU_STUF, ONLY : SLU_FACTORS - USE SUBR_BEGEND_LEVELS, ONLY : SYM_MAT_DECOMP_SUPRLU_BEGEND USE SYM_MAT_DECOMP_SUPRLU_USE_IFs @@ -59,19 +58,14 @@ SUBROUTINE SYM_MAT_DECOMP_SUPRLU ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N INTEGER(LONG), INTENT(INOUT) :: INFO ! Output from SuperLU routine - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = SYM_MAT_DECOMP_SUPRLU_BEGEND + INTEGER(LONG) :: COMPV ! Component number (1-6) of a grid DOF INTEGER(LONG) :: GRIDV ! Grid number REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERMS) REAL(DOUBLE) :: DUM_COL(NROWS) ! Temp variable for solving equations -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -166,12 +160,7 @@ SUBROUTINE SYM_MAT_DECOMP_SUPRLU ( CALLING_SUBR, MATIN_NAME, MATIN_SET, NROWS, N ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/UNIX_TIME.f03 b/Source/UTIL/UNIX_TIME.f03 new file mode 100644 index 00000000..e76a873b --- /dev/null +++ b/Source/UTIL/UNIX_TIME.f03 @@ -0,0 +1,48 @@ +! ################################################################################################################################## +! Begin MIT license text. +! _______________________________________________________________________________________________________ + +! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) + +! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and +! associated documentation files (the "Software"), to deal in the Software without restriction, including +! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to +! the following conditions: + +! The above copyright notice and this permission notice shall be included in all copies or substantial +! portions of the Software and documentation. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +! THE SOFTWARE. +! _______________________________________________________________________________________________________ + +! End MIT license text. + +! Computes the current UNIX timestamp via C's time(). + +SUBROUTINE UNIX_TIME(T) + + USE PENTIUM_II_KIND, ONLY: LONG + USE ISO_C_BINDING, ONLY: C_PTR, C_NULL_PTR, C_LONG + + IMPLICIT NONE + + INTEGER(LONG), INTENT(OUT) :: T + + INTERFACE + FUNCTION C_TIME(TLOC) BIND(C, NAME='time') + IMPORT :: C_PTR, C_LONG + TYPE(C_PTR), VALUE :: TLOC + INTEGER(C_LONG) :: C_TIME + END FUNCTION C_TIME + END INTERFACE + + T = INT(C_TIME(C_NULL_PTR), LONG) + +END SUBROUTINE UNIX_TIME diff --git a/Source/UTIL/UNIX_TIME.f90 b/Source/UTIL/UNIX_TIME.f90 deleted file mode 100644 index 2d1174ff..00000000 --- a/Source/UTIL/UNIX_TIME.f90 +++ /dev/null @@ -1,83 +0,0 @@ -! ################################################################################################################################## -! Begin MIT license text. -! _______________________________________________________________________________________________________ - -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) - -! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and -! associated documentation files (the "Software"), to deal in the Software without restriction, including -! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to -! the following conditions: - -! The above copyright notice and this permission notice shall be included in all copies or substantial -! portions of the Software and documentation. - -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -! THE SOFTWARE. -! _______________________________________________________________________________________________________ - -! End MIT license text. - -! Computes the current UNIX timestamp. - -SUBROUTINE UNIX_TIME(T) - - USE PENTIUM_II_KIND, ONLY: LONG - - IMPLICIT NONE - - INTEGER(LONG), INTENT(OUT) :: T - CHARACTER(LEN=8) :: DATE_C - CHARACTER(LEN=10) :: TIME_C - CHARACTER(LEN=5) :: ZONE_C - INTEGER :: VALUES(8) - INTEGER :: Y, MO, DA, HH, MM, SS - INTEGER :: ZH, ZM, SIGN - INTEGER(LONG) :: TZ_MIN, Y0, M0, A, B, JDN, EPOCH - - CALL DATE_AND_TIME(DATE_C, TIME_C, ZONE_C, VALUES) - - READ(DATE_C(1:4), '(I4)') Y - READ(DATE_C(5:6), '(I2)') MO - READ(DATE_C(7:8), '(I2)') DA - - READ(TIME_C(1:2), '(I2)') HH - READ(TIME_C(3:4), '(I2)') MM - READ(TIME_C(5:6), '(I2)') SS - - ! Parse timezone “+hhmm”/“-hhmm” into minutes - IF (ZONE_C(1:1) .EQ. '-') THEN - SIGN = -1 - ELSE - SIGN = 1 - END IF - READ(ZONE_C(2:3), '(I2)') ZH - READ(ZONE_C(4:5), '(I2)') ZM - TZ_MIN = SIGN * (ZH * 60 + ZM) - - ! Compute Julian Day Number - IF (MO .LE. 2) THEN - Y0 = Y - 1 - M0 = MO + 12 - ELSE - Y0 = Y - M0 = MO - END IF - A = Y0 / 100 - B = 2 - A + A / 4 - JDN = INT(365.25D0 * (Y0 + 4716)) + INT(30.6001D0 * (M0 + 1)) & - + DA + B - 1524 - - EPOCH = 2440588 ! JDN of 1970-01-01 - - T = (JDN - EPOCH) * 86400 & - + HH * 3600 + MM * 60 + SS & - - TZ_MIN * 60 - -END SUBROUTINE UNIX_TIME diff --git a/Source/UTIL/VECTOR_NORM.f90 b/Source/UTIL/VECTOR_NORM.f90 index 32e604cd..438c6491 100644 --- a/Source/UTIL/VECTOR_NORM.f90 +++ b/Source/UTIL/VECTOR_NORM.f90 @@ -33,11 +33,10 @@ SUBROUTINE VECTOR_NORM ( VEC, NSIZE, WHICH, VEC_NORM, IERR ) ! (2) If WHICH = 'INFINITY' , calculate the infinity norm (maximum absolute value in the vector) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO - USE SUBR_BEGEND_LEVELS, ONLY : VECTOR_NORM_BEGEND USE VECTOR_NORM_USE_IFs @@ -49,7 +48,6 @@ SUBROUTINE VECTOR_NORM ( VEC, NSIZE, WHICH, VEC_NORM, IERR ) INTEGER(LONG) , INTENT(IN) :: NSIZE ! Extent of VEC INTEGER(LONG) , INTENT(OUT) :: IERR ! Error indicator INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG) , PARAMETER :: SUBR_BEGEND = VECTOR_NORM_BEGEND REAL(DOUBLE) , INTENT(IN) :: VEC(NSIZE) ! The vector for which the norm will be calculated REAL(DOUBLE) , INTENT(OUT) :: VEC_NORM ! The norm calculated for VEC @@ -57,12 +55,7 @@ SUBROUTINE VECTOR_NORM ( VEC, NSIZE, WHICH, VEC_NORM, IERR ) INTRINSIC :: DSQRT -! ********************************************************************************************************************************* - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGIN',F10.3) - ENDIF + ! ********************************************************************************************************************************** IERR = 0 @@ -92,12 +85,7 @@ SUBROUTINE VECTOR_NORM ( VEC, NSIZE, WHICH, VEC_NORM, IERR ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_ALLOC_MEM_TABLE.f90 b/Source/UTIL/WRITE_ALLOC_MEM_TABLE.f90 index cc9f1df9..9fdcf7d0 100644 --- a/Source/UTIL/WRITE_ALLOC_MEM_TABLE.f90 +++ b/Source/UTIL/WRITE_ALLOC_MEM_TABLE.f90 @@ -31,7 +31,7 @@ SUBROUTINE WRITE_ALLOC_MEM_TABLE ( MESSAGE ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : BLNK_SUB_NAM - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE CONSTANTS_1, ONLY : ZERO USE DEBUG_PARAMETERS, ONLY : DEBUG USE ALLOCATED_ARRAY_DATA, ONLY : ALLOCATED_ARRAY_NAMES, ALLOCATED_ARRAY_MEM, NUM_ALLOC_ARRAYS diff --git a/Source/UTIL/WRITE_DOF_TABLES.f90 b/Source/UTIL/WRITE_DOF_TABLES.f90 index 1d2a65d6..fbca3401 100644 --- a/Source/UTIL/WRITE_DOF_TABLES.f90 +++ b/Source/UTIL/WRITE_DOF_TABLES.f90 @@ -29,10 +29,9 @@ SUBROUTINE WRITE_DOF_TABLES ! Writess DOF table data to file LINK1C USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, L1C, LINK1C, L1C_MSG, ERR, F06 + USE IOUNT1, ONLY : L1C, LINK1C, L1C_MSG, ERR, F06 USE SCONTR, ONLY : DATA_NAM_LEN, MTDOF, NDOFG, NGRID, BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_DOF_TABLES_BEGEND USE DOF_TABLES, ONLY : TDOFI, TDOF, TSET USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP @@ -44,15 +43,10 @@ SUBROUTINE WRITE_DOF_TABLES CHARACTER(LEN=DATA_NAM_LEN) :: DATA_SET_NAME ! A data set name for output purposes INTEGER(LONG) :: I,J ! DO loop indices or counters - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_DOF_TABLES_BEGEND + INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Write TSET, TDOF, TDOFI tables to file L1C @@ -61,7 +55,7 @@ SUBROUTINE WRITE_DOF_TABLES IF (LOAD_ISTEP > 1) THEN OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'REPLACE', L1C_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1C, LINK1C, OUNT, 'REPLACE', L1C_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ENDIF DATA_SET_NAME = 'TSET' @@ -91,12 +85,7 @@ SUBROUTINE WRITE_DOF_TABLES ENDDO ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_EDAT.f90 b/Source/UTIL/WRITE_EDAT.f90 index 855fd271..dd98a973 100644 --- a/Source/UTIL/WRITE_EDAT.f90 +++ b/Source/UTIL/WRITE_EDAT.f90 @@ -30,7 +30,7 @@ SUBROUTINE WRITE_EDAT ! the information read fron element connection entries in the Bulk Data USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM , LGUSERIN , LSUSERIN , NELE , NCUSERIN , WARN_ERR, & MEDAT_CBAR , MEDAT_CBEAM , MEDAT_CBUSH , MEDAT_CELAS1 , MEDAT_CELAS2 , & @@ -42,7 +42,6 @@ SUBROUTINE WRITE_EDAT USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : EDAT, EPNT, ETYPE USE PARAMS, ONLY : SUPWARN - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_EDAT_BEGEND USE WRITE_EDAT_USE_IFs @@ -62,14 +61,9 @@ SUBROUTINE WRITE_EDAT INTEGER(LONG) :: MEDAT ! Number of terms in EDAT for a specific element type INTEGER(LONG) :: NG ! Number of grids defined on a CUSERIN entry INTEGER(LONG) :: NS ! Number of scalar points defined on a CUSERIN entry - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_EDAT_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize @@ -411,12 +405,7 @@ SUBROUTINE WRITE_EDAT WRITE(F06,2100) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_ELM_OT4.f90 b/Source/UTIL/WRITE_ELM_OT4.f90 index d6a4cc4f..17044b90 100644 --- a/Source/UTIL/WRITE_ELM_OT4.f90 +++ b/Source/UTIL/WRITE_ELM_OT4.f90 @@ -29,11 +29,9 @@ SUBROUTINE WRITE_ELM_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) ! Writes CB OTM text file that describes the rows of element related OTM matrices USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CC_OUTPUT_DESCRIBERS, ONLY : STRN_LOC, STRE_LOC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_ELM_OT4_BEGEND USE WRITE_ELM_OT4_USE_IFs @@ -49,14 +47,9 @@ SUBROUTINE WRITE_ELM_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) INTEGER(LONG), INTENT(IN) :: NROWS_MAT ! Number of rows in MAT INTEGER(LONG), INTENT(IN) :: UNT ! Unit number where to write matrix INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_ELM_OT4_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** WRITE(UNT,11) NROWS_MAT, NCOLS, MAT_NAME @@ -84,12 +77,7 @@ SUBROUTINE WRITE_ELM_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) WRITE(UNT, *) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_FIJFIL.f90 b/Source/UTIL/WRITE_FIJFIL.f90 index f1ea5310..bcbbf041 100644 --- a/Source/UTIL/WRITE_FIJFIL.f90 +++ b/Source/UTIL/WRITE_FIJFIL.f90 @@ -30,11 +30,10 @@ SUBROUTINE WRITE_FIJFIL ( WHICH, JVEC ) ! User must have Case Control entries ELDATA in order to get these files written USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, F06, F21, F22, F23, F24, F25, F21_MSG, F22_MSG, F23_MSG, F24_MSG, F25_MSG + USE IOUNT1, ONLY : F06, F21, F22, F23, F24, F25, F21_MSG, F22_MSG, F23_MSG, F24_MSG, F25_MSG USE DEBUG_PARAMETERS USE SCONTR, ONLY : BLNK_SUB_NAM, MAX_STRESS_POINTS, NSUB, NTSUB USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_FIJFIL_BEGEND USE MODEL_STUF, ONLY : EID, TYPE, ELGP, ELDOF, KE, ME, PEB, PEG, PEL, PPE, PTE, & SE1, SE2, SE3, STE1, STE2, STE3, UEB, UEG, UEL USE PARAMS, ONLY : ELFORCEN @@ -48,14 +47,9 @@ SUBROUTINE WRITE_FIJFIL ( WHICH, JVEC ) INTEGER(LONG), INTENT(IN) :: JVEC ! Internal subcase or vector number for data to be written INTEGER(LONG), INTENT(IN) :: WHICH ! Which F2j file to write to INTEGER(LONG) :: I,J, K ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_FIJFIL_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** @@ -193,12 +187,7 @@ SUBROUTINE WRITE_FIJFIL ( WHICH, JVEC ) !xx WRITE(F25) 'FINISHED' ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_GRD_OT4.f90 b/Source/UTIL/WRITE_GRD_OT4.f90 index bd34ac72..6535fe4e 100644 --- a/Source/UTIL/WRITE_GRD_OT4.f90 +++ b/Source/UTIL/WRITE_GRD_OT4.f90 @@ -29,10 +29,8 @@ SUBROUTINE WRITE_GRD_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) ! Writes CB OTM text file that describes the rows of grid related OTM matrices USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_GRD_OT4_BEGEND USE WRITE_GRD_OT4_USE_IFs @@ -48,14 +46,9 @@ SUBROUTINE WRITE_GRD_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) INTEGER(LONG), INTENT(IN) :: NROWS_MAT ! Number of rows in MAT INTEGER(LONG), INTENT(IN) :: UNT ! Unit number where to write matrix INTEGER(LONG) :: I ! DO loop index - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_GRD_OT4_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** WRITE(UNT, 1) NROWS_MAT, NCOLS, MAT_NAME @@ -67,12 +60,7 @@ SUBROUTINE WRITE_GRD_OT4 ( MAT_NAME, NROWS_MAT, NROWS_TXT, NCOLS, TXT, UNT ) WRITE(UNT, *) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_INTEGER_VEC.f90 b/Source/UTIL/WRITE_INTEGER_VEC.f90 index bc33689a..3bdff5c2 100644 --- a/Source/UTIL/WRITE_INTEGER_VEC.f90 +++ b/Source/UTIL/WRITE_INTEGER_VEC.f90 @@ -29,10 +29,9 @@ SUBROUTINE WRITE_INTEGER_VEC ( ARRAY_DESCR, INT_VEC, NROWS ) ! Writes an integer vector to F06 in a format that has 10 terms across the page (repeated until vector is completely written) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MATRIX_BY_COLS_BEGEND USE WRITE_INTEGER_VEC_USE_IFs ! Corrected 2019/07/14 (was WRITE_VECTOR_USE_IFs) @@ -48,16 +47,11 @@ SUBROUTINE WRITE_INTEGER_VEC ( ARRAY_DESCR, INT_VEC, NROWS ) INTEGER(LONG) :: INT_VEC_LINE(10) ! 10 members of INT_VEC INTEGER(LONG) :: NUM_LEFT ! Count of the number of rows of INT_VEC left to write out INTEGER(LONG) :: PAD ! Number of spaces to pad in HEADER to center MAT_DESCRIPTOR - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MATRIX_BY_COLS_BEGEND + INTRINSIC :: LEN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** PAD = (132 - LEN(ARRAY_DESCR))/2 @@ -82,12 +76,7 @@ SUBROUTINE WRITE_INTEGER_VEC ( ARRAY_DESCR, INT_VEC, NROWS ) ENDDO WRITE(F06,*) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_L1A.f90 b/Source/UTIL/WRITE_L1A.f90 index 1b468b52..ee320f0b 100644 --- a/Source/UTIL/WRITE_L1A.f90 +++ b/Source/UTIL/WRITE_L1A.f90 @@ -24,16 +24,16 @@ ! End MIT license text. - SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) + SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE ) ! Writes data to file LINK1A at the end of each LINK. This is read by all LINK's after LINK1, as they begin. This text file contains ! the names of files opened for a run, the "counter" info (e.g. NGRID, number of grids, etc), solution number, PARAM's USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : MOT4, MOU4, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : MOT4, MOU4, WRT_ERR - USE IOUNT1, ONLY : ANS, BUG, EIN, ENF, ERR, F04, F06, IN0, IN1, INI, & + USE IOUNT1, ONLY : BUG, EIN, ENF, ERR, F06, IN0, IN1, INI, & L1A, NEU, OT4, PCH, SEQ, SPC, SC1, & F21, F22, F23, F24, F25, & L1B, L1C, L1D, L1E, L1F, L1G, L1H, L1I, L1J, L1K, & @@ -43,7 +43,7 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) L2K, L2L, L2M, L2N, L2O, L2P, L2Q, L2R, L2S, L2T, & L3A, L4A, L4B, L4C, L4D, L5A, L5B, OP2, OU4 - USE IOUNT1, ONLY : ANSSTAT, BUGSTAT, EINSTAT, ENFSTAT, ERRSTAT, F04STAT, F06STAT, IN0STAT, IN1STAT, INISTAT, & + USE IOUNT1, ONLY : BUGSTAT, EINSTAT, ENFSTAT, ERRSTAT, F06STAT, IN0STAT, IN1STAT, INISTAT, & L1ASTAT, NEUSTAT, OT4STAT, PCHSTAT, SEQSTAT, SPCSTAT, & F21STAT, F22STAT, F23STAT, F24STAT, F25STAT, & L1BSTAT, L1CSTAT, L1DSTAT, L1ESTAT, L1FSTAT, L1GSTAT, L1HSTAT, L1ISTAT, L1JSTAT, L1KSTAT, & @@ -53,7 +53,7 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) L2KSTAT, L2LSTAT, L2MSTAT, L2NSTAT, L2OSTAT, L2PSTAT, L2QSTAT, L2RSTAT, L2SSTAT, L2TSTAT, & L3ASTAT, L4ASTAT, L4BSTAT, L4CSTAT, L4DSTAT, L5ASTAT, L5BSTAT, OP2STAT, OU4STAT - USE IOUNT1, ONLY : ANSFIL, BUGFIL, EINFIL, ENFFIL, ERRFIL, F04FIL, F06FIL, IN0FIL, INIFIL, LINK1A, & + USE IOUNT1, ONLY : BUGFIL, EINFIL, ENFFIL, ERRFIL, F06FIL, IN0FIL, INIFIL, LINK1A, & NEUFIL, OT4FIL, PCHFIL, SEQFIL, SPCFIL, F21FIL, F22FIL, F23FIL, F24FIL, F25FIL, & LINK1A, LINK1B, LINK1C, LINK1D, LINK1E, LINK1F, LINK1G, LINK1H, LINK1I, LINK1J, & LINK1K, LINK1L, LINK1M, LINK1N, LINK1O, LINK1P, LINK1Q, LINK1R, LINK1S, LINK1T, & @@ -62,7 +62,7 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) LINK2K, LINK2L, LINK2M, LINK2N, LINK2O, LINK2P, LINK2Q, LINK2R, LINK2S, LINK2T, & LINK3A, LINK4A, LINK4B, LINK4C, LINK4D, LINK5A, LINK5B, OP2FIL, OU4FIL - USE IOUNT1, ONLY : ANS_MSG, BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F04_MSG, F06_MSG, IN0_MSG, IN1_MSG, INI_MSG, & + USE IOUNT1, ONLY : BUG_MSG, EIN_MSG, ENF_MSG, ERR_MSG, F06_MSG, IN0_MSG, IN1_MSG, INI_MSG, & L1A_MSG, NEU_MSG, OT4_MSG, PCH_MSG, SEQ_MSG, SPC_MSG, & F21_MSG, F22_MSG, F23_MSG, F24_MSG, F25_MSG, & L1B_MSG, L1C_MSG, L1D_MSG, L1E_MSG, L1F_MSG, L1G_MSG, L1H_MSG, L1I_MSG, L1J_MSG, L1K_MSG, & @@ -73,7 +73,6 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) L3A_MSG, L4A_MSG, L4B_MSG, L4C_MSG, L4D_MSG, L5A_MSG, L5B_MSG, OP2_MSG, OU4_MSG USE SCONTR USE TIMDAT, ONLY : STIME, TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_L1A_BEGEND USE PARAMS, ONLY : CBMIN3, CBMIN4, ELFORCEN, HEXAXIS, IORQ1B, IORQ1M, IORQ1S, IORQ2B, IORQ2T,& MATSPARS, MIN4TRED, QUAD4TYP, QUADAXIS, SPARSTOR @@ -85,19 +84,13 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) CHARACTER(LEN=*), INTENT(IN) :: CLOSE_STAT ! STATUS when closing file LINK1A CHARACTER(LEN=*), INTENT(IN) :: CALL_OUTA_HERE ! 'Y'/'N' indicator of whether to call OUTA_HERE (this should be 'Y' ! except when this subr is called by OUTA_HERE - CHARACTER(LEN=*), INTENT(IN) :: WRITE_F04 ! If 'Y' write subr begin/end times to F04 (if WRT_LOG >= SUBR_BEGEND) INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: IOCHK ! IOSTAT error number when opening/reading a file INTEGER(LONG) :: OUNT(2) ! File units to write messages to - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_L1A_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Units for writing open errors @@ -109,8 +102,8 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) OPEN (L1A,FILE=LINK1A,STATUS='REPLACE',IOSTAT=IOCHK) IF (IOCHK /= 0) THEN - CALL OPNERR (IOCHK, LINK1A, OUNT, WRITE_F04 ) - CALL FILERR ( OUNT, WRITE_F04 ) + CALL OPNERR (IOCHK, LINK1A, OUNT ) + CALL FILERR ( OUNT ) IF (CALL_OUTA_HERE == 'Y') THEN CALL OUTA_HERE ( 'N' ) ENDIF @@ -129,12 +122,10 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) WRITE(L1A,140) SC1 ! 1 - WRITE(L1A,151) ANS,ANSSTAT,ANS_MSG,ANSFIL ! 2 WRITE(L1A,151) BUG,BUGSTAT,BUG_MSG,BUGFIL ! 3 WRITE(L1A,151) EIN,EINSTAT,EIN_MSG,EINFIL ! 4 WRITE(L1A,151) ENF,ENFSTAT,ENF_MSG,ENFFIL ! 5 WRITE(L1A,151) ERR,ERRSTAT,ERR_MSG,ERRFIL ! 6 - WRITE(L1A,151) F04,F04STAT,F04_MSG,F04FIL ! 7 WRITE(L1A,151) F06,F06STAT,F06_MSG,F06FIL ! 8 WRITE(L1A,151) IN0,IN0STAT,IN0_MSG,IN0FIL ! 9 WRITE(L1A,151) L1A,L1ASTAT,L1A_MSG,LINK1A ! 10 @@ -538,14 +529,9 @@ SUBROUTINE WRITE_L1A ( CLOSE_STAT, CALL_OUTA_HERE, WRITE_F04 ) WRITE(L1A,103) (COMM(I),I=0,49) - CALL FILE_CLOSE ( L1A, LINK1A, CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( L1A, LINK1A, CLOSE_STAT ) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_L1M.f90 b/Source/UTIL/WRITE_L1M.f90 index 35686cc4..446dd46c 100644 --- a/Source/UTIL/WRITE_L1M.f90 +++ b/Source/UTIL/WRITE_L1M.f90 @@ -31,8 +31,7 @@ SUBROUTINE WRITE_L1M USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE SCONTR, ONLY : LINKNO, NUM_EIGENS - USE IOUNT1, ONLY : ERR, F06, L1M, L1M_MSG, L1MSTAT, LINK1M, SC1, WRT_ERR, WRT_LOG - USE TIMDAT, ONLY : HOUR, MINUTE, SEC, SFRAC, STIME, TSEC + USE IOUNT1, ONLY : ERR, F06, L1M, L1M_MSG, L1MSTAT, LINK1M, SC1, WRT_ERR USE DEBUG_PARAMETERS, ONLY : DEBUG USE EIGEN_MATRICES_1 , ONLY : EIGEN_VAL, GEN_MASS, MODE_NUM @@ -41,10 +40,9 @@ SUBROUTINE WRITE_L1M MIJ_COL, MIJ_ROW, NUM_FAIL_CRIT USE WRITE_L1M_USE_IFs - + USE LINK_MESSAGE_Interface + IMPLICIT NONE - - CHARACTER(54*BYTE) :: MODNAM ! Name to write to screen to describe module being run INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: OUNT(2) ! File units to write messages to @@ -57,11 +55,9 @@ SUBROUTINE WRITE_L1M !xx STATUS = 'OLD ' !xx RW = 'WRITE' - CALL FILE_OPEN ( L1M, LINK1M, OUNT, 'REPLACE', L1M_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1M, LINK1M, OUNT, 'REPLACE', L1M_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) - CALL OURTIM - MODNAM = 'WRITE EIGENVALUE DATA FROM PRIOR LINK' - WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC + CALL LINK_MESSAGE('WRITE EIGENVALUE DATA FROM PRIOR LINK') WRITE(L1M) EIG_SID WRITE(L1M) EIG_METH @@ -88,10 +84,8 @@ SUBROUTINE WRITE_L1M WRITE(L1M) MODE_NUM(I), EIGEN_VAL(I), GEN_MASS(I) ENDDO - CALL FILE_CLOSE ( L1M, LINK1M, 'KEEP', 'Y' ) + CALL FILE_CLOSE ( L1M, LINK1M, 'KEEP' ) -! ********************************************************************************************************************************** - 9092 FORMAT(1X,I2,'/',A54,8X,2X,I2,':',I2,':',I2,'.',I3) ! ********************************************************************************************************************************** diff --git a/Source/UTIL/WRITE_L1Z.f90 b/Source/UTIL/WRITE_L1Z.f90 index 15948a67..c62fc073 100644 --- a/Source/UTIL/WRITE_L1Z.f90 +++ b/Source/UTIL/WRITE_L1Z.f90 @@ -29,11 +29,10 @@ SUBROUTINE WRITE_L1Z ! Writes file LINK1Z of some of the data needed in a restart if user has CHKPNT in the Exec Control USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04, F06, L1Z, LINK1Z, L1Z_MSG, L1ZSTAT + USE IOUNT1, ONLY : F06, L1Z, LINK1Z, L1Z_MSG, L1ZSTAT USE SCONTR, ONLY : BLNK_SUB_NAM, NSUB, SOL_NAME USE TIMDAT, ONLY : STIME, TSEC USE MODEL_STUF, ONLY : CC_EIGR_SID, MPCSET, SPCSET, SUBLOD - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_L1Z_BEGEND USE WRITE_L1Z_USE_IFs @@ -44,17 +43,12 @@ SUBROUTINE WRITE_L1Z INTEGER(LONG) :: I ! DO loop index INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_L1Z_BEGEND + -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** - CALL FILE_OPEN ( L1Z, LINK1Z, OUNT, 'REPLACE', L1Z_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( L1Z, LINK1Z, OUNT, 'REPLACE', L1Z_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) WRITE(L1Z) SOL_NAME WRITE(L1Z) NSUB WRITE(L1Z) MPCSET @@ -63,9 +57,8 @@ SUBROUTINE WRITE_L1Z WRITE(L1Z) SUBLOD(I,1), SUBLOD(I,2) ENDDO WRITE(L1Z) CC_EIGR_SID - CALL FILE_CLOSE ( L1Z, LINK1Z, L1ZSTAT, 'Y' ) + CALL FILE_CLOSE ( L1Z, LINK1Z, L1ZSTAT ) - 9002 FORMAT(1X,A,' END ',F10.3) ! ********************************************************************************************************************************** END SUBROUTINE WRITE_L1Z diff --git a/Source/UTIL/WRITE_MATRIX_1.f90 b/Source/UTIL/WRITE_MATRIX_1.f90 index 6b880451..66dcf35e 100644 --- a/Source/UTIL/WRITE_MATRIX_1.f90 +++ b/Source/UTIL/WRITE_MATRIX_1.f90 @@ -33,10 +33,9 @@ SUBROUTINE WRITE_MATRIX_1 ( FILNAM, UNT, CLOSE_IT, CLOSE_STAT, MESSAG, NAME, NTE USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, SC1, WRT_ERR, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, SC1, WRT_ERR USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MATRIX_1_BEGEND USE WRITE_MATRIX_1_USE_IFs @@ -58,7 +57,7 @@ SUBROUTINE WRITE_MATRIX_1 ( FILNAM, UNT, CLOSE_IT, CLOSE_STAT, MESSAG, NAME, NTE INTEGER(LONG) :: I,J,K ! DO loop indices or counters INTEGER(LONG) :: NTERM_ROW_I ! Number of terms in row I of MATIN INTEGER(LONG) :: OUNT(2) ! File units to write messages to. Input to subr UNFORMATTED_OPEN - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MATRIX_1_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATIN(NTERM) ! Real values for matrix MATIN @@ -66,18 +65,13 @@ SUBROUTINE WRITE_MATRIX_1 ( FILNAM, UNT, CLOSE_IT, CLOSE_STAT, MESSAG, NAME, NTE INTRINSIC DABS -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** OUNT(1) = ERR OUNT(2) = F06 - CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'REPLACE', MESSAG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) + CALL FILE_OPEN ( UNT, FILNAM, OUNT, 'REPLACE', MESSAG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N' ) ! Write sparse (compressed row storage) matrix to file in i, j, val format: @@ -97,15 +91,10 @@ SUBROUTINE WRITE_MATRIX_1 ( FILNAM, UNT, CLOSE_IT, CLOSE_STAT, MESSAG, NAME, NTE ENDDO IF (CLOSE_IT == 'Y') THEN - CALL FILE_CLOSE ( UNT, FILNAM, CLOSE_STAT, 'Y' ) + CALL FILE_CLOSE ( UNT, FILNAM, CLOSE_STAT ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_MATRIX_BY_COLS.f90 b/Source/UTIL/WRITE_MATRIX_BY_COLS.f90 index 7cec948d..f01fd092 100644 --- a/Source/UTIL/WRITE_MATRIX_BY_COLS.f90 +++ b/Source/UTIL/WRITE_MATRIX_BY_COLS.f90 @@ -29,10 +29,9 @@ SUBROUTINE WRITE_MATRIX_BY_COLS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) ! Writes a matrix one column at a time in a format that has 10 terms across the page (repeated un til col is completely written) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MATRIX_BY_COLS_BEGEND USE WRITE_VECTOR_USE_IFs @@ -48,19 +47,14 @@ SUBROUTINE WRITE_MATRIX_BY_COLS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: NUM_LEFT ! INTEGER(LONG) :: PAD ! Number of spaces to pad in HEADER to center MAT_DESCRIPTOR - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MATRIX_BY_COLS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATOUT(NROWS,NCOLS)! Matrix to write out REAL(DOUBLE) :: MAT_LINE(10) ! Up to 10 terms from one col of MATOUT INTRINSIC :: LEN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** PAD = (132 - LEN(MAT_DESCR))/2 @@ -88,12 +82,7 @@ SUBROUTINE WRITE_MATRIX_BY_COLS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) WRITE(OUT_UNT,*) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_MATRIX_BY_ROWS.f90 b/Source/UTIL/WRITE_MATRIX_BY_ROWS.f90 index 9f566c54..9005f91a 100644 --- a/Source/UTIL/WRITE_MATRIX_BY_ROWS.f90 +++ b/Source/UTIL/WRITE_MATRIX_BY_ROWS.f90 @@ -29,10 +29,9 @@ SUBROUTINE WRITE_MATRIX_BY_ROWS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) ! Writes a matrix one row at a time in a format that has 10 terms across the page (repeated until row is completely written) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_MATRIX_BY_ROWS_BEGEND USE WRITE_VECTOR_USE_IFs @@ -48,19 +47,14 @@ SUBROUTINE WRITE_MATRIX_BY_ROWS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: NUM_LEFT ! INTEGER(LONG) :: PAD ! Number of spaces to pad in HEADER to center MAT_DESCRIPTOR - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_MATRIX_BY_ROWS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MATOUT(NROWS,NCOLS)! Matrix to write out REAL(DOUBLE) :: MAT_LINE(10) ! Up to 10 terms from one col of MATOUT INTRINSIC :: LEN -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** PAD = (132 - LEN(MAT_DESCR))/2 @@ -88,12 +82,7 @@ SUBROUTINE WRITE_MATRIX_BY_ROWS ( MAT_DESCR, MATOUT, NROWS, NCOLS, OUT_UNT ) WRITE(OUT_UNT,*) ENDDO -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_MEM_SUM_TO_F04.f90 b/Source/UTIL/WRITE_MEM_SUM_TO_F04.f90 deleted file mode 100644 index bc916362..00000000 --- a/Source/UTIL/WRITE_MEM_SUM_TO_F04.f90 +++ /dev/null @@ -1,80 +0,0 @@ -! ################################################################################################################################## -! Begin MIT license text. -! _______________________________________________________________________________________________________ - -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) - -! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and -! associated documentation files (the "Software"), to deal in the Software without restriction, including -! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to -! the following conditions: - -! The above copyright notice and this permission notice shall be included in all copies or substantial -! portions of the Software and documentation. - -! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -! THE SOFTWARE. -! _______________________________________________________________________________________________________ - -! End MIT license text. - - SUBROUTINE WRITE_MEM_SUM_TO_F04 ( NAME, WHAT, MB_MEM, NROWS, NCOLS, SUBR_BEGEND ) - -! Write info regarding matrices when they are allocated or deallocated to the F04 text output file - - USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_LOG, F04 - USE SCONTR, ONLY : TOT_MB_MEM_ALLOC - USE DEBUG_PARAMETERS, ONLY : DEBUG - - IMPLICIT NONE - - CHARACTER(LEN=*), INTENT(IN) :: NAME ! Array name that has MB_ALLOCATED mem allocated - CHARACTER(LEN=*), INTENT(IN) :: WHAT ! Whether to write allocated or deallocated memory - CHARACTER(15*BYTE) :: NAMEL ! 14 bytes of NAME (or padded blanks - for F04 output) - - INTEGER(LONG) , INTENT(IN) :: NCOLS ! Number of cols for matrix NAME - INTEGER(LONG) , INTENT(IN) :: NROWS ! Number of rows for matrix NAME - INTEGER(LONG) , INTENT(IN) :: SUBR_BEGEND ! SUBR_BEGEND value from calling subr - - REAL(DOUBLE) , INTENT(IN) :: MB_MEM ! Megabytes of mmemory allocated to array NAME - -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - NAMEL(1:) = ' ' - NAMEL(1:) = NAME(1:) - IF (WHAT == 'ALLOC') THEN - IF (DEBUG(107) == 0) THEN - WRITE(F04,9002) MB_MEM, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9004) MB_MEM, NAMEL, NROWS, NCOLS, TOT_MB_MEM_ALLOC - ENDIF - ELSE IF (WHAT == 'DEALLOC') THEN - IF (DEBUG(107) == 0) then - WRITE(F04,9003) MB_MEM, NAMEL, TOT_MB_MEM_ALLOC - ELSE - WRITE(F04,9005) MB_MEM, NAMEL, TOT_MB_MEM_ALLOC - ENDIF - ENDIF - ENDIF - - RETURN -! ********************************************************************************************************************************** - 9002 FORMAT( 48X,F13.3,' MB ',A15,':',I12,' row,',I12,' col , T:',F10.3) - - 9003 FORMAT( 48X,F13.3,' MB ',A15,':',39X,'T:',F10.3) - - 9004 FORMAT( 48X,F13.6,' MB ',A15,':',I12,' row,',I12,' col , T:',F13.6) - - 9005 FORMAT( 48X,F13.6,' MB ',A15,':',39X,'T:',F13.6) - -! ********************************************************************************************************************************** - - END SUBROUTINE WRITE_MEM_SUM_TO_F04 - diff --git a/Source/UTIL/WRITE_OU4_FULL_MAT.f90 b/Source/UTIL/WRITE_OU4_FULL_MAT.f90 index 8df0b682..b41981b2 100644 --- a/Source/UTIL/WRITE_OU4_FULL_MAT.f90 +++ b/Source/UTIL/WRITE_OU4_FULL_MAT.f90 @@ -30,12 +30,11 @@ SUBROUTINE WRITE_OU4_FULL_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, MAT, UNT ) ! Used for OUTPUT4 matrices USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, LEN_INPUT_FNAME, OU4, OU4FIL, MOU4, WRT_LOG + USE IOUNT1, ONLY : F06, LEN_INPUT_FNAME, OU4, OU4FIL, MOU4 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : PRTOU4 - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_OU4_FULL_MAT_BEGEND USE WRITE_OU4_FULL_MAT_USE_IFs @@ -56,16 +55,11 @@ SUBROUTINE WRITE_OU4_FULL_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, MAT, UNT ) INTEGER(LONG), PARAMETER :: IROW = 1 ! A term written to UNT for the trailer record (just to be like NASTRAN) INTEGER(LONG), PARAMETER :: PREC = 2 ! Matrix precision (2 indicates double precision) INTEGER(LONG), PARAMETER :: ROW_BEG = 1 ! 1st row of matrix output to UNT is row 1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_OU4_FULL_MAT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MAT(NROWS,NCOLS) ! Array of terms in matrix MAT -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Get file name for unit UNT @@ -114,12 +108,7 @@ SUBROUTINE WRITE_OU4_FULL_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, MAT, UNT ) WRITE(F06,1001) MAT_NAME, NROWS, NCOLS, FILNAM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_OU4_SPARSE_MAT.f90 b/Source/UTIL/WRITE_OU4_SPARSE_MAT.f90 index 4fe8877e..d3a9f331 100644 --- a/Source/UTIL/WRITE_OU4_SPARSE_MAT.f90 +++ b/Source/UTIL/WRITE_OU4_SPARSE_MAT.f90 @@ -30,13 +30,12 @@ SUBROUTINE WRITE_OU4_SPARSE_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, NTERM_MAT, ! Used for OUTPUT4 matrices USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : ERR, F04, F06, LEN_INPUT_FNAME, OU4, OU4FIL, mou4, WRT_LOG + USE IOUNT1, ONLY : ERR, F06, LEN_INPUT_FNAME, OU4, OU4FIL, mou4 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : PRTOU4, SPARSTOR USE SCRATCH_MATRICES, ONLY : I_CRS1, J_CRS1, CRS1, I_CCS1, J_CCS1, CCS1 - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_OU4_SPARSE_MAT_BEGEND USE WRITE_OU4_SPARSE_MAT_USE_IFs @@ -67,17 +66,12 @@ SUBROUTINE WRITE_OU4_SPARSE_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, NTERM_MAT, INTEGER(LONG) :: NTERM_COL_J ! INTEGER(LONG), PARAMETER :: PREC = 2 ! Matrix precision (2 indicates double precision) INTEGER(LONG), PARAMETER :: ROW_BEG = 1 ! 1st row of matrix output to UNT is row 1 - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_OU4_SPARSE_MAT_BEGEND + REAL(DOUBLE) , INTENT(IN) :: MAT(NTERM_MAT) ! Array of terms in matrix MAT REAL(DOUBLE) :: CCS1_COL(NROWS) ! One column of CCS1 in full format -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Get file name for unit UNT @@ -167,12 +161,7 @@ SUBROUTINE WRITE_OU4_SPARSE_MAT ( MAT_NAME, NROWS, NCOLS, FORM, SYM, NTERM_MAT, WRITE(F06,1001) MAT_NAME, NROWS, NCOLS, FILNAM -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_PARTNd_MAT_HDRS.f90 b/Source/UTIL/WRITE_PARTNd_MAT_HDRS.f90 index a6a6b65d..1d52c43e 100644 --- a/Source/UTIL/WRITE_PARTNd_MAT_HDRS.f90 +++ b/Source/UTIL/WRITE_PARTNd_MAT_HDRS.f90 @@ -29,13 +29,12 @@ SUBROUTINE WRITE_PARTNd_MAT_HDRS ( MAT_NAME, ROW_SET, COL_SET, NROWS, NCOLS ) ! Writes the grid/comp pairs corresponding to the cols and rows of a partitioned matrix. Used for OUTPUT4 matrices USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MTDOF, NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, NDOFN, NDOFO, NDOFR, & NDOFS, NDOFSA, NDOFSB, NDOFSE, NDOFSG, NDOFSZ, NUM_USET_U1, NUM_USET_U2, TSET_CHR_LEN USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOFI USE OUTPUT4_MATRICES, ONLY : OU4_MAT_COL_GRD_COMP, OU4_MAT_ROW_GRD_COMP - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_PARTNd_MAT_HDRS_BEGEND USE WRITE_PARTNd_MAT_HDRS_USE_IFs @@ -52,14 +51,9 @@ SUBROUTINE WRITE_PARTNd_MAT_HDRS ( MAT_NAME, ROW_SET, COL_SET, NROWS, NCOLS ) INTEGER(LONG) :: OUTPUT_1(10) ! Part of a line of output INTEGER(LONG) :: OUTPUT_2(10) ! Part of a line of output INTEGER(LONG) :: NUM_LEFT ! Used when printing a line of 10 values in the set - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_PARTNd_MAT_HDRS_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Write the matrix col headers out to F06 @@ -136,12 +130,6 @@ SUBROUTINE WRITE_PARTNd_MAT_HDRS ( MAT_NAME, ROW_SET, COL_SET, NROWS, NCOLS ) ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF RETURN diff --git a/Source/UTIL/WRITE_SPARSE_CRS.f90 b/Source/UTIL/WRITE_SPARSE_CRS.f90 index 8c9c301b..a59001a9 100644 --- a/Source/UTIL/WRITE_SPARSE_CRS.f90 +++ b/Source/UTIL/WRITE_SPARSE_CRS.f90 @@ -29,12 +29,11 @@ SUBROUTINE WRITE_SPARSE_CRS ( MAT_NAME, ROW_SET, COL_SET, NTERM_A, NROWS_A, I_AX ! Writes a matrix that is in sparse CRS format to the F06 output file based on user request via Bulk Data PARAM PRTijk entries USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC USE CONSTANTS_1, ONLY : ZERO USE PARAMS, ONLY : SPARSTOR, TINY - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_SPARSE_CRS_BEGEND USE WRITE_SPARSE_CRS_USE_IFs @@ -63,16 +62,11 @@ SUBROUTINE WRITE_SPARSE_CRS ( MAT_NAME, ROW_SET, COL_SET, NTERM_A, NROWS_A, I_AX INTEGER(LONG) :: NULL_ROWS_A ! Number of null rows in input matrix INTEGER(LONG) :: ROW_COMP = 0 ! Component number returned from subr GET_GRID_AND_COMP INTEGER(LONG) :: ROW_GRID = 0 ! Grid number returned from subr GET_GRID_AND_COMP - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_SPARSE_CRS_BEGEND + REAL(DOUBLE) , INTENT(IN) :: AXX(NTERM_A) ! Array of terms in matrix AXX -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Strip out trailing blanks from MAT_NAME and put remainder centered in array LINE_OUT @@ -215,12 +209,7 @@ SUBROUTINE WRITE_SPARSE_CRS ( MAT_NAME, ROW_SET, COL_SET, NTERM_A, NROWS_A, I_AX ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_TDOF.f90 b/Source/UTIL/WRITE_TDOF.f90 index 557b6ac9..147eaa4e 100644 --- a/Source/UTIL/WRITE_TDOF.f90 +++ b/Source/UTIL/WRITE_TDOF.f90 @@ -27,14 +27,13 @@ SUBROUTINE WRITE_TDOF ( TDOF_MSG ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MTDOF, NDOFG, NDOFM, NDOFN, NDOFSA, NDOFSB, NDOFSG, NDOFSZ, NDOFSE, NDOFS, & NDOFF, NDOFO, NDOFA, NDOFR, NDOFL, NGRID, NUM_USET_U1, NUM_USET_U2 USE TIMDAT, ONLY : TSEC USE DOF_TABLES, ONLY : TDOF, TDOFI USE PARAMS, ONLY : PRTDOF USE MODEL_STUF, ONLY : GRID_ID, INV_GRID_SEQ - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_TDOF_BEGEND USE WRITE_TDOF_USE_IFs @@ -49,14 +48,9 @@ SUBROUTINE WRITE_TDOF ( TDOF_MSG ) INTEGER(LONG) :: I,J,K ! DO loop indices INTEGER(LONG) :: IROW ! Row number in array TDOF or TDOFI INTEGER(LONG) :: NUM_COMPS ! Number of displ components (1 for SPOINT, 6 for physical grid) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_TDOF_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Table TDOF is printed in the F06 file if B.D. PARAM PRTDOF = 1 or 3 @@ -71,7 +65,7 @@ SUBROUTINE WRITE_TDOF ( TDOF_MSG ) ENDIF IROW = 0 DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(I), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS IROW = IROW + 1 IF (J == 1) THEN @@ -111,7 +105,7 @@ SUBROUTINE WRITE_TDOF ( TDOF_MSG ) ENDIF IROW = 0 DO I = 1,NGRID - CALL GET_GRID_NUM_COMPS ( GRID_ID(INV_GRID_SEQ(I)), NUM_COMPS, SUBR_NAME ) + CALL GET_GRID_NUM_COMPS ( INV_GRID_SEQ(I), NUM_COMPS, SUBR_NAME ) DO J = 1,NUM_COMPS IROW = IROW + 1 IF (J == 1) THEN @@ -139,12 +133,7 @@ SUBROUTINE WRITE_TDOF ( TDOF_MSG ) WRITE(F06,'(//)') ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_TSET.f90 b/Source/UTIL/WRITE_TSET.f90 index 18ab3c32..4f10d97c 100644 --- a/Source/UTIL/WRITE_TSET.f90 +++ b/Source/UTIL/WRITE_TSET.f90 @@ -29,12 +29,11 @@ SUBROUTINE WRITE_TSET ! Writes the NGRID x 6 TSET degree of freedom table to the F06 file based on user supplied Bulk Data Param PRTTSET USE PENTIUM_II_KIND, ONLY : LONG - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MTSET, NGRID USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : GRID, GRID_SEQ, INV_GRID_SEQ USE DOF_TABLES, ONLY : TSET - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_TSET_BEGEND USE WRITE_TSET_USE_IFs @@ -43,14 +42,9 @@ SUBROUTINE WRITE_TSET CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'WRITE_TSET' INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_TSET_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************* WRITE(F06,56) @@ -60,12 +54,7 @@ SUBROUTINE WRITE_TSET ENDDO WRITE(F06,59) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_USERIN_BD_CARDS.f90 b/Source/UTIL/WRITE_USERIN_BD_CARDS.f90 index 14cc4970..5c36c9a6 100644 --- a/Source/UTIL/WRITE_USERIN_BD_CARDS.f90 +++ b/Source/UTIL/WRITE_USERIN_BD_CARDS.f90 @@ -30,7 +30,7 @@ SUBROUTINE WRITE_USERIN_BD_CARDS ( NROWS, X_SET ) ! Data PARAM CUSERIN, USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, F06FIL, MOU4, OU4, OU4FIL + USE IOUNT1, ONLY : ERR, F06, F06FIL, MOU4, OU4, OU4FIL USE SCONTR, ONLY : JCARD_LEN, NCORD, NDOFG, NGRID, NVEC, WARN_ERR, BLNK_SUB_NAM USE TIMDAT, ONLY : START_YEAR, START_MONTH, START_DAY, START_HOUR, START_MINUTE, START_SEC, START_SFRAC USE DOF_TABLES, ONLY : TDOFI diff --git a/Source/UTIL/WRITE_USET.f90 b/Source/UTIL/WRITE_USET.f90 index 6fd60106..89029096 100644 --- a/Source/UTIL/WRITE_USET.f90 +++ b/Source/UTIL/WRITE_USET.f90 @@ -29,12 +29,11 @@ SUBROUTINE WRITE_USET ! Writes the NGRID x 6 USET table to the F06 file based on user supplied Bulk Data Param PRTUSET USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : F04, F06, WRT_LOG + USE IOUNT1, ONLY : F06 USE SCONTR, ONLY : BLNK_SUB_NAM, MTSET, NDOFG, NGRID, NUM_USET_U1, NUM_USET_U2 USE TIMDAT, ONLY : TSEC USE MODEL_STUF, ONLY : GRID, GRID_SEQ, INV_GRID_SEQ USE PARAMS, ONLY : PRTUSET - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_USET_BEGEND USE DOF_TABLES, ONLY : TDOF, USET, USETSTR_TABLE USE WRITE_USET_USE_IFs @@ -44,14 +43,9 @@ SUBROUTINE WRITE_USET CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'WRITE_USET' INTEGER(LONG) :: I,J ! DO loop indices - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_USET_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Write the USET table @@ -73,12 +67,7 @@ SUBROUTINE WRITE_USET ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_USETSTR.f90 b/Source/UTIL/WRITE_USETSTR.f90 index e77a195a..027884eb 100644 --- a/Source/UTIL/WRITE_USETSTR.f90 +++ b/Source/UTIL/WRITE_USETSTR.f90 @@ -31,11 +31,10 @@ SUBROUTINE WRITE_USETSTR ! displ set table to be written USE PENTIUM_II_KIND, ONLY : BYTE, LONG - USE IOUNT1, ONLY : ERR, F04, F06, WRT_LOG + USE IOUNT1, ONLY : ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, MTDOF, NDOFA, NDOFF, NDOFG, NDOFL, NDOFM, NDOFN, NDOFO, NDOFR, & NDOFS, NDOFSA, NDOFSB, NDOFSE, NDOFSG, NDOFSZ, NUM_USET_U1, NUM_USET_U2, TSET_CHR_LEN USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_USETSTR_BEGEND USE DOF_TABLES, ONLY : TDOFI, USETSTR_TABLE USE WRITE_USETSTR_USE_IFs @@ -56,14 +55,9 @@ SUBROUTINE WRITE_USETSTR INTEGER(LONG) :: NUM_NULL ! Number of sets that have been requested for output that are null INTEGER(LONG) :: OUTPUT_1(10) ! Part of a line of output INTEGER(LONG) :: OUTPUT_2(10) ! Part of a line of output - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_USETSTR_BEGEND -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + + ! ********************************************************************************************************************************** ! Initialize @@ -180,12 +174,7 @@ SUBROUTINE WRITE_USETSTR ENDIF -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/Source/UTIL/WRITE_VECTOR.f90 b/Source/UTIL/WRITE_VECTOR.f90 index 686855ff..574f788b 100644 --- a/Source/UTIL/WRITE_VECTOR.f90 +++ b/Source/UTIL/WRITE_VECTOR.f90 @@ -29,10 +29,9 @@ SUBROUTINE WRITE_VECTOR ( VEC_NAME, WHAT, NUM, UX ) ! Writes a vector in full format to the F06 file USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE - USE IOUNT1, ONLY : WRT_ERR, WRT_LOG, F04, F06 + USE IOUNT1, ONLY : WRT_ERR, F06 USE SCONTR, ONLY : BLNK_SUB_NAM USE TIMDAT, ONLY : TSEC - USE SUBR_BEGEND_LEVELS, ONLY : WRITE_VECTOR_BEGEND USE WRITE_VECTOR_USE_IFs @@ -50,16 +49,11 @@ SUBROUTINE WRITE_VECTOR ( VEC_NAME, WHAT, NUM, UX ) ! in the calling subr. In this subr, VEC_NAME is striped of trailing ! blanks to get only the actual message. On exit VEC_NAME_LEN is the ! length of the finite message in VEC_NAME (i.e. without trailing blanks) - INTEGER(LONG), PARAMETER :: SUBR_BEGEND = WRITE_VECTOR_BEGEND + REAL(DOUBLE) , INTENT(IN) :: UX(NUM) ! Vector to write out -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9001) SUBR_NAME,TSEC - 9001 FORMAT(1X,A,' BEGN ',F10.3) - ENDIF + ! ********************************************************************************************************************************** ! Strip out trailing blanks from VEC_NAME and put remainder centered in array LINE_OUT @@ -86,12 +80,7 @@ SUBROUTINE WRITE_VECTOR ( VEC_NAME, WHAT, NUM, UX ) ENDDO WRITE(F06,*) -! ********************************************************************************************************************************** - IF (WRT_LOG >= SUBR_BEGEND) THEN - CALL OURTIM - WRITE(F04,9002) SUBR_NAME,TSEC - 9002 FORMAT(1X,A,' END ',F10.3) - ENDIF + RETURN diff --git a/dev_docs/post_processing.md b/dev_docs/post_processing.md index f1088799..cdc14a5c 100644 --- a/dev_docs/post_processing.md +++ b/dev_docs/post_processing.md @@ -5,13 +5,15 @@ There are a few main ways to export data (to verify): | Location | Case Control Command | Notes | | -------- | -------------------- | ----- | -| F06 | DISP=ALL | Defaults to PRINT | -| F06 | DISP(PRINT)=ALL | Writes to the F06 file | +| F06/ans | DISP=ALL | Defaults to PRINT | +| F06/ans | DISP(PRINT)=ALL | Writes to the F06 file (and ANS if DEBUG,200) | | OP2 | DISP(PLOT)=ALL | Writes to the OP2 file | | PUNCH | DISP(PUNCH)=ALL | Writes to the PCH file | | CSV | DISP(CSV)=ALL | TODO: Write to a CSV file | | NEU | DISP(NEU)=ALL | TODO: Writes to a NEU file (currently generated with PARAM,POST,-1) | +The F06 and ANS files are basically the same, so main results support is the same. +However, the ANS file is incomplete, so until they're the same, we'll document it. OP2 PLOT Support ================ @@ -44,10 +46,12 @@ which begs the question of is the code compatible with sets, when we do? FAQ --------- -**What is the difference between F06, OP2, and NEU files?** +**What is the difference between F06, OP2, NEU, and ANS files?** **F06** is the main human readable Nastran/Mystran output. It contains error messages, warnings, etc. which can make things harder to parse. In general, you'd use this for quick checks, but post-processors like FEMAP / PATRAN / pyNastran can't read it. An F06 result is requested with a PRINT flag. +The **ANS** is LINK9 (results) only and requires a debug flag to export. It is simpler to parse, but basically the same as the F06. An ANS result is requested with a PRINT flag and a ``DEBUG,200,1`` flag. + THe **OP2** is the main binary output file that FEMAP / PATRAN / pyNastran can read. An OP2 result is requested with a PLOT flag (e.g., ``DISP(PLOT) = ALL``). The **NEU** is an ASCII file that is supported by FEMAP. It's not well tested against though. NEU is selected with the ``PARAM,POST,-1`` flag. @@ -69,7 +73,8 @@ OP2 Params (TODO) PARAM,POST,-1 - default=0 (consistent with Nastran) -> no op2 - NX/MSC Nastran: activates the OP2 (vs. XDB) - - Mystran (future option): activates OP2 output (vs. no effect) + - Mystran (future option): activates OP2 output (vs. nothing) + - Mystran current: activates the NEU output (vs. using a flag) PARAM,OGEOM,YES - default=YES (consistent with Nastran) @@ -81,87 +86,87 @@ PARAM,OGEOM,YES Static Post-Processing Support ============================== -| Result | F06 | OP2 | NEU | PCH | CSV | Notes | -| ------ | --- | --- | --- | --- | --- | ----- | -| Displacement | Yes | Yes | Yes | ??? | No | | -| SPC Force | Yes | Yes | Yes | ??? | No | | -| MPC Force | Yes | Yes | ??? | ??? | No | | -| Applied Load Vector | Yes | Yes | ??? | ??? | No | | -| Grid Point Weight | Yes | Yes | ??? | ??? | No | See Grid Point Weight note | -| Grid Point Force | Yes | Yes | ??? | ??? | No | | - -| Force Result | F06 | OP2 | NEU | PCH | CSV | Notes | -| ------------ | --- | --- | --- | --- | --- | ----- | -| CELASx | Yes | Yes | ??? | ??? | No | | -| CROD | Yes | Yes | ??? | ??? | No | | -| CBUSH | Yes | Yes | ??? | ??? | No | | -| CBAR | Yes | Yes | ??? | ??? | No | | -| CBEAM | N/A | N/A | ??? | N/A | N/A | card not supported | -| CSHEAR | Yes | No | ??? | ??? | No | large difference between output structure of Nastran & Mystran | -| CTRIA3 Iso | Yes | Yes | ??? | ??? | No | | -| TRIA3K/QUAD4K | Yes | No | ??? | ??? | No | | -| CQUAD4 Iso-Center | Yes | Yes | ??? | ??? | No | | -| CQUAD4 Iso-Corner | No | No | ??? | ??? | No | | -| CTRIA3 Comp | No | No | ??? | ??? | No | [results not calculated](https://github.com/MYSTRANsolver/MYSTRAN/issues/53) | +| Result | F06 | ANS | OP2 | NEU | PCH | CSV | Notes | +| ------ | --- | --- | --- | --- | --- | --- | ----- | +| Displacement | Yes | Yes | Yes | Yes | ??? | No | | +| SPC Force | Yes | Yes | Yes | Yes | ??? | No | | +| MPC Force | Yes | ??? | Yes | ??? | ??? | No | | +| Applied Load Vector | Yes | Yes | Yes | ??? | ??? | No | | +| Grid Point Weight | Yes | No | Yes | ??? | ??? | No | See Grid Point Weight note | +| Grid Point Force | Yes | Yes | Yes | ??? | ??? | No | | + +| Force Result | F06 | ANS | OP2 | NEU | PCH | CSV | Notes | +| ------------ | --- | --- | --- | --- | --- | --- | ----- | +| CELASx | Yes | Yes | Yes | ??? | ??? | No | | +| CROD | Yes | Yes | Yes | ??? | ??? | No | | +| CBUSH | Yes | Yes | Yes | ??? | ??? | No | | +| CBAR | Yes | Yes | Yes | ??? | ??? | No | | +| CBEAM | N/A | N/A | N/A | ??? | N/A | N/A | card not supported | +| CSHEAR | Yes | Yes | No | ??? | ??? | No | large difference between output structure of Nastran & Mystran | +| CTRIA3 Iso | Yes | Yes | Yes | ??? | ??? | No | | +| TRIA3K/QUAD4K | Yes | Yes | No | ??? | ??? | No | | +| CQUAD4 Iso-Center | Yes | Yes | Yes | ??? | ??? | No | | +| CQUAD4 Iso-Corner | No | No | No | ??? | ??? | No | | +| CTRIA3 Comp | No | No | No | ??? | ??? | No | [results not calculated](https://github.com/MYSTRANsolver/MYSTRAN/issues/53) | | CQUAD4 Comp | No | No | No | ??? | ??? | No | [results not calculated](https://github.com/MYSTRANsolver/MYSTRAN/issues/53) | -| Solid | N/A | N/A | ??? | N/A | N/A | No outputs (expected) | - -| Stress Result | F06 | OP2 | NEU | PCH | CSV | Notes | -| ------------- | --- | --- | --- | --- | --- | ------------------------- | -| CELASx | ??? | ??? | ??? | ??? | No | | -| CROD | Yes | Yes | ??? | ??? | No | no axial/torsion margin | -| CBUSH | ??? | ??? | ??? | ??? | No | | -| CBAR | Yes | Yes | ??? | ??? | No | large difference between output structure of Nastran & Mystran | -| CBEAM | N/A | N/A | ??? | N/A | N/A | card not supported | -| CSHEAR | Yes | Yes | ??? | ??? | No | | -| CTRIA3 Iso | Yes | Yes | ??? | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | -| CQUAD4 Iso-Center | Yes | Yes | ??? | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | -| CQUAD4 Iso-Corner | Yes | ??? | Yes | ??? | No | | -| CTRIA3 Comp | Yes | Yes | ??? | ??? | No | no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | -| CQUAD4 Comp | Yes | Yes | ??? | ??? | No | no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | -| Solid | Yes | Yes | ??? | ??? | No | Center support only (no corner); No directional vectors; No coordinate system support; no transform support | - - -| Strain Result | F06 | OP2 | PCH | CSV | Notes | -| ------------- | --- | --- | --- | --- | ----------------------- | -| CELASx | ??? | ??? | ??? | No | | -| CROD | No | No | ??? | No | [1d results not calculated](https://github.com/MYSTRANsolver/MYSTRAN/issues/46) | -| CBUSH | ??? | ??? | ??? | No | | -| CBAR | No | No | No | No | [1d results not calculated](https://github.com/MYSTRANsolver/MYSTRAN/issues/46) | -| CBEAM | N/A | N/A | N/A | N/A | card not supported | -| CSHEAR | Yes | Yes | ??? | No | | -| CTRIA3 Iso | Yes | ??? | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) -| CQUAD4 Iso-Center | Yes | Yes | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) -| CQUAD4 Iso-Corner | ??? | Yes | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) -| CTRIA3 Comp | Yes | Yes | ??? | No | no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) -| CQUAD4 Comp | Yes | Yes | ??? | No | no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) +| Solid | N/A | N/A | N/A | ??? | N/A | N/A | No outputs (expected) | + +| Stress Result | F06 | ANS | OP2 | NEU | PCH | CSV | Notes | +| ------------- | --- | --- | --- | --- | --- | --- | ------------------------- | +| CELASx | ??? | ??? | ??? | ??? | ??? | No | | +| CROD | Yes | Yes | Yes | ??? | ??? | No | no axial/torsion margin | +| CBUSH | ??? | ??? | ??? | ??? | ??? | No | | +| CBAR | Yes | Yes | Yes | ??? | ??? | No | large difference between output structure of Nastran & Mystran | +| CBEAM | N/A | N/A | N/A | ??? | N/A | N/A | card not supported | +| CSHEAR | Yes | No | Yes | ??? | ??? | No | | +| CTRIA3 Iso | Yes | Yes | Yes | ??? | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | +| CQUAD4 Iso-Center | Yes | Yes | Yes | ??? | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | +| CQUAD4 Iso-Corner | Yes | Yes | ??? | Yes | ??? | No | | +| CTRIA3 Comp | Yes | Yes | Yes | ??? | ??? | No | no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | +| CQUAD4 Comp | Yes | Yes | Yes | ??? | ??? | No | no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | +| Solid | Yes | ??? | Yes | ??? | ??? | No | Center support only (no corner); No directional vectors; No coordinate system support; no transform support | + + +| Strain Result | F06 | ANS | OP2 | PCH | CSV | Notes | +| ------------- | --- | --- | --- | --- | --- | ----------------------- | +| CELASx | ??? | ??? | ??? | ??? | No | | +| CROD | No | No | No | ??? | No | [1d results not calculated](https://github.com/MYSTRANsolver/MYSTRAN/issues/46) | +| CBUSH | ??? | ??? | ??? | ??? | No | | +| CBAR | No | No | No | No | No | [1d results not calculated](https://github.com/MYSTRANsolver/MYSTRAN/issues/46) | +| CBEAM | N/A | N/A | N/A | N/A | N/A | card not supported | +| CSHEAR | Yes | No | Yes | ??? | No | | +| CTRIA3 Iso | Yes | Yes | ??? | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) +| CQUAD4 Iso-Center | Yes | Yes | Yes | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) +| CQUAD4 Iso-Corner | ??? | ??? | Yes | ??? | No | OP2 plane1/2 results faked; no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) +| CTRIA3 Comp | Yes | Yes | Yes | ??? | No | no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) +| CQUAD4 Comp | Yes | Yes | Yes | ??? | No | no FIBER/CURV support (FIBER only); no MAXS/MISES support (MISES only) | Solid | Yes | ??? | Yes | ??? | No | Center support only (no corner); No directional vectors; No coordinate system support; no transform support -| Strain Energy Result | F06 | OP2 | PCH | CSV | Notes | -| -------------------- | --- | --- | --- | --- | ----- | -| CELASx | No | No | No | No | | -| CROD | No | No | No | No | | -| CBUSH | No | No | No | No | | -| CBAR | No | No | No | No | | -| CBEAM | N/A | N/A | N/A | N/A | card not supported | -| CSHEAR | No | No | No | No | | -| CTRIA3 Iso | No | No | No | No | | -| CQUAD4 Iso-Center | No | No | No | No | | -| CQUAD4 Iso-Corner | No | No | No | No | | -| CTRIA3 Comp | No | No | No | No | | -| CQUAD4 Comp | No | No | No | No | | -| Solid | No | No | No | No | | +| Strain Energy Result | F06 | ANS | OP2 | PCH | CSV | Notes | +| -------------------- | --- | --- | --- | --- | --- | ----- | +| CELASx | No | No | No | No | No | | +| CROD | No | No | No | No | No | | +| CBUSH | No | No | No | No | No | | +| CBAR | No | No | No | No | No | | +| CBEAM | N/A | N/A | N/A | N/A | N/A | card not supported | +| CSHEAR | No | No | No | No | No | | +| CTRIA3 Iso | No | No | No | No | No | | +| CQUAD4 Iso-Center | No | No | No | No | No | | +| CQUAD4 Iso-Corner | No | No | No | No | No | | +| CTRIA3 Comp | No | No | No | No | No | | +| CQUAD4 Comp | No | No | No | No | No | | +| Solid | No | No | No | No | No | | Eigen Post-Processing Support ============================= -| Result | F06 | OP2 | PCH | CSV | Notes | -| ------ | --- | --- | --- | --- | ----- | -| Grid Point Weight | Yes | Yes | No | No | | -| Eigenvector | Yes | Yes | ??? | No | | -| Eigenvalue | Yes | Yes | ??? | No | | -| MEFFMASS | ??? | No | ??? | No | | +| Result | F06 | ANS | OP2 | PCH | CSV | Notes | +| ------ | --- | --- | --- | --- | --- | ----- | +| Grid Point Weight | Yes | No | Yes | No | No | | +| Eigenvector | Yes | ??? | Yes | ??? | No | | +| Eigenvalue | Yes | ??? | Yes | ??? | No | | +| MEFFMASS | ??? | ??? | No | ??? | No | | Notes ===== @@ -178,11 +183,14 @@ Grid Point Weight Limitation - CG should be (3,3) instead of (3,1) - applies to all outputs -F06 Limitations +ANS/F06 Limitations ------------------- - - Grid Point Weight has an incorrect format + - ANS doesn't support: + - grid point weight + - rod strain + - shear stress/strain - OP2 Limitations +OP2 Limitations --------------- - No FIBER/CURV support (FIBER only) - No MAXS/MISES support (MISES only)