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

    r5185 r5186  
    1 ! $Header$
     1MODULE lmdz_dudv2
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC dudv2
    24
    3 SUBROUTINE dudv2(teta, pkf, bern, du, dv)
     5CONTAINS
    46
    5   USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    6   USE lmdz_paramet
    7   IMPLICIT NONE
     7  SUBROUTINE dudv2(teta, pkf, bern, du, dv)
    88
    9   !=======================================================================
     9    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     10    USE lmdz_paramet
     11    IMPLICIT NONE
    1012
    11   !   Auteur:  P. Le Van
    12   !   -------
     13    !=======================================================================
    1314
    14   !   Objet:
    15   !   ------
     15    !   Auteur:  P. Le Van
     16    !   -------
    1617
    17   !   *****************************************************************
    18   !   ..... calcul du terme de pression (gradient de p/densite )   et
    19   !      du terme de ( -gradient de la fonction de Bernouilli ) ...
    20   !   *****************************************************************
    21   !      Ces termes sont ajoutes a  d(ucov)/dt et a d(vcov)/dt  ..
     18    !   Objet:
     19    !   ------
     20
     21    !   *****************************************************************
     22    !   ..... calcul du terme de pression (gradient de p/densite )   et
     23    !      du terme de ( -gradient de la fonction de Bernouilli ) ...
     24    !   *****************************************************************
     25    !      Ces termes sont ajoutes a  d(ucov)/dt et a d(vcov)/dt  ..
    2226
    2327
    24   !    teta , pkf, bern  sont des arguments d'entree  pour le s-pg  ....
    25   !    du et dv          sont des arguments de sortie pour le s-pg  ....
     28    !    teta , pkf, bern  sont des arguments d'entree  pour le s-pg  ....
     29    !    du et dv          sont des arguments de sortie pour le s-pg  ....
    2630
    27   !=======================================================================
    28   !
     31    !=======================================================================
     32    !
     33
     34    REAL :: teta(ip1jmp1, llm), pkf(ip1jmp1, llm), bern(ip1jmp1, llm), &
     35            du(ip1jmp1, llm), dv(ip1jm, llm)
     36    INTEGER :: l, ij
     37
     38    DO l = 1, llm
     39
     40      DO ij = iip2, ip1jm - 1
     41        du(ij, l) = du(ij, l) + 0.5 * (teta(ij, l) + teta(ij + 1, l)) * &
     42                (pkf(ij, l) - pkf(ij + 1, l)) + bern(ij, l) - bern(ij + 1, l)
     43      END DO
    2944
    3045
     46      !    .....  correction  pour du(iip1,j,l),  j=2,jjm   ......
     47      !    ...          du(iip1,j,l) = du(1,j,l)                 ...
    3148
    32   REAL :: teta(ip1jmp1, llm), pkf(ip1jmp1, llm), bern(ip1jmp1, llm), &
    33           du(ip1jmp1, llm), dv(ip1jm, llm)
    34   INTEGER :: l, ij
     49      !DIR$ IVDEP
     50      DO ij = iip1 + iip1, ip1jm, iip1
     51        du(ij, l) = du(ij - iim, l)
     52      END DO
     53
     54      DO ij = 1, ip1jm
     55        dv(ij, l) = dv(ij, l) + 0.5 * (teta(ij, l) + teta(ij + iip1, l)) * &
     56                (pkf(ij + iip1, l) - pkf(ij, l)) &
     57                + bern(ij + iip1, l) - bern(ij, l)
     58      END DO
     59
     60    END DO
     61    !
     62
     63  END SUBROUTINE dudv2
    3564
    3665
    37   DO l = 1, llm
    38 
    39     DO ij = iip2, ip1jm - 1
    40       du(ij, l) = du(ij, l) + 0.5 * (teta(ij, l) + teta(ij + 1, l)) * &
    41               (pkf(ij, l) - pkf(ij + 1, l)) + bern(ij, l) - bern(ij + 1, l)
    42     END DO
    43 
    44 
    45     !    .....  correction  pour du(iip1,j,l),  j=2,jjm   ......
    46     !    ...          du(iip1,j,l) = du(1,j,l)                 ...
    47 
    48     !DIR$ IVDEP
    49     DO ij = iip1 + iip1, ip1jm, iip1
    50       du(ij, l) = du(ij - iim, l)
    51     END DO
    52 
    53 
    54     DO ij = 1, ip1jm
    55       dv(ij, l) = dv(ij, l) + 0.5 * (teta(ij, l) + teta(ij + iip1, l)) * &
    56               (pkf(ij + iip1, l) - pkf(ij, l)) &
    57               + bern(ij + iip1, l) - bern(ij, l)
    58     END DO
    59 
    60   END DO
    61   !
    62 
    63 END SUBROUTINE dudv2
     66END MODULE lmdz_dudv2
Note: See TracChangeset for help on using the changeset viewer.