/[MITgcm]/MITgcm/pkg/pp81/pp81_calc.F
ViewVC logotype

Annotation of /MITgcm/pkg/pp81/pp81_calc.F

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


Revision 1.8 - (hide annotations) (download)
Mon Feb 23 21:20:15 2015 UTC (9 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, HEAD
Changes since 1.7: +2 -2 lines
- change background vertical diffusivity in vertical mixing pkgs ggl90,
  kl10, my82 and pp81 from temperature diffusivity to salinity diffusivity.
  This makes ptracers default diffusivity (that uses salt diffKr) more
  consistent with vertical mixing schemes.

1 jmc 1.8 C $Header: /u/gcmpack/MITgcm/pkg/pp81/pp81_calc.F,v 1.7 2014/11/17 14:12:06 jmc Exp $
2 mlosch 1.1 C $Name: $
3    
4     #include "PP81_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: PP81_CALC
8    
9     C !INTERFACE: =======================================================
10     subroutine PP81_CALC(
11 jmc 1.6 I bi, bj, sigmaR, myTime, myIter, myThid )
12 mlosch 1.1
13     C !DESCRIPTION: \bv
14 jmc 1.4 C *==========================================================*
15 mlosch 1.1 C | SUBROUTINE PP81_CALC |
16     C | o Compute all PP81 fields defined in PP81.h |
17 jmc 1.4 C *==========================================================*
18 mlosch 1.1 C | This subroutine is based on SPEM code |
19 jmc 1.4 C *==========================================================*
20 mlosch 1.1
21     C global parameters updated by pp_calc
22 jmc 1.4 C PPviscAz :: PP eddy viscosity coefficient (m^2/s)
23     C PPdiffKzT :: PP diffusion coefficient for temperature (m^2/s)
24 mlosch 1.1 C
25     C \ev
26    
27     C !USES: ============================================================
28 jmc 1.4 IMPLICIT NONE
29 mlosch 1.1 #include "SIZE.h"
30     #include "EEPARAMS.h"
31     #include "PARAMS.h"
32 jmc 1.7 #include "GRID.h"
33     #ifdef ALLOW_3D_DIFFKR
34     # include "DYNVARS.h"
35     #endif
36 mlosch 1.1 #include "PP81.h"
37 jmc 1.7 c#ifdef ALLOW_AUTODIFF_TAMC
38     c#include "tamc.h"
39     c#include "tamc_keys.h"
40     c#endif /* ALLOW_AUTODIFF_TAMC */
41 mlosch 1.1
42     C !INPUT PARAMETERS: ===================================================
43 jmc 1.6 C Routine arguments
44     C bi, bj :: Current tile indices
45     C sigmaR :: Vertical gradient of iso-neutral density
46     C myTime :: Current time in simulation
47     C myIter :: Current time-step number
48     C myThid :: My Thread Id number
49 mlosch 1.1 INTEGER bi, bj
50 jmc 1.6 _RL sigmaR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
51 jmc 1.4 _RL myTime
52 jmc 1.6 INTEGER myIter
53 mlosch 1.1 INTEGER myThid
54    
55     #ifdef ALLOW_PP81
56     C !LOCAL VARIABLES: ====================================================
57     c Local constants
58     C imin, imax, jmin, jmax - array computation indices
59     C RiNumber - Richardson Number
60     INTEGER I, J, K
61     INTEGER iMin ,iMax ,jMin ,jMax
62     _RL denom, PPviscTmp
63     _RL RiNumber(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
64     CEOP
65     iMin = 2-OLx
66     iMax = sNx+OLx-1
67     jMin = 2-OLy
68     jMax = sNy+OLy-1
69    
70     DO K = 2, Nr
71     CALL PP81_RI_NUMBER(
72 jmc 1.4 I bi, bj, K, iMin, iMax, jMin, jMax,
73     O RiNumber,
74 mlosch 1.1 I myTime, myThid )
75     DO J=jMin,jMax
76     DO I=iMin,iMax
77     IF ( RiNumber(I,J) .LT. RiLimit ) THEN
78     denom = 1.0 + PPalpha*RiLimit
79     PPviscTmp = PPviscMax
80     ELSE
81     denom = 1.0 + PPalpha*RiNumber(I,J)
82     PPviscTmp = PPnu0/(denom**PPnRi)
83     ENDIF
84     C assign a minium ( = background ) value
85 jmc 1.4 PPviscAr(I,J,K,bi,bj) = MAX(PPviscTmp,viscArNr(k))
86 mlosch 1.1 PPdiffKr(I,J,K,bi,bj) = MAX(PPviscAr(I,J,K,bi,bj)/denom,
87 jmc 1.7 #ifdef ALLOW_3D_DIFFKR
88     & diffKr(i,j,k,bi,bj) )
89     #else
90 jmc 1.8 & diffKrNrS(k) )
91 jmc 1.7 #endif
92 mlosch 1.1 CML if ( k.eq.2 .and. i.ge.1 .and. i.le.sNx .and. j.eq.1)
93     CML & print '(A,3I3,5E14.5)', 'ml-pp81', I,J,K, RiLimit,
94     CML & RiNumber(I,J),denom,
95     CML & PPviscAr(I,J,K,bi,bj), PPdiffKr(I,J,K,bi,bj)
96     ENDDO
97     ENDDO
98     #ifdef ALLOW_PP81_LOWERBOUND
99 jmc 1.4 CRT This is where the lower limit for subsurface layers
100     CRT (BRIOS special) is set.
101 jmc 1.5 IF ( (usingZCoords .AND. K .EQ. 2) .OR.
102     & (usingPCoords .AND. K .EQ. Nr) ) THEN
103 mlosch 1.1 DO J=jMin,jMax
104     DO I=iMin,iMax
105     PPviscAr(I,J,K,bi,bj) = MAX(PPviscMin,PPviscAr(I,J,K,bi,bj))
106     PPdiffKr(I,J,K,bi,bj) = MAX(PPdiffMin,PPdiffKr(I,J,K,bi,bj))
107 jmc 1.4 ENDDO
108 mlosch 1.1 ENDDO
109     ENDIF
110     #endif /* ALLOW_PP81_LOWERBOUND */
111     C Mask land points
112     DO J=jMin,jMax
113     DO I=iMin,iMax
114     PPviscAr(I,J,K,bi,bj) = PPviscAr(I,J,K,bi,bj)
115     & * maskC(I,J,K,bi,bj)
116     PPdiffKr(I,J,K,bi,bj) = PPdiffKr(I,J,K,bi,bj)
117     & * maskC(I,J,K,bi,bj)
118 jmc 1.4 ENDDO
119 mlosch 1.1 ENDDO
120     C end K-loop
121     ENDDO
122    
123     #endif /* ALLOW_PP81 */
124    
125     RETURN
126     END

  ViewVC Help
Powered by ViewVC 1.1.22