GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/borne_var_surf.F90 Lines: 0 62 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 36 0.0 %

Line Branch Exec Source
1
SUBROUTINE borne_var_surf(klon,klev,nbsrf,                   &
2
         iflag_bug_t2m_stab_ipslcm61,                        &
3
         t1,q1,u1,v1,                                        &
4
         ftsol, qsurf, pctsrf, paprs,                        &
5
         t2m, q2m, u10m, v10m,                               &
6
         zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor,           &
7
         zrh2m_cor, zqsat2m_cor)
8
9
IMPLICIT NONE
10
11
!==================================================================
12
! Declarations
13
!==================================================================
14
15
! arguments
16
INTEGER klon,klev,nbsrf,iflag_bug_t2m_stab_ipslcm61
17
REAL,DIMENSION(klon),INTENT(IN) :: t1, q1, u1, v1
18
REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: t2m, q2m, u10m, v10m
19
REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol, pctsrf
20
REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs
21
REAL,DIMENSION(klon),INTENT(IN) :: qsurf
22
REAL,DIMENSION (klon),INTENT(OUT) :: zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor
23
REAL,DIMENSION (klon),INTENT(OUT)  :: zrh2m_cor, zqsat2m_cor
24
25
26
! local
27
INTEGER i,nsrf
28
REAL,DIMENSION (klon,nbsrf) :: t2m_cor, q2m_cor, u10m_cor, v10m_cor
29
REAL                               :: zx_qs1, zcor1, zdelta1
30
include "YOMCST.h"
31
include "YOETHF.h"
32
include "FCTTRE.h"
33
!==================================================================
34
! Correction of sub surface variables
35
!==================================================================
36
37
zrh2m_cor=0.
38
zqsat2m_cor=0.
39
40
DO nsrf=1,nbsrf
41
   DO i=1,klon
42
    t2m_cor(i,nsrf)=t2m(i,nsrf)
43
    q2m_cor(i,nsrf)=q2m(i,nsrf)
44
    u10m_cor(i,nsrf)=u10m(i,nsrf)
45
    v10m_cor(i,nsrf)=v10m(i,nsrf)
46
     IF(iflag_bug_t2m_stab_ipslcm61.EQ.-2.AND.q2m(i,nsrf).LT.0.) THEN
47
      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
48
      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
49
      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
50
      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
51
      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
52
      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
53
      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
54
     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.-1.AND.(ftsol(i,nsrf).LE.t1(i).OR.q2m(i,nsrf).LT.0.)) THEN
55
      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
56
      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
57
      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
58
      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
59
      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
60
      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
61
      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
62
     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.1.AND.ftsol(i,nsrf).LE.t1(i)) THEN
63
      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
64
      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
65
      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
66
      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
67
      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
68
      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
69
      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
70
     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.0) THEN
71
      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
72
      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
73
      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
74
      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
75
      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
76
      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
77
      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
78
     ENDIF
79
!!!
80
     zdelta1 = MAX(0.,SIGN(1., rtt-t2m_cor(i,nsrf) ))
81
     zx_qs1  = r2es * FOEEW(t2m_cor(i,nsrf),zdelta1)/paprs(i,1)
82
     zx_qs1  = MIN(0.5,zx_qs1)
83
     zcor1   = 1./(1.-RETV*zx_qs1)
84
     zx_qs1  = zx_qs1*zcor1
85
     zrh2m_cor(i) = zrh2m_cor(i) + q2m_cor(i,nsrf)/zx_qs1 * pctsrf(i,nsrf)
86
     zqsat2m_cor(i) = zqsat2m_cor(i) + zx_qs1  * pctsrf(i,nsrf)
87
!!!
88
   ENDDO
89
ENDDO
90
91
!==================================================================
92
! Agregation of sub surfaces
93
!==================================================================
94
95
zt2m_cor=0.
96
zq2m_cor=0.
97
zu10m_cor=0.
98
zv10m_cor=0.
99
DO nsrf = 1, nbsrf
100
   DO i = 1, klon
101
      zt2m_cor(i)  = zt2m_cor(i)  + t2m_cor(i,nsrf)  * pctsrf(i,nsrf)
102
      zq2m_cor(i)  = zq2m_cor(i)  + q2m_cor(i,nsrf)  * pctsrf(i,nsrf)
103
      zu10m_cor(i) = zu10m_cor(i) + u10m_cor(i,nsrf) * pctsrf(i,nsrf)
104
      zv10m_cor(i) = zv10m_cor(i) + v10m_cor(i,nsrf) * pctsrf(i,nsrf)
105
   ENDDO
106
ENDDO
107
108
RETURN
109
END
110
111