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

Last change on this file since 1690 was 1575, checked in by jghattas, 13 years ago
  • Added suffix _mpi_rank to lmdz.out text file. Each processus now write into seperate file but only if lunout/=6 (lunout is set in run.def).
  • Change some print* into write(lunout,*)
  • phytrac.F90 : always include ini_histrac and write_histrac. The file histrac.nc is written if ecrit_tra> 0 (set in physiq.def). Change default value of ecrit_tra into 0.
  • 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 1575 2011-09-21 13:57:48Z emillour $
[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"
[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,*)
59     $       'i,k,temperature,lon,lat,pourc ter,oce,lic,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,*)
80     $       'i,k,temperature,lon,lat,pourc ter,oce,lic,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,*)
106     $      'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,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,*)
127     $      'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,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.