!> @file salsa_util_mod.f90 !--------------------------------------------------------------------------------! ! This file is part of PALM-4U. ! ! PALM-4U is free software: you can redistribute it and/or modify it under the ! terms of the GNU General Public License as published by the Free Software ! Foundation, either version 3 of the License, or (at your option) any later ! version. ! ! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 1997-2019 Leibniz Universitaet Hannover !--------------------------------------------------------------------------------! ! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: salsa_util_mod.f90 3872 2019-04-08 15:03:06Z suehring $ ! moved decrlaration of sums_salsa_ws_l to statistics module ! ! 3871 2019-04-08 14:38:39Z knoop ! Formatting changes ! ! 3845 2019-04-01 13:41:55Z monakurppa ! Initial revision ! ! ! ! Authors: ! -------- ! @author monakurppa ! ! ! Description: ! ------------ !> Utility functions used in salsa_mod. !------------------------------------------------------------------------------! MODULE salsa_util_mod USE control_parameters, & ONLY: message_string USE kinds USE pegrid IMPLICIT NONE ! !-- Component index TYPE component_index INTEGER(iwp) :: ncomp !< Number of components INTEGER(iwp), ALLOCATABLE :: ind(:) !< Component index CHARACTER(len=3), ALLOCATABLE :: comp(:) !< Component name END TYPE component_index SAVE INTERFACE component_index_constructor MODULE PROCEDURE component_index_constructor END INTERFACE component_index_constructor INTERFACE get_index MODULE PROCEDURE get_index END INTERFACE get_index INTERFACE is_used MODULE PROCEDURE is_used END INTERFACE is_used PRIVATE PUBLIC component_index, component_index_constructor, get_index, is_used CONTAINS !------------------------------------------------------------------------------! ! Description: ! ------------ !> Creates index tables for different (aerosol) components !------------------------------------------------------------------------------! SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp ) IMPLICIT NONE INTEGER(iwp) :: i !< INTEGER(iwp) :: jj !< INTEGER(iwp), INTENT(in) :: nlist ! < Maximum number of components INTEGER(iwp), INTENT(inout) :: ncomp !< Number of components TYPE(component_index), INTENT(inout) :: self !< Object containing the indices of different !< aerosol components CHARACTER(len=3), INTENT(in) :: listcomp(nlist) !< List cof component names ncomp = 0 DO WHILE ( listcomp(ncomp+1) /= ' ' .AND. ncomp < nlist ) ncomp = ncomp + 1 ENDDO self%ncomp = ncomp ALLOCATE( self%ind(ncomp), self%comp(ncomp) ) DO i = 1, ncomp self%ind(i) = i ENDDO jj = 1 DO i = 1, nlist IF ( listcomp(i) == '') CYCLE self%comp(jj) = listcomp(i) jj = jj + 1 ENDDO END SUBROUTINE component_index_constructor !------------------------------------------------------------------------------! ! Description: ! ------------ !> Gives the index of a component in the component list !------------------------------------------------------------------------------! INTEGER FUNCTION get_index( self, incomp ) IMPLICIT NONE CHARACTER(len=*), INTENT(in) :: incomp !< Component name INTEGER(iwp) :: i TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different !< aerosol components IF ( ANY( self%comp == incomp ) ) THEN i = 1 DO WHILE ( (self%comp(i) /= incomp) ) i = i + 1 ENDDO get_index = i ELSEIF ( incomp == 'H2O' ) THEN get_index = self%ncomp + 1 ELSE WRITE( message_string, * ) 'Incorrect component name given!' CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 ) ENDIF RETURN END FUNCTION get_index !------------------------------------------------------------------------------! ! Description: ! ------------ !> Tells if the (aerosol) component is being used in the simulation !------------------------------------------------------------------------------! LOGICAL FUNCTION is_used( self, icomp ) IMPLICIT NONE CHARACTER(len=*), INTENT(in) :: icomp !< Component name TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different !< aerosol components IF ( ANY(self%comp == icomp) ) THEN is_used = .TRUE. ELSE is_used = .FALSE. ENDIF END FUNCTION END MODULE salsa_util_mod