MODULE SELECT_SOURCE ! Use Select_Source ! copyright 2005, J. E. Akin, all rights reserved. ! Begin select_source_lib.f ! NOTE: This is a set of programs that validate previously developed ! applications. It uses the data input EXAMPLE as an integer code ! to select the desired source groups. To reduce the executable ! file size one may want to comment out much of the SELECT CASE ! segment. ! The EXAMPLE source files selected here are stored in the library ! named demo_select_lib.f (unless it is a CASE DEFAULT result). IMPLICIT NONE INTEGER, PARAMETER :: nnn = -1 ! a dummy example source number INTEGER, PARAMETER :: ccc = -1 ! a dummy exact case number CONTAINS ! The functionality SUBROUTINE SELECT_DESCRIBE_EXAMPLE ! .............................................................. ! LIST DESCRIPTION OF CANNED SOURCE EXAMPLES ! .............................................................. Use System_Constants ! For EXAMPLE IMPLICIT NONE PRINT *,' ' SELECT CASE (EXAMPLE) CASE (101) ; CALL DESCRIBE_EXAMPLE_101 ! Conduct convect CASE (102) ; CALL DESCRIBE_EXAMPLE_102 ! Slider bearing CASE (103) ; CALL DESCRIBE_EXAMPLE_103 ! Y'+2Y=10, Y(0) = 0 CASE (104) ; CALL DESCRIBE_EXAMPLE_104 ! u" + u + x = 0 CASE (105) ; CALL DESCRIBE_EXAMPLE_105 ! u" + Q(x) = 0 CASE (106) ; CALL DESCRIBE_EXAMPLE_106 ! u" + f_1 u' + f_2 u = f_3 CASE (107) ; CALL DESCRIBE_EXAMPLE_107 ! LS: u" +f_1 u' +f_2 u =f_3 CASE (108) ; CALL DESCRIBE_EXAMPLE_108 ! K*A U,xx-H*P(U-U_ext)-Q_e=0 CASE (109) ; CALL DESCRIBE_EXAMPLE_109 ! 1/R * d[R K_RR dT/dR]/dR+Q=0 CASE (110) ; CALL DESCRIBE_EXAMPLE_110 ! Cylindrical Stress Analysis CASE (111) ; CALL DESCRIBE_EXAMPLE_111 ! DC Resistance Network CASE (112) ; CALL DESCRIBE_EXAMPLE_112 ! SUPG u*p'-k*p''=Q CASE (113) ; CALL DESCRIBE_EXAMPLE_113 ! Elastic bar thermal loads CASE (114) ; CALL DESCRIBE_EXAMPLE_114 ! Heat and Mass Transfer 1D CASE (121) ; CALL DESCRIBE_EXAMPLE_121 ! K U,xx - R U,t = 0 via iter CASE (122) ; CALL DESCRIBE_EXAMPLE_122 ! K U,xx - R U,t = 0 transient CASE (123) ; CALL DESCRIBE_EXAMPLE_123 ! 122 plus line convection CASE (125) ; CALL DESCRIBE_EXAMPLE_125 ! Beam on elastic foundation CASE (136) ; CALL DESCRIBE_EXAMPLE_136 ! Dynamic_Eigen_Static_L2_bar CASE (137) ; CALL DESCRIBE_EXAMPLE_137 ! Dyn_Eigen_Static_bar_by_GQ CASE (201) ; CALL DESCRIBE_EXAMPLE_201 ! Plane_Stress CASE (202) ; CALL DESCRIBE_EXAMPLE_202 ! Poisson_Eq_anisotropic CASE (203) ; CALL DESCRIBE_EXAMPLE_203 ! Plane Frame CASE (204) ; CALL DESCRIBE_EXAMPLE_204 ! Poisson_Eq_T3_only CASE (205) ; CALL DESCRIBE_EXAMPLE_205 ! Torsion_Stress_Function CASE (206) ; CALL DESCRIBE_EXAMPLE_206 ! Plane Truss CASE (207) ; CALL DESCRIBE_EXAMPLE_207 ! Plane Truss energy method CASE (208) ; CALL DESCRIBE_EXAMPLE_208 ! Axisymmetric General Poisson CASE (209) ; CALL DESCRIBE_EXAMPLE_209 ! General Poisson CASE (210) ; CALL DESCRIBE_EXAMPLE_210 ! Plane stress CST hard-coded CASE (211) ; CALL DESCRIBE_EXAMPLE_211 ! Advective diffusion, E const CASE (212) ; CALL DESCRIBE_EXAMPLE_212 ! Advective diffusion, E var CASE (213) ; CALL DESCRIBE_EXAMPLE_213 ! Advective diffusion, E var CASE (214) ; CALL DESCRIBE_EXAMPLE_214 ! Advective diffusion, E var CASE (215) ; CALL DESCRIBE_EXAMPLE_215 ! Plain strain (w mass matrix) CASE (301) ; CALL DESCRIBE_EXAMPLE_301 ! Space Frame CASE (302) ; CALL DESCRIBE_EXAMPLE_302 ! General Poisson, subset of 209 CASE (303) ; CALL DESCRIBE_EXAMPLE_303 ! Solid stress analysis, no mass CASE DEFAULT PRINT *,'NOTE: NO COMPILATION FOR EXAMPLE NUMBER ', EXAMPLE PRINT *,'SEE EXAMPLE LIBRARY FOR SOURCE, DATA & RESULTS' PRINT *,'AND PLACE SOURCE IN my_el_sq_inc, etc AND RUN MAKE' END SELECT PRINT *,' ' END SUBROUTINE SELECT_DESCRIBE_EXAMPLE SUBROUTINE SELECT_DESCRIBE_EXACT_CASE ! .............................................................. ! LIST DESCRIPTION OF CANNED SOURCE EXACTS ! .............................................................. Use System_Constants ! For EXAMPLE, EXACT_CASE IMPLICIT NONE ! PRINT *,' ' ! SELECT CASE (EXACT_CASE) ! CASE (ccc) ; CALL DESCRIBE_EXACT_ccc ! CASE (1 ) ; CALL DESCRIBE_EXACT_1 ! CASE DEFAULT PRINT *,'NOTE: NO DESCRIPTION FOR EXACT CASE ', EXACT_CASE ! END SELECT ! PRINT *,' ' END SUBROUTINE SELECT_DESCRIBE_EXACT_CASE SUBROUTINE SELECT_ELEM_SQ_MATRIX (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, X) !for space frame !b L_PT_PROP, IE) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GENERATE ELEMENT SQUARE MATRIX, OPTIONAL COLUMN MATRIX ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Geometric_Properties Use Elem_Type_Data Use Sys_Properties_Data Use Interface_Header IMPLICIT NONE INTEGER, INTENT(IN) :: IE REAL(DP), INTENT(INOUT) :: E (N_R_B, N_R_B) REAL(DP), INTENT(INOUT) :: H_INTG (LT_N) !b make optional !uu REAL(DP), INTENT(IN) :: X (MAX_NP, N_SPACE) ! Global coordinates ! OPTIONAL PROPERTY VALUES REAL(DP), INTENT(IN) :: PRT_L_PT (LT_N, N_NP_FLO), PRT_MAT (MISC_FL) INTEGER, INTENT(IN) :: L_PT_PROP (N_NP_FIX) LOGICAL, SAVE :: WARN = .TRUE. ! VARIABLES: See file Notation.F ! .............................................................. ! *** ELEM_SQ_MATRIX PROBLEM DEPENDENT STATEMENTS FOLLOW *** ! .............................................................. SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL ELEM_SQ_EX_nnn ! IF (NUL_COL ==0 ) CALL ELEM_COL_EX_nnn CASE (101) ; CALL ELEM_SQ_EX_101 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (102) ; CALL ELEM_SQ_EX_102 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (103) ; CALL ELEM_SQ_EX_103 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (104) ; CALL ELEM_SQ_EX_104 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (105) ; CALL ELEM_SQ_EX_105 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (106) ; CALL ELEM_SQ_EX_106 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (107) ; CALL ELEM_SQ_EX_107 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (108) ; CALL ELEM_SQ_EX_108 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (109) ; CALL ELEM_SQ_EX_109 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (110) ; CALL ELEM_SQ_EX_110 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (111) ; CALL ELEM_SQ_EX_111 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (112) ; CALL ELEM_SQ_EX_112 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, X) ! for Pe_sys !b L_PT_PROP, IE) CASE (113) ; CALL ELEM_SQ_EX_113 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (114) ; CALL ELEM_SQ_EX_114 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (121) ; CALL ELEM_SQ_EX_121 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (122) ; CALL ELEM_SQ_EX_122 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (123) ; CALL ELEM_SQ_EX_123 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (125) ; CALL ELEM_SQ_EX_125 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (136) ; CALL ELEM_SQ_EX_136 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (137) ; CALL ELEM_SQ_EX_137 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (201) ; CALL ELEM_SQ_EX_201 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (202) ; CALL ELEM_SQ_EX_202 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (203) ; CALL ELEM_SQ_EX_203 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (204) ; CALL ELEM_SQ_EX_204 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (205) ; CALL ELEM_SQ_EX_205 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (206) ; CALL ELEM_SQ_EX_206 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (207) ; CALL ELEM_SQ_EX_207 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) ! CASE (208) is 209 with keyword axisymmetric CASE (208:209, 302) CALL ELEM_SQ_EX_209 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (210) ; CALL ELEM_SQ_EX_210 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (211) ; CALL ELEM_SQ_EX_211 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (212) ; CALL ELEM_SQ_EX_212 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (213) ; CALL ELEM_SQ_EX_213 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (214) ; CALL ELEM_SQ_EX_214 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (215) ; CALL ELEM_SQ_EX_215 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (301) ; CALL ELEM_SQ_EX_301 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, X) ! for ref node !b L_PT_PROP, IE) ! 302 is subset of 209 CASE (303) ; CALL ELEM_SQ_EX_303 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_el_sq_inc.', & ' WAS application_lib.f RECOMPILED ?' IF (NUL_COL == 0) PRINT *,'ALSO my_el_col_inc' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL ELEM_SQ_MATRIX (E, H_INTG, PRT_L_PT, PRT_MAT, L_PT_PROP, & IE, X) !b IE) IF (NUL_COL == 0) CALL ELEM_COL_MATRIX (E, H_INTG, PRT_L_PT, & PRT_MAT, L_PT_PROP, IE) END SELECT if ( DEBUG_EL_COL .and. IE <= 3 ) call rprint (c, 1, lt_free,1) !b if ( DEBUG_EL_SQ .and. IE <= 3 ) call rprint (s, lt_free, lt_free,1) !b END SUBROUTINE SELECT_ELEM_SQ_MATRIX SUBROUTINE SELECT_MIXED_SQ_MATRIX (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GENERATE MIXED_BC SQUARE MATRIX, OPTIONAL COLUMN MATRIX ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Geometric_Properties Use Elem_Type_Data ! for: Use Sys_Properties_Data ! for FLT_MISC, MISC_FIX Use Interface_Header ! for functions IMPLICIT NONE INTEGER, INTENT(IN) :: IE ! OPTIONAL PROPERTY VALUES REAL(DP), INTENT(INOUT) :: E (N_R_B, N_R_B), H_INTG (LT_N) REAL(DP), INTENT(IN) :: PRT_L_PT (LT_N, N_NP_FLO), PRT_MAT (MISC_FL) INTEGER, INTENT(IN) :: L_PT_PROP (N_NP_FIX) LOGICAL, SAVE :: WARN = .TRUE. ! .............................................................. ! *** MIXED_SQ_MATRIX PROBLEM DEPENDENT STATEMENTS FOLLOW *** ! .............................................................. SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL MIXED_SQ_EX_nnn CASE (101:105) ; RETURN ! CASE (102) ; RETURN ! CASE (103) ; RETURN ! CASE (104) ; RETURN ! CASE (105) ; RETURN CASE (106) CALL MIXED_SQ_EX_106 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (107) ; RETURN CASE (112, 113,114) ; RETURN CASE (121,122,123,125,136,137) ; RETURN CASE (201) ; RETURN CASE (202) CALL MIXED_SQ_EX_202 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (203) ; RETURN CASE (204) CALL MIXED_SQ_EX_204 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (205) ; RETURN CASE (206) ; RETURN CASE (207) ; RETURN ! CASE (208) is 209 with keyword axisymmetric CASE (208:209, 302) CALL MIXED_SQ_EX_209 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (210) ; RETURN CASE (211) ; RETURN CASE (212) ; RETURN CASE (213) ; RETURN CASE (214) ! a transient extension of 209 CALL MIXED_SQ_EX_214 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE) CASE (215) ; RETURN CASE (301) ; RETURN ! 302 is a subset of 209 CASE (303) ; RETURN ! no MIXED_SQ_EX_ CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_mixed_bc_inc.', & ' WAS application_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL MIXED_SQ_MATRIX (E, H_INTG, PRT_L_PT, & PRT_MAT, L_PT_PROP, IE) END SELECT END SUBROUTINE SELECT_MIXED_SQ_MATRIX SUBROUTINE SELECT_EXACT_ROBIN_DATA (XYZ, ROBIN_1, ROBIN_2) ! .............................................................. ! Mixed or Robin boundary condition, Standard form: ! K_n * U,n + ROBIN_1 * U + ROBIN_2 = 0 ! .............................................................. Use System_Constants ! For EXAMPLE Use Geometric_Properties Use Elem_Type_Data ! for: Use Sys_Properties_Data ! for FLT_MISC, MISC_FIX IMPLICIT NONE REAL(DP), INTENT(IN) :: XYZ (N_SPACE) REAL(DP), INTENT(OUT) :: ROBIN_1, ROBIN_2 SELECT CASE (EXACT_CASE) !===> remember to include "Use Select_Source ! for SELECT_EXACT_* " ! CASE (ccc) ; CALL EXACT_ROBIN_CASE_ccc (XYZ, ROBIN_1, ROBIN_2) CASE (1:5, 7:15) ; ROBIN_1 = 0.d0 ; ROBIN_2 = 0.d0 CASE (6) ; CALL NAFEMS_CONVECTION_TEST_MIXED (XYZ, ROBIN_1, ROBIN_2) CASE (16) ; CALL UXX_FAUSETT_EBC_RBC_ROBIN (XYZ, ROBIN_1, ROBIN_2) CASE (17) ; CALL UXX_FAUSETT_RBC_RBC_ROBIN (XYZ, ROBIN_1, ROBIN_2) CASE DEFAULT !b CALL EXACT_ROBIN_CASE (XYZ, ROBIN_1, ROBIN_2) ROBIN_1 = 0.d0 ; ROBIN_2 = 0.d0 PRINT *,'WARNING: SELECT_EXACT_ROBIN_DATA, NO USER DATA GIVEN' PRINT *,'DEFAULTED TO ROBIN_1 = 0.d0 ; ROBIN_2 = 0.d0' N_WARN = N_WARN + 1 END SELECT END SUBROUTINE SELECT_EXACT_ROBIN_DATA SUBROUTINE SELECT_ELEM_COL_MATRIX (E, H_INTG, PRT_L_PT, PRT_MAT,& L_PT_PROP, IE) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GENERATE OPTIONAL ELEMENT COLUMN MATRIX ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Elem_Type_Data ! for: Use Sys_Properties_Data ! for FLT_MISC, MISC_FIX Use Interface_Header ! for functions IMPLICIT NONE INTEGER, INTENT(IN) :: IE ! OPTIONAL PROPERTY VALUES REAL(DP), INTENT(INOUT) :: E (N_R_B, N_R_B), H_INTG (LT_N) REAL(DP), INTENT(IN) :: PRT_L_PT (LT_N, N_NP_FLO), PRT_MAT (MISC_FL) INTEGER, INTENT(IN) :: L_PT_PROP (N_NP_FIX) LOGICAL, SAVE :: WARN = .TRUE. ! ..................................................... ! *** ELEM_COL_MATRIX PROBLEM DEPENDENT STATEMENTS FOLLOW *** ! ..................................................... SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL ELEM_COL_EX_nnn CASE (101:107) ; RETURN ! CASE (102) ; RETURN ! CASE (103) ; RETURN ! CASE (104) ; RETURN ! CASE (105) ; RETURN ! CASE (106) ; RETURN ! CASE (107) ; RETURN CASE (112, 113,114) ; RETURN CASE (121,122,123,125,136,137) ; RETURN CASE (201:215) ; RETURN !b CASE (202) ; RETURN !b CASE (203) ; RETURN !b CASE (204) ; RETURN !b CASE (205) ; RETURN !b CASE (206) ; RETURN !b CASE (207) ; RETURN ! 208 and 302 are subsets of 209 !b CASE (208:209, 302) ; RETURN !b CASE (210) ; RETURN !b CASE (211) ; RETURN !b CASE (212) ; RETURN !b CASE (213,214,215) ; RETURN CASE (301:303) ; RETURN ! no ELEM_COL_EX_ CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_el_col_inc.', & ' WAS application_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL ELEM_COL_MATRIX (E, H_INTG, PRT_L_PT, & PRT_MAT, L_PT_PROP, IE) END SELECT END SUBROUTINE SELECT_ELEM_COL_MATRIX SUBROUTINE SELECT_SEG_COL_MATRIX (E, H_INTG, PRT_L_PT, PRT_MAT,& L_PT_PROP, IE, FLUX) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GENERATE FLUX SEGMENT COLUMN MATRIX ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Elem_Type_Data ! for: Use Sys_Properties_Data ! for FLT_MISC, MISC_FIX Use Geometric_Properties Use Interface_Header ! for functions IMPLICIT NONE INTEGER, INTENT(IN) :: IE ! OPTIONAL PROPERTY VALUES REAL(DP), INTENT(INOUT) :: E (N_R_B, N_R_B), H_INTG (LT_N) REAL(DP), INTENT(IN) :: PRT_L_PT (LT_N, N_NP_FLO), PRT_MAT (MISC_FL) INTEGER, INTENT(IN) :: L_PT_PROP (N_NP_FIX) ! OPTIONAL FLUX VALUES IF BOUNDARY SEGMENT ELEMENT REAL(DP), INTENT(IN) :: FLUX (L_B_N, N_G_FLUX) LOGICAL, SAVE :: WARN = .TRUE. ! ..................................................... ! *** SEG_COL_MATRIX PROBLEM DEPENDENT STATEMENTS FOLLOW *** ! ..................................................... SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL SEG_COL_EX_nnn CASE (101:107) ; RETURN ! CASE (102) ; RETURN ! CASE (103) ; RETURN ! CASE (104) ; RETURN ! CASE (105) ; RETURN ! CASE (106) ; RETURN ! CASE (107) ; RETURN CASE (112, 113,114) ; RETURN CASE (121,122,123,125,136,137) ; RETURN CASE (201) ; RETURN CASE (202) CALL SEG_COL_EX_202 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, FLUX) CASE (203) ; RETURN CASE (204) CALL SEG_COL_EX_204 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, FLUX) CASE (205) ; RETURN CASE (206) ; RETURN CASE (207) ; RETURN ! CASE (208) is 209 with keyword axisymmetric CASE (208:209, 302) ! 302 is a subset of 209 CALL SEG_COL_EX_209 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, FLUX) CASE (210) ; RETURN CASE (211) ; RETURN CASE (213) ; RETURN CASE (214) CALL SEG_COL_EX_214 (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, FLUX) CASE (215) ; RETURN CASE (301) ; RETURN ! 302 is a subset of 209 CASE (303) ; RETURN ! no SEG_COL_MATRIX CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_seg_col_inc.', & ' WAS application_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL SEG_COL_MATRIX (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, FLUX) END SELECT END SUBROUTINE SELECT_SEG_COL_MATRIX SUBROUTINE SELECT_ELEM_POST_DATA (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, FLUX) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GENERATE DATA FOR ELEMENT POST-SOLUTION USE IN POST_PROCESS_ELEM ! IF THAT WAS NOT DONE IN ELEM_SQ_MATRIX ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Elem_Type_Data ! for: Use Sys_Properties_Data ! for FLT_MISC, MISC_FIX Use Interface_Header ! for functions IMPLICIT NONE INTEGER, INTENT(IN) :: IE ! OPTIONAL PROPERTY VALUES REAL(DP), INTENT(INOUT) :: E (N_R_B, N_R_B), H_INTG (LT_N) REAL(DP), INTENT(IN) :: PRT_L_PT (LT_N, N_NP_FLO), PRT_MAT (MISC_FL) INTEGER, INTENT(IN) :: L_PT_PROP (N_NP_FIX) ! OPTIONAL FLUX VALUES IF BOUNDARY SEGMENT ELEMENT REAL(DP), INTENT(IN) :: FLUX (L_B_N, N_G_FLUX) LOGICAL, SAVE :: WARN = .TRUE. ! ..................................................... ! *** ELEM_POST_DATA PROBLEM DEPENDENT STATEMENTS FOLLOW *** ! ..................................................... SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL ELEM_POST_EX_nnn (E, H_INTG, PRT_L_PT, PRT_MAT, & ! L_PT_PROP, IE, FLUX) CASE (101:107) ; RETURN ! CASE (102) ; RETURN ! CASE (103) ; RETURN ! CASE (104) ; RETURN ! CASE (105) ; RETURN ! CASE (106) ; RETURN ! CASE (107) ; RETURN CASE (112, 113,114) ; RETURN CASE (121,122,123,125,136,137) ; RETURN CASE (201:215) ; RETURN ! CASE (202) ; RETURN ! CASE (203) ; RETURN ! CASE (204) ; RETURN ! CASE (205) ; RETURN ! CASE (206) ; RETURN ! CASE (207) ; RETURN ! CASE (208:209) ; RETURN ! CASE (210) ; RETURN ! CASE (211) ; RETURN ! CASE (212) ; RETURN ! CASE (213,214,215) ; RETURN CASE (301:303) ; RETURN ! no ELEM_POST_DATA CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_el_post_inc.', & ' WAS application_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL ELEM_POST_DATA (E, H_INTG, PRT_L_PT, PRT_MAT, & L_PT_PROP, IE, FLUX) END SELECT END SUBROUTINE SELECT_ELEM_POST_DATA SUBROUTINE SELECT_POST_PROCESS_ELEM (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE, & DD, DD_OLD) !b ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ELEMENT LEVEL POST-SOLUTION CALCULATIONS, FROM ELEM_POST_DATA ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Elem_Type_Data ! for: Use Sys_Properties_Data ! for FLT_MISC, MISC_FIX Use Interface_Header ! for functions IMPLICIT NONE INTEGER, INTENT(IN) :: ITER, IE ! ITERATION, ELEMENT NUMBER REAL(DP), INTENT(INOUT) :: DD (N_D_FRE), DD_OLD (N_D_FRE) ! OPTIONAL PROPERTY AND SOLUTION VALUES REAL(DP), INTENT(IN) :: PRT_L_PT (LT_N, N_NP_FLO), & PRT_MAT (MISC_FL) INTEGER, INTENT(IN) :: L_PT_PROP (N_NP_FIX) LOGICAL, SAVE :: WARN = .TRUE. ! .................................................... ! *** POST_PROCESS_ELEM PROBLEM DEPENDENT STATEMENTS FOLLOW *** ! .................................................... SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL POST_PROCESS_ELEM_EX_nnn CASE (101) ; CALL POST_PROCESS_ELEM_EX_101 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (102) ; CALL POST_PROCESS_ELEM_EX_102 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (103) ; RETURN CASE (104) ; CALL POST_PROCESS_ELEM_EX_104 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (105) ; RETURN CASE (106) ; RETURN CASE (107) ; RETURN CASE (112,114) ; RETURN CASE (113) ; CALL POST_PROCESS_ELEM_EX_113 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (121,122,125,136,137) ; RETURN CASE (123) ; CALL POST_PROCESS_ELEM_EX_123 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (201) ; CALL POST_PROCESS_ELEM_EX_201 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (202) ; RETURN CASE (203) ; RETURN CASE (204) ; RETURN CASE (205) ; CALL POST_PROCESS_ELEM_EX_205 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (206) ; CALL POST_PROCESS_ELEM_EX_206 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (207) ; CALL POST_PROCESS_ELEM_EX_207 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (208:209) ; RETURN CASE (210) ; CALL POST_PROCESS_ELEM_EX_210 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (211) ; RETURN CASE (213,214) ; RETURN CASE (215) ; CALL POST_PROCESS_ELEM_EX_215 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (301) ; RETURN CASE (303) ; CALL POST_PROCESS_ELEM_EX_303 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_post_el_inc.', & ' WAS application_lib.f RECOMPILED ?' PRINT *,'OR WAS KEYWORD post_mixed NEEDED INSTEAD ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL POST_PROCESS_ELEM (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE, & DD, DD_OLD) !b END SELECT END SUBROUTINE SELECT_POST_PROCESS_ELEM SUBROUTINE SELECT_POST_PROCESS_MIXED (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! MIXED SEGMENT LEVEL POST-SOLUTION CALCULATIONS ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Elem_Type_Data ! for: Use Sys_Properties_Data ! for FLT_MISC, MISC_FIX Use Interface_Header ! for functions IMPLICIT NONE INTEGER, INTENT(IN) :: ITER, IE ! ITERATION, ELEMENT NUMBER ! OPTIONAL PROPERTY AND SOLUTION VALUES REAL(DP), INTENT(IN) :: PRT_L_PT (LT_N, N_NP_FLO), & PRT_MAT (MISC_FL) INTEGER, INTENT(IN) :: L_PT_PROP (N_NP_FIX) LOGICAL, SAVE :: WARN = .TRUE. ! .................................................... ! *** POST_PROCESS_MIXED PROBLEM DEPENDENT STATEMENTS FOLLOW *** ! .................................................... SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL POST_PROCESS_MIXED_EX_nnn (PRT_L_PT, PRT_MAT, & ! L_PT_PROP, ITER, IE) CASE (101:107) ; Return ! CASE (102) ; Return ! CASE (103) ; RETURN ! CASE (104) ; Return ! CASE (105) ; RETURN ! CASE (106) ; RETURN ! CASE (107) ; RETURN CASE (112,113,114) ; RETURN CASE (121,122,123,125,136,137) ; RETURN CASE (201) ; Return CASE (202) ; RETURN CASE (203) ; RETURN CASE (204) ; CALL POST_PROCESS_MIXED_EX_204 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (205) ; RETURN CASE (206) ; Return CASE (207) ; Return ! CASE (208) is 209 with keyword axisymmetric CASE (208:209) CALL POST_PROCESS_MIXED_EX_209 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (210) ; RETURN CASE (211) ; RETURN CASE (212) ; RETURN CASE (213) ; RETURN ! 214 is transient version of 209 CASE (214) ; CALL POST_PROCESS_MIXED_EX_214 (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) CASE (215) ; RETURN CASE (301) ; RETURN CASE (303) ; RETURN ! no POST_PROCESS_MIXED_EX_ CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_post_mixed_inc.', & ' WAS application_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL POST_PROCESS_MIXED (PRT_L_PT, PRT_MAT, & L_PT_PROP, ITER, IE) END SELECT END SUBROUTINE SELECT_POST_PROCESS_MIXED FUNCTION SELECT_START_DOF_VALUE (IG, XYZ) ! * * * * * * * * * * * * * * * * * * * * * * * * * * ! DEFINE STARTING VALUE OF PARAMETER IG IN TERMS OF ! COORDINATES OF THE NODE (FOR ITERATIVE SOLUTIONS) ! * * * * * * * * * * * * * * * * * * * * * * * * * * ! A PROBLEM DEPENDENT ROUTINE Use System_Constants ! For EXAMPLE, N_SPACE IMPLICIT NONE INTEGER, INTENT(IN) :: IG ! local dof number REAL(DP), INTENT(IN) :: XYZ (N_SPACE) ! position REAL(DP) :: SELECT_START_DOF_VALUE ! result REAL(DP) :: START_DOF_VALUE ! default result LOGICAL, SAVE :: WARN = .TRUE. ! IG = LOCAL PARAMETER NUMBER AT NODE ! .................................................... ! ** PROBLEM DEPENDENT START STATEMENTS FOLLOW ** ! .................................................... SELECT_START_DOF_VALUE = 0.d0 SELECT CASE (EXAMPLE) ! CASE (nnn) ; SELECT_START_DOF_VALUE & ! = START_DOF_VALUE_EX_nnn (IG, XYZ) CASE (101:107) ; RETURN ! No iterations ! CASE (102) ; RETURN ! No iterations ! CASE (103) ; RETURN ! No iterations ! CASE (104) ; RETURN ! No iterations ! CASE (105) ; RETURN ! No iterations ! CASE (106) ; RETURN ! No iterations ! CASE (107) ; RETURN ! No iterations CASE (108,113,114,125,136,137) ; RETURN ! No iterations ! 112 may iterate CASE (121,122,123) ; SELECT_START_DOF_VALUE = INITIAL_VALUE CASE (201:215) ; RETURN ! No iterations ! CASE (202) ; RETURN ! No iterations ! CASE (203) ; RETURN ! No iterations ! CASE (204) ; RETURN ! No iterations ! CASE (205) ; RETURN ! No iterations ! CASE (206) ; RETURN ! No iterations ! CASE (207) ; RETURN ! No iterations ! CASE (208:209, 302) ; RETURN ! No iterations ! CASE (210) ; RETURN ! No iterations ! CASE (211) ; RETURN ! No iterations ! CASE (212) ; RETURN ! CASE (213) ; RETURN ! CASE (214) ; SELECT_START_DOF_VALUE = INITIAL_VALUE ! CASE (215) ; RETURN CASE (301:303) ; RETURN ! No iterations CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_iter_start_inc.', & ' WAS application_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING SELECT_START_DOF_VALUE = START_DOF_VALUE (IG, XYZ) END SELECT END FUNCTION SELECT_START_DOF_VALUE FUNCTION SELECT_GET_APPLICATION_B_MATRIX (DGH, XYZ) RESULT (B) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GET APPLICATION DEPENDENT B MATRIX FOR STRAIN OR GRADIENTS ! (USED IF SUPERCONVERGENT PATCH GRADIENTS ARE ACTIVE) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Elem_Type_Data ! for LT_N, LT_FREE, & H (LT_N) IF NEEDED Use Interface_Header IMPLICIT NONE REAL (DP), INTENT(IN) :: DGH (N_SPACE, LT_N) REAL (DP), INTENT(IN) :: XYZ (N_SPACE) REAL (DP) :: B (N_R_B, LT_FREE) LOGICAL, SAVE :: WARN = .TRUE. SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL GET_B_MATRIX_EX_nnn (DGH, XYZ, B) ! CASE (101) ; RETURN ! CASE (102) ; RETURN ! CASE (103) ; RETURN ! CASE (104) ; RETURN ! CASE (105) ; RETURN ! CASE (106) ; RETURN ! CASE (107) ; RETURN ! CASE (112) ; CALL GET_B_MATRIX_EX_112 (DGH, XYZ, B) ! CASE (121,122) ; RETURN ! CASE (201) ; RETURN ! CASE (202) ; RETURN ! CASE (203) ; RETURN ! CASE (301) ; RETURN CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_b_matrix_inc.', & ' WAS application_lib.f RECOMPILED ?' PRINT *,'FUNCTION SELECT_GET_APPLICATION_B_MATRIX' N_WARN = N_WARN + 1 END IF ! FIRST WARNING B = GET_APPLICATION_B_MATRIX (DGH, XYZ) END SELECT END FUNCTION SELECT_GET_APPLICATION_B_MATRIX SUBROUTINE SELECT_APPLICATION_B_MATRIX (DGH, XYZ, B) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GET APPLICATION DEPENDENT B MATRIX FOR STRAIN OR GRADIENTS ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Elem_Type_Data ! for LT_N, LT_FREE, & H (LT_N) IF NEEDED Use Interface_Header IMPLICIT NONE REAL (DP), INTENT(IN) :: DGH (N_SPACE, LT_N) REAL (DP), INTENT(IN) :: XYZ (N_SPACE) REAL (DP), INTENT(OUT) :: B (N_R_B, LT_FREE) LOGICAL, SAVE :: WARN = .TRUE. SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL B_MATRIX_EX_nnn (DGH, XYZ, B) CASE (101,102,103,104,105,106) ; B = DGH CASE (107) ; CALL B_MATRIX_EX_107 (DGH, XYZ, B) ! LSq CASE (109) ; B = DGH CASE (110) ; CALL B_MATRIX_EX_110 (DGH, XYZ, B) ! Cyl CASE (112,113) ; B = DGH CASE (114,125) ; B = 0.d0 CASE (121,122,123,136,137) ; B = DGH CASE (201) ; CALL B_MATRIX_PLANE_ELASTIC (LT_N, N_SPACE, & N_G_DOF, DGH, N_R_B, B) CASE (202) ; B = DGH CASE (203) ; B = 0.d0 ! space frame CASE (204) ; B = DGH ! T3 Poisson CASE (205) ; B = DGH CASE (206) ; B = 0.d0 CASE (207) ; B = 0.d0 CASE (208:209, 302) ; B = DGH CASE (210) ; CALL ELASTIC_B_PLANAR (DGH, B) ! plane stress CASE (211) ; B = DGH CASE (212) ; B = DGH CASE (213) ; B = DGH CASE (214) ; RETURN CASE (215) ; CALL ELASTIC_B_PLANAR (DGH, B) ! plane strain CASE (301) ; RETURN CASE (303) ; CALL ELASTIC_B_SOLID (DGH, B) ! solid body CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_b_matrix_inc.', & ' WAS application_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING B = GET_APPLICATION_B_MATRIX (DGH, XYZ) END SELECT END SUBROUTINE SELECT_APPLICATION_B_MATRIX FUNCTION SELECT_GET_APPLICATION_E_MATRIX (IE, XYZ) RESULT (E) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GET APPLICATION DEPENDENT E MATRIX FOR CONSTITUTIVE LAW ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE Use Sys_Properties_Data Use Interface_Header IMPLICIT NONE INTEGER, INTENT (IN) :: IE REAL (DP), INTENT(IN) :: XYZ (N_SPACE) REAL (DP) :: E (N_R_B, N_R_B) LOGICAL, SAVE :: WARN = .TRUE. CALL REAL_IDENTITY (N_R_B, E) ! DEFAULT TO IDENTITY MATRIX !b SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL GET_E_MATRIX_EX_nnn (IE, XYZ) ! CASE (101) ; RETURN ! CASE (102) ; RETURN ! CASE (103) ; RETURN ! CASE (104) ; RETURN ! CASE (105) ; RETURN ! CASE (106) ; RETURN ! CASE (107) ; RETURN ! CASE (201) ; RETURN CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_e_matrix_inc.', & ' WAS application_lib.f RECOMPILED ?' PRINT *,'FUNCTION SELECT_GET_APPLICATION_E_MATRIX' N_WARN = N_WARN + 1 END IF ! FIRST WARNING E = GET_APPLICATION_E_MATRIX (IE, XYZ) END SELECT END FUNCTION SELECT_GET_APPLICATION_E_MATRIX SUBROUTINE SELECT_APPLICATION_E_MATRIX (IE, XYZ, E) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! GET APPLICATION DEPENDENT E MATRIX FOR CONSTITUTIVE LAW ! (USED IF SUPERCONVERGENT PATCH GRADIENTS ARE ACTIVE) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! For EXAMPLE, N_R_B, N_SPACE Use Sys_Properties_Data IMPLICIT NONE INTEGER, INTENT (IN) :: IE REAL (DP), INTENT(IN) :: XYZ (N_SPACE) REAL (DP), INTENT(OUT) :: E (N_R_B, N_R_B) LOGICAL, SAVE :: WARN = .TRUE. IF ( DEBUG_PROPERTY .OR. DEBUG_E ) PRINT *, & 'Enter SELECT_APPLICATION_E_MATRIX' SELECT CASE (EXAMPLE) ! CASE (nnn) ; CALL E_MATRIX_EX_nnn (IE, XYZ, E) CASE (101) ; E = GET_REAL_LP (1) * GET_REAL_LP (2) ! K_e * A_e ! CASE (102) Slider bearing ! CASE (103) Slider bearing CASE (104) ; E = 1 ! ODE CASE (105) ; E = 1 ! ODE CASE (106) ; E = 1 ! ODE CASE (107) ; CALL REAL_IDENTITY (N_R_B, E) ! Hermite ODE CASE (108) ; E = GET_REAL_LP (1) * GET_REAL_LP (2) ! K * A CASE (109) ; E (1, 1) = GET_REAL_LP (1) ! K_RR, cyl CASE (110) ; CALL E_MATRIX_EX_110 (IE, XYZ, E) CASE (111) ; E = 1 / GET_REAL_LP (1) ! Circuit CASE (112,113) ; E = GET_REAL_LP (2) ! conductivity CASE (114) ; E = GET_REAL_LP (1) ! conductivity CASE (121,122,123,125,136,137) ; E = GET_REAL_LP (1) ! conductivity CASE (201) ; CALL PLANE_STRESS_E_MATRIX (GET_REAL_LP (1), & GET_REAL_LP (2), E) CASE (202) ; CALL E_MATRIX_EX_202 (IE, XYZ, E) !b POISSON_ANISOTROPIC_2D_E_MATRIX & !b (GET_REAL_LP (1), GET_REAL_LP (2), & !b GET_REAL_LP (3), E) ! (K_XX, K_YY, K_XY, E) ! CASE (203) Plane frame CASE (204) ; CALL E_MATRIX_EX_204 (IE, XYZ, E) ! 2D Poisson CASE (205) ; CALL E_MATRIX_EX_205 (IE, XYZ, E) ! Torsion 2D ! CASE (206) Plane truss ! CASE (207) Plane truss energy method CASE (208,209,214,302) ; CALL POISSON_ANISOTROPIC_E_MATRIX (E) CASE (210) ; CALL E_PLANE_STRESS (E) CASE (211) ; CALL E_MATRIX_EX_211 (IE, XYZ, E) ! Advection Diffusion CASE (212) ; CALL E_MATRIX_EX_212 (IE, XYZ, E) ! Var Advect Diffusion CASE (213) ; CALL E_MATRIX_EX_213 (IE, XYZ, E) ! Var Advect Diffusion CASE (215) ; CALL E_PLANE_STRAIN (E) CASE (303) ; CALL E_SOLID_STRESS (E) ! for error est CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_e_matrix_inc FOR EXAMPLE ',& EXAMPLE, ', WAS application_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL APPLICATION_E_MATRIX (IE, XYZ, E) END SELECT IF ( DEBUG_PROPERTY .OR. DEBUG_E ) PRINT *, & 'Leave SELECT_APPLICATION_E_MATRIX' END SUBROUTINE SELECT_APPLICATION_E_MATRIX !SUBROUTINE SELECT_GET_CONSTANT_E (IE, E) !b turned off 4/8/02 !! * * * * * * * * * * * * * * * * * * * * * * * * * * * * !! COMPUTE A CONSTANT CONSTITUTIVE MATRIX, E !! * * * * * * * * * * * * * * * * * * * * * * * * * * * * !Use System_Constants ! For EXAMPLE !Use Elem_Type_Data ! for: LT_N, LT_PARM, COORD (LT_N, N_SPACE), & ! ! DLH (LT_PARM, LT_N), H (LT_N), etc !Use Sys_Properties_Data ! for FLT_MISC, MISC_FIX !!b Use Interface_Header ! IMPLICIT NONE ! INTEGER, INTENT(IN) :: IE ! ELEMENT NUMBER ! REAL(DP), INTENT(INOUT) :: E (N_R_B, N_R_B) ! CONSTITUTIVE MATRIX ! LOGICAL, SAVE :: WARN = .TRUE. ! ! SELECT CASE (EXAMPLE) ! ! CASE (nnn) ; CALL GET_CONSTANT_E_nnn (IE, E) ! ! CASE (101) ; CALL REAL_IDENTITY (N_R_B, E) ! ! CASE (102) ; CALL REAL_IDENTITY (N_R_B, E) ! ! CASE (103) ; CALL REAL_IDENTITY (N_R_B, E) ! ! CASE (104) ; CALL REAL_IDENTITY (N_R_B, E) ! ! CASE (105) ; CALL REAL_IDENTITY (N_R_B, E) ! ! CASE (106) ; CALL REAL_IDENTITY (N_R_B, E) ! ! CASE (107) ; CALL REAL_IDENTITY (N_R_B, E) ! ! CASE (201) ; CALL GET_CONSTANT_E_201 (IE, E) ! CASE DEFAULT ! IF ( WARN ) THEN ; WARN = .FALSE. ! PRINT *,'WARNING: DEFAULTED TO my_e_matrix_inc.', & ! ' WAS application_lib.f RECOMPILED ?' ! N_WARN = N_WARN + 1 ! END IF ! FIRST WARNING ! CALL GET_CONSTANT_E (IE, E) ! END SELECT !END SUBROUTINE SELECT_GET_CONSTANT_E ! |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| SUBROUTINE SELECT_EXACT_CASE_NUMBER (CASE_EXACT) ! New exact cases do not assume a coupling of EXAMPLE & DATA_SET Use System_Constants ! For EXAMPLE, DATA_SET, EXACT_CASE IMPLICIT NONE INTEGER, INTENT (OUT) :: CASE_EXACT CASE_EXACT = 0 IF ( EXAMPLE < 1 .OR. DATA_SET < 1 ) RETURN SELECT CASE (EXAMPLE) CASE (101); IF (DATA_SET >= 1 .AND. DATA_SET <= 4 ) CASE_EXACT = 1 CASE (104); IF (DATA_SET >= 1 .AND. DATA_SET <= 2 ) CASE_EXACT = 9 IF (DATA_SET >= 4 .AND. DATA_SET <= 6 ) CASE_EXACT = 9 IF (DATA_SET == 3 ) CASE_EXACT = 10 CASE (105); IF (DATA_SET >= 1 .AND. DATA_SET <= 2 ) CASE_EXACT = 11 IF (DATA_SET == 3 ) CASE_EXACT = 14 CASE (106); IF (DATA_SET == 1 ) CASE_EXACT = 15 IF (DATA_SET == 2 ) CASE_EXACT = 16 IF (DATA_SET == 3 ) CASE_EXACT = 17 CASE (109); IF (DATA_SET == 1 ) CASE_EXACT = 21 IF (DATA_SET == 2 ) CASE_EXACT = 21 CASE (201); IF (DATA_SET >= 1 .AND. DATA_SET <= 6 ) CASE_EXACT = 12 CASE (202); IF (DATA_SET == 1 ) CASE_EXACT = 2 IF (DATA_SET >= 2 .AND. DATA_SET <= 4 ) CASE_EXACT = 5 IF (DATA_SET == 5 ) CASE_EXACT = 8 IF (DATA_SET == 6 ) CASE_EXACT = 8 IF (DATA_SET == 7 ) CASE_EXACT = 0 IF (DATA_SET == 8 ) CASE_EXACT = 20 IF (DATA_SET == 10) CASE_EXACT = 19 IF (DATA_SET == 11) CASE_EXACT = 22 !XXX CASE DEFAULT ! CASE_EXACT = 0 END SELECT IF ( CASE_EXACT /= EXACT_CASE ) THEN ! PRINT *,'WARNING: SELECT_EXACT_CASE_NUMBER, WAS EXPECTING ', & ! 'EXACT CASE = ', EXACT_CASE ! PRINT *,'NOT A SELECTED VALUE OF ', CASE_EXACT N_WARN = N_WARN + 1 IF ( EXACT_CASE == 0 ) THEN PRINT *,'WARNING: SELECT_EXACT_CASE_NUMBER, USING EXACT ', & 'CASE = ', CASE_EXACT PRINT *,'FROM EXAMPLE DATA_SET PAIR, NOT DEFAULT VALUE OF 0' EXACT_CASE = CASE_EXACT ELSE PRINT *,'WARNING: SELECT_EXACT_CASE_NUMBER, USING EXACT ', & 'CASE = ', EXACT_CASE PRINT *,'NOT EXAMPLE DATA_SET PAIR VALUE OF ', CASE_EXACT END IF END IF END SUBROUTINE SELECT_EXACT_CASE_NUMBER SUBROUTINE SELECT_EXACT_SOLUTION (XYZ, EXACT_SOL) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! EXACT SOLUTION FOR OUTPUT OR ERROR ESTIMATES ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! for N_G_DOF, N_SPACE, EXACT_CASE IMPLICIT NONE REAL(DP), INTENT (IN) :: XYZ (N_SPACE) ! POINT IN SPACE REAL(DP), INTENT (OUT) :: EXACT_SOL (N_G_DOF) ! PT EXACT VALUE LOGICAL, SAVE :: WARN = .TRUE. SELECT CASE (EXACT_CASE) !===> remember to include "Use Select_Source ! for SELECT_EXACT_* " ! CASE (ccc) ; CALL EXACT_SOLUTION_CASE_ccc (XYZ, EXACT_SOL) CASE (1 ) ; CALL MYERS_1D_ROD_HEAT (XYZ, EXACT_SOL) CASE (2 ) ; CALL LAKHANY_WHITEMAN_TEST (XYZ, EXACT_SOL) CASE (3 ) ; CALL POISSON_ZZ_SQ_W_SOURCE (XYZ, EXACT_SOL) CASE (4 ) ; CALL STRONG_DIAGONAL_SQ (XYZ, EXACT_SOL) CASE (5 ) ; CALL POISSON_ANNULUS_ARC (XYZ, EXACT_SOL) CASE (6 ) ; CALL NAFEMS_CONVECTION_TEST (XYZ, EXACT_SOL) CASE (7 ) ; CALL POTENTIAL_FLOW_CYL_EXACT (XYZ, EXACT_SOL) CASE (8 ) ; CALL PATCH_TEST_2D_PE_2_DER (XYZ, EXACT_SOL) CASE (9 ) ; CALL UXX_U_X (XYZ, EXACT_SOL) CASE (10 ) ; CALL UXX_U_X_NBC (XYZ, EXACT_SOL) CASE (11 ) ; CALL UXX_X_TO_N (XYZ, EXACT_SOL) CASE (12 ) ; CALL PATCH_TEST_2D_STRESS (XYZ, EXACT_SOL) CASE (13 ) ; CALL PATCH_TEST_AXI_SYM_STRESS (XYZ, EXACT_SOL) CASE (14 ) ; CALL UXX_Q_STEP (XYZ, EXACT_SOL) CASE (15 ) ; CALL UXX_FAUSETT_EBC (XYZ, EXACT_SOL) CASE (16 ) ; CALL UXX_FAUSETT_EBC_RBC (XYZ, EXACT_SOL) CASE (17 ) ; CALL UXX_FAUSETT_RBC_RBC (XYZ, EXACT_SOL) CASE (18 ) ; CALL SUPG_1D_01 (XYZ, EXACT_SOL) CASE (19 ) ; CALL CARSLAW_ORTHOTROPIC (XYZ, EXACT_SOL) CASE (20 ) ; CALL CUBIC_2D_LAPLACE (XYZ, EXACT_SOL) CASE (21 ) ; CALL CYLINDER_HEAT_EBC (XYZ, EXACT_SOL) CASE (22 ) ; CALL KREYSZIG_SPHERE_5 (XYZ, EXACT_SOL) CASE (23 ) ; CALL HOLE_IN_INFINITE_PLATE (XYZ, EXACT_SOL) CASE (24 ) ; CALL PATCH_TEST_2D_PE (XYZ, EXACT_SOL) CASE (25 ) ; CALL COSINE_HILL_BC_ONLY (XYZ, EXACT_SOL) CASE (26 ) ; CALL HEINRICH_EXAMPLE_5_9 (XYZ, EXACT_SOL) CASE (27 ) ; CALL ADE_1_D_TEST (XYZ, EXACT_SOL) CASE (28 ) ; CALL GRIFFITHS_TEST_1 (XYZ, EXACT_SOL) CASE (29 ) ; CALL GRIFFITHS_TEST_2 (XYZ, EXACT_SOL) CASE (30 ) ; CALL STOCASTIC_VOLATILITY_BC (XYZ, EXACT_SOL) CASE (31 ) ; CALL EXACT_TRANSIENT_TEST_1 (XYZ, EXACT_SOL) CASE (32 ) ; CALL CONVECT_DIFFUS_ON_SQ (XYZ, EXACT_SOL) CASE (33 ) ; CALL RECT_BAR_BEND_DEFLECTIONS (XYZ, EXACT_SOL) CASE (34 ) ; CALL TRANSIENT_HALF_WALL (XYZ, EXACT_SOL) CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_exact_inc FOR CASE ', & EXACT_CASE, ', WAS exact_lib.f RECOMPILED ?' PRINT *,' WAS select_source_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL EXACT_SOLUTION (XYZ, EXACT_SOL) END SELECT END SUBROUTINE SELECT_EXACT_SOLUTION SUBROUTINE SELECT_EXACT_FLUX (XYZ, FLUX) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! EXACT FLUX FOR OUTPUT OR ERROR ESTIMATES ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! for N_G_DOF, N_SPACE, N_R_B, EXACT_CASE IMPLICIT NONE REAL(DP), INTENT (IN) :: XYZ (N_SPACE) ! POINT IN SPACE REAL(DP), INTENT (OUT) :: FLUX (N_R_B) ! PT EXACT VALUE LOGICAL, SAVE :: WARN = .TRUE. SELECT CASE (EXACT_CASE) !==> Rember Use Select_Source ! for SELECT_EXACT_* CASE (1 ) ; CALL MYERS_1D_ROD_HEAT_FLUX (XYZ, FLUX) CASE (2 ) ; CALL LAKHANY_WHITEMAN_TEST_FLUX (XYZ, FLUX) CASE (3 ) ; CALL POISSON_ZZ_SQ_W_SOURCE_FLUX (XYZ, FLUX) CASE (4 ) ; CALL STRONG_DIAGONAL_SQ_FLUX (XYZ, FLUX) CASE (5 ) ; CALL POISSON_ANNULUS_ARC_FLUX (XYZ, FLUX) CASE (6 ) ; CALL NAFEMS_CONVECTION_TEST_FLUX (XYZ, FLUX) CASE (7 ) ; CALL POTENTIAL_FLOW_CYL_EXACT_VEL (XYZ, FLUX) CASE (8 ) ; CALL PATCH_TEST_2D_PE_2_DER_FLUX (XYZ, FLUX) CASE (9 ) ; CALL UXX_U_X_FLUX (XYZ, FLUX) CASE (10 ) ; CALL UXX_U_X_FLUX_NBC (XYZ, FLUX) CASE (11 ) ; CALL UXX_X_TO_N_FLUX (XYZ, FLUX) CASE (12 ) ; CALL PATCH_TEST_2D_STRESS_FLUX (XYZ, FLUX) CASE (13 ) ; CALL PATCH_TEST_AXI_SYM_STRESS_FLUX (XYZ, FLUX) CASE (14 ) ; CALL UXX_Q_STEP_FLUX (XYZ, FLUX) CASE (15 ) ; CALL UXX_FAUSETT_EBC_FLUX (XYZ, FLUX) CASE (16 ) ; CALL UXX_FAUSETT_EBC_RBC_FLUX (XYZ, FLUX) CASE (17 ) ; CALL UXX_FAUSETT_RBC_RBC_FLUX (XYZ, FLUX) CASE (18 ) ; CALL SUPG_1D_01_FLUX (XYZ, FLUX) CASE (19 ) ; CALL CARSLAW_ORTHOTROPIC_FLUX (XYZ, FLUX) CASE (20 ) ; CALL CUBIC_2D_LAPLACE_FLUX (XYZ, FLUX) CASE (21 ) ; CALL CYLINDER_HEAT_EBC_FLUX (XYZ, FLUX) CASE (22 ) ; CALL KREYSZIG_SPHERE_5_FLUX (XYZ, FLUX) CASE (23 ) ; CALL HOLE_IN_INFINITE_PLATE_FLUX (XYZ, FLUX) CASE (24 ) ; CALL PATCH_TEST_2D_PE_FLUX (XYZ, FLUX) CASE (25 ) ; FLUX = 0.d0 ! BC ONLY CASE (26 ) ; CALL HEINRICH_EXAMPLE_5_9_FLUX (XYZ, FLUX) CASE (27 ) ; CALL ADE_1_D_TEST_FLUX (XYZ, FLUX) CASE (28 ) ; CALL GRIFFITHS_TEST_1_FLUX (XYZ, FLUX) CASE (29 ) ; CALL GRIFFITHS_TEST_2_FLUX (XYZ, FLUX) CASE (30 ) ; FLUX = 0.d0 ! BC ONLY CASE (33 ) ; CALL RECT_BAR_BEND_STRESSES (XYZ, FLUX) CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_exact_flux_inc IN CASE ',& EXACT_CASE, ', WAS exact_lib.f RECOMPILED ?' PRINT *,' WAS select_source_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL EXACT_FLUX (XYZ, FLUX) END SELECT END SUBROUTINE SELECT_EXACT_FLUX SUBROUTINE SELECT_EXACT_FLUX_GRAD (XYZ, FLUX_GRAD) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! EXACT FLUX GRADIENT (2ND DERIV) FOR OUTPUT OR ERROR ESTIMATES ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! for N_G_DOF, N_SPACE, N_R_B, EXACT_CASE IMPLICIT NONE REAL(DP), INTENT (IN) :: XYZ (N_SPACE) ! POINT IN SPACE REAL(DP), INTENT (OUT) :: FLUX_GRAD (N_R_B * N_SPACE) ! EXACT LOGICAL, SAVE :: WARN = .TRUE. ! FLUX_GRAD = EXACT FLUX GRAD (2ND DERIV) COMPONENTS AT A POINT SELECT CASE (EXACT_CASE) !==> Rember Use Select_Source ! for SELECT_EXACT_* CASE (1, 3:4, 6:7, 9:13 ) ; FLUX_GRAD = 0.d0 CASE (2 ) ; CALL LAKHANY_WHITEMAN_TEST_DERIV_2 (XYZ, FLUX_GRAD) CASE (5 ) ; CALL POISSON_ANNULUS_ARC_DERIV_2 (XYZ, FLUX_GRAD) CASE (8 ) ; CALL PATCH_TEST_2D_PE_2_DER_FG (XYZ, FLUX_GRAD) CASE (18 ) ; CALL SUPG_1D_01_FLUX_GRAD (XYZ, FLUX_GRAD) CASE (20 ) ; CALL CUBIC_2D_LAPLACE_FLUX_GRAD (XYZ, FLUX_GRAD) CASE (25 ) ; FLUX_GRAD = 0.d0 ! BC ONLY CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_exact_2nd_der_inc FOR CASE ',& EXACT_CASE, ', WAS exact_lib.f RECOMPILED ?' PRINT *,' WAS select_source_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL EXACT_FLUX_GRAD (XYZ, FLUX_GRAD) END SELECT END SUBROUTINE SELECT_EXACT_FLUX_GRAD SUBROUTINE SELECT_EXACT_INTEGRAL (XYZ, INTEGRAL) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! EXACT INTEGRAL FOR ELEMENT MATRICES ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! for N_G_DOF, N_SPACE, N_R_B, EXACT_CASE IMPLICIT NONE REAL(DP), INTENT (IN) :: XYZ (N_SPACE) ! POINT IN SPACE REAL(DP), INTENT (OUT) :: INTEGRAL ! PT EXACT VALUE LOGICAL, SAVE :: WARN = .TRUE. SELECT CASE (EXACT_CASE) !==> Rember Use Select_Source ! for SELECT_EXACT_* CASE (1 ) ; CALL MYERS_1D_ROD_HEAT_LOSS (XYZ, INTEGRAL) CASE (2:20) ; INTEGRAL = 0.d0 CASE (25 ) ; INTEGRAL = 0.d0 ! BC ONLY CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_exact_integral_inc.', & ' WAS exact_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL EXACT_INTEGRAL (XYZ, INTEGRAL) END SELECT END SUBROUTINE SELECT_EXACT_INTEGRAL SUBROUTINE SELECT_EXACT_NORMAL_FLUX (XYZ, FLUX_N) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! EXACT FLUX FOR OUTPUT OR ERROR ESTIMATES ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! for N_G_DOF, N_SPACE, EXACT_CASE IMPLICIT NONE REAL(DP), INTENT (IN) :: XYZ (N_SPACE) ! POINT IN SPACE REAL(DP), INTENT (OUT) :: FLUX_N ! PT EXACT VALUE LOGICAL, SAVE :: WARN = .TRUE. SELECT CASE (EXACT_CASE) CASE (1:4,6:13) ; FLUX_N = 0.d0 CASE (5) ; CALL POISSON_ANNULUS_ARC_NORMAL_FLUX (XYZ, FLUX_N) CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_exact_normal_flux_inc.', & ' WAS exact_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL EXACT_NORMAL_FLUX (XYZ, FLUX_N) END SELECT END SUBROUTINE SELECT_EXACT_NORMAL_FLUX SUBROUTINE SELECT_EXACT_SOURCE (XYZ, SOURCE) ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! EXACT SOURCE FOR ELEMENT MATRICES ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Use System_Constants ! for N_G_DOF, N_SPACE, N_R_B, EXACT_CASE IMPLICIT NONE REAL(DP), INTENT (IN) :: XYZ (N_SPACE) ! POINT IN SPACE REAL(DP), INTENT (OUT) :: SOURCE ! PT EXACT VALUE LOGICAL, SAVE :: WARN = .TRUE. SELECT CASE (EXACT_CASE) CASE (1, 6:7, 9:10, 12:13) ; SOURCE = 0.d0 CASE (2 ) ; CALL LAKHANY_WHITEMAN_TEST_SOURCE (XYZ, SOURCE) CASE (3 ) ; CALL POISSON_ZZ_SQ_W_SOURCE_SOURCE (XYZ, SOURCE) CASE (4 ) ; CALL STRONG_DIAGONAL_SQ_SOURCE (XYZ, SOURCE) CASE (5 ) ; CALL POISSON_ANNULUS_ARC_SOURCE (XYZ, SOURCE) CASE (8 ) ; CALL PATCH_TEST_2D_PE_2_DER_SOURCE (XYZ, SOURCE) CASE (11 ) ; CALL UXX_X_TO_N_SOURCE (XYZ, SOURCE) CASE (14 ) ; CALL UXX_Q_STEP_SOURCE (XYZ, SOURCE) CASE (15 ) ; CALL UXX_FAUSETT_EBC_SOURCE (XYZ, SOURCE) CASE (16 ) ; CALL UXX_FAUSETT_EBC_RBC_SOURCE (XYZ, SOURCE) CASE (17 ) ; CALL UXX_FAUSETT_RBC_RBC_SOURCE (XYZ, SOURCE) CASE (25 ) ; SOURCE = 0.d0 ! BC ONLY CASE (28 ) ; CALL GRIFFITHS_TEST_1_SOURCE (XYZ, SOURCE) CASE (29 ) ; CALL GRIFFITHS_TEST_2_SOURCE (XYZ, SOURCE) CASE (30 ) ; SOURCE = 0.d0 ! BC ONLY CASE DEFAULT IF ( WARN ) THEN ; WARN = .FALSE. PRINT *,'WARNING: DEFAULTED TO my_exact_source_inc.', & ' WAS exact_lib.f RECOMPILED ?' N_WARN = N_WARN + 1 END IF ! FIRST WARNING CALL EXACT_SOURCE (XYZ, SOURCE) END SELECT END SUBROUTINE SELECT_EXACT_SOURCE ! Section based on EXAMPLE !SUBROUTINE SELECT_EX_SOLUTION (XYZ, EXACT_SOL) !! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * !! EXACT SOLUTION FOR OUTPUT OR ERROR ESTIMATES, VIA EXAMPLE !! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * !Use System_Constants ! for N_G_DOF, N_SPACE, EXAMPLE ! IMPLICIT NONE ! REAL(DP), INTENT (IN) :: XYZ (N_SPACE) ! POINT IN SPACE ! REAL(DP), INTENT (OUT) :: EXACT_SOL (N_G_DOF) ! PT EXACT VALUE ! LOGICAL, SAVE :: WARN = .TRUE. ! SELECT CASE (EXAMPLE) ! then any DATA_SET number ! ! CASE (nnn) ; CALL EXACT_SOLUTION_EX_nnn (XYZ, EXACT_SOL) ! CASE (101) ; CALL MYERS_1D_ROD_HEAT (XYZ, EXACT_SOL) ! CASE DEFAULT ! IF ( WARN ) THEN ; WARN = .FALSE. ! PRINT *,'WARNING: DEFAULTED TO EXACT_SOLUTION.', & ! ' WAS exact_lib.f RECOMPILED ?' ! N_WARN = N_WARN + 1 ! END IF ! FIRST WARNING ! CALL EXACT_SOLUTION (XYZ, EXACT_SOL) ! END SELECT !END SUBROUTINE SELECT_EX_SOLUTION ! End select_source_lib.f END MODULE SELECT_SOURCE