Ignore:
Timestamp:
Jul 28, 2024, 4:17:54 PM (8 weeks ago)
Author:
abarral
Message:

Put comgeom.h, comgeom2.h into modules

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/enercin.F90

    r5134 r5136  
    1 SUBROUTINE enercin( vcov, ucov, vcont, ucont, ecin )
     1SUBROUTINE enercin(vcov, ucov, vcont, ucont, ecin)
    22
    3 !-------------------------------------------------------------------------------
    4 ! Authors: P. Le Van.
    5 !-------------------------------------------------------------------------------
    6 ! Purpose: Compute kinetic energy at sigma levels.
     3  !-------------------------------------------------------------------------------
     4  ! Authors: P. Le Van.
     5  !-------------------------------------------------------------------------------
     6  ! Purpose: Compute kinetic energy at sigma levels.
     7  USE lmdz_comgeom
     8
    79  IMPLICIT NONE
    810  INCLUDE "dimensions.h"
    911  INCLUDE "paramet.h"
    10   INCLUDE "comgeom.h"
    11 !===============================================================================
    12 ! Arguments:
    13   REAL, INTENT(IN)  :: vcov    (ip1jm,  llm)
    14   REAL, INTENT(IN)  :: ucov    (ip1jmp1,llm)
    15   REAL, INTENT(IN)  :: vcont   (ip1jm,  llm)
    16   REAL, INTENT(IN)  :: ucont   (ip1jmp1,llm)
    17   REAL, INTENT(OUT) :: ecin    (ip1jmp1,llm)
    18 !===============================================================================
    19 ! Notes:
    20 !                 . V
    21 !                i,j-1
     12  !===============================================================================
     13  ! Arguments:
     14  REAL, INTENT(IN) :: vcov    (ip1jm, llm)
     15  REAL, INTENT(IN) :: ucov    (ip1jmp1, llm)
     16  REAL, INTENT(IN) :: vcont   (ip1jm, llm)
     17  REAL, INTENT(IN) :: ucont   (ip1jmp1, llm)
     18  REAL, INTENT(OUT) :: ecin    (ip1jmp1, llm)
     19  !===============================================================================
     20  ! Notes:
     21  !                 . V
     22  !                i,j-1
    2223
    23 !      alpha4 .       . alpha1
     24  !      alpha4 .       . alpha1
    2425
    2526
    26 !        U .      . P     . U
    27 !       i-1,j    i,j      i,j
     27  !        U .      . P     . U
     28  !       i-1,j    i,j      i,j
    2829
    29 !      alpha3 .       . alpha2
     30  !      alpha3 .       . alpha2
    3031
    3132
    32 !                 . V
    33 !                i,j
     33  !                 . V
     34  !                i,j
    3435
    35 ! Kinetic energy at scalar point P(i,j) (excluding poles) is:
    36 !       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
    37 !              0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
    38 !              0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
    39 !              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
    40 !===============================================================================
    41 ! Local variables:
     36  ! Kinetic energy at scalar point P(i,j) (excluding poles) is:
     37  !       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
     38  !              0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
     39  !              0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
     40  !              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
     41  !===============================================================================
     42  ! Local variables:
    4243  INTEGER :: l, ij, i
    43   REAL    :: ecinni(iip1), ecinsi(iip1), ecinpn, ecinps
    44 !===============================================================================
    45   DO l=1,llm
    46     DO ij = iip2, ip1jm -1
    47       ecin(ij+1,l)=0.5*(ucov(ij    ,l)*ucont(ij    ,l)*alpha3p4(ij +1)          &
    48                       + ucov(ij+1  ,l)*ucont(ij+1  ,l)*alpha1p2(ij +1)          &
    49                       + vcov(ij-iim,l)*vcont(ij-iim,l)*alpha1p4(ij +1)          &
    50                       + vcov(ij+1  ,l)*vcont(ij+1  ,l)*alpha2p3(ij +1) )
     44  REAL :: ecinni(iip1), ecinsi(iip1), ecinpn, ecinps
     45  !===============================================================================
     46  DO l = 1, llm
     47    DO ij = iip2, ip1jm - 1
     48      ecin(ij + 1, l) = 0.5 * (ucov(ij, l) * ucont(ij, l) * alpha3p4(ij + 1)          &
     49              + ucov(ij + 1, l) * ucont(ij + 1, l) * alpha1p2(ij + 1)          &
     50              + vcov(ij - iim, l) * vcont(ij - iim, l) * alpha1p4(ij + 1)          &
     51              + vcov(ij + 1, l) * vcont(ij + 1, l) * alpha2p3(ij + 1))
    5152    END DO
    5253    !--- Correction: ecin(1,j,l)= ecin(iip1,j,l)
    53     DO ij=iip2,ip1jm,iip1; ecin(ij,l) = ecin(ij+iim,l); END DO
     54    DO ij = iip2, ip1jm, iip1; ecin(ij, l) = ecin(ij + iim, l);
     55    END DO
    5456
    5557    !--- North pole
    56     DO i=1,iim
    57       ecinni(i) = vcov(i,l)*vcont(i,l)*aire(i)
     58    DO i = 1, iim
     59      ecinni(i) = vcov(i, l) * vcont(i, l) * aire(i)
    5860    END DO
    59     ecinpn = 0.5*SUM(ecinni(1:iim))/apoln
    60     DO ij=1,iip1; ecin(ij,l)=ecinpn; END DO
     61    ecinpn = 0.5 * SUM(ecinni(1:iim)) / apoln
     62    DO ij = 1, iip1; ecin(ij, l) = ecinpn;
     63    END DO
    6164
    6265    !--- South pole
    63     DO i=1,iim
    64       ecinsi(i) = vcov(i+ip1jmi1,l)*vcont(i+ip1jmi1,l)*aire(i+ip1jm)
     66    DO i = 1, iim
     67      ecinsi(i) = vcov(i + ip1jmi1, l) * vcont(i + ip1jmi1, l) * aire(i + ip1jm)
    6568    END DO
    66     ecinps = 0.5*SUM(ecinsi(1:iim))/apols
    67     DO ij=1,iip1; ecin(ij+ip1jm,l)=ecinps; END DO
     69    ecinps = 0.5 * SUM(ecinsi(1:iim)) / apols
     70    DO ij = 1, iip1; ecin(ij + ip1jm, l) = ecinps;
     71    END DO
    6872  END DO
    6973
Note: See TracChangeset for help on using the changeset viewer.