[3] | 1 | ! |
---|
| 2 | ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ajsec.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $ |
---|
| 3 | ! |
---|
| 4 | ! ADAPTATION GCM POUR CP(T) |
---|
| 5 | SUBROUTINE ajsec(paprs, pplay, ppk, tfi, ufi, vfi, nq, qfi, |
---|
| 6 | . d_tfi, d_ufi, d_vfi, d_qfi) |
---|
[101] | 7 | |
---|
| 8 | use dimphy |
---|
[1530] | 9 | use mod_grid_phy_lmdz, only: nbp_lev |
---|
[1621] | 10 | use cpdet_phy_mod, only: t2tpot, tpot2t |
---|
[3] | 11 | IMPLICIT none |
---|
| 12 | c====================================================================== |
---|
| 13 | c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818 |
---|
| 14 | c Objet: ajustement sec (adaptation du GCM du LMD) |
---|
| 15 | c S. Lebonnois, 10/2007: |
---|
| 16 | c melange u et v comme dans convadj (MARS) |
---|
| 17 | c====================================================================== |
---|
| 18 | c Arguments: |
---|
| 19 | c tfi-------input-R- Temperature |
---|
| 20 | c ufi-------input-R- vent zonal |
---|
| 21 | c vfi-------input-R- vent meridien |
---|
| 22 | c nq--------input-R- nombre de traceurs |
---|
| 23 | c qfi-------input-R- traceurs |
---|
| 24 | c |
---|
| 25 | c d_tfi-----output-R-Incrementation de la temperature |
---|
| 26 | c d_ufi-----output-R-Incrementation du vent zonal |
---|
| 27 | c d_vfi-----output-R-Incrementation du vent meridien |
---|
| 28 | c d_qfi-----output-R-Incrementation des traceurs |
---|
| 29 | c====================================================================== |
---|
| 30 | #include "YOMCST.h" |
---|
| 31 | REAL paprs(klon,klev+1), pplay(klon,klev) |
---|
| 32 | REAL ppk(klon,klev) |
---|
| 33 | INTEGER nq |
---|
| 34 | REAL tfi(klon,klev), d_tfi(klon,klev) |
---|
| 35 | REAL ufi(klon,klev), d_ufi(klon,klev) |
---|
| 36 | REAL vfi(klon,klev), d_vfi(klon,klev) |
---|
| 37 | REAL qfi(klon,klev,nq), d_qfi(klon,klev,nq) |
---|
| 38 | c |
---|
[101] | 39 | INTEGER,save :: limbas, limhau ! les couches a ajuster |
---|
[3] | 40 | c |
---|
| 41 | REAL zh(klon,klev) |
---|
| 42 | REAL zu(klon,klev),zv(klon,klev) |
---|
| 43 | REAL zt(klon,klev),zq(klon,klev,nq) |
---|
| 44 | REAL zdp(klon,klev) |
---|
| 45 | REAL zpkdp(klon,klev) |
---|
| 46 | REAL hm,sm,zum,zvm,zalpha,zqm(nq) |
---|
| 47 | LOGICAL modif(klon), down |
---|
| 48 | INTEGER i, k, k1, k2, iq |
---|
| 49 | c |
---|
| 50 | c Initialisation: |
---|
| 51 | c |
---|
[101] | 52 | limbas=1 |
---|
| 53 | limhau=klev |
---|
| 54 | |
---|
[3] | 55 | DO k = 1, klev |
---|
| 56 | DO i = 1, klon |
---|
| 57 | d_tfi(i,k) = 0.0 |
---|
| 58 | d_ufi(i,k) = 0.0 |
---|
| 59 | d_vfi(i,k) = 0.0 |
---|
| 60 | d_qfi(i,k,:) = 0.0 |
---|
| 61 | zu(i,k) = ufi(i,k) |
---|
| 62 | zv(i,k) = vfi(i,k) |
---|
| 63 | zq(i,k,:) = qfi(i,k,:) |
---|
| 64 | ENDDO |
---|
| 65 | ENDDO |
---|
| 66 | c------------------------------------- passage en temperature potentielle |
---|
| 67 | ! ADAPTATION GCM POUR CP(T) |
---|
[1530] | 68 | call t2tpot(klon*nbp_lev,tfi,zh,ppk) |
---|
[3] | 69 | c |
---|
| 70 | DO k = limbas, limhau |
---|
| 71 | DO i = 1, klon |
---|
| 72 | zdp(i,k) = paprs(i,k)-paprs(i,k+1) |
---|
| 73 | zpkdp(i,k) = ppk(i,k) * zdp(i,k) |
---|
| 74 | ENDDO |
---|
| 75 | ENDDO |
---|
| 76 | c |
---|
| 77 | c------------------------------------- detection des profils a modifier |
---|
| 78 | DO i = 1, klon |
---|
| 79 | modif(i) = .FALSE. |
---|
| 80 | ENDDO |
---|
| 81 | DO k = limbas+1, limhau |
---|
| 82 | DO i = 1, klon |
---|
| 83 | IF (.NOT.modif(i)) THEN |
---|
| 84 | IF ( zh(i,k).LT.zh(i,k-1) ) modif(i) = .TRUE. |
---|
| 85 | ENDIF |
---|
| 86 | ENDDO |
---|
| 87 | ENDDO |
---|
| 88 | c------------------------------------- correction des profils instables |
---|
| 89 | DO 1080 i = 1, klon |
---|
| 90 | IF (modif(i)) THEN |
---|
| 91 | k2 = limbas |
---|
| 92 | 8000 CONTINUE |
---|
| 93 | k2 = k2 + 1 |
---|
| 94 | IF (k2 .GT. limhau) goto 8001 |
---|
| 95 | IF (zh(i,k2) .LT. zh(i,k2-1)) THEN |
---|
| 96 | k1 = k2 - 1 |
---|
| 97 | k = k1 |
---|
| 98 | sm = zpkdp(i,k2) |
---|
| 99 | hm = zh(i,k2) |
---|
| 100 | 8020 CONTINUE |
---|
| 101 | sm = sm +zpkdp(i,k) |
---|
| 102 | hm = hm +zpkdp(i,k) * (zh(i,k)-hm) / sm |
---|
| 103 | down = .FALSE. |
---|
| 104 | IF (k1 .ne. limbas) THEN |
---|
| 105 | IF (hm .LT. zh(i,k1-1)) down = .TRUE. |
---|
| 106 | ENDIF |
---|
| 107 | IF (down) THEN |
---|
| 108 | k1 = k1 - 1 |
---|
| 109 | k = k1 |
---|
| 110 | ELSE |
---|
| 111 | IF ((k2 .EQ. limhau)) GOTO 8021 |
---|
| 112 | IF ((zh(i,k2+1).GE.hm)) GOTO 8021 |
---|
| 113 | k2 = k2 + 1 |
---|
| 114 | k = k2 |
---|
| 115 | ENDIF |
---|
| 116 | GOTO 8020 |
---|
| 117 | 8021 CONTINUE |
---|
| 118 | c------------ nouveau profil : constant (valeur moyenne) |
---|
| 119 | c------------ et melange partiel des vents |
---|
| 120 | zalpha=0. |
---|
| 121 | zum=0. |
---|
| 122 | zvm=0. |
---|
| 123 | zqm=0. |
---|
| 124 | DO k = k1, k2 |
---|
| 125 | zalpha=zalpha+ABS(zh(i,k)-hm)*zdp(i,k) |
---|
| 126 | zh(i,k) = hm |
---|
| 127 | zum=zum+ufi(i,k)*zdp(i,k) |
---|
| 128 | zvm=zvm+vfi(i,k)*zdp(i,k) |
---|
| 129 | do iq=1,nq |
---|
| 130 | zqm(iq)=zqm(iq)+qfi(i,k,iq)*zdp(i,k) |
---|
| 131 | enddo |
---|
| 132 | ENDDO |
---|
| 133 | zalpha=zalpha/(hm*(paprs(i,k1)-paprs(i,k2+1))) |
---|
| 134 | zum=zum/(paprs(i,k1)-paprs(i,k2+1)) |
---|
| 135 | zvm=zvm/(paprs(i,k1)-paprs(i,k2+1)) |
---|
| 136 | do iq=1,nq |
---|
| 137 | zqm(iq)=zqm(iq)/(paprs(i,k1)-paprs(i,k2+1)) |
---|
| 138 | enddo |
---|
| 139 | |
---|
| 140 | IF(zalpha.GT.1.) THEN |
---|
| 141 | PRINT*,'WARNING dans ajsec zalpha=',zalpha |
---|
| 142 | c STOP |
---|
| 143 | zalpha=1. |
---|
| 144 | ELSE |
---|
| 145 | c IF(zalpha.LT.0.) STOP |
---|
| 146 | IF(zalpha.LT.1.e-5) zalpha=1.e-4 |
---|
| 147 | ENDIF |
---|
| 148 | c ---------------------------- |
---|
[1301] | 149 | c TEST --- PAS DE MELANGE DE U ni Q |
---|
[3] | 150 | c zalpha=0. |
---|
| 151 | c ---------------------------- |
---|
| 152 | |
---|
| 153 | DO k=k1,k2 |
---|
| 154 | zu(i,k)=ufi(i,k)+zalpha*(zum-ufi(i,k)) |
---|
| 155 | zv(i,k)=vfi(i,k)+zalpha*(zvm-vfi(i,k)) |
---|
| 156 | do iq=1,nq |
---|
| 157 | zq(i,k,iq)=qfi(i,k,iq)+zalpha*(zqm(iq)-qfi(i,k,iq)) |
---|
| 158 | enddo |
---|
| 159 | ENDDO |
---|
| 160 | k2 = k2 + 1 |
---|
| 161 | ENDIF |
---|
| 162 | GOTO 8000 |
---|
| 163 | 8001 CONTINUE |
---|
| 164 | ENDIF |
---|
| 165 | 1080 CONTINUE |
---|
| 166 | c |
---|
| 167 | c------------------------------------- passage en temperature |
---|
| 168 | c------------------------------------- et calcul du d_t |
---|
| 169 | ! ADAPTATION GCM POUR CP(T) |
---|
[1530] | 170 | call tpot2t(klon*nbp_lev,zh,zt,ppk) |
---|
[3] | 171 | |
---|
| 172 | DO k = limbas, limhau |
---|
| 173 | DO i = 1, klon |
---|
| 174 | d_tfi(i,k) = zt(i,k) - tfi(i,k) |
---|
| 175 | d_ufi(i,k) = zu(i,k) - ufi(i,k) |
---|
| 176 | d_vfi(i,k) = zv(i,k) - vfi(i,k) |
---|
| 177 | do iq=1,nq |
---|
| 178 | d_qfi(i,k,iq) = zq(i,k,iq) - qfi(i,k,iq) |
---|
| 179 | enddo |
---|
| 180 | ENDDO |
---|
| 181 | ENDDO |
---|
| 182 | c |
---|
| 183 | IF (limbas.GT.1) THEN |
---|
| 184 | DO k = 1, limbas-1 |
---|
| 185 | DO i = 1, klon |
---|
| 186 | d_tfi(i,k) = 0.0 |
---|
| 187 | d_ufi(i,k) = 0.0 |
---|
| 188 | d_vfi(i,k) = 0.0 |
---|
| 189 | do iq=1,nq |
---|
| 190 | d_qfi(i,k,iq) = 0.0 |
---|
| 191 | enddo |
---|
| 192 | ENDDO |
---|
| 193 | ENDDO |
---|
| 194 | ENDIF |
---|
| 195 | c |
---|
| 196 | IF (limhau.LT.klev) THEN |
---|
| 197 | DO k = limhau+1, klev |
---|
| 198 | DO i = 1, klon |
---|
| 199 | d_tfi(i,k) = 0.0 |
---|
| 200 | d_ufi(i,k) = 0.0 |
---|
| 201 | d_vfi(i,k) = 0.0 |
---|
| 202 | do iq=1,nq |
---|
| 203 | d_qfi(i,k,iq) = 0.0 |
---|
| 204 | enddo |
---|
| 205 | ENDDO |
---|
| 206 | ENDDO |
---|
| 207 | ENDIF |
---|
| 208 | c |
---|
| 209 | RETURN |
---|
| 210 | END |
---|
| 211 | |
---|