source: LMDZ5/trunk/libf/phylmd/hgardfou.F @ 1850

Last change on this file since 1850 was 1790, checked in by Ehouarn Millour, 11 years ago

Ré-implémentation des commissions écrasées par la rev 1785. (Notamment lmdz1d.F)
UG
...................................................

Reimplementation of the commitions undonned by rev 1785. (Especially lmdy1d.F)
UG
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.6 KB
Line 
1!
2! $Id: hgardfou.F 1790 2013-07-17 09:24:04Z idelkadi $
3      SUBROUTINE hgardfou (t,tsol,text)
4      USE dimphy
5      USE phys_state_var_mod
6      USE indice_sol_mod
7      IMPLICIT none
8c======================================================================
9c Verifier la temperature
10c======================================================================
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
18C
19      INTEGER i, k, nsrf
20      REAL zt(klon)
21      INTEGER jadrs(klon), jbad
22      LOGICAL ok
23c
24      LOGICAL firstcall
25      SAVE firstcall
26      DATA firstcall /.TRUE./
27c$OMP THREADPRIVATE(firstcall)
28
29      IF (firstcall) THEN
30         WRITE(lunout,*)
31     $  'hgardfou garantit la temperature dans [100,370] K'
32         firstcall = .FALSE.
33c        DO i = 1, klon
34c         WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
35c        ENDDO
36c
37      ENDIF
38c
39      ok = .TRUE.
40      DO k = 1, klev
41         DO i = 1, klon
42            zt(i) = t(i,k)
43         ENDDO
44#ifdef CRAY
45         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
46#else
47         jbad = 0
48         DO i = 1, klon
49         IF (zt(i) > 370.) THEN
50            jbad = jbad + 1
51            jadrs(jbad) = i
52         ENDIF
53         ENDDO
54#endif
55         IF (jbad .GT. 0) THEN
56           ok = .FALSE.
57           DO i = 1, jbad
58             WRITE(lunout,*)
59     $       'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =',
60     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
61     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
62           ENDDO
63         ENDIF
64#ifdef CRAY
65         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
66#else
67         jbad = 0
68         DO i = 1, klon
69!         IF (zt(i).LT.100.0) THEN
70         IF (zt(i).LT.50.0) THEN
71            jbad = jbad + 1
72            jadrs(jbad) = i
73         ENDIF
74         ENDDO
75#endif
76         IF (jbad .GT. 0) THEN
77           ok = .FALSE.
78           DO i = 1, jbad
79             WRITE(lunout,*)
80     $       'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =',
81     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
82     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
83           ENDDO
84         ENDIF
85      ENDDO
86c
87      DO nsrf = 1, nbsrf
88         DO i = 1, klon
89            zt(i) = tsol(i,nsrf)
90         ENDDO
91#ifdef CRAY
92         CALL WHENFGT(klon, zt, 1, 370.0, jadrs, jbad)
93#else
94         jbad = 0
95         DO i = 1, klon
96         IF (zt(i).GT.370.0) THEN
97            jbad = jbad + 1
98            jadrs(jbad) = i
99         ENDIF
100         ENDDO
101#endif
102         IF (jbad .GT. 0) THEN
103           ok = .FALSE.
104           DO i = 1, jbad
105            WRITE(lunout,*)
106     $      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='
107     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
108     $      ,pctsrf(jadrs(i),nsrf)
109           ENDDO
110         ENDIF
111#ifdef CRAY
112         CALL WHENFLT(klon, zt, 1, 100.0, jadrs, jbad)
113#else
114         jbad = 0
115         DO i = 1, klon
116!         IF (zt(i).LT.100.0) THEN
117         IF (zt(i).LT.50.0) THEN
118            jbad = jbad + 1
119            jadrs(jbad) = i
120         ENDIF
121         ENDDO
122#endif
123         IF (jbad .GT. 0) THEN
124           ok = .FALSE.
125           DO i = 1, jbad
126            WRITE(lunout,*)
127     $      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='
128     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
129     $      ,pctsrf(jadrs(i),nsrf)
130           ENDDO
131         ENDIF
132      ENDDO
133c
134      IF (.NOT. ok) THEN
135         abort_message= 'hgardfou s arrete '//text
136         CALL abort_gcm (modname,abort_message,1)
137      ENDIF
138
139      RETURN
140      END
Note: See TracBrowser for help on using the repository browser.