Changeset 36 for LMDZ.3.3/trunk/libf/dyn3d
- Timestamp:
- Feb 8, 2000, 9:43:14 AM (25 years ago)
- Location:
- LMDZ.3.3/trunk/libf/dyn3d
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/trunk/libf/dyn3d/addfi.F
r21 r36 82 82 ENDDO 83 83 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 92 91 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 99 97 c 100 98 … … 134 132 ENDDO 135 133 136 IF( alphax.NE.0. ) THEN137 134 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 142 154 tpn = SSUM(iim,xpn,1)/apoln 143 155 tps = SSUM(iim,xps,1)/apols 144 156 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 161 158 pq ( ij ,k,iq) = tpn 162 159 pq (ij+ip1jm,k,iq) = tps 163 ENDDO 164 ENDDO 165 ENDDO 166 167 ENDIF 168 160 ENDDO 161 ENDDO 162 ENDDO 169 163 170 164 RETURN -
LMDZ.3.3/trunk/libf/dyn3d/integrd.F
r2 r36 91 91 ENDDO 92 92 c 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 105 103 c 106 104 c ... Calcul de la nouvelle masse d'air au dernier temps integre t+1 ... … … 136 134 c 137 135 c 138 IF( alphax.NE.0. ) THEN 139 DO ij = 1, iim 136 DO ij = 1, iim 140 137 tppn(ij) = aire( ij ) * teta( ij ,l) 141 138 tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l) 142 139 ENDDO 143 140 tpn = SSUM(iim,tppn,1)/apoln 144 141 tps = SSUM(iim,tpps,1)/apols 145 142 146 143 DO ij = 1, iip1 147 144 teta( ij ,l) = tpn 148 145 teta(ij+ip1jm,l) = tps 149 ENDDO 150 ENDIF 146 ENDDO 151 147 c 152 148 … … 197 193 c ..... Calcul de la valeur moyenne, unique aux poles pour q ..... 198 194 c 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 205 200 qppn(ij) = aire( ij ) * q( ij ,l,iq) 206 201 qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq) 207 202 ENDDO 208 203 qpn = SSUM(iim,qppn,1)/apoln 209 204 qps = SSUM(iim,qpps,1)/apols 210 205 211 206 DO ij = 1, iip1 212 207 q( ij ,l,iq) = qpn 213 208 q(ij+ip1jm,l,iq) = qps 214 ENDDO 215 216 ENDDO 217 ENDDO 218 219 ENDIF 209 ENDDO 210 211 ENDDO 212 ENDDO 213 220 214 221 215 CALL SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
Note: See TracChangeset
for help on using the changeset viewer.