source: trunk/LMDZ.TITAN/libf/phytitan/hgardfou.F @ 1243

Last change on this file since 1243 was 102, checked in by slebonnois, 14 years ago

SL : corrections et modifications dans phytitan correspondant a celles
faites apres compilation Venus. Titan pas encore compile.

File size: 2.7 KB
Line 
1!
2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/hgardfou.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
3!
4      SUBROUTINE hgardfou (t,tsol,text)
5c======================================================================
6c Verifier la temperature
7c======================================================================
8      use dimphy
9      IMPLICIT none
10#include "dimensions.h"
11#include "YOMCST.h"
12      REAL t(klon,klev), tsol(klon)
13      CHARACTER*(*) text
14C
15      INTEGER i, k
16      REAL zt(klon)
17      INTEGER jadrs(klon), jbad
18      LOGICAL ok
19c
20      LOGICAL firstcall
21      SAVE firstcall
22      DATA firstcall /.TRUE./
23      IF (firstcall) THEN
24         PRINT*, 'hgardfou garantit la temperature dans [20,1200] K'
25         firstcall = .FALSE.
26      ENDIF
27c
28      ok = .TRUE.
29      DO k = 1, klev
30         DO i = 1, klon
31            zt(i) = t(i,k)
32         ENDDO
33#ifdef CRAY
34         CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)
35#else
36         jbad = 0
37         DO i = 1, klon
38         IF (zt(i).GT.1200.0) THEN
39            jbad = jbad + 1
40            jadrs(jbad) = i
41         ENDIF
42         ENDDO
43#endif
44         IF (jbad .GT. 0) THEN
45           ok = .FALSE.
46           DO i = 1, jbad
47             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
48           ENDDO
49         ENDIF
50#ifdef CRAY
51         CALL WHENFLT(klon, zt, 1, 20.0, jadrs, jbad)
52#else
53         jbad = 0
54         DO i = 1, klon
55         IF (zt(i).LT.20.0) THEN
56            jbad = jbad + 1
57            jadrs(jbad) = i
58         ENDIF
59         ENDDO
60#endif
61         IF (jbad .GT. 0) THEN
62           ok = .FALSE.
63           DO i = 1, jbad
64             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
65           ENDDO
66         ENDIF
67      ENDDO
68c
69         DO i = 1, klon
70            zt(i) = tsol(i)
71         ENDDO
72#ifdef CRAY
73         CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)
74#else
75         jbad = 0
76         DO i = 1, klon
77         IF (zt(i).GT.1200.0) THEN
78            jbad = jbad + 1
79            jadrs(jbad) = i
80         ENDIF
81         ENDDO
82#endif
83         IF (jbad .GT. 0) THEN
84           ok = .FALSE.
85           DO i = 1, jbad
86             PRINT *,'i,temperature sol =',jadrs(i),zt(jadrs(i))
87           ENDDO
88         ENDIF
89#ifdef CRAY
90         CALL WHENFLT(klon, zt, 1, 20.0, jadrs, jbad)
91#else
92         jbad = 0
93         DO i = 1, klon
94         IF (zt(i).LT.20.0) THEN
95            jbad = jbad + 1
96            jadrs(jbad) = i
97         ENDIF
98         ENDDO
99#endif
100         IF (jbad .GT. 0) THEN
101           ok = .FALSE.
102           DO i = 1, jbad
103             PRINT *,'i,temperature sol =',jadrs(i),zt(jadrs(i))
104           ENDDO
105         ENDIF
106c
107      IF (.NOT. ok) THEN
108         PRINT*, 'hgardfou s arrete ', text
109         CALL abort
110      ENDIF
111
112      RETURN
113      END
Note: See TracBrowser for help on using the repository browser.