source: LMDZ.3.3/trunk/libf/dyn3d/fxyhyper.F @ 5221

Last change on this file since 5221 was 544, checked in by lmdzadmin, 20 years ago

Incorporation des modifications necessaires a l'utilisation de la librairie
Psmile/PRISM, et creation d'un tag IPSL-CM4_PSMILE, selon M.-E. Demory
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 4.4 KB
RevLine 
[203]1c
[207]2c $Header$
[203]3c
4       SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy  ,   
5     ,                       xzoom, grossx, dzoomx,taux  ,
[2]6     , rlatu,yprimu,rlatv,yprimv,rlatu1,  yprimu1,  rlatu2,  yprimu2  ,
7     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
8
9       IMPLICIT NONE
10c
11c      Auteur :  P. Le Van .
12c
13c      d'apres  formulations de R. Sadourny .
14c
15c
16c     Ce spg calcule les latitudes( routine fyhyp ) et longitudes( fxhyp )
17c            par des  fonctions  a tangente hyperbolique .
18c
19c     Il y a 3 parametres ,en plus des coordonnees du centre du zoom (xzoom
20c                      et  yzoom )   : 
21c
22c     a) le grossissement du zoom  :  grossy  ( en y ) et grossx ( en x )
23c     b) l' extension     du zoom  :  dzoomy  ( en y ) et dzoomx ( en x )
[203]24c     c) la raideur de la transition du zoom  :   taux et tauy   
[2]25c
[203]26c  N.B : Il vaut mieux avoir   :   grossx * dzoomx <  pi    ( radians )
27c ******
28c                  et              grossy * dzoomy <  pi/2  ( radians )
[2]29c
30#include "dimensions.h"
31#include "paramet.h"
32
33
34c   .....  Arguments  ...
35c
36       REAL xzoom,yzoom,grossx,grossy,dzoomx,dzoomy,taux,tauy
37       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
38     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
39       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
40     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
[212]41       REAL*8  dxmin, dxmax , dymin, dymax
[2]42
43c   ....   var. locales   .....
44c
45       INTEGER i,j
46c
47
[203]48       CALL fyhyp ( yzoom, grossy, dzoomy,tauy  ,
[212]49     ,  rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
50     ,  dymin,dymax                                               )
[2]51
52       CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv,
[212]53     , xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax         )
[2]54
55
[203]56        DO i = 1, iip1
[2]57          IF(rlonp025(i).LT.rlonv(i))  THEN
[203]58           WRITE(6,*) ' Attention !  rlonp025 < rlonv',i
[2]59            STOP
60          ENDIF
61
62          IF(rlonv(i).LT.rlonm025(i))  THEN
[203]63           WRITE(6,*) ' Attention !  rlonm025 > rlonv',i
[2]64            STOP
65          ENDIF
66
67          IF(rlonp025(i).GT.rlonu(i))  THEN
[203]68           WRITE(6,*) ' Attention !  rlonp025 > rlonu',i
[2]69            STOP
70          ENDIF
71        ENDDO
72
[203]73        WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FX **** '
[2]74
75c
76       DO j = 1, jjm
77c
78       IF(rlatu1(j).LE.rlatu2(j))   THEN
[203]79         WRITE(6,*)'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j
[2]80         STOP 13
81       ENDIF
82c
83       IF(rlatu2(j).LE.rlatu(j+1))  THEN
[203]84        WRITE(6,*)'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j
[2]85        STOP 14
86       ENDIF
87c
88       IF(rlatu(j).LE.rlatu1(j))    THEN
[203]89        WRITE(6,*)' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j
[2]90        STOP 15
91       ENDIF
92c
93       IF(rlatv(j).LE.rlatu2(j))    THEN
[203]94        WRITE(6,*)' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j
[2]95        STOP 16
96       ENDIF
97c
98       IF(rlatv(j).ge.rlatu1(j))    THEN
[203]99        WRITE(6,*)' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j
[2]100        STOP 17
101       ENDIF
102c
103       IF(rlatv(j).ge.rlatu(j))     THEN
[203]104        WRITE(6,*) ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j
[2]105        STOP 18
106       ENDIF
107c
108       ENDDO
109c
[203]110       WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FY **** '
[2]111c
[212]112        WRITE(6,18)
113        WRITE(6,*) '  Latitudes  '
114        WRITE(6,*) ' *********** '
115        WRITE(6,18)
[544]116cvg>>
117        WRITE(6,3) dymin
118        WRITE(6,4) dymax
119cvg<<
120cvg        WRITE(6,3)  dymin, dymax
[212]121        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
122     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
123c
124        WRITE(6,18)
125        WRITE(6,*) '  Longitudes  '
126        WRITE(6,*) ' ************ '
127        WRITE(6,18)
[544]128cvg>>
129        WRITE(6,3) dxmin
130        WRITE(6,4) dxmax
131cvg<<
132cvg        WRITE(6,3)  dxmin, dxmax
[212]133        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
134     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
135        WRITE(6,18)
136c
[544]137cvg3      Format(1x, ' Au centre du zoom , la longueur de la maille est',
138cvg     ,  ' d environ ',f8.2 ,' degres  ',
139cvg     , ' alors que la maille en dehors de la zone du zoom est d environ
140cvg     , ', f8.2,' degres ' )
141cvg>>
[212]1423      Format(1x, ' Au centre du zoom , la longueur de la maille est',
[544]143     ,  ' d environ ',f8.2 ,' degres  ')
1444      Format(1x, ' alors que la maille en dehors de la zone du zoom',
145     ,  ' est d environ ', f8.2,' degres ' )
146cvg<<
[212]14718      FORMAT(/)
[2]148
149       RETURN
150       END
151
Note: See TracBrowser for help on using the repository browser.