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

Last change on this file since 2353 was 2346, checked in by Ehouarn Millour, 9 years ago

Physics/dynamics separation:

  • remove all references to dimensions.h from physics. nbp_lon (==iim) , nbp_lat (==jjm+1) and nbp_lev (==llm) from mod_grid_phy_lmdz should be used instead.
  • added module regular_lonlat_mod in phy_common to store information about the global (lon-lat) grid cell boundaries and centers.

EM

  • 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
RevLine 
[1992]1
[1279]2! $Id: hgardfou.F90 2346 2015-08-21 15:13:46Z emillour $
[2235]3SUBROUTINE hgardfou(t, tsol, text,abortphy)
[1992]4  USE dimphy
5  USE phys_state_var_mod
6  USE indice_sol_mod
[2311]7  USE print_control_mod, ONLY: lunout
[1992]8  IMPLICIT NONE
9  ! ======================================================================
10  ! Verifier la temperature
11  ! ======================================================================
12  include "YOMCST.h"
13  REAL t(klon, klev), tsol(klon, nbsrf)
[2100]14  CHARACTER(len=*), intent(in):: text
[1992]15  CHARACTER (LEN=20) :: modname = 'hgardfou'
[2235]16  INTEGER abortphy
[987]17
[1992]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
[524]42#ifdef CRAY
[1992]43    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
[524]44#else
[1992]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
[524]52#endif
[1992]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
[524]61#ifdef CRAY
[1992]62    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
[524]63#else
[1992]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
[524]72#endif
[1992]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
[524]87#ifdef CRAY
[1992]88    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
[524]89#else
[1992]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
[524]97#endif
[1992]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
[524]107#ifdef CRAY
[1992]108    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
[524]109#else
[1992]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
[524]118#endif
[1992]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
[524]129
[2311]130!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
[2235]131  IF (.NOT. ok) abortphy=1
[1992]132
133END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.