| 1 |
jscott |
1.1 |
|
| 2 |
|
|
#include "ctrparam.h" |
| 3 |
|
|
|
| 4 |
|
|
! ========================================================== |
| 5 |
|
|
! |
| 6 |
|
|
! VWEIGAV.F: |
| 7 |
|
|
! |
| 8 |
|
|
! ---------------------------------------------------------- |
| 9 |
|
|
! |
| 10 |
|
|
! Revision History: |
| 11 |
|
|
! |
| 12 |
|
|
! When Who What |
| 13 |
|
|
! ----- ---------- ------- |
| 14 |
|
|
! 080200 Chien Wang repack based on CliChem3 & M24x11, |
| 15 |
|
|
! and add cpp. |
| 16 |
|
|
! |
| 17 |
|
|
! ========================================================== |
| 18 |
|
|
|
| 19 |
|
|
SUBROUTINE VWEIGHAV (GRAV,VIN,VOUT,PHI,PHIS,ZSTARAV,LB,LE,JB,JE |
| 20 |
|
|
* ,PTOP,SCLH,P,SIGE,DSIGO,CKS,CKN,IO,IM,JM,LM) 2595.5 |
| 21 |
|
|
C 2596. |
| 22 |
|
|
DIMENSION P(IM,JM),SCLH(JM,LM),SIGE(37),DSIGO(35), |
| 23 |
|
|
& PHIS(IO,JM) 2596.5 |
| 24 |
|
|
DIMENSION VIN(JM,LM),VOUT(JM),PHI(IM,JM,LM),ZSTARAV(JM) |
| 25 |
|
|
c JHALF=12 2597.5 |
| 26 |
|
|
JHALF=JM/2 |
| 27 |
|
|
DO 10 J=JB,JE 2598. |
| 28 |
|
|
COEF=.5 2598.5 |
| 29 |
|
|
IF(J.EQ.JB.OR.J.EQ.JE) COEF=1. 2599. |
| 30 |
|
|
COEKD=CKS 2599.5 |
| 31 |
|
|
IF(J.GT.JHALF) COEKD=CKN 2600. |
| 32 |
|
|
ZTEM=0. 2600.5 |
| 33 |
|
|
CONT=0. 2601. |
| 34 |
|
|
TEM1=0. 2602. |
| 35 |
|
|
TEM2=0. 2602.5 |
| 36 |
|
|
IF(J.NE.JB) TEM1=ZSTARAV(J) |
| 37 |
|
|
IF(J.NE.JE) TEM2=ZSTARAV(J+1) |
| 38 |
|
|
DO 20 L=LB,LE 2601.5 |
| 39 |
|
|
TEM=P(1,J)*SCLH(J,L)/(P(1,J)*SIGE(L+1)+PTOP) 2604. |
| 40 |
|
|
TEM=TEM*DSIGO(L)*EXP(-.5*(PHI(1,J,L)+PHI(1,J,L+1)-2.*PHIS(1,J))/ 2604.5 |
| 41 |
|
|
* GRAV/(COEF*(TEM1+TEM2)*COEKD+1.E-20)) 2605. |
| 42 |
|
|
CONT=CONT+TEM 2605.5 |
| 43 |
|
|
20 ZTEM=ZTEM+VIN(J,L)*TEM 2606. |
| 44 |
|
|
VOUT(J)=ZTEM/(CONT+1.E-20) 2606.5 |
| 45 |
|
|
10 CONTINUE 2607. |
| 46 |
|
|
C 2607.5 |
| 47 |
|
|
RETURN 2608. |
| 48 |
|
|
END 2608.5 |
| 49 |
|
|
SUBROUTINE VWEI1AV (GRAV,VIN,VOUT,PHI,PHIS,ZSTARAV,LB,LE,JB,JE |
| 50 |
|
|
* ,PTOP,SCLH,P,SIGE,DSIGO,CKS,CKN,IO,IM,JM,LM) 2609.5 |
| 51 |
|
|
C 2610. |
| 52 |
|
|
DIMENSION P(IM,JM),SCLH(JM,LM),SIGE(37),DSIGO(35),PHIS(IO,JM) 2610.5 |
| 53 |
|
|
DIMENSION VIN(JM,LM),VOUT(JM),PHI(IM,JM,LM),ZSTARAV(JM) |
| 54 |
|
|
c JHALF=12 2611.5 |
| 55 |
|
|
JHALF=JM/2 |
| 56 |
|
|
DO 10 J=JB,JE 2612. |
| 57 |
|
|
COEKD=CKS 2612.5 |
| 58 |
|
|
IF(J.GT.JHALF) COEKD=CKN 2613. |
| 59 |
|
|
ZTEM=0. 2613.5 |
| 60 |
|
|
CONT=0. 2614. |
| 61 |
|
|
DO 20 L=LB,LE 2614.5 |
| 62 |
|
|
TEM=(P(1,J)+P(1,J-1))*.5*(SCLH(J,L)+SCLH(J-1,L))/ 2615. |
| 63 |
|
|
* ((P(1,J)+P(1,J-1))*SIGE(L+1)+2.*PTOP) 2615.5 |
| 64 |
|
|
TEM=TEM*DSIGO(L)*EXP(-.25*(PHI(1,J,L)+PHI(1,J-1,L)+PHI(1,J,L+1)+ 2616. |
| 65 |
|
|
* PHI(1,J-1,L+1)-2.*PHIS(1,J)-2.*PHIS(1,J-1))/GRAV/ 2616.5 |
| 66 |
|
|
* (ZSTARAV(J)*COEKD+1.E-20)) |
| 67 |
|
|
CONT=CONT+TEM 2617.5 |
| 68 |
|
|
20 ZTEM=ZTEM+VIN(J,L)*TEM 2618. |
| 69 |
|
|
VOUT(J)=ZTEM/(CONT+1.E-20) 2618.5 |
| 70 |
|
|
10 CONTINUE 2619. |
| 71 |
|
|
C 2619.5 |
| 72 |
|
|
RETURN 2620. |
| 73 |
|
|
END 2620.5 |