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

Encapsulate files in modules

File:
1 moved

Legend:

Unmodified
Added
Removed

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

    r5185 r5186  
    1 ! $Id$
     1MODULE lmdz_dissip
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC dissip
    24
    3 SUBROUTINE dissip(vcov, ucov, teta, p, dv, du, dh)
    4   USE comconst_mod, ONLY: dtdiss
    5   USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
    6   USE lmdz_comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, &
    7           tetagrot, tetatemp, coefdis, vert_prof_dissip
    8   USE lmdz_comgeom
     5CONTAINS
    96
    10   USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    11   USE lmdz_paramet
    12   IMPLICIT NONE
     7  SUBROUTINE dissip(vcov, ucov, teta, p, dv, du, dh)
     8    USE comconst_mod, ONLY: dtdiss
     9    USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
     10    USE lmdz_comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, &
     11            tetagrot, tetatemp, coefdis, vert_prof_dissip
     12    USE lmdz_comgeom
     13
     14    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15    USE lmdz_paramet
     16    IMPLICIT NONE
    1317
    1418
    15   ! ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
    16   ! (  10/01/98  )
     19    ! ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
     20    ! (  10/01/98  )
    1721
    18   !=======================================================================
     22    !=======================================================================
    1923
    20   !   Auteur:  P. Le Van
    21   !   -------
     24    !   Auteur:  P. Le Van
     25    !   -------
    2226
    23   !   Objet:
    24   !   ------
     27    !   Objet:
     28    !   ------
    2529
    26   !   Dissipation horizontale
     30    !   Dissipation horizontale
    2731
    28   !=======================================================================
    29   !-----------------------------------------------------------------------
    30   !   Declarations:
    31   !   -------------
     32    !=======================================================================
     33    !-----------------------------------------------------------------------
     34    !   Declarations:
     35    !   -------------
    3236
    3337
    3438
    3539
    36   !   Arguments:
    37   !   ----------
     40    !   Arguments:
     41    !   ----------
    3842
    39   REAL, INTENT(IN) :: vcov(ip1jm, llm) ! covariant meridional wind
    40   REAL, INTENT(IN) :: ucov(ip1jmp1, llm) ! covariant zonal wind
    41   REAL, INTENT(IN) :: teta(ip1jmp1, llm) ! potential temperature
    42   REAL, INTENT(IN) :: p(ip1jmp1, llmp1) ! pressure
    43   ! tendencies (.../s) on covariant winds and potential temperature
    44   REAL, INTENT(OUT) :: dv(ip1jm, llm)
    45   REAL, INTENT(OUT) :: du(ip1jmp1, llm)
    46   REAL, INTENT(OUT) :: dh(ip1jmp1, llm)
     43    REAL, INTENT(IN) :: vcov(ip1jm, llm) ! covariant meridional wind
     44    REAL, INTENT(IN) :: ucov(ip1jmp1, llm) ! covariant zonal wind
     45    REAL, INTENT(IN) :: teta(ip1jmp1, llm) ! potential temperature
     46    REAL, INTENT(IN) :: p(ip1jmp1, llmp1) ! pressure
     47    ! tendencies (.../s) on covariant winds and potential temperature
     48    REAL, INTENT(OUT) :: dv(ip1jm, llm)
     49    REAL, INTENT(OUT) :: du(ip1jmp1, llm)
     50    REAL, INTENT(OUT) :: dh(ip1jmp1, llm)
    4751
    48   !   Local:
    49   !   ------
     52    !   Local:
     53    !   ------
    5054
    51   REAL :: gdx(ip1jmp1, llm), gdy(ip1jm, llm)
    52   REAL :: grx(ip1jmp1, llm), gry(ip1jm, llm)
    53   REAL :: te1dt(llm), te2dt(llm), te3dt(llm)
    54   REAL :: deltapres(ip1jmp1, llm)
     55    REAL :: gdx(ip1jmp1, llm), gdy(ip1jm, llm)
     56    REAL :: grx(ip1jmp1, llm), gry(ip1jm, llm)
     57    REAL :: te1dt(llm), te2dt(llm), te3dt(llm)
     58    REAL :: deltapres(ip1jmp1, llm)
    5559
    56   INTEGER :: l, ij
     60    INTEGER :: l, ij
    5761
    58   !-----------------------------------------------------------------------
    59   !   initialisations:
    60   !   ----------------
     62    !-----------------------------------------------------------------------
     63    !   initialisations:
     64    !   ----------------
    6165
    62   DO l = 1, llm
    63     te1dt(l) = tetaudiv(l) * dtdiss
    64     te2dt(l) = tetaurot(l) * dtdiss
    65     te3dt(l) = tetah(l) * dtdiss
    66   ENDDO
    67   du = 0.
    68   dv = 0.
    69   dh = 0.
     66    DO l = 1, llm
     67      te1dt(l) = tetaudiv(l) * dtdiss
     68      te2dt(l) = tetaurot(l) * dtdiss
     69      te3dt(l) = tetah(l) * dtdiss
     70    ENDDO
     71    du = 0.
     72    dv = 0.
     73    dh = 0.
    7074
    71   !-----------------------------------------------------------------------
    72   !   Calcul de la dissipation:
    73   !   -------------------------
     75    !-----------------------------------------------------------------------
     76    !   Calcul de la dissipation:
     77    !   -------------------------
    7478
    75   !   Calcul de la partie   grad  ( div ) :
    76   !   -------------------------------------
     79    !   Calcul de la partie   grad  ( div ) :
     80    !   -------------------------------------
    7781
    78   IF(lstardis) THEN
    79     CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy)
    80   ELSE
    81     CALL gradiv (llm, ucov, vcov, nitergdiv, gdx, gdy)
    82   ENDIF
     82    IF(lstardis) THEN
     83      CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy)
     84    ELSE
     85      CALL gradiv (llm, ucov, vcov, nitergdiv, gdx, gdy)
     86    ENDIF
    8387
    84   DO l = 1, llm
     88    DO l = 1, llm
    8589
    86     DO ij = 1, iip1
    87       gdx(ij, l) = 0.
    88       gdx(ij + ip1jm, l) = 0.
     90      DO ij = 1, iip1
     91        gdx(ij, l) = 0.
     92        gdx(ij + ip1jm, l) = 0.
     93      ENDDO
     94
     95      DO ij = iip2, ip1jm
     96        du(ij, l) = du(ij, l) - te1dt(l) * gdx(ij, l)
     97      ENDDO
     98      DO ij = 1, ip1jm
     99        dv(ij, l) = dv(ij, l) - te1dt(l) * gdy(ij, l)
     100      ENDDO
     101
    89102    ENDDO
    90103
    91     DO ij = iip2, ip1jm
    92       du(ij, l) = du(ij, l) - te1dt(l) * gdx(ij, l)
    93     ENDDO
    94     DO ij = 1, ip1jm
    95       dv(ij, l) = dv(ij, l) - te1dt(l) * gdy(ij, l)
     104    !   calcul de la partie   n X grad ( rot ):
     105    !   ---------------------------------------
     106
     107    IF(lstardis) THEN
     108      CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry)
     109    ELSE
     110      CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry)
     111    ENDIF
     112
     113    DO l = 1, llm
     114      DO ij = 1, iip1
     115        grx(ij, l) = 0.
     116      ENDDO
     117
     118      DO ij = iip2, ip1jm
     119        du(ij, l) = du(ij, l) - te2dt(l) * grx(ij, l)
     120      ENDDO
     121      DO ij = 1, ip1jm
     122        dv(ij, l) = dv(ij, l) - te2dt(l) * gry(ij, l)
     123      ENDDO
    96124    ENDDO
    97125
    98   ENDDO
     126    !   calcul de la partie   div ( grad ):
     127    !   -----------------------------------
    99128
    100   !   calcul de la partie   n X grad ( rot ):
    101   !   ---------------------------------------
     129    IF(lstardis) THEN
    102130
    103   IF(lstardis) THEN
    104     CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry)
    105   ELSE
    106     CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry)
    107   ENDIF
     131      DO l = 1, llm
     132        DO ij = 1, ip1jmp1
     133          deltapres(ij, l) = AMAX1(0., p(ij, l) - p(ij, l + 1))
     134        ENDDO
     135      ENDDO
    108136
    109   DO l = 1, llm
    110     DO ij = 1, iip1
    111       grx(ij, l) = 0.
    112     ENDDO
    113 
    114     DO ij = iip2, ip1jm
    115       du(ij, l) = du(ij, l) - te2dt(l) * grx(ij, l)
    116     ENDDO
    117     DO ij = 1, ip1jm
    118       dv(ij, l) = dv(ij, l) - te2dt(l) * gry(ij, l)
    119     ENDDO
    120   ENDDO
    121 
    122   !   calcul de la partie   div ( grad ):
    123   !   -----------------------------------
    124 
    125   IF(lstardis) THEN
     137      CALL divgrad2(llm, teta, deltapres, niterh, gdx)
     138    ELSE
     139      CALL divgrad (llm, teta, niterh, gdx)
     140    ENDIF
    126141
    127142    DO l = 1, llm
    128143      DO ij = 1, ip1jmp1
    129         deltapres(ij, l) = AMAX1(0., p(ij, l) - p(ij, l + 1))
     144        dh(ij, l) = dh(ij, l) - te3dt(l) * gdx(ij, l)
    130145      ENDDO
    131146    ENDDO
    132147
    133     CALL divgrad2(llm, teta, deltapres, niterh, gdx)
    134   ELSE
    135     CALL divgrad (llm, teta, niterh, gdx)
    136   ENDIF
    137 
    138   DO l = 1, llm
    139     DO ij = 1, ip1jmp1
    140       dh(ij, l) = dh(ij, l) - te3dt(l) * gdx(ij, l)
    141     ENDDO
    142   ENDDO
     148  END SUBROUTINE dissip
    143149
    144150
    145 END SUBROUTINE dissip
     151END MODULE lmdz_dissip
Note: See TracChangeset for help on using the changeset viewer.