Changeset 2430


Ignore:
Timestamp:
Nov 6, 2020, 2:26:13 PM (4 years ago)
Author:
emillour
Message:

Venus GCM:
Improve hgardfou by adding checks for NaN in the tests.
EM

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/LMDZ.VENUS/libf/phyvenus/hgardfou.F

    r1688 r2430  
    44      SUBROUTINE hgardfou (t,tsol,text)
    55
    6       use dimphy
     6      use dimphy, only: klon,klev
    77      IMPLICIT none
    88c======================================================================
    9 c Verifier la temperature
     9c Check temperature
    1010c======================================================================
    11 #include "YOMCST.h"
    12       REAL t(klon,klev), tsol(klon)
    13       CHARACTER*(*) text
     11!#include "YOMCST.h"
     12      REAL,INTENT(IN) :: t(klon,klev), tsol(klon)
     13      CHARACTER(len=*),INTENT(in):: text
    1414C
    15       INTEGER i, k
    16       REAL zt(klon)
    17       INTEGER jadrs(klon), jbad
    18       LOGICAL ok
     15      INTEGER :: i, k
     16      REAL :: zt(klon) ! to locally store temperature fields
     17      REAL,PARAMETER :: tmin=15.0   ! Minimum temperature
     18      REAL,PARAMETER :: tmax=1200.0 ! Maximum temperature
     19      INTEGER :: jbad ! number of problematic points
     20      INTEGER :: jadrs(klon) ! stored index of problematic points
     21      LOGICAL :: ok ! .true. as long as everything OK
     22      CHARACTER(len=100) :: textout
    1923c
    20       LOGICAL firstcall
    21       SAVE firstcall
    22       DATA firstcall /.TRUE./
     24      LOGICAL,SAVE :: firstcall=.TRUE.
     25
    2326      IF (firstcall) THEN
    24          PRINT*, 'hgardfou garantit la temperature dans [15,1200] K'
     27         PRINT*, 'hgardfou checks if temperature is in [15,1200] K'
    2528         firstcall = .FALSE.
    2629      ENDIF
    2730c
    2831      ok = .TRUE.
     32
     33      !1. Atmospheric temperatures
    2934      DO k = 1, klev
    3035         DO i = 1, klon
    31 !!!! MODIF GG to avoid crash after 78--> 95 extension!!
    32 !!!  WARNING: it has to be review/removed when the extension to the
    33 !!!  thermosphere is completed (physical processes and ionosphere added)
    34           IF (k.LT.85) THEN
    3536            zt(i) = t(i,k)
    36           ENDIF
    3737         ENDDO
     38
     39         ! Look for temperatures that are not numbers (NaN, Infinity, etc.)
     40         jbad=0
     41         DO i=1,klon
     42           IF (zt(i).NE.zt(i)) THEN
     43             jbad = jbad + 1
     44             jadrs(jbad) = i
     45           ENDIF
     46         ENDDO
     47         
     48         IF (jbad .GT. 0) THEN
     49           ok = .FALSE.
     50           DO i = 1, jbad
     51             PRINT *,'i,k,temperature =',jadrs(i),k,zt(jadrs(i))
     52           ENDDO
     53         ENDIF
     54         
     55         
     56         ! Look for temperatures greater than tmax
    3857#ifdef CRAY
    39          CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)
     58         CALL WHENFGT(klon, zt, 1, tmax, jadrs, jbad)
    4059#else
    4160         jbad = 0
    4261         DO i = 1, klon
    43          IF (zt(i).GT.1200.0) THEN
     62           IF (zt(i).GT.tmax) THEN
    4463            jbad = jbad + 1
    4564            jadrs(jbad) = i
    46          ENDIF
     65           ENDIF
    4766         ENDDO
    4867#endif
     
    5372           ENDDO
    5473         ENDIF
     74
     75         ! Look for temperatures lower than tmin
    5576#ifdef CRAY
    56          CALL WHENFLT(klon, zt, 1, 15.0, jadrs, jbad)
     77         CALL WHENFLT(klon, zt, 1, tmin, jadrs, jbad)
    5778#else
    5879         jbad = 0
    5980         DO i = 1, klon
    60          IF (zt(i).LT.15.0) THEN
     81           IF (zt(i).LT.tmin) THEN
    6182            jbad = jbad + 1
    6283            jadrs(jbad) = i
    63          ENDIF
     84           ENDIF
    6485         ENDDO
    6586#endif
     
    7091           ENDDO
    7192         ENDIF
     93      ENDDO ! of DO k = 1, klev
     94
     95      !2. surface temperatures
     96      DO i = 1, klon
     97         zt(i) = tsol(i)
    7298      ENDDO
    73 c
    74          DO i = 1, klon
    75             zt(i) = tsol(i)
    76          ENDDO
     99
     100      ! Look for temperatures that are not numbers (NaN, Infinity, etc.)
     101      jbad=0
     102      DO i=1,klon
     103        IF (zt(i).NE.zt(i)) THEN
     104          jbad = jbad + 1
     105          jadrs(jbad) = i
     106        ENDIF
     107      ENDDO
     108         
     109      IF (jbad .GT. 0) THEN
     110        ok = .FALSE.
     111        DO i = 1, jbad
     112          PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
     113        ENDDO
     114      ENDIF
     115
     116      ! Look for temperatures greater then tmax
    77117#ifdef CRAY
    78          CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)
     118      CALL WHENFGT(klon, zt, 1, tmax, jadrs, jbad)
    79119#else
    80          jbad = 0
    81          DO i = 1, klon
    82          IF (zt(i).GT.1200.0) THEN
    83             jbad = jbad + 1
    84             jadrs(jbad) = i
    85          ENDIF
    86          ENDDO
     120      jbad = 0
     121      DO i = 1, klon
     122        IF (zt(i).GT.tmax) THEN
     123           jbad = jbad + 1
     124           jadrs(jbad) = i
     125        ENDIF
     126      ENDDO
    87127#endif
    88          IF (jbad .GT. 0) THEN
    89            ok = .FALSE.
    90            DO i = 1, jbad
    91              PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
    92            ENDDO
    93          ENDIF
     128      IF (jbad .GT. 0) THEN
     129        ok = .FALSE.
     130        DO i = 1, jbad
     131          PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
     132        ENDDO
     133      ENDIF
     134
     135      ! Look for temperatures lower than tmin
    94136#ifdef CRAY
    95          CALL WHENFLT(klon, zt, 1, 20.0, jadrs, jbad)
     137      CALL WHENFLT(klon, zt, 1, tmin, jadrs, jbad)
    96138#else
    97          jbad = 0
    98          DO i = 1, klon
    99          IF (zt(i).LT.20.0) THEN
    100             jbad = jbad + 1
    101             jadrs(jbad) = i
    102          ENDIF
    103          ENDDO
     139      jbad = 0
     140      DO i = 1, klon
     141        IF (zt(i).LT.tmin) THEN
     142           jbad = jbad + 1
     143           jadrs(jbad) = i
     144        ENDIF
     145      ENDDO
    104146#endif
    105          IF (jbad .GT. 0) THEN
    106            ok = .FALSE.
    107            DO i = 1, jbad
    108              PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
    109            ENDDO
    110          ENDIF
     147      IF (jbad .GT. 0) THEN
     148        ok = .FALSE.
     149        DO i = 1, jbad
     150          PRINT *,'i,temperature =',jadrs(i),zt(jadrs(i))
     151        ENDDO
     152      ENDIF
    111153c
    112154      IF (.NOT. ok) THEN
    113          text='hgardfou s arrete '//text
    114          CALL abort_physic("hgardfou", text, 1)
     155         textout='hgardfou stops '//text
     156         CALL abort_physic("hgardfou", textout, 1)
    115157      ENDIF
    116158
    117       RETURN
    118159      END
Note: See TracChangeset for help on using the changeset viewer.