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

Last change on this file since 1957 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.6 KB
RevLine 
[524]1!
[1279]2! $Id: hgardfou.F 1907 2013-11-26 13:10:46Z fairhead $
[524]3      SUBROUTINE hgardfou (t,tsol,text)
[1785]4      USE dimphy
5      USE phys_state_var_mod
6      USE indice_sol_mod
[524]7      IMPLICIT none
8c======================================================================
9c Verifier la temperature
10c======================================================================
[941]11#include "dimensions.h"
[524]12#include "YOMCST.h"
[1575]13#include "iniprint.h"
[524]14      REAL t(klon,klev), tsol(klon,nbsrf)
15      CHARACTER*(*) text
[1279]16      character (len=20) :: modname = 'hgardfou'
17      character (len=80) :: abort_message
[524]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./
[987]27c$OMP THREADPRIVATE(firstcall)
28
[524]29      IF (firstcall) THEN
[1575]30         WRITE(lunout,*)
31     $  'hgardfou garantit la temperature dans [100,370] K'
[524]32         firstcall = .FALSE.
[941]33c        DO i = 1, klon
[1575]34c         WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
[941]35c        ENDDO
36c
[524]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
[1550]49         IF (zt(i) > 370.) THEN
[524]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
[1575]58             WRITE(lunout,*)
[1790]59     $       'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =',
[1146]60     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
61     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
[524]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
[1575]79             WRITE(lunout,*)
[1790]80     $       'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =',
[1146]81     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
82     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
[524]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
[1575]105            WRITE(lunout,*)
[1790]106     $      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='
[1146]107     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
108     $      ,pctsrf(jadrs(i),nsrf)
[524]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
[1575]126            WRITE(lunout,*)
[1790]127     $      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='
[1146]128     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
129     $      ,pctsrf(jadrs(i),nsrf)
[524]130           ENDDO
131         ENDIF
132      ENDDO
133c
134      IF (.NOT. ok) THEN
[1279]135         abort_message= 'hgardfou s arrete '//text
136         CALL abort_gcm (modname,abort_message,1)
[524]137      ENDIF
138
139      RETURN
140      END
Note: See TracBrowser for help on using the repository browser.