1 |
jscott |
1.1 |
|
2 |
|
|
#include "ctrparam.h" |
3 |
|
|
|
4 |
|
|
! ========================================================== |
5 |
|
|
! |
6 |
|
|
! HORDIFF.F: subroutine for calculating horizontal |
7 |
|
|
! diffusion of Q. |
8 |
|
|
! |
9 |
|
|
! ---------------------------------------------------------- |
10 |
|
|
! |
11 |
|
|
! Revision History: |
12 |
|
|
! |
13 |
|
|
! When Who What |
14 |
|
|
! ---- ---------- ------- |
15 |
|
|
! 080100 Chien Wang repack based on CliChem3 & M24x11, |
16 |
|
|
! and add cpp. |
17 |
|
|
! |
18 |
|
|
! ========================================================== |
19 |
|
|
|
20 |
|
|
SUBROUTINE HORDIFF(DTDIF) |
21 |
|
|
|
22 |
|
|
#include "BD2G04.COM" |
23 |
|
|
|
24 |
|
|
COMMON U,V,T,P,Q |
25 |
|
|
DIMENSION VT(IM0,JM0,LM0),TT(IM0,JM0,LM0),PT(IM0,JM0), |
26 |
|
|
* QT(IM0,JM0,LM0),PU(IM0,JM0),FD(IM0,JM0),DQDY(JM0,LM0) |
27 |
|
|
COMMON/HDFLUX/VQHD(JM0,LM0) |
28 |
|
|
logical first |
29 |
|
|
data first /.true./ |
30 |
|
|
I=1 |
31 |
|
|
JMM1=JM0-1 |
32 |
|
|
FDIFF=2.5E5 |
33 |
|
|
FDIFF=5.0E5 |
34 |
|
|
if(first)then |
35 |
|
|
print *,' HOR DIFF for Q' |
36 |
|
|
print *,' FDIFF=',FDIFF |
37 |
|
|
print *,'IM0=',IM0,' JM0=',JM0,' LM0=',LM0 |
38 |
|
|
first=.false. |
39 |
|
|
endif |
40 |
|
|
DO 50 J=1,JM0 |
41 |
|
|
50 FD(I,J)=P(I,J)*DXYP(J) |
42 |
|
|
DO 57 L=1,LM0 |
43 |
|
|
DO 57 J=1,JM0 |
44 |
|
|
AJL(J,L,56)=AJL(J,L,56)-Q (I,J,L)*P(I,J) |
45 |
|
|
57 QT (I,J,L)=Q (I,J,L)*FD(I,J) |
46 |
|
|
DO 100 L=1,LM0 |
47 |
|
|
DO 100 J=2,JM0 |
48 |
|
|
DQDY(J,L)=(Q (1,J,L)-Q (1,J-1,L))/DYV(J) |
49 |
|
|
100 CONTINUE |
50 |
|
|
DO 200 L=1,LM0 |
51 |
|
|
PSAV=0.5*(P(1,1)+P(1,2)) |
52 |
|
|
FLUXL=FDIFF*DQDY(2,L)*DXV(2)*PSAV*DTDIF |
53 |
|
|
FLUXL=DMAX1( -0.5*QT(1,2,L), DMIN1(0.5*QT(1,1,L),FLUXL)) |
54 |
|
|
c FLUXR=0. |
55 |
|
|
QT (1,1,L)=QT (1,1,L)+FLUXL |
56 |
|
|
DO 210 J=2,JMM1 |
57 |
|
|
PSAV=0.5*(P(1,J)+P(1,J+1)) |
58 |
|
|
FLUXR=FDIFF*DQDY(J+1,L)*DXV(J+1)*PSAV*DTDIF |
59 |
|
|
FLUXR=DMAX1( -0.5*QT(1,J+1,L), DMIN1(0.5*QT(1,J,L),FLUXR)) |
60 |
|
|
QT (1,J,L)=QT (1,J,L)+(FLUXR-FLUXL) |
61 |
|
|
VQHD(J,L)=-FLUXL/(DXV(J)*0.5*(P(1,J)+P(1,J-1))*DTDIF) |
62 |
|
|
FLUXL=FLUXR |
63 |
|
|
210 CONTINUE |
64 |
|
|
QT (1,JM,L)=QT (1,JM,L)-FLUXR |
65 |
|
|
J=JM |
66 |
|
|
VQHD(J,L)=-FLUXL/(DXV(J)*0.5*(P(1,J)+P(1,J-1))*DTDIF) |
67 |
|
|
200 CONTINUE |
68 |
|
|
DO 300 L=1,LM0 |
69 |
|
|
DO 300 J=1,JM0 |
70 |
|
|
Q (I,J,L)=QT (I,J,L)/FD(I,J) |
71 |
|
|
AJL(J,L,56)=AJL(J,L,56)+Q (I,J,L)*P(I,J) |
72 |
|
|
300 CONTINUE |
73 |
|
|
DOPK=1. |
74 |
|
|
RETURN |
75 |
|
|
END |
76 |
|
|
|