1 |
jscott |
1.1 |
|
2 |
|
|
#include "ctrparam.h" |
3 |
|
|
|
4 |
|
|
! ============================================================ |
5 |
|
|
! |
6 |
|
|
! CHEMSHAP2D.F: A revised version of SHAP2D.F which is a |
7 |
|
|
! subroutine for applying Shapiro (2d) |
8 |
|
|
! smoothing of MIT Global Chemistry Model |
9 |
|
|
! |
10 |
|
|
! ------------------------------------------------------------ |
11 |
|
|
! |
12 |
|
|
! Author: Chien Wang |
13 |
|
|
! MIT Joint Program on Science and Policy |
14 |
|
|
! of Global Change |
15 |
|
|
! |
16 |
|
|
! ---------------------------------------------------------- |
17 |
|
|
! |
18 |
|
|
! Revision History: |
19 |
|
|
! |
20 |
|
|
! When Who What |
21 |
|
|
! ---- ---------- ------- |
22 |
|
|
! 080494 Chien Wang rev. |
23 |
|
|
! 080200 Chien Wang repack based on CliChem3 & add cpp |
24 |
|
|
! |
25 |
|
|
! ========================================================== |
26 |
|
|
|
27 |
|
|
subroutine chemshap2d (MFILTR,NORDER,XXX,IM,JM,J1,ITYPE) 8590. |
28 |
|
|
|
29 |
|
|
COMMON/WORK2/X1JI(72,46),X2JI(72,46),X3JI(72,46),X1(72),X2(72), |
30 |
|
|
* X3(72),X4(72),XM1(72),XJMP1(72) |
31 |
|
|
|
32 |
|
|
! ---------------------------------------------------------- |
33 |
|
|
|
34 |
|
|
#if ( defined CPL_CHEM ) |
35 |
|
|
|
36 |
|
|
C VARIABLE ITYPE DETERMINES TYPE OF BOUNDARY CONDITIONS |
37 |
|
|
C ITYPE=1 FOR PS,T AND Q ( XM1=X2) |
38 |
|
|
C ITYPE=2 FOR U (XM1=X1) |
39 |
|
|
C ITYPE=3 FOR V (XM1=-X1) |
40 |
|
|
|
41 |
|
|
JMM1=JM-1 |
42 |
|
|
J2=J1+1 |
43 |
|
|
IMBY2=1 |
44 |
|
|
DO 145 N=1,NORDER |
45 |
|
|
|
46 |
|
|
DO 146 K=1,IM |
47 |
|
|
X1(K)=X1JI(K,J1) |
48 |
|
|
X2(K)=X1JI(K,J2) |
49 |
|
|
X3(K)=X1JI(K,JMM1) |
50 |
|
|
X4(K)=X1JI(K,JM) |
51 |
|
|
IF(ITYPE.EQ.1)THEN |
52 |
|
|
XM1(K)=X1JI(K,J2) |
53 |
|
|
XJMP1(K)=X1JI(K,JMM1) |
54 |
|
|
ELSEIF(ITYPE.EQ.2)THEN |
55 |
|
|
XM1(K)=X1JI(K,J1) |
56 |
|
|
XJMP1(K)=X1JI(K,JM) |
57 |
|
|
ELSE |
58 |
|
|
XM1(K)=-X1JI(K,J1) |
59 |
|
|
XJMP1(K)=-X1JI(K,JM) |
60 |
|
|
ENDIF |
61 |
|
|
146 CONTINUE |
62 |
|
|
|
63 |
|
|
DO 142 I=1,IM |
64 |
|
|
X1IM1=X1JI(I,J1) |
65 |
|
|
DO 142 J=J2,JMM1 |
66 |
|
|
X1I=X1JI(I,J) |
67 |
|
|
X1JI(I,J)=X1IM1-X1I-X1I+X1JI(I,J+1) |
68 |
|
|
X1IM1=X1I |
69 |
|
|
142 CONTINUE |
70 |
|
|
|
71 |
|
|
SUM1=0. |
72 |
|
|
SUMJM=0. |
73 |
|
|
DO 144 K=1,IMBY2 |
74 |
|
|
ccc SUM1 =SUM1 +X2(K)-X1(K)-X1(K)+X2(K) |
75 |
|
|
SUM1 =SUM1 +XM1(K)-X1(K)-X1(K)+X2(K) |
76 |
|
|
ccc SUMJM=SUMJM+X3(K)-X4(K)-X4(K)+X3(K) |
77 |
|
|
SUMJM=SUMJM+X3(K)-X4(K)-X4(K)+XJMP1(K) |
78 |
|
|
144 CONTINUE |
79 |
|
|
|
80 |
|
|
X1SUM =SUM1 /IMBY2 |
81 |
|
|
XJMSUM =SUMJM/IMBY2 |
82 |
|
|
c DO 147 K=1,IM |
83 |
|
|
c X1JI(K,JM)=XJMSUM |
84 |
|
|
c 147 X1JI(K,J1)= X1SUM |
85 |
|
|
|
86 |
|
|
145 CONTINUE |
87 |
|
|
|
88 |
|
|
DO 160 I=1,IM |
89 |
|
|
c DO 160 J=J1,JM |
90 |
|
|
do 160 j=j2,jmm1 |
91 |
|
|
X1JI(I,J)=(X3JI(I,J)-X1JI(I,J)/XXX) |
92 |
|
|
160 CONTINUE |
93 |
|
|
|
94 |
|
|
#endif |
95 |
|
|
|
96 |
|
|
RETURN |
97 |
|
|
END |