source: LMDZ6/branches/contrails/libf/phylmd/hgardfou.F90 @ 5450

Last change on this file since 5450 was 5285, checked in by abarral, 8 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
Line 
1
2! $Id: hgardfou.F90 5285 2024-10-28 13:33:29Z aborella $
3SUBROUTINE hgardfou(t, tsol, text,abortphy)
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
8  USE print_control_mod, ONLY: lunout
9  USE yomcst_mod_h
10IMPLICIT NONE
11  ! ======================================================================
12  ! Verifier la temperature
13  ! ======================================================================
14
15  REAL t(klon, klev), tsol(klon, nbsrf)
16  CHARACTER(len=*), intent(in):: text
17  CHARACTER (LEN=20) :: modname = 'hgardfou'
18  INTEGER abortphy
19
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
44#ifdef CRAY
45    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
46#else
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
54#endif
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 =', &
59          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
60          latitude_deg(jadrs(i)),(pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
61      END DO
62    END IF
63#ifdef CRAY
64    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
65#else
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
74#endif
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 =', &
79          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
80          latitude_deg(jadrs(i)), (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
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
89#ifdef CRAY
90    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
91#else
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
99#endif
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), &
105          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
106          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
107      END DO
108    END IF
109#ifdef CRAY
110    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
111#else
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
120#endif
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), &
126          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
127          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
128      END DO
129    END IF
130  END DO
131
132!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
133  IF (.NOT. ok) abortphy=1
134
135END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.