/[lmdze]/trunk/Sources/phylmd/hgardfou.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/hgardfou.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 2 months ago) by guez
Original Path: trunk/libf/phylmd/hgardfou.f90
File size: 2260 byte(s)
Initial import
1 guez 3 module hgardfou_m
2    
3     IMPLICIT none
4    
5     contains
6    
7     SUBROUTINE hgardfou(t, tsol)
8    
9     ! From phylmd/hgardfou.F, v 1.1.1.1 2004/05/19 12:53:07
10    
11     ! This procedure aborts the program if the temperature gets out of range.
12    
13     use dimens_m
14     use indicesol
15     use dimphy
16     use YOMCST
17    
18     REAL, intent(in):: t(klon, klev), tsol(klon, nbsrf)
19    
20     ! Variables local to the procedure:
21    
22     real, parameter:: temp_min = 50., temp_max = 370. ! temperature range, in K
23     INTEGER i, k, nsrf
24     INTEGER jadrs(klon), jbad
25     LOGICAL ok
26    
27     !----------------------------------------------------------
28    
29     ok = .TRUE.
30     DO k = 1, klev
31     jbad = 0
32     DO i = 1, klon
33     IF (t(i, k) > temp_max) THEN
34     jbad = jbad + 1
35     jadrs(jbad) = i
36     ENDIF
37     ENDDO
38     IF (jbad > 0) THEN
39     ok = .FALSE.
40     DO i = 1, jbad
41     print *, "t(", jadrs(i), ", ", k, ") = ", t(jadrs(i), k)
42     ENDDO
43     ENDIF
44     jbad = 0
45     DO i = 1, klon
46     IF (t(i, k) < temp_min) THEN
47     jbad = jbad + 1
48     jadrs(jbad) = i
49     ENDIF
50     ENDDO
51     IF (jbad > 0) THEN
52     ok = .FALSE.
53     DO i = 1, jbad
54     print *, "t(", jadrs(i), ", ", k, ") = ", t(jadrs(i), k)
55     ENDDO
56     ENDIF
57     ENDDO
58    
59     DO nsrf = 1, nbsrf
60     jbad = 0
61     DO i = 1, klon
62     IF (tsol(i, nsrf) > temp_max) THEN
63     jbad = jbad + 1
64     jadrs(jbad) = i
65     ENDIF
66     ENDDO
67     IF (jbad > 0) THEN
68     ok = .FALSE.
69     DO i = 1, jbad
70     print *, "tsol(", jadrs(i), ", ", nsrf, ") = ", &
71     tsol(jadrs(i), nsrf)
72     ENDDO
73     ENDIF
74     jbad = 0
75     DO i = 1, klon
76     IF (tsol(i, nsrf) < temp_min) THEN
77     jbad = jbad + 1
78     jadrs(jbad) = i
79     ENDIF
80     ENDDO
81     IF (jbad > 0) THEN
82     ok = .FALSE.
83     DO i = 1, jbad
84     print *, "tsol(", jadrs(i), ", ", nsrf, ") = ", &
85     tsol(jadrs(i), nsrf)
86     ENDDO
87     ENDIF
88     ENDDO
89    
90     IF (.NOT. ok) THEN
91     PRINT *, 'hgardfou: temperature out of range'
92     stop 1
93     ENDIF
94    
95     END SUBROUTINE hgardfou
96    
97     end module hgardfou_m

  ViewVC Help
Powered by ViewVC 1.1.21