*IF DEF,A13_1A,OR,DEF,A13_1B,OR,DEF,A13_1C,OR,DEF,RECON                    NEGZERO1.2      
*IF DEF,T3E                                                                PXNEGZRO.1      
C ******************************COPYRIGHT******************************    NEGZERO1.3      
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved.    NEGZERO1.4      
C                                                                          NEGZERO1.5      
C Use, duplication or disclosure of this code is subject to the            NEGZERO1.6      
C restrictions as set forth in the contract.                               NEGZERO1.7      
C                                                                          NEGZERO1.8      
C                Meteorological Office                                     NEGZERO1.9      
C                London Road                                               NEGZERO1.10     
C                BRACKNELL                                                 NEGZERO1.11     
C                Berkshire UK                                              NEGZERO1.12     
C                RG12 2SZ                                                  NEGZERO1.13     
C                                                                          NEGZERO1.14     
C If no contract has been raised with this copy of the code, the use,      NEGZERO1.15     
C duplication or disclosure of it is strictly prohibited.  Permission      NEGZERO1.16     
C to do so must first be obtained in writing from the Head of Numerical    NEGZERO1.17     
C Modelling at the above address.                                          NEGZERO1.18     
C ******************************COPYRIGHT******************************    NEGZERO1.19     
!                                                                          NEGZERO1.20     
! + Removes negative zeros from field                                      NEGZERO1.21     
! Requires Fortran 90 Compiler                                             NEGZERO1.22     
!                                                                          NEGZERO1.23     
! Subroutine interface                                                     NEGZERO1.24     
                                                                           NEGZERO1.25     

      SUBROUTINE REMOVE_NEGATIVE_ZERO(                                      2NEGZERO1.26     
     &  FIELD,P_FIELD,LEVELS)                                              NEGZERO1.27     
                                                                           NEGZERO1.28     
      IMPLICIT NONE                                                        NEGZERO1.29     
                                                                           NEGZERO1.30     
      INTEGER                                                              NEGZERO1.31     
     &   P_FIELD    ! IN: horizontal dimension of field                    NEGZERO1.32     
     &,  LEVELS     ! IN: number of levels                                 NEGZERO1.33     
                                                                           NEGZERO1.34     
      INTEGER                                                              NEGZERO1.35     
     &   FIELD(P_FIELD,LEVELS)                                             NEGZERO1.36     
                    ! IN/OUT: Field to check and update                    NEGZERO1.37     
! Note: FIELD in the calling routine should be of type REAL                NEGZERO1.38     
! The type INTEGER is used here to allow us to perform bitwise             NEGZERO1.39     
! operations on it.                                                        NEGZERO1.40     
                                                                           NEGZERO1.41     
! Local variables                                                          NEGZERO1.42     
      INTEGER                                                              NEGZERO1.43     
     &  I,K                                                                NEGZERO1.44     
                                                                           NEGZERO1.45     
      INTEGER                                                              NEGZERO1.46     
     &  minus_zero,mask,word_length                                        NEGZERO1.47     
                                                                           NEGZERO1.48     
      word_length=8*kind(minus_zero)                                       NEGZERO1.49     
                                                                           NEGZERO1.50     
      minus_zero=shiftl(1,word_length-1)                                   NEGZERO1.51     
      mask=shiftl(0,word_length-1)                                         NEGZERO1.52     
                                                                           NEGZERO1.53     
      DO K=1,LEVELS                                                        NEGZERO1.54     
        DO I=1,P_FIELD                                                     NEGZERO1.55     
                                                                           NEGZERO1.56     
          IF (IEOR(FIELD(I,K), minus_zero) .EQ. mask) FIELD(I,K)=mask      NEGZERO1.57     
                                                                           NEGZERO1.58     
        ENDDO                                                              NEGZERO1.59     
      ENDDO                                                                NEGZERO1.60     
                                                                           NEGZERO1.61     
      RETURN                                                               NEGZERO1.62     
      END                                                                  NEGZERO1.63     
*ENDIF                                                                     PXNEGZRO.2      
*ENDIF                                                                     NEGZERO1.64