| 1 |
C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_diff_x.F,v 1.3 2001/09/21 13:11:43 adcroft Exp $ |
| 2 |
C $Name: $ |
| 3 |
|
| 4 |
#include "GAD_OPTIONS.h" |
| 5 |
|
| 6 |
CBOP |
| 7 |
C !ROUTINE: GAD_DIFF_X |
| 8 |
|
| 9 |
C !INTERFACE: ========================================================== |
| 10 |
SUBROUTINE GAD_DIFF_X( |
| 11 |
I bi,bj,k, |
| 12 |
I xA, diffKh, |
| 13 |
I tracer, |
| 14 |
O dfx, |
| 15 |
I myThid ) |
| 16 |
|
| 17 |
C !DESCRIPTION: |
| 18 |
C Calculates the area integrated zonal flux due to down-gradient diffusion |
| 19 |
C of a tracer: |
| 20 |
C \begin{equation*} |
| 21 |
C F^x_{diff} = - A^x \kappa_h \frac{1}{\Delta x_c} \delta_i \theta |
| 22 |
C \end{equation*} |
| 23 |
|
| 24 |
C !USES: =============================================================== |
| 25 |
IMPLICIT NONE |
| 26 |
#include "SIZE.h" |
| 27 |
#include "GRID.h" |
| 28 |
|
| 29 |
C !INPUT PARAMETERS: =================================================== |
| 30 |
C bi,bj :: tile indices |
| 31 |
C k :: vertical level |
| 32 |
C xA :: area of face at U points |
| 33 |
C diffKh :: horizontal diffusivity |
| 34 |
C tracer :: tracer field |
| 35 |
C myThid :: thread number |
| 36 |
INTEGER bi,bj,k |
| 37 |
_RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
| 38 |
_RL diffKh (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) |
| 39 |
_RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
| 40 |
INTEGER myThid |
| 41 |
|
| 42 |
C !OUTPUT PARAMETERS: ================================================== |
| 43 |
C dfx :: zonal diffusive flux |
| 44 |
_RL dfx (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
| 45 |
|
| 46 |
C !LOCAL VARIABLES: ==================================================== |
| 47 |
C i,j :: loop indices |
| 48 |
INTEGER i,j |
| 49 |
CEOP |
| 50 |
|
| 51 |
C print *,'in gad_diff_x' |
| 52 |
DO j=1-Oly,sNy+Oly |
| 53 |
dfx(1-Olx,j)=0. |
| 54 |
DO i=1-Olx+1,sNx+Olx |
| 55 |
dfx(i,j) = -diffKh(i,j,k)*xA(i,j) |
| 56 |
& *_recip_dxC(i,j,bi,bj) |
| 57 |
& *(Tracer(i,j)-Tracer(i-1,j)) |
| 58 |
& *CosFacU(j,bi,bj) |
| 59 |
ENDDO |
| 60 |
ENDDO |
| 61 |
|
| 62 |
RETURN |
| 63 |
END |
| 64 |
c---------------------------------------------------------- |
| 65 |
SUBROUTINE CALC_MLD(bi,bj,diffkh3d_x,diffkh3d_y,myThid) |
| 66 |
implicit none |
| 67 |
|
| 68 |
#include "SIZE.h" |
| 69 |
#include "EEPARAMS.h" |
| 70 |
#include "PARAMS.h" |
| 71 |
#include "DYNVARS.h" |
| 72 |
#include "GRID.h" |
| 73 |
|
| 74 |
INTEGER bi,bj |
| 75 |
_RL diffkh3d_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) |
| 76 |
_RL diffkh3d_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) |
| 77 |
INTEGER myThid |
| 78 |
|
| 79 |
C !LOCAL VARIABLES: ==================================================== |
| 80 |
C i,j :: loop indices |
| 81 |
INTEGER i,j !,k |
| 82 |
c jrs next |
| 83 |
_RL rhoK (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
| 84 |
_RL Khplus,gradij,gradim1,gradjm1,calc_grad |
| 85 |
C _RL dep_frac |
| 86 |
real *8 khconst,khmin,khmax |
| 87 |
parameter ( khconst=5.d15 ) !2.5d15 |
| 88 |
parameter ( khmin=1000.0 ) |
| 89 |
parameter ( khmax=40000.0 ) !15000.0 |
| 90 |
cjrs try constants 6e14, 3e15, 5e15, 10e15 |
| 91 |
|
| 92 |
c jrs next |
| 93 |
C print *,'in calc_mld for Khplus ' |
| 94 |
Cold CALL FIND_RHO( |
| 95 |
C & bi,bj,1-Olx,sNx+OLx,1-OLy,sNy+OLy,1,1, |
| 96 |
C & theta,salt,rhoK,myThid) |
| 97 |
CALL FIND_RHO_2D( |
| 98 |
& 1-Olx,sNx+OLx,1-OLy,sNy+OLy,1, |
| 99 |
& theta(1-OLx,1-OLy,1,bi,bj), salt(1-OLx,1-OLy,1,bi,bj), |
| 100 |
& rhoK, 1, bi, bj, myThid) |
| 101 |
|
| 102 |
DO j=1-Oly,sNy+Oly |
| 103 |
DO i=1-Olx+1,sNx+Olx |
| 104 |
|
| 105 |
|
| 106 |
if (hfacc(i,j,1,bi,bj).ne.0) then |
| 107 |
gradij= calc_grad(i,j,bi,bj,rhoK) |
| 108 |
endif |
| 109 |
|
| 110 |
if ( (hfacc(i,j,1,bi,bj).ne.0).and. |
| 111 |
& (hfacc(i-1,j,1,bi,bj).ne.0) ) then |
| 112 |
gradim1= 0.! calc_grad(i-1,j,bi,bj,rhoK) |
| 113 |
if ((gradij.ne.0).and.(gradim1.ne.0)) then |
| 114 |
Khplus= khconst*(gradij+gradim1)/2 |
| 115 |
elseif (gradij.ne.0) then |
| 116 |
Khplus= khconst*gradij |
| 117 |
elseif (gradim1.ne.0) then |
| 118 |
Khplus= khconst*gradim1 |
| 119 |
else |
| 120 |
Khplus=0.d0 |
| 121 |
endif |
| 122 |
if (Khplus.lt.khmin) Khplus=khmin |
| 123 |
if (Khplus.gt.khmax) Khplus=khmax |
| 124 |
if (yC(i,j,bi,bj) .GE. 80.) Khplus=khmin |
| 125 |
diffkh3d_x(i,j,1)=Khplus |
| 126 |
C print *,'Khplus_x: ',i,j,Khplus |
| 127 |
|
| 128 |
else |
| 129 |
diffkh3d_x(i,j,1)=0.d0 |
| 130 |
endif |
| 131 |
|
| 132 |
if ( (hfacc(i,j,1,bi,bj).ne.0).and. |
| 133 |
& (hfacc(i,j-1,1,bi,bj).ne.0) ) then |
| 134 |
gradjm1=0.!calc_grad(i,j-1,bi,bj,rhoK) |
| 135 |
if ((gradij.ne.0).and.(gradjm1.ne.0)) then |
| 136 |
Khplus= khconst*(gradij+gradjm1)/2 |
| 137 |
elseif (gradij.ne.0) then |
| 138 |
Khplus= khconst*gradij |
| 139 |
elseif (gradjm1.ne.0) then |
| 140 |
Khplus= khconst*gradjm1 |
| 141 |
else |
| 142 |
Khplus=0.d0 |
| 143 |
endif |
| 144 |
if (Khplus.lt.khmin) Khplus=khmin |
| 145 |
if (Khplus.gt.khmax) Khplus=khmax |
| 146 |
if (yC(i,j,bi,bj).GE. 80.) Khplus=khmin |
| 147 |
diffkh3d_y(i,j,1)=Khplus |
| 148 |
c diffkh3d_y(i,j,2)=0.5*Khplus |
| 149 |
c diffkh3d_y(i,j,3)=0.2*Khplus |
| 150 |
C print *,'Khplus_y: ',i,j,Khplus |
| 151 |
|
| 152 |
else |
| 153 |
diffkh3d_y(i,j,1)=0.d0 |
| 154 |
endif |
| 155 |
c DO k=2,7 |
| 156 |
c if (-hMixLayer(i,j,bi,bj).ge.rF(k)) then |
| 157 |
c diffkh3d_x(i,j,k)=0.d0 |
| 158 |
c diffkh3d_y(i,j,k)=0.d0 |
| 159 |
c elseif (-hMixLayer(i,j,bi,bj).ge.rF(k+1)) then |
| 160 |
c dep_frac=(hMixLayer(i,j,bi,bj)+rF(k))/drF(k)* |
| 161 |
c & (240.+rC(k))/240. |
| 162 |
c diffkh3d_x(i,j,k)= dep_frac*diffkh3d_x(i,j,1) |
| 163 |
c diffkh3d_y(i,j,k)= dep_frac*diffkh3d_y(i,j,1) |
| 164 |
c else |
| 165 |
c dep_frac = (240.+rC(k))/240. |
| 166 |
c diffkh3d_x(i,j,k)= dep_frac*diffkh3d_x(i,j,1) |
| 167 |
c diffkh3d_y(i,j,k)= dep_frac*diffkh3d_y(i,j,1) |
| 168 |
c endif |
| 169 |
c ENDDO |
| 170 |
|
| 171 |
ENDDO |
| 172 |
ENDDO |
| 173 |
|
| 174 |
return |
| 175 |
end |
| 176 |
c-------------------------------------------------- |
| 177 |
real*8 FUNCTION CALC_GRAD(i,j,bi,bj,rhoK) |
| 178 |
implicit none |
| 179 |
|
| 180 |
#include "SIZE.h" |
| 181 |
#include "EEPARAMS.h" |
| 182 |
#include "PARAMS.h" |
| 183 |
#include "GRID.h" |
| 184 |
|
| 185 |
INTEGER i,j,bi,bj |
| 186 |
_RL rhoK (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
| 187 |
|
| 188 |
|
| 189 |
c Local variables |
| 190 |
integer xno,yno |
| 191 |
_RL xgrad,ygrad |
| 192 |
|
| 193 |
c print *,'entering calc_gradient...for ',i,j |
| 194 |
if (hfacC(i,j,1,bi,bj).eq.0) then |
| 195 |
calc_grad=0.d0 |
| 196 |
else |
| 197 |
xgrad=0.d0 |
| 198 |
xno=0 |
| 199 |
if (hfacC(i+1,j,1,bi,bj).ne.0) then |
| 200 |
xgrad= abs((rhoK(i+1,j)-rhoK(i,j))*_recip_dxC(i+1,j,bi,bj)) |
| 201 |
xno=1 |
| 202 |
c print *,'gradient with i+1: ',xgrad |
| 203 |
endif |
| 204 |
if (hfacC(i-1,j,1,bi,bj).ne.0) then |
| 205 |
xgrad= xgrad + |
| 206 |
& abs((rhoK(i,j)-rhoK(i-1,j))*_recip_dxC(i,j,bi,bj)) |
| 207 |
xno=xno+1 |
| 208 |
c print *,'gradient with i-1: ', |
| 209 |
c & abs((rhoK(i,j)-rhoK(i-1,j))*_recip_dxC(i,j,bi,bj)) |
| 210 |
endif |
| 211 |
|
| 212 |
ygrad=0.d0 |
| 213 |
yno=0 |
| 214 |
if (hfacC(i,j+1,1,bi,bj).ne.0) then |
| 215 |
ygrad= abs((rhoK(i,j+1)-rhoK(i,j))*_recip_dyC(i,j+1,bi,bj)) |
| 216 |
yno=1 |
| 217 |
endif |
| 218 |
if (hfacC(i,j-1,1,bi,bj).ne.0) then |
| 219 |
ygrad= ygrad + |
| 220 |
& abs((rhoK(i,j)-rhoK(i,j-1))*_recip_dyC(i,j,bi,bj)) |
| 221 |
yno=yno+1 |
| 222 |
endif |
| 223 |
|
| 224 |
if ((xno.ne.0).and.(yno.ne.0)) then |
| 225 |
calc_grad=(xgrad/xno)*(xgrad/xno) + |
| 226 |
& (ygrad/yno)*(ygrad/yno) |
| 227 |
elseif (xno.ne.0) then |
| 228 |
calc_grad= (xgrad/xno)*(xgrad/xno) |
| 229 |
else |
| 230 |
calc_grad= (ygrad/yno)*(ygrad/yno) |
| 231 |
endif |
| 232 |
endif |
| 233 |
|
| 234 |
return |
| 235 |
end |
Parent Directory
| 
Revision Log
| 
Revision Graph