/[lmdze]/trunk/Sources/dyn3d/vlspltqs.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/vlspltqs.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 28 by guez, Fri Mar 26 18:33:04 2010 UTC revision 39 by guez, Tue Jan 25 15:11:05 2011 UTC
# Line 33  c Line 33  c
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)        REAL w(ip1jmp1,llm)
39        real, intent(in):: pdt        real, intent(in):: pdt
# Line 97  c   pour eviter une exponentielle. Line 97  c   pour eviter une exponentielle.
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
# Line 369  c  calcul du nombre de maille sur lequel Line 367  c  calcul du nombre de maille sur lequel
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
# Line 383  c   indicage des mailles concernees par Line 378  c   indicage des mailles concernees par
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
# Line 476  c Line 470  c
470        use comvert        use comvert
471        use logic        use logic
472        use comgeom        use comgeom
473          USE nr_util, ONLY : pi
474        IMPLICIT NONE        IMPLICIT NONE
475  c  c
476  c  c
# Line 607  c   calcul des pentes limites aux poles Line 602  c   calcul des pentes limites aux poles
602           dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)           dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
603        ENDDO        ENDDO
604    
 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  
   
605  c   calcul des pentes limitees  c   calcul des pentes limitees
606    
607        DO ij=iip2,ip1jm        DO ij=iip2,ip1jm
Legend:
Removed from v.28  
changed lines
  Added in v.39
  ViewVC Help
Powered by ViewVC 1.1.21