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

Last change on this file since 1243 was 1017, checked in by emillour, 11 years ago

Common dynamics: (and collateral adaptations in Venus physics)
Improved cpdet routines in and additional sponge mode:

  • Additionnal sponge mode (trigered with "callsponge" flag), in line with the one used in the Generic and Martian GCM. This sponge is called whenever there is a dissipation step.
  • Improvement of the cpdet routines : created routines tpot2t_glo_p and t2tpot_glo_p which handle fields on the whole dynamics (scaler) grid, which are more efficient than calling tpot2t_p or t2tpot_p with slabs of data (generated use of intermediate copies of these chunks of data at every call)
  • Turned cpdet.F into a module cpdet_mod.F90 (and correspondingly adapted all routines in the Venus physics).

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 cpdet_mod, only: t2tpot, tpot2t
10      IMPLICIT none
11c======================================================================
12c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
13c Objet: ajustement sec (adaptation du GCM du LMD)
14c S. Lebonnois, 10/2007:
15c melange u et v comme dans convadj (MARS)
16c======================================================================
17c Arguments:
18c tfi-------input-R- Temperature
19c ufi-------input-R- vent zonal
20c vfi-------input-R- vent meridien
21c nq--------input-R- nombre de traceurs
22c qfi-------input-R- traceurs
23c
24c d_tfi-----output-R-Incrementation de la temperature
25c d_ufi-----output-R-Incrementation du vent zonal
26c d_vfi-----output-R-Incrementation du vent meridien
27c d_qfi-----output-R-Incrementation des traceurs
28c======================================================================
29#include "dimensions.h"
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*llm,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
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*llm,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.