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

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

Further modifications to enforce physics/dynamics separation:

  • moved iniprint.h and misc_mod back to dyn3d_common, as these should only be used by dynamics.
  • created print_control_mod in the physics to store flags prt_level, lunout, debug to be local to physics (should be used rather than iniprint.h)
  • created abort_physic.F90 , which does the same job as abort_gcm() did, but should be used instead when in physics.
  • reactivated inifis (turned it into a module, inifis_mod.F90) to initialize physical constants and print_control_mod flags.

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.2 KB
RevLine 
[1992]1
[1279]2! $Id: hgardfou.F90 2311 2015-06-25 07:45:24Z 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 "dimensions.h"
13  include "YOMCST.h"
14  REAL t(klon, klev), tsol(klon, nbsrf)
[2100]15  CHARACTER(len=*), intent(in):: text
[1992]16  CHARACTER (LEN=20) :: modname = 'hgardfou'
[2235]17  INTEGER abortphy
[987]18
[1992]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
[524]43#ifdef CRAY
[1992]44    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
[524]45#else
[1992]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
[524]53#endif
[1992]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
[524]62#ifdef CRAY
[1992]63    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
[524]64#else
[1992]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
[524]73#endif
[1992]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
[524]88#ifdef CRAY
[1992]89    CALL whenfgt(klon, zt, 1, 370.0, jadrs, jbad)
[524]90#else
[1992]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
[524]98#endif
[1992]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
[524]108#ifdef CRAY
[1992]109    CALL whenflt(klon, zt, 1, 100.0, jadrs, jbad)
[524]110#else
[1992]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
[524]119#endif
[1992]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
[524]130
[2311]131!  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
[2235]132  IF (.NOT. ok) abortphy=1
[1992]133
134END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.