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/dyn3dmem/addfi_loc.f90

    r5104 r5105  
    22! $Id$
    33
    4       SUBROUTINE addfi_loc(pdt, leapf, forward,
    5      S          pucov, pvcov, pteta, pq   , pps ,
    6      S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
    7       USE parallel_lmdz
    8       USE infotrac, ONLY: nqtot
    9       USE control_mod, ONLY: planet_type
    10       IMPLICIT NONE
    11 c
    12 c=======================================================================
    13 c
    14 c    Addition of the physical tendencies
    15 c
    16 c    Interface :
    17 c    -----------
    18 c
    19 c      Input :
    20 c      -------
    21 c      pdt                    time step of integration
    22 c      leapf                  logical
    23 c      forward                logical
    24 c      pucov(ip1jmp1,llm)     first component of the covariant velocity
    25 c      pvcov(ip1ip1jm,llm)    second component of the covariant velocity
    26 c      pteta(ip1jmp1,llm)     potential temperature
    27 c      pts(ip1jmp1,llm)       surface temperature
    28 c      pdufi(ip1jmp1,llm)     |
    29 c      pdvfi(ip1jm,llm)       |   respective
    30 c      pdhfi(ip1jmp1)         |      tendencies
    31 c      pdtsfi(ip1jmp1)        |
    32 c
    33 c      Output :
    34 c      --------
    35 c      pucov
    36 c      pvcov
    37 c      ph
    38 c      pts
    39 c
    40 c
    41 c=======================================================================
    42 c
    43 c-----------------------------------------------------------------------
    44 c
    45 c    0.  Declarations :
    46 c    ------------------
    47 c
    48       include "dimensions.h"
    49       include "paramet.h"
    50       include "comgeom.h"
    51 c
    52 c    Arguments :
    53 c    -----------
    54 c
    55       REAL,INTENT(IN) :: pdt ! time step for the integration (s)
    56 c
    57       REAL,INTENT(INOUT) :: pvcov(ijb_v:ije_v,llm) ! covariant meridional wind
    58       REAL,INTENT(INOUT) :: pucov(ijb_u:ije_u,llm) ! covariant zonal wind
    59       REAL,INTENT(INOUT) :: pteta(ijb_u:ije_u,llm) ! potential temperature
    60       REAL,INTENT(INOUT) :: pq(ijb_u:ije_u,llm,nqtot) ! tracers
    61       REAL,INTENT(INOUT) :: pps(ijb_u:ije_u) ! surface pressure (Pa)
    62 c respective tendencies (.../s) to add
    63       REAL,INTENT(IN) :: pdvfi(ijb_v:ije_v,llm)
    64       REAL,INTENT(IN) :: pdufi(ijb_u:ije_u,llm)
    65       REAL,INTENT(IN) :: pdqfi(ijb_u:ije_u,llm,nqtot)
    66       REAL,INTENT(IN) :: pdhfi(ijb_u:ije_u,llm)
    67       REAL,INTENT(IN) :: pdpfi(ijb_u:ije_u)
    68 c
    69       LOGICAL,INTENT(IN) :: leapf,forward ! not used
    70 c
    71 c
    72 c    Local variables :
    73 c    -----------------
    74 c
    75       REAL xpn(iim),xps(iim),tpn,tps
    76       INTEGER j,k,iq,ij
    77       REAL,PARAMETER :: qtestw = 1.0e-15
    78       REAL,PARAMETER :: qtestt = 1.0e-40
    79 
    80       REAL SSUM
    81       EXTERNAL SSUM
    82      
    83       INTEGER :: ijb,ije
    84 c
    85 c-----------------------------------------------------------------------
    86      
    87       ijb=ij_begin
    88       ije=ij_end
    89      
    90 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    91       DO k = 1,llm
    92          DO j = ijb,ije
    93             pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
    94          ENDDO
     4SUBROUTINE addfi_loc(pdt, leapf, forward, &
     5        pucov, pvcov, pteta, pq   , pps , &
     6        pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
     7  USE parallel_lmdz
     8  USE infotrac, ONLY: nqtot
     9  USE control_mod, ONLY: planet_type
     10  IMPLICIT NONE
     11  !
     12  !=======================================================================
     13  !
     14  !    Addition of the physical tendencies
     15  !
     16  !    Interface :
     17  !    -----------
     18  !
     19  !  Input :
     20  !  -------
     21  !  pdt                    time step of integration
     22  !  leapf                  logical
     23  !  forward                logical
     24  !  pucov(ip1jmp1,llm)     first component of the covariant velocity
     25  !  pvcov(ip1ip1jm,llm)    second component of the covariant velocity
     26  !  pteta(ip1jmp1,llm)     potential temperature
     27  !  pts(ip1jmp1,llm)       surface temperature
     28  !  pdufi(ip1jmp1,llm)     |
     29  !  pdvfi(ip1jm,llm)       |   respective
     30  !  pdhfi(ip1jmp1)         |      tendencies
     31  !  pdtsfi(ip1jmp1)        |
     32  !
     33  !  Output :
     34  !  --------
     35  !  pucov
     36  !  pvcov
     37  !  ph
     38  !  pts
     39  !
     40  !
     41  !=======================================================================
     42  !
     43  !-----------------------------------------------------------------------
     44  !
     45  !    0.  Declarations :
     46  !    ------------------
     47  !
     48  include "dimensions.h"
     49  include "paramet.h"
     50  include "comgeom.h"
     51  !
     52  !    Arguments :
     53  !    -----------
     54  !
     55  REAL,INTENT(IN) :: pdt ! time step for the integration (s)
     56  !
     57  REAL,INTENT(INOUT) :: pvcov(ijb_v:ije_v,llm) ! covariant meridional wind
     58  REAL,INTENT(INOUT) :: pucov(ijb_u:ije_u,llm) ! covariant zonal wind
     59  REAL,INTENT(INOUT) :: pteta(ijb_u:ije_u,llm) ! potential temperature
     60  REAL,INTENT(INOUT) :: pq(ijb_u:ije_u,llm,nqtot) ! tracers
     61  REAL,INTENT(INOUT) :: pps(ijb_u:ije_u) ! surface pressure (Pa)
     62  ! respective tendencies (.../s) to add
     63  REAL,INTENT(IN) :: pdvfi(ijb_v:ije_v,llm)
     64  REAL,INTENT(IN) :: pdufi(ijb_u:ije_u,llm)
     65  REAL,INTENT(IN) :: pdqfi(ijb_u:ije_u,llm,nqtot)
     66  REAL,INTENT(IN) :: pdhfi(ijb_u:ije_u,llm)
     67  REAL,INTENT(IN) :: pdpfi(ijb_u:ije_u)
     68  !
     69  LOGICAL,INTENT(IN) :: leapf,forward ! not used
     70  !
     71  !
     72  !    Local variables :
     73  !    -----------------
     74  !
     75  REAL :: xpn(iim),xps(iim),tpn,tps
     76  INTEGER :: j,k,iq,ij
     77  REAL,PARAMETER :: qtestw = 1.0e-15
     78  REAL,PARAMETER :: qtestt = 1.0e-40
     79
     80  REAL :: SSUM
     81  EXTERNAL SSUM
     82
     83  INTEGER :: ijb,ije
     84  !
     85  !-----------------------------------------------------------------------
     86
     87  ijb=ij_begin
     88  ije=ij_end
     89
     90!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     91  DO k = 1,llm
     92     DO j = ijb,ije
     93        pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
     94     ENDDO
     95  ENDDO
     96!$OMP END DO NOWAIT
     97
     98  if (pole_nord) then
     99!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     100    DO  k    = 1, llm
     101     DO  ij   = 1, iim
     102       xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
     103     ENDDO
     104     tpn      = SSUM(iim,xpn,1)/ apoln
     105
     106     DO ij   = 1, iip1
     107       pteta(   ij   ,k)  = tpn
     108     ENDDO
     109   ENDDO
     110!$OMP END DO NOWAIT
     111  endif
     112
     113  if (pole_sud) then
     114!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     115    DO  k    = 1, llm
     116     DO  ij   = 1, iim
     117       xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
     118     ENDDO
     119     tps      = SSUM(iim,xps,1)/ apols
     120
     121     DO ij   = 1, iip1
     122       pteta(ij+ip1jm,k)  = tps
     123     ENDDO
     124   ENDDO
     125!$OMP END DO NOWAIT
     126  endif
     127  !
     128
     129  ijb=ij_begin
     130  ije=ij_end
     131  if (pole_nord) ijb=ij_begin+iip1
     132  if (pole_sud)  ije=ij_end-iip1
     133
     134!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     135  DO k = 1,llm
     136     DO j = ijb,ije
     137        pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
     138     ENDDO
     139  ENDDO
     140!$OMP END DO NOWAIT
     141
     142  if (pole_nord) ijb=ij_begin
     143
     144!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     145  DO k = 1,llm
     146     DO j = ijb,ije
     147        pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
     148     ENDDO
     149  ENDDO
     150!$OMP END DO NOWAIT
     151
     152  !
     153  if (pole_sud)  ije=ij_end
     154!$OMP MASTER
     155  DO j = ijb,ije
     156     pps(j) = pps(j) + pdpfi(j) * pdt
     157  ENDDO
     158!$OMP END MASTER
     159
     160  if (planet_type=="earth") then
     161  ! ! earth case, special treatment for first 2 tracers (water)
     162  DO iq = 1, 2
     163!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     164     DO k = 1,llm
     165        DO j = ijb,ije
     166           pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
     167           pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
     168        ENDDO
     169     ENDDO
     170!$OMP END DO NOWAIT
     171  ENDDO
     172
     173  DO iq = 3, nqtot
     174!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     175     DO k = 1,llm
     176        DO j = ijb,ije
     177           pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
     178           pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
     179        ENDDO
     180     ENDDO
     181!$OMP END DO NOWAIT
     182  ENDDO
     183  else
     184  ! ! general case, treat all tracers equally)
     185   DO iq = 1, nqtot
     186!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     187     DO k = 1,llm
     188        DO j = ijb,ije
     189           pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
     190           pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
     191        ENDDO
     192     ENDDO
     193!$OMP END DO NOWAIT
     194   ENDDO
     195  endif ! of if (planet_type=="earth")
     196
     197!$OMP MASTER
     198  if (pole_nord) then
     199
     200    DO  ij   = 1, iim
     201      xpn(ij) = aire(   ij   ) * pps(  ij     )
     202    ENDDO
     203
     204    tpn      = SSUM(iim,xpn,1)/apoln
     205
     206    DO ij   = 1, iip1
     207      pps (   ij     )  = tpn
     208    ENDDO
     209
     210  endif
     211
     212  if (pole_sud) then
     213
     214    DO  ij   = 1, iim
     215      xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
     216    ENDDO
     217
     218    tps      = SSUM(iim,xps,1)/apols
     219
     220    DO ij   = 1, iip1
     221      pps ( ij+ip1jm )  = tps
     222    ENDDO
     223
     224  endif
     225!$OMP END MASTER
     226
     227  if (pole_nord) then
     228    DO iq = 1, nqtot
     229!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     230      DO  k    = 1, llm
     231        DO  ij   = 1, iim
     232          xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
     233        ENDDO
     234        tpn      = SSUM(iim,xpn,1)/apoln
     235
     236        DO ij   = 1, iip1
     237          pq (   ij   ,k,iq)  = tpn
     238        ENDDO
    95239      ENDDO
    96 c$OMP END DO NOWAIT
    97 
    98       if (pole_nord) then
    99 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    100         DO  k    = 1, llm
    101          DO  ij   = 1, iim
    102            xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
    103          ENDDO
    104          tpn      = SSUM(iim,xpn,1)/ apoln
    105 
    106          DO ij   = 1, iip1
    107            pteta(   ij   ,k)  = tpn
    108          ENDDO
    109        ENDDO
    110 c$OMP END DO NOWAIT
    111       endif
    112 
    113       if (pole_sud) then
    114 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    115         DO  k    = 1, llm
    116          DO  ij   = 1, iim
    117            xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
    118          ENDDO
    119          tps      = SSUM(iim,xps,1)/ apols
    120 
    121          DO ij   = 1, iip1
    122            pteta(ij+ip1jm,k)  = tps
    123          ENDDO
    124        ENDDO
    125 c$OMP END DO NOWAIT
    126       endif
    127 c
    128 
    129       ijb=ij_begin
    130       ije=ij_end
    131       if (pole_nord) ijb=ij_begin+iip1
    132       if (pole_sud)  ije=ij_end-iip1
    133 
    134 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    135       DO k = 1,llm
    136          DO j = ijb,ije
    137             pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
    138          ENDDO
     240!$OMP END DO NOWAIT     
     241    ENDDO
     242  endif
     243
     244  if (pole_sud) then
     245    DO iq = 1, nqtot
     246!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     247      DO  k    = 1, llm
     248        DO  ij   = 1, iim
     249          xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
     250        ENDDO
     251        tps      = SSUM(iim,xps,1)/apols
     252
     253        DO ij   = 1, iip1
     254          pq (ij+ip1jm,k,iq)  = tps
     255        ENDDO
    139256      ENDDO
    140 c$OMP END DO NOWAIT
    141 
    142       if (pole_nord) ijb=ij_begin
    143 
    144 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    145       DO k = 1,llm
    146          DO j = ijb,ije
    147             pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
    148          ENDDO
    149       ENDDO
    150 c$OMP END DO NOWAIT
    151 
    152 c
    153       if (pole_sud)  ije=ij_end
    154 c$OMP MASTER
    155       DO j = ijb,ije
    156          pps(j) = pps(j) + pdpfi(j) * pdt
    157       ENDDO
    158 c$OMP END MASTER
    159  
    160       if (planet_type=="earth") then
    161       ! earth case, special treatment for first 2 tracers (water)
    162       DO iq = 1, 2
    163 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    164          DO k = 1,llm
    165             DO j = ijb,ije
    166                pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
    167                pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
    168             ENDDO
    169          ENDDO
    170 c$OMP END DO NOWAIT
    171       ENDDO
    172 
    173       DO iq = 3, nqtot
    174 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    175          DO k = 1,llm
    176             DO j = ijb,ije
    177                pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
    178                pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
    179             ENDDO
    180          ENDDO
    181 c$OMP END DO NOWAIT
    182       ENDDO
    183       else
    184       ! general case, treat all tracers equally)
    185        DO iq = 1, nqtot
    186 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    187          DO k = 1,llm
    188             DO j = ijb,ije
    189                pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
    190                pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
    191             ENDDO
    192          ENDDO
    193 c$OMP END DO NOWAIT
    194        ENDDO
    195       endif ! of if (planet_type=="earth")
    196 
    197 c$OMP MASTER
    198       if (pole_nord) then
    199      
    200         DO  ij   = 1, iim
    201           xpn(ij) = aire(   ij   ) * pps(  ij     )
    202         ENDDO
    203 
    204         tpn      = SSUM(iim,xpn,1)/apoln
    205 
    206         DO ij   = 1, iip1
    207           pps (   ij     )  = tpn
    208         ENDDO
    209      
    210       endif
    211 
    212       if (pole_sud) then
    213      
    214         DO  ij   = 1, iim
    215           xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
    216         ENDDO
    217 
    218         tps      = SSUM(iim,xps,1)/apols
    219 
    220         DO ij   = 1, iip1
    221           pps ( ij+ip1jm )  = tps
    222         ENDDO
    223      
    224       endif
    225 c$OMP END MASTER
    226 
    227       if (pole_nord) then
    228         DO iq = 1, nqtot
    229 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    230           DO  k    = 1, llm
    231             DO  ij   = 1, iim
    232               xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
    233             ENDDO
    234             tpn      = SSUM(iim,xpn,1)/apoln
    235  
    236             DO ij   = 1, iip1
    237               pq (   ij   ,k,iq)  = tpn
    238             ENDDO
    239           ENDDO
    240 c$OMP END DO NOWAIT       
    241         ENDDO
    242       endif
    243      
    244       if (pole_sud) then
    245         DO iq = 1, nqtot
    246 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    247           DO  k    = 1, llm
    248             DO  ij   = 1, iim
    249               xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
    250             ENDDO
    251             tps      = SSUM(iim,xps,1)/apols
    252  
    253             DO ij   = 1, iip1
    254               pq (ij+ip1jm,k,iq)  = tps
    255             ENDDO
    256           ENDDO
    257 c$OMP END DO NOWAIT       
    258         ENDDO
    259       endif
    260      
    261      
    262       RETURN
    263       END
     257!$OMP END DO NOWAIT     
     258    ENDDO
     259  endif
     260
     261
     262
     263END SUBROUTINE addfi_loc
Note: See TracChangeset for help on using the changeset viewer.