/[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

revision 69 by guez, Mon Feb 18 16:33:12 2013 UTC revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC
# Line 12  contains Line 12  contains
12    
13      USE indicesol, ONLY: nbsrf      USE indicesol, ONLY: nbsrf
14      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
15        use nr_util, only: ifirstloc
16    
17      REAL, intent(in):: t(klon, klev), tsol(klon, nbsrf)      REAL, intent(in):: t(klon, klev), tsol(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(tsol(:, nsrf) > temp_max .or. tsol(:, nsrf) < temp_min)
37         DO i = 1, klon         if (jbad <= klon) then
38            IF (tsol(i, nsrf) > temp_max) THEN            PRINT *, 'hgardfou: temperature out of range'
39               jbad = jbad + 1            print *, "tsol(", jbad, ", ", nsrf, ") = ", tsol(jbad, nsrf)
40               jadrs(jbad) = i            stop 1
           ENDIF  
        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  
41         ENDIF         ENDIF
42      ENDDO      ENDDO
43    
     IF (.NOT. ok) THEN  
        PRINT *, 'hgardfou: temperature out of range'  
        stop 1  
     ENDIF  
   
44    END SUBROUTINE hgardfou    END SUBROUTINE hgardfou
45    
46  end module hgardfou_m  end module hgardfou_m
Legend:
Removed from v.69  
changed lines
  Added in v.70
  ViewVC Help
Powered by ViewVC 1.1.21