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

Last change on this file since 1258 was 1146, checked in by Laurent Fairhead, 15 years ago

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF
  • 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      SUBROUTINE hgardfou (t,tsol,text)
[766]3      use dimphy
[941]4      use phys_state_var_mod
[524]5      IMPLICIT none
6c======================================================================
7c Verifier la temperature
8c======================================================================
[941]9#include "dimensions.h"
[524]10#include "YOMCST.h"
11#include "indicesol.h"
12      REAL t(klon,klev), tsol(klon,nbsrf)
13      CHARACTER*(*) text
14C
15      INTEGER i, k, nsrf
16      REAL zt(klon)
17      INTEGER jadrs(klon), jbad
18      LOGICAL ok
19c
20      LOGICAL firstcall
21      SAVE firstcall
22      DATA firstcall /.TRUE./
[987]23c$OMP THREADPRIVATE(firstcall)
24
[524]25      IF (firstcall) THEN
26         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
27         firstcall = .FALSE.
[941]28c        DO i = 1, klon
29c         print*,'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
30c        ENDDO
31c
[524]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
[1146]53             PRINT *,'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
54     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
55     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
[524]56           ENDDO
57         ENDIF
58#ifdef CRAY
59         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
60#else
61         jbad = 0
62         DO i = 1, klon
63!         IF (zt(i).LT.100.0) THEN
64         IF (zt(i).LT.50.0) THEN
65            jbad = jbad + 1
66            jadrs(jbad) = i
67         ENDIF
68         ENDDO
69#endif
70         IF (jbad .GT. 0) THEN
71           ok = .FALSE.
72           DO i = 1, jbad
[1146]73             PRINT *,'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
74     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
75     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
[524]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
[1146]98            PRINT *,'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
99     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
100     $      ,pctsrf(jadrs(i),nsrf)
[524]101           ENDDO
102         ENDIF
103#ifdef CRAY
104         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
105#else
106         jbad = 0
107         DO i = 1, klon
108!         IF (zt(i).LT.100.0) THEN
109         IF (zt(i).LT.50.0) THEN
110            jbad = jbad + 1
111            jadrs(jbad) = i
112         ENDIF
113         ENDDO
114#endif
115         IF (jbad .GT. 0) THEN
116           ok = .FALSE.
117           DO i = 1, jbad
[1146]118            PRINT *,'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
119     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
120     $      ,pctsrf(jadrs(i),nsrf)
[524]121           ENDDO
122         ENDIF
123      ENDDO
124c
125      IF (.NOT. ok) THEN
126         PRINT*, 'hgardfou s arrete ', text
127         CALL abort
128      ENDIF
129
130      RETURN
131      END
Note: See TracBrowser for help on using the repository browser.