Changeset 36 for LMDZ.3.3


Ignore:
Timestamp:
Feb 8, 2000, 9:43:14 AM (25 years ago)
Author:
lmdz
Message:

Calcul de valeurs uniques (moyenne zonale) aux poles
LF

Location:
LMDZ.3.3/trunk/libf/dyn3d
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/trunk/libf/dyn3d/addfi.F

    r21 r36  
    8282      ENDDO
    8383
    84       IF( alphax.NE.0. )   THEN
    85         DO  k    = 1, llm
    86          DO  ij   = 1, iim
    87           xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
    88           xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
    89          ENDDO
    90           tpn      = SSUM(iim,xpn,1)/ apoln
    91           tps      = SSUM(iim,xps,1)/ apols
     84      DO  k    = 1, llm
     85       DO  ij   = 1, iim
     86         xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
     87         xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
     88       ENDDO
     89       tpn      = SSUM(iim,xpn,1)/ apoln
     90       tps      = SSUM(iim,xps,1)/ apols
    9291
    93          DO ij   = 1, iip1
    94           pteta(   ij   ,k)  = tpn
    95           pteta(ij+ip1jm,k)  = tps
    96          ENDDO
    97         ENDDO
    98       ENDIF
     92       DO ij   = 1, iip1
     93         pteta(   ij   ,k)  = tpn
     94         pteta(ij+ip1jm,k)  = tps
     95       ENDDO
     96      ENDDO
    9997c
    10098
    … …  
    134132      ENDDO
    135133
    136       IF( alphax.NE.0. )   THEN
    137134
    138          DO  ij   = 1, iim
    139           xpn(ij) = aire(   ij   ) * pps(  ij     )
    140           xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
    141          ENDDO
     135      DO  ij   = 1, iim
     136        xpn(ij) = aire(   ij   ) * pps(  ij     )
     137        xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
     138      ENDDO
     139      tpn      = SSUM(iim,xpn,1)/apoln
     140      tps      = SSUM(iim,xps,1)/apols
     141
     142      DO ij   = 1, iip1
     143        pps (   ij     )  = tpn
     144        pps ( ij+ip1jm )  = tps
     145      ENDDO
     146
     147
     148      DO iq = 1, nq
     149        DO  k    = 1, llm
     150          DO  ij   = 1, iim
     151            xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
     152            xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
     153          ENDDO
    142154          tpn      = SSUM(iim,xpn,1)/apoln
    143155          tps      = SSUM(iim,xps,1)/apols
    144156
    145          DO ij   = 1, iip1
    146           pps (   ij     )  = tpn
    147           pps ( ij+ip1jm )  = tps
    148          ENDDO
    149 
    150 
    151        DO iq = 1, nq
    152          DO  k    = 1, llm
    153            DO  ij   = 1, iim
    154             xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
    155             xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
    156            ENDDO
    157             tpn      = SSUM(iim,xpn,1)/apoln
    158             tps      = SSUM(iim,xps,1)/apols
    159 
    160            DO ij   = 1, iip1
     157          DO ij   = 1, iip1
    161158            pq (   ij   ,k,iq)  = tpn
    162159            pq (ij+ip1jm,k,iq)  = tps
    163            ENDDO
    164          ENDDO
    165        ENDDO
    166 
    167       ENDIF
    168 
     160          ENDDO
     161        ENDDO
     162      ENDDO
    169163
    170164      RETURN

  • LMDZ.3.3/trunk/libf/dyn3d/integrd.F

    r2 r36  
    9191      ENDDO
    9292c
    93       IF( alphax.NE.0. )   THEN
    94         DO  ij    = 1, iim
    95          tppn(ij) = aire(   ij   ) * ps(  ij    )
    96          tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
    97         ENDDO
    98          tpn      = SSUM(iim,tppn,1)/apoln
    99          tps      = SSUM(iim,tpps,1)/apols
    100         DO ij   = 1, iip1
    101          ps(   ij   )  = tpn
    102          ps(ij+ip1jm)  = tps
    103         ENDDO
    104       ENDIF
     93      DO  ij    = 1, iim
     94       tppn(ij) = aire(   ij   ) * ps(  ij    )
     95       tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
     96      ENDDO
     97       tpn      = SSUM(iim,tppn,1)/apoln
     98       tps      = SSUM(iim,tpps,1)/apols
     99      DO ij   = 1, iip1
     100       ps(   ij   )  = tpn
     101       ps(ij+ip1jm)  = tps
     102      ENDDO
    105103c
    106104c  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
    … …  
    136134c
    137135c
    138       IF( alphax.NE.0. )   THEN
    139         DO  ij   = 1, iim
     136      DO  ij   = 1, iim
    140137        tppn(ij) = aire(   ij   ) * teta(  ij    ,l)
    141138        tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
    142         ENDDO
     139      ENDDO
    143140        tpn      = SSUM(iim,tppn,1)/apoln
    144141        tps      = SSUM(iim,tpps,1)/apols
    145142
    146         DO ij   = 1, iip1
     143      DO ij   = 1, iip1
    147144        teta(   ij   ,l)  = tpn
    148145        teta(ij+ip1jm,l)  = tps
    149         ENDDO
    150       ENDIF
     146      ENDDO
    151147c
    152148
    … …  
    197193c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
    198194c
    199       IF( alphax.NE.0. )   THEN
    200 
    201         DO iq = 1, nq
    202           DO l = 1, llm
    203 
    204              DO ij = 1, iim
     195
     196      DO iq = 1, nq
     197        DO l = 1, llm
     198
     199           DO ij = 1, iim
    205200             qppn(ij) = aire(   ij   ) * q(   ij   ,l,iq)
    206201             qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq)
    207              ENDDO
     202           ENDDO
    208203             qpn  =  SSUM(iim,qppn,1)/apoln
    209204             qps  =  SSUM(iim,qpps,1)/apols
    210205
    211              DO ij = 1, iip1
     206           DO ij = 1, iip1
    212207             q(   ij   ,l,iq)  = qpn
    213208             q(ij+ip1jm,l,iq)  = qps
    214              ENDDO
    215 
    216           ENDDO
    217         ENDDO
    218 
    219       ENDIF
     209           ENDDO
     210
     211        ENDDO
     212      ENDDO
     213
    220214
    221215         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
Note: See TracChangeset for help on using the changeset viewer.