diff --git a/BUILD.md b/BUILD.md index 944e1c9..8efbd0f 100644 --- a/BUILD.md +++ b/BUILD.md @@ -47,7 +47,7 @@ If your build environment is already set up, building MYSTRAN is quite straightf 3. Fetch the source code if you haven't already. If you're using Git, you can clone the repo with **`git clone https://github.com/MYSTRANsolver/MYSTRAN.git`**. 4. Move the terminal to the MYSTRAN folder. If you've just run `git clone`, just do a **`cd MYSTRAN`**. 5. Generate the build scripts by running **`cmake -G "MinGW Makefiles" .`**. - 6. Compile with **`make`**. If you have an N-core processor, running **`make -jN`** will probably me much faster. A good choice of N is printed in the previous step, right before the end. + 6. Compile with **`mingw32-make`**. If you have an N-core processor, running **`mingw32-make -jN`** will probably be much faster. A good choice of N is printed in the previous step, right before the end. 7. The executable will reside at **`Binaries/mystran.exe`**. ### Steps for Linux (any) diff --git a/Source/Interfaces/WRITE_ROD_Interface.f90 b/Source/Interfaces/WRITE_ROD_Interface.f90 index a86fb5a..89d34a3 100644 --- a/Source/Interfaces/WRITE_ROD_Interface.f90 +++ b/Source/Interfaces/WRITE_ROD_Interface.f90 @@ -29,7 +29,7 @@ MODULE WRITE_ROD_Interface INTERFACE SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE ) + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_OP2 ) USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE @@ -49,6 +49,7 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, TITLE, SUBTITL 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_OP2 ! writes the op2 INTEGER(LONG), INTENT(IN) :: NUM ! The number of rows of OGEL to write out INTEGER(LONG), INTENT(IN) :: ITABLE ! the current op2 subtable, should be -3, -5, ... diff --git a/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 b/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 index 703f1b1..9d1ab36 100644 --- a/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 +++ b/Source/LK9/L91/WRITE_ELEM_STRAINS.f90 @@ -390,20 +390,23 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) !IF (TYPE == 'BAR ') THEN !CALL WRITE_BAR ( NUM, FILL(1:1), FILL(1:16) ) IF (TYPE(1:4) == 'ELAS') THEN - CALL GET_SPRING_OP2_ELEMENT_TYPE(ELEMENT_TYPE) - NUM_WIDE = 2 ! eid, spring_strain - NVALUES = NUM_WIDE * NUM - - DEVICE_CODE = 1 ! PLOT - - !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) - CALL GET_STRESS_CODE( STRESS_CODE, 1, 1, 0) - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + IF (WRITE_OP2) THEN + CALL GET_SPRING_OP2_ELEMENT_TYPE(ELEMENT_TYPE) + + NUM_WIDE = 2 ! eid, spring_strain + NVALUES = NUM_WIDE * NUM + + DEVICE_CODE = 1 ! PLOT - WRITE(OP2) NVALUES - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, REAL(OGEL(I,1), 4), I=1,NUM) + !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) + CALL GET_STRESS_CODE( STRESS_CODE, 1, 1, 0) + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + + WRITE(OP2) NVALUES + WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, REAL(OGEL(I,1), 4), I=1,NUM) + ENDIF WRITE(F06,1103) (FILL(1:1), EID_OUT_ARRAY(I,1), OGEL(I,1),I=1,NUM) @@ -428,7 +431,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) NNODES = 7 ENDIF - !IF (WRITE_OP2) THEN + IF (WRITE_OP2) THEN NUM_WIDE = 4 + 21 * NNODES NVALUES = NUM_WIDE * NUM @@ -472,6 +475,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ! szz txz s3 c1 c2 c3 REAL(OGEL(I,3),4), REAL(OGEL(I,6),4), REAL(OGEL(I,11),4), 0., 0., 0., & J=1,NNODES), I=1,NUM) + ENDIF IF (STRN_OPT == 'VONMISES') THEN NCOLS = 7 @@ -499,12 +503,12 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ENDIF ELSE IF (TYPE(1:5) == 'QUAD4') THEN - !CALL WRITE_OST_CQUAD4 ( NUM, FILL, ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI ) - !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) - CALL GET_STRESS_CODE( STRESS_CODE, 1, 1, 1) + IF (WRITE_OP2) THEN + !CALL WRITE_OST_CQUAD4 ( NUM, FILL, ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI ) - IF (.TRUE.) THEN + !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) + CALL GET_STRESS_CODE( STRESS_CODE, 1, 1, 1) IF (STRN_LOC == 'CENTER ') THEN ! CQUAD4-33 !(eid_device, @@ -676,7 +680,7 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ELSE IF (TYPE == 'ROD ') THEN CALL WRITE_ROD (ISUBCASE, NUM, FILL(1:1), FILL(1:16), ITABLE, TITLEI, STITLEI, LABELI, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE ) + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_OP2 ) ELSE IF (TYPE(1:5) == 'SHEAR') THEN CALL WRITE_OST_CSHEAR (NUM, FILL, ISUBCASE, ITABLE, TITLEI, STITLEI, LABELI, & @@ -689,18 +693,20 @@ SUBROUTINE WRITE_ELEM_STRAINS ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) WRITE_F06, WRITE_OP2, WRITE_ANS) ELSE IF (TYPE == 'BUSH ') THEN - ELEMENT_TYPE = 102 ! CBUSH - NUM_WIDE = 7 ! eid, tx, ty, tz, rx, ry, rz - STRESS_CODE = 1 ! dunno - !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) - CALL GET_STRESS_CODE( STRESS_CODE, 0, 1, 0) - NVALUES = NUM * NUM_WIDE - - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - - WRITE(OP2) NVALUES - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE,(REAL(OGEL(I,J),4), J=1,6), I=1,NUM) + IF (WRITE_OP2) THEN + ELEMENT_TYPE = 102 ! CBUSH + NUM_WIDE = 7 ! eid, tx, ty, tz, rx, ry, rz + STRESS_CODE = 1 ! dunno + !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) + CALL GET_STRESS_CODE( STRESS_CODE, 0, 1, 0) + NVALUES = NUM * NUM_WIDE + + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + + WRITE(OP2) NVALUES + 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) @@ -959,6 +965,7 @@ SUBROUTINE WRITE_OST_CSHEAR(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, REAL(REAL32) :: NAN NAN = IEEE_VALUE(NAN, IEEE_QUIET_NAN) + IF (WRITE_OP2) THEN DEVICE_CODE = 1 ! PLOT NVALUES = NUM * NUM_WIDE NTOTAL = NVALUES * 4 @@ -996,6 +1003,7 @@ SUBROUTINE WRITE_OST_CSHEAR(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, !Normal-X Normal-Y Shear-XY -> max_shear, avg_shear, margin WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, REAL(OGEL(I,3), 4), REAL(OGEL(I,3), 4), & NAN, I=1,NUM) + ENDIF ! write op2 DO I=1,NUM,2 IF (I+1 <= NUM) THEN WRITE(F06,1603) FILL(1: 0), EID_OUT_ARRAY(I,1),(OGEL(I,J),J=1,3), EID_OUT_ARRAY(I+1,1),(OGEL(I+1,J),J=1,3) @@ -1062,21 +1070,23 @@ SUBROUTINE WRITE_OST_CTRIA3(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, DEVICE_CODE = 1 ! plot K = 0 - 100 FORMAT("*DEBUG: WRITE_CTRIA3 ITABLE=",I8, "; NUM=",I8,"; NVALUES=",I8,"; NTOTAL=",I8) -!101 FORMAT("*DEBUG: WRITE_CTRIA3 ITABLE=",I8," (should be -5, -7,...)") - NVALUES = NUM * NUM_WIDE - NTOTAL = NVALUES * 4 - WRITE(ERR,100) ITABLE,NUM,NVALUES,NTOTAL - - !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) - CALL GET_STRESS_CODE( STRESS_CODE, 1, 1, 1) - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLE, SUBTITLE, LABEL, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - WRITE(OP2) NVALUES + IF (WRITE_OP2) THEN + 100 FORMAT("*DEBUG: WRITE_CTRIA3 ITABLE=",I8, "; NUM=",I8,"; NVALUES=",I8,"; NTOTAL=",I8) +!101 FORMAT("*DEBUG: WRITE_CTRIA3 ITABLE=",I8," (should be -5, -7,...)") + NVALUES = NUM * NUM_WIDE + NTOTAL = NVALUES * 4 + WRITE(ERR,100) ITABLE,NUM,NVALUES,NTOTAL - ! op2 version of the upper & lower layers all in one call, but without the transverse shear - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, (REAL(OGEL(2*I-1,J),4), J=1,8), (REAL(OGEL(2*I,J),4), J=1,8), I=1,NUM) + !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) + CALL GET_STRESS_CODE( STRESS_CODE, 1, 1, 1) + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLE, SUBTITLE, LABEL, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + WRITE(OP2) NVALUES + ! op2 version of the upper & lower layers all in one call, but without the transverse shear + WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, (REAL(OGEL(2*I-1,J),4), J=1,8), & + (REAL(OGEL(2*I,J),4), J=1,8), I=1,NUM) + ENDIF 1703 FORMAT(1X,I8,4X,'Anywhere',2X,4(1ES13.5),0PF9.3,5(1ES13.5)) 1704 FORMAT(13X,'in elem',3X,4(1ES13.5),0PF9.3,5(1ES13.5)) diff --git a/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 b/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 index dccbfba..55716f4 100644 --- a/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 +++ b/Source/LK9/L91/WRITE_ELEM_STRESSES.f90 @@ -26,9 +26,8 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, 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. - + ! 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 SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, BARTOR, INT_SC_NUM, MAX_NUM_STR, NDOFR, NUM_CB_DOFS, & @@ -395,7 +394,6 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) 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 @@ -406,21 +404,22 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) FIELD5_INT_MODE, FIELD6_EIGENVALUE) ELSE IF (TYPE(1:4) == 'ELAS') THEN + IF (WRITE_OP2) THEN + CALL GET_SPRING_OP2_ELEMENT_TYPE(ELEMENT_TYPE) - CALL GET_SPRING_OP2_ELEMENT_TYPE(ELEMENT_TYPE) + NUM_WIDE = 2 ! eid, spring_stress + NVALUES = NUM_WIDE * NUM + + DEVICE_CODE = 1 ! PLOT - NUM_WIDE = 2 ! eid, spring_stress - NVALUES = NUM_WIDE * NUM - - DEVICE_CODE = 1 ! PLOT - - !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) - CALL GET_STRESS_CODE( STRESS_CODE, 1, 0, 0) - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) + CALL GET_STRESS_CODE( STRESS_CODE, 1, 0, 0) + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - WRITE(OP2) NVALUES - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, REAL(OGEL(I,1), 4), I=1,NUM) + WRITE(OP2) NVALUES + 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) @@ -443,44 +442,48 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) NUM_WIDE = 4 + 21 * NNODES NVALUES = NUM_WIDE * NUM - !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) - CALL GET_STRESS_CODE( STRESS_CODE, 1, 0, 0) - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - WRITE(OP2) NVALUES - CEN_WORD = "CEN/" - - ! See the CHEXA, CPENTA, or CTETRA entry for the definition of the element coordinate systems. - ! The material coordinate system (CORDM) may be the basic system (0 or blank), any defined system - ! (Integer > 0), or the standard internal coordinate system of the element designated as: - ! -1: element coordinate system (-1) - ! -2: element system based on eigenvalue techniques to insure non bias in the element formulation. - - ! TODO hardcoded - CID = -1 - - ! setting: - ! - CTETRA: [element_device, cid, 'CEN/', 4] - ! - CPYRAM: [element_device, cid, 'CEN/', 5] - ! - CPENTA: [element_device, cid, 'CEN/', 6] - ! - CHEXA: [element_device, cid, 'CEN/', 8] - - ! 1 2 3 4 5 6 7 - ! Element Sigma-xx Sigma-yy Sigma-zz Tau-xy Tau-yz Tau-zx von Mises - ! ID - - ! TODO: we repeat the center node N times because the corner results have not been calculated - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, CID, CEN_WORD, NNODES-1, & - ! grid_id - ! 21 - (GID_OUT_ARRAY(I,J), & - ! oxx txy s1 a1 a2 a3 p ovm - REAL(OGEL(I,1),4), REAL(OGEL(I,4),4), REAL(OGEL(I,9), 4), 0., 0., 0., REAL(OGEL(I,12),4), REAL(OGEL(I,7),4), & - ! syy tyz s2 b1 b2 b3 - REAL(OGEL(I,2),4), REAL(OGEL(I,5),4), REAL(OGEL(I,10),4), 0., 0., 0., & - ! szz txz s3 c1 c2 c3 - REAL(OGEL(I,3),4), REAL(OGEL(I,6),4), REAL(OGEL(I,11),4), 0., 0., 0., & - J=1,NNODES), I=1,NUM) + IF (WRITE_OP2) THEN + !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) + CALL GET_STRESS_CODE( STRESS_CODE, 1, 0, 0) + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + WRITE(OP2) NVALUES + CEN_WORD = "CEN/" + + ! See the CHEXA, CPENTA, or CTETRA entry for the definition of the element coordinate systems. + ! The material coordinate system (CORDM) may be the basic system (0 or blank), any defined system + ! (Integer > 0), or the standard internal coordinate system of the element designated as: + ! -1: element coordinate system (-1) + ! -2: element system based on eigenvalue techniques to insure non bias in the element formulation. + + ! TODO hardcoded + CID = -1 + + ! setting: + ! - CTETRA: [element_device, cid, 'CEN/', 4] + ! - CPYRAM: [element_device, cid, 'CEN/', 5] + ! - CPENTA: [element_device, cid, 'CEN/', 6] + ! - CHEXA: [element_device, cid, 'CEN/', 8] + + ! 1 2 3 4 5 6 7 + ! Element Sigma-xx Sigma-yy Sigma-zz Tau-xy Tau-yz Tau-zx von Mises + ! ID + + ! TODO: we repeat the center node N times because the corner results have not been calculated + WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, CID, CEN_WORD, NNODES-1, & + ! grid_id + ! 21 + (GID_OUT_ARRAY(I,J), & + ! oxx txy s1 a1 a2 a3 + REAL(OGEL(I,1),4), REAL(OGEL(I,4),4), REAL(OGEL(I,9), 4), 0., 0., 0., & + ! p ovm + REAL(OGEL(I,12),4), REAL(OGEL(I,7),4), & + ! syy tyz s2 b1 b2 b3 + REAL(OGEL(I,2),4), REAL(OGEL(I,5),4), REAL(OGEL(I,10),4), 0., 0., 0., & + ! szz txz s3 c1 c2 c3 + REAL(OGEL(I,3),4), REAL(OGEL(I,6),4), REAL(OGEL(I,11),4), 0., 0., 0., & + J=1,NNODES), I=1,NUM) + ENDIF ! end of op2 IF (STRE_OPT == 'VONMISES') THEN NCOLS = 7 @@ -513,60 +516,62 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) CALL GET_STRESS_CODE( STRESS_CODE, 1, 0, 1) - IF (STRE_LOC == 'CENTER ') THEN - ! CQUAD4-33 - 2 FORMAT(' *DEBUG: WRITE_CQUAD4-33: NUM=',I4, " NUM_PTS=", I4, " STRE_LOC=",A,"ITABLE=",I4) - WRITE(ERR,2) NUM,NUM_PTS,STRE_LOC,ITABLE - - !(eid_device, - ! fd1, sx1, sy1, txy1, angle1, major1, minor1, vm1, - ! fd2, sx2, sy2, txy2, angle2, major2, minor2, vm2,) = out; n=17 - NUM_WIDE = 17 - ELEMENT_TYPE = 33 - NVALUES = NUM_WIDE * NUM - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - !NUM_PTS = 1 - ! just a copy of the CTRIA3 code - ! op2 version of the upper & lower layers all in one call, but without the transverse shear - WRITE(OP2) NVALUES - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, (REAL(OGEL(2*I-1,J),4), J=1,8), (REAL(OGEL(2*I,J),4), J=1,8), I=1,NUM) - ELSE - ! CQUAD4-144 - 3 FORMAT(' *DEBUG: WRITE_CQUAD4-144: NUM=',I4, " NUM_PTS=", I4, " STRE_LOC=",A,"ITABLE=",I4) - WRITE(ERR,3) NUM,NUM_PTS,STRE_LOC,ITABLE - ELEMENT_TYPE = 144 - NUM_WIDE = 87 ! 2 + 17 * (4+1) ! 4 nodes + 1 centroid - - ! TODO: probably wrong...divide NUM by NUM_PTS? - NELEMENTS = NUM / NUM_PTS - NVALUES = NUM_WIDE * NELEMENTS - ! NUM= 10 NUM_PTS= 5 - !(eid_device, "CEN/", 4, # "CEN/4" - ! fd1, sx1, sy1, txy1, angle1, major1, minor1, vm1, - ! fd2, sx2, sy2, txy2, angle2, major2, minor2, vm2,) = n = 17+2 - ! - ! (grid, - ! fd1, sx1, sy1, txy1, angle1, major1, minor1, vm1, - ! fd2, sx2, sy2, txy2, angle2, major2, minor2, vm2,)*4 = n = 17*4 - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLEI, STITLE, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - WRITE(OP2) NVALUES - ! see the CQUAD4-33 stress/strain (the IF part of this IF-ELSE block) - ! writing before trying to understand this... - ! - ! basically a one-liner version of the F06 writing - ! we broke out the L=1,NUM_PTS-1 loop to 4 lines (the GID_OUT_ARRAY lines) - ! to avoid an additional hard to write loop - WRITE(OP2) (EID_OUT_ARRAY(5*I+1,1)*10+DEVICE_CODE, "CEN/", 4, & - (REAL(OGEL(10*I+1,J),4), J=1,8), (REAL(OGEL(10*I+2, J),4), J=1,8), & - GID_OUT_ARRAY(5*I+1,2), (REAL(OGEL(10*I+3,J),4), J=1,8), (REAL(OGEL(10*I+4, J),4), J=1,8), & - GID_OUT_ARRAY(5*I+1,3), (REAL(OGEL(10*I+5,J),4), J=1,8), (REAL(OGEL(10*I+6, J),4), J=1,8), & - GID_OUT_ARRAY(5*I+1,4), (REAL(OGEL(10*I+7,J),4), J=1,8), (REAL(OGEL(10*I+8, J),4), J=1,8), & - GID_OUT_ARRAY(5*I+1,5), (REAL(OGEL(10*I+9,J),4), J=1,8), (REAL(OGEL(10*(I+1),J),4), J=1,8), & - I=0,NELEMENTS-1) - ENDIF - + IF (WRITE_OP2) THEN + IF (STRE_LOC == 'CENTER ') THEN + ! CQUAD4-33 + 2 FORMAT(' *DEBUG: WRITE_CQUAD4-33: NUM=',I4, " NUM_PTS=", I4, " STRE_LOC=",A,"ITABLE=",I4) + WRITE(ERR,2) NUM,NUM_PTS,STRE_LOC,ITABLE + + !(eid_device, + ! fd1, sx1, sy1, txy1, angle1, major1, minor1, vm1, + ! fd2, sx2, sy2, txy2, angle2, major2, minor2, vm2,) = out; n=17 + NUM_WIDE = 17 + ELEMENT_TYPE = 33 + NVALUES = NUM_WIDE * NUM + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + !NUM_PTS = 1 + ! just a copy of the CTRIA3 code + ! op2 version of the upper & lower layers all in one call, but without the transverse shear + WRITE(OP2) NVALUES + WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, (REAL(OGEL(2*I-1,J),4), J=1,8), (REAL(OGEL(2*I,J),4), J=1,8), I=1,NUM) + ELSE + ! CQUAD4-144 + 3 FORMAT(' *DEBUG: WRITE_CQUAD4-144: NUM=',I4, " NUM_PTS=", I4, " STRE_LOC=",A,"ITABLE=",I4) + WRITE(ERR,3) NUM,NUM_PTS,STRE_LOC,ITABLE + ELEMENT_TYPE = 144 + NUM_WIDE = 87 ! 2 + 17 * (4+1) ! 4 nodes + 1 centroid + + ! TODO: probably wrong...divide NUM by NUM_PTS? + NELEMENTS = NUM / NUM_PTS + NVALUES = NUM_WIDE * NELEMENTS + ! NUM= 10 NUM_PTS= 5 + !(eid_device, "CEN/", 4, # "CEN/4" + ! fd1, sx1, sy1, txy1, angle1, major1, minor1, vm1, + ! fd2, sx2, sy2, txy2, angle2, major2, minor2, vm2,) = n = 17+2 + ! + ! (grid, + ! fd1, sx1, sy1, txy1, angle1, major1, minor1, vm1, + ! fd2, sx2, sy2, txy2, angle2, major2, minor2, vm2,)*4 = n = 17*4 + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLEI, STITLE, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + WRITE(OP2) NVALUES + ! see the CQUAD4-33 stress/strain (the IF part of this IF-ELSE block) + ! writing before trying to understand this... + ! + ! basically a one-liner version of the F06 writing + ! we broke out the L=1,NUM_PTS-1 loop to 4 lines (the GID_OUT_ARRAY lines) + ! to avoid an additional hard to write loop + WRITE(OP2) (EID_OUT_ARRAY(5*I+1,1)*10+DEVICE_CODE, "CEN/", 4, & + (REAL(OGEL(10*I+1,J),4), J=1,8), (REAL(OGEL(10*I+2, J),4), J=1,8), & + GID_OUT_ARRAY(5*I+1,2), (REAL(OGEL(10*I+3,J),4), J=1,8), (REAL(OGEL(10*I+4, J),4), J=1,8), & + GID_OUT_ARRAY(5*I+1,3), (REAL(OGEL(10*I+5,J),4), J=1,8), (REAL(OGEL(10*I+6, J),4), J=1,8), & + GID_OUT_ARRAY(5*I+1,4), (REAL(OGEL(10*I+7,J),4), J=1,8), (REAL(OGEL(10*I+8, J),4), J=1,8), & + GID_OUT_ARRAY(5*I+1,5), (REAL(OGEL(10*I+9,J),4), J=1,8), (REAL(OGEL(10*(I+1),J),4), J=1,8), & + I=0,NELEMENTS-1) + ENDIF + ENDIF ! end of op2 + K = 0 DO I=1,NUM,NUM_PTS 4 FORMAT(' *DEBUG: WRITE_CQUAD4-144: I=',I4, " K=", I4) @@ -675,7 +680,8 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) ENDIF ELSE IF (TYPE == 'ROD ') THEN - CALL WRITE_ROD (ISUBCASE, NUM, FILL(1:1), FILL(1:16), ITABLE, TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE ) + CALL WRITE_ROD (ISUBCASE, NUM, FILL(1:1), FILL(1:16), 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, & @@ -688,16 +694,17 @@ SUBROUTINE WRITE_ELEM_STRESSES ( JSUB, NUM, IHDR, NUM_PTS, ITABLE ) WRITE_F06, WRITE_OP2, WRITE_ANS) ELSE IF (TYPE == 'BUSH ') THEN - ELEMENT_TYPE = 102 ! CBUSH - NUM_WIDE = 7 ! eid, tx, ty, tz, rx, ry, rz - STRESS_CODE = 1 ! dunno - NVALUES = NUM * NUM_WIDE - - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - - WRITE(OP2) NVALUES - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE,(REAL(OGEL(I,J),4),J=1,6), I=1,NUM) + IF (WRITE_OP2) THEN + ELEMENT_TYPE = 102 ! CBUSH + NUM_WIDE = 7 ! eid, tx, ty, tz, rx, ry, rz + STRESS_CODE = 1 ! dunno + NVALUES = NUM * NUM_WIDE + + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLEI, STITLEI, LABELI, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + WRITE(OP2) NVALUES + 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) @@ -956,41 +963,43 @@ SUBROUTINE WRITE_OES_CSHEAR(NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABEL, REAL(REAL32) :: NAN NAN = IEEE_VALUE(NAN, IEEE_QUIET_NAN) - DEVICE_CODE = 1 ! PLOT - NVALUES = NUM * NUM_WIDE - NTOTAL = NVALUES * 4 - - ! eid, max_shear, avg_shear, margin - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLE, SUBTITLE, LABEL, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - - 100 FORMAT("*DEBUG: WRITE_CSHEAR ITABLE=",I8, "; NUM=",I8,"; NVALUES=",I8,"; NTOTAL=",I8) - 101 FORMAT("*DEBUG: WRITE_CSHEAR ITABLE=",I8," (should be -5, -7,...)") - NVALUES = NUM * NUM_WIDE - NTOTAL = NVALUES * 4 - WRITE(ERR,100) ITABLE,NUM,NVALUES,NTOTAL - WRITE(OP2) NVALUES - - ! Nastran OP2 requires this write call be a one liner...so it's a little weird... - ! translating: - ! DO I=1,NUM - ! WRITE(OP2) EID_OUT_ARRAY(I,1)*10+DEVICE_CODE ! Nastran is weird and requires scaling the ELEMENT_ID - ! - ! convert from float64 (double precision) to float32 (single precision) - ! RE1 = REAL(OGEL(I,1), 4) - ! RE2 = REAL(OGEL(I,2), 4) - ! RE3 = REAL(OGEL(I,3), 4) - ! - ! write the max_shear, avg_shear, - ! WRITE(OP2) RE1, RE2, RE3 - ! ENDDO - ! - ! write the CSHEAR stress/strain data - !Normal-X Normal-Y Shear-XY -> max_shear, avg_shear, margin - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, REAL(OGEL(I,3), 4), REAL(OGEL(I,3), 4), & + IF (WRITE_OP2) THEN + DEVICE_CODE = 1 ! PLOT + NVALUES = NUM * NUM_WIDE + NTOTAL = NVALUES * 4 + + ! eid, max_shear, avg_shear, margin + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLE, SUBTITLE, LABEL, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + + 100 FORMAT("*DEBUG: WRITE_CSHEAR ITABLE=",I8, "; NUM=",I8,"; NVALUES=",I8,"; NTOTAL=",I8) + 101 FORMAT("*DEBUG: WRITE_CSHEAR ITABLE=",I8," (should be -5, -7,...)") + NVALUES = NUM * NUM_WIDE + NTOTAL = NVALUES * 4 + WRITE(ERR,100) ITABLE,NUM,NVALUES,NTOTAL + WRITE(OP2) NVALUES + + ! Nastran OP2 requires this write call be a one liner...so it's a little weird... + ! translating: + ! DO I=1,NUM + ! WRITE(OP2) EID_OUT_ARRAY(I,1)*10+DEVICE_CODE ! Nastran is weird and requires scaling the ELEMENT_ID + ! + ! convert from float64 (double precision) to float32 (single precision) + ! RE1 = REAL(OGEL(I,1), 4) + ! RE2 = REAL(OGEL(I,2), 4) + ! RE3 = REAL(OGEL(I,3), 4) + ! + ! write the max_shear, avg_shear, + ! WRITE(OP2) RE1, RE2, RE3 + ! ENDDO + ! + ! write the CSHEAR stress/strain data + !Normal-X Normal-Y Shear-XY -> max_shear, avg_shear, margin + WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, REAL(OGEL(I,3), 4), REAL(OGEL(I,3), 4), & NAN, I=1,NUM) - WRITE(ERR,100) ITABLE - + WRITE(ERR,100) ITABLE + ENDIF ! write op2 + DO I=1,NUM,2 IF (I+1 <= NUM) THEN WRITE(F06,1603) FILL(1: 0), EID_OUT_ARRAY(I,1),(OGEL(I,J),J=1,3), EID_OUT_ARRAY(I+1,1),(OGEL(I+1,J),J=1,3) @@ -1061,19 +1070,22 @@ SUBROUTINE WRITE_OES_CTRIA3 ( NUM, FILL, ISUBCASE, ITABLE, TITLE, SUBTITLE, LABE NTOTAL = NVALUES * 4 WRITE(ERR,100) ITABLE,NUM,NVALUES,NTOTAL - !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) - CALL GET_STRESS_CODE( STRESS_CODE, 1, 0, 1) - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & - TITLE, SUBTITLE, LABEL, FIELD5_INT_MODE, FIELD6_EIGENVALUE) - WRITE(OP2) NVALUES - -! 1702 FORMAT(1X,A,'Element Location Fibre Stresses In Element Coord System Principal Stresses (Zero Shear)', & -! ' Max Transverse Transverse' & -! ,/,1X,A,' ID Distance Normal-X Normal-Y Shear-XY Angle Major Minor', & -! ' Shear-XY Shear-XZ Shear-YZ',/,1X,123X,'(max through thickness)') - - ! op2 version of the upper & lower layers all in one call, but without the transverse shear - WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, (REAL(OGEL(2*I-1,J),4), J=1,8), (REAL(OGEL(2*I,J),4), J=1,8), I=1,NUM) + IF (WRITE_OP2) THEN + !CALL GET_STRESS_CODE(STRESS_CODE, IS_VON_MISES, IS_STRAIN, IS_FIBER_DISTANCE) + CALL GET_STRESS_CODE( STRESS_CODE, 1, 0, 1) + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEMENT_TYPE, NUM_WIDE, STRESS_CODE, & + TITLE, SUBTITLE, LABEL, FIELD5_INT_MODE, FIELD6_EIGENVALUE) + WRITE(OP2) NVALUES + +!1702 FORMAT(1X,A,'Element Location Fibre Stresses In Element Coord System Principal Stresses (Zero Shear)', & +! ' Max Transverse Transverse' & +! ,/,1X,A,' ID Distance Normal-X Normal-Y Shear-XY Angle Major Minor', & +! ' Shear-XY Shear-XZ Shear-YZ',/,1X,123X,'(max through thickness)') + + ! op2 version of the upper & lower layers all in one call, but without the transverse shear + WRITE(OP2) (EID_OUT_ARRAY(I,1)*10+DEVICE_CODE, (REAL(OGEL(2*I-1,J),4), J=1,8), & + (REAL(OGEL(2*I,J),4), J=1,8), I=1,NUM) + ENDIF ! write op2 1703 FORMAT(1X,I8,4X,'Anywhere',2X,4(1ES13.5),0PF9.3,5(1ES13.5)) diff --git a/Source/LK9/L91/WRITE_GRD_OP2_OUTPUTS.f90 b/Source/LK9/L91/WRITE_GRD_OP2_OUTPUTS.f90 index 2dc6f84..a666d85 100644 --- a/Source/LK9/L91/WRITE_GRD_OP2_OUTPUTS.f90 +++ b/Source/LK9/L91/WRITE_GRD_OP2_OUTPUTS.f90 @@ -75,6 +75,9 @@ SUBROUTINE WRITE_GRD_OP2_OUTPUTS ( JSUB, NUM, WHAT, ITABLE, NEW_RESULT ) INTEGER(LONG) :: NUM_WIDE ! the width in bytes of a result INTEGER(LONG) :: NVALUES ! the width in "words" of a result +! ********************************************************************************************************************************** + ! TODO: assuming PLOT + DEVICE_CODE = 1 ! ********************************************************************************************************************************** ! IF (WRT_LOG >= SUBR_BEGEND) THEN ! CALL OURTIM @@ -133,7 +136,6 @@ SUBROUTINE WRITE_GRD_OP2_OUTPUTS ( JSUB, NUM, WHAT, ITABLE, NEW_RESULT ) ITABLE = ITABLE - 1 ! Write accels, displ's, applied forces or SPC forces (also calc TOTALS for forces if that is being output) ! TOTALS(J) is summation of G.P. values of applied forces, SPC forces, or MFC forces, for each of the J=1,6 components. - DEVICE_CODE = 1 ! fill the G_OR_S array CALL GET_G_OR_S ( NUM, G_OR_S ) diff --git a/Source/LK9/L91/WRITE_ROD.f90 b/Source/LK9/L91/WRITE_ROD.f90 index 92b47e0..62c72a6 100644 --- a/Source/LK9/L91/WRITE_ROD.f90 +++ b/Source/LK9/L91/WRITE_ROD.f90 @@ -26,7 +26,7 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE) + 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. @@ -54,6 +54,7 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, 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_OP2 ! write the op2 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 @@ -102,7 +103,7 @@ SUBROUTINE WRITE_ROD ( ISUBCASE, NUM, FILL_F06, FILL_ANS, ITABLE, & !ELEM_TYPE = 3 ! CTUBE !ELEM_TYPE = 10 ! CONROD CALL OUTPUT2_WRITE_OES_ROD(ISUBCASE, ELEM_TYPE, NUM, ITABLE, TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE) + FIELD5_INT_MODE, FIELD6_EIGENVALUE, WRITE_OP2) DO I=1,NUM,2 RLINE_F06(1:) = ' ' @@ -306,7 +307,7 @@ END SUBROUTINE GET_MAX_MIN_ABS END SUBROUTINE WRITE_ROD !================================================================================================== SUBROUTINE OUTPUT2_WRITE_OES_ROD(ISUBCASE, ELEM_TYPE, NUM, ITABLE, TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE) + 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. ! @@ -326,6 +327,7 @@ SUBROUTINE OUTPUT2_WRITE_OES_ROD(ISUBCASE, ELEM_TYPE, NUM, ITABLE, TITLE, SUBTIT INTEGER(LONG), INTENT(IN) :: ISUBCASE ! subcase id INTEGER(LONG), INTENT(IN) :: NUM ! the number of elements in OGEL to write INTEGER(LONG), INTENT(IN) :: ELEM_TYPE + LOGICAL, INTENT(IN) :: WRITE_OP2 ! is this a PLOT result -> OP2 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 @@ -340,7 +342,6 @@ SUBROUTINE OUTPUT2_WRITE_OES_ROD(ISUBCASE, ELEM_TYPE, NUM, ITABLE, TITLE, SUBTIT INTEGER(LONG) :: NTOTAL ! the number of bytes corresponding to nvalues REAL(REAL32) :: NAN LOGICAL :: IS_PRINT ! is this a PRINT result -> F06 - LOGICAL :: IS_PLOT ! is this a PLOT result -> OP2 NAN = IEEE_VALUE(NAN, IEEE_QUIET_NAN) ! TODO: assuming PLOT @@ -350,21 +351,20 @@ SUBROUTINE OUTPUT2_WRITE_OES_ROD(ISUBCASE, ELEM_TYPE, NUM, ITABLE, TITLE, SUBTIT !******OP2 ! we're already setup for subtable -3 !================================================================================================== - - ! eid, axisl_stress, axial_margin, torsional stress, torsional_margin - NUM_WIDE = 5 - - ! dunno??? - STRESS_CODE = 1 - CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEM_TYPE, NUM_WIDE, STRESS_CODE, TITLE, SUBTITLE, LABEL, & - FIELD5_INT_MODE, FIELD6_EIGENVALUE) - ! ITABLE = -4, -6, ... - !NWORDS = NUM * NUM_WIDE - !NTOTAL = NBYTES_PER_WORD * NWORDS - - IS_PRINT = .TRUE. - IS_PLOT = .TRUE. - IF (IS_PLOT) THEN + + IF (WRITE_OP2) THEN + ! eid, axisl_stress, axial_margin, torsional stress, torsional_margin + NUM_WIDE = 5 + + ! dunno??? + STRESS_CODE = 1 + CALL WRITE_OES3_STATIC(ITABLE, ISUBCASE, DEVICE_CODE, ELEM_TYPE, NUM_WIDE, STRESS_CODE, & + TITLE, SUBTITLE, LABEL, & + FIELD5_INT_MODE, FIELD6_EIGENVALUE) + ! ITABLE = -4, -6, ... + !NWORDS = NUM * NUM_WIDE + !NTOTAL = NBYTES_PER_WORD * NWORDS + 100 FORMAT("*DEBUG: ITABLE=",I8, "; NUM=",I8,"; NVALUES=",I8,"; NTOTAL=",I8) NVALUES = NUM * NUM_WIDE NTOTAL = NVALUES * 4 diff --git a/Source/LK9/L92/OFP1.f90 b/Source/LK9/L92/OFP1.f90 index 001d3ef..41836a4 100644 --- a/Source/LK9/L92/OFP1.f90 +++ b/Source/LK9/L92/OFP1.f90 @@ -42,11 +42,13 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N USE COL_VECS, ONLY : UG_COL, UG0_COL, PG_COL, PHIXG_COL, PHIXN_COL USE OUTPUT4_MATRICES, ONLY : OTM_ACCE, OTM_DISP, TXT_ACCE, TXT_DISP USE CC_OUTPUT_DESCRIBERS, ONLY : ACCE_OUT, DISP_OUT, OLOA_OUT + USE DEBUG_PARAMETERS, ONLY : DEBUG USE OFP1_USE_IFs IMPLICIT NONE + LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH, WRITE_ANS ! 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 @@ -84,6 +86,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N INTRINSIC IAND WRITE(ERR,9000) "OFP1 - disp, accel and applied force output" 9000 FORMAT(' *DEBUG: RUNNING=', A) + WRITE_ANS = (DEBUG(200) > 0) ! ********************************************************************************************************************************** IF (WRT_LOG >= SUBR_BEGEND) THEN @@ -99,8 +102,7 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N ENDDO ENDDO -! Initialize WRITE_OGEL - + ! Initialize WRITE_OGEL DO I=1,NGRID WRITE_OGEL(I) = 'Y' ENDDO @@ -164,15 +166,18 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N ENDDO IF ((NUM == NREQ) .AND. (SC_OUT_REQ > 0)) THEN - !IF ((ACCE_OUT(1:4) == 'PLOT') .OR. (ACCE_OUT(1:4) == 'BOTH')) THEN + WRITE_F06 = (ACCE_OUT(1:1) == 'Y') + WRITE_OP2 = (ACCE_OUT(2:2) == 'Y') + WRITE_PCH = (ACCE_OUT(3:3) == 'Y') + IF (WRITE_OP2) THEN CALL WRITE_GRD_OP2_OUTPUTS ( JVEC, NUM, WHAT, ITABLE, NEW_RESULT ) - !ENDIF + ENDIF - IF ((ACCE_OUT(1:5) == 'PUNCH') .OR. (ACCE_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_PCH) THEN CALL WRITE_GRD_PCH_OUTPUTS ( JVEC, NUM, WHAT ) ENDIF - IF ((ACCE_OUT(1:5) == 'PRINT') .OR. (ACCE_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_F06) THEN CALL CHK_OGEL_ZEROS ( NUM ) CALL WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, ACCE_ALL_SAME_CID, WRITE_OGEL ) ENDIF @@ -249,15 +254,18 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N ENDDO IF ((NUM == NREQ) .AND. (SC_OUT_REQ > 0)) THEN - !IF ((DISP_OUT(1:4) == 'PLOT') .OR. (DISP_OUT(1:4) == 'BOTH')) THEN + WRITE_F06 = (DISP_OUT(1:1) == 'Y') + WRITE_OP2 = (DISP_OUT(2:2) == 'Y') + WRITE_PCH = (DISP_OUT(3:3) == 'Y') + IF (WRITE_OP2) THEN CALL WRITE_GRD_OP2_OUTPUTS ( JVEC, NUM, WHAT, ITABLE, NEW_RESULT ) - !ENDIF + ENDIF - IF ((DISP_OUT(1:5) == 'PUNCH') .OR. (DISP_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_PCH) THEN CALL WRITE_GRD_PCH_OUTPUTS ( JVEC, NUM, WHAT ) ENDIF - IF ((DISP_OUT(1:5) == 'PRINT') .OR. (DISP_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_F06) THEN CALL CHK_OGEL_ZEROS ( NUM ) CALL WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, DISP_ALL_SAME_CID, WRITE_OGEL ) ENDIF @@ -327,15 +335,18 @@ SUBROUTINE OFP1 ( JVEC, WHAT, SC_OUT_REQ, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, N ENDDO IF (NUM == NREQ) THEN - !IF ((OLOA_OUT(1:4) == 'PLOT') .OR. (OLOA_OUT(1:4) == 'BOTH')) THEN + WRITE_F06 = (OLOA_OUT(1:1) == 'Y') + WRITE_OP2 = (OLOA_OUT(2:2) == 'Y') + WRITE_PCH = (OLOA_OUT(3:3) == 'Y') + IF (WRITE_OP2) THEN CALL WRITE_GRD_OP2_OUTPUTS ( JVEC, NUM, WHAT, ITABLE, NEW_RESULT ) - !ENDIF + ENDIF - IF ((OLOA_OUT(1:5) == 'PUNCH') .OR. (OLOA_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_PCH) THEN CALL WRITE_GRD_PCH_OUTPUTS ( JVEC, NUM, WHAT ) ENDIF - IF ((OLOA_OUT(1:5) == 'PRINT') .OR. (OLOA_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_F06) THEN CALL CHK_OGEL_ZEROS ( NUM ) CALL WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, OLOAD_ALL_SAME_CID, WRITE_OGEL ) ENDIF diff --git a/Source/LK9/L92/OFP2.f90 b/Source/LK9/L92/OFP2.f90 index 7d2760d..1324e6c 100644 --- a/Source/LK9/L92/OFP2.f90 +++ b/Source/LK9/L92/OFP2.f90 @@ -26,7 +26,7 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4_GROW, ITABLE, NEW_RESULT ) -! Processes SPC and MPC force output requests for 1 subcase. + ! 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 @@ -60,6 +60,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 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) @@ -136,15 +137,13 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 ENDDO ENDDO -! Initialize WRITE_OGEL - + ! Initialize WRITE_OGEL DO I=1,NGRID WRITE_OGEL(I) = 'Y' ENDDO ! --------------------------------------------------------------------------------------------------------------------------------- -! Process SPC force requests - + ! Process SPC force requests NEW_RESULT = .TRUE. IF (WHAT == 'SPCF') THEN WRITE(ERR,9000) "OFP2 - SPC" @@ -296,16 +295,19 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 IF ((NUM == NREQ) .AND. (SC_OUT_REQ > 0)) THEN - !IF ((SPCF_OUT(1:4) == 'PLOT') .OR. (SPCF_OUT(1:4) == 'BOTH')) THEN + WRITE_F06 = (SPCF_OUT(1:1) == 'Y') + WRITE_OP2 = (SPCF_OUT(2:2) == 'Y') + WRITE_PCH = (SPCF_OUT(3:3) == 'Y') + IF (WRITE_OP2) THEN CALL WRITE_GRD_OP2_OUTPUTS ( JVEC, NUM, WHAT, ITABLE, NEW_RESULT ) NEW_RESULT = .FALSE. - !ENDIF + ENDIF - IF ((SPCF_OUT(1:5) == 'PUNCH') .OR. (SPCF_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_PCH) THEN CALL WRITE_GRD_PCH_OUTPUTS ( JVEC, NUM, WHAT ) ENDIF - IF ((SPCF_OUT(1:5) == 'PRINT') .OR. (SPCF_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_F06) THEN CALL CHK_OGEL_ZEROS ( NUM ) CALL WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, SPCF_ALL_SAME_CID, WRITE_OGEL ) ENDIF @@ -581,16 +583,19 @@ SUBROUTINE OFP2 ( JVEC, WHAT, SC_OUT_REQ, ZERO_GEN_STIFF, FEMAP_SET_ID, ITG, OT4 IF ((NUM == NREQ) .AND. (SC_OUT_REQ > 0)) THEN - !IF ((MPCF_OUT(1:4) == 'PLOT') .OR. (MPCF_OUT(1:4) == 'BOTH')) THEN + WRITE_F06 = (MPCF_OUT(1:1) == 'Y') + WRITE_OP2 = (MPCF_OUT(2:2) == 'Y') + WRITE_PCH = (MPCF_OUT(3:3) == 'Y') + IF (WRITE_OP2) THEN CALL WRITE_GRD_OP2_OUTPUTS ( JVEC, NUM, WHAT, ITABLE, NEW_RESULT ) NEW_RESULT = .FALSE. - !ENDIF + ENDIF - IF ((MPCF_OUT(1:5) == 'PUNCH') .OR. (MPCF_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_PCH) THEN CALL WRITE_GRD_PCH_OUTPUTS ( JVEC, NUM, WHAT ) ENDIF - IF ((MPCF_OUT(1:5) == 'PRINT') .OR. (MPCF_OUT(1:4) == 'BOTH')) THEN + IF (WRITE_F06) THEN CALL CHK_OGEL_ZEROS ( NUM ) CALL WRITE_GRD_PRT_OUTPUTS ( JVEC, NUM, WHAT, IHDR, MPCF_ALL_SAME_CID, WRITE_OGEL ) ENDIF diff --git a/Source/LK9/LINK9/LINK9.f90 b/Source/LK9/LINK9/LINK9.f90 index 4b3261f..d24456f 100644 --- a/Source/LK9/LINK9/LINK9.f90 +++ b/Source/LK9/LINK9/LINK9.f90 @@ -94,6 +94,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IMPLICIT NONE + LOGICAL :: WRITE_F06, WRITE_OP2, WRITE_PCH, WRITE_ANS ! flag LOGICAL :: LEXIST ! .TRUE. if a file exists LOGICAL :: LOPEN ! .TRUE. if a file is opened @@ -170,60 +171,57 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! ********************************************************************************************************************************** LINKNO = 9 -! Set time initializing parameters - + ! Set time initializing parameters CALL TIME_INIT -! Initialize WRT_BUG - + ! Initialize WRT_BUG DO I=0,MBUG-1 WRT_BUG(I) = 0 ENDDO -! Get date and time, write to screen + ! Get date and time, write to screen CALL OURDAT CALL OURTIM WRITE(SC1,152) LINKNO EPS1 = EPSIL(1) -! Make units for writing errors the screen until we open output files - + ! Make units for writing errors the screen until we open output files OUNT(1) = SC1 OUNT(2) = SC1 -! Make units for writing errors the error file and output file - + ! Make units for writing errors the error file and output file OUNT(1) = ERR OUNT(2) = F06 - IF (DEBUG(200) > 0) THEN + WRITE_F06 = (DISP_OUT(1:1) == 'Y') + WRITE_OP2 = (DISP_OUT(2:2) == 'Y') + WRITE_PCH = (DISP_OUT(3:3) == 'Y') + WRITE_ANS = (DEBUG(200) > 0) + 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 ((DISP_OUT(1:5) == 'PUNCH') .OR. (DISP_OUT(1:4) == 'BOTH')) THEN + 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' ) ENDIF ENDIF -! Write info to text files - + ! 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 - + ! Read LINK1A file CALL READ_L1A ( 'KEEP', 'Y' ) -! Check COMM for successful completion of prior LINKs - + ! Check COMM for successful completion of prior LINKs IF (RESTART == 'Y') THEN P_LINKNO = 1 ELSE @@ -236,8 +234,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL OUTA_HERE ( 'Y' ) ! Prior LINK's didn't complete, so quit ENDIF -! Before reading file data in subr LINK9S, deallocate all of those arrays and then allocate them fresh - + ! 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 @@ -284,15 +281,13 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL ALLOCATE_MODEL_STUF ( 'PPNT, PDATA, PTYPE', SUBR_NAME ) CALL ALLOCATE_MODEL_STUF ( 'PLOAD4_3D_DATA', SUBR_NAME ) -! Read LINK9S data - + ! Read LINK9S data CALL OURTIM MODNAM = 'READ MODEL DATA ARRAYS' WRITE(SC1,9092) LINKNO,MODNAM,HOUR,MINUTE,SEC,SFRAC CALL LINK9S -! Determine MAXREQ (max number of output requests) so we can allocate memory to arrays below - + ! Determine MAXREQ (max number of output requests) so we can allocate memory to arrays below CALL MAXREQ_OGEL CALL DEALLOCATE_MODEL_STUF ( 'ESORT2' ) !----------------------------------------------------------------------------------------------------------------------------------- @@ -339,10 +334,9 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF -! Read files with KSF, MSF, QSYS (used to calc SPC constraint forces, QS), but only if they will be needed. -! For any SOL_NAME they will be needed if any SPC constraint force output is requested or GP force balance or if POST /=0. -! For non CB they will be needed also if MEFFMASS, MPFACTOR are to be calculated (done via SPC force total method) - + ! Read files with KSF, MSF, QSYS (used to calc SPC constraint forces, QS), but only if they will be needed. + ! For any SOL_NAME they will be needed if any SPC constraint force output is requested or GP force balance or if POST /=0. + ! For non CB they will be needed also if MEFFMASS, MPFACTOR are to be calculated (done via SPC force total method) READ_SPCARRAYS = 'N' IF (SOL_NAME == 'GEN CB MODEL') THEN IF ((ANY_SPCF_OUTPUT > 0) .OR. (ANY_GPFO_OUTPUT > 0) .OR. (NDOFSA > 0) .OR. (POST /= 0)) THEN @@ -450,8 +444,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF -! Read MPC constraint matrices - + ! Read MPC constraint matrices IF ((ANY_MPCF_OUTPUT > 0) .OR. (ANY_GPFO_OUTPUT > 0) .OR. (POST /= 0)) THEN IF (NDOFM > 0) THEN @@ -496,8 +489,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF -! Read MGG mass matrix if this is a dynamics solution and GP force balance is requested - + ! 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 @@ -513,8 +505,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ENDIF -! Read MLL mass matrix if this is a dynamics solution and GP force balance is requested. - + ! 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 @@ -536,14 +527,12 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) !xx CALL FILE_OPEN ( F25, F25FIL, OUNT, 'REPLACE', F25_MSG, 'WRITE_STIME', 'UNFORMATTED', 'WRITE', 'REWIND', 'Y', 'N', 'Y' ) !xx ENDIF -! Open data files for reading displacements (will be read below in loop over number of subcases/vectors) - + ! 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' ) -! 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) -! EIGEN_VAL was not deallocated in LINK4 (see LINK4 comment 01/11/19) so we do not allocate it here anymore - + ! 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) + ! EIGEN_VAL was not deallocated in LINK4 (see LINK4 comment 01/11/19) so we do not allocate it here anymore ZERO_GEN_STIFF = 'N' IF ((SOL_NAME(1:5) == 'MODES') .OR. (SOL_NAME(1:12) == 'GEN CB MODEL')) THEN ! MODE_NUM is not used to det gen stiff but it is read in subr READ_L1M @@ -610,20 +599,16 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL ALLOCATE_COL_VEC ( 'PG_COL', NDOFG, SUBR_NAME ) !----------------------------------------------------------------------------------------------------------------------------------- -! Allocate arrays particular to LINK9 - + ! Allocate arrays particular to LINK9 CALL ALLOCATE_LINK9_STUF ( SUBR_NAME ) -! Initialize JTSUB which will become the col no in the elem thermal loads matrix corresponding to the subcases below. - + ! Initialize JTSUB which will become the col no in the elem thermal loads matrix corresponding to the subcases below. JTSUB = 0 -! Set NUM_SOLNS for use in loop (below) to get outputs for each subcase/solution vector and size. Also, allocate memory for -! CB OTM matrices (if CB soln) and open CB OTM output files (OU4(8) for grid related OTM's and OU4(9) for elem related OTM's) - + ! Set NUM_SOLNS for use in loop (below) to get outputs for each subcase/solution vector and size. Also, allocate memory for + ! CB OTM matrices (if CB soln) and open CB OTM output files (OU4(8) for grid related OTM's and OU4(9) for elem related OTM's) PROC_PG_OUTPUT = 'Y' IF ((SOL_NAME(1:7) == 'STATICS') .OR. (SOL_NAME(1:8) == 'NLSTATIC')) THEN - NUM_SOLNS = NSUB ELSE IF (SOL_NAME(1:8) == 'BUCKLING') THEN @@ -632,20 +617,17 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) NUM_SOLNS = 1 ELSE - NUM_SOLNS = NVEC PROC_PG_OUTPUT = 'N' ENDIF ELSE IF (SOL_NAME(1:5) == 'MODES') THEN - NUM_SOLNS = NVEC ELSE IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN - NUM_SOLNS = NUM_CB_DOFS - ! These will be allocated with zero size if no output ie requested + ! These will be allocated with zero size if no output ie requested CALL ALLOCATE_CB_GRD_OTM ( 'OTM_ACCE' ) CALL ALLOCATE_CB_GRD_OTM ( 'OTM_DISP' ) CALL ALLOCATE_CB_GRD_OTM ( 'OTM_MPCF' ) @@ -655,7 +637,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL ALLOCATE_CB_ELM_OTM ( 'OTM_STRE' ) CALL ALLOCATE_CB_ELM_OTM ( 'OTM_STRN' ) - IUE = 0 ! Get index for file unit nos for elem/grid related OTM unformatted files + ! Get index for file unit nos for elem/grid related OTM unformatted files + IUE = 0 IUG = 0 DO I=1,MOU4 IF (OU4(I) == OU4_ELM_OTM) IUE = I @@ -671,7 +654,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL FILE_OPEN (OU4(IUG),OU4FIL(IUG),OUNT,'REPLACE', OU4_MSG(IUG),'NEITHER','UNFORMATTED','WRITE','REWIND','Y','N', 'Y') ENDIF - ITE = 0 ! Get index for file unit nos for elem/grid related OTM text files + ! Get index for file unit nos for elem/grid related OTM text files + ITE = 0 ITG = 0 OT4_EROW = 0 OT4_GROW = 0 @@ -679,7 +663,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) IF (OT4(I) == OT4_ELM_OTM) ITE = I IF (OT4(I) == OT4_GRD_OTM) ITG = I ENDDO - IF ((ITE <= 0) .OR. (ITG <= 0)) THEN ! Open files for OTM text data to describe the unformatted files above + IF ((ITE <= 0) .OR. (ITG <= 0)) THEN + ! Open files for OTM text data to describe the unformatted files above WRITE(ERR,9901) SUBR_NAME, ITE, ITG, MOT4 WRITE(F06,9901) SUBR_NAME, ITE, ITG, MOT4 FATAL_ERR = FATAL_ERR + 1 @@ -753,7 +738,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) JTSUB = JTSUB + 1 ENDIF ENDIF - ! Det if GP related outputs were requested in Case Control for this S/C + + ! Det if GP related outputs were requested in Case Control for this S/C SC_ACCE_OUTPUT = IAND(OGROUT(INT_SC_NUM),IBIT(GROUT_ACCE_BIT)) SC_DISP_OUTPUT = IAND(OGROUT(INT_SC_NUM),IBIT(GROUT_DISP_BIT)) SC_OLOA_OUTPUT = IAND(OGROUT(INT_SC_NUM),IBIT(GROUT_OLOA_BIT)) @@ -788,8 +774,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) UG_COL(I) = UGV ENDDO -! If this is a CB soln and JVEC <= NDOFR+NVEC, formulate a col of PHIXG from data in file L5B. Otherwise zero - + ! If this is a CB soln and JVEC <= NDOFR+NVEC, formulate a col of PHIXG from data in file L5B. Otherwise zero IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN CALL ALLOCATE_COL_VEC ( 'PHIXG_COL', NDOFG, SUBR_NAME ) IF (JVEC <= NDOFR+NVEC) THEN @@ -809,9 +794,9 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ENDIF -! Process acceleration output requests - ! 10/01/14: Need BGRID for Femap displs to transform from global to basic - CALL ALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS', SUBR_NAME ) + ! Process acceleration output requests + ! 10/01/14: Need BGRID for Femap displs to transform from global to basic + CALL ALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS', SUBR_NAME ) NEW_RESULT = .TRUE. ITABLE = -1 @@ -831,8 +816,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ENDIF -! Process displacement output requests - + ! Process displacement output requests IF ((SC_DISP_OUTPUT > 0) .OR. (POST /= 0)) THEN CALL OURTIM MODNAM = 'PROCESS DISPL OUTPUT REQUESTS, "' @@ -842,7 +826,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF !CALL END_OP2_TABLE(ITABLE) -! Process applied load (OPG1) output requests + ! Process applied load (OPG1) output requests NEW_RESULT = .TRUE. ITABLE = -1 IF (PROC_PG_OUTPUT == 'Y') THEN @@ -859,9 +843,8 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF !CALL END_OP2_TABLE(ITABLE) -! Calc SPC forces and process SPC force output requests, if there are any or if GP force balance, modal effective mass and/or -! participation factor output is requested. Calc anyway if there are any DOF's in the SA (AUTOSPC) set - + ! Calc SPC forces and process SPC force output requests, if there are any or if GP force balance, modal effective mass and/or + ! participation factor output is requested. Calc anyway if there are any DOF's in the SA (AUTOSPC) set NEW_RESULT = .TRUE. ITABLE = -1 IF (SOL_NAME(1:5) == 'MODES') THEN @@ -902,8 +885,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ! NEW_RESULT = .FALSE. ENDIF -! Process MPC force output requests, if there are any - + ! Process MPC force output requests, if there are any NEW_RESULT = .TRUE. IF (NDOFM > 0) THEN @@ -929,8 +911,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF !CALL END_OP2_TABLE(ITABLE) -! Process grid point force balance requests - + ! Process grid point force balance requests !zzzz CALL ALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS', SUBR_NAME ) ! 10/01/14: Move to above CALL OFP1. Need for Femap disp NEW_RESULT = .TRUE. IF (SC_GPFO_OUTPUT > 0) THEN @@ -992,8 +973,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL DEALLOCATE_COL_VEC ( 'QGm_COL' ) WRITE(SC1,*) CR13 -! Process element force/stress output requests - + ! Process element force/stress output requests SC_ELFE_OUTPUT = IAND(OELOUT(INT_SC_NUM),IBIT(ELOUT_ELFE_BIT)) SC_ELFN_OUTPUT = IAND(OELOUT(INT_SC_NUM),IBIT(ELOUT_ELFN_BIT)) SC_STRE_OUTPUT = IAND(OELOUT(INT_SC_NUM),IBIT(ELOUT_STRE_BIT)) @@ -1027,8 +1007,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF CALL DEALLOCATE_MODEL_STUF ( 'SINGLE ELEMENT ARRAYS' ) -! Rewind files containing G-set & S-set loads and read STIME so we can read loads file again for next subcase - + ! Rewind files containing G-set & S-set loads and read STIME so we can read loads file again for next subcase INQUIRE ( FILE=LINK1E, EXIST=LEXIST, OPENED=LOPEN ) IF (LOPEN) THEN REWIND (L1E) @@ -1069,8 +1048,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL DEALLOCATE_COL_VEC ( 'PG_COL' ) !----------------------------------------------------------------------------------------------------------------------------------- -! Write ACCE, DISP, MPCF and SPCF OTM's to OUTPUT4 file. Also write text file descriptions of the rows of the OTM's. - + ! Write ACCE, DISP, MPCF and SPCF OTM's to OUTPUT4 file. Also write text file descriptions of the rows of the OTM's. IF (SOL_NAME(1:12) == 'GEN CB MODEL') THEN WRITE(F06,*) @@ -1188,8 +1166,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF -! Close OTM text files (unformatted OU4 files closed in subr CLOSE_LIJFILES) - + ! 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' ) @@ -1213,8 +1190,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL WRITE_MEFFMASS ENDIF -! Call OUTPUT4 processor to process output requests for OUTPUT4 matrices generated in this link - + ! 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 ' @@ -1223,8 +1199,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL OUTPUT4_PROC ( SUBR_NAME ) ENDIF -! Deallocate MPFACTOR, MEFFMASS - + ! Deallocate MPFACTOR, MEFFMASS CALL DEALLOCATE_EIGEN1_MAT ( 'MPFACTOR_N6' ) CALL DEALLOCATE_EIGEN1_MAT ( 'MPFACTOR_NR' ) CALL DEALLOCATE_EIGEN1_MAT ( 'MEFFMASS' ) @@ -1352,8 +1327,7 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) CALL FILE_CLOSE ( F25, F25FIL, 'DELETE', 'Y' ) ENDIF -! Check allocation status of allocatable arrays, if requested - + ! Check allocation status of allocatable arrays, if requested IF (DEBUG(100) > 0) THEN CALL CHK_ARRAY_ALLOC_STAT IF (DEBUG(100) > 1) THEN @@ -1361,24 +1335,21 @@ SUBROUTINE LINK9 ( LK9_PROC_NUM ) ENDIF ENDIF -! Write LINK9 end to F04, F06 - + ! Write LINK9 end to F04, 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 - + ! Close ANS but leave the closing of BUG, ERR, F04, F06 files until after LINK9 returns to MYSTRAN.for IF (DEBUG(200) > 0) THEN CALL FILE_CLOSE ( ANS, ANSFIL, 'KEEP', 'Y' ) ELSE CALL FILE_CLOSE ( ANS, ANSFIL, 'DELETE', 'Y' ) ENDIF -! Close some files - + ! 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' ) ELSE diff --git a/Source/Modules/CC_OUTPUT_DESCRIBERS.f90 b/Source/Modules/CC_OUTPUT_DESCRIBERS.f90 index e757a65..59dbc10 100644 --- a/Source/Modules/CC_OUTPUT_DESCRIBERS.f90 +++ b/Source/Modules/CC_OUTPUT_DESCRIBERS.f90 @@ -40,40 +40,40 @@ MODULE CC_OUTPUT_DESCRIBERS ! Case Control, warning messages are written to the MYSTRAN output file. CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: ACCE_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: ACCE_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: ACCE_OUT = 'YNNNN ' ! print, plot, punch, neu, csv CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: ACCE_MAG = 'MAG ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: DISP_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: DISP_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: DISP_OUT = 'YNNNN ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: DISP_MAG = 'MAG ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: GPFO_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: GPFO_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: GPFO_OUT = 'YNNNN ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: MPCF_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: MPCF_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: MPCF_OUT = 'YNNNN ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: MPCF_MAG = 'MAG ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: OLOA_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: OLOA_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: OLOA_OUT = 'YNNNN ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: OLOA_MAG = 'MAG ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: SPCF_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: SPCF_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: SPCF_OUT = 'YNNNN ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: SPCF_MAG = 'MAG ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: FORC_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: FORC_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: FORC_OUT = 'YNNNN ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: FORC_MAG = 'MAG ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRN_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRN_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRN_OUT = 'YNNNN ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRN_MAG = 'MAG ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRN_OPT = 'VONMISES' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRN_LOC = 'CENTER ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRE_SORT = 'SORT1 ' - CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRE_OUT = 'PRINT ' + CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRE_OUT = 'YNNNN ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRE_MAG = 'MAG ' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRE_OPT = 'VONMISES' CHARACTER(LEN(CC_CMD_DESCRIBERS)) :: STRE_LOC = 'CENTER ' diff --git a/Source/Modules/MYSTRAN_Version.f90 b/Source/Modules/MYSTRAN_Version.f90 index 1bc52be..5d62130 100644 --- a/Source/Modules/MYSTRAN_Version.f90 +++ b/Source/Modules/MYSTRAN_Version.f90 @@ -2,7 +2,7 @@ ! Begin MIT license text. ! _______________________________________________________________________________________________________ -! Copyright 2022 Dr William R Case, Jr (mystransolver@gmail.com) +! Copyright 2023 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 @@ -35,10 +35,10 @@ MODULE MYSTRAN_Version SAVE CHARACTER(256*BYTE) :: MYSTRAN_COMMENT = '*** Please report any problems to mystransolver@gmail.com ***' - CHARACTER( 8*BYTE), PARAMETER :: MYSTRAN_VER_NUM = '14.01' - CHARACTER( 3*BYTE), PARAMETER :: MYSTRAN_VER_MONTH= 'Sep' - CHARACTER( 2*BYTE), PARAMETER :: MYSTRAN_VER_DAY = '19' - CHARACTER( 4*BYTE), PARAMETER :: MYSTRAN_VER_YEAR = '2022' + CHARACTER( 8*BYTE), PARAMETER :: MYSTRAN_VER_NUM = '14.02' + CHARACTER( 3*BYTE), PARAMETER :: MYSTRAN_VER_MONTH= 'July' + CHARACTER( 2*BYTE), PARAMETER :: MYSTRAN_VER_DAY = '17' + CHARACTER( 4*BYTE), PARAMETER :: MYSTRAN_VER_YEAR = '2023' CHARACTER( 33*BYTE), PARAMETER :: MYSTRAN_AUTHOR = 'MYSTRAN developed by Dr Bill Case' END MODULE MYSTRAN_Version diff --git a/Source/UTIL/FILE_OPEN.f90 b/Source/UTIL/FILE_OPEN.f90 index 58045d3..c723de6 100644 --- a/Source/UTIL/FILE_OPEN.f90 +++ b/Source/UTIL/FILE_OPEN.f90 @@ -26,11 +26,74 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTION, POSITION, WRITE_L1A, WRITE_VER, WRITE_F04) -! 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: -! (1) called 1st time for READ (to open file and to read and check STIME) -! (2) called 2nd time (after closing by calling subr) to position at end for subsequent writing after returning - + ! 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: + ! (1) called 1st time for READ (to open file and to read and check STIME) + ! (2) called 2nd time (after closing by calling subr) to position at end for subsequent writing after returning + ! + ! Parameters + ! ---------- + ! UNIT : int + ! the file number to open + ! FILNAM : str + ! the filename to open + ! OUNT : tuple[int, int] + ! I think this is Bill's black magic for handling fortran files... + ! STATUS : str8 + ! not checked.... + ! 'NEW': creates a new file + ! 'OLD': opens an existing file + ! 'REPLACE' : If the file doesn't exist, it creates it. If it does exist, then it replaces it. + ! 'UNKNOWN' : ??? + ! MESSAG : str + ! used for error messages + ! RW_STIME : ??? + ! 'READ_STIME' : read the stime? + ! 'WRITE_STIME' : write the stime? + ! 'NEITHER' : skip this + ! FORMAT : str + ! 'FORMATTED' : for ASCII files + ! 'UNFORMATTED' : for binary files that have records + ! 'BINARY' : binary files, but you get to handle everything; no ACCESS or RECL + ! 'SYSTEM' : ???; no ACCESS or RECL + ! Opening a file with FORM='BINARY' has roughly the same effect as FORM='UNFORMATTED', except + ! that no record lengths are embedded in the file. Without this data, there is no way to tell + ! where one record begins, or ends. Thus, it is impossible to BACKSPACE a FORM='BINARY' file, + ! because there is no way of telling where to backspace to. A READ on a 'BINARY' file will read + ! as much data as needed to fill the variables on the input list. + ! ACTION : str8 + ! 'READ' : open the file for reading + ! 'WRITE': open the file for writing + ! 'READWRITE': ??? + ! POSITION : str8 + ! 'ASIS' : ??? + ! 'APPEND' : open the file in append mode + ! 'REWIND' : start from the beginning of the file + ! RW_STIME : ??? + ! ??? + ! WRITE_L1A : str1 + ! Y/N : write to L1A??? + ! WRITE_VER : str1 + ! Y/N : write to VER??? + ! WRITE_F04 : str1 + ! Y/N : write to F04 + ! + ! Unused + ! ------- + ! ACCESS : str + ! 'SEQUENTIAL' : ???; FILE_OPEN always uses this + ! 'DIRECT' : ??? + ! 'STREAM' : ??? + ! DIRECT="NO" + ! RECL : int / None + ! this is not modifyable per block; record_length + ! int : the size of the record length; if you go over the size, it'll 0-pad + ! None: automatic + ! + ! Examples + ! -------- + ! FILE_OPEN ( OP2, OP2FIL, OUNT,'OLD ', OP2_MSG,'NEITHER','UNFORMATTED','WRITE','REWIND','N','N','Y') + ! USE PENTIUM_II_KIND, ONLY : BYTE, LONG, DOUBLE USE IOUNT1, ONLY : ANS, F04, F06, IN1, SC1, WRT_ERR, WRT_LOG USE SCONTR, ONLY : BLNK_SUB_NAM, FATAL_ERR, PROG_NAME @@ -52,7 +115,7 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI CHARACTER(LEN=*), INTENT(IN) :: FILNAM ! File name CHARACTER(LEN=*), INTENT(IN) :: FORMAT ! File format CHARACTER(LEN=*), INTENT(IN) :: MESSAG ! File description - CHARACTER(LEN=*), INTENT(IN) :: POSITION ! File description + 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) @@ -66,7 +129,7 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI 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), 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 @@ -78,13 +141,13 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI ! ********************************************************************************************************************************** IF (WRT_LOG >= SUBR_BEGEND) THEN CALL OURTIM - INQUIRE(FILE=FILNAM,OPENED=FILE_OPND) + 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) + INQUIRE(FILE=FILNAM, EXIST=FILE_EXIST) NAM_STA(1:) = STATUS NAM_FOR(1:) = FORMAT NAM_ACT(1:) = ACTION @@ -96,22 +159,23 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI ENDIF ! ********************************************************************************************************************************** -! Check inputs for sensibility (coding errors if wrong) - + ! Check inputs for sensibility (coding errors if wrong) IERR = 0 - ! Check FORM - IF ((FORMAT /= 'FORMATTED') .AND. (FORMAT /= 'UNFORMATTED'))THEN + + ! Check FORM + IF ((FORMAT /= 'FORMATTED') .AND. (FORMAT /= 'UNFORMATTED') .AND. (FORMAT /= 'BINARY'))THEN IERR = IERR + 1 DO I=1,2 IF (OUNT(I) > 0) THEN - WRITE(OUNT(I),909) SUBR_NAME, 'FORMAT', 'FORMATTED or UNFORMATTED', FORMAT + WRITE(OUNT(I),909) SUBR_NAME, 'FORMAT', 'FORMATTED, UNFORMATTED or BINARY', FORMAT ELSE - WRITE(SC1,909) SUBR_NAME, 'FORMAT', 'FORMATTED or UNFORMATTED', FORMAT + WRITE(SC1,909) SUBR_NAME, 'FORMAT', 'FORMATTED, UNFORMATTED or BINARY', FORMAT ENDIF IF (OUNT(2) == OUNT(1)) EXIT ENDDO ENDIF - ! Ckeck ACTION + + ! Check ACTION IF ((ACTION /= 'READ') .AND. (ACTION /= 'WRITE') .AND. (ACTION /= 'READWRITE')) THEN IERR = IERR + 1 DO I=1,2 @@ -123,7 +187,8 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI IF (OUNT(2) == OUNT(1)) EXIT ENDDO ENDIF - ! Check POSITION + + ! Check POSITION IF ((POSITION /= 'ASIS') .AND. (POSITION /= 'APPEND') .AND. (POSITION /= 'REWIND')) THEN IERR = IERR + 1 DO I=1,2 @@ -135,7 +200,8 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI IF (OUNT(2) == OUNT(1)) EXIT ENDDO ENDIF - ! Check STATUS + + ! Check STATUS ! IF ((STATUS /= 'NEW') .AND.(STATUS /= 'OLD') .AND.(STATUS /= 'REPLACE')) THEN ! IERR = IERR + 1 ! DO I=1,2 @@ -147,7 +213,8 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI ! IF (OUNT(2) == OUNT(1)) EXIT ! ENDDO ! ENDIF - ! Check WRITE_L1A + + ! Check WRITE_L1A IF ((WRITE_L1A /= 'Y') .AND. (WRITE_L1A /= 'N'))THEN IERR = IERR + 1 DO I=1,2 @@ -159,7 +226,8 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI IF (OUNT(2) == OUNT(1)) EXIT ENDDO ENDIF - ! Check WRITE_STIME + + ! Check WRITE_STIME IF ((RW_STIME /= 'READ_STIME') .AND. (RW_STIME /= 'WRITE_STIME') .AND. (RW_STIME /= 'NEITHER'))THEN IERR = IERR + 1 DO I=1,2 @@ -193,8 +261,7 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI ENDIF ENDIF -! No problems with inputs, so proceed to open file - + ! No problems with inputs, so proceed to open file IERR = 0 OPEN ( UNIT, FILE=FILNAM, STATUS=STATUS, FORM=FORMAT, ACCESS='SEQUENTIAL', ACTION=ACTION, POSITION=POSITION, IOSTAT=IOCHK ) @@ -219,7 +286,7 @@ SUBROUTINE FILE_OPEN (UNIT, FILNAM, OUNT, STATUS, MESSAG, RW_STIME, FORMAT, ACTI IERR = IERR +1 ENDIF ENDIF - ELSE IF (RW_STIME == 'WRITE_STIME') THEN ! Write STIME + ELSE IF (RW_STIME == 'WRITE_STIME') THEN ! Write STIME IF (FORMAT == 'FORMATTED') THEN WRITE(UNIT,'(1X,I11)') STIME ELSE diff --git a/Source/UTIL/OUTPUT2_UTILS.f90 b/Source/UTIL/OUTPUT2_UTILS.f90 index 6971182..3cbd8e6 100644 --- a/Source/UTIL/OUTPUT2_UTILS.f90 +++ b/Source/UTIL/OUTPUT2_UTILS.f90 @@ -4,8 +4,8 @@ SUBROUTINE WRITE_OP2_HEADER(POST) USE IOUNT1, ONLY : OP2 integer, intent(in) :: POST - character(len=28) :: TAPE_CODE - character(len=8) :: NASTRAN_VERSION + character(len=28) :: TAPE_CODE + character(len=8) :: NASTRAN_VERSION IF (POST == -1) THEN !_write_markers(op2, op2_ascii, [3, 0, 7]) WRITE(OP2) 3 diff --git a/Source/UTIL/OUTPUT2_WRITE_TABLE.f90 b/Source/UTIL/OUTPUT2_WRITE_TABLE.f90 index aa210d3..4c7f461 100644 --- a/Source/UTIL/OUTPUT2_WRITE_TABLE.f90 +++ b/Source/UTIL/OUTPUT2_WRITE_TABLE.f90 @@ -39,6 +39,7 @@ SUBROUTINE WRITE_OUG3_EIGN(ITABLE, ISUBCASE, DEVICE_CODE, ANALYSIS_CODE, TABLE_C LOGICAL, INTENT(INOUT) :: NEW_RESULT INTEGER(LONG) :: FORMAT_CODE INTEGER(LONG) :: NUM_WIDE + INTEGER(LONG) :: NINT = 4 INTEGER(LONG), INTENT(IN) :: MODE ! field 5 REAL(DOUBLE), INTENT(IN) :: EIGENVALUE ! field 6 @@ -79,6 +80,7 @@ SUBROUTINE WRITE_OUG3(ITABLE, ISUBCASE, FORMAT_CODE, DEVICE_CODE, ANALYSIS_CODE, INTEGER(LONG) :: THERMAL, SORT_CODE, & RANDOM_CODE, ACOUSTIC_FLAG, OCODE, & APPROACH_CODE, TCODE + INTEGER(LONG) :: NINT = 4 TITLE2 = TITLE(1:100) SUBTITLE2 = SUBTITLE(1:67)