source: trunk/LMDZ.VENUS/libf/phyvenus/ajsec.F @ 1543

Last change on this file since 1543 was 1530, checked in by emillour, 9 years ago

Venus and Titan GCMs:
Updates in the physics to keep up with updates in LMDZ5 (up to
LMDZ5 trunk, rev 2350) concerning dynamics/physics separation:

  • Adapted makelmdz and makelmdz_fcm script to stop if trying to compile 1d model or newstart or start2archive in parallel.
  • got rid of references to "dimensions.h" in physics. Within physics packages, use nbp_lon (=iim), nbp_lat (=jjmp1) and nbp_lev (=llm) from module mod_grid_phy_lmdz (in phy_common) instead. Only partially done for Titan, because of many hard-coded commons; a necessary first step will be to clean these up (using modules).

EM
File size: 6.1 KB
Line 
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      use mod_grid_phy_lmdz, only: nbp_lev
10      use cpdet_mod, only: t2tpot, tpot2t
11      IMPLICIT none
12c======================================================================
13c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
14c Objet: ajustement sec (adaptation du GCM du LMD)
15c S. Lebonnois, 10/2007:
16c melange u et v comme dans convadj (MARS)
17c======================================================================
18c Arguments:
19c tfi-------input-R- Temperature
20c ufi-------input-R- vent zonal
21c vfi-------input-R- vent meridien
22c nq--------input-R- nombre de traceurs
23c qfi-------input-R- traceurs
24c
25c d_tfi-----output-R-Incrementation de la temperature
26c d_ufi-----output-R-Incrementation du vent zonal
27c d_vfi-----output-R-Incrementation du vent meridien
28c d_qfi-----output-R-Incrementation des traceurs
29c======================================================================
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)
38c
39      INTEGER,save :: limbas, limhau ! les couches a ajuster
40c
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
49c
50c Initialisation:
51c
52      limbas=1
53      limhau=klev
54
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
66c------------------------------------- passage en temperature potentielle
67! ADAPTATION GCM POUR CP(T)
68      call t2tpot(klon*nbp_lev,tfi,zh,ppk)
69c
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
76c
77c------------------------------------- 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
88c------------------------------------- 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
118c------------ nouveau profil : constant (valeur moyenne)
119c------------ 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
142c         STOP
143                 zalpha=1.
144              ELSE
145c                IF(zalpha.LT.0.) STOP
146                 IF(zalpha.LT.1.e-5) zalpha=1.e-4
147              ENDIF
148c ----------------------------
149c TEST --- PAS DE MELANGE DE U ni Q
150c             zalpha=0.
151c ----------------------------
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
166c
167c------------------------------------- passage en temperature
168c------------------------------------- et calcul du d_t
169! ADAPTATION GCM POUR CP(T)
170      call tpot2t(klon*nbp_lev,zh,zt,ppk)
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
182c
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
195c
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
208c
209      RETURN
210      END
211
Note: See TracBrowser for help on using the repository browser.