Ignore:
Timestamp:
Jul 24, 2024, 10:58:59 AM (4 months ago)
Author:
abarral
Message:

Turn grid/*.h into lmdz_fxy.f90

Location:
LMDZ6/branches/Amaury_dev/libf
Files:
3 deleted
2 edited
1 moved

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxy.f90

    r5106 r5108  
    1 
    21! $Id$
    32
    4 SUBROUTINE fxy(rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1, &
    5         rlatu2,yprimu2, &
    6         rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
     3SUBROUTINE fxy(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, &
     4        rlatu2, yprimu2, &
     5        rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, xprimp025)
    76
    87  USE comconst_mod, ONLY: pi
    9   USE serre_mod, ONLY: pxo,pyo,alphax,alphay,transx,transy
     8  USE serre_mod, ONLY: pxo, pyo, alphax, alphay, transx, transy
     9  USE lmdz_fxy, ONLY: fxy_new
    1010
    1111  IMPLICIT NONE
     
    2020  include "paramet.h"
    2121
    22    INTEGER :: i,j
     22  INTEGER :: i, j
    2323
    24    REAL :: rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm), &
    25          rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
    26    REAL :: rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1), &
    27          rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
     24  REAL :: rlatu(jjp1), yprimu(jjp1), rlatv(jjm), yprimv(jjm), &
     25          rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
     26  REAL :: rlonu(iip1), xprimu(iip1), rlonv(iip1), xprimv(iip1), &
     27          rlonm025(iip1), xprimm025(iip1), rlonp025(iip1), xprimp025(iip1)
     28  REAL :: ripx, fx, fxprim, fy, fyprim, ri, rj, bigy
    2829
    29   INCLUDE "fxy_new.h"
    30 
     30  CALL fxy_new(ripx, fx, fxprim, fy, fyprim, ri, rj, bigy)
    3131
    3232  !    ......  calcul  des  latitudes  et de y'   .....
    3333  !
    34    DO j = 1, jjm + 1
    35       rlatu(j) = fy    ( REAL( j )        )
    36      yprimu(j) = fyprim( REAL( j )        )
    37    ENDDO
     34  DO j = 1, jjm + 1
     35    rlatu(j) = fy    (REAL(j))
     36    yprimu(j) = fyprim(REAL(j))
     37  ENDDO
    3838
     39  DO j = 1, jjm
    3940
    40    DO j = 1, jjm
     41    rlatv(j) = fy    (REAL(j) + 0.5)
     42    rlatu1(j) = fy    (REAL(j) + 0.25)
     43    rlatu2(j) = fy    (REAL(j) + 0.75)
    4144
    42      rlatv(j)  = fy    ( REAL( j ) + 0.5  )
    43      rlatu1(j) = fy    ( REAL( j ) + 0.25 )
    44      rlatu2(j) = fy    ( REAL( j ) + 0.75 )
     45    yprimv(j) = fyprim(REAL(j) + 0.5)
     46    yprimu1(j) = fyprim(REAL(j) + 0.25)
     47    yprimu2(j) = fyprim(REAL(j) + 0.75)
    4548
    46     yprimv(j)  = fyprim( REAL( j ) + 0.5  )
    47     yprimu1(j) = fyprim( REAL( j ) + 0.25 )
    48     yprimu2(j) = fyprim( REAL( j ) + 0.75 )
    49 
    50    ENDDO
     49  ENDDO
    5150
    5251  !
    5352  ! .....  calcul   des  longitudes et de  x'   .....
    5453  !
    55    DO i = 1, iim + 1
    56        rlonv(i)     = fx    (   REAL( i )          )
    57        rlonu(i)     = fx    (   REAL( i ) + 0.5    )
    58     rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
    59     rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
     54  DO i = 1, iim + 1
     55    rlonv(i) = fx    (REAL(i))
     56    rlonu(i) = fx    (REAL(i) + 0.5)
     57    rlonm025(i) = fx    (REAL(i) - 0.25)
     58    rlonp025(i) = fx    (REAL(i) + 0.25)
    6059
    61      xprimv  (i)    = fxprim (  REAL( i )          )
    62      xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
    63     xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
    64     xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
    65    ENDDO
     60    xprimv  (i) = fxprim (REAL(i))
     61    xprimu  (i) = fxprim (REAL(i) + 0.5)
     62    xprimm025(i) = fxprim (REAL(i) - 0.25)
     63    xprimp025(i) = fxprim (REAL(i) + 0.25)
     64  ENDDO
    6665
    6766  !
  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxysinus.f90

    r5106 r5108  
    1 
    21! $Id$
    32
    4 SUBROUTINE fxysinus(rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1, &
    5         rlatu2,yprimu2, &
    6         rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
    7 
     3SUBROUTINE fxysinus(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, &
     4        rlatu2, yprimu2, &
     5        rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, xprimp025)
    86
    97  USE comconst_mod, ONLY: pi
     8  USE lmdz_fxy, ONLY: fxy_sin
    109  IMPLICIT NONE
    1110  !
     
    1918  INCLUDE "paramet.h"
    2019
    21    INTEGER :: i,j
     20  INTEGER :: i, j
    2221
    23    REAL :: rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm), &
    24          rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
    25    REAL :: rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1), &
    26          rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
     22  REAL :: rlatu(jjp1), yprimu(jjp1), rlatv(jjm), yprimv(jjm), &
     23          rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
     24  REAL :: rlonu(iip1), xprimu(iip1), rlonv(iip1), xprimv(iip1), &
     25          rlonm025(iip1), xprimm025(iip1), rlonp025(iip1), xprimp025(iip1)
     26  REAL :: fy, fx, fxprim, fyprim, ri, rj
    2727
    28   INCLUDE "fxy_sin.h"
     28  CALL fxy_sin(fy, fx, fxprim, fyprim, ri, rj)
    2929
    3030
    3131  !    ......  calcul  des  latitudes  et de y'   .....
    3232  !
    33    DO j = 1, jjm + 1
    34       rlatu(j) = fy    ( REAL( j )        )
    35      yprimu(j) = fyprim( REAL( j )        )
    36    ENDDO
     33  DO j = 1, jjm + 1
     34    rlatu(j) = fy    (REAL(j))
     35    yprimu(j) = fyprim(REAL(j))
     36  ENDDO
    3737
     38  DO j = 1, jjm
    3839
    39    DO j = 1, jjm
     40    rlatv(j) = fy    (REAL(j) + 0.5)
     41    rlatu1(j) = fy    (REAL(j) + 0.25)
     42    rlatu2(j) = fy    (REAL(j) + 0.75)
    4043
    41      rlatv(j)  = fy    ( REAL( j ) + 0.5  )
    42      rlatu1(j) = fy    ( REAL( j ) + 0.25 )
    43      rlatu2(j) = fy    ( REAL( j ) + 0.75 )
     44    yprimv(j) = fyprim(REAL(j) + 0.5)
     45    yprimu1(j) = fyprim(REAL(j) + 0.25)
     46    yprimu2(j) = fyprim(REAL(j) + 0.75)
    4447
    45     yprimv(j)  = fyprim( REAL( j ) + 0.5  )
    46     yprimu1(j) = fyprim( REAL( j ) + 0.25 )
    47     yprimu2(j) = fyprim( REAL( j ) + 0.75 )
    48 
    49    ENDDO
     48  ENDDO
    5049
    5150  !
    5251  ! .....  calcul   des  longitudes et de  x'   .....
    5352  !
    54    DO i = 1, iim + 1
    55        rlonv(i)     = fx    (   REAL( i )          )
    56        rlonu(i)     = fx    (   REAL( i ) + 0.5    )
    57     rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
    58     rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
     53  DO i = 1, iim + 1
     54    rlonv(i) = fx    (REAL(i))
     55    rlonu(i) = fx    (REAL(i) + 0.5)
     56    rlonm025(i) = fx    (REAL(i) - 0.25)
     57    rlonp025(i) = fx    (REAL(i) + 0.25)
    5958
    60      xprimv  (i)    = fxprim (  REAL( i )          )
    61      xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
    62     xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
    63     xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
    64    ENDDO
     59    xprimv  (i) = fxprim (REAL(i))
     60    xprimu  (i) = fxprim (REAL(i) + 0.5)
     61    xprimm025(i) = fxprim (REAL(i) - 0.25)
     62    xprimp025(i) = fxprim (REAL(i) + 0.25)
     63  ENDDO
    6564
    6665  !
    67    RETURN
     66  RETURN
    6867END SUBROUTINE fxysinus
    6968
  • LMDZ6/branches/Amaury_dev/libf/grid/lmdz_fxy.f90

    r5105 r5108  
     1! This module replaces grid/fxy*.h
    12
    2 ! $Header$
     3MODULE lmdz_fxy
     4  IMPLICIT NONE; PRIVATE
     5  PUBLIC fxy_new, fxy_reg, fxy_sin, fxy_prim
     6CONTAINS
     7  SUBROUTINE fxy_new(ripx, fx, fxprim, fy, fyprim, ri, rj, bigy)
     8    INCLUDE "dimensions.h"
     9    REAL :: ripx, fx, fxprim, fy, fyprim, ri, rj, bigy
    310
    4 !--------------------------------------------------------------
    5    REAL :: ripx
    6    REAL :: fx,fxprim,fy,fyprim,ri,rj,bigy
    7 !
    8 !....stretching in x...
    9 !
    10   ripx(  ri )= (ri-1.0) *2.*pi/REAL(iim)
    11   fx  (  ri )= ripx(ri) + transx  + &
    12         alphax * SIN( ripx(ri)+transx-pxo ) - pi
    13   fxprim(ri) = 2.*pi/REAL(iim)  * &
    14         ( 1.+ alphax * COS( ripx(ri)+transx-pxo ) )
     11    !....stretching in x...
     12    ripx(ri) = (ri - 1.0) * 2. * pi / REAL(iim)
     13    fx  (ri) = ripx(ri) + transx + &
     14            alphax * SIN(ripx(ri) + transx - pxo) - pi
     15    fxprim(ri) = 2. * pi / REAL(iim) * &
     16            (1. + alphax * COS(ripx(ri) + transx - pxo))
    1517
    16 !....stretching in y...
    17 !
    18   bigy(rj)   = 2.* (REAL(jjp1)-rj ) *pi/jjm
    19   fy(rj)     =  ( bigy(rj) + transy  + &
    20         alphay * SIN( bigy(rj)+transy-pyo ) ) /2.  - pi/2.
    21   fyprim(rj) = ( pi/jjm ) * ( 1.+ &
    22         alphay * COS( bigy(rj)+transy-pyo ) )
     18    !....stretching in y...
     19    bigy(rj) = 2. * (REAL(jjp1) - rj) * pi / jjm
     20    fy(rj) = (bigy(rj) + transy + &
     21            alphay * SIN(bigy(rj) + transy - pyo)) / 2. - pi / 2.
     22    fyprim(rj) = (pi / jjm) * (1. + &
     23            alphay * COS(bigy(rj) + transy - pyo))
    2324
    24   ! fy(rj)= pyo-pisjjm*(rj-transy)+coefalpha*SIN(depisjm*(rj-
    25 ! *  transy ))
    26 !   fyprim(rj)= pisjjm-pisjjm*coefy2* COS(depisjm*(rj-transy))
    27 !--------------------------------------------------------------
     25    ! fy(rj)= pyo-pisjjm*(rj-transy)+coefalpha*SIN(depisjm*(rj-
     26    ! *  transy ))
     27    !   fyprim(rj)= pisjjm-pisjjm*coefy2* COS(depisjm*(rj-transy))
     28    !--------------------------------------------------------------
     29  END SUBROUTINE fxy_new
     30
     31  SUBROUTINE fxy_reg(fy, fx, fxprim, fyprim, ri, rj)
     32    INCLUDE "dimensions.h"
     33    REAL :: fy, fx, fxprim, fyprim, ri, rj
     34
     35    fy    (rj) = pi / REAL(jjm) * (0.5 * REAL(jjm) + 1. - rj)
     36    fyprim(rj) = pi / REAL(jjm)
     37
     38    ! fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm)))
     39    ! fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
     40
     41    fx    (ri) = 2. * pi / REAL(iim) * (ri - 0.5 * REAL(iim) - 1.)
     42    ! fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) )
     43    fxprim(ri) = 2. * pi / REAL(iim)
     44    !
     45    !    La valeur de pi est passee par le common/const/ou /const2/ .
     46    !    Sinon, il faut la calculer avant d'appeler ces fonctions .
     47    !
     48    !   ----------------------------------------------------------------
     49    ! Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
     50    !   -----------------------------------------------------------------
     51    !
     52    !    .....  ici, on a l'application particuliere suivante   ........
     53    !
     54    !            **************************************
     55    !            **     x = 2. * pi/iim *  X         **
     56    !            **     y =      pi/jjm *  Y         **
     57    !            **************************************
     58    !
     59    !   ..................................................................
     60    !   ..................................................................
     61    !
     62    !
     63    !
     64    !-----------------------------------------------------------------------
     65
     66  END SUBROUTINE fxy_reg
     67
     68  SUBROUTINE fxy_sin(fy, fx, fxprim, fyprim, ri, rj)
     69    REAL :: fy, fx, fxprim, fyprim, ri, rj
     70
     71    fy(rj) = ASIN(1. + 2. * ((1. - rj) / REAL(jjm)))
     72    fyprim(rj) = 1. / SQRT((rj - 1.) * (jjm + 1. - rj))
     73
     74    fx    (ri) = 2. * pi / REAL(iim) * (ri - 0.5 * REAL(iim) - 1.)
     75    ! fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) )
     76    fxprim(ri) = 2. * pi / REAL(iim)
     77    !
     78    !
     79    !    La valeur de pi est passee par le common/const/ou /const2/ .
     80    !    Sinon, il faut la calculer avant d'appeler ces fonctions .
     81    !
     82    !   ----------------------------------------------------------------
     83    ! Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
     84    !   -----------------------------------------------------------------
     85    !
     86    !    .....  ici, on a l'application particuliere suivante   ........
     87    !
     88    !            **************************************
     89    !            **     x = 2. * pi/iim *  X         **
     90    !            **     y =      pi/jjm *  Y         **
     91    !            **************************************
     92    !
     93    !   ..................................................................
     94    !   ..................................................................
     95    !
     96    !
     97    !
     98    !-----------------------------------------------------------------------
     99  END SUBROUTINE fxy_sin
     100
     101  SUBROUTINE fxy_prim(fy, fx, fxprim, fyprim, ri, rj)
     102    REAL :: fy, fx, fxprim, fyprim, ri, rj
     103
     104    fy    (rj) = pi / REAL(jjm) * (0.5 * REAL(jjm) + 1. - rj)
     105    fyprim(rj) = pi / REAL(jjm)
     106
     107    ! fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm)))
     108    ! fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
     109
     110    fx    (ri) = 2. * pi / REAL(iim) * (ri - 0.5 * REAL(iim) - 1.)
     111    ! fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) )
     112    fxprim(ri) = 2. * pi / REAL(iim)
     113    !
     114    !
     115    !    La valeur de pi est passee par le common/const/ou /const2/ .
     116    !    Sinon, il faut la calculer avant d'appeler ces fonctions .
     117    !
     118    !   ----------------------------------------------------------------
     119    ! Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
     120    !   -----------------------------------------------------------------
     121    !
     122    !    .....  ici, on a l'application particuliere suivante   ........
     123    !
     124    !            **************************************
     125    !            **     x = 2. * pi/iim *  X         **
     126    !            **     y =      pi/jjm *  Y         **
     127    !            **************************************
     128    !
     129    !   ..................................................................
     130    !   ..................................................................
     131    !
     132    !
     133    !
     134    !-----------------------------------------------------------------------
     135  END SUBROUTINE fxy_prim
     136END MODULE lmdz_fxy
Note: See TracChangeset for help on using the changeset viewer.