source: LMDZ.3.3/branches/rel-LF/libf/phylmd/hgardfou.F @ 201

Last change on this file since 201 was 177, checked in by lmdzadmin, 24 years ago

Lots of stuff, plus particulierement:

  • appel a ORCHIDEE en etat de marche (pb de grille subsiste)
  • modifs de Pascale sur soil dans le cas ou ok_veget=false -
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.7 KB
Line 
1      SUBROUTINE hgardfou (t,tsol,text)
2      IMPLICIT none
3c======================================================================
4c Verifier la temperature
5c======================================================================
6#include "dimensions.h"
7#include "dimphy.h"
8#include "YOMCST.h"
9#include "indicesol.h"
10      REAL t(klon,klev), tsol(klon,nbsrf)
11      CHARACTER*(*) text
12C
13      INTEGER i, k, nsrf
14      REAL zt(klon)
15      INTEGER jadrs(klon), jbad
16      LOGICAL ok
17c
18      LOGICAL firstcall
19      SAVE firstcall
20      DATA firstcall /.TRUE./
21      IF (firstcall) THEN
22         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
23         firstcall = .FALSE.
24      ENDIF
25c
26      ok = .TRUE.
27      DO k = 1, klev
28         DO i = 1, klon
29            zt(i) = t(i,k)
30         ENDDO
31#ifdef CRAY
32         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
33#else
34         jbad = 0
35         DO i = 1, klon
36         IF (zt(i).GT.370.0) THEN
37            jbad = jbad + 1
38            jadrs(jbad) = i
39         ENDIF
40         ENDDO
41#endif
42         IF (jbad .GT. 0) THEN
43           ok = .FALSE.
44           DO i = 1, jbad
45             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
46           ENDDO
47         ENDIF
48#ifdef CRAY
49         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
50#else
51         jbad = 0
52         DO i = 1, klon
53!         IF (zt(i).LT.100.0) THEN
54         IF (zt(i).LT.50.0) THEN
55            jbad = jbad + 1
56            jadrs(jbad) = i
57         ENDIF
58         ENDDO
59#endif
60         IF (jbad .GT. 0) THEN
61           ok = .FALSE.
62           DO i = 1, jbad
63             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
64           ENDDO
65         ENDIF
66      ENDDO
67c
68      DO nsrf = 1, nbsrf
69         DO i = 1, klon
70            zt(i) = tsol(i,nsrf)
71         ENDDO
72#ifdef CRAY
73         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
74#else
75         jbad = 0
76         DO i = 1, klon
77         IF (zt(i).GT.370.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,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i))
87           ENDDO
88         ENDIF
89#ifdef CRAY
90         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
91#else
92         jbad = 0
93         DO i = 1, klon
94!         IF (zt(i).LT.100.0) THEN
95         IF (zt(i).LT.50.0) THEN
96            jbad = jbad + 1
97            jadrs(jbad) = i
98         ENDIF
99         ENDDO
100#endif
101         IF (jbad .GT. 0) THEN
102           ok = .FALSE.
103           DO i = 1, jbad
104             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i))
105           ENDDO
106         ENDIF
107      ENDDO
108c
109      IF (.NOT. ok) THEN
110         PRINT*, 'hgardfou s arrete ', text
111         CALL abort
112      ENDIF
113
114      RETURN
115      END
Note: See TracBrowser for help on using the repository browser.