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/advect.F90

    r5102 r5103  
    1 
    21! $Header$
    32
    4       SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta)
     3SUBROUTINE advect(ucov, vcov, teta, w, massebx, masseby, du, dv, dteta)
    54
    6       USE comconst_mod, ONLY: daysec
    7       USE logic_mod, ONLY: conser
    8       USE ener_mod, ONLY: gtot
    9      
    10       IMPLICIT NONE
    11 c=======================================================================
    12 c
    13 c   Auteurs:  P. Le Van , Fr. Hourdin  .
    14 c   -------
    15 c
    16 c   Objet:
    17 c   ------
    18 c
    19 c   *************************************************************
    20 c   .... calcul des termes d'advection vertic.pour u,v,teta,q ...
    21 c   *************************************************************
    22 c        ces termes sont ajoutes a du,dv,dteta et dq .
    23 c  Modif F.Forget 03/94 : on retire q de advect
    24 c
    25 c=======================================================================
    26 c-----------------------------------------------------------------------
    27 c   Declarations:
    28 c   -------------
     5  USE comconst_mod, ONLY: daysec
     6  USE logic_mod, ONLY: conser
     7  USE ener_mod, ONLY: gtot
    298
    30       include "dimensions.h"
    31       include "paramet.h"
    32       include "comgeom.h"
     9  IMPLICIT NONE
     10  !=======================================================================
     11  !
     12  !   Auteurs:  P. Le Van , Fr. Hourdin  .
     13  !   -------
     14  !
     15  !   Objet:
     16  !   ------
     17  !
     18  !   *************************************************************
     19  !   .... calcul des termes d'advection vertic.pour u,v,teta,q ...
     20  !   *************************************************************
     21  !    ces termes sont ajoutes a du,dv,dteta et dq .
     22  !  Modif F.Forget 03/94 : on retire q de advect
     23  !
     24  !=======================================================================
     25  !-----------------------------------------------------------------------
     26  !   Declarations:
     27  !   -------------
    3328
    34 c   Arguments:
    35 c   ----------
     29  include "dimensions.h"
     30  include "paramet.h"
     31  include "comgeom.h"
    3632
    37       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    38       REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
    39       REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
     33  !   Arguments:
     34  !   ----------
    4035
    41 c   Local:
    42 c   ------
     36  REAL :: vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
     37  REAL :: massebx(ip1jmp1, llm), masseby(ip1jm, llm), w(ip1jmp1, llm)
     38  REAL :: dv(ip1jm, llm), du(ip1jmp1, llm), dteta(ip1jmp1, llm)
    4339
    44       REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
    45       REAL unsaire2(ip1jmp1), ge(ip1jmp1)
    46       REAL deuxjour, ww, gt, uu, vv
     40  !   Local:
     41  !   ------
    4742
    48       INTEGER  ij,l
     43  REAL :: uav(ip1jmp1, llm), vav(ip1jm, llm), wsur2(ip1jmp1)
     44  REAL :: unsaire2(ip1jmp1), ge(ip1jmp1)
     45  REAL :: deuxjour, ww, gt, uu, vv
    4946
    50       REAL      SSUM
     47  INTEGER :: ij, l
    5148
    52 c-----------------------------------------------------------------------
    53 c   2. Calculs preliminaires:
    54 c   -------------------------
     49  REAL :: SSUM
    5550
    56       IF (conser)  THEN
    57          deuxjour = 2. * daysec
     51  !-----------------------------------------------------------------------
     52  !   2. Calculs preliminaires:
     53  !   -------------------------
    5854
    59          DO   ij   = 1, ip1jmp1
    60          unsaire2(ij) = unsaire(ij) * unsaire(ij)
    61       END DO
    62       END IF
     55  IF (conser)  THEN
     56    deuxjour = 2. * daysec
     57
     58    DO   ij = 1, ip1jmp1
     59      unsaire2(ij) = unsaire(ij) * unsaire(ij)
     60    END DO
     61  END IF
    6362
    6463
    65 c------------------  -yy ----------------------------------------------
    66 c   .  Calcul de     u
     64  !------------------  -yy ----------------------------------------------
     65  !   .  Calcul de     u
    6766
    68       DO  l=1,llm
    69          DO    ij    = iip2, ip1jmp1
    70             uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
    71          ENDDO
    72          DO    ij    = iip2, ip1jm
    73             uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
    74          ENDDO
    75          DO      ij        = 1, iip1
    76             uav(ij      ,l) = 0.
    77             uav(ip1jm+ij,l) = 0.
    78          ENDDO
    79       ENDDO
     67  DO  l = 1, llm
     68    DO    ij = iip2, ip1jmp1
     69      uav(ij, l) = 0.25 * (ucov(ij, l) + ucov(ij - iip1, l))
     70    ENDDO
     71    DO    ij = iip2, ip1jm
     72      uav(ij, l) = uav(ij, l) + uav(ij + iip1, l)
     73    ENDDO
     74    DO      ij = 1, iip1
     75      uav(ij, l) = 0.
     76      uav(ip1jm + ij, l) = 0.
     77    ENDDO
     78  ENDDO
    8079
    81 c------------------  -xx ----------------------------------------------
    82 c   .  Calcul de     v
     80  !------------------  -xx ----------------------------------------------
     81  !   .  Calcul de     v
    8382
    84       DO  l=1,llm
    85          DO    ij  = 2, ip1jm
    86           vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
    87          ENDDO
    88          DO    ij   = 1,ip1jm,iip1
    89           vav(ij,l) = vav(ij+iim,l)
    90          ENDDO
    91          DO    ij   = 1, ip1jm-1
    92           vav(ij,l) = vav(ij,l) + vav(ij+1,l)
    93          ENDDO
    94          DO    ij      = 1, ip1jm, iip1
    95           vav(ij+iim,l) = vav(ij,l)
    96          ENDDO
    97       ENDDO
     83  DO  l = 1, llm
     84    DO    ij = 2, ip1jm
     85      vav(ij, l) = 0.25 * (vcov(ij, l) + vcov(ij - 1, l))
     86    ENDDO
     87    DO    ij = 1, ip1jm, iip1
     88      vav(ij, l) = vav(ij + iim, l)
     89    ENDDO
     90    DO    ij = 1, ip1jm - 1
     91      vav(ij, l) = vav(ij, l) + vav(ij + 1, l)
     92    ENDDO
     93    DO    ij = 1, ip1jm, iip1
     94      vav(ij + iim, l) = vav(ij, l)
     95    ENDDO
     96  ENDDO
    9897
    99 c-----------------------------------------------------------------------
     98  !-----------------------------------------------------------------------
    10099
    101 c
    102       DO l = 1, llmm1
     100  !
     101  DO l = 1, llmm1
    103102
    104103
    105 c      ......   calcul de  - w/2.    au niveau  l+1   .......
     104    ! ......   calcul de  - w/2.    au niveau  l+1   .......
    106105
    107       DO ij  = 1, ip1jmp1
    108       wsur2( ij ) = - 0.5 * w( ij,l+1 )
    109       END DO
     106    DO ij = 1, ip1jmp1
     107      wsur2(ij) = - 0.5 * w(ij, l + 1)
     108    END DO
    110109
    111110
    112 c    .....................     calcul pour  du     ..................
     111    ! .....................     calcul pour  du     ..................
    113112
    114       DO ij = iip2 ,ip1jm-1
    115       ww        = wsur2 (  ij  )     + wsur2( ij+1 )
    116       uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
    117       du(ij,l)  = du(ij,l)   - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
    118       du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
     113    DO ij = iip2, ip1jm - 1
     114      ww = wsur2 (ij) + wsur2(ij + 1)
     115      uu = 0.5 * (ucov(ij, l) + ucov(ij, l + 1))
     116      du(ij, l) = du(ij, l) - ww * (uu - uav(ij, l)) / massebx(ij, l)
     117      du(ij, l + 1) = du(ij, l + 1) + ww * (uu - uav(ij, l + 1)) / massebx(ij, l + 1)
     118    END DO
     119
     120    ! .....  correction pour  du(iip1,j,l)  ........
     121    ! .....     du(iip1,j,l)= du(1,j,l)   .....
     122
     123    !DIR$ IVDEP
     124    DO   ij = iip1 + iip1, ip1jm, iip1
     125      du(ij, l) = du(ij - iim, l)
     126      du(ij, l + 1) = du(ij - iim, l + 1)
     127    END DO
     128
     129    ! .................    calcul pour   dv      .....................
     130
     131    DO ij = 1, ip1jm
     132      ww = wsur2(ij + iip1) + wsur2(ij)
     133      vv = 0.5 * (vcov(ij, l) + vcov(ij, l + 1))
     134      dv(ij, l) = dv(ij, l) - ww * (vv - vav(ij, l)) / masseby(ij, l)
     135      dv(ij, l + 1) = dv(ij, l + 1) + ww * (vv - vav(ij, l + 1)) / masseby(ij, l + 1)
     136    END DO
     137
     138    !
     139
     140    ! ............................................................
     141    ! ...............    calcul pour   dh      ...................
     142    ! ............................................................
     143
     144    !                   ---z
     145    !   calcul de  - d( teta  * w )      qu'on ajoute a   dh
     146    !               ...............
     147
     148    DO ij = 1, ip1jmp1
     149      ww = wsur2(ij) * (teta(ij, l) + teta(ij, l + 1))
     150      dteta(ij, l) = dteta(ij, l) - ww
     151      dteta(ij, l + 1) = dteta(ij, l + 1) + ww
     152    END DO
     153
     154    IF(conser)  THEN
     155      DO ij = 1, ip1jmp1
     156        ge(ij) = wsur2(ij) * wsur2(ij) * unsaire2(ij)
    119157      END DO
     158      gt = SSUM(ip1jmp1, ge, 1)
     159      gtot(l) = deuxjour * SQRT(gt / ip1jmp1)
     160    END IF
    120161
    121 c     .....  correction pour  du(iip1,j,l)  ........
    122 c     .....     du(iip1,j,l)= du(1,j,l)   .....
     162  END DO
    123163
    124 CDIR$ IVDEP
    125       DO   ij   = iip1 +iip1, ip1jm, iip1
    126       du( ij, l  ) = du( ij -iim, l  )
    127       du( ij,l+1 ) = du( ij -iim,l+1 )
    128       END DO
    129 
    130 c     .................    calcul pour   dv      .....................
    131 
    132       DO ij = 1, ip1jm
    133       ww        = wsur2( ij+iip1 )   + wsur2( ij )
    134       vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
    135       dv(ij,l)  = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
    136       dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
    137       END DO
    138 
    139 c
    140 
    141 c     ............................................................
    142 c     ...............    calcul pour   dh      ...................
    143 c     ............................................................
    144 
    145 c                       ---z
    146 c       calcul de  - d( teta  * w )      qu'on ajoute a   dh
    147 c                   ...............
    148 
    149         DO ij = 1, ip1jmp1
    150          ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
    151          dteta(ij, l ) = dteta(ij, l )  -  ww
    152          dteta(ij,l+1) = dteta(ij,l+1)  +  ww
    153       END DO
    154 
    155       IF( conser)  THEN
    156         DO ij = 1,ip1jmp1
    157         ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
    158       END DO
    159         gt       = SSUM( ip1jmp1,ge,1 )
    160         gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
    161       END IF
    162 
    163       END DO
    164  
    165       RETURN
    166       END
     164  RETURN
     165END SUBROUTINE advect
Note: See TracChangeset for help on using the changeset viewer.