Skip to content
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
108 changes: 20 additions & 88 deletions Source/LK9/L92/GP_FORCE_BALANCE_PROC.f90
Original file line number Diff line number Diff line change
Expand Up @@ -30,19 +30,16 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
! The effects of all forces on grids are included so totals
! should be zero

USE PENTIUM_II_KIND, ONLY : BYTE, SHORT, LONG, DOUBLE
USE IOUNT1, ONLY : ERR, F06, OP2, SC1, WRT_ERR
USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE
USE IOUNT1, ONLY : ERR, F06, OP2, SC1
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 CONSTANTS_1, ONLY : ZERO, ONE_HUNDRED
USE DOF_TABLES, ONLY : TDOF, TDOF_ROW_START
USE DEBUG_PARAMETERS, ONLY : DEBUG
USE MODEL_STUF, ONLY : AGRID, EID, ELGP, ESORT1, ETYPE, NUM_EMG_FATAL_ERRS, GRID, GRID_ELEM_CONN_ARRAY, GRID_ID, &
USE MODEL_STUF, ONLY : AGRID, EID, ELGP, ESORT1, ETYPE, GRID, GRID_ELEM_CONN_ARRAY, GRID_ID, &
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
USE CC_OUTPUT_DESCRIBERS, ONLY : GPFO_OUT
USE NONLINEAR_PARAMS, ONLY : LOAD_ISTEP

Expand Down Expand Up @@ -110,17 +107,14 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
INTEGER(LONG) :: ELEMENT_TYPE ! the OP2 flag for the element
LOGICAL :: FIELD_5_INT_FLAG ! flag to trigger FIELD5_INT_MODE vs.
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
CHARACTER(LEN=128) :: TITLEI ! the model TITLE
CHARACTER(LEN=128) :: SUBTITLEI ! the subcase SUBTITLE
CHARACTER(LEN=128) :: LABELI ! the subcase LABEL
INTEGER(LONG) :: ITABLE ! the table counter

INTEGER, ALLOCATABLE :: GPFORCE_NID_EID(:,:) ! currently unused
CHARACTER*8, ALLOCATABLE :: GPFORCE_ETYPE(:) ! currently unused
REAL, ALLOCATABLE :: GPFORCE_FXYZ_MXYZ(:,:) ! currently unused

INTEGER, ALLOCATABLE :: GPFORCE_NID_EID(:,:)
CHARACTER*8, ALLOCATABLE :: GPFORCE_ETYPE(:)
REAL(DOUBLE), ALLOCATABLE :: GPFORCE_FXYZ_MXYZ(:,:)


! **********************************************************************************************************************************
Expand All @@ -134,13 +128,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
WRITE_F06 = (GPFO_OUT(1:1) == 'Y')
WRITE_OP2 = (GPFO_OUT(2:2) == 'Y')

!WRITE(ERR,*) 'GPFORCE WRITE_F06',WRITE_F06
!WRITE(ERR,*) 'GPFORCE WRITE_OP2',WRITE_OP2
!FLUSH(ERR)
!WRITE_PCH = (ACCE_OUT(3:3) == 'Y')
!WRITE_OP2 = .TRUE.
!WRITE_F06 = .TRUE.

! OP2: Write output headers if this is not the first use of this subr.
ANALYSIS_CODE = -1
FIELD_5_INT_FLAG = .TRUE.
Expand All @@ -149,9 +136,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )

INODE_GPFORCE = 1

!WRITE(ERR,*) "Running GPFORCE"
!FLUSH(ERR)

! Initialize
DO I=1,6
FG1(I) = ZERO
Expand Down Expand Up @@ -229,11 +213,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
ENDIF

ISUBCASE = SCNUM(ISUBCASE_INDEX)
!WRITE(ERR,*) "JVEC=",JVEC
!WRITE(ERR,*) "ISUBCASE_INDEX=",ISUBCASE_INDEX
!WRITE(ERR,*) "SCNUM(1)=",SCNUM(1)
!WRITE(ERR,*) "ISUBCASE=",ISUBCASE
!FLUSH(ERR)

! -- F06 header for TITLE, SUBTITLE, LABEL (but only to F06)
TITLEI = TITLE(INT_SC_NUM)
Expand Down Expand Up @@ -299,15 +278,9 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
ENDDO

DEVICE_CODE = 1
!GPFB_NROWS = 0
!CALL CALCULATE_GPFB_NROWS(GPFB_NROWS)
!CALL BUILD_GPFB(GPFB_NROWS)
!WRITE(OP2) (GRID(I,1)*10+DEVICE_CODE, I=1,NGRID)

NNODE_GPFORCE = NGRID
DO I=1,NGRID
!WRITE(ERR,*) " GPFORCE I=",I
!FLUSH(ERR)
IB = IAND(GROUT(I,INT_SC_NUM),IBIT(GROUT_GPFO_BIT))
GRID_NUM = GRID(I,1)
CALL GET_GRID_NUM_COMPS ( I, NUM_COMPS, SUBR_NAME )
Expand All @@ -320,7 +293,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )

