source: LMDZ5/trunk/libf/phylmd/hgardfou.F90 @ 3627

Last change on this file since 3627 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
RevLine 
[1992]1
[1279]2! $Id: hgardfou.F90 2399 2015-11-20 16:23:28Z lguez $
[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
[1992]9  IMPLICIT NONE
10  ! ======================================================================
11  ! Verifier la temperature
12  ! ======================================================================
13  include "YOMCST.h"
14  REAL t(klon, klev), tsol(klon, nbsrf)
[2100]15  CHARACTER(len=*), intent(in):: text
[1992]16  CHARACTER (LEN=20) :: modname = 'hgardfou'
[2235]17  INTEGER abortphy
[987]18
[1992]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
[524]43#ifdef CRAY
[1992]44    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
[524]45#else
[1992]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
[524]53#endif
[1992]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 =', &
[2399]58          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
59          latitude_deg(jadrs(i)),(pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
[1992]60      END DO
61    END IF
[524]62#ifdef CRAY
[1992]63    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
[524]64#else
[1992]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
[524]73#endif
[1992]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 =', &
[2399]78          jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
79          latitude_deg(jadrs(i)), (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
[1992]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
[524]88#ifdef CRAY
[1992]89    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
[524]90#else
[1992]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
[524]98#endif
[1992]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), &
[2399]104          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
105          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
[1992]106      END DO
107    END IF
[524]108#ifdef CRAY
[1992]109    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
[524]110#else
[1992]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
[524]119#endif
[1992]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), &
[2399]125          nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
126          latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
[1992]127      END DO
128    END IF
129  END DO
[524]130
[2311]131!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
[2235]132  IF (.NOT. ok) abortphy=1
[1992]133
134END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.