source: LMDZ5/trunk/libf/phylmd/hgardfou.F90 @ 2153

Last change on this file since 2153 was 2100, checked in by lguez, 10 years ago

Removed "on rentre dans guide_main" from guide_main in dyn3dpar, was
already commented out in the dyn3dmem version.

Keeping length of lines under 80 characters in physiq (for
readability). Removed wrong comments "ajout des tendances de la
diffusion turbulente". Replaced "con" by "convection" as an argument
of add_phys_tend.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
Line 
1
2! $Id: hgardfou.F90 2100 2014-07-22 16:33:56Z lguez $
3SUBROUTINE hgardfou(t, tsol, text)
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
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_gcm(modname, text, 1)
131
132END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.