NUM_CONN_ELEMS = GRID_ELEM_CONN_ARRAY(I,2)
NNODE_GPFORCE = NNODE_GPFORCE + NUM_CONN_ELEMS
!DO J=1,NUM_CONN_ELEMS

!IF (IS_THERMAL) THEN
! NUM_CONN_ELEMS = GRID_ELEM_CONN_ARRAY(I,2)
Expand All @@ -339,8 +311,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
!ENDIF
ENDIF
ENDDO
!WRITE(ERR,*) "NNODE_GPFORCE",NNODE_GPFORCE
!FLUSH(ERR)
!------------------------------------------------------------------------
! ALLOCATE: GPFORCE_NID_EID, GPFORCE_ETYPE, GPFORCE_FXYZ_MXYZ
!ref mystran SUB ALLOCATE_DOF_TABLES
Expand All @@ -351,7 +321,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
NROWS = NNODE_GPFORCE
NCOLS = 2
ALLOCATE (GPFORCE_NID_EID(NROWS,2),STAT=IERR)
!MB_ALLOCATED = REAL(LONG)*REAL(LGRID)*REAL(NCOLS)/ONEPP6
IF (IERR == 0) THEN
DO I=1,NROWS
DO J=1,NCOLS
Expand All @@ -367,7 +336,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
WRITE(ERR,*) 'ALLOCATED!'
ELSE
ALLOCATE (GPFORCE_ETYPE(NROWS),STAT=IERR)
!MB_ALLOCATED = REAL(LONG)*REAL(LGRID)*REAL(NCOLS)/ONEPP6
IF (IERR == 0) THEN
DO I=1,NROWS
GPFORCE_ETYPE(I) = "NA"
Expand All @@ -379,7 +347,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
!----------------
NCOLS = 6
ALLOCATE (GPFORCE_FXYZ_MXYZ(NROWS,NCOLS),STAT=IERR)
!MB_ALLOCATED = REAL(LONG)*REAL(LGRID)*REAL(NCOLS)/ONEPP6
IF (IERR == 0) THEN
DO I=1,NROWS
DO J=1,NCOLS
Expand All @@ -389,8 +356,13 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
ELSE
WRITE(6,*) 'GPFORCE_FXYZ_MXYZ ALLOCATED error'
ENDIF

ELSE
! Dummy allocations to suppress warnings
ALLOCATE (GPFORCE_NID_EID(0,0))
ALLOCATE (GPFORCE_ETYPE(0))
ALLOCATE (GPFORCE_FXYZ_MXYZ(0,0))
ENDIF ! write_op2 allocation

!------------------------------------------------------------------------
CALL COUNTER_INIT('Process grid ', NGRID)
DO I=1,NGRID
Expand Down Expand Up @@ -470,15 +442,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
IS_APP = IS_ABS_POSITIVE(PG1)
IS_SPC = IS_ABS_POSITIVE(QGs1)
IS_MPC = IS_ABS_POSITIVE(QGm1)
!IS_APP = .TRUE.
!IS_SPC = .TRUE.
!IS_MPC = .TRUE.
!WRITE(ERR,*) "start - loads WRITE_OP2",WRITE_OP2
!write(ERR,*) " INODE_GPFORCE =", INODE_GPFORCE
!write(ERR,*) " IS_APP =", IS_APP
!write(ERR,*) " IS_SPC =", IS_SPC
!write(ERR,*) " IS_MPC =", IS_MPC
!FLUSH(ERR)

IF(WRITE_OP2) THEN
IF(IS_APP) THEN
Expand Down Expand Up @@ -535,8 +498,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
IF(IS_SPC) INODE_GPFORCE = INODE_GPFORCE + 1
IF(IS_MPC) INODE_GPFORCE = INODE_GPFORCE + 1
ENDIF
!WRITE(ERR,*) "end - loads WRITE_OP2",WRITE_OP2
!FLUSH(ERR)

IF (WRITE_F06) THEN
IF (IS_APP) WRITE(F06,9203) (PG1(J),J=1,6) ! applied load
Expand Down Expand Up @@ -589,8 +550,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
TOTALS(L) = TOTALS(L) - PEG1(L)
ENDDO

!WRITE(ERR,*) "INODE_GPFORCE=",INODE_GPFORCE
!FLUSH(ERR)
IF(WRITE_OP2) THEN
GPFORCE_NID_EID(INODE_GPFORCE,1) = GRID_NUM
GPFORCE_NID_EID(INODE_GPFORCE,2) = EID
Expand Down Expand Up @@ -644,8 +603,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
ENDIF

ENDIF
!FLUSH(F06)
!FLUSH(ERR)

