! ! $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