/[lmdze]/trunk/Sources/phylmd/hgardfou.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/hgardfou.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/hgardfou.f90 revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC trunk/Sources/phylmd/hgardfou.f revision 207 by guez, Thu Sep 1 10:30:53 2016 UTC
# Line 4  module hgardfou_m Line 4  module hgardfou_m
4    
5  contains  contains
6    
7    SUBROUTINE hgardfou(t, tsol)    SUBROUTINE hgardfou(t, ftsol)
8    
9      ! From phylmd/hgardfou.F, v 1.1.1.1 2004/05/19 12:53:07      ! From phylmd/hgardfou.F, v 1.1.1.1 2004/05/19 12:53:07
10    
11      ! This procedure aborts the program if the temperature gets out of range.      ! This procedure aborts the program if the temperature gets out of range.
12    
13      use dimens_m      USE indicesol, ONLY: nbsrf
14      use indicesol      USE dimphy, ONLY: klev, klon
15      use dimphy      use nr_util, only: ifirstloc
     use SUPHEC_M  
16    
17      REAL, intent(in):: t(klon, klev), tsol(klon, nbsrf)      REAL, intent(in):: t(klon, klev), ftsol(klon, nbsrf)
18    
19      ! Variables local to the procedure:      ! Variables local to the procedure:
20    
21      real, parameter:: temp_min = 50., temp_max = 370. ! temperature range, in K      real, parameter:: temp_min = 50., temp_max = 370. ! temperature range, in K
22      INTEGER i, k, nsrf      INTEGER k, nsrf, jbad
     INTEGER jadrs(klon), jbad  
     LOGICAL ok  
23    
24      !----------------------------------------------------------      !----------------------------------------------------------
25    
     ok = .TRUE.  
26      DO k = 1, klev      DO k = 1, klev
27         jbad = 0         jbad = ifirstloc(t(:, k) > temp_max .or. t(:, k) < temp_min)
28         DO i = 1, klon         if (jbad <= klon) then
29            IF (t(i, k) > temp_max) THEN            PRINT *, 'hgardfou: temperature out of range'
30               jbad = jbad + 1            print *, "t(", jbad, ", ", k, ") = ", t(jbad, k)
31               jadrs(jbad) = i            stop 1
32            ENDIF         end if
        ENDDO  
        IF (jbad  >  0) THEN  
           ok = .FALSE.  
           DO i = 1, jbad  
              print *, "t(", jadrs(i), ", ", k, ") = ", t(jadrs(i), k)  
           ENDDO  
        ENDIF  
        jbad = 0  
        DO i = 1, klon  
           IF (t(i, k) < temp_min) THEN  
              jbad = jbad + 1  
              jadrs(jbad) = i  
           ENDIF  
        ENDDO  
        IF (jbad  >  0) THEN  
           ok = .FALSE.  
           DO i = 1, jbad  
              print *, "t(", jadrs(i), ", ", k, ") = ", t(jadrs(i), k)  
           ENDDO  
        ENDIF  
33      ENDDO      ENDDO
34    
35      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
36         jbad = 0         jbad = ifirstloc(ftsol(:, nsrf) > temp_max &
37         DO i = 1, klon              .or. ftsol(:, nsrf) < temp_min)
38            IF (tsol(i, nsrf) > temp_max) THEN         if (jbad <= klon) then
39               jbad = jbad + 1            PRINT *, 'hgardfou: temperature out of range'
40               jadrs(jbad) = i            print *, "ftsol(", jbad, ", ", nsrf, ") = ", ftsol(jbad, nsrf)
41            ENDIF            stop 1
        ENDDO  
        IF (jbad  >  0) THEN  
           ok = .FALSE.  
           DO i = 1, jbad  
               print *, "tsol(", jadrs(i), ", ", nsrf, ") = ", &  
                   tsol(jadrs(i), nsrf)  
           ENDDO  
        ENDIF  
        jbad = 0  
        DO i = 1, klon  
           IF (tsol(i, nsrf) < temp_min) THEN  
              jbad = jbad + 1  
              jadrs(jbad) = i  
           ENDIF  
        ENDDO  
        IF (jbad  >  0) THEN  
           ok = .FALSE.  
           DO i = 1, jbad  
               print *, "tsol(", jadrs(i), ", ", nsrf, ") = ", &  
                   tsol(jadrs(i), nsrf)  
           ENDDO  
42         ENDIF         ENDIF
43      ENDDO      ENDDO
44    
     IF (.NOT. ok) THEN  
        PRINT *, 'hgardfou: temperature out of range'  
        stop 1  
     ENDIF  
   
45    END SUBROUTINE hgardfou    END SUBROUTINE hgardfou
46    
47  end module hgardfou_m  end module hgardfou_m
Legend:
Removed from v.38  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21