/[MITgcm]/MITgcm/model/src/calc_common_factors.F
ViewVC logotype

Diff of /MITgcm/model/src/calc_common_factors.F

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

revision 1.7 by cnh, Tue Aug 18 16:32:41 1998 UTC revision 1.17 by heimbach, Mon Jul 30 20:20:43 2001 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6  CStartOfInterFace  CStartOfInterFace
7        SUBROUTINE CALC_COMMON_FACTORS(        SUBROUTINE CALC_COMMON_FACTORS(
8       I        bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,       I        bi,bj,iMin,iMax,jMin,jMax,k,
9       O        xA,yA,uTrans,vTrans,rTrans,rVel,maskC,maskUp,       O        xA,yA,uTrans,vTrans,rTrans,maskUp,
10       I        myThid)       I        myThid)
11    
12  C     /==========================================================\  C     /==========================================================\
# Line 18  C     | that are used at various points Line 19  C     | that are used at various points
19  C     | This reduces the amount of total work, total memory      |  C     | This reduces the amount of total work, total memory      |
20  C     | and therefore execution time and is generally a good     |  C     | and therefore execution time and is generally a good     |
21  C     | idea.                                                    |  C     | idea.                                                    |
 C     | We also think lower taxes are a good idea but we doubt   |  
 C     | whether we'll ever get them.                             |  
22  C     \==========================================================/  C     \==========================================================/
23        IMPLICIT NONE        IMPLICIT NONE
24    
# Line 29  C     == GLobal variables == Line 28  C     == GLobal variables ==
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
29  #include "PARAMS.h"  #include "PARAMS.h"
30  #include "GRID.h"  #include "GRID.h"
31    #ifdef ALLOW_NONHYDROSTATIC
32    #include "GW.h"
33    #endif
34    
35  C     == Routine arguments ==  C     == Routine arguments ==
36  C     bi, bj, iMin, iMax, jMin, jMax - Range of points for which calculation  C     bi, bj, iMin, iMax, jMin, jMax - Range of points for which calculation
# Line 38  C     yA      - Tracer cell face area no Line 40  C     yA      - Tracer cell face area no
40  C     uTrans  - Zonal volume transport through cell face  C     uTrans  - Zonal volume transport through cell face
41  C     vTrans  - Meridional volume transport through cell face  C     vTrans  - Meridional volume transport through cell face
42  C     rTrans  - R-direction volume transport through cell face  C     rTrans  - R-direction volume transport through cell face
 C     rVel    - R-direction velocity at cell upper and lower faces  
 C     maskC   - land/water mask for tracer points  
43  C     maskUp  - land/water mask for Wvel points (above tracer level)  C     maskUp  - land/water mask for Wvel points (above tracer level)
44  C     myThid - Instance number for this innvocation of CALC_COMMON_FACTORS  C     myThid - Instance number for this innvocation of CALC_COMMON_FACTORS
45  C  C
46        INTEGER bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown        INTEGER bi,bj,iMin,iMax,jMin,jMax,k
47        _RS xA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS xA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
48        _RS yA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS yA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
49        _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50        _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL rVel  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)  
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
52        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53  C  C
54        INTEGER myThid        INTEGER myThid
# Line 58  CEndOfInterface Line 56  CEndOfInterface
56    
57  C     == Local variables ==  C     == Local variables ==
58  C     I, J, K - Loop counters  C     I, J, K - Loop counters
 C     kUp, kDown, kM1 - Index for layer above and below. K_UP and K_DOWN  
 C                         are switched with layer to be the appropriate index  
 C                         into fluxUD.  
59        INTEGER i,j        INTEGER i,j
       LOGICAL TOP_LAYER  
60    
61        TOP_LAYER = K .EQ. 1  C--   Initialisation
62          DO j=1-OLy,sNy+OLy
63           DO i=1-OLx,sNx+OLx
64            xA(i,j)      = 0. _d 0
65            yA(i,j)      = 0. _d 0
66            uTrans(i,j)  = 0. _d 0
67            vTrans(i,j)  = 0. _d 0
68            rTrans(i,j)  = 0. _d 0
69           ENDDO
70          ENDDO      
71    
72    C--   Calculate mask for tracer cells  (0 => land, 1 => water)
73          IF (K .EQ. 1) THEN
74            DO j=jMin,jMax
75             DO i=iMin,iMax
76              maskUp(i,j) = 0.
77             ENDDO
78            ENDDO
79          ELSE
80            DO j=jMin,jMax
81             DO i=iMin,iMax
82              maskUp(i,j) = maskC(i,j,k-1,bi,bj)*maskC(i,j,k,bi,bj)
83             ENDDO
84            ENDDO
85          ENDIF
86    
87  C--   Calculate tracer cell face open areas  C--   Calculate tracer cell face open areas
88        DO j=jMin,jMax        DO j=jMin,jMax
89         DO i=iMin,iMax         DO i=iMin,iMax
90          xA(i,j) = _dyG(i,j,bi,bj)*drF(k)*_hFacW(i,j,k,bi,bj)          xA(i,j) = _dyG(i,j,bi,bj)
91          yA(i,j) = _dxG(i,j,bi,bj)*drF(k)*_hFacS(i,j,k,bi,bj)       &   *drF(k)*_hFacW(i,j,k,bi,bj)
92            yA(i,j) = _dxG(i,j,bi,bj)
93         &   *drF(k)*_hFacS(i,j,k,bi,bj)
94         ENDDO         ENDDO
95        ENDDO        ENDDO
96    
# Line 86  C--   tracer cell faces. Line 106  C--   tracer cell faces.
106  C--   Calculate vertical "volume transport" through  C--   Calculate vertical "volume transport" through
107  C--   tracer cell face *above* this level.  C--   tracer cell face *above* this level.
108        DO j=jMin,jMax        DO j=jMin,jMax
109         DO i=iMin,iMax          DO i=iMin,iMax
110          rTrans(i,j) = uTrans(i,j)*recip_rkFac-uTrans(i+1,j)*_recip_rkFac            rTrans(i,j) = wVel(i,j,k,bi,bj)*rA(i,j,bi,bj)
111       &               +vTrans(i,j)*_recip_rkFac-vTrans(i,j+1)*_recip_rkFac          ENDDO
      &               +rTrans(i,j)  
        ENDDO  
       ENDDO  
   
 C--   Vertical velocity at upper face  
       DO j=jMin,jMax  
        DO i=iMin,iMax  
         rVel(i,j,kUp) = rTrans(i,j)/_rA(i,j,bi,bj)  
        ENDDO  
       ENDDO  
   
 C--    Calculate mask for tracer cells  (0 => land, 1 => water)  
       DO j=jMin,jMax  
        DO i=iMin,iMax  
         maskC(i,j) = 1.  
         if (_hFacC(i,j,k,bi,bj).eq.0.) maskC(i,j)=0.  
         maskUp(i,j) = 1.  
         if (_hFacC(i,j,k,bi,bj).eq.0. .or. TOP_LAYER ) maskUp(i,j)=0.  
        ENDDO  
112        ENDDO        ENDDO
113    
114        RETURN        RETURN
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22