/[MITgcm]/MITgcm_contrib/shelfice_remeshing/CLEAN/code/shelfice_update_masks.F
ViewVC logotype

Annotation of /MITgcm_contrib/shelfice_remeshing/CLEAN/code/shelfice_update_masks.F

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


Revision 1.4 - (hide annotations) (download)
Fri Jan 22 10:26:50 2016 UTC (9 years, 6 months ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +0 -0 lines
Overlap bug fixing

1 dgoldberg 1.2 C $Header: /u/gcmpack/MITgcm_contrib/verification_other/shelfice_remeshing/code/shelfice_update_masks.F,v 1.1 2015/12/11 19:48:32 dgoldberg Exp $
2 dgoldberg 1.1 C $Name: $
3    
4     #include "SHELFICE_OPTIONS.h"
5     #ifdef ALLOW_CTRL
6     # include "CTRL_OPTIONS.h"
7     #endif
8    
9     CBOP
10     C !ROUTINE: SHELFICE_UPDATE_MASKS
11     C !INTERFACE:
12     SUBROUTINE SHELFICE_UPDATE_MASKS(
13     I rF, recip_drF,
14     U hFacC,
15     I myThid )
16     C !DESCRIPTION: \bv
17     C *==========================================================*
18     C | SUBROUTINE SHELFICE_UPDATE_MASKS
19     C | o modify topography factor hFacC according to ice shelf
20     C | topography
21     C *==========================================================*
22     C \ev
23    
24     C !USES:
25     IMPLICIT NONE
26     C === Global variables ===
27     #include "SIZE.h"
28     #include "EEPARAMS.h"
29     #include "PARAMS.h"
30     #ifdef ALLOW_SHELFICE
31     # include "SHELFICE.h"
32     #endif /* ALLOW_SHELFICE */
33    
34     C !INPUT/OUTPUT PARAMETERS:
35     C == Routine arguments ==
36     C rF :: R-coordinate of face of cell (units of r).
37     C recip_drF :: Recipricol of cell face separation along Z axis ( units of r ).
38     C hFacC :: Fraction of cell in vertical which is open (see GRID.h)
39     C myThid :: Number of this instance of SHELFICE_UPDATE_MASKS
40     _RS rF (1:Nr+1)
41     _RS recip_drF (1:Nr)
42     _RS hFacC (1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
43     INTEGER myThid
44    
45     #ifdef ALLOW_SHELFICE
46     C !LOCAL VARIABLES:
47     C == Local variables ==
48     C bi,bj :: tile indices
49     C I,J,K :: Loop counters
50     INTEGER bi, bj
51     INTEGER I, J, K
52     _RL hFacCtmp
53     _RL hFacMnSz
54     CEOP
55    
56     C initialize R_shelfIce
57     DO bj = myByLo(myThid), myByHi(myThid)
58     DO bi = myBxLo(myThid), myBxHi(myThid)
59     DO j=1-OLy,sNy+OLy
60     DO i=1-OLx,sNx+OLx
61     R_shelfIce(i,j,bi,bj) = 0. _d 0
62     R_Grounding(i,j,bi,bj) = 0. _d 0
63     ENDDO
64     ENDDO
65     ENDDO
66     ENDDO
67    
68     IF ( SHELFICEtopoFile .NE. ' ' ) THEN
69     _BARRIER
70     C Read the shelfIce draught using the mid-level I/O pacakage read_write_rec
71     C The 0 is the "iteration" argument. The 1 is the record number.
72     CALL READ_REC_XY_RS( SHELFICEtopoFile, R_shelfIce,
73     & 1, 0, myThid )
74    
75     CALL READ_REC_XY_RS( SHELFICEGroundTopoFile, R_Grounding,
76     & 1, 0, myThid )
77    
78     C Read the shelfIce draught using the mid-level I/O pacakage read_write_fld
79     C The 0 is the "iteration" argument. The ' ' is an empty suffix
80     C CALL READ_FLD_XY_RS( SHELFICEtopoFile, ' ', R_shelfIce,
81     C & 0, myThid )
82     ENDIF
83     C- end setup R_shelfIce in the interior
84    
85     C- fill in the overlap (+ BARRIER):
86     _EXCH_XY_RS(R_shelfIce, myThid )
87     _EXCH_XY_RS(R_Grounding, myThid )
88    
89     C-- Calculate lopping factor hFacC : Remove part outside of the domain
90     C taking into account the Reference (=at rest) Surface Position Ro_shelfIce
91     DO bj=myByLo(myThid), myByHi(myThid)
92     DO bi=myBxLo(myThid), myBxHi(myThid)
93    
94     C-- compute contributions of shelf ice to looping factors
95     DO K=1, Nr
96     hFacMnSz=max( hFacMin, min(hFacMinDr*recip_drF(k),1. _d 0) )
97     DO J=1-OLy,sNy+OLy
98     DO I=1-OLx,sNx+OLx
99     C o Non-dimensional distance between grid boundary and model surface
100     hFacCtmp = (rF(k)-R_shelfIce(I,J,bi,bj))*recip_drF(K)
101     C o Reduce the previous fraction : substract the outside part.
102     hFacCtmp = hFacC(I,J,K,bi,bj) - max( hFacCtmp, 0. _d 0)
103     C o set to zero if empty Column :
104     hFacCtmp = max( hFacCtmp, 0. _d 0)
105     C o Impose minimum fraction and/or size (dimensional)
106     IF (hFacCtmp.LT.hFacMnSz) THEN
107     IF (hFacCtmp.LT.hFacMnSz*0.5) THEN
108     hFacC(I,J,K,bi,bj)=0.
109     ELSE
110     hFacC(I,J,K,bi,bj)=hFacMnSz
111     ENDIF
112     ELSE
113     hFacC(I,J,K,bi,bj)=hFacCtmp
114     ENDIF
115     ENDDO
116     ENDDO
117     ENDDO
118    
119     #ifdef ALLOW_SHIFWFLX_CONTROL
120     C maskSHI is a hack to play along with the general ctrl-package
121     C infrastructure, where only the k=1 layer of a 3D mask is used
122     C for 2D fields. We cannot use maskInC instead, because routines
123     C like ctrl_get_gen and ctrl_set_unpack_xy require 3D masks.
124     DO K=1,Nr
125     DO J=1-OLy,sNy+OLy
126     DO I=1-OLx,sNx+OLx
127     maskSHI(I,J,K,bi,bj) = 0. _d 0
128     ENDDO
129     ENDDO
130     ENDDO
131     DO K=1,Nr
132     DO J=1-OLy,sNy+OLy
133     DO I=1-OLx,sNx+OLx
134     IF ( ABS(R_shelfice(I,J,bi,bj)) .GT. 0. _d 0
135     & .AND. hFacC(I,J,K,bi,bj) .NE. 0. _d 0 ) THEN
136     maskSHI(I,J,K,bi,bj) = 1. _d 0
137     maskSHI(I,J,1,bi,bj) = 1. _d 0
138     ENDIF
139     ENDDO
140     ENDDO
141     ENDDO
142     #endif /* ALLOW_SHIFWFLX_CONTROL */
143    
144     C - end bi,bj loops.
145     ENDDO
146     ENDDO
147     #endif /* ALLOW_SHELFICE */
148    
149     RETURN
150     END

  ViewVC Help
Powered by ViewVC 1.1.22