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

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

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
RevLine 
[524]1!
[1279]2! $Id: hgardfou.F 1279 2009-12-10 09:02:56Z jyg $
[524]3      SUBROUTINE hgardfou (t,tsol,text)
[766]4      use dimphy
[941]5      use phys_state_var_mod
[524]6      IMPLICIT none
7c======================================================================
8c Verifier la temperature
9c======================================================================
[941]10#include "dimensions.h"
[524]11#include "YOMCST.h"
12#include "indicesol.h"
13      REAL t(klon,klev), tsol(klon,nbsrf)
14      CHARACTER*(*) text
[1279]15      character (len=20) :: modname = 'hgardfou'
16      character (len=80) :: abort_message
[524]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./
[987]26c$OMP THREADPRIVATE(firstcall)
27
[524]28      IF (firstcall) THEN
29         PRINT*, 'hgardfou garantit la temperature dans [100,370] K'
30         firstcall = .FALSE.
[941]31c        DO i = 1, klon
32c         print*,'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
33c        ENDDO
34c
[524]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).GT.370.0) 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
[1146]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)
[524]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
[1146]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)
[524]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
[1146]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)
[524]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
[1146]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)
[524]124           ENDDO
125         ENDIF
126      ENDDO
127c
128      IF (.NOT. ok) THEN
[1279]129         abort_message= 'hgardfou s arrete '//text
130         CALL abort_gcm (modname,abort_message,1)
[524]131      ENDIF
132
133      RETURN
134      END
Note: See TracBrowser for help on using the repository browser.