source: LMDZ6/trunk/libf/phylmd/hgardfou.F90 @ 5277

! $Id: hgardfou.F90 5274 2024-10-25 13:41:23Z abarral $
SUBROUTINE hgardfou(t, tsol, text,abortphy)
  USE dimphy, ONLY: klon, klev
  USE phys_state_var_mod, ONLY: pctsrf
  USE geometry_mod, ONLY: longitude_deg, latitude_deg
  USE indice_sol_mod, ONLY: nbsrf
  USE print_control_mod, ONLY: lunout
  USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
          , R_ecc, R_peri, R_incl                                      &
          , RA, RG, R1SA                                         &
          , RSIGMA                                                     &
          , R, RMD, RMV, RD, RV, RCPD                    &
          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
          , RCW, RCS                                                 &
          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
          , RALPD, RBETD, RGAMD
IMPLICIT NONE
  ! ======================================================================
  ! Verifier la temperature
  ! ======================================================================

  REAL t(klon, klev), tsol(klon, nbsrf)
  CHARACTER(len=*), intent(in):: text
  CHARACTER (LEN=20) :: modname = 'hgardfou'
  INTEGER abortphy

  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)), longitude_deg(jadrs(i)), &
          latitude_deg(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)), longitude_deg(jadrs(i)), &
          latitude_deg(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)), longitude_deg(jadrs(i)), &
          latitude_deg(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)), longitude_deg(jadrs(i)), &
          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
      END DO
    END IF
  END DO

!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
  IF (.NOT. ok) abortphy=1

END SUBROUTINE hgardfou