source: LMDZ6/trunk/libf/dyn3d_common/advzp.f90 @ 5431

Last change on this file since 5431 was 5285, checked in by abarral, 8 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.5 KB
RevLine 
[524]1!
2! $Header$
3!
[5246]4SUBROUTINE ADVZP(LIMIT,DTZ,W,SM,S0,SSX,SY,SZ &
5        ,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra )
[524]6
[5281]7  USE comgeom_mod_h
[5271]8  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]9USE paramet_mod_h
[5271]10IMPLICIT NONE
[524]11
[5246]12  !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
13  !                                                                 C
14  !  second-order moments (SOM) advection of tracer in Z direction  C
15  !                                                                 C
16  !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
17  !                                                                 C
18  !  Source : Pascal Simon ( Meteo, CNRM )                          C
19  !  Adaptation : A.A. (LGGE)                                       C
20  !  Derniere Modif : 19/11/95 LAST                                 C
21  !                                                                 C
22  !  sont les arguments d'entree pour le s-pg                       C
23  !                                                                 C
24  !  argument de sortie du s-pg                                     C
25  !                                                                 C
26  !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
27  !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
28  !
29  ! Rem : Probleme aux poles il faut reecrire ce cas specifique
30  !    Attention au sens de l'indexation
31  !
[524]32
[5246]33  !
34  !  parametres principaux du modele
35  !
[5271]36
[5272]37
[5246]38  !
39  !  Arguments :
40  !  ----------
41  !  dty : frequence fictive d'appel du transport
42  !  parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
43  !
44    INTEGER :: lon,lat,niv
45    INTEGER :: i,j,jv,k,kp,l,lp
46    INTEGER :: ntra
47     ! PARAMETER (ntra = 1)
48  !
49    REAL :: dtz
50    REAL :: w ( iip1,jjp1,llm )
51  !
52  !  moments: SM  total mass in each grid box
53  !       S0  mass of tracer in each grid box
54  !       Si  1rst order moment in i direction
55  !
56  REAL :: SM(iip1,jjp1,llm) &
57        ,S0(iip1,jjp1,llm,ntra)
58  REAL :: SSX(iip1,jjp1,llm,ntra) &
59        ,SY(iip1,jjp1,llm,ntra) &
60        ,SZ(iip1,jjp1,llm,ntra) &
61        ,SSXX(iip1,jjp1,llm,ntra) &
62        ,SSXY(iip1,jjp1,llm,ntra) &
63        ,SSXZ(iip1,jjp1,llm,ntra) &
64        ,SYY(iip1,jjp1,llm,ntra) &
65        ,SYZ(iip1,jjp1,llm,ntra) &
66        ,SZZ(iip1,jjp1,llm,ntra)
67  !
68  !  Local :
69  !  -------
70  !
71  !  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
72  !  mass fluxes in kg
73  !  declaration :
74  !
75  REAL :: WGRI(iip1,jjp1,0:llm)
[524]76
[5246]77  ! Rem : UGRI et VGRI ne sont pas utilises dans
78  !  cette subroutine ( advection en z uniquement )
79  !  Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
80      ! attention a celui de WGRI
81  !
82  !  the moments F are similarly defined and used as temporary
83  !  storage for portions of the grid boxes in transit
84  !
85  !  the moments Fij are used as temporary storage for
86  !  portions of the grid boxes in transit at the current level
87  !
88  !  work arrays
89  !
90  !
91  REAL :: F0(iim,llm,ntra),FM(iim,llm)
92  REAL :: FX(iim,llm,ntra),FY(iim,llm,ntra)
93  REAL :: FZ(iim,llm,ntra)
94  REAL :: FXX(iim,llm,ntra),FXY(iim,llm,ntra)
95  REAL :: FXZ(iim,llm,ntra),FYY(iim,llm,ntra)
96  REAL :: FYZ(iim,llm,ntra),FZZ(iim,llm,ntra)
97  REAL :: S00(ntra)
98  REAL :: SM0             ! Just temporal variable
99  !
100  !  work arrays
101  !
102  REAL :: ALF(iim),ALF1(iim)
103  REAL :: ALFQ(iim),ALF1Q(iim)
104  REAL :: ALF2(iim),ALF3(iim)
105  REAL :: ALF4(iim)
106  REAL :: TEMPTM          ! Just temporal variable
107  REAL :: SLPMAX,S1MAX,S1NEW,S2NEW
108  !
109  REAL :: sqi,sqf
110  LOGICAL :: LIMIT
[524]111
[5246]112  lon = iim         ! rem : Il est possible qu'un pbl. arrive ici
113  lat = jjp1        ! a cause des dim. differentes entre les
114  niv = llm         !       tab. S et VGRI
[524]115
[5246]116  !-----------------------------------------------------------------
117  ! *** Test : diag de la qtite totale de traceur dans
118         ! l'atmosphere avant l'advection en Y
119  !
120  sqi = 0.
121  sqf = 0.
122  !
123  DO l = 1,llm
124     DO j = 1,jjp1
[524]125       DO i = 1,iim
[5246]126          sqi = sqi + S0(i,j,l,ntra)
127       END DO
128     END DO
129  END DO
130  PRINT*,'---------- DIAG DANS ADVZP - ENTREE --------'
131  PRINT*,'sqi=',sqi
[524]132
[5246]133  !-----------------------------------------------------------------
134  !  Interface : adaptation nouveau modele
135  !  -------------------------------------
136  !
137  !  Conversion des flux de masses en kg
138
139  DO l = 1,llm
140     DO j = 1,jjp1
141        DO i = 1,iip1
142        wgri (i,j,llm+1-l) = w (i,j,l)
143        END DO
144     END DO
145  END DO
146  do j=1,jjp1
147     do i=1,iip1
148        wgri(i,j,0)=0.
149     enddo
150  enddo
151  !
152  !AA rem : Je ne suis pas sur du signe
153  !AA       Je ne suis pas sur pour le 0:llm
154  !
155  !-----------------------------------------------------------------
156  !---------------------- START HERE -------------------------------
157  !
158  !  boucle sur les latitudes
159  !
160  DO K=1,LAT
161  !
162  !  place limits on appropriate moments before transport
163  !  (if flux-limiting is to be applied)
164  !
165  IF(.NOT.LIMIT) GO TO 101
166  !
167  DO JV=1,NTRA
168  DO L=1,NIV
169     DO I=1,LON
170        IF(S0(I,K,L,JV).GT.0.) THEN
171          SLPMAX=S0(I,K,L,JV)
172          S1MAX =1.5*SLPMAX
173          S1NEW =AMIN1(S1MAX,AMAX1(-S1MAX,SZ(I,K,L,JV)))
174          S2NEW =AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. , &
175                AMAX1(ABS(S1NEW)-SLPMAX,SZZ(I,K,L,JV)) )
176          SZ (I,K,L,JV)=S1NEW
177          SZZ(I,K,L,JV)=S2NEW
178          SSXZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SSXZ(I,K,L,JV)))
179          SYZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SYZ(I,K,L,JV)))
180        ELSE
181          SZ (I,K,L,JV)=0.
182          SZZ(I,K,L,JV)=0.
183          SSXZ(I,K,L,JV)=0.
184          SYZ(I,K,L,JV)=0.
185        ENDIF
186     END DO
187  END DO
188  END DO
189  !
190 101   CONTINUE
191  !
192  !  boucle sur les niveaux intercouches de 1 a NIV-1
193  !   (flux nul au sommet L=0 et a la base L=NIV)
194  !
195  !  calculate flux and moments between adjacent boxes
196  ! (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
197  !  1- create temporary moments/masses for partial boxes in transit
198  !  2- reajusts moments remaining in the box
199  !
200  DO L=1,NIV-1
201  LP=L+1
202  !
203  DO I=1,LON
204  !
205     IF(WGRI(I,K,L).LT.0.) THEN
206       FM(I,L)=-WGRI(I,K,L)*DTZ
207       ALF(I)=FM(I,L)/SM(I,K,LP)
208       SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
209     ELSE
210       FM(I,L)=WGRI(I,K,L)*DTZ
211       ALF(I)=FM(I,L)/SM(I,K,L)
212       SM(I,K,L)=SM(I,K,L)-FM(I,L)
213     ENDIF
214  !
215     ALFQ (I)=ALF(I)*ALF(I)
216     ALF1 (I)=1.-ALF(I)
217     ALF1Q(I)=ALF1(I)*ALF1(I)
218     ALF2 (I)=ALF1(I)-ALF(I)
219     ALF3 (I)=ALF(I)*ALFQ(I)
220     ALF4 (I)=ALF1(I)*ALF1Q(I)
221  !
222  END DO
223  !
224  DO JV=1,NTRA
225  DO I=1,LON
226  !
227     IF(WGRI(I,K,L).LT.0.) THEN
228  !
229       F0 (I,L,JV)=ALF (I)* ( S0(I,K,LP,JV)-ALF1(I)* &
230             ( SZ(I,K,LP,JV)-ALF2(I)*SZZ(I,K,LP,JV) ) )
231       FZ (I,L,JV)=ALFQ(I)*(SZ(I,K,LP,JV)-3.*ALF1(I)*SZZ(I,K,LP,JV))
232       FZZ(I,L,JV)=ALF3(I)*SZZ(I,K,LP,JV)
233       FXZ(I,L,JV)=ALFQ(I)*SSXZ(I,K,LP,JV)
234       FYZ(I,L,JV)=ALFQ(I)*SYZ(I,K,LP,JV)
235       FX (I,L,JV)=ALF (I)*(SSX(I,K,LP,JV)-ALF1(I)*SSXZ(I,K,LP,JV))
236       FY (I,L,JV)=ALF (I)*(SY(I,K,LP,JV)-ALF1(I)*SYZ(I,K,LP,JV))
237       FXX(I,L,JV)=ALF (I)*SSXX(I,K,LP,JV)
238       FXY(I,L,JV)=ALF (I)*SSXY(I,K,LP,JV)
239       FYY(I,L,JV)=ALF (I)*SYY(I,K,LP,JV)
240  !
241       S0 (I,K,LP,JV)=S0 (I,K,LP,JV)-F0 (I,L,JV)
242       SZ (I,K,LP,JV)=ALF1Q(I) &
243             *(SZ(I,K,LP,JV)+3.*ALF(I)*SZZ(I,K,LP,JV))
244       SZZ(I,K,LP,JV)=ALF4 (I)*SZZ(I,K,LP,JV)
245       SSXZ(I,K,LP,JV)=ALF1Q(I)*SSXZ(I,K,LP,JV)
246       SYZ(I,K,LP,JV)=ALF1Q(I)*SYZ(I,K,LP,JV)
247       SSX (I,K,LP,JV)=SSX (I,K,LP,JV)-FX (I,L,JV)
248       SY (I,K,LP,JV)=SY (I,K,LP,JV)-FY (I,L,JV)
249       SSXX(I,K,LP,JV)=SSXX(I,K,LP,JV)-FXX(I,L,JV)
250       SSXY(I,K,LP,JV)=SSXY(I,K,LP,JV)-FXY(I,L,JV)
251       SYY(I,K,LP,JV)=SYY(I,K,LP,JV)-FYY(I,L,JV)
252  !
253     ELSE
254  !
255       F0 (I,L,JV)=ALF (I)*(S0(I,K,L,JV) &
256             +ALF1(I) * (SZ(I,K,L,JV)+ALF2(I)*SZZ(I,K,L,JV)) )
257       FZ (I,L,JV)=ALFQ(I)*(SZ(I,K,L,JV)+3.*ALF1(I)*SZZ(I,K,L,JV))
258       FZZ(I,L,JV)=ALF3(I)*SZZ(I,K,L,JV)
259       FXZ(I,L,JV)=ALFQ(I)*SSXZ(I,K,L,JV)
260       FYZ(I,L,JV)=ALFQ(I)*SYZ(I,K,L,JV)
261       FX (I,L,JV)=ALF (I)*(SSX(I,K,L,JV)+ALF1(I)*SSXZ(I,K,L,JV))
262       FY (I,L,JV)=ALF (I)*(SY(I,K,L,JV)+ALF1(I)*SYZ(I,K,L,JV))
263       FXX(I,L,JV)=ALF (I)*SSXX(I,K,L,JV)
264       FXY(I,L,JV)=ALF (I)*SSXY(I,K,L,JV)
265       FYY(I,L,JV)=ALF (I)*SYY(I,K,L,JV)
266  !
267       S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0(I,L,JV)
268       SZ (I,K,L,JV)=ALF1Q(I)*(SZ(I,K,L,JV)-3.*ALF(I)*SZZ(I,K,L,JV))
269       SZZ(I,K,L,JV)=ALF4 (I)*SZZ(I,K,L,JV)
270       SSXZ(I,K,L,JV)=ALF1Q(I)*SSXZ(I,K,L,JV)
271       SYZ(I,K,L,JV)=ALF1Q(I)*SYZ(I,K,L,JV)
272       SSX (I,K,L,JV)=SSX (I,K,L,JV)-FX (I,L,JV)
273       SY (I,K,L,JV)=SY (I,K,L,JV)-FY (I,L,JV)
274       SSXX(I,K,L,JV)=SSXX(I,K,L,JV)-FXX(I,L,JV)
275       SSXY(I,K,L,JV)=SSXY(I,K,L,JV)-FXY(I,L,JV)
276       SYY(I,K,L,JV)=SYY(I,K,L,JV)-FYY(I,L,JV)
277  !
278     ENDIF
279  !
280  END DO
281  END DO
282  !
283  END DO
284  !
285  !  puts the temporary moments Fi into appropriate neighboring boxes
286  !
287  DO L=1,NIV-1
288  LP=L+1
289  !
290  DO I=1,LON
291  !
292     IF(WGRI(I,K,L).LT.0.) THEN
293       SM(I,K,L)=SM(I,K,L)+FM(I,L)
294       ALF(I)=FM(I,L)/SM(I,K,L)
295     ELSE
296       SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
297       ALF(I)=FM(I,L)/SM(I,K,LP)
298     ENDIF
299  !
300     ALF1(I)=1.-ALF(I)
301     ALFQ(I)=ALF(I)*ALF(I)
302     ALF1Q(I)=ALF1(I)*ALF1(I)
303     ALF2(I)=ALF(I)*ALF1(I)
304     ALF3(I)=ALF1(I)-ALF(I)
305  !
306  END DO
307  !
308  DO JV=1,NTRA
309  DO I=1,LON
310  !
311     IF(WGRI(I,K,L).LT.0.) THEN
312  !
313       TEMPTM=-ALF(I)*S0(I,K,L,JV)+ALF1(I)*F0(I,L,JV)
314       S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
315       SZZ(I,K,L,JV)=ALFQ(I)*FZZ(I,L,JV)+ALF1Q(I)*SZZ(I,K,L,JV) &
316             +5.*( ALF2(I)*(FZ(I,L,JV)-SZ(I,K,L,JV))+ALF3(I)*TEMPTM )
317       SZ (I,K,L,JV)=ALF (I)*FZ (I,L,JV)+ALF1 (I)*SZ (I,K,L,JV) &
318             +3.*TEMPTM
319       SSXZ(I,K,L,JV)=ALF (I)*FXZ(I,L,JV)+ALF1 (I)*SSXZ(I,K,L,JV) &
320             +3.*(ALF1(I)*FX (I,L,JV)-ALF  (I)*SSX (I,K,L,JV))
321       SYZ(I,K,L,JV)=ALF (I)*FYZ(I,L,JV)+ALF1 (I)*SYZ(I,K,L,JV) &
322             +3.*(ALF1(I)*FY (I,L,JV)-ALF  (I)*SY (I,K,L,JV))
323       SSX (I,K,L,JV)=SSX (I,K,L,JV)+FX (I,L,JV)
324       SY (I,K,L,JV)=SY (I,K,L,JV)+FY (I,L,JV)
325       SSXX(I,K,L,JV)=SSXX(I,K,L,JV)+FXX(I,L,JV)
326       SSXY(I,K,L,JV)=SSXY(I,K,L,JV)+FXY(I,L,JV)
327       SYY(I,K,L,JV)=SYY(I,K,L,JV)+FYY(I,L,JV)
328  !
329     ELSE
330  !
331       TEMPTM=ALF(I)*S0(I,K,LP,JV)-ALF1(I)*F0(I,L,JV)
332       S0 (I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
333       SZZ(I,K,LP,JV)=ALFQ(I)*FZZ(I,L,JV)+ALF1Q(I)*SZZ(I,K,LP,JV) &
334             +5.*( ALF2(I)*(SZ(I,K,LP,JV)-FZ(I,L,JV))-ALF3(I)*TEMPTM )
335       SZ (I,K,LP,JV)=ALF (I)*FZ(I,L,JV)+ALF1(I)*SZ(I,K,LP,JV) &
336             +3.*TEMPTM
337       SSXZ(I,K,LP,JV)=ALF(I)*FXZ(I,L,JV)+ALF1(I)*SSXZ(I,K,LP,JV) &
338             +3.*(ALF(I)*SSX(I,K,LP,JV)-ALF1(I)*FX(I,L,JV))
339       SYZ(I,K,LP,JV)=ALF(I)*FYZ(I,L,JV)+ALF1(I)*SYZ(I,K,LP,JV) &
340             +3.*(ALF(I)*SY(I,K,LP,JV)-ALF1(I)*FY(I,L,JV))
341       SSX (I,K,LP,JV)=SSX (I,K,LP,JV)+FX (I,L,JV)
342       SY (I,K,LP,JV)=SY (I,K,LP,JV)+FY (I,L,JV)
343       SSXX(I,K,LP,JV)=SSXX(I,K,LP,JV)+FXX(I,L,JV)
344       SSXY(I,K,LP,JV)=SSXY(I,K,LP,JV)+FXY(I,L,JV)
345       SYY(I,K,LP,JV)=SYY(I,K,LP,JV)+FYY(I,L,JV)
346  !
347     ENDIF
348  !
349  END DO
350  END DO
351  !
352  END DO
353  !
354  !  fin de la boucle principale sur les latitudes
355  !
356  END DO
357  !
358  DO l = 1,llm
359  DO j = 1,jjp1
360      SM(iip1,j,l) = SM(1,j,l)
361      S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
362      SSX(iip1,j,l,ntra) = SSX(1,j,l,ntra)
363      SY(iip1,j,l,ntra) = SY(1,j,l,ntra)
364      SZ(iip1,j,l,ntra) = SZ(1,j,l,ntra)
365  ENDDO
366  ENDDO
367                                                                             ! C-------------------------------------------------------------
368  ! *** Test : diag de la qqtite totale de tarceur
369         ! dans l'atmosphere avant l'advection en z
370   DO l = 1,llm
371   DO j = 1,jjp1
372   DO i = 1,iim
373      sqf = sqf + S0(i,j,l,ntra)
374   ENDDO
375   ENDDO
376   ENDDO
377   PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
378   PRINT*,'sqf=', sqf
379
380  RETURN
381END SUBROUTINE ADVZP
Note: See TracBrowser for help on using the repository browser.