/[lmdze]/trunk/libf/dyn3d/fxy.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/fxy.f90

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

trunk/libf/dyn3d/fxy.f revision 6 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/libf/dyn3d/fxy.f90 revision 7 by guez, Mon Mar 31 12:24:17 2008 UTC
# Line 1  Line 1 
1  !  SUBROUTINE fxy(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/fxy.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $       yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, &
3  !       xprimp025)
       SUBROUTINE fxy (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,  
      ,                    rlatu2,yprimu2,  
      , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)  
   
       use dimens_m  
       use paramet_m  
       use comconst  
       use serre  
       IMPLICIT NONE  
   
 c     Auteur  :  P. Le Van  
 c  
 c     Calcul  des longitudes et des latitudes  pour une fonction f(x,y)  
 c           a tangente sinusoidale et eventuellement avec zoom  .  
 c  
 c  
   
        INTEGER i,j  
   
        REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),  
      , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)  
        REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),  
      , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)  
   
        include "fxy_new.h"  
   
   
 c    ......  calcul  des  latitudes  et de y'   .....  
 c  
        DO j = 1, jjm + 1  
           rlatu(j) = fy    ( FLOAT( j )        )  
          yprimu(j) = fyprim( FLOAT( j )        )  
        ENDDO  
   
   
        DO j = 1, jjm  
   
          rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )  
          rlatu1(j) = fy    ( FLOAT( j ) + 0.25 )  
          rlatu2(j) = fy    ( FLOAT( j ) + 0.75 )  
   
         yprimv(j)  = fyprim( FLOAT( j ) + 0.5  )  
         yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )  
         yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )  
   
        ENDDO  
   
 c  
 c     .....  calcul   des  longitudes et de  x'   .....  
 c  
        DO i = 1, iim + 1  
            rlonv(i)     = fx    (   FLOAT( i )          )  
            rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )  
         rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )  
         rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )  
   
          xprimv  (i)    = fxprim (  FLOAT( i )          )  
          xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )  
         xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )  
         xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )  
        ENDDO  
   
 c  
        RETURN  
        END  
4    
5      ! From dyn3d/fxy.F, v 1.1.1.1 2004/05/19 12:53:06
6      ! Auteur : P. Le Van
7      ! Calcul des longitudes et des latitudes pour une fonction f(x, y)
8      ! à tangente sinusoïdale et éventuellement avec zoom.
9    
10      USE dimens_m, ONLY : iim, jjm
11    
12      IMPLICIT NONE
13    
14      REAL, INTENT (OUT) :: rlatu(jjm + 1), yprimu(jjm + 1), rlatv(jjm)
15      REAL, INTENT (OUT) :: yprimv(jjm)
16      REAL, INTENT (OUT) :: rlatu1(jjm)
17      REAL, INTENT (OUT) :: yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
18      REAL, INTENT (OUT) :: rlonu(iim + 1), xprimu(iim + 1), rlonv(iim + 1)
19      REAL, INTENT (OUT) :: xprimv(iim + 1)
20      REAL, INTENT (OUT) :: rlonm025(iim + 1), xprimm025(iim + 1)
21      REAL, INTENT (OUT) :: rlonp025(iim + 1)
22      REAL, INTENT (OUT) :: xprimp025(iim + 1)
23    
24      ! Variables local to the procedure:
25    
26      INTEGER i, j
27    
28      !------------------------------------------------------------
29    
30      ! Calcul des latitudes et de y'
31    
32      DO j = 1, jjm + 1
33         rlatu(j) = fy(real(j))
34         yprimu(j) = fyprim(real(j))
35      END DO
36    
37      DO j = 1, jjm
38         rlatv(j) = fy(real(j) + 0.5)
39         rlatu1(j) = fy(real(j) + 0.25)
40         rlatu2(j) = fy(real(j) + 0.75)
41    
42         yprimv(j) = fyprim(real(j) + 0.5)
43         yprimu1(j) = fyprim(real(j) + 0.25)
44         yprimu2(j) = fyprim(real(j) + 0.75)
45      END DO
46    
47      ! Calcul des longitudes et de x'
48    
49      DO i = 1, iim + 1
50         rlonv(i) = fx(real(i))
51         rlonu(i) = fx(real(i) + 0.5)
52         rlonm025(i) = fx(real(i) - 0.25)
53         rlonp025(i) = fx(real(i) + 0.25)
54    
55         xprimv(i) = fxprim(real(i))
56         xprimu(i) = fxprim(real(i) + 0.5)
57         xprimm025(i) = fxprim(real(i) - 0.25)
58         xprimp025(i) = fxprim(real(i) + 0.25)
59      END DO
60    
61    CONTAINS
62    
63      ! From grid/fxy_new.h, v 1.1.1.1 2004/05/19 12:53:05
64    
65      REAL FUNCTION ripx(ri)
66        ! stretching in x
67        USE comconst, ONLY : pi
68        REAL, INTENT (IN) :: ri
69    
70        ripx = (ri - 1.) * 2 * pi / REAL(iim)
71      end function ripx
72    
73      !******************************************************
74    
75      REAL FUNCTION fx(ri)
76        ! stretching in x
77        USE comconst, ONLY : pi
78        USE serre, ONLY : alphax, pxo, transx
79        REAL, INTENT (IN) :: ri
80    
81        fx = ripx(ri) + transx + alphax * SIN(ripx(ri) + transx - pxo) - pi
82      end function fx
83    
84      !******************************************************
85    
86      REAL FUNCTION fxprim(ri)
87        ! stretching in x
88        USE comconst, ONLY : pi
89        USE serre, ONLY : alphax, pxo, transx
90        REAL, INTENT (IN) :: ri
91    
92        fxprim = 2 * pi / REAL(iim) * (1. + alphax * COS(ripx(ri) + transx - pxo))
93      end function fxprim
94    
95      !******************************************************
96    
97      REAL FUNCTION bigy(rj)
98        ! stretching in y
99        USE comconst, ONLY : pi
100        REAL, INTENT (IN) :: rj
101    
102        bigy = 2 * (REAL(jjm + 1) - rj) * pi / jjm
103      end function bigy
104    
105      !******************************************************
106    
107      REAL FUNCTION fy(rj)
108        ! stretching in y
109        USE comconst, ONLY : pi
110        USE serre, ONLY : alphay, pyo, transy
111        REAL, INTENT (IN) :: rj
112    
113        fy = (bigy(rj) + transy + alphay * SIN(bigy(rj) + transy - pyo)) / 2 &
114             - pi / 2
115      end function fy
116    
117      !******************************************************
118    
119      REAL FUNCTION fyprim(rj)
120        ! stretching in y
121        USE comconst, ONLY : pi
122        USE serre, ONLY : alphay, pyo, transy
123        REAL, INTENT (IN) :: rj
124    
125        fyprim = (pi / jjm) * (1. + alphay * COS(bigy(rj) + transy - pyo))
126      end function fyprim
127    
128    END SUBROUTINE fxy
Legend:
Removed from v.6  
changed lines
  Added in v.7
  ViewVC Help
Powered by ViewVC 1.1.21