source: LMDZ4/branches/LMDZ4_V3_patches/libf/phylmd/hgardfou.F @ 4588

Last change on this file since 4588 was 943, checked in by lmdzadmin, 17 years ago

Ajout coordonnees geographiques et pourcentages pour les plantages
IM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
RevLine 
[524]1!
2! $Header$
3!
[943]4      SUBROUTINE hgardfou (rlon,rlat,pctsrf,t,tsol,text)
[766]5      use dimphy
[524]6      IMPLICIT none
7c======================================================================
8c Verifier la temperature
9c======================================================================
[943]10#include "dimensions.h"
[766]11cym#include "dimphy.h"
[524]12#include "YOMCST.h"
13#include "indicesol.h"
[943]14      REAL rlon(klon), rlat(klon), pctsrf(klon, nbsrf)
[524]15      REAL t(klon,klev), tsol(klon,nbsrf)
16      CHARACTER*(*) text
17C
18      INTEGER i, k, nsrf
19      REAL zt(klon)
20      INTEGER jadrs(klon), jbad
21      LOGICAL ok
22c
23      LOGICAL firstcall
24      SAVE firstcall
25      DATA firstcall /.TRUE./
26      IF (firstcall) THEN
27         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
28         firstcall = .FALSE.
[943]29c
30         DO i = 1, klon
31          print*,'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
32         ENDDO
33c
[524]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
[943]55             PRINT *,'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
56     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
57     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
[524]58           ENDDO
59         ENDIF
60#ifdef CRAY
61         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
62#else
63         jbad = 0
64         DO i = 1, klon
65!         IF (zt(i).LT.100.0) THEN
66         IF (zt(i).LT.50.0) THEN
67            jbad = jbad + 1
68            jadrs(jbad) = i
69         ENDIF
70         ENDDO
71#endif
72         IF (jbad .GT. 0) THEN
73           ok = .FALSE.
74           DO i = 1, jbad
[943]75             PRINT *,'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
76     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
77     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
[524]78           ENDDO
79         ENDIF
80      ENDDO
81c
82      DO nsrf = 1, nbsrf
83         DO i = 1, klon
84            zt(i) = tsol(i,nsrf)
85         ENDDO
86#ifdef CRAY
87         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
88#else
89         jbad = 0
90         DO i = 1, klon
91         IF (zt(i).GT.370.0) THEN
92            jbad = jbad + 1
93            jadrs(jbad) = i
94         ENDIF
95         ENDDO
96#endif
97         IF (jbad .GT. 0) THEN
98           ok = .FALSE.
99           DO i = 1, jbad
[943]100            PRINT *,'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
101     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
102     $      ,pctsrf(jadrs(i),nsrf)
[524]103           ENDDO
104         ENDIF
105#ifdef CRAY
106         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
107#else
108         jbad = 0
109         DO i = 1, klon
110!         IF (zt(i).LT.100.0) THEN
111         IF (zt(i).LT.50.0) THEN
112            jbad = jbad + 1
113            jadrs(jbad) = i
114         ENDIF
115         ENDDO
116#endif
117         IF (jbad .GT. 0) THEN
118           ok = .FALSE.
119           DO i = 1, jbad
[943]120            PRINT *,'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
121     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
122     $      ,pctsrf(jadrs(i),nsrf)
[524]123           ENDDO
124         ENDIF
125      ENDDO
126c
127      IF (.NOT. ok) THEN
128         PRINT*, 'hgardfou s arrete ', text
129         CALL abort
130      ENDIF
131
132      RETURN
133      END
Note: See TracBrowser for help on using the repository browser.