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

Last change on this file since 984 was 972, checked in by lmdzadmin, 16 years ago

Version thermique FH/CRio
Ajout tests cas physiques non pris en comptes et ajout/enleve prints
Nouvelle routine thermcell_flux2.F90
IM
  • 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./
25      IF (firstcall) THEN
26         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
27         firstcall = .FALSE.
28c        DO i = 1, klon
29c         print*,'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
30c        ENDDO
31c
32      ENDIF
33c
34      ok = .TRUE.
35      DO k = 1, klev
36         DO i = 1, klon
37            zt(i) = t(i,k)
38         ENDDO
39#ifdef CRAY
40         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
41#else
42         jbad = 0
43         DO i = 1, klon
44         IF (zt(i).GT.370.0) THEN
45            jbad = jbad + 1
46            jadrs(jbad) = i
47         ENDIF
48         ENDDO
49#endif
50         IF (jbad .GT. 0) THEN
51           ok = .FALSE.
52           DO i = 1, jbad
53            PRINT *,'i,k,temperature rlon rlat=',jadrs(i),k,zt(jadrs(i))
54     $      ,rlon(jadrs(i)),rlat(jadrs(i))
55           ENDDO
56         ENDIF
57#ifdef CRAY
58         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
59#else
60         jbad = 0
61         DO i = 1, klon
62!         IF (zt(i).LT.100.0) THEN
63         IF (zt(i).LT.50.0) THEN
64            jbad = jbad + 1
65            jadrs(jbad) = i
66         ENDIF
67         ENDDO
68#endif
69         IF (jbad .GT. 0) THEN
70           ok = .FALSE.
71           DO i = 1, jbad
72            PRINT *,'i,k,temperature rlon rlat=',jadrs(i),k,zt(jadrs(i))
73     $      ,rlon(jadrs(i)),rlat(jadrs(i))
74           ENDDO
75         ENDIF
76      ENDDO
77c
78      DO nsrf = 1, nbsrf
79         DO i = 1, klon
80            zt(i) = tsol(i,nsrf)
81         ENDDO
82#ifdef CRAY
83         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
84#else
85         jbad = 0
86         DO i = 1, klon
87         IF (zt(i).GT.370.0) THEN
88            jbad = jbad + 1
89            jadrs(jbad) = i
90         ENDIF
91         ENDDO
92#endif
93         IF (jbad .GT. 0) THEN
94           ok = .FALSE.
95           DO i = 1, jbad
96             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i)),
97     $       rlon(jadrs(i)),rlat(jadrs(i))
98           ENDDO
99         ENDIF
100#ifdef CRAY
101         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
102#else
103         jbad = 0
104         DO i = 1, klon
105!         IF (zt(i).LT.100.0) THEN
106         IF (zt(i).LT.50.0) THEN
107            jbad = jbad + 1
108            jadrs(jbad) = i
109         ENDIF
110         ENDDO
111#endif
112         IF (jbad .GT. 0) THEN
113           ok = .FALSE.
114           DO i = 1, jbad
115             PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i)),
116     $       rlon(jadrs(i)),rlat(jadrs(i))
117           ENDDO
118         ENDIF
119      ENDDO
120c
121      IF (.NOT. ok) THEN
122         PRINT*, 'hgardfou s arrete ', text
123         CALL abort
124      ENDIF
125
126      RETURN
127      END
Note: See TracBrowser for help on using the repository browser.