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