Changeset 3001 for palm/trunk/SOURCE


Ignore:
Timestamp:
Apr 20, 2018 12:27:13 PM (7 years ago)
Author:
suehring
Message:

Bugfix, replace MERGE function by an if-condition in the anterpolation in order to avoid floating-point exceptions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r2997 r3001  
    2525! -----------------
    2626! $Id$
     27! Bugfix, replace MERGE function by an if-condition in the anterpolation (in
     28! order to avoid floating-point exceptions).
     29!
     30! 2997 2018-04-19 13:35:17Z suehring
    2731! Mask topography grid points in anterpolation
    2832!
     
    57935797!
    57945798!--             In case all child grid points are inside topography, i.e.
    5795 !--             cellsum is zero, also parent solution would have zero values at
    5796 !--             that point, which may cause problems in particular for the
    5797 !--             temperature. Therefore, in case cellsum is zero, keep the
    5798 !--             parent solution at this point.
    5799                 fc(kk,jj,ii) = MERGE( ( 1.0_wp - fra ) * fc(kk,jj,ii) +        &
    5800                                       fra * cellsum  /                         &
    5801                                       REAL( ijkfc(kk,jj,ii), KIND = wp ),      &
    5802                                       fc(kk,jj,ii),                            &
    5803                                       cellsum /= 0.0_wp )      
     5799!--             ijkfc and cellsum are zero, also parent solution would have
     5800!--             zero values at that grid point, which may cause problems in
     5801!--             particular for the temperature. Therefore, in case cellsum is
     5802!--             zero, keep the parent solution at this point.
     5803                IF ( ijkfc(kk,jj,ii) /= 0 )  THEN
     5804                   fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +            &
     5805                                    fra * cellsum  /                           &
     5806                                    REAL( ijkfc(kk,jj,ii), KIND=wp )
     5807                ENDIF 
    58045808
    58055809             ENDDO
Note: See TracChangeset for help on using the changeset viewer.