/[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 227 by guez, Thu Nov 2 15:47:03 2017 UTC
# Line 4  module hgardfou_m Line 4  module hgardfou_m
4    
5  contains  contains
6    
7    SUBROUTINE hgardfou(t, tsol)    SUBROUTINE hgardfou(t_seri, 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 abort_gcm_m, only: abort_gcm
14      use indicesol      USE indicesol, ONLY: nbsrf, clnsurf
15      use dimphy      USE dimphy, ONLY: klev, klon
16      use SUPHEC_M      use nr_util, only: ifirstloc
17        use phyetat0_m, only: rlon, rlat
18    
19      REAL, intent(in):: t(klon, klev), tsol(klon, nbsrf)      REAL, intent(in):: t_seri(:, :) ! (klon, klev)
20        REAL, intent(in):: ftsol(:, :) ! (klon, nbsrf)
21    
22      ! Variables local to the procedure:      ! Variables local to the procedure:
23    
24      real, parameter:: temp_min = 50., temp_max = 370. ! temperature range, in K      real, parameter:: temp_min = 50., temp_max = 370. ! temperature range, in K
25      INTEGER i, k, nsrf      INTEGER k, nsrf, jbad
     INTEGER jadrs(klon), jbad  
     LOGICAL ok  
26    
27      !----------------------------------------------------------      !----------------------------------------------------------
28    
     ok = .TRUE.  
29      DO k = 1, klev      DO k = 1, klev
30         jbad = 0         jbad = ifirstloc(t_seri(:, k) > temp_max .or. t_seri(:, k) < temp_min)
31         DO i = 1, klon         if (jbad <= klon) then
32            IF (t(i, k) > temp_max) THEN            print *, "t_seri(", jbad, ", ", k, ") = ", t_seri(jbad, k)
33               jbad = jbad + 1            call abort_gcm('hgardfou', 'temperature out of range')
34               jadrs(jbad) = i         end if
           ENDIF  
        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  
35      ENDDO      ENDDO
36    
37      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
38         jbad = 0         jbad = ifirstloc(ftsol(:, nsrf) > temp_max &
39         DO i = 1, klon              .or. ftsol(:, nsrf) < temp_min)
40            IF (tsol(i, nsrf) > temp_max) THEN         if (jbad <= klon) then
41               jbad = jbad + 1            print *, "ftsol(position index =", jbad, ", sub-surface index =", &
42               jadrs(jbad) = i                 nsrf, ") =", ftsol(jbad, nsrf)
43            ENDIF            print *, "sub-surface name: ", clnsurf(nsrf)
44         ENDDO            print *, "longitude:", rlon(jbad), "degrees east"
45         IF (jbad  >  0) THEN            print *, "latitude:", rlat(jbad), "degrees north"
46            ok = .FALSE.            call abort_gcm('hgardfou', 'temperature out of range')
           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  
47         ENDIF         ENDIF
48      ENDDO      ENDDO
49    
     IF (.NOT. ok) THEN  
        PRINT *, 'hgardfou: temperature out of range'  
        stop 1  
     ENDIF  
   
50    END SUBROUTINE hgardfou    END SUBROUTINE hgardfou
51    
52  end module hgardfou_m  end module hgardfou_m
Legend:
Removed from v.38  
changed lines
  Added in v.227
  ViewVC Help
Powered by ViewVC 1.1.21