source: trunk/LMDZ.VENUS/libf/phyvenus/hgardfou.F @ 2925

!
! $Header: /home/cvsroot/LMDZ4/libf/phylmd/hgardfou.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
!
      SUBROUTINE hgardfou (t,tsol,text)

      use dimphy, only: klon,klev
      IMPLICIT none
c======================================================================
c Check temperature
c======================================================================
!#include "YOMCST.h"
      REAL,INTENT(IN) :: t(klon,klev), tsol(klon)
      CHARACTER(len=*),INTENT(in):: text
C
      INTEGER :: i, k
      REAL :: zt(klon) ! to locally store temperature fields
      REAL,PARAMETER :: tmin=15.0   ! Minimum temperature
      REAL,PARAMETER :: tmax=1200.0 ! Maximum temperature
      INTEGER :: jbad ! number of problematic points
      INTEGER :: jadrs(klon) ! stored index of problematic points
      LOGICAL :: ok ! .true. as long as everything OK
      CHARACTER(len=100) :: textout
c
      LOGICAL,SAVE :: firstcall=.TRUE.

      IF (firstcall) THEN
         PRINT*, 'hgardfou checks if temperature is in [15,1200] K'
         firstcall = .FALSE.
      ENDIF
c
      ok = .TRUE.

      !1. Atmospheric temperatures 
      DO k = 1, klev
         DO i = 1, klon
            zt(i) = t(i,k)
         ENDDO

         ! Look for temperatures that are not numbers (NaN, Infinity, etc.)
         jbad=0
         DO i=1,klon
           IF (zt(i).NE.zt(i)) THEN
             jbad = jbad + 1
             jadrs(jbad) = i
           ENDIF
         ENDDO
         
         IF (jbad .GT. 0) THEN
           ok = .FALSE.
           DO i = 1, jbad
             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
           ENDDO
         ENDIF
         
         
         ! Look for temperatures greater than tmax
#ifdef CRAY
         CALL WHENFGT(klon, zt, 1, tmax, jadrs, jbad)
#else
         jbad = 0
         DO i = 1, klon
           IF (zt(i).GT.tmax) THEN
            jbad = jbad + 1
            jadrs(jbad) = i
           ENDIF
         ENDDO
#endif
         IF (jbad .GT. 0) THEN
           ok = .FALSE.
           DO i = 1, jbad
             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
           ENDDO
         ENDIF

         ! Look for temperatures lower than tmin
#ifdef CRAY
         CALL WHENFLT(klon, zt, 1, tmin, jadrs, jbad)
#else
         jbad = 0
         DO i = 1, klon
           IF (zt(i).LT.tmin) THEN
            jbad = jbad + 1
            jadrs(jbad) = i
           ENDIF
         ENDDO
#endif
         IF (jbad .GT. 0) THEN
           ok = .FALSE.
           DO i = 1, jbad
             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
           ENDDO
         ENDIF
      ENDDO ! of DO k = 1, klev

      !2. surface temperatures
      DO i = 1, klon
         zt(i) = tsol(i)
      ENDDO

      ! Look for temperatures that are not numbers (NaN, Infinity, etc.)
      jbad=0
      DO i=1,klon
        IF (zt(i).NE.zt(i)) THEN
          jbad = jbad + 1
          jadrs(jbad) = i
        ENDIF
      ENDDO
         
      IF (jbad .GT. 0) THEN
        ok = .FALSE.
        DO i = 1, jbad
          PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
        ENDDO
      ENDIF

      ! Look for temperatures greater then tmax
#ifdef CRAY
      CALL WHENFGT(klon, zt, 1, tmax, jadrs, jbad)
#else
      jbad = 0
      DO i = 1, klon
        IF (zt(i).GT.tmax) THEN
           jbad = jbad + 1
           jadrs(jbad) = i
        ENDIF
      ENDDO
#endif
      IF (jbad .GT. 0) THEN
        ok = .FALSE.
        DO i = 1, jbad
          PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
        ENDDO
      ENDIF

      ! Look for temperatures lower than tmin
#ifdef CRAY
      CALL WHENFLT(klon, zt, 1, tmin, jadrs, jbad)
#else
      jbad = 0
      DO i = 1, klon
        IF (zt(i).LT.tmin) THEN
           jbad = jbad + 1
           jadrs(jbad) = i
        ENDIF
      ENDDO
#endif
      IF (jbad .GT. 0) THEN
        ok = .FALSE.
        DO i = 1, jbad
          PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
        ENDDO
      ENDIF
c
      IF (.NOT. ok) THEN
         textout='hgardfou stops '//text
         CALL abort_physic("hgardfou", textout, 1)
      ENDIF

      END