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

Last change on this file since 4106 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
Line 
1
2! $Id: hgardfou.F90 2435 2016-01-28 16:02:13Z acozic $
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.