! =============================================================== ! Copyright (c) CERFACS (all rights reserved) ! =============================================================== SUBROUTINE analytic_getsource(nnode, rhoinv, press, tempe, w_spec, source_spec) ! !*********************************************************************** !*********************************************************************** ! USE mod_param_defs USE mod_input_param_defs, ONLY: wmol USE mod_solut, ONLY: neqs USE mod_input_param_defs, ONLY: mixture_name USE mod_error, ONLY: print_error_and_quit IMPLICIT NONE ! IN INTEGER :: nnode REAL(pr) :: rhoinv(1:nnode), press(1:nnode), tempe(1:nnode) REAL(pr) :: w_spec(1:neqs,1:nnode) ! OUT REAL(pr) :: source_spec(1:neqs,1:nnode) ! LOCAL CHARACTER(LEN=strl) :: message IF ( TRIM(mixture_name) == 'NOX22' ) THEN CALL NOX22(nnode, neqs, rhoinv, press, tempe, w_spec, wmol, source_spec) ELSE IF ( TRIM(mixture_name) == 'NOX211' ) THEN CALL NOX211(nnode, neqs, rhoinv, press, tempe, w_spec, wmol, source_spec) ELSE IF ( TRIM(mixture_name) == 'PPB_Sp29_Re172_QSS11' ) THEN CALL PPB_Sp29_Re172_QSS11(nnode, neqs, rhoinv, press, tempe, w_spec, wmol, source_spec) ELSE message="Can't find chemical routine corresponding to "//TRIM(mixture_name)//" in analytic scheme database." CALL print_error_and_quit ( err_message=message ) END IF END SUBROUTINE analytic_getsource