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

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

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

revision 1.3 by jmc, Wed Apr 6 18:45:20 2005 UTC revision 1.4 by jmc, Thu Oct 8 20:08:20 2009 UTC
# Line 11  C !INTERFACE: ========================== Line 11  C !INTERFACE: ==========================
11       I     bi, bj, myTime, myThid )       I     bi, bj, myTime, myThid )
12    
13  C !DESCRIPTION: \bv  C !DESCRIPTION: \bv
14  C     /==========================================================\  C     *==========================================================*
15  C     | SUBROUTINE PP81_CALC                                     |  C     | SUBROUTINE PP81_CALC                                     |
16  C     | o Compute all PP81 fields defined in PP81.h              |  C     | o Compute all PP81 fields defined in PP81.h              |
17  C     |==========================================================|  C     *==========================================================*
18  C     | This subroutine is based on SPEM code                    |  C     | This subroutine is based on SPEM code                    |
19  C     \==========================================================/  C     *==========================================================*
       IMPLICIT NONE  
 C  
 C--------------------------------------------------------------------  
20    
21  C global parameters updated by pp_calc  C global parameters updated by pp_calc
22  C     PPviscAz   - PP eddy viscosity coefficient              (m^2/s)  C     PPviscAz  :: PP eddy viscosity coefficient              (m^2/s)
23  C     PPdiffKzT  - PP diffusion coefficient for temperature   (m^2/s)  C     PPdiffKzT :: PP diffusion coefficient for temperature   (m^2/s)
24  C  C
25  C \ev  C \ev
26    
27  C !USES: ============================================================  C !USES: ============================================================
28          IMPLICIT NONE
29  #include "SIZE.h"  #include "SIZE.h"
30  #include "EEPARAMS.h"  #include "EEPARAMS.h"
31  #include "PARAMS.h"  #include "PARAMS.h"
# Line 44  C !USES: =============================== Line 42  C !USES: ===============================
42    
43  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
44  c Routine arguments  c Routine arguments
45  c     bi, bj - array indices on which to apply calculations  c     bi, bj :: array indices on which to apply calculations
46  c     myTime - Current time in simulation  c     myTime :: Current time in simulation
47    c     myThid :: My Tread Id number
48    
49        INTEGER bi, bj        INTEGER bi, bj
       INTEGER myThid  
50        _RL     myTime        _RL     myTime
51          INTEGER myThid
52    
53  #ifdef ALLOW_PP81  #ifdef ALLOW_PP81
54    
# Line 69  CEOP Line 68  CEOP
68    
69        DO K = 2, Nr        DO K = 2, Nr
70         CALL PP81_RI_NUMBER(         CALL PP81_RI_NUMBER(
71       I      bi, bj, K, iMin, iMax, jMin, jMax,       I      bi, bj, K, iMin, iMax, jMin, jMax,
72       O      RiNumber,       O      RiNumber,
73       I      myTime, myThid )       I      myTime, myThid )
74         DO J=jMin,jMax         DO J=jMin,jMax
75          DO I=iMin,iMax          DO I=iMin,iMax
# Line 82  CEOP Line 81  CEOP
81            PPviscTmp = PPnu0/(denom**PPnRi)            PPviscTmp = PPnu0/(denom**PPnRi)
82           ENDIF           ENDIF
83  C     assign a minium ( = background ) value  C     assign a minium ( = background ) value
84           PPviscAr(I,J,K,bi,bj) = MAX(PPviscTmp,viscAr)           PPviscAr(I,J,K,bi,bj) = MAX(PPviscTmp,viscArNr(k))
85           PPdiffKr(I,J,K,bi,bj) = MAX(PPviscAr(I,J,K,bi,bj)/denom,           PPdiffKr(I,J,K,bi,bj) = MAX(PPviscAr(I,J,K,bi,bj)/denom,
86       &        diffKrNrT(k))       &        diffKrNrT(k))
87  CML         if ( k.eq.2 .and. i.ge.1 .and. i.le.sNx .and. j.eq.1)  CML         if ( k.eq.2 .and. i.ge.1 .and. i.le.sNx .and. j.eq.1)
# Line 92  CML     &        PPviscAr(I,J,K,bi,bj), Line 91  CML     &        PPviscAr(I,J,K,bi,bj),
91          ENDDO          ENDDO
92         ENDDO         ENDDO
93  #ifdef ALLOW_PP81_LOWERBOUND  #ifdef ALLOW_PP81_LOWERBOUND
94  CRT   This is where the lower limit for subsurface layers  CRT   This is where the lower limit for subsurface layers
95  CRT   (BRIOS special) is set.  CRT   (BRIOS special) is set.
96         IF ( (buoyancyRelation .EQ. 'OCEANIC' .AND. K .EQ. 2) .OR.         IF ( (buoyancyRelation .EQ. 'OCEANIC' .AND. K .EQ. 2) .OR.
97       &      (buoyancyRelation .EQ. 'OCEANICP' .AND. K .EQ. Nr) ) THEN       &      (buoyancyRelation .EQ. 'OCEANICP' .AND. K .EQ. Nr) ) THEN
98          DO J=jMin,jMax          DO J=jMin,jMax
99           DO I=iMin,iMax           DO I=iMin,iMax
100            PPviscAr(I,J,K,bi,bj) = MAX(PPviscMin,PPviscAr(I,J,K,bi,bj))            PPviscAr(I,J,K,bi,bj) = MAX(PPviscMin,PPviscAr(I,J,K,bi,bj))
101            PPdiffKr(I,J,K,bi,bj) = MAX(PPdiffMin,PPdiffKr(I,J,K,bi,bj))            PPdiffKr(I,J,K,bi,bj) = MAX(PPdiffMin,PPdiffKr(I,J,K,bi,bj))
102           ENDDO           ENDDO
103          ENDDO          ENDDO
104         ENDIF         ENDIF
105  #endif /* ALLOW_PP81_LOWERBOUND */  #endif /* ALLOW_PP81_LOWERBOUND */
# Line 111  C     Mask land points Line 110  C     Mask land points
110       &        * maskC(I,J,K,bi,bj)       &        * maskC(I,J,K,bi,bj)
111           PPdiffKr(I,J,K,bi,bj) = PPdiffKr(I,J,K,bi,bj)           PPdiffKr(I,J,K,bi,bj) = PPdiffKr(I,J,K,bi,bj)
112       &        * maskC(I,J,K,bi,bj)       &        * maskC(I,J,K,bi,bj)
113          ENDDO          ENDDO
114         ENDDO         ENDDO
115  C     end K-loop  C     end K-loop
116        ENDDO        ENDDO
# Line 120  C     end K-loop Line 119  C     end K-loop
119    
120        RETURN        RETURN
121        END        END
   
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22