Ignore:
Timestamp:
Sep 11, 2024, 6:03:07 PM (9 days ago)
Author:
abarral
Message:

Encapsulate files in modules

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_caldyn.f90

    r5185 r5186  
    1 ! $Id$
     1MODULE lmdz_caldyn
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC caldyn
    24
    3 SUBROUTINE caldyn &
    4         (itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, &
    5         phi, conser, du, dv, dteta, dp, w, pbaru, pbarv, time)
     5CONTAINS
    66
    7   USE comvert_mod, ONLY: ap, bp
    8   USE lmdz_comgeom
     7  SUBROUTINE caldyn &
     8          (itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, &
     9          phi, conser, du, dv, dteta, dp, w, pbaru, pbarv, time)
    910
    10   USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    11   USE lmdz_paramet
    12   IMPLICIT NONE
     11    USE comvert_mod, ONLY: ap, bp
     12    USE lmdz_comgeom
    1313
    14   !=======================================================================
     14    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15    USE lmdz_paramet
     16    USE lmdz_advect, ONLY: advect
     17    USE lmdz_dteta1, ONLY: dteta1
     18    USE lmdz_dudv1, ONLY: dudv1
     19    USE lmdz_dudv2, ONLY: dudv2
    1520
    16   !  Auteur :  P. Le Van
     21    IMPLICIT NONE
    1722
    18   !   Objet:
    19   !   ------
     23    !=======================================================================
    2024
    21   !   Calcul des tendances dynamiques.
     25    !  Auteur :  P. Le Van
    2226
    23   ! Modif 04/93 F.Forget
    24   !=======================================================================
     27    !   Objet:
     28    !   ------
    2529
    26   !-----------------------------------------------------------------------
    27   !   0. Declarations:
    28   !   ----------------
     30    !   Calcul des tendances dynamiques.
     31
     32    ! Modif 04/93 F.Forget
     33    !=======================================================================
     34
     35    !-----------------------------------------------------------------------
     36    !   0. Declarations:
     37    !   ----------------
    2938
    3039
    3140
    3241
    33   !   Arguments:
    34   !   ----------
     42    !   Arguments:
     43    !   ----------
    3544
    36   LOGICAL, INTENT(IN) :: conser ! triggers printing some diagnostics
    37   INTEGER, INTENT(IN) :: itau ! time step index
    38   REAL, INTENT(IN) :: vcov(ip1jm, llm) ! covariant meridional wind
    39   REAL, INTENT(IN) :: ucov(ip1jmp1, llm) ! covariant zonal wind
    40   REAL, INTENT(IN) :: teta(ip1jmp1, llm) ! potential temperature
    41   REAL, INTENT(IN) :: ps(ip1jmp1) ! surface pressure
    42   REAL, INTENT(IN) :: phis(ip1jmp1) ! geopotential at the surface
    43   REAL, INTENT(IN) :: pk(ip1jmp1, llm) ! Exner at mid-layer
    44   REAL, INTENT(IN) :: pkf(ip1jmp1, llm) ! filtered Exner
    45   REAL, INTENT(IN) :: phi(ip1jmp1, llm) ! geopotential
    46   REAL, INTENT(OUT) :: masse(ip1jmp1, llm) ! air mass
    47   REAL, INTENT(OUT) :: dv(ip1jm, llm) ! tendency on vcov
    48   REAL, INTENT(OUT) :: du(ip1jmp1, llm) ! tendency on ucov
    49   REAL, INTENT(OUT) :: dteta(ip1jmp1, llm) ! tenddency on teta
    50   REAL, INTENT(OUT) :: dp(ip1jmp1) ! tendency on ps
    51   REAL, INTENT(OUT) :: w(ip1jmp1, llm) ! vertical velocity
    52   REAL, INTENT(OUT) :: pbaru(ip1jmp1, llm) ! mass flux in the zonal direction
    53   REAL, INTENT(OUT) :: pbarv(ip1jm, llm) ! mass flux in the meridional direction
    54   REAL, INTENT(IN) :: time ! current time
     45    LOGICAL, INTENT(IN) :: conser ! triggers printing some diagnostics
     46    INTEGER, INTENT(IN) :: itau ! time step index
     47    REAL, INTENT(IN) :: vcov(ip1jm, llm) ! covariant meridional wind
     48    REAL, INTENT(IN) :: ucov(ip1jmp1, llm) ! covariant zonal wind
     49    REAL, INTENT(IN) :: teta(ip1jmp1, llm) ! potential temperature
     50    REAL, INTENT(IN) :: ps(ip1jmp1) ! surface pressure
     51    REAL, INTENT(IN) :: phis(ip1jmp1) ! geopotential at the surface
     52    REAL, INTENT(IN) :: pk(ip1jmp1, llm) ! Exner at mid-layer
     53    REAL, INTENT(IN) :: pkf(ip1jmp1, llm) ! filtered Exner
     54    REAL, INTENT(IN) :: phi(ip1jmp1, llm) ! geopotential
     55    REAL, INTENT(OUT) :: masse(ip1jmp1, llm) ! air mass
     56    REAL, INTENT(OUT) :: dv(ip1jm, llm) ! tendency on vcov
     57    REAL, INTENT(OUT) :: du(ip1jmp1, llm) ! tendency on ucov
     58    REAL, INTENT(OUT) :: dteta(ip1jmp1, llm) ! tenddency on teta
     59    REAL, INTENT(OUT) :: dp(ip1jmp1) ! tendency on ps
     60    REAL, INTENT(OUT) :: w(ip1jmp1, llm) ! vertical velocity
     61    REAL, INTENT(OUT) :: pbaru(ip1jmp1, llm) ! mass flux in the zonal direction
     62    REAL, INTENT(OUT) :: pbarv(ip1jm, llm) ! mass flux in the meridional direction
     63    REAL, INTENT(IN) :: time ! current time
    5564
    56   !   Local:
    57   !   ------
     65    !   Local:
     66    !   ------
    5867
    59   REAL :: vcont(ip1jm, llm), ucont(ip1jmp1, llm)
    60   REAL :: ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
    61   REAL :: massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm)
    62   REAL :: vorpot(ip1jm, llm)
    63   REAL :: ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
    64   REAL :: bern(ip1jmp1, llm)
    65   REAL :: massebxy(ip1jm, llm)
     68    REAL :: vcont(ip1jm, llm), ucont(ip1jmp1, llm)
     69    REAL :: ang(ip1jmp1, llm), p(ip1jmp1, llmp1)
     70    REAL :: massebx(ip1jmp1, llm), masseby(ip1jm, llm), psexbarxy(ip1jm)
     71    REAL :: vorpot(ip1jm, llm)
     72    REAL :: ecin(ip1jmp1, llm), convm(ip1jmp1, llm)
     73    REAL :: bern(ip1jmp1, llm)
     74    REAL :: massebxy(ip1jm, llm)
    6675
    67   INTEGER :: ij, l
     76    INTEGER :: ij, l
    6877
    69   !-----------------------------------------------------------------------
    70   !   Compute dynamical tendencies:
    71   !--------------------------------
     78    !-----------------------------------------------------------------------
     79    !   Compute dynamical tendencies:
     80    !--------------------------------
    7281
    73   ! compute contravariant winds ucont() and vcont
    74   CALL covcont  (llm, ucov, vcov, ucont, vcont)
    75   ! compute pressure p()
    76   CALL pression (ip1jmp1, ap, bp, ps, p)
    77   ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?)
    78   CALL psextbar (ps, psexbarxy)
    79   ! compute mass in each atmospheric mesh: masse()
    80   CALL massdair (p, masse)
    81   ! compute X and Y-averages of mass, massebx() and masseby()
    82   CALL massbar  (masse, massebx, masseby)
    83   ! compute XY-average of mass, massebxy()
    84   CALL massbarxy(masse, massebxy)
    85   ! compute mass fluxes pbaru() and pbarv()
    86   CALL flumass  (massebx, masseby, vcont, ucont, pbaru, pbarv)
    87   ! compute dteta() , horizontal converging flux of theta
    88   CALL dteta1   (teta, pbaru, pbarv, dteta)
    89   ! compute convm(), horizontal converging flux of mass
    90   CALL convmas  (pbaru, pbarv, convm)
     82    ! compute contravariant winds ucont() and vcont
     83    CALL covcont  (llm, ucov, vcov, ucont, vcont)
     84    ! compute pressure p()
     85    CALL pression (ip1jmp1, ap, bp, ps, p)
     86    ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?)
     87    CALL psextbar (ps, psexbarxy)
     88    ! compute mass in each atmospheric mesh: masse()
     89    CALL massdair (p, masse)
     90    ! compute X and Y-averages of mass, massebx() and masseby()
     91    CALL massbar  (masse, massebx, masseby)
     92    ! compute XY-average of mass, massebxy()
     93    CALL massbarxy(masse, massebxy)
     94    ! compute mass fluxes pbaru() and pbarv()
     95    CALL flumass  (massebx, masseby, vcont, ucont, pbaru, pbarv)
     96    ! compute dteta() , horizontal converging flux of theta
     97    CALL dteta1   (teta, pbaru, pbarv, dteta)
     98    ! compute convm(), horizontal converging flux of mass
     99    CALL convmas  (pbaru, pbarv, convm)
    91100
    92   ! compute pressure variation due to mass convergence
    93   DO ij = 1, ip1jmp1
    94     dp(ij) = convm(ij, 1) / airesurg(ij)
    95   ENDDO
     101    ! compute pressure variation due to mass convergence
     102    DO ij = 1, ip1jmp1
     103      dp(ij) = convm(ij, 1) / airesurg(ij)
     104    ENDDO
    96105
    97   ! compute vertical velocity w()
    98   CALL vitvert (convm, w)
    99   ! compute potential vorticity vorpot()
    100   CALL tourpot (vcov, ucov, massebxy, vorpot)
    101   ! compute rotation induced du() and dv()
    102   CALL dudv1   (vorpot, pbaru, pbarv, du, dv)
    103   ! compute kinetic energy ecin()
    104   CALL enercin (vcov, ucov, vcont, ucont, ecin)
    105   ! compute Bernouilli function bern()
    106   CALL bernoui (ip1jmp1, llm, phi, ecin, bern)
    107   ! compute and add du() and dv() contributions from Bernouilli and pressure
    108   CALL dudv2   (teta, pkf, bern, du, dv)
     106    ! compute vertical velocity w()
     107    CALL vitvert (convm, w)
     108    ! compute potential vorticity vorpot()
     109    CALL tourpot (vcov, ucov, massebxy, vorpot)
     110    ! compute rotation induced du() and dv()
     111    CALL dudv1   (vorpot, pbaru, pbarv, du, dv)
     112    ! compute kinetic energy ecin()
     113    CALL enercin (vcov, ucov, vcont, ucont, ecin)
     114    ! compute Bernouilli function bern()
     115    CALL bernoui (ip1jmp1, llm, phi, ecin, bern)
     116    ! compute and add du() and dv() contributions from Bernouilli and pressure
     117    CALL dudv2   (teta, pkf, bern, du, dv)
    109118
    110   DO l = 1, llm
    111     DO ij = 1, ip1jmp1
    112       ang(ij, l) = ucov(ij, l) + constang(ij)
     119    DO l = 1, llm
     120      DO ij = 1, ip1jmp1
     121        ang(ij, l) = ucov(ij, l) + constang(ij)
     122      ENDDO
    113123    ENDDO
    114   ENDDO
    115124
    116   ! compute vertical advection contributions to du(), dv() and dteta()
    117   CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta)
     125    ! compute vertical advection contributions to du(), dv() and dteta()
     126    CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta)
    118127
    119   !  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
    120   ! probablement. Observe sur le code compile avec pgf90 3.0-1
     128    !  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
     129    ! probablement. Observe sur le code compile avec pgf90 3.0-1
    121130
    122   DO l = 1, llm
    123     DO ij = 1, ip1jm, iip1
    124       IF(dv(ij, l)/=dv(ij + iim, l))  THEN
    125         ! PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',
    126         !    ,   ' dans caldyn'
    127         ! PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
    128         dv(ij + iim, l) = dv(ij, l)
    129       ENDIF
     131    DO l = 1, llm
     132      DO ij = 1, ip1jm, iip1
     133        IF(dv(ij, l)/=dv(ij + iim, l))  THEN
     134          ! PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',
     135          !    ,   ' dans caldyn'
     136          ! PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
     137          dv(ij + iim, l) = dv(ij, l)
     138        ENDIF
     139      ENDDO
    130140    ENDDO
    131   ENDDO
    132141
    133   !-----------------------------------------------------------------------
    134   !   Output some control variables:
    135   !---------------------------------
     142    !-----------------------------------------------------------------------
     143    !   Output some control variables:
     144    !---------------------------------
    136145
    137   IF(conser)  THEN
    138     CALL sortvarc &
    139             (itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, time, vcov)
    140   ENDIF
     146    IF(conser)  THEN
     147      CALL sortvarc &
     148              (itau, ucov, teta, ps, masse, pk, phis, vorpot, phi, bern, dp, time, vcov)
     149    ENDIF
    141150
    142 END SUBROUTINE caldyn
     151  END SUBROUTINE caldyn
     152
     153END MODULE lmdz_caldyn
Note: See TracChangeset for help on using the changeset viewer.