Ignore:
Timestamp:
Jul 23, 2024, 7:14:34 PM (8 weeks ago)
Author:
abarral
Message:

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/divgrad2.f90

    r5104 r5105  
    22! $Header$
    33
    4       SUBROUTINE divgrad2 ( klevel, h, deltapres, lh, divgra )
    5 c
    6 c    P. Le Van
    7 c
    8 c   ***************************************************************
    9 c
    10 c    .....   calcul de  (div( grad ))   de (  pext * h ) .....
    11 c   ****************************************************************
    12 c   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
    13 c         divgra     est  un argument  de sortie pour le s-prg
    14 c
    15       IMPLICIT NONE
    16 c
    17       INCLUDE "dimensions.h"
    18       INCLUDE "paramet.h"
    19       INCLUDE "comgeom2.h"
    20       INCLUDE "comdissipn.h"
     4SUBROUTINE divgrad2 ( klevel, h, deltapres, lh, divgra )
     5  !
     6  ! P. Le Van
     7  !
     8  !   ***************************************************************
     9  !
     10  ! .....   calcul de  (div( grad ))   de (  pext * h ) .....
     11  !   ****************************************************************
     12  !   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
     13  !     divgra     est  un argument  de sortie pour le s-prg
     14  !
     15  IMPLICIT NONE
     16  !
     17  INCLUDE "dimensions.h"
     18  INCLUDE "paramet.h"
     19  INCLUDE "comgeom2.h"
     20  INCLUDE "comdissipn.h"
    2121
    22 c    .......    variables en arguments   .......
    23 c
    24       INTEGER klevel
    25       REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
    26       REAL divgra( ip1jmp1,klevel)
    27 c
    28 c    .......    variables  locales    ..........
    29 c
    30       REAL    signe, nudivgrs, sqrtps( ip1jmp1,llm )
    31       INTEGER l,ij,iter,lh
    32 c    ...................................................................
     22  !    .......    variables en arguments   .......
     23  !
     24  INTEGER :: klevel
     25  REAL :: h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
     26  REAL :: divgra( ip1jmp1,klevel)
     27  !
     28  !    .......    variables  locales    ..........
     29  !
     30  REAL :: signe, nudivgrs, sqrtps( ip1jmp1,llm )
     31  INTEGER :: l,ij,iter,lh
     32  !    ...................................................................
    3333
    34 c
    35       signe    = (-1.)**lh
    36       nudivgrs = signe * cdivh
     34  !
     35  signe    = (-1.)**lh
     36  nudivgrs = signe * cdivh
    3737
    38       CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
     38  CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
    3939
    40 c
    41       CALL laplacien( klevel, divgra, divgra )
    42      
    43       DO l = 1, klevel
    44        DO ij = 1, ip1jmp1
    45         sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
    46        ENDDO
    47       ENDDO
    48 c
    49       DO l = 1, klevel
    50         DO ij = 1, ip1jmp1
    51          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
    52         ENDDO
    53       ENDDO
    54    
    55 c    ........    Iteration de l'operateur  laplacien_gam    ........
    56 c
    57       DO  iter = 1, lh - 2
    58        CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
    59      *                     unsapolnga2, unsapolsga2,  divgra, divgra )
    60       ENDDO
    61 c
    62 c    ...............................................................
    63  
    64       DO l = 1, klevel
    65         DO ij = 1, ip1jmp1
    66           divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
    67         ENDDO
    68       ENDDO
    69 c
    70       CALL laplacien ( klevel, divgra, divgra )
    71 c
    72       DO l  = 1,klevel
    73       DO ij = 1,ip1jmp1
    74       divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
    75       ENDDO
    76       ENDDO
     40  !
     41  CALL laplacien( klevel, divgra, divgra )
    7742
    78       RETURN
    79       END
     43  DO l = 1, klevel
     44   DO ij = 1, ip1jmp1
     45    sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
     46   ENDDO
     47  ENDDO
     48  !
     49  DO l = 1, klevel
     50    DO ij = 1, ip1jmp1
     51     divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
     52    ENDDO
     53  ENDDO
     54
     55  !    ........    Iteration de l'operateur  laplacien_gam    ........
     56  !
     57  DO  iter = 1, lh - 2
     58   CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2, &
     59         unsapolnga2, unsapolsga2,  divgra, divgra )
     60  ENDDO
     61  !
     62  !    ...............................................................
     63
     64  DO l = 1, klevel
     65    DO ij = 1, ip1jmp1
     66      divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
     67    ENDDO
     68  ENDDO
     69  !
     70  CALL laplacien ( klevel, divgra, divgra )
     71  !
     72  DO l  = 1,klevel
     73  DO ij = 1,ip1jmp1
     74  divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
     75  ENDDO
     76  ENDDO
     77
     78  RETURN
     79END SUBROUTINE divgrad2
Note: See TracChangeset for help on using the changeset viewer.