source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/hgardfou.F90 @ 3814

Last change on this file since 3814 was 3814, checked in by ymipsl, 10 years ago

remove all dynamic dependency in LMDZ physics except for the include "dimensions.h"

YM

File size: 3.2 KB
Line 
1
2! $Id: hgardfou.F90 2235 2015-03-17 09:56:59Z fhourdin $
3SUBROUTINE hgardfou(t, tsol, text,abortphy)
4  USE dimphy
5  USE phys_state_var_mod
6  USE indice_sol_mod
7  IMPLICIT NONE
8  ! ======================================================================
9  ! Verifier la temperature
10  ! ======================================================================
11  include "dimensions.h"
12  include "YOMCST.h"
13  include "iniprint.h"
14  REAL t(klon, klev), tsol(klon, nbsrf)
15  CHARACTER(len=*), intent(in):: text
16  CHARACTER (LEN=20) :: modname = 'hgardfou'
17  INTEGER abortphy
18
19  INTEGER i, k, nsrf
20  REAL zt(klon)
21  INTEGER jadrs(klon), jbad
22  LOGICAL ok
23
24  LOGICAL firstcall
25  SAVE firstcall
26  DATA firstcall/.TRUE./
27  !$OMP THREADPRIVATE(firstcall)
28
29  IF (firstcall) THEN
30    WRITE (lunout, *) 'hgardfou garantit la temperature dans [100,370] K'
31    firstcall = .FALSE.
32    ! DO i = 1, klon
33    ! WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
34    ! ENDDO
35
36  END IF
37
38  ok = .TRUE.
39  DO k = 1, klev
40    DO i = 1, klon
41      zt(i) = t(i, k)
42    END DO
43#ifdef CRAY
44    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
45#else
46    jbad = 0
47    DO i = 1, klon
48      IF (zt(i)>370.) THEN
49        jbad = jbad + 1
50        jadrs(jbad) = i
51      END IF
52    END DO
53#endif
54    IF (jbad>0) THEN
55      ok = .FALSE.
56      DO i = 1, jbad
57        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
58          jadrs(i), k, zt(jadrs(i)), rlon(jadrs(i)), rlat(jadrs(i)), &
59          (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
60      END DO
61    END IF
62#ifdef CRAY
63    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
64#else
65    jbad = 0
66    DO i = 1, klon
67      ! IF (zt(i).LT.100.0) THEN
68      IF (zt(i)<50.0) THEN
69        jbad = jbad + 1
70        jadrs(jbad) = i
71      END IF
72    END DO
73#endif
74    IF (jbad>0) THEN
75      ok = .FALSE.
76      DO i = 1, jbad
77        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
78          jadrs(i), k, zt(jadrs(i)), rlon(jadrs(i)), rlat(jadrs(i)), &
79          (pctsrf(jadrs(i),nsrf), nsrf=1, nbsrf)
80      END DO
81    END IF
82  END DO
83
84  DO nsrf = 1, nbsrf
85    DO i = 1, klon
86      zt(i) = tsol(i, nsrf)
87    END DO
88#ifdef CRAY
89    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
90#else
91    jbad = 0
92    DO i = 1, klon
93      IF (zt(i)>370.0) THEN
94        jbad = jbad + 1
95        jadrs(jbad) = i
96      END IF
97    END DO
98#endif
99    IF (jbad>0) THEN
100      ok = .FALSE.
101      DO i = 1, jbad
102        WRITE (lunout, *) &
103          'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
104          nsrf, zt(jadrs(i)), rlon(jadrs(i)), rlat(jadrs(i)), &
105          pctsrf(jadrs(i), nsrf)
106      END DO
107    END IF
108#ifdef CRAY
109    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
110#else
111    jbad = 0
112    DO i = 1, klon
113      ! IF (zt(i).LT.100.0) THEN
114      IF (zt(i)<50.0) THEN
115        jbad = jbad + 1
116        jadrs(jbad) = i
117      END IF
118    END DO
119#endif
120    IF (jbad>0) THEN
121      ok = .FALSE.
122      DO i = 1, jbad
123        WRITE (lunout, *) &
124          'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
125          nsrf, zt(jadrs(i)), rlon(jadrs(i)), rlat(jadrs(i)), &
126          pctsrf(jadrs(i), nsrf)
127      END DO
128    END IF
129  END DO
130
131!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
132  IF (.NOT. ok) abortphy=1
133
134END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.