Changeset 2430
- Timestamp:
- Nov 6, 2020, 2:26:13 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.VENUS/libf/phyvenus/hgardfou.F
r1688 r2430 4 4 SUBROUTINE hgardfou (t,tsol,text) 5 5 6 use dimphy 6 use dimphy, only: klon,klev 7 7 IMPLICIT none 8 8 c====================================================================== 9 c Verifier latemperature9 c Check temperature 10 10 c====================================================================== 11 #include "YOMCST.h"12 REAL t(klon,klev), tsol(klon)13 CHARACTER *(*)text11 !#include "YOMCST.h" 12 REAL,INTENT(IN) :: t(klon,klev), tsol(klon) 13 CHARACTER(len=*),INTENT(in):: text 14 14 C 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 19 23 c 20 LOGICAL firstcall 21 SAVE firstcall 22 DATA firstcall /.TRUE./ 24 LOGICAL,SAVE :: firstcall=.TRUE. 25 23 26 IF (firstcall) THEN 24 PRINT*, 'hgardfou garantit la temperature dans[15,1200] K'27 PRINT*, 'hgardfou checks if temperature is in [15,1200] K' 25 28 firstcall = .FALSE. 26 29 ENDIF 27 30 c 28 31 ok = .TRUE. 32 33 !1. Atmospheric temperatures 29 34 DO k = 1, klev 30 35 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 the33 !!! thermosphere is completed (physical processes and ionosphere added)34 IF (k.LT.85) THEN35 36 zt(i) = t(i,k) 36 ENDIF37 37 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 38 57 #ifdef CRAY 39 CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)58 CALL WHENFGT(klon, zt, 1, tmax, jadrs, jbad) 40 59 #else 41 60 jbad = 0 42 61 DO i = 1, klon 43 IF (zt(i).GT.1200.0) THEN62 IF (zt(i).GT.tmax) THEN 44 63 jbad = jbad + 1 45 64 jadrs(jbad) = i 46 ENDIF65 ENDIF 47 66 ENDDO 48 67 #endif … … 53 72 ENDDO 54 73 ENDIF 74 75 ! Look for temperatures lower than tmin 55 76 #ifdef CRAY 56 CALL WHENFLT(klon, zt, 1, 15.0, jadrs, jbad)77 CALL WHENFLT(klon, zt, 1, tmin, jadrs, jbad) 57 78 #else 58 79 jbad = 0 59 80 DO i = 1, klon 60 IF (zt(i).LT.15.0) THEN81 IF (zt(i).LT.tmin) THEN 61 82 jbad = jbad + 1 62 83 jadrs(jbad) = i 63 ENDIF84 ENDIF 64 85 ENDDO 65 86 #endif … … 70 91 ENDDO 71 92 ENDIF 93 ENDDO ! of DO k = 1, klev 94 95 !2. surface temperatures 96 DO i = 1, klon 97 zt(i) = tsol(i) 72 98 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 77 117 #ifdef CRAY 78 CALL WHENFGT(klon, zt, 1, 1200.0, jadrs, jbad)118 CALL WHENFGT(klon, zt, 1, tmax, jadrs, jbad) 79 119 #else 80 81 82 IF (zt(i).GT.1200.0) THEN83 84 85 86 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 87 127 #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 94 136 #ifdef CRAY 95 CALL WHENFLT(klon, zt, 1, 20.0, jadrs, jbad)137 CALL WHENFLT(klon, zt, 1, tmin, jadrs, jbad) 96 138 #else 97 98 99 IF (zt(i).LT.20.0) THEN100 101 102 103 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 104 146 #endif 105 106 107 108 109 110 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 111 153 c 112 154 IF (.NOT. ok) THEN 113 text ='hgardfou s arrete'//text114 CALL abort_physic("hgardfou", text , 1)155 textout='hgardfou stops '//text 156 CALL abort_physic("hgardfou", textout, 1) 115 157 ENDIF 116 158 117 RETURN118 159 END
Note: See TracChangeset
for help on using the changeset viewer.