Changeset 5143 for LMDZ6/branches/Amaury_dev/libf/phylmd/borne_var_surf.F90
- Timestamp:
- Jul 29, 2024, 5:47:53 PM (3 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/borne_var_surf.F90
r5082 r5143 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 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 8 9 IMPLICIT NONE 9 USE lmdz_YOETHF 10 USE lmdz_fcttre, ONLY: foeew, foede, qsats, qsatl, dqsats, dqsatl, thermcep 10 11 11 !================================================================== 12 ! Declarations 13 !================================================================== 12 IMPLICIT NONE 14 13 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 14 !================================================================== 15 ! Declarations 16 !================================================================== 24 17 18 ! arguments 19 INTEGER klon, klev, nbsrf, iflag_bug_t2m_stab_ipslcm61 20 REAL, DIMENSION(klon), INTENT(IN) :: t1, q1, u1, v1 21 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: t2m, q2m, u10m, v10m 22 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: ftsol, pctsrf 23 REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs 24 REAL, DIMENSION(klon), INTENT(IN) :: qsurf 25 REAL, DIMENSION (klon), INTENT(OUT) :: zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor 26 REAL, DIMENSION (klon), INTENT(OUT) :: zrh2m_cor, zqsat2m_cor 25 27 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 !================================================================== 28 ! local 29 INTEGER i, nsrf 30 REAL, DIMENSION (klon, nbsrf) :: t2m_cor, q2m_cor, u10m_cor, v10m_cor 31 REAL :: zx_qs1, zcor1, zdelta1 32 include "YOMCST.h" 33 !================================================================== 34 ! Correction of sub surface variables 35 !================================================================== 36 36 37 zrh2m_cor=0.38 zqsat2m_cor=0.37 zrh2m_cor = 0. 38 zqsat2m_cor = 0. 39 39 40 DO nsrf=1,nbsrf41 DO i=1,klon42 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==-2.AND.q2m(i,nsrf)<0.) THEN47 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==-1.AND.(ftsol(i,nsrf)<=t1(i).OR.q2m(i,nsrf)<0.)) THEN55 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==1.AND.ftsol(i,nsrf)<=t1(i)) THEN63 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==0) THEN71 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 ENDIF79 !!!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*zcor185 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 ENDDO89 ENDDO40 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==-2.AND.q2m(i, nsrf)<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==-1.AND.(ftsol(i, nsrf)<=t1(i).OR.q2m(i, nsrf)<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==1.AND.ftsol(i, nsrf)<=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==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 90 91 !==================================================================92 ! Agregation of sub surfaces93 !==================================================================91 !================================================================== 92 ! Agregation of sub surfaces 93 !================================================================== 94 94 95 zt2m_cor=0.96 zq2m_cor=0.97 zu10m_cor=0.98 zv10m_cor=0.99 DO nsrf = 1, nbsrf100 DO i = 1, klon101 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 ENDDO106 ENDDO95 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 107 108 RETURN108 RETURN 109 109 END 110 110
Note: See TracChangeset
for help on using the changeset viewer.
