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_addfi.f90

    r5185 r5186  
    1 ! $Id$
     1MODULE lmdz_addfi
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC addfi
    24
    3 SUBROUTINE addfi(pdt, leapf, forward, pucov, pvcov, pteta, pq, pps, pdufi, pdvfi, pdhfi, pdqfi, pdpfi)
     5CONTAINS
    46
    5   USE lmdz_infotrac, ONLY: nqtot
    6   USE control_mod, ONLY: planet_type
    7   USE lmdz_ssum_scopy, ONLY: ssum
    8   USE lmdz_comgeom
    9   USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    10   USE lmdz_paramet
     7  SUBROUTINE addfi(pdt, leapf, forward, pucov, pvcov, pteta, pq, pps, pdufi, pdvfi, pdhfi, pdqfi, pdpfi)
    118
    12   IMPLICIT NONE
     9    USE lmdz_infotrac, ONLY: nqtot
     10    USE control_mod, ONLY: planet_type
     11    USE lmdz_ssum_scopy, ONLY: ssum
     12    USE lmdz_comgeom
     13    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     14    USE lmdz_paramet
    1315
    14   !=======================================================================
     16    IMPLICIT NONE
    1517
    16   !    Addition of the physical tendencies
     18    !=======================================================================
    1719
    18   !    Interface :
    19   !    -----------
     20    !    Addition of the physical tendencies
    2021
    21   !  Input :
    22   !  -------
    23   !  pdt                    time step of integration
    24   !  leapf                  logical
    25   !  forward                logical
    26   !  pucov(ip1jmp1,llm)     first component of the covariant velocity
    27   !  pvcov(ip1ip1jm,llm)    second component of the covariant velocity
    28   !  pteta(ip1jmp1,llm)     potential temperature
    29   !  pts(ip1jmp1,llm)       surface temperature
    30   !  pdufi(ip1jmp1,llm)     |
    31   !  pdvfi(ip1jm,llm)       |   respective
    32   !  pdhfi(ip1jmp1)         |      tendencies
    33   !  pdtsfi(ip1jmp1)        |
     22    !    Interface :
     23    !    -----------
    3424
    35   !  Output :
    36   !  --------
    37   !  pucov
    38   !  pvcov
    39   !  ph
    40   !  pts
     25    !  Input :
     26    !  -------
     27    !  pdt                    time step of integration
     28    !  leapf                  logical
     29    !  forward                logical
     30    !  pucov(ip1jmp1,llm)     first component of the covariant velocity
     31    !  pvcov(ip1ip1jm,llm)    second component of the covariant velocity
     32    !  pteta(ip1jmp1,llm)     potential temperature
     33    !  pts(ip1jmp1,llm)       surface temperature
     34    !  pdufi(ip1jmp1,llm)     |
     35    !  pdvfi(ip1jm,llm)       |   respective
     36    !  pdhfi(ip1jmp1)         |      tendencies
     37    !  pdtsfi(ip1jmp1)        |
     38
     39    !  Output :
     40    !  --------
     41    !  pucov
     42    !  pvcov
     43    !  ph
     44    !  pts
    4145
    4246
    43   !=======================================================================
    44   !  !
    45   !    Arguments :
    46   !    -----------
     47    !=======================================================================
     48    !  !
     49    !    Arguments :
     50    !    -----------
    4751
    48   REAL, INTENT(IN) :: pdt ! time step for the integration (s)
     52    REAL, INTENT(IN) :: pdt ! time step for the integration (s)
    4953
    50   REAL, INTENT(INOUT) :: pvcov(ip1jm, llm) ! covariant meridional wind
    51   REAL, INTENT(INOUT) :: pucov(ip1jmp1, llm) ! covariant zonal wind
    52   REAL, INTENT(INOUT) :: pteta(ip1jmp1, llm) ! potential temperature
    53   REAL, INTENT(INOUT) :: pq(ip1jmp1, llm, nqtot) ! tracers
    54   REAL, INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa)
    55   ! respective tendencies (.../s) to add
    56   REAL, INTENT(IN) :: pdvfi(ip1jm, llm)
    57   REAL, INTENT(IN) :: pdufi(ip1jmp1, llm)
    58   REAL, INTENT(IN) :: pdqfi(ip1jmp1, llm, nqtot)
    59   REAL, INTENT(IN) :: pdhfi(ip1jmp1, llm)
    60   REAL, INTENT(IN) :: pdpfi(ip1jmp1)
     54    REAL, INTENT(INOUT) :: pvcov(ip1jm, llm) ! covariant meridional wind
     55    REAL, INTENT(INOUT) :: pucov(ip1jmp1, llm) ! covariant zonal wind
     56    REAL, INTENT(INOUT) :: pteta(ip1jmp1, llm) ! potential temperature
     57    REAL, INTENT(INOUT) :: pq(ip1jmp1, llm, nqtot) ! tracers
     58    REAL, INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa)
     59    ! respective tendencies (.../s) to add
     60    REAL, INTENT(IN) :: pdvfi(ip1jm, llm)
     61    REAL, INTENT(IN) :: pdufi(ip1jmp1, llm)
     62    REAL, INTENT(IN) :: pdqfi(ip1jmp1, llm, nqtot)
     63    REAL, INTENT(IN) :: pdhfi(ip1jmp1, llm)
     64    REAL, INTENT(IN) :: pdpfi(ip1jmp1)
    6165
    62   LOGICAL, INTENT(IN) :: leapf, forward ! not used
     66    LOGICAL, INTENT(IN) :: leapf, forward ! not used
    6367
    6468
    65   !    Local variables :
    66   !    -----------------
     69    !    Local variables :
     70    !    -----------------
    6771
    68   REAL :: xpn(iim), xps(iim), tpn, tps
    69   INTEGER :: j, k, iq, ij
    70   REAL, PARAMETER :: qtestw = 1.0e-15
    71   REAL, PARAMETER :: qtestt = 1.0e-40
     72    REAL :: xpn(iim), xps(iim), tpn, tps
     73    INTEGER :: j, k, iq, ij
     74    REAL, PARAMETER :: qtestw = 1.0e-15
     75    REAL, PARAMETER :: qtestt = 1.0e-40
    7276
    73   !-----------------------------------------------------------------------
     77    !-----------------------------------------------------------------------
    7478
    75   DO k = 1, llm
     79    DO k = 1, llm
     80      DO j = 1, ip1jmp1
     81        pteta(j, k) = pteta(j, k) + pdhfi(j, k) * pdt
     82      ENDDO
     83    ENDDO
     84
     85    DO  k = 1, llm
     86      DO  ij = 1, iim
     87        xpn(ij) = aire(ij) * pteta(ij, k)
     88        xps(ij) = aire(ij + ip1jm) * pteta(ij + ip1jm, k)
     89      ENDDO
     90      tpn = SSUM(iim, xpn, 1) / apoln
     91      tps = SSUM(iim, xps, 1) / apols
     92
     93      DO ij = 1, iip1
     94        pteta(ij, k) = tpn
     95        pteta(ij + ip1jm, k) = tps
     96      ENDDO
     97    ENDDO
     98    !
     99
     100    DO k = 1, llm
     101      DO j = iip2, ip1jm
     102        pucov(j, k) = pucov(j, k) + pdufi(j, k) * pdt
     103      ENDDO
     104    ENDDO
     105
     106    DO k = 1, llm
     107      DO j = 1, ip1jm
     108        pvcov(j, k) = pvcov(j, k) + pdvfi(j, k) * pdt
     109      ENDDO
     110    ENDDO
     111
    76112    DO j = 1, ip1jmp1
    77       pteta(j, k) = pteta(j, k) + pdhfi(j, k) * pdt
     113      pps(j) = pps(j) + pdpfi(j) * pdt
    78114    ENDDO
    79   ENDDO
    80115
    81   DO  k = 1, llm
     116    IF (planet_type=="earth") THEN
     117      ! earth case, special treatment for first 2 tracers (water)
     118      DO iq = 1, 2
     119        DO k = 1, llm
     120          DO j = 1, ip1jmp1
     121            pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
     122            pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestw)
     123          ENDDO
     124        ENDDO
     125      ENDDO
     126
     127      DO iq = 3, nqtot
     128        DO k = 1, llm
     129          DO j = 1, ip1jmp1
     130            pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
     131            pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestt)
     132          ENDDO
     133        ENDDO
     134      ENDDO
     135    else
     136      ! general case, treat all tracers equally)
     137      DO iq = 1, nqtot
     138        DO k = 1, llm
     139          DO j = 1, ip1jmp1
     140            pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
     141            pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestt)
     142          ENDDO
     143        ENDDO
     144      ENDDO
     145    ENDIF ! of if (planet_type=="earth")
     146
    82147    DO  ij = 1, iim
    83       xpn(ij) = aire(ij) * pteta(ij, k)
    84       xps(ij) = aire(ij + ip1jm) * pteta(ij + ip1jm, k)
     148      xpn(ij) = aire(ij) * pps(ij)
     149      xps(ij) = aire(ij + ip1jm) * pps(ij + ip1jm)
    85150    ENDDO
    86151    tpn = SSUM(iim, xpn, 1) / apoln
    … …  
    88153
    89154    DO ij = 1, iip1
    90       pteta(ij, k) = tpn
    91       pteta(ij + ip1jm, k) = tps
     155      pps (ij) = tpn
     156      pps (ij + ip1jm) = tps
    92157    ENDDO
    93   ENDDO
    94   !
    95158
    96   DO k = 1, llm
    97     DO j = iip2, ip1jm
    98       pucov(j, k) = pucov(j, k) + pdufi(j, k) * pdt
    99     ENDDO
    100   ENDDO
     159    DO iq = 1, nqtot
     160      DO  k = 1, llm
     161        DO  ij = 1, iim
     162          xpn(ij) = aire(ij) * pq(ij, k, iq)
     163          xps(ij) = aire(ij + ip1jm) * pq(ij + ip1jm, k, iq)
     164        ENDDO
     165        tpn = SSUM(iim, xpn, 1) / apoln
     166        tps = SSUM(iim, xps, 1) / apols
    101167
    102   DO k = 1, llm
    103     DO j = 1, ip1jm
    104       pvcov(j, k) = pvcov(j, k) + pdvfi(j, k) * pdt
    105     ENDDO
    106   ENDDO
    107 
    108 
    109   DO j = 1, ip1jmp1
    110     pps(j) = pps(j) + pdpfi(j) * pdt
    111   ENDDO
    112 
    113   IF (planet_type=="earth") THEN
    114     ! earth case, special treatment for first 2 tracers (water)
    115     DO iq = 1, 2
    116       DO k = 1, llm
    117         DO j = 1, ip1jmp1
    118           pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
    119           pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestw)
     168        DO ij = 1, iip1
     169          pq (ij, k, iq) = tpn
     170          pq (ij + ip1jm, k, iq) = tps
    120171        ENDDO
    121172      ENDDO
    122173    ENDDO
    123174
    124     DO iq = 3, nqtot
    125       DO k = 1, llm
    126         DO j = 1, ip1jmp1
    127           pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
    128           pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestt)
    129         ENDDO
    130       ENDDO
    131     ENDDO
    132   else
    133     ! general case, treat all tracers equally)
    134     DO iq = 1, nqtot
    135       DO k = 1, llm
    136         DO j = 1, ip1jmp1
    137           pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
    138           pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestt)
    139         ENDDO
    140       ENDDO
    141     ENDDO
    142   ENDIF ! of if (planet_type=="earth")
    143 
    144   DO  ij = 1, iim
    145     xpn(ij) = aire(ij) * pps(ij)
    146     xps(ij) = aire(ij + ip1jm) * pps(ij + ip1jm)
    147   ENDDO
    148   tpn = SSUM(iim, xpn, 1) / apoln
    149   tps = SSUM(iim, xps, 1) / apols
    150 
    151   DO ij = 1, iip1
    152     pps (ij) = tpn
    153     pps (ij + ip1jm) = tps
    154   ENDDO
    155 
    156   DO iq = 1, nqtot
    157     DO  k = 1, llm
    158       DO  ij = 1, iim
    159         xpn(ij) = aire(ij) * pq(ij, k, iq)
    160         xps(ij) = aire(ij + ip1jm) * pq(ij + ip1jm, k, iq)
    161       ENDDO
    162       tpn = SSUM(iim, xpn, 1) / apoln
    163       tps = SSUM(iim, xps, 1) / apols
    164 
    165       DO ij = 1, iip1
    166         pq (ij, k, iq) = tpn
    167         pq (ij + ip1jm, k, iq) = tps
    168       ENDDO
    169     ENDDO
    170   ENDDO
    171 
    172 END SUBROUTINE addfi
     175  END SUBROUTINE addfi
     176END MODULE lmdz_addfi
Note: See TracChangeset for help on using the changeset viewer.