source: lmdz_wrf/trunk/WRFV3/lmdz/hgardfou.F90 @ 1939

Last change on this file since 1939 was 186, checked in by lfita, 10 years ago

Removing checking printings
File size: 4.3 KB
Line 
1!
2! $Id: hgardfou.F 1795 2013-07-18 08:20:28Z emillour $
3      SUBROUTINE hgardfou (t,tsol,text)
4      USE dimphy
5      USE phys_state_var_mod
6      USE indice_sol_mod
7      IMPLICIT none
8!c======================================================================
9!c Verifier la temperature
10!c======================================================================
11#include "dimensions.h"
12#include "YOMCST.h"
13#include "iniprint.h"
14      REAL t(klon,klev), tsol(klon,nbsrf)
15      CHARACTER*(*) text
16      character (len=20) :: modname = 'hgardfou'
17      character (len=80) :: abort_message
18!C
19      INTEGER i, k, nsrf
20      REAL zt(klon)
21      INTEGER jadrs(klon), jbad
22      LOGICAL ok
23!c
24      LOGICAL firstcall
25      SAVE firstcall
26      DATA firstcall /.TRUE./
27!$OMP THREADPRIVATE(firstcall)
28
29! Lluis
30      INTEGER                                            :: lp
31      lp = 885
32
33      IF (firstcall) THEN
34         WRITE(lunout,*)                                                             &
35       &  'hgardfou garantit la temperature dans [100,370] K'
36         firstcall = .FALSE.
37!c        DO i = 1, klon
38!c         WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
39!c        ENDDO
40!c
41      ENDIF
42!c
43      ok = .TRUE.
44      DO k = 1, klev
45         DO i = 1, klon
46            zt(i) = t(i,k)
47         ENDDO
48#ifdef CRAY
49         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
50#else
51         jbad = 0
52         DO i = 1, klon
53         IF (zt(i) > 370.) THEN
54            jbad = jbad + 1
55            jadrs(jbad) = i
56         ENDIF
57         ENDDO
58#endif
59         IF (jbad .GT. 0) THEN
60           ok = .FALSE.
61           DO i = 1, jbad
62             WRITE(lunout,*)                                                         &
63       &       'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =',                    &
64       &       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),                &
65       &       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
66           ENDDO
67         ENDIF
68#ifdef CRAY
69         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
70#else
71         jbad = 0
72         DO i = 1, klon
73!         IF (zt(i).LT.100.0) THEN
74         IF (zt(i).LT.50.0) THEN
75            jbad = jbad + 1
76            jadrs(jbad) = i
77         ENDIF
78         ENDDO
79#endif
80         IF (jbad .GT. 0) THEN
81           ok = .FALSE.
82           DO i = 1, jbad
83             WRITE(lunout,*)                                                         &
84       &       'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =',                    &
85       &       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),                &
86       &       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
87           ENDDO
88         ENDIF
89      ENDDO
90!c
91      DO nsrf = 1, nbsrf
92         DO i = 1, klon
93            IF (pctsrf(i,nsrf) > 0.) THEN
94              zt(i) = tsol(i,nsrf)
95            ELSE
96              zt(i) = 300.0
97            END IF
98         ENDDO
99#ifdef CRAY
100         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
101#else
102         jbad = 0
103         DO i = 1, klon
104         IF (zt(i).GT.370.0) THEN
105            jbad = jbad + 1
106            jadrs(jbad) = i
107         ENDIF
108         ENDDO
109#endif
110         IF (jbad .GT. 0) THEN
111           ok = .FALSE.
112           DO i = 1, jbad
113            WRITE(lunout,*)                                                          &
114       &      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='                   &
115       &      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))              &
116       &      ,pctsrf(jadrs(i),nsrf)
117           ENDDO
118         ENDIF
119#ifdef CRAY
120         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
121#else
122         jbad = 0
123         DO i = 1, klon
124!         IF (zt(i).LT.100.0) THEN
125         IF (zt(i).LT.50.0) THEN
126            jbad = jbad + 1
127            jadrs(jbad) = i
128         ENDIF
129         ENDDO
130#endif
131         IF (jbad .GT. 0) THEN
132           ok = .FALSE.
133           DO i = 1, jbad
134            WRITE(lunout,*)                                                          &
135       &      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='                   &
136       &      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))              &
137       &      ,pctsrf(jadrs(i),nsrf)
138           ENDDO
139         ENDIF
140      ENDDO
141!c
142      IF (.NOT. ok) THEN
143         abort_message= 'hgardfou s arrete '//text
144         CALL abort_gcm (modname,abort_message,1)
145      ENDIF
146
147      RETURN
148      END
Note: See TracBrowser for help on using the repository browser.