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 |
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) |
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) |
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 |
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) = |
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 |
|
|
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 |
|
|
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 |
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 |
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), |
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 |