/[MITgcm]/MITgcm/pkg/mom_common/mom_calc_hfacz.F
ViewVC logotype

Diff of /MITgcm/pkg/mom_common/mom_calc_hfacz.F

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

revision 1.7 by jmc, Sun Jun 17 14:18:00 2012 UTC revision 1.8 by jmc, Sun Feb 9 18:57:01 2014 UTC
# Line 8  C !ROUTINE: MOM_CALC_HFACZ Line 8  C !ROUTINE: MOM_CALC_HFACZ
8    
9  C !INTERFACE: ==========================================================  C !INTERFACE: ==========================================================
10        SUBROUTINE MOM_CALC_HFACZ(        SUBROUTINE MOM_CALC_HFACZ(
11       I        bi,bj,k,       I        bi, bj, k,
12       O        hFacZ,r_hFacZ,       O        hFacZ, r_hFacZ,
13       I        myThid)       I        myThid )
14    
15  C !DESCRIPTION:  C !DESCRIPTION:
16  C Calculates the fractional thickness at vorticity points  C Calculates the fractional thickness at vorticity points
# Line 21  C !USES: =============================== Line 21  C !USES: ===============================
21  #include "EEPARAMS.h"  #include "EEPARAMS.h"
22  #include "PARAMS.h"  #include "PARAMS.h"
23  #include "GRID.h"  #include "GRID.h"
24  #ifdef ALLOW_EXCH2  #ifdef ALLOW_DEPTH_CONTROL
25  #include "W2_EXCH2_SIZE.h"  # ifdef ALLOW_AUTODIFF_TAMC
26  #include "W2_EXCH2_TOPOLOGY.h"  #  include "tamc.h"
27  #endif /* ALLOW_EXCH2 */  #  include "tamc_keys.h"
28    # endif
29  #ifdef ALLOW_AUTODIFF_TAMC  #else /* ALLOW_DEPTH_CONTROL */
30  # include "tamc.h"  # ifdef ALLOW_EXCH2
31  # include "tamc_keys.h"  #  include "W2_EXCH2_SIZE.h"
32  #endif  #  include "W2_EXCH2_TOPOLOGY.h"
33    # endif
34    #endif /* ALLOW_DEPTH_CONTROL */
35    
36  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
37  C  bi,bj                :: tile indices  C  bi,bj      :: tile indices
38  C  k                    :: vertical level  C  k          :: vertical level
39  C  myThid               :: thread number  C  myThid     :: my Thread Id number
40        INTEGER bi,bj,k        INTEGER bi, bj, k
41        INTEGER myThid        INTEGER myThid
42    
43  C !OUTPUT PARAMETERS: ==================================================  C !OUTPUT PARAMETERS: ==================================================
44  C  hFacZ                :: fractional thickness at vorticity points  C  hFacZ      :: fractional thickness at vorticity points
45  C  r_hFacZ              :: reciprocal  C  r_hFacZ    :: reciprocal
46        _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
47        _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
48    
49  C !LOCAL VARIABLES: ====================================================  C !LOCAL VARIABLES: ====================================================
50  C  i,j                  :: loop indices  C  i,j        :: loop indices
51  C  hZoption   :: forward mode option to select the way hFacZ is computed:  C  hZoption   :: forward mode option to select the way hFacZ is computed:
52  C                0 : = minimum of 4 hFacW,hFacS arround (consistent with  C                0 : = minimum of 4 hFacW,hFacS arround (consistent with
53  C                    definition of partial cell & mask near topography)  C                    definition of partial cell & mask near topography)
# Line 53  C                1 : = minimum of 2 aver Line 55  C                1 : = minimum of 2 aver
55  C                2 : = average of 4 hFacW,hFacS arround (consistent with  C                2 : = average of 4 hFacW,hFacS arround (consistent with
56  C                    how free surface affects hFacW,hFacS it using r* and  C                    how free surface affects hFacW,hFacS it using r* and
57  C                    without topography)  C                    without topography)
58        INTEGER I,J        INTEGER i,j
59  #ifdef ALLOW_DEPTH_CONTROL  #ifdef ALLOW_DEPTH_CONTROL
60        _RL hFacZOpen(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL hFacZOpen (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61        _RL hFacZOpenI(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL hFacZOpenI(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
62        _RL hFacZOpenJ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL hFacZOpenJ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
63  # ifdef USE_SMOOTH_MIN  # ifdef USE_SMOOTH_MIN
64        _RS      SMOOTHMIN_RS        _RS      SMOOTHMIN_RS
65        EXTERNAL SMOOTHMIN_RS        EXTERNAL SMOOTHMIN_RS
66  # endif /* USE_SMOOTH_MIN */  # endif /* USE_SMOOTH_MIN */
67  #else  #else /* ALLOW_DEPTH_CONTROL */
68        _RS     hFacZOpen        _RS     hFacZOpen
69        INTEGER hZoption        INTEGER hZoption
70        LOGICAL northWestCorner, northEastCorner,        LOGICAL northWestCorner, northEastCorner,
71       &        southWestCorner, southEastCorner       &        southWestCorner, southEastCorner
72        INTEGER myFace        INTEGER myFace
73  #ifdef ALLOW_EXCH2  # ifdef ALLOW_EXCH2
74        INTEGER myTile        INTEGER myTile
75  #endif /* ALLOW_EXCH2 */  # endif /* ALLOW_EXCH2 */
 CEOP  
76        PARAMETER ( hZoption = 0 )        PARAMETER ( hZoption = 0 )
77  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_DEPTH_CONTROL */
78    CEOP
79    
80    C--   Calculate open water fraction at vorticity points
81    
 #ifdef ALLOW_AUTODIFF_TAMC  
82  #ifdef ALLOW_DEPTH_CONTROL  #ifdef ALLOW_DEPTH_CONTROL
83    
84    #ifdef ALLOW_AUTODIFF_TAMC
85            act1 = bi - myBxLo(myThid)            act1 = bi - myBxLo(myThid)
86            max1 = myBxHi(myThid) - myBxLo(myThid) + 1            max1 = myBxHi(myThid) - myBxLo(myThid) + 1
87            act2 = bj - myByLo(myThid)            act2 = bj - myByLo(myThid)
# Line 88  CEOP Line 93  CEOP
93       &                      + act3*max1*max2       &                      + act3*max1*max2
94       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
95            kkey = (ikey-1)*Nr + k            kkey = (ikey-1)*Nr + k
 #endif /* ALLOW_DEPTH_CONTROL */  
96  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
97    
 C--   Calculate open water fraction at vorticity points  
   
 #ifdef ALLOW_DEPTH_CONTROL  
98        DO j=1-OLy,sNy+OLy        DO j=1-OLy,sNy+OLy
99         DO i=1-OLx,sNx+OLx         DO i=1-OLx,sNx+OLx
100          hFacZ(i,j)     =0.          hFacZ(i,j)     =0.
101          r_hFacZ(i,j)   =0.          r_hFacZ(i,j)   =0.
102          hFacZOpen(i,j) =0.          hFacZOpen(i,j) =0.
103          hFacZOpenJ(i,j)=0.          hFacZOpenI(i,j)=0.
104          hFacZOpenJ(i,j)=0.          hFacZOpenJ(i,j)=0.
105         ENDDO         ENDDO
106        ENDDO        ENDDO
# Line 128  CADJ STORE    r_hFacZ(:,:) = comlev1_bib Line 129  CADJ STORE    r_hFacZ(:,:) = comlev1_bib
129       &         *maskS(i,j,k,bi,bj)*maskS(i-1,j,k,bi,bj)       &         *maskS(i,j,k,bi,bj)*maskS(i-1,j,k,bi,bj)
130         ENDDO         ENDDO
131        ENDDO        ENDDO
132  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
 #ifdef ALLOW_DEPTH_CONTROL  
133  CADJ STORE hFacZOpenI(:,:) = comlev1_bibj_k , key=kkey, byte=isbyte  CADJ STORE hFacZOpenI(:,:) = comlev1_bibj_k , key=kkey, byte=isbyte
134  CADJ STORE hFacZOpenJ(:,:) = comlev1_bibj_k , key=kkey, byte=isbyte  CADJ STORE hFacZOpenJ(:,:) = comlev1_bibj_k , key=kkey, byte=isbyte
135  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_AUTODIFF_TAMC */
 #endif    /* ALLOW_AUTODIFF_TAMC */  
136        DO j=2-OLy,sNy+OLy        DO j=2-OLy,sNy+OLy
137         DO i=2-OLx,sNx+OLx         DO i=2-OLx,sNx+OLx
138          hFacZ(i,j) =          hFacZ(i,j) =
# Line 146  CADJ STORE hFacZOpenJ(:,:) = comlev1_bib Line 145  CADJ STORE hFacZOpenJ(:,:) = comlev1_bib
145       &         *maskS(i,j,k,bi,bj)*maskS(i-1,j,k,bi,bj)       &         *maskS(i,j,k,bi,bj)*maskS(i-1,j,k,bi,bj)
146         ENDDO         ENDDO
147        ENDDO        ENDDO
148  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
 #ifdef ALLOW_DEPTH_CONTROL  
149  CADJ STORE hFacZ(:,:) = comlev1_bibj_k , key=kkey, byte=isbyte  CADJ STORE hFacZ(:,:) = comlev1_bibj_k , key=kkey, byte=isbyte
150  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_AUTODIFF_TAMC */
 #endif    /* ALLOW_AUTODIFF_TAMC */  
151        DO j=2-OLy,sNy+OLy        DO j=2-OLy,sNy+OLy
152         DO i=2-OLx,sNx+OLx         DO i=2-OLx,sNx+OLx
153          IF (hFacZ(i,j).EQ.0.) THEN          IF (hFacZ(i,j).EQ.0.) THEN
154           r_hFacZ(i,j)=0.           r_hFacZ(i,j) = 0. _d 0
155          ELSE          ELSE
156           r_hFacZ(i,j)=1./hFacZ(i,j)           r_hFacZ(i,j) = 1. _d 0/hFacZ(i,j)
157          ENDIF          ENDIF
158         ENDDO         ENDDO
159        ENDDO        ENDDO
160  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
 #ifdef ALLOW_DEPTH_CONTROL  
161  CADJ STORE    r_hFacZ(:,:) = comlev1_bibj_k , key=kkey, byte=isbyte  CADJ STORE    r_hFacZ(:,:) = comlev1_bibj_k , key=kkey, byte=isbyte
162  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_AUTODIFF_TAMC */
 #endif    /* ALLOW_AUTODIFF_TAMC */  
163    
164  #else /* not ALLOW_DEPTH_CONTROL */  #else /* not ALLOW_DEPTH_CONTROL */
165    
# Line 235  c         hFacZ(i,j) = 0.5 _d 0 * hFacZO Line 230  c         hFacZ(i,j) = 0.5 _d 0 * hFacZO
230          ENDDO          ENDDO
231        ENDIF        ENDIF
232    
233  C---+----1----+----2----+----3----+----4  C-----------------------------------------
234  C     Special stuff for Cubed Sphere  C     Special stuff for Cubed Sphere
235        IF ( useCubedSphereExchange .AND. hZoption.GE.1 ) THEN        IF ( useCubedSphereExchange .AND. hZoption.GE.1 ) THEN
236    
# Line 243  C     Special stuff for Cubed Sphere Line 238  C     Special stuff for Cubed Sphere
238          myTile = W2_myTileList(bi,bj)          myTile = W2_myTileList(bi,bj)
239          myFace = exch2_myFace(myTile)          myFace = exch2_myFace(myTile)
240          southWestCorner = exch2_isWedge(myTile).EQ.1          southWestCorner = exch2_isWedge(myTile).EQ.1
241       &               .AND. exch2_isSedge(myTile).EQ.1       &              .AND. exch2_isSedge(myTile).EQ.1
242          southEastCorner = exch2_isEedge(myTile).EQ.1          southEastCorner = exch2_isEedge(myTile).EQ.1
243       &              .AND. exch2_isSedge(myTile).EQ.1       &              .AND. exch2_isSedge(myTile).EQ.1
244          northEastCorner = exch2_isEedge(myTile).EQ.1          northEastCorner = exch2_isEedge(myTile).EQ.1
# Line 258  C     Special stuff for Cubed Sphere Line 253  C     Special stuff for Cubed Sphere
253          northEastCorner = .TRUE.          northEastCorner = .TRUE.
254  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
255    
   
256          IF ( southWestCorner ) THEN          IF ( southWestCorner ) THEN
257           i=1           i=1
258           j=1           j=1
# Line 284  C     Special stuff for Cubed Sphere Line 278  C     Special stuff for Cubed Sphere
278          ENDIF          ENDIF
279    
280          IF ( southEastCorner ) THEN          IF ( southEastCorner ) THEN
281           I=sNx+1           i=sNx+1
282           J=1           j=1
283  C-    to get the same truncation, independent from the face Nb:  C-    to get the same truncation, independent from the face Nb:
284           IF ( hZoption.EQ.1 ) THEN           IF ( hZoption.EQ.1 ) THEN
285            hFacZOpen=MIN(_hFacW(i,j,k,bi,bj),            hFacZOpen=MIN(_hFacW(i,j,k,bi,bj),
# Line 368  C-    to get the same truncation, indepe Line 362  C-    to get the same truncation, indepe
362          ENDIF          ENDIF
363    
364        ENDIF        ENDIF
365  C---+----1----+----2----+----3----+----4  C     Special Cubed Sphere block ends here
366    C-----------------------------------------
367    
368  C--   Calculate reciprol:  C--   Calculate reciprol:
369        DO j=1-OLy,sNy+OLy        DO j=1-OLy,sNy+OLy
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22