/[MITgcm]/MITgcm/pkg/generic_advdiff/gad_dst3fl_adv_x.F
ViewVC logotype

Contents of /MITgcm/pkg/generic_advdiff/gad_dst3fl_adv_x.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.14 - (show annotations) (download)
Thu Feb 28 23:15:18 2008 UTC (16 years, 2 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62c, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59o, checkpoint62b, checkpoint61f, checkpoint61n, checkpoint61q, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.13: +3 -1 lines
improve vectorizability by moving a few statements out of the main loop

1 C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_dst3fl_adv_x.F,v 1.13 2007/04/04 01:39:06 jmc Exp $
2 C $Name: $
3
4 #include "GAD_OPTIONS.h"
5
6 SUBROUTINE GAD_DST3FL_ADV_X(
7 I bi,bj,k, calcCFL, deltaTloc,
8 I uTrans, uFld,
9 I maskLocW, tracer,
10 O uT,
11 I myThid )
12 C /==========================================================\
13 C | SUBROUTINE GAD_DST3FL_ADV_X |
14 C | o Compute Zonal advective Flux of Tracer using |
15 C | 3rd Order DST Sceheme with flux limiting |
16 C |==========================================================|
17 IMPLICIT NONE
18
19 C == GLobal variables ==
20 #include "SIZE.h"
21 #include "GRID.h"
22 #include "GAD.h"
23
24 C == Routine arguments ==
25 INTEGER bi,bj,k
26 LOGICAL calcCFL
27 _RL deltaTloc
28 _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
29 _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
30 _RS maskLocW(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
31 _RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
32 _RL uT (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
33 INTEGER myThid
34
35 C == Local variables ==
36 INTEGER i,j
37 _RL Rjm,Rj,Rjp,uCFL,d0,d1,psiP,psiM,thetaP,thetaM
38 _RL thetaMax
39 PARAMETER( thetaMax = 1.D+20 )
40
41 C- jmc: an alternative would be to compute directly psiM*Rj & psiP*Rj
42 C (if Rj*Rjm < 0 => psiP*Rj = 0 , elsef Rj > 0 ... , else ... )
43 C with no need to compute thetaM (might be easier to differentiate)
44
45 DO j=1-Oly,sNy+Oly
46 uT(1-Olx,j)=0. _d 0
47 uT(2-Olx,j)=0. _d 0
48 uT(sNx+Olx,j)=0. _d 0
49 ENDDO
50 DO j=1-Oly,sNy+Oly
51 DO i=1-Olx+2,sNx+Olx-1
52 Rjp=(tracer(i+1,j)-tracer( i ,j))*maskLocW(i+1,j)
53 Rj =(tracer( i ,j)-tracer(i-1,j))*maskLocW( i ,j)
54 Rjm=(tracer(i-1,j)-tracer(i-2,j))*maskLocW(i-1,j)
55
56 uCFL = uFld(i,j)
57 IF ( calcCFL ) uCFL = ABS( uFld(i,j)*deltaTloc
58 & *recip_dxC(i,j,bi,bj)*recip_deepFacC(k) )
59 d0=(2. _d 0 -uCFL)*(1. _d 0 -uCFL)*oneSixth
60 d1=(1. _d 0 -uCFL*uCFL)*oneSixth
61
62 C- the old version: can produce overflow, division by zero,
63 c and is wrong for tracer with low concentration:
64 c thetaP=Rjm/(1.D-20+Rj)
65 c thetaM=Rjp/(1.D-20+Rj)
66 C- the right expression, but not bounded:
67 c thetaP=0.D0
68 c thetaM=0.D0
69 c IF (Rj.NE.0.D0) thetaP=Rjm/Rj
70 c IF (Rj.NE.0.D0) thetaM=Rjp/Rj
71 C- prevent |thetaP,M| to reach too big value:
72 IF ( ABS(Rj)*thetaMax .LE. ABS(Rjm) ) THEN
73 thetaP=SIGN(thetaMax,Rjm*Rj)
74 ELSE
75 thetaP=Rjm/Rj
76 ENDIF
77 IF ( ABS(Rj)*thetaMax .LE. ABS(Rjp) ) THEN
78 thetaM=SIGN(thetaMax,Rjp*Rj)
79 ELSE
80 thetaM=Rjp/Rj
81 ENDIF
82
83 psiP=d0+d1*thetaP
84 psiP=MAX(0. _d 0,MIN(MIN(1. _d 0,psiP),
85 & thetaP*(1. _d 0 -uCFL)/(uCFL+1. _d -20) ))
86 psiM=d0+d1*thetaM
87 psiM=MAX(0. _d 0,MIN(MIN(1. _d 0,psiM),
88 & thetaM*(1. _d 0 -uCFL)/(uCFL+1. _d -20) ))
89
90 uT(i,j)=
91 & 0.5*(uTrans(i,j)+ABS(uTrans(i,j)))
92 & *( Tracer(i-1,j) + psiP*Rj )
93 & +0.5*(uTrans(i,j)-ABS(uTrans(i,j)))
94 & *( Tracer( i ,j) - psiM*Rj )
95
96 ENDDO
97 ENDDO
98
99 RETURN
100 END

  ViewVC Help
Powered by ViewVC 1.1.22