source: LMDZ4/trunk/libf/phylmd/hgardfou.F @ 1054

Last change on this file since 1054 was 987, checked in by Laurent Fairhead, 16 years ago

Du nettoyage sur le parallelisme, inclusion de nouvelles interfaces pour OPA9
et ORCHIDEE YM
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE hgardfou (t,tsol,text)
5      use dimphy
6      use phys_state_var_mod
7      IMPLICIT none
8c======================================================================
9c Verifier la temperature
10c======================================================================
11#include "dimensions.h"
12#include "YOMCST.h"
13#include "indicesol.h"
14      REAL t(klon,klev), tsol(klon,nbsrf)
15      CHARACTER*(*) text
16C
17      INTEGER i, k, nsrf
18      REAL zt(klon)
19      INTEGER jadrs(klon), jbad
20      LOGICAL ok
21c
22      LOGICAL firstcall
23      SAVE firstcall
24      DATA firstcall /.TRUE./
25c$OMP THREADPRIVATE(firstcall)
26
27      IF (firstcall) THEN
28         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
29         firstcall = .FALSE.
30c        DO i = 1, klon
31c         print*,'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
32c        ENDDO
33c
34      ENDIF
35c
36      ok = .TRUE.
37      DO k = 1, klev
38         DO i = 1, klon
39            zt(i) = t(i,k)
40         ENDDO
41#ifdef CRAY
42         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
43#else
44         jbad = 0
45         DO i = 1, klon
46         IF (zt(i).GT.370.0) THEN
47            jbad = jbad + 1
48            jadrs(jbad) = i
49         ENDIF
50         ENDDO
51#endif
52         IF (jbad .GT. 0) THEN
53           ok = .FALSE.
54           DO i = 1, jbad
55            PRINT *,'i,k,temperature rlon rlat=',jadrs(i),k,zt(jadrs(i))
56     $      ,rlon(jadrs(i)),rlat(jadrs(i))
57           ENDDO
58         ENDIF
59#ifdef CRAY
60         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
61#else
62         jbad = 0
63         DO i = 1, klon
64!         IF (zt(i).LT.100.0) THEN
65         IF (zt(i).LT.50.0) THEN
66            jbad = jbad + 1
67            jadrs(jbad) = i
68         ENDIF
69         ENDDO
70#endif
71         IF (jbad .GT. 0) THEN
72           ok = .FALSE.
73           DO i = 1, jbad
74            PRINT *,'i,k,temperature rlon rlat=',jadrs(i),k,zt(jadrs(i))
75     $      ,rlon(jadrs(i)),rlat(jadrs(i))
76           ENDDO
77         ENDIF
78      ENDDO
79c
80      DO nsrf = 1, nbsrf
81         DO i = 1, klon
82            zt(i) = tsol(i,nsrf)
83         ENDDO
84#ifdef CRAY
85         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
86#else
87         jbad = 0
88         DO i = 1, klon
89         IF (zt(i).GT.370.0) THEN
90            jbad = jbad + 1
91            jadrs(jbad) = i
92         ENDIF
93         ENDDO
94#endif
95         IF (jbad .GT. 0) THEN
96           ok = .FALSE.
97           DO i = 1, jbad
98             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i)),
99     $       rlon(jadrs(i)),rlat(jadrs(i))
100           ENDDO
101         ENDIF
102#ifdef CRAY
103         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
104#else
105         jbad = 0
106         DO i = 1, klon
107!         IF (zt(i).LT.100.0) THEN
108         IF (zt(i).LT.50.0) THEN
109            jbad = jbad + 1
110            jadrs(jbad) = i
111         ENDIF
112         ENDDO
113#endif
114         IF (jbad .GT. 0) THEN
115           ok = .FALSE.
116           DO i = 1, jbad
117             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i)),
118     $       rlon(jadrs(i)),rlat(jadrs(i))
119           ENDDO
120         ENDIF
121      ENDDO
122c
123      IF (.NOT. ok) THEN
124         PRINT*, 'hgardfou s arrete ', text
125         CALL abort
126      ENDIF
127
128      RETURN
129      END
Note: See TracBrowser for help on using the repository browser.