/[lmdze]/trunk/dyn3d/rotatf.f
ViewVC logotype

Diff of /trunk/dyn3d/rotatf.f

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

trunk/libf/dyn3d/rotatf.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/dyn3d/rotatf.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC
# Line 1  Line 1 
1  !  
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/rotatf.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/rotatf.F,v 1.1.1.1 2004/05/19
3  !  ! 12:53:05 lmdzadmin Exp $
4        SUBROUTINE rotatf (klevel, x, y, rot )  
5  c  SUBROUTINE rotatf(klevel, x, y, rot)
6  c     Auteur : P.Le Van  
7  c**************************************************************    ! Auteur : P.Le Van
8  c.  calcule le rotationnel    ! **************************************************************
9  c     a tous les niveaux d'1 vecteur de comp. x et y ..    ! .  calcule le rotationnel
10  c       x  et  y etant des composantes  covariantes  ...    ! a tous les niveaux d'1 vecteur de comp. x et y ..
11  c********************************************************************    ! x  et  y etant des composantes  covariantes  ...
12  c   klevel, x  et y   sont des arguments d'entree pour le s-prog    ! ********************************************************************
13  c        rot          est  un argument  de sortie pour le s-prog    ! klevel, x  et y   sont des arguments d'entree pour le s-prog
14  c    ! rot          est  un argument  de sortie pour le s-prog
15        use dimens_m  
16        use paramet_m    USE dimens_m
17        use comgeom    USE paramet_m
18        IMPLICIT NONE    USE comgeom
19  c    USE filtreg_m, ONLY: filtreg
20  c    IMPLICIT NONE
21  c   .....  variables en arguments  ......  
22  c  
23        INTEGER klevel    ! .....  variables en arguments  ......
24        REAL rot( ip1jm,klevel )  
25        REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )    INTEGER, INTENT (IN) :: klevel
26  c    REAL rot(ip1jm, klevel)
27  c  ...   variables  locales  ...    REAL, INTENT (IN) :: x(ip1jmp1, klevel), y(ip1jm, klevel)
28  c  
29        INTEGER  l, ij    ! ...   variables  locales  ...
30  c  
31  c    INTEGER l, ij
32        DO  10 l = 1,klevel  
33  c  
34          DO   ij = 1, ip1jm - 1    DO l = 1, klevel
35           rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +  
36       *                   x(ij +iip1, l )  -  x( ij,l )        DO ij = 1, ip1jm - 1
37          ENDDO        rot(ij, l) = y(ij+1, l) - y(ij, l) + x(ij+iip1, l) - x(ij, l)
38  c      END DO
39  c    .... correction pour rot( iip1,j,l)  ....  
40  c    ....   rot(iip1,j,l)= rot(1,j,l) ...      ! .... correction pour rot( iip1,j,l)  ....
41  CDIR$ IVDEP      ! ....   rot(iip1,j,l)= rot(1,j,l) ...
42          DO  ij = iip1, ip1jm, iip1      ! DIR$ IVDEP
43           rot( ij,l ) = rot( ij -iim,l )      DO ij = iip1, ip1jm, iip1
44          ENDDO        rot(ij, l) = rot(ij-iim, l)
45  c      END DO
46    10  CONTINUE  
47      END DO
48          CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )  
49            CALL filtreg(rot, jjm, klevel, 2, 2, .FALSE.)
50          DO l = 1, klevel  
51            DO ij = 1, ip1jm    DO l = 1, klevel
52             rot(ij,l) = rot(ij,l) * unsairez(ij)      DO ij = 1, ip1jm
53            ENDDO        rot(ij, l) = rot(ij, l)*unsairez(ij)
54          ENDDO      END DO
55  c    END DO
56  c  
57        RETURN  
58        END    RETURN
59    END SUBROUTINE rotatf
Legend:
Removed from v.3  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21