109 |
ENDDO |
ENDDO |
110 |
|
|
111 |
endif |
endif |
|
c Fin modif Fred |
|
112 |
|
|
113 |
c *** q contient les qqtes de traceur avant l'advection |
c *** q contient les qqtes de traceur avant l'advection |
114 |
|
|
126 |
ENDDO |
ENDDO |
127 |
ENDDO |
ENDDO |
128 |
|
|
|
c PRINT*,'----- S0 just before conversion -------' |
|
|
c PRINT*,'S0(16,12,1)=',s0(16,12,1) |
|
|
c PRINT*,'Q(16,12,1,4)=',q(16,12,1,4) |
|
|
|
|
129 |
c *** On calcule la masse d'air en kg |
c *** On calcule la masse d'air en kg |
130 |
|
|
131 |
DO l = 1,llm |
DO l = 1,llm |
152 |
ENDDO |
ENDDO |
153 |
ENDDO |
ENDDO |
154 |
|
|
|
c ss0 = 0. |
|
|
c DO l = 1,llm |
|
|
c DO j = 1,jjp1 |
|
|
c DO i = 1,iim |
|
|
c ss0 = ss0 + s0 ( i,j,l ) |
|
|
c ENDDO |
|
|
c ENDDO |
|
|
c ENDDO |
|
|
c PRINT*, 'valeur tot s0 avant advection=',ss0 |
|
|
|
|
155 |
c *** Appel des subroutines d'advection en X, en Y et en Z |
c *** Appel des subroutines d'advection en X, en Y et en Z |
156 |
c *** Advection avec "time-splitting" |
c *** Advection avec "time-splitting" |
157 |
|
|
|
c----------------------------------------------------------- |
|
|
c PRINT*,'----- S0 just before ADVX -------' |
|
|
c PRINT*,'S0(16,12,1)=',s0(16,12,1) |
|
|
|
|
|
c----------------------------------------------------------- |
|
|
c do l=1,llm |
|
|
c do j=1,jjp1 |
|
|
c do i=1,iip1 |
|
|
c zq=s0(i,j,l)/sm(i,j,l) |
|
|
c if(zq.lt.qmin) |
|
|
c , print*,'avant advx1, s0(',i,',',j,',',l,')=',zq |
|
|
c enddo |
|
|
c enddo |
|
|
c enddo |
|
|
CCC |
|
158 |
if(mode.eq.2) then |
if(mode.eq.2) then |
159 |
do l=1,llm |
do l=1,llm |
160 |
s0s=0. |
s0s=0. |
226 |
enddo |
enddo |
227 |
endif |
endif |
228 |
call limx(s0,sx,sm,pente_max) |
call limx(s0,sx,sm,pente_max) |
|
c call minmaxq(zq,1.e33,-1.e33,'avant advx ') |
|
229 |
call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf) |
call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf) |
|
c call minmaxq(zq,1.e33,-1.e33,'avant advy ') |
|
230 |
if (mode.eq.4) then |
if (mode.eq.4) then |
231 |
do l=1,llm |
do l=1,llm |
232 |
do i=1,iip1 |
do i=1,iip1 |
239 |
endif |
endif |
240 |
call limy(s0,sy,sm,pente_max) |
call limy(s0,sy,sm,pente_max) |
241 |
call advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz ) |
call advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz ) |
|
c call minmaxq(zq,1.e33,-1.e33,'avant advz ') |
|
242 |
do j=1,jjp1 |
do j=1,jjp1 |
243 |
do i=1,iip1 |
do i=1,iip1 |
244 |
sz(i,j,1)=0. |
sz(i,j,1)=0. |
270 |
enddo |
enddo |
271 |
|
|
272 |
|
|
|
c call minmaxq(zq,1.e33,-1.e33,'avant advx ') |
|
273 |
if (mode.eq.4) then |
if (mode.eq.4) then |
274 |
do l=1,llm |
do l=1,llm |
275 |
do i=1,iip1 |
do i=1,iip1 |
282 |
endif |
endif |
283 |
call limx(s0,sx,sm,pente_max) |
call limx(s0,sx,sm,pente_max) |
284 |
call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf) |
call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf) |
|
c call minmaxq(zq,1.e33,-1.e33,'apres advx ') |
|
|
c do l=1,llm |
|
|
c do j=1,jjp1 |
|
|
c do i=1,iip1 |
|
|
c zq=s0(i,j,l)/sm(i,j,l) |
|
|
c if(zq.lt.qmin) |
|
|
c , print*,'apres advx2, s0(',i,',',j,',',l,')=',zq |
|
|
c enddo |
|
|
c enddo |
|
|
c enddo |
|
285 |
c *** On repasse les S dans la variable q directement 14/10/94 |
c *** On repasse les S dans la variable q directement 14/10/94 |
286 |
c On revient a des rapports de melange en divisant par la masse |
c On revient a des rapports de melange en divisant par la masse |
287 |
|
|
389 |
enddo |
enddo |
390 |
enddo |
enddo |
391 |
|
|
|
c PRINT*, ' SORTIE DE PENTES --- ca peut glisser ....' |
|
|
|
|
392 |
DO l = 1,llm |
DO l = 1,llm |
393 |
DO j = 1,jjp1 |
DO j = 1,jjp1 |
394 |
DO i = 1,iip1 |
DO i = 1,iip1 |
395 |
IF (q(i,j,l,0).lt.0.) THEN |
IF (q(i,j,l,0).lt.0.) THEN |
|
c PRINT*,'------------ BIP-----------' |
|
|
c PRINT*,'Q0(',i,j,l,')=',q(i,j,l,0) |
|
|
c PRINT*,'QX(',i,j,l,')=',q(i,j,l,1) |
|
|
c PRINT*,'QY(',i,j,l,')=',q(i,j,l,2) |
|
|
c PRINT*,'QZ(',i,j,l,')=',q(i,j,l,3) |
|
|
c PRINT*,' PBL EN SORTIE DE PENTES' |
|
396 |
q(i,j,l,0)=0. |
q(i,j,l,0)=0. |
|
c STOP |
|
397 |
ENDIF |
ENDIF |
398 |
ENDDO |
ENDDO |
399 |
ENDDO |
ENDDO |
400 |
ENDDO |
ENDDO |
401 |
|
|
|
c PRINT*, '-------------------------------------------' |
|
|
|
|
402 |
do l=1,llm |
do l=1,llm |
403 |
do j=1,jjp1 |
do j=1,jjp1 |
404 |
do i=1,iip1 |
do i=1,iip1 |
409 |
enddo |
enddo |
410 |
RETURN |
RETURN |
411 |
END |
END |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|