source: lmdz_wrf/WRFV3/lmdz/hgardfou.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 4.6 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         PRINT *,'  Lluis nsrf: ',nsrf
93         DO i = 1, klon
94            IF (pctsrf(i,nsrf) > 0.) THEN
95              zt(i) = tsol(i,nsrf)
96            ELSE
97              zt(i) = 300.0
98            END IF
99         ENDDO
100#ifdef CRAY
101         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
102#else
103         jbad = 0
104         DO i = 1, klon
105         IF (zt(i).GT.370.0) THEN
106            jbad = jbad + 1
107            jadrs(jbad) = i
108         ENDIF
109         ENDDO
110#endif
111         IF (jbad .GT. 0) THEN
112           ok = .FALSE.
113           DO i = 1, jbad
114            WRITE(lunout,*)                                                          &
115       &      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='                   &
116       &      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))              &
117       &      ,pctsrf(jadrs(i),nsrf)
118           ENDDO
119         ENDIF
120#ifdef CRAY
121         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
122#else
123         jbad = 0
124         DO i = 1, klon
125!         IF (zt(i).LT.100.0) THEN
126         IF (zt(i).LT.50.0) THEN
127            jbad = jbad + 1
128            jadrs(jbad) = i
129         ENDIF
130         ENDDO
131#endif
132         IF (jbad .GT. 0) THEN
133           ok = .FALSE.
134           DO i = 1, jbad
135            WRITE(lunout,*)                                                          &
136       &      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='                   &
137       &      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))              &
138       &      ,pctsrf(jadrs(i),nsrf)
139             PRINT *,'    Lluis: nsrf k isfc tsol zt pctsrf_____'
140             DO k=1,nbsrf
141               PRINT *,'    ',nsrf,k,jadrs(i),tsol(jadrs(i),k),zt(jadrs(i)),pctsrf(jadrs(i),k)
142             END DO
143           ENDDO
144         ENDIF
145      ENDDO
146!c
147      IF (.NOT. ok) THEN
148         abort_message= 'hgardfou s arrete '//text
149         CALL abort_gcm (modname,abort_message,1)
150      ENDIF
151
152      RETURN
153      END
Note: See TracBrowser for help on using the repository browser.