source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/dyn3d_common/test_period.f @ 224

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago
File size: 4.9 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE test_period ( ucov, vcov, teta, q, p, phis )
5c
6c     Auteur : P. Le Van 
7c    ---------
8c  ....  Cette routine teste la periodicite en longitude des champs   ucov,
9c                           teta, q , p et phis                 .......... 
10c
11      USE infotrac
12c     IMPLICIT NONE
13c
14!-----------------------------------------------------------------------
15!   INCLUDE 'dimensions.h'
16!
17!   dimensions.h contient les dimensions du modele
18!   ndm est tel que iim=2**ndm
19!-----------------------------------------------------------------------
20
21      INTEGER iim,jjm,llm,ndm
22
23      PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
24
25!-----------------------------------------------------------------------
26!
27! $Header$
28!
29!
30!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
31!                 veillez  n'utiliser que des ! pour les commentaires
32!                 et  bien positionner les & des lignes de continuation
33!                 (les placer en colonne 6 et en colonne 73)
34!
35!
36!-----------------------------------------------------------------------
37!   INCLUDE 'paramet.h'
38
39      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
40      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
41      INTEGER  ijmllm,mvar
42      INTEGER jcfil,jcfllm
43
44      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
45     &    ,jjp1=jjm+1-1/jjm)
46      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
47      PARAMETER( kftd  = iim/2 -ndm )
48      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
49      PARAMETER( ip1jmi1= ip1jm - iip1 )
50      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
51      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
52      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
53
54!-----------------------------------------------------------------------
55c
56c    ......  Arguments   ......
57c
58      REAL ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) ,
59     ,      q(ip1jmp1,llm,nqtot), p(ip1jmp1,llmp1), phis(ip1jmp1)
60c
61c   .....  Variables  locales  .....
62c
63      INTEGER ij,l,nq
64c
65      DO l = 1, llm
66         DO ij = 1, ip1jmp1, iip1
67          IF( ucov(ij,l).NE.ucov(ij+iim,l) )  THEN
68          PRINT *,'STOP dans test_period car ---  UCOV  ---  n est pas', 
69     ,  ' periodique en longitude ! '
70          PRINT *,' l,  ij = ', l, ij, ij+iim
71          STOP
72          ENDIF
73          IF( teta(ij,l).NE.teta(ij+iim,l) )  THEN
74          PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', 
75     ,   ' periodique en longitude ! '
76          PRINT *,' l,  ij = ', l, ij, ij+iim
77     ,      , teta(ij,l),   teta(ij+iim,l)
78          STOP
79          ENDIF
80         ENDDO
81
82         do ij=1,iim
83          if (teta(ij,l).ne.teta(1,l)
84     s     .or.teta(ip1jm+ij,l).ne.teta(ip1jm+1,l) ) then
85          PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', 
86     ,  ' constant aux poles ! '
87          print*,'teta(',1 ,',',l,')=',teta(1 ,l)
88          print*,'teta(',ij,',',l,')=',teta(ij,l)
89          print*,'teta(',ip1jm+1 ,',',l,')=',teta(ip1jm+1 ,l)
90          print*,'teta(',ip1jm+ij,',',l,')=',teta(ip1jm+ij,l)
91          stop
92          endif
93         enddo
94      ENDDO
95
96c
97      DO l = 1, llm
98         DO ij = 1, ip1jm, iip1
99          IF( vcov(ij,l).NE.vcov(ij+iim,l) )  THEN
100          PRINT *,'STOP dans test_period car ---  VCOV  ---  n est pas', 
101     ,   ' periodique en longitude !'
102          PRINT *,' l,  ij = ', l, ij, ij+iim,vcov(ij+iim,l),vcov(ij,l)
103          vcov(ij+iim,l)=vcov(ij,l)
104c         STOP
105          ENDIF
106         ENDDO
107      ENDDO
108     
109c
110      DO nq =1, nqtot
111        DO l =1, llm
112          DO ij = 1, ip1jmp1, iip1
113          IF( q(ij,l,nq).NE.q(ij+iim,l,nq) )  THEN
114          PRINT *,'STOP dans test_period car ---  Q  ---  n est pas ', 
115     ,   'periodique en longitude !'
116          PRINT *,' nq , l,  ij = ', nq, l, ij, ij+iim
117          STOP
118          ENDIF
119          ENDDO
120        ENDDO
121      ENDDO
122c
123       DO l = 1, llm
124         DO ij = 1, ip1jmp1, iip1
125          IF( p(ij,l).NE.p(ij+iim,l) )  THEN
126          PRINT *,'STOP dans test_period car ---  P  ---  n est pas', 
127     ,    ' periodique en longitude !'
128          PRINT *,' l ij = ',l, ij, ij+iim
129          STOP
130          ENDIF
131          IF( phis(ij).NE.phis(ij+iim) )  THEN
132          PRINT *,'STOP dans test_period car ---  PHIS  ---  n est pas', 
133     ,   ' periodique en longitude !  l, IJ = ', l, ij,ij+iim
134          PRINT *,' ij = ', ij, ij+iim
135          STOP
136          ENDIF
137         ENDDO
138         do ij=1,iim
139          if (p(ij,l).ne.p(1,l)
140     s     .or.p(ip1jm+ij,l).ne.p(ip1jm+1,l) ) then
141          PRINT *,'STOP dans test_period car ---  P     ---  n est pas', 
142     ,  ' constant aux poles ! '
143          print*,'p(',1 ,',',l,')=',p(1 ,l)
144          print*,'p(',ij,',',l,')=',p(ij,l)
145          print*,'p(',ip1jm+1 ,',',l,')=',p(ip1jm+1 ,l)
146          print*,'p(',ip1jm+ij,',',l,')=',p(ip1jm+ij,l)
147          stop
148          endif
149         enddo
150       ENDDO
151c
152c
153         RETURN
154         END
Note: See TracBrowser for help on using the repository browser.