source: LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/hgardfou.F90 @ 3373

Last change on this file since 3373 was 2399, checked in by Ehouarn Millour, 9 years ago

Follow-up from commit 2395: get rid of rlon and rlat, longitude_deg and latitude_deg (from module geometry_mod) should be used instead. Longitudes and latitudes are no longer loaded from startphy.nc but inherited from dynamics (and compatibility with values in startphy.nc is checked). This will change bench results because of roundoffs differences between the two.
EM

  • 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 2399 2015-11-20 16:23:28Z idelkadi $
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  IMPLICIT NONE
10  ! ======================================================================
11  ! Verifier la temperature
12  ! ======================================================================
13  include "YOMCST.h"
14  REAL t(klon, klev), tsol(klon, nbsrf)
15  CHARACTER(len=*), intent(in):: text
16  CHARACTER (LEN=20) :: modname = 'hgardfou'
17  INTEGER abortphy
18
19  INTEGER i, k, nsrf
20  REAL zt(klon)
21  INTEGER jadrs(klon), jbad
22  LOGICAL ok
23
24  LOGICAL firstcall
25  SAVE firstcall
26  DATA firstcall/.TRUE./
27  !$OMP THREADPRIVATE(firstcall)
28
29  IF (firstcall) THEN
30    WRITE (lunout, *) 'hgardfou garantit la temperature dans [100,370] K'
31    firstcall = .FALSE.
32    ! DO i = 1, klon
33    ! WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
34    ! ENDDO
35
36  END IF
37
38  ok = .TRUE.
39  DO k = 1, klev
40    DO i = 1, klon
41      zt(i) = t(i, k)
42    END DO
43#ifdef CRAY
44    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
45#else
46    jbad = 0
47    DO i = 1, klon
48      IF (zt(i)>370.) THEN
49        jbad = jbad + 1
50        jadrs(jbad) = i
51      END IF
52    END DO
53#endif
54    IF (jbad>0) THEN
55      ok = .FALSE.
56      DO i = 1, jbad
57        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
58          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
59          latitude_deg(jadrs(i)),(pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
60      END DO
61    END IF
62#ifdef CRAY
63    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
64#else
65    jbad = 0
66    DO i = 1, klon
67      ! IF (zt(i).LT.100.0) THEN
68      IF (zt(i)<50.0) THEN
69        jbad = jbad + 1
70        jadrs(jbad) = i
71      END IF
72    END DO
73#endif
74    IF (jbad>0) THEN
75      ok = .FALSE.
76      DO i = 1, jbad
77        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
78          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
79          latitude_deg(jadrs(i)), (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
80      END DO
81    END IF
82  END DO
83
84  DO nsrf = 1, nbsrf
85    DO i = 1, klon
86      zt(i) = tsol(i, nsrf)
87    END DO
88#ifdef CRAY
89    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
90#else
91    jbad = 0
92    DO i = 1, klon
93      IF (zt(i)>370.0) THEN
94        jbad = jbad + 1
95        jadrs(jbad) = i
96      END IF
97    END DO
98#endif
99    IF (jbad>0) THEN
100      ok = .FALSE.
101      DO i = 1, jbad
102        WRITE (lunout, *) &
103          'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
104          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
105          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
106      END DO
107    END IF
108#ifdef CRAY
109    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
110#else
111    jbad = 0
112    DO i = 1, klon
113      ! IF (zt(i).LT.100.0) THEN
114      IF (zt(i)<50.0) THEN
115        jbad = jbad + 1
116        jadrs(jbad) = i
117      END IF
118    END DO
119#endif
120    IF (jbad>0) THEN
121      ok = .FALSE.
122      DO i = 1, jbad
123        WRITE (lunout, *) &
124          'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
125          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
126          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
127      END DO
128    END IF
129  END DO
130
131!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
132  IF (.NOT. ok) abortphy=1
133
134END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.