C*********************************************************** C*********************************************************** C SUBROUTINE ADDIF0 I ( QADV0, I UFLX, WFLX, I CD1 , W QADVM, O DTQAD0, DTQDI0, B DENS0, G DX, FDZ, FDZM, D NX, NZ, NXB, NZB ) C C*********************************************************** IMPLICIT REAL*8 ( A-H, O-Z ) C*********************************************************** C DIMENSION \ QADV0 ( -2: NZB ) , QADVM ( -2:NZB ) DIMENSION \ DTQAD0( -2:NXB, -2:NZB ), \ DTQDI0( -2:NXB, -2:NZB ), \ UFLX ( -2:NXB, -2:NZB ), \ WFLX ( -2:NXB, -2:NZB ), \ CD1 ( -2:NXB, -2:NZB ) C DIMENSION \ DENS0( -2:NZB ), \ FDZ ( -2:NZB ), \ FDZM ( -2:NZB ) C C=========================================================== C DO 10 IZ = 0, NZ QADVM(IZ) = \ 9.0D0 / 16.0D0 * ( QADV0(IZ ) + QADV0(IZ-1) ) \ - 1.0D0 / 16.0D0 * ( QADV0(IZ+1) + QADV0(IZ-2) ) 10 CONTINUE C QADVM(-1) = QADVM(1) QADVM(-2) = QADVM(2) QADVM(NZ+1) = 2.0D0 * QADVM(NZ ) - QADVM(NZ-1) QADVM(NZ+2) = 2.0D0 * QADVM(NZ+1) - QADVM(NZ ) C C DO 11 IZ = 0, NZ-1 DO 11 IX = 1, NX DTQAD0(IX,IZ) = \ ( QADV0(IZ) * \ ( - 1.125D0 * ( UFLX(IX+1,IZ) - UFLX(IX ,IZ) ) \ + 0.125D0 * ( UFLX(IX+2,IZ) - UFLX(IX-1,IZ) ) / 3.0D0 ) \ - 1.125D0 \ * ( WFLX(IX ,IZ+1) * QADVM(IZ+1) \ - WFLX(IX ,IZ ) * QADVM(IZ ) ) \ + 0.125D0 / 3.0D0 \ * ( WFLX(IX ,IZ+2) * QADVM(IZ+2) \ - WFLX(IX ,IZ-1) * QADVM(IZ-1) ) ) \ / DENS0(IZ) / FDZ(IZ) / DX C 11 CONTINUE C CALL BOUND ( DTQAD0, NX, NZ, NXB, NZB, 1, 1, 1, 1 ) C C------------------------------------------------------------- C DO 21 IZ = 0, NZ-1 DO 21 IX = 1, NX DTQDI0(IX,IZ) = \ ( ( DENS0(IZ+1) + DENS0(IZ) ) / 2.0D0 / DX**2 \ * ( CD1(IX+1,IZ+1) + CD1(IX,IZ+1) ) / 2.0D0 \ * ( QADV0(IZ+1) - QADV0(IZ) ) / FDZM(IZ+1) \ - ( DENS0(IZ-1) + DENS0(IZ) ) / 2.0D0 / DX**2 \ * ( CD1(IX+1,IZ ) + CD1(IX ,IZ) ) / 2.0D0 \ * ( QADV0(IZ) - QADV0(IZ-1) ) / FDZM(IZ) ) \ / FDZ(IZ) / DENS0(IZ) 21 CONTINUE C CALL BOUND ( DTQDI0, NX, NZ, NXB, NZB, 1, 1, 1, 1 ) C C================================================================ C RETURN E N D