! $Id: hgardfou.F90 5144 2024-07-29 21:01:04Z fairhead $ SUBROUTINE hgardfou(t, tsol, text, abortphy) USE dimphy, ONLY: klon, klev USE phys_state_var_mod, ONLY: pctsrf USE lmdz_geometry, ONLY: longitude_deg, latitude_deg USE indice_sol_mod, ONLY: nbsrf USE lmdz_print_control, ONLY: lunout USE lmdz_yomcst 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 jbad = 0 DO i = 1, klon IF (zt(i)>370.) THEN jbad = jbad + 1 jadrs(jbad) = i END IF END DO 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 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 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 jbad = 0 DO i = 1, klon IF (zt(i)>370.0) THEN jbad = jbad + 1 jadrs(jbad) = i END IF END DO 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 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 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