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

Diff of /trunk/dyn3d/fxyhyper.f

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

revision 118 by guez, Thu Dec 18 17:30:24 2014 UTC revision 119 by guez, Wed Jan 7 14:34:57 2015 UTC
# Line 4  module fxyhyper_m Line 4  module fxyhyper_m
4    
5  contains  contains
6    
7    SUBROUTINE fxyhyper(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &    SUBROUTINE fxyhyper(rlatu, yprimu, rlatv, rlatu1, yprimu1, rlatu2, yprimu2, &
8         yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, &         rlonu, xprimu, rlonv, xprimv, xprimm025, xprimp025)
        xprimp025)  
9    
10      ! From dyn3d/fxyhyper.F, version 1.1.1.1, 2004/05/19 12:53:06      ! From dyn3d/fxyhyper.F, version 1.1.1.1, 2004/05/19 12:53:06
11    
     USE dimens_m, ONLY: jjm  
12      use fxhyp_m, only: fxhyp      use fxhyp_m, only: fxhyp
13      use fyhyp_m, only: fyhyp      use fyhyp_m, only: fyhyp
     USE paramet_m, ONLY: iip1  
     use serre, only: clat, grossismy, dzoomy, tauy, clon, grossismx, dzoomx, &  
          taux  
14    
15      ! Auteur : P. Le Van d'après les formulations de R. Sadourny      REAL, intent(out):: rlatu(:), yprimu(:) ! (jjm + 1)
16        real, intent(out):: rlatv(:) ! (jjm)
17      ! f(x, y) à dérivée tangente hyperbolique      real, intent(out):: rlatu1(:), yprimu1(:), rlatu2(:), yprimu2(:) ! (jjm)
18        REAL, intent(out):: rlonu(:), xprimu(:), rlonv(:), xprimv(:) ! (iim + 1)
19      ! Cette procédure calcule les latitudes (routine fyhyp) et      REAL, intent(out):: xprimm025(:) ! (iim + 1)
20      ! longitudes (fxhyp) par des fonctions tangente hyperbolique.      REAL, intent(out):: xprimp025(:) ! (iim + 1)
   
     ! Il y a trois paramètres, en plus des coordonnées du centre du  
     ! zoom (clon et clat) :  
   
     ! a) le grossissement du zoom : grossismy (en y) et grossismx (en x)  
     ! b) l'extension du zoom : dzoomy (en y) et dzoomx (en x)  
     ! c) la raideur de la transition du zoom : taux et tauy  
   
     ! Nota bene : il vaut mieux avoir : grossismx * dzoomx < pi (radians)  
     ! et grossismy * dzoomy < pi/2 (radians)  
   
     REAL rlatu(:), yprimu(:) ! (jjm + 1)  
     real rlatv(:), yprimv(:) ! (jjm)  
     real rlatu1(:), yprimu1(:), rlatu2(:), yprimu2(:) ! (jjm)  
     REAL rlonu(:), xprimu(:), rlonv(:), xprimv(:) ! (iim + 1)  
     REAL rlonm025(:), xprimm025(:), rlonp025(:), xprimp025(:) ! (iim + 1)  
   
     ! Local:  
   
     double precision dxmin, dxmax, dymin, dymax  
     INTEGER i, j  
21    
22      !----------------------------------------------------------      !----------------------------------------------------------
23    
24      CALL fyhyp(clat, grossismy, dzoomy, tauy, rlatu, yprimu, rlatv, yprimv, &      CALL fyhyp(rlatu, yprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
25           rlatu2, yprimu2, rlatu1, yprimu1, dymin, dymax)      CALL fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)
     CALL fxhyp(clon, grossismx, dzoomx, taux, rlonm025, xprimm025, rlonv, &  
          xprimv, rlonu, xprimu, rlonp025, xprimp025, dxmin, dxmax)  
   
     DO i = 1, iip1  
        IF (rlonp025(i).LT.rlonv(i)) THEN  
           print *, ' Attention ! rlonp025 < rlonv', i  
           STOP 1  
        ENDIF  
   
        IF (rlonv(i).LT.rlonm025(i)) THEN  
           print *, ' Attention ! rlonm025 > rlonv', i  
           STOP 1  
        ENDIF  
   
        IF (rlonp025(i).GT.rlonu(i)) THEN  
           print *, ' Attention ! rlonp025 > rlonu', i  
           STOP 1  
        ENDIF  
     ENDDO  
   
     print *, 'Test de coherence ok pour fx'  
   
     DO j = 1, jjm  
        IF (rlatu1(j).LE.rlatu2(j)) THEN  
           print *, 'Attention ! rlatu1 < rlatu2 ', rlatu1(j), rlatu2(j), j  
           STOP 13  
        ENDIF  
   
        IF (rlatu2(j).LE.rlatu(j+1)) THEN  
           print *, 'Attention ! rlatu2 < rlatup1 ', rlatu2(j), rlatu(j+1), j  
           STOP 14  
        ENDIF  
   
        IF (rlatu(j).LE.rlatu1(j)) THEN  
           print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j  
           STOP 15  
        ENDIF  
   
        IF (rlatv(j).LE.rlatu2(j)) THEN  
           print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j  
           STOP 16  
        ENDIF  
   
        IF (rlatv(j).ge.rlatu1(j)) THEN  
           print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j  
           STOP 17  
        ENDIF  
   
        IF (rlatv(j).ge.rlatu(j)) THEN  
           print *, ' Attention ! rlatv > rlatu ', rlatv(j), rlatu(j), j  
           STOP 18  
        ENDIF  
     ENDDO  
   
     print *, 'Test de coherence ok pour fy'  
   
     print *, 'Latitudes'  
     print 3, dymin, dymax  
     print *, 'Si cette derniere est trop lache, modifiez les parametres'  
     print *, 'grossism, tau, dzoom pour Y et repasser ! '  
   
     print *, ' Longitudes '  
     print 3, dxmin, dxmax  
     print *, 'Si cette derniere est trop lache, modifiez les parametres'  
     print *, 'grossism, tau, dzoom pour Y et repasser ! '  
   
 3   Format(1x, ' Au centre du zoom, la longueur de la maille est', &  
          ' d environ ', f0.2, ' degres ', /, &  
          ' alors que la maille en dehors de la zone du zoom est ', &  
          "d'environ", f0.2, ' degres ')  
26    
27    END SUBROUTINE fxyhyper    END SUBROUTINE fxyhyper
28    
Legend:
Removed from v.118  
changed lines
  Added in v.119
  ViewVC Help
Powered by ViewVC 1.1.21