Ignore:
Timestamp:
Jul 25, 2024, 8:45:50 AM (8 weeks ago)
Author:
abarral
Message:

Correct various minor mistakes from previous commits

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3dmem
Files:
14 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90

    r5117 r5123  
    1 
    21! $Id$
    32
    43SUBROUTINE addfi_loc(pdt, leapf, forward, &
    5         pucov, pvcov, pteta, pq   , pps , &
    6         pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
     4        pucov, pvcov, pteta, pq, pps, &
     5        pdufi, pdvfi, pdhfi, pdqfi, pdpfi)
    76  USE parallel_lmdz
    87  USE infotrac, ONLY: nqtot
    98  USE control_mod, ONLY: planet_type
     9  USE lmdz_ssum_scopy, ONLY: ssum
     10
    1011  IMPLICIT NONE
    1112  !
    … …  
    5354  !    -----------
    5455  !
    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)
     56  REAL, INTENT(IN) :: pdt ! time step for the integration (s)
     57  !
     58  REAL, INTENT(INOUT) :: pvcov(ijb_v:ije_v, llm) ! covariant meridional wind
     59  REAL, INTENT(INOUT) :: pucov(ijb_u:ije_u, llm) ! covariant zonal wind
     60  REAL, INTENT(INOUT) :: pteta(ijb_u:ije_u, llm) ! potential temperature
     61  REAL, INTENT(INOUT) :: pq(ijb_u:ije_u, llm, nqtot) ! tracers
     62  REAL, INTENT(INOUT) :: pps(ijb_u:ije_u) ! surface pressure (Pa)
    6263  ! 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
     64  REAL, INTENT(IN) :: pdvfi(ijb_v:ije_v, llm)
     65  REAL, INTENT(IN) :: pdufi(ijb_u:ije_u, llm)
     66  REAL, INTENT(IN) :: pdqfi(ijb_u:ije_u, llm, nqtot)
     67  REAL, INTENT(IN) :: pdhfi(ijb_u:ije_u, llm)
     68  REAL, INTENT(IN) :: pdpfi(ijb_u:ije_u)
     69  !
     70  LOGICAL, INTENT(IN) :: leapf, forward ! not used
    7071  !
    7172  !
    … …  
    7374  !    -----------------
    7475  !
    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
     76  REAL :: xpn(iim), xps(iim), tpn, tps
     77  INTEGER :: j, k, iq, ij
     78  REAL, PARAMETER :: qtestw = 1.0e-15
     79  REAL, PARAMETER :: qtestt = 1.0e-40
     80
     81  INTEGER :: ijb, ije
    8482  !
    8583  !-----------------------------------------------------------------------
    8684
    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
     85  ijb = ij_begin
     86  ije = ij_end
     87
     88  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     89  DO k = 1, llm
     90    DO j = ijb, ije
     91      pteta(j, k) = pteta(j, k) + pdhfi(j, k) * pdt
     92    ENDDO
     93  ENDDO
     94  !$OMP END DO NOWAIT
    9795
    9896  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
     97    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     98    DO  k = 1, llm
     99      DO  ij = 1, iim
     100        xpn(ij) = aire(ij) * pteta(ij, k)
     101      ENDDO
     102      tpn = SSUM(iim, xpn, 1) / apoln
     103
     104      DO ij = 1, iip1
     105        pteta(ij, k) = tpn
     106      ENDDO
     107    ENDDO
     108    !$OMP END DO NOWAIT
    111109  ENDIF
    112110
    113111  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
     112    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     113    DO  k = 1, llm
     114      DO  ij = 1, iim
     115        xps(ij) = aire(ij + ip1jm) * pteta(ij + ip1jm, k)
     116      ENDDO
     117      tps = SSUM(iim, xps, 1) / apols
     118
     119      DO ij = 1, iip1
     120        pteta(ij + ip1jm, k) = tps
     121      ENDDO
     122    ENDDO
     123    !$OMP END DO NOWAIT
     124  ENDIF
     125  !
     126
     127  ijb = ij_begin
     128  ije = ij_end
     129  IF (pole_nord) ijb = ij_begin + iip1
     130  IF (pole_sud)  ije = ij_end - iip1
     131
     132  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     133  DO k = 1, llm
     134    DO j = ijb, ije
     135      pucov(j, k) = pucov(j, k) + pdufi(j, k) * pdt
     136    ENDDO
     137  ENDDO
     138  !$OMP END DO NOWAIT
     139
     140  IF (pole_nord) ijb = ij_begin
     141
     142  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     143  DO k = 1, llm
     144    DO j = ijb, ije
     145      pvcov(j, k) = pvcov(j, k) + pdvfi(j, k) * pdt
     146    ENDDO
     147  ENDDO
     148  !$OMP END DO NOWAIT
     149
     150  !
     151  IF (pole_sud)  ije = ij_end
     152  !$OMP MASTER
     153  DO j = ijb, ije
     154    pps(j) = pps(j) + pdpfi(j) * pdt
     155  ENDDO
     156  !$OMP END MASTER
    159157
    160158  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
     159    ! earth case, special treatment for first 2 tracers (water)
     160    DO iq = 1, 2
     161      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     162      DO k = 1, llm
     163        DO j = ijb, ije
     164          pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
     165          pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestw)
     166        ENDDO
     167      ENDDO
     168      !$OMP END DO NOWAIT
     169    ENDDO
     170
     171    DO iq = 3, nqtot
     172      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     173      DO k = 1, llm
     174        DO j = ijb, ije
     175          pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
     176          pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestt)
     177        ENDDO
     178      ENDDO
     179      !$OMP END DO NOWAIT
     180    ENDDO
    183181  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
     182    ! general case, treat all tracers equally)
     183    DO iq = 1, nqtot
     184      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     185      DO k = 1, llm
     186        DO j = ijb, ije
     187          pq(j, k, iq) = pq(j, k, iq) + pdqfi(j, k, iq) * pdt
     188          pq(j, k, iq) = AMAX1(pq(j, k, iq), qtestt)
     189        ENDDO
     190      ENDDO
     191      !$OMP END DO NOWAIT
     192    ENDDO
    195193  ENDIF ! of if (planet_type=="earth")
    196194
    197 !$OMP MASTER
     195  !$OMP MASTER
    198196  IF (pole_nord) THEN
    199     DO  ij   = 1, iim
    200       xpn(ij) = aire(   ij   ) * pps(  ij     )
    201     ENDDO
    202 
    203     tpn      = SSUM(iim,xpn,1)/apoln
    204 
    205     DO ij   = 1, iip1
    206       pps (   ij     ) = tpn
     197    DO  ij = 1, iim
     198      xpn(ij) = aire(ij) * pps(ij)
     199    ENDDO
     200
     201    tpn = SSUM(iim, xpn, 1) / apoln
     202
     203    DO ij = 1, iip1
     204      pps (ij) = tpn
    207205    ENDDO
    208206
    … …  
    210208
    211209  IF (pole_sud) THEN
    212     DO  ij   = 1, iim
    213       xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
    214     ENDDO
    215 
    216     tps      = SSUM(iim,xps,1)/apols
    217 
    218     DO ij   = 1, iip1
    219       pps ( ij+ip1jm ) = tps
    220     ENDDO
    221 
    222   ENDIF
    223 !$OMP END MASTER
     210    DO  ij = 1, iim
     211      xps(ij) = aire(ij + ip1jm) * pps(ij + ip1jm)
     212    ENDDO
     213
     214    tps = SSUM(iim, xps, 1) / apols
     215
     216    DO ij = 1, iip1
     217      pps (ij + ip1jm) = tps
     218    ENDDO
     219
     220  ENDIF
     221  !$OMP END MASTER
    224222
    225223  IF (pole_nord) THEN
    226224    DO iq = 1, nqtot
    227 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    228       DO  k    = 1, llm
    229         DO  ij   = 1, iim
    230           xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
    231         ENDDO
    232         tpn      = SSUM(iim,xpn,1)/apoln
    233 
    234         DO ij   = 1, iip1
    235           pq (   ij   ,k,iq) = tpn
    236         ENDDO
    237       ENDDO
    238 !$OMP END DO NOWAIT     
     225      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     226      DO  k = 1, llm
     227        DO  ij = 1, iim
     228          xpn(ij) = aire(ij) * pq(ij, k, iq)
     229        ENDDO
     230        tpn = SSUM(iim, xpn, 1) / apoln
     231
     232        DO ij = 1, iip1
     233          pq (ij, k, iq) = tpn
     234        ENDDO
     235      ENDDO
     236      !$OMP END DO NOWAIT
    239237    ENDDO
    240238  ENDIF
    … …  
    242240  IF (pole_sud) THEN
    243241    DO iq = 1, nqtot
    244 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    245       DO  k    = 1, llm
    246         DO  ij   = 1, iim
    247           xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
    248         ENDDO
    249         tps      = SSUM(iim,xps,1)/apols
    250 
    251         DO ij   = 1, iip1
    252           pq (ij+ip1jm,k,iq)  = tps
    253         ENDDO
    254       ENDDO
    255 !$OMP END DO NOWAIT     
    256     ENDDO
    257   ENDIF
    258 
    259 
     242      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     243      DO  k = 1, llm
     244        DO  ij = 1, iim
     245          xps(ij) = aire(ij + ip1jm) * pq(ij + ip1jm, k, iq)
     246        ENDDO
     247        tps = SSUM(iim, xps, 1) / apols
     248
     249        DO ij = 1, iip1
     250          pq (ij + ip1jm, k, iq) = tps
     251        ENDDO
     252      ENDDO
     253      !$OMP END DO NOWAIT
     254    ENDDO
     255  ENDIF
    260256
    261257END SUBROUTINE addfi_loc

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90

    r5117 r5123  
    5151
    5252  INTEGER :: ij, l, ijb, ije
    53   EXTERNAL  SSUM
    54   REAL :: SSUM
    55 
    56 
    5753
    5854  !-----------------------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90

    r5117 r5123  
    8585    USE write_field_loc
    8686    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
     87    USE lmdz_ssum_scopy, ONLY: ssum
     88
    8789
    8890    IMPLICIT NONE
    … …  
    9799    REAL :: tpn, tps
    98100
    99     REAL  SSUM
    100101    LOGICAL, PARAMETER :: dissip_conservative = .TRUE.
    101102    TYPE(Request), SAVE :: Request_dissip

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/convflu_loc.f90

    r5105 r5123  
    1616  !
    1717  USE parallel_lmdz
     18  USE lmdz_ssum_scopy, ONLY: ssum
     19
    1820  IMPLICIT NONE
    1921  !
    … …  
    2628  !
    2729  INTEGER :: ijb,ije
    28   EXTERNAL   SSUM
    29   REAL :: SSUM
    3030  !
    3131  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90

    r5117 r5123  
    5656
    5757  INTEGER :: l, ij
    58 
    59   REAL :: SSUM
    6058  INTEGER :: ijb, ije
    6159

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90

    r5117 r5123  
    1010  !  *********************************************************************
    1111  USE parallel_lmdz
     12  USE lmdz_ssum_scopy, ONLY: ssum
     13
    1214  IMPLICIT NONE
    1315  !
    … …  
    3941  INTEGER :: l,ij
    4042  !    ...................................................................
    41   !
    42   EXTERNAL  SSUM
    43   REAL :: SSUM
    4443  INTEGER :: ijb,ije,jjb,jje
    4544  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90

    r5117 r5123  
    99  !  *********************************************************************
    1010  USE parallel_lmdz
     11  USE lmdz_ssum_scopy, ONLY: ssum
     12
    1113  IMPLICIT NONE
    1214  !
    … …  
    3638  INTEGER :: ijb,ije
    3739  !    ...................................................................
    38   !
    39   EXTERNAL  SSUM
    40   REAL :: SSUM
    4140  !
    4241  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90

    r5117 r5123  
    1010  USE parallel_lmdz
    1111  USE lmdz_filtreg_p
     12  USE lmdz_ssum_scopy, ONLY: ssum
     13
    1214  IMPLICIT NONE
    1315  !
    … …  
    3739  REAL :: sumypn,sumyps
    3840  !    ...................................................................
    39   !
    40   EXTERNAL  SSUM
    41   REAL :: SSUM
    4241  INTEGER :: ijb,ije,jjb,jje
    4342  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90

    r5118 r5123  
    1717  USE lmdz_strings, ONLY: int2str
    1818  USE lmdz_iniprint, ONLY: lunout, prt_level
     19  USE lmdz_ssum_scopy, ONLY: ssum
    1920
    2021  IMPLICIT NONE
    … …  
    7879  INTEGER :: l,ij,iq,i,j
    7980
    80   REAL :: SSUM
    81   EXTERNAL SSUM
    8281  INTEGER :: ijb,ije,jjb,jje
    8382  LOGICAL :: checksum

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90

    r5118 r5123  
    134134  REAL :: time
    135135
    136   REAL :: SSUM
    137136  ! REAL,SAVE,ALLOCATABLE :: finvmaold(:,:)
    138137

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massdair_loc.f90

    r5117 r5123  
    3030  REAL :: massemoyn, massemoys
    3131
    32   REAL :: SSUM
    33   EXTERNAL SSUM
    3432  !
    3533  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90

    r5118 r5123  
    3838  REAL :: zx_defau_diag(ijb_u:ije_u, llm, 2)
    3939  REAL :: q_follow(ijb_u:ije_u, llm, 2)
    40   !
    41   REAL :: SSUM
    42   EXTERNAL SSUM
    4340  !
    4441  INTEGER :: imprim

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90

    r5118 r5123  
    4646
    4747  Logical :: extremum
    48 
    49   REAL :: SSUM
    5048
    5149  REAL :: z1, z2, z3
    … …  
    384382          min_qParent, min_qMass, min_ratio ! MVals et CRisi
    385383  USE comconst_mod, ONLY: pi
     384  USE lmdz_ssum_scopy, ONLY: ssum
     385
    386386  IMPLICIT NONE
    387387  !
    … …  
    428428  REAL :: Ratio(ijb_u:ije_u, llm, nqtot) ! CRisi
    429429  INTEGER :: ifils, iq2 ! CRisi
    430   !
    431   !
    432   REAL :: SSUM
    433   EXTERNAL  SSUM
    434430
    435431  DATA first/.TRUE./
    … …  
    850846  !$OMP THREADPRIVATE(temps0,temps1,temps2,temps3,temps4,temps5)
    851847
    852   REAL :: SSUM
    853 
    854848  DATA temps0, temps1, temps2, temps3, temps4, temps5/0., 0., 0., 0., 0., 0./
    855849  INTEGER :: ijb, ije, ijb_x, ije_x

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90

    r5118 r5123  
    4040  REAL :: Ratio(ijb_u:ije_u, llm, nqtot) ! CRisi
    4141  INTEGER :: ifils, iq2 ! CRisi
    42 
    43   REAL :: SSUM
    4442
    4543  INTEGER :: ijb, ije, ijb_x, ije_x
    … …  
    392390  USE comconst_mod, ONLY: pi
    393391  USE lmdz_iniprint, ONLY: lunout, prt_level
     392  USE lmdz_ssum_scopy, ONLY: ssum
     393
    394394  IMPLICIT NONE
    395395  !
    … …  
    437437  INTEGER :: ijb, ije
    438438  INTEGER :: ijbm, ijem
    439 
    440   REAL :: ssum
    441439
    442440  ijb = ij_begin - 2 * iip1
Note: See TracChangeset for help on using the changeset viewer.