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

Last change on this file since 3818 was 3818, checked in by millour, 10 years ago

Some partial cleanup on uses of "dimensions.h" in physics.
At this point 3D gcm compiles and bench seems to run fine :-)
EM

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