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

Diff of /trunk/dyn3d/fxy.f

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

trunk/libf/dyn3d/fxy.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/dyn3d/fxy.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC
# Line 1  Line 1 
1  !  module fxy_m
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/fxy.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $  
 !  
       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  
2    
3      IMPLICIT NONE
4    
5      private
6      public fxy
7    
8    contains
9    
10      SUBROUTINE fxy(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
11           yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, &
12           xprimp025)
13    
14        ! From dyn3d/fxy.F, v 1.1.1.1 2004/05/19 12:53:06
15        ! Auteur : P. Le Van
16        ! Calcul des longitudes et des latitudes pour une fonction f(x, y)
17        ! à tangente sinusoïdale et éventuellement avec zoom.
18    
19        USE dimens_m, ONLY : iim, jjm
20    
21        REAL, INTENT (OUT) :: rlatu(jjm + 1), yprimu(jjm + 1), rlatv(jjm)
22        REAL, INTENT (OUT) :: yprimv(jjm)
23        REAL, INTENT (OUT) :: rlatu1(jjm)
24        REAL, INTENT (OUT) :: yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
25        REAL, INTENT (OUT) :: rlonu(iim + 1), xprimu(iim + 1), rlonv(iim + 1)
26        REAL, INTENT (OUT) :: xprimv(iim + 1)
27        REAL, INTENT (OUT) :: rlonm025(iim + 1), xprimm025(iim + 1)
28        REAL, INTENT (OUT) :: rlonp025(iim + 1)
29        REAL, INTENT (OUT) :: xprimp025(iim + 1)
30    
31        ! Variables local to the procedure:
32    
33        INTEGER i, j
34    
35        !------------------------------------------------------------
36    
37        ! Calcul des latitudes et de y'
38    
39        DO j = 1, jjm + 1
40           rlatu(j) = fy(real(j))
41           yprimu(j) = fyprim(real(j))
42        END DO
43    
44        DO j = 1, jjm
45           rlatv(j) = fy(real(j) + 0.5)
46           rlatu1(j) = fy(real(j) + 0.25)
47           rlatu2(j) = fy(real(j) + 0.75)
48    
49           yprimv(j) = fyprim(real(j) + 0.5)
50           yprimu1(j) = fyprim(real(j) + 0.25)
51           yprimu2(j) = fyprim(real(j) + 0.75)
52        END DO
53    
54        ! Calcul des longitudes et de x'
55    
56        DO i = 1, iim + 1
57           rlonv(i) = fx(real(i))
58           rlonu(i) = fx(real(i) + 0.5)
59           rlonm025(i) = fx(real(i) - 0.25)
60           rlonp025(i) = fx(real(i) + 0.25)
61    
62           xprimv(i) = fxprim(real(i))
63           xprimu(i) = fxprim(real(i) + 0.5)
64           xprimm025(i) = fxprim(real(i) - 0.25)
65           xprimp025(i) = fxprim(real(i) + 0.25)
66        END DO
67    
68      END SUBROUTINE fxy
69    
70      !******************************************************
71    
72      ! From grid/fxy_new.h, v 1.1.1.1 2004/05/19 12:53:05
73    
74      REAL FUNCTION ripx(ri)
75    
76        ! stretching in x
77    
78        USE nr_util, ONLY : pi
79        USE dimens_m, ONLY : iim
80    
81        REAL, INTENT (IN) :: ri
82    
83        ripx = (ri - 1.) * 2 * pi / REAL(iim)
84    
85      end function ripx
86    
87      !******************************************************
88    
89      REAL FUNCTION fx(ri)
90    
91        ! stretching in x
92        USE nr_util, ONLY : pi
93        USE serre, ONLY : alphax, pxo, transx
94        REAL, INTENT (IN) :: ri
95    
96        fx = ripx(ri) + transx + alphax * SIN(ripx(ri) + transx - pxo) - pi
97    
98      end function fx
99    
100      !******************************************************
101    
102      REAL FUNCTION fxprim(ri)
103    
104        ! stretching in x
105    
106        USE nr_util, ONLY : pi
107        USE serre, ONLY : alphax, pxo, transx
108        USE dimens_m, ONLY : iim
109    
110        REAL, INTENT (IN) :: ri
111    
112        fxprim = 2 * pi / REAL(iim) * (1. + alphax * COS(ripx(ri) + transx - pxo))
113    
114      end function fxprim
115    
116      !******************************************************
117    
118      REAL FUNCTION bigy(rj)
119    
120        ! stretching in y
121        USE nr_util, ONLY : pi
122        USE dimens_m, ONLY : jjm
123        REAL, INTENT (IN) :: rj
124    
125        bigy = 2 * (REAL(jjm + 1) - rj) * pi / jjm
126    
127      end function bigy
128    
129      !******************************************************
130    
131      REAL FUNCTION fy(rj)
132    
133        ! stretching in y
134        USE nr_util, ONLY : pi
135        USE serre, ONLY : alphay, pyo, transy
136        REAL, INTENT (IN) :: rj
137    
138        fy = (bigy(rj) + transy + alphay * SIN(bigy(rj) + transy - pyo)) / 2 &
139             - pi / 2
140    
141      end function fy
142    
143      !******************************************************
144    
145      REAL FUNCTION fyprim(rj)
146    
147        ! stretching in y
148    
149        USE nr_util, ONLY : pi
150        USE serre, ONLY : alphay, pyo, transy
151        USE dimens_m, ONLY : jjm
152    
153        REAL, INTENT (IN) :: rj
154    
155        fyprim = (pi / jjm) * (1. + alphay * COS(bigy(rj) + transy - pyo))
156    
157      end function fyprim
158    
159    end module fxy_m

Legend:
Removed from v.3  
changed lines
  Added in v.82

  ViewVC Help
Powered by ViewVC 1.1.21