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/psextbar.f90

    r5104 r5105  
    22! $Header$
    33
    4       SUBROUTINE psextbar ( ps, psexbarxy )
    5       IMPLICIT NONE
     4SUBROUTINE psextbar ( ps, psexbarxy )
     5  IMPLICIT NONE
    66
    7 c=======================================================================
    8 c
    9 c   Auteur:  P. Le Van
    10 c   -------
    11 c
    12 c   Objet:
    13 c   ------
    14 c
    15 c **********************************************************************
    16 c calcul des moyennes en x et en y de (pression au sol*aire variable) ..
    17 c **********************************************************************
    18 c
    19 c         ps          est un  argum. d'entree  pour le s-pg ..
    20 c         psexbarxy   est un  argum. de sortie pour le s-pg ..
    21 c
    22 c   Methode:
    23 c   --------
    24 c
    25 c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
    26 c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
    27 c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
    28 c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
    29 c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
    30 c
    31 c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)       
    32 c
    33 c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
    34 c
    35 c
    36 c
    37 c   alpha4 .         . alpha1    . alpha4
    38 c    (i,j)             (i,j)       (i+1,j)
    39 c
    40 c             P .        U .          . P
    41 c           (i,j)       (i,j)         (i+1,j)
    42 c
    43 c   alpha3 .         . alpha2    .alpha3
    44 c    (i,j)              (i,j)     (i+1,j)
    45 c
    46 c             V .        Z .          . V
    47 c           (i,j)
    48 c
    49 c   alpha4 .         . alpha1    .alpha4
    50 c   (i,j+1)            (i,j+1)   (i+1,j+1)
    51 c
    52 c             P .        U .          . P
    53 c          (i,j+1)                    (i+1,j+1)
    54 c
    55 c
    56 c
    57 c
    58 c                       On  a :
    59 c
    60 c    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
    61 c                 Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
    62 c    localise  au point  ... U (i,j) ...
    63 c
    64 c    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
    65 c                 Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
    66 c    localise  au point  ... V (i,j) ...
    67 c
    68 c  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
    69 c               Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
    70 c    localise  au point  ... Z (i,j) ...
    71 c
    72 c
    73 c
    74 c=======================================================================
     7  !=======================================================================
     8  !
     9  !   Auteur:  P. Le Van
     10  !   -------
     11  !
     12  !   Objet:
     13  !   ------
     14  !
     15  ! **********************************************************************
     16  ! calcul des moyennes en x et en y de (pression au sol*aire variable) ..
     17  ! **********************************************************************
     18  !
     19  !     ps          est un  argum. d'entree  pour le s-pg ..
     20  !     psexbarxy   est un  argum. de sortie pour le s-pg ..
     21  !
     22  !   Methode:
     23  !   --------
     24  !
     25  !    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
     26  !   alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
     27  !   alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
     28  !   alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
     29  !   alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
     30  !
     31  !    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
     32  !
     33  !    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
     34  !
     35  !
     36  !
     37  !   alpha4 .         . alpha1    . alpha4
     38  !    (i,j)             (i,j)       (i+1,j)
     39  !
     40  !         P .        U .          . P
     41  !       (i,j)       (i,j)         (i+1,j)
     42  !
     43  !   alpha3 .         . alpha2    .alpha3
     44  !    (i,j)              (i,j)     (i+1,j)
     45  !
     46  !         V .        Z .          . V
     47  !       (i,j)
     48  !
     49  !   alpha4 .         . alpha1    .alpha4
     50  !   (i,j+1)            (i,j+1)   (i+1,j+1)
     51  !
     52  !         P .        U .          . P
     53  !      (i,j+1)                    (i+1,j+1)
     54  !
     55  !
     56  !
     57  !
     58  !                   On  a :
     59  !
     60  !    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
     61  !             Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
     62  ! localise  au point  ... U (i,j) ...
     63  !
     64  !    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
     65  !             Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)
     66  ! localise  au point  ... V (i,j) ...
     67  !
     68  !  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
     69  !           Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
     70  ! localise  au point  ... Z (i,j) ...
     71  !
     72  !
     73  !
     74  !=======================================================================
    7575
    7676
    77       INCLUDE "dimensions.h"
    78       INCLUDE "paramet.h"
    79       INCLUDE "comgeom.h"
     77  INCLUDE "dimensions.h"
     78  INCLUDE "paramet.h"
     79  INCLUDE "comgeom.h"
    8080
    81       REAL ps( ip1jmp1 ), psexbarxy ( ip1jm ), pext( ip1jmp1 )
     81  REAL :: ps( ip1jmp1 ), psexbarxy ( ip1jm ), pext( ip1jmp1 )
    8282
    83       INTEGER l, ij
    84 c
     83  INTEGER :: l, ij
     84  !
    8585
    86       DO ij = 1, ip1jmp1
    87        pext(ij) = ps(ij) * aire(ij)
    88       ENDDO
     86  DO ij = 1, ip1jmp1
     87   pext(ij) = ps(ij) * aire(ij)
     88  ENDDO
    8989
    9090
    91       DO     ij = 1, ip1jm - 1
    92       psexbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
    93      *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
    94       END DO
     91  DO     ij = 1, ip1jm - 1
     92  psexbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) + &
     93        pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
     94  END DO
    9595
    9696
    97 c    ....  correction pour     psexbarxy( iip1,j )  ........
     97  !    ....  correction pour     psexbarxy( iip1,j )  ........
    9898
    99 CDIR$ IVDEP
     99  !DIR$ IVDEP
    100100
    101       DO ij = iip1, ip1jm, iip1
    102       psexbarxy( ij ) = psexbarxy( ij - iim )
    103       END DO
     101  DO ij = iip1, ip1jm, iip1
     102  psexbarxy( ij ) = psexbarxy( ij - iim )
     103  END DO
    104104
    105105
    106       RETURN
    107       END
     106  RETURN
     107END SUBROUTINE psextbar
Note: See TracChangeset for help on using the changeset viewer.