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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 38 - (show annotations)
Thu Jan 6 17:52:19 2011 UTC (13 years, 3 months ago) by guez
Original Path: trunk/libf/phylmd/hgardfou.f90
File size: 2262 byte(s) 
Extracted ASCII art from "inigeom" into a separate text file in the
documentation.

"test_disvert" now creates a separate file for layer thicknesses.

Moved variables from module "yomcst" to module "suphec_m" because this
is where those variables are defined. Kept in "yomcst" only parameters
of Earth orbit. Gave the attribute "parameter" to some variables of
module "suphec_m".

Variables of module "yoethf" were defined in procedure "suphec". Moved
these definitions to a new procedure "yoethf" in module "yoethf_m".
1 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 SUPHEC_M
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