! For each of the 6 components (J=1,6 for components T1, T2, T3, R1, R2, R3),
! calc % of grid force imbalance as a % of the largest
Expand All @@ -666,11 +623,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
ENDIF

!----------------
!WRITE(ERR,*) " GPFORCE DEALLOCATE: NROWS", NROWS
!WRITE(ERR,*) " IERR=", IERR
!WRITE(ERR,*) " INODE_GPFORCE=", INODE_GPFORCE
!WRITE(ERR,*) " NNODE_GPFORCE=", NNODE_GPFORCE
!FLUSH(ERR)
! DEALLOCATE: GPFORCE_NID_EID, GPFORCE_ETYPE, GPFORCE_FXYZ_MXYZ
!ref mystran SUB DEALLOCATE_DOF_TABLES
!KTSTACK(5500,3)
Expand All @@ -679,28 +631,7 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
! write the data to the op2
!(nid_device, eid, elem_name, f1, f2, f3, m1, m2, m3) = out
!nid = nid_device // 10
!DO I=1,INODE_GPFORCE-1
! WRITE(F06,*) GPFORCE_NID_EID(I,1)*10+DEVICE_CODE, &
! GPFORCE_NID_EID(I,2), &
! GPFORCE_ETYPE(I), &
! GPFORCE_FXYZ_MXYZ(I,1), &
! GPFORCE_FXYZ_MXYZ(I,2), &
! GPFORCE_FXYZ_MXYZ(I,3), &
! GPFORCE_FXYZ_MXYZ(I,4), &
! GPFORCE_FXYZ_MXYZ(I,5), &
! GPFORCE_FXYZ_MXYZ(I,6)
! WRITE(ERR,*) GPFORCE_NID_EID(I,1)*10+DEVICE_CODE, &
! GPFORCE_NID_EID(I,2), &
! GPFORCE_ETYPE(I), &
! GPFORCE_FXYZ_MXYZ(I,1), &
! GPFORCE_FXYZ_MXYZ(I,2), &
! GPFORCE_FXYZ_MXYZ(I,3), &
! GPFORCE_FXYZ_MXYZ(I,4), &
! GPFORCE_FXYZ_MXYZ(I,5), &
! GPFORCE_FXYZ_MXYZ(I,6)
!ENDDO

!WRITE(ERR,*) "OP2-ISUBCASE=",ISUBCASE

CALL OUTPUT2_WRITE_OGF(ISUBCASE, INODE_GPFORCE-1, &
TITLEI, SUBTITLEI, LABELI, &
ANALYSIS_CODE, FIELD5_INT_MODE, FIELD6_EIGENVALUE)
Expand All @@ -720,11 +651,6 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )

!---------------------
! deallocate the arrays
!WRITE(ERR,*) 'GPFORCE_NID_EID is allocated'
!WRITE(ERR,*) 'GPFORCE_NID_EID(1,:)=',GPFORCE_NID_EID(1,1),GPFORCE_NID_EID(1,2),GPFORCE_ETYPE(1)
!WRITE(ERR,*) 'GPFORCE_FXYZ(1,:)=',GPFORCE_FXYZ_MXYZ(1,1),GPFORCE_FXYZ_MXYZ(1,2),GPFORCE_FXYZ_MXYZ(1,3)
!WRITE(ERR,*) 'GPFORCE_MXYZ(1,:)=',GPFORCE_FXYZ_MXYZ(1,4),GPFORCE_FXYZ_MXYZ(1,5),GPFORCE_FXYZ_MXYZ(1,6)
!FLUSH(ERR)
DEALLOCATE(GPFORCE_NID_EID,STAT=IERR)
IF (IERR /= 0) THEN
WRITE(ERR,*) 'GPFORCE_NID_EID DEALLOCATE error'
Expand All @@ -740,7 +666,13 @@ SUBROUTINE GP_FORCE_BALANCE_PROC ( JVEC, IHEADER )
IF (IERR /= 0) THEN
WRITE(ERR,*) 'GPFORCE_FXYZ_MXYZ DEALLOCATE error'
ENDIF
ELSE
! deallocate the dummy arrays
DEALLOCATE (GPFORCE_NID_EID)
DEALLOCATE (GPFORCE_ETYPE)
DEALLOCATE (GPFORCE_FXYZ_MXYZ)
ENDIF

FLUSH(OP2)
FLUSH(F06)
FLUSH(ERR)
Expand Down Expand Up @@ -859,7 +791,7 @@ SUBROUTINE CALCULATE_GPFB_IMBALANCE(CHAR_PCT, MAX_ABS, MAX_ABS_PCT, MAX_ABS_GRID
! For each of the 6 components (J=1,6 for components T1, T2, T3, R1, R2, R3)
! - 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 PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE
USE IOUNT1, ONLY : F06
USE CONSTANTS_1, ONLY : ZERO
USE DEBUG_PARAMETERS, ONLY : DEBUG
Expand Down
Loading