33 |
c Arguments: |
c Arguments: |
34 |
c ---------- |
c ---------- |
35 |
REAL masse(ip1jmp1,llm),pente_max |
REAL masse(ip1jmp1,llm),pente_max |
36 |
REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm) |
REAL, intent(in):: pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm) |
37 |
REAL q(ip1jmp1,llm) |
REAL q(ip1jmp1,llm) |
38 |
REAL w(ip1jmp1,llm),pdt |
REAL w(ip1jmp1,llm) |
39 |
REAL p(ip1jmp1,llmp1),teta(ip1jmp1,llm),pk(ip1jmp1,llm) |
real, intent(in):: pdt |
40 |
|
REAL, intent(in):: p(ip1jmp1,llmp1) |
41 |
|
real teta(ip1jmp1,llm),pk(ip1jmp1,llm) |
42 |
c |
c |
43 |
c Local |
c Local |
44 |
c --------- |
c --------- |
97 |
ENDDO |
ENDDO |
98 |
ENDDO |
ENDDO |
99 |
|
|
|
c PRINT*,'Debut vlsplt version debug sans vlyqs' |
|
|
|
|
100 |
zzpbar = 0.5 * pdt |
zzpbar = 0.5 * pdt |
101 |
zzw = pdt |
zzw = pdt |
102 |
DO l=1,llm |
DO l=1,llm |
367 |
ENDDO |
ENDDO |
368 |
|
|
369 |
IF(n0.gt.0) THEN |
IF(n0.gt.0) THEN |
|
ccc PRINT*,'Nombre de points pour lesquels on advect plus que le' |
|
|
ccc & ,'contenu de la maille : ',n0 |
|
|
|
|
370 |
DO l=1,llm |
DO l=1,llm |
371 |
IF(nl(l).gt.0) THEN |
IF(nl(l).gt.0) THEN |
372 |
iju=0 |
iju=0 |
378 |
ENDIF |
ENDIF |
379 |
ENDDO |
ENDDO |
380 |
niju=iju |
niju=iju |
|
c PRINT*,'niju,nl',niju,nl(l) |
|
381 |
|
|
382 |
c traitement des mailles |
c traitement des mailles |
383 |
DO iju=1,niju |
DO iju=1,niju |
601 |
dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l) |
dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l) |
602 |
ENDDO |
ENDDO |
603 |
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
|
|
C En memoire de dIFferents tests sur la |
|
|
C limitation des pentes aux poles. |
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
|
|
C PRINT*,dyq(1) |
|
|
C PRINT*,dyqv(iip1+1) |
|
|
C apn=abs(dyq(1)/dyqv(iip1+1)) |
|
|
C PRINT*,dyq(ip1jm+1) |
|
|
C PRINT*,dyqv(ip1jm-iip1+1) |
|
|
C aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1)) |
|
|
C DO ij=2,iim |
|
|
C apn=amax1(abs(dyq(ij)/dyqv(ij)),apn) |
|
|
C aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps) |
|
|
C ENDDO |
|
|
C apn=min(pente_max/apn,1.) |
|
|
C aps=min(pente_max/aps,1.) |
|
|
C |
|
|
C |
|
|
C cas ou on a un extremum au pole |
|
|
C |
|
|
C IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.) |
|
|
C & apn=0. |
|
|
C IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)* |
|
|
C & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.) |
|
|
C & aps=0. |
|
|
C |
|
|
C limitation des pentes aux poles |
|
|
C DO ij=1,iip1 |
|
|
C dyq(ij)=apn*dyq(ij) |
|
|
C dyq(ip1jm+ij)=aps*dyq(ip1jm+ij) |
|
|
C ENDDO |
|
|
C |
|
|
C test |
|
|
C DO ij=1,iip1 |
|
|
C dyq(iip1+ij)=0. |
|
|
C dyq(ip1jm+ij-iip1)=0. |
|
|
C ENDDO |
|
|
C DO ij=1,ip1jmp1 |
|
|
C dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1)) |
|
|
C ENDDO |
|
|
C |
|
|
C changement 10 07 96 |
|
|
C IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.) |
|
|
C & THEN |
|
|
C DO ij=1,iip1 |
|
|
C dyqmax(ij)=0. |
|
|
C ENDDO |
|
|
C ELSE |
|
|
C DO ij=1,iip1 |
|
|
C dyqmax(ij)=pente_max*abs(dyqv(ij)) |
|
|
C ENDDO |
|
|
C ENDIF |
|
|
C |
|
|
C IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)* |
|
|
C & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.) |
|
|
C &THEN |
|
|
C DO ij=ip1jm+1,ip1jmp1 |
|
|
C dyqmax(ij)=0. |
|
|
C ENDDO |
|
|
C ELSE |
|
|
C DO ij=ip1jm+1,ip1jmp1 |
|
|
C dyqmax(ij)=pente_max*abs(dyqv(ij-iip1)) |
|
|
C ENDDO |
|
|
C ENDIF |
|
|
C fin changement 10 07 96 |
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
|
|
|
|
604 |
c calcul des pentes limitees |
c calcul des pentes limitees |
605 |
|
|
606 |
DO ij=iip2,ip1jm |
DO ij=iip2,ip1jm |