Ignore:
Timestamp:
Jul 23, 2024, 3:29:36 PM (8 weeks ago)
Author:
abarral
Message:

Handle CPP_INLANDSIS in lmdz_cppkeys_wrapper.F90
Remove obsolete key wrgrads_thermcell, _ADV_HALO, _ADV_HALLO, isminmax
Remove redundant uses of CPPKEY_INCA (thanks acozic)
Remove obsolete misc/write_field.F90
Remove unused ioipsl_* wrappers
Remove calls to WriteField_u with wrong signature
Convert .F -> .[fF]90
(lint) uppercase fortran operators
[note: 1d and iso still broken - working on it]

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/dissip.F90

    r5102 r5103  
    1 
    21! $Id$
    32
    4       SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
    5 c
    6       USE comconst_mod, ONLY: dtdiss
    7      
    8       IMPLICIT NONE
     3SUBROUTINE dissip(vcov, ucov, teta, p, dv, du, dh)
     4  !
     5  USE comconst_mod, ONLY: dtdiss
     6
     7  IMPLICIT NONE
    98
    109
    11 c ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
    12 c                                (  10/01/98  )
     10  ! ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
     11  ! (  10/01/98  )
    1312
    14 c=======================================================================
    15 c
    16 c   Auteur:  P. Le Van
    17 c   -------
    18 c
    19 c   Objet:
    20 c   ------
    21 c
    22 c   Dissipation horizontale
    23 c
    24 c=======================================================================
    25 c-----------------------------------------------------------------------
    26 c   Declarations:
    27 c   -------------
     13  !=======================================================================
     14  !
     15  !   Auteur:  P. Le Van
     16  !   -------
     17  !
     18  !   Objet:
     19  !   ------
     20  !
     21  !   Dissipation horizontale
     22  !
     23  !=======================================================================
     24  !-----------------------------------------------------------------------
     25  !   Declarations:
     26  !   -------------
    2827
    29       include "dimensions.h"
    30       include "paramet.h"
    31       include "comgeom.h"
    32       include "comdissnew.h"
    33       include "comdissipn.h"
     28  include "dimensions.h"
     29  include "paramet.h"
     30  include "comgeom.h"
     31  include "comdissnew.h"
     32  include "comdissipn.h"
    3433
    35 c   Arguments:
    36 c   ----------
     34  !   Arguments:
     35  !   ----------
    3736
    38       REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
    39       REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
    40       REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature
    41       REAL,INTENT(IN) :: p(ip1jmp1,llmp1) ! pressure
    42       ! tendencies (.../s) on covariant winds and potential temperature
    43       REAL,INTENT(OUT) :: dv(ip1jm,llm)
    44       REAL,INTENT(OUT) :: du(ip1jmp1,llm)
    45       REAL,INTENT(OUT) :: dh(ip1jmp1,llm)
     37  REAL, INTENT(IN) :: vcov(ip1jm, llm) ! covariant meridional wind
     38  REAL, INTENT(IN) :: ucov(ip1jmp1, llm) ! covariant zonal wind
     39  REAL, INTENT(IN) :: teta(ip1jmp1, llm) ! potential temperature
     40  REAL, INTENT(IN) :: p(ip1jmp1, llmp1) ! pressure
     41  ! ! tendencies (.../s) on covariant winds and potential temperature
     42  REAL, INTENT(OUT) :: dv(ip1jm, llm)
     43  REAL, INTENT(OUT) :: du(ip1jmp1, llm)
     44  REAL, INTENT(OUT) :: dh(ip1jmp1, llm)
    4645
    47 c   Local:
    48 c   ------
     46  !   Local:
     47  !   ------
    4948
    50       REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
    51       REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
    52       REAL te1dt(llm),te2dt(llm),te3dt(llm)
    53       REAL deltapres(ip1jmp1,llm)
     49  REAL :: gdx(ip1jmp1, llm), gdy(ip1jm, llm)
     50  REAL :: grx(ip1jmp1, llm), gry(ip1jm, llm)
     51  REAL :: te1dt(llm), te2dt(llm), te3dt(llm)
     52  REAL :: deltapres(ip1jmp1, llm)
    5453
    55       INTEGER l,ij
     54  INTEGER :: l, ij
    5655
    57       REAL SSUM
     56  REAL :: SSUM
    5857
    59 c-----------------------------------------------------------------------
    60 c   initialisations:
    61 c   ----------------
     58  !-----------------------------------------------------------------------
     59  !   initialisations:
     60  !   ----------------
    6261
    63       DO l=1,llm
    64          te1dt(l) = tetaudiv(l) * dtdiss
    65          te2dt(l) = tetaurot(l) * dtdiss
    66          te3dt(l) = tetah(l)    * dtdiss
     62  DO l = 1, llm
     63    te1dt(l) = tetaudiv(l) * dtdiss
     64    te2dt(l) = tetaurot(l) * dtdiss
     65    te3dt(l) = tetah(l) * dtdiss
     66  ENDDO
     67  du = 0.
     68  dv = 0.
     69  dh = 0.
     70
     71  !-----------------------------------------------------------------------
     72  !   Calcul de la dissipation:
     73  !   -------------------------
     74
     75  !   Calcul de la partie   grad  ( div ) :
     76  !   -------------------------------------
     77
     78  IF(lstardis) THEN
     79    CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy)
     80  ELSE
     81    CALL gradiv (llm, ucov, vcov, nitergdiv, gdx, gdy)
     82  ENDIF
     83
     84  DO l = 1, llm
     85
     86    DO ij = 1, iip1
     87      gdx(ij, l) = 0.
     88      gdx(ij + ip1jm, l) = 0.
     89    ENDDO
     90
     91    DO ij = iip2, ip1jm
     92      du(ij, l) = du(ij, l) - te1dt(l) * gdx(ij, l)
     93    ENDDO
     94    DO ij = 1, ip1jm
     95      dv(ij, l) = dv(ij, l) - te1dt(l) * gdy(ij, l)
     96    ENDDO
     97
     98  ENDDO
     99
     100  !   calcul de la partie   n X grad ( rot ):
     101  !   ---------------------------------------
     102
     103  IF(lstardis) THEN
     104    CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry)
     105  ELSE
     106    CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry)
     107  ENDIF
     108
     109  DO l = 1, llm
     110    DO ij = 1, iip1
     111      grx(ij, l) = 0.
     112    ENDDO
     113
     114    DO ij = iip2, ip1jm
     115      du(ij, l) = du(ij, l) - te2dt(l) * grx(ij, l)
     116    ENDDO
     117    DO ij = 1, ip1jm
     118      dv(ij, l) = dv(ij, l) - te2dt(l) * gry(ij, l)
     119    ENDDO
     120  ENDDO
     121
     122  !   calcul de la partie   div ( grad ):
     123  !   -----------------------------------
     124
     125  IF(lstardis) THEN
     126
     127    DO l = 1, llm
     128      DO ij = 1, ip1jmp1
     129        deltapres(ij, l) = AMAX1(0., p(ij, l) - p(ij, l + 1))
    67130      ENDDO
    68       du=0.
    69       dv=0.
    70       dh=0.
     131    ENDDO
    71132
    72 c-----------------------------------------------------------------------
    73 c   Calcul de la dissipation:
    74 c   -------------------------
     133    CALL divgrad2(llm, teta, deltapres, niterh, gdx)
     134  ELSE
     135    CALL divgrad (llm, teta, niterh, gdx)
     136  ENDIF
    75137
    76 c   Calcul de la partie   grad  ( div ) :
    77 c   -------------------------------------
     138  DO l = 1, llm
     139    DO ij = 1, ip1jmp1
     140      dh(ij, l) = dh(ij, l) - te3dt(l) * gdx(ij, l)
     141    ENDDO
     142  ENDDO
    78143
    79 
    80       IF(lstardis) THEN
    81          CALL gradiv2( llm,ucov,vcov,nitergdiv,gdx,gdy )
    82       ELSE
    83          CALL gradiv ( llm,ucov,vcov,nitergdiv,gdx,gdy )
    84       ENDIF
    85 
    86       DO l=1,llm
    87 
    88          DO ij = 1, iip1
    89             gdx(     ij ,l) = 0.
    90             gdx(ij+ip1jm,l) = 0.
    91          ENDDO
    92 
    93          DO ij = iip2,ip1jm
    94             du(ij,l) = du(ij,l) - te1dt(l) *gdx(ij,l)
    95          ENDDO
    96          DO ij = 1,ip1jm
    97             dv(ij,l) = dv(ij,l) - te1dt(l) *gdy(ij,l)
    98          ENDDO
    99 
    100        ENDDO
    101 
    102 c   calcul de la partie   n X grad ( rot ):
    103 c   ---------------------------------------
    104 
    105       IF(lstardis) THEN
    106          CALL nxgraro2( llm,ucov, vcov, nitergrot,grx,gry )
    107       ELSE
    108          CALL nxgrarot( llm,ucov, vcov, nitergrot,grx,gry )
    109       ENDIF
    110 
    111 
    112       DO l=1,llm
    113          DO ij = 1, iip1
    114             grx(ij,l) = 0.
    115          ENDDO
    116 
    117          DO ij = iip2,ip1jm
    118             du(ij,l) = du(ij,l) - te2dt(l) * grx(ij,l)
    119          ENDDO
    120          DO ij =  1, ip1jm
    121             dv(ij,l) = dv(ij,l) - te2dt(l) * gry(ij,l)
    122          ENDDO
    123       ENDDO
    124 
    125 c   calcul de la partie   div ( grad ):
    126 c   -----------------------------------
    127 
    128        
    129       IF(lstardis) THEN
    130 
    131        DO l = 1, llm
    132           DO ij = 1, ip1jmp1
    133             deltapres(ij,l) = AMAX1( 0.,  p(ij,l) - p(ij,l+1) )
    134           ENDDO
    135        ENDDO
    136 
    137          CALL divgrad2( llm,teta, deltapres  ,niterh, gdx )
    138       ELSE
    139          CALL divgrad ( llm,teta, niterh, gdx        )
    140       ENDIF
    141 
    142       DO l = 1,llm
    143          DO ij = 1,ip1jmp1
    144             dh( ij,l ) = dh( ij,l ) - te3dt(l) * gdx( ij,l )
    145          ENDDO
    146       ENDDO
    147 
    148       RETURN
    149       END
     144  RETURN
     145END SUBROUTINE dissip
Note: See TracChangeset for help on using the changeset viewer.