source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/dyn/dudv1_p.f @ 224

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago
File size: 3.2 KB
Line 
1      SUBROUTINE dudv1_p ( vorpot, pbaru, pbarv, du, dv )
2      USE parallel_lmdz
3      IMPLICIT NONE
4c
5c-----------------------------------------------------------------------
6c
7c   Auteur:   P. Le Van
8c   -------
9c
10c   Objet:
11c   ------
12c   calcul du terme de  rotation
13c   ce terme est ajoute a  d(ucov)/dt et a d(vcov)/dt  ..
14c   vorpot, pbaru et pbarv sont des arguments d'entree  pour le s-pg ..
15c   du  et dv              sont des arguments de sortie pour le s-pg ..
16c
17c-----------------------------------------------------------------------
18
19!-----------------------------------------------------------------------
20!   INCLUDE 'dimensions.h'
21!
22!   dimensions.h contient les dimensions du modele
23!   ndm est tel que iim=2**ndm
24!-----------------------------------------------------------------------
25
26      INTEGER iim,jjm,llm,ndm
27
28      PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
29
30!-----------------------------------------------------------------------
31!
32! $Header$
33!
34!
35!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
36!                 veillez  n'utiliser que des ! pour les commentaires
37!                 et  bien positionner les & des lignes de continuation
38!                 (les placer en colonne 6 et en colonne 73)
39!
40!
41!-----------------------------------------------------------------------
42!   INCLUDE 'paramet.h'
43
44      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
45      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
46      INTEGER  ijmllm,mvar
47      INTEGER jcfil,jcfllm
48
49      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
50     &    ,jjp1=jjm+1-1/jjm)
51      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
52      PARAMETER( kftd  = iim/2 -ndm )
53      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
54      PARAMETER( ip1jmi1= ip1jm - iip1 )
55      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
56      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
57      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
58
59!-----------------------------------------------------------------------
60
61      REAL vorpot( ip1jm,llm ) ,pbaru( ip1jmp1,llm ) ,
62     *     pbarv( ip1jm,llm ) ,du( ip1jmp1,llm ) ,dv( ip1jm,llm )
63      INTEGER  l,ij,ijb,ije
64c
65c
66     
67c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
68      DO 10 l = 1,llm
69c
70      ijb=ij_begin
71      ije=ij_end
72     
73      if (pole_nord) ijb=ij_begin+iip1
74      if (pole_sud)  ije=ij_end-iip1
75     
76      DO 2  ij = ijb, ije-1 
77      du( ij,l ) = 0.125 *(  vorpot(ij-iip1, l) + vorpot( ij, l)  ) *
78     *                    (   pbarv(ij-iip1, l) + pbarv(ij-iim,  l) +
79     *                        pbarv(   ij  , l) + pbarv(ij+ 1 ,  l)   )
80   2  CONTINUE
81   
82 
83c
84      if (pole_nord) ijb=ij_begin
85     
86      DO 3 ij = ijb, ije-1 
87      dv( ij+1,l ) = - 0.125 *(  vorpot(ij, l)  + vorpot(ij+1, l)  ) *
88     *                        (   pbaru(ij, l)  +  pbaru(ij+1   , l) +
89     *                       pbaru(ij+iip1, l)  +  pbaru(ij+iip2, l)  )
90   3  CONTINUE
91c
92c    .... correction  pour  dv( 1,j,l )  .....
93c    ....   dv(1,j,l)= dv(iip1,j,l) ....
94c
95CDIR$ IVDEP
96      DO 4 ij = ijb, ije, iip1
97      dv( ij,l ) = dv( ij + iim, l )
98   4  CONTINUE
99c
100  10  CONTINUE
101c$OMP END DO NOWAIT
102      RETURN
103      END
Note: See TracBrowser for help on using the repository browser.