source: LMDZ5/branches/LMDZ5_AR5/libf/phylmd/hgardfou.F

Last change on this file was 1550, checked in by lguez, 13 years ago

Bug fix in "bilan_dyn_p". The index was out of bounds in the removed
assignment . Also, the removed assignment was useless.

Bug fix in "coefkzmin". The size of a dummy array cannot exceed the
size of the associated actual array. ("coefkzmin" is called by
"coef_diff_turb".) "km(:, klev+1)" and "kn(:, klev+1)" were not
defined in "coefkzmin" so this was maybe an innocuous bug.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1!
2! $Id: hgardfou.F 1550 2011-07-05 09:44:55Z aclsce $
3      SUBROUTINE hgardfou (t,tsol,text)
4      use dimphy
5      use phys_state_var_mod
6      IMPLICIT none
7c======================================================================
8c Verifier la temperature
9c======================================================================
10#include "dimensions.h"
11#include "YOMCST.h"
12#include "indicesol.h"
13      REAL t(klon,klev), tsol(klon,nbsrf)
14      CHARACTER*(*) text
15      character (len=20) :: modname = 'hgardfou'
16      character (len=80) :: abort_message
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./
26c$OMP THREADPRIVATE(firstcall)
27
28      IF (firstcall) THEN
29         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
30         firstcall = .FALSE.
31c        DO i = 1, klon
32c         print*,'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
33c        ENDDO
34c
35      ENDIF
36c
37      ok = .TRUE.
38      DO k = 1, klev
39         DO i = 1, klon
40            zt(i) = t(i,k)
41         ENDDO
42#ifdef CRAY
43         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
44#else
45         jbad = 0
46         DO i = 1, klon
47         IF (zt(i) > 370.) THEN
48            jbad = jbad + 1
49            jadrs(jbad) = i
50         ENDIF
51         ENDDO
52#endif
53         IF (jbad .GT. 0) THEN
54           ok = .FALSE.
55           DO i = 1, jbad
56             PRINT *,'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
57     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
58     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
59           ENDDO
60         ENDIF
61#ifdef CRAY
62         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
63#else
64         jbad = 0
65         DO i = 1, klon
66!         IF (zt(i).LT.100.0) THEN
67         IF (zt(i).LT.50.0) THEN
68            jbad = jbad + 1
69            jadrs(jbad) = i
70         ENDIF
71         ENDDO
72#endif
73         IF (jbad .GT. 0) THEN
74           ok = .FALSE.
75           DO i = 1, jbad
76             PRINT *,'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
77     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
78     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
79           ENDDO
80         ENDIF
81      ENDDO
82c
83      DO nsrf = 1, nbsrf
84         DO i = 1, klon
85            zt(i) = tsol(i,nsrf)
86         ENDDO
87#ifdef CRAY
88         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
89#else
90         jbad = 0
91         DO i = 1, klon
92         IF (zt(i).GT.370.0) THEN
93            jbad = jbad + 1
94            jadrs(jbad) = i
95         ENDIF
96         ENDDO
97#endif
98         IF (jbad .GT. 0) THEN
99           ok = .FALSE.
100           DO i = 1, jbad
101            PRINT *,'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
102     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
103     $      ,pctsrf(jadrs(i),nsrf)
104           ENDDO
105         ENDIF
106#ifdef CRAY
107         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
108#else
109         jbad = 0
110         DO i = 1, klon
111!         IF (zt(i).LT.100.0) THEN
112         IF (zt(i).LT.50.0) THEN
113            jbad = jbad + 1
114            jadrs(jbad) = i
115         ENDIF
116         ENDDO
117#endif
118         IF (jbad .GT. 0) THEN
119           ok = .FALSE.
120           DO i = 1, jbad
121            PRINT *,'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
122     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
123     $      ,pctsrf(jadrs(i),nsrf)
124           ENDDO
125         ENDIF
126      ENDDO
127c
128      IF (.NOT. ok) THEN
129         abort_message= 'hgardfou s arrete '//text
130         CALL abort_gcm (modname,abort_message,1)
131      ENDIF
132
133      RETURN
134      END
Note: See TracBrowser for help on using the repository browser.