source: LMDZ4/trunk/libf/phy_IPCC_AR4/hgardfou.F @ 868

Last change on this file since 868 was 868, checked in by Laurent Fairhead, 17 years ago

Preparation du remplacement de la physique utilisee pour l'exercice IPCC_AR4
par la version de la physique avec thermique. On garde le repertoire phylmd
pour un petit moment pour que les utilisateurs ne soient pas trop perdus ...
phy_IPCC_AR4 = phylmd
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.8 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE hgardfou (t,tsol,text)
5      use dimphy
6      IMPLICIT none
7c======================================================================
8c Verifier la temperature
9c======================================================================
10cym#include "dimensions.h"
11cym#include "dimphy.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./
25      IF (firstcall) THEN
26         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
27         firstcall = .FALSE.
28      ENDIF
29c
30      ok = .TRUE.
31      DO k = 1, klev
32         DO i = 1, klon
33            zt(i) = t(i,k)
34         ENDDO
35#ifdef CRAY
36         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
37#else
38         jbad = 0
39         DO i = 1, klon
40         IF (zt(i).GT.370.0) THEN
41            jbad = jbad + 1
42            jadrs(jbad) = i
43         ENDIF
44         ENDDO
45#endif
46         IF (jbad .GT. 0) THEN
47           ok = .FALSE.
48           DO i = 1, jbad
49             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
50           ENDDO
51         ENDIF
52#ifdef CRAY
53         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
54#else
55         jbad = 0
56         DO i = 1, klon
57!         IF (zt(i).LT.100.0) THEN
58         IF (zt(i).LT.50.0) THEN
59            jbad = jbad + 1
60            jadrs(jbad) = i
61         ENDIF
62         ENDDO
63#endif
64         IF (jbad .GT. 0) THEN
65           ok = .FALSE.
66           DO i = 1, jbad
67             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
68           ENDDO
69         ENDIF
70      ENDDO
71c
72      DO nsrf = 1, nbsrf
73         DO i = 1, klon
74            zt(i) = tsol(i,nsrf)
75         ENDDO
76#ifdef CRAY
77         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
78#else
79         jbad = 0
80         DO i = 1, klon
81         IF (zt(i).GT.370.0) THEN
82            jbad = jbad + 1
83            jadrs(jbad) = i
84         ENDIF
85         ENDDO
86#endif
87         IF (jbad .GT. 0) THEN
88           ok = .FALSE.
89           DO i = 1, jbad
90             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i))
91           ENDDO
92         ENDIF
93#ifdef CRAY
94         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
95#else
96         jbad = 0
97         DO i = 1, klon
98!         IF (zt(i).LT.100.0) THEN
99         IF (zt(i).LT.50.0) THEN
100            jbad = jbad + 1
101            jadrs(jbad) = i
102         ENDIF
103         ENDDO
104#endif
105         IF (jbad .GT. 0) THEN
106           ok = .FALSE.
107           DO i = 1, jbad
108             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i))
109           ENDDO
110         ENDIF
111      ENDDO
112c
113      IF (.NOT. ok) THEN
114         PRINT*, 'hgardfou s arrete ', text
115         CALL abort
116      ENDIF
117
118      RETURN
119      END
Note: See TracBrowser for help on using the repository browser.