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

Last change on this file since 5409 was 5285, checked in by abarral, 7 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.3 KB
RevLine 
[1992]1
[1279]2! $Id: hgardfou.F90 5285 2024-10-28 13:33:29Z evignon $
[2235]3SUBROUTINE hgardfou(t, tsol, text,abortphy)
[2399]4  USE dimphy, ONLY: klon, klev
5  USE phys_state_var_mod, ONLY: pctsrf
6  USE geometry_mod, ONLY: longitude_deg, latitude_deg
7  USE indice_sol_mod, ONLY: nbsrf
[2311]8  USE print_control_mod, ONLY: lunout
[5285]9  USE yomcst_mod_h
[5274]10IMPLICIT NONE
[1992]11  ! ======================================================================
12  ! Verifier la temperature
13  ! ======================================================================
[5274]14
[1992]15  REAL t(klon, klev), tsol(klon, nbsrf)
[2100]16  CHARACTER(len=*), intent(in):: text
[1992]17  CHARACTER (LEN=20) :: modname = 'hgardfou'
[2235]18  INTEGER abortphy
[987]19
[1992]20  INTEGER i, k, nsrf
21  REAL zt(klon)
22  INTEGER jadrs(klon), jbad
23  LOGICAL ok
24
25  LOGICAL firstcall
26  SAVE firstcall
27  DATA firstcall/.TRUE./
28  !$OMP THREADPRIVATE(firstcall)
29
30  IF (firstcall) THEN
31    WRITE (lunout, *) 'hgardfou garantit la temperature dans [100,370] K'
32    firstcall = .FALSE.
33    ! DO i = 1, klon
34    ! WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
35    ! ENDDO
36
37  END IF
38
39  ok = .TRUE.
40  DO k = 1, klev
41    DO i = 1, klon
42      zt(i) = t(i, k)
43    END DO
[524]44#ifdef CRAY
[1992]45    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
[524]46#else
[1992]47    jbad = 0
48    DO i = 1, klon
49      IF (zt(i)>370.) THEN
50        jbad = jbad + 1
51        jadrs(jbad) = i
52      END IF
53    END DO
[524]54#endif
[1992]55    IF (jbad>0) THEN
56      ok = .FALSE.
57      DO i = 1, jbad
58        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
[2399]59          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
60          latitude_deg(jadrs(i)),(pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
[1992]61      END DO
62    END IF
[524]63#ifdef CRAY
[1992]64    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
[524]65#else
[1992]66    jbad = 0
67    DO i = 1, klon
68      ! IF (zt(i).LT.100.0) THEN
69      IF (zt(i)<50.0) THEN
70        jbad = jbad + 1
71        jadrs(jbad) = i
72      END IF
73    END DO
[524]74#endif
[1992]75    IF (jbad>0) THEN
76      ok = .FALSE.
77      DO i = 1, jbad
78        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
[2399]79          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
80          latitude_deg(jadrs(i)), (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
[1992]81      END DO
82    END IF
83  END DO
84
85  DO nsrf = 1, nbsrf
86    DO i = 1, klon
87      zt(i) = tsol(i, nsrf)
88    END DO
[524]89#ifdef CRAY
[1992]90    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
[524]91#else
[1992]92    jbad = 0
93    DO i = 1, klon
94      IF (zt(i)>370.0) THEN
95        jbad = jbad + 1
96        jadrs(jbad) = i
97      END IF
98    END DO
[524]99#endif
[1992]100    IF (jbad>0) THEN
101      ok = .FALSE.
102      DO i = 1, jbad
103        WRITE (lunout, *) &
104          'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
[2399]105          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
106          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
[1992]107      END DO
108    END IF
[524]109#ifdef CRAY
[1992]110    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
[524]111#else
[1992]112    jbad = 0
113    DO i = 1, klon
114      ! IF (zt(i).LT.100.0) THEN
115      IF (zt(i)<50.0) THEN
116        jbad = jbad + 1
117        jadrs(jbad) = i
118      END IF
119    END DO
[524]120#endif
[1992]121    IF (jbad>0) THEN
122      ok = .FALSE.
123      DO i = 1, jbad
124        WRITE (lunout, *) &
125          'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
[2399]126          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
127          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
[1992]128      END DO
129    END IF
130  END DO
[524]131
[2311]132!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
[2235]133  IF (.NOT. ok) abortphy=1
[1992]134
135END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.