source: LMDZ5/branches/testing/libf/phylmd/hgardfou.F90 @ 3998

Last change on this file since 3998 was 2435, checked in by Laurent Fairhead, 9 years ago

Merged trunk changes r2396:2434 into testing branch

  • 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 2435 2016-01-28 16:02:13Z emillour $
[2258]3SUBROUTINE hgardfou(t, tsol, text,abortphy)
[2435]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
[2408]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)
[2160]15  CHARACTER(len=*), intent(in):: text
[1992]16  CHARACTER (LEN=20) :: modname = 'hgardfou'
[2258]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 =', &
[2435]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 =', &
[2435]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), &
[2435]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), &
[2435]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
[2408]131!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
[2258]132  IF (.NOT. ok) abortphy=1
[1992]133
134END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.