! $Id: hgardfou.F90 1992 2014-03-05 13:19:12Z musat $ SUBROUTINE hgardfou(t, tsol, text) USE dimphy USE phys_state_var_mod USE indice_sol_mod IMPLICIT NONE ! ====================================================================== ! Verifier la temperature ! ====================================================================== include "dimensions.h" include "YOMCST.h" include "iniprint.h" REAL t(klon, klev), tsol(klon, nbsrf) CHARACTER *(*) text CHARACTER (LEN=20) :: modname = 'hgardfou' CHARACTER (LEN=80) :: abort_message INTEGER i, k, nsrf REAL zt(klon) INTEGER jadrs(klon), jbad LOGICAL ok LOGICAL firstcall SAVE firstcall DATA firstcall/.TRUE./ !$OMP THREADPRIVATE(firstcall) IF (firstcall) THEN WRITE (lunout, *) 'hgardfou garantit la temperature dans [100,370] K' firstcall = .FALSE. ! DO i = 1, klon ! WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i) ! ENDDO END IF ok = .TRUE. DO k = 1, klev DO i = 1, klon zt(i) = t(i, k) END DO #ifdef CRAY CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad) #else jbad = 0 DO i = 1, klon IF (zt(i)>370.) THEN jbad = jbad + 1 jadrs(jbad) = i END IF END DO #endif IF (jbad>0) THEN ok = .FALSE. DO i = 1, jbad WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', & jadrs(i), k, zt(jadrs(i)), rlon(jadrs(i)), rlat(jadrs(i)), & (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf) END DO END IF #ifdef CRAY CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad) #else jbad = 0 DO i = 1, klon ! IF (zt(i).LT.100.0) THEN IF (zt(i)<50.0) THEN jbad = jbad + 1 jadrs(jbad) = i END IF END DO #endif IF (jbad>0) THEN ok = .FALSE. DO i = 1, jbad WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', & jadrs(i), k, zt(jadrs(i)), rlon(jadrs(i)), rlat(jadrs(i)), & (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf) END DO END IF END DO DO nsrf = 1, nbsrf DO i = 1, klon zt(i) = tsol(i, nsrf) END DO #ifdef CRAY CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad) #else jbad = 0 DO i = 1, klon IF (zt(i)>370.0) THEN jbad = jbad + 1 jadrs(jbad) = i END IF END DO #endif IF (jbad>0) THEN ok = .FALSE. DO i = 1, jbad WRITE (lunout, *) & 'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), & nsrf, zt(jadrs(i)), rlon(jadrs(i)), rlat(jadrs(i)), & pctsrf(jadrs(i), nsrf) END DO END IF #ifdef CRAY CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad) #else jbad = 0 DO i = 1, klon ! IF (zt(i).LT.100.0) THEN IF (zt(i)<50.0) THEN jbad = jbad + 1 jadrs(jbad) = i END IF END DO #endif IF (jbad>0) THEN ok = .FALSE. DO i = 1, jbad WRITE (lunout, *) & 'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), & nsrf, zt(jadrs(i)), rlon(jadrs(i)), rlat(jadrs(i)), & pctsrf(jadrs(i), nsrf) END DO END IF END DO IF (.NOT. ok) THEN abort_message = 'hgardfou s arrete ' // text CALL abort_gcm(modname, abort_message, 1) END IF RETURN END SUBROUTINE hgardfou