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

Annotation of /MITgcm/model/src/update_r_star.F

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


Revision 1.1 - (hide annotations) (download)
Sun Jan 26 21:06:11 2003 UTC (21 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint48b_post
r* coordinate added in #ifdef NONLIN_FRSURF block.
 (modification to pressure gradient not yet implemented)

1 jmc 1.1 C $Header: $
2     C $Name: $
3    
4     #include "CPP_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: UPDATE_R_STAR
8     C !INTERFACE:
9     SUBROUTINE UPDATE_R_STAR( myTime, myIter, myThid )
10     C !DESCRIPTION: \bv
11     C *==========================================================*
12     C | SUBROUTINE UPDATE_R_STAR
13     C | o Update the thickness fractions (hFacC,W,S)
14     C | according to the surface r-position = Non-Linear FrSurf
15     C *==========================================================*
16     C \ev
17    
18     C !USES:
19     IMPLICIT NONE
20     C == Global variables
21     #include "SIZE.h"
22     #include "EEPARAMS.h"
23     #include "PARAMS.h"
24     c #include "DYNVARS.h"
25     #include "GRID.h"
26     #include "SURFACE.h"
27    
28     C !INPUT/OUTPUT PARAMETERS:
29     C == Routine arguments ==
30     C myTime - Current time in simulation
31     C myIter - Current iteration number in simulation
32     C myThid - Thread number for this instance of the routine.
33     _RL myTime
34     INTEGER myIter
35     INTEGER myThid
36    
37     C !LOCAL VARIABLES:
38     #ifdef NONLIN_FRSURF
39     C Local variables
40     C i,j,k,bi,bj - loop counter
41     INTEGER i,j,k,bi,bj
42     CEOP
43    
44     DO bj=myByLo(myThid), myByHi(myThid)
45     DO bi=myBxLo(myThid), myBxHi(myThid)
46    
47     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
48    
49     c #ifdef ALLOW_OBCS
50     c C-- Apply OBC to hFac_surfW,S before updating hFacW,S
51     c IF (useOBCS) CALL OBCS_APPLY_SURF_DR(
52     c I bi, bj, ksurfC, ksurfW, ksurfS,
53     c U hFac_surfC, hFac_surfW, hFac_surfS,
54     c I myThid )
55     c #endif /* ALLOW_OBCS */
56    
57     DO k=1,Nr
58     DO j=1-Oly,sNy+Oly
59     DO i=1-Olx,sNx+Olx
60     C-- Update the fractional thickness hFacC , hFacW & hFacS (& "recip_hFac") :
61     hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
62     & *rStarFacC(i,j,bi,bj)
63     hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
64     & *rStarFacW(i,j,bi,bj)
65     hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
66     & *rStarFacS(i,j,bi,bj)
67     #ifdef USE_MASK_AND_NO_IF
68     recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj)
69     & / ( hFacC(i,j,k,bi,bj) + (1.-maskC(i,j,k,bi,bj)) )
70     recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj)
71     & / ( hFacW(i,j,k,bi,bj) + (1.-maskW(i,j,k,bi,bj)) )
72     recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj)
73     & / ( hFacS(i,j,k,bi,bj) + (1.-maskS(i,j,k,bi,bj)) )
74     #else
75     IF (maskC(i,j,k,bi,bj).NE.0.)
76     & recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / hFacC(i,j,k,bi,bj)
77     IF (maskW(i,j,k,bi,bj).NE.0.)
78     & recip_hFacW(i,j,k,bi,bj) = 1. _d 0 / hFacW(i,j,k,bi,bj)
79     IF (maskS(i,j,k,bi,bj).NE.0.)
80     & recip_hFacS(i,j,k,bi,bj) = 1. _d 0 / hFacS(i,j,k,bi,bj)
81     #endif
82     ENDDO
83     ENDDO
84     ENDDO
85    
86     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
87    
88     C- end bi,bj loop
89     ENDDO
90     ENDDO
91    
92     c _EXCH_XYZ_RS( hFacC, myThid )
93     c _EXCH_XYZ_RS( recip_hFacC, myThid )
94     c CALL EXCH_UV_XYZ_RS(hFacW,hFacS,.FALSE.,myThid)
95     c CALL EXCH_UV_XYZ_RS(recip_hFacW,recip_hFacS,.FALSE.,myThid)
96    
97     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
98     #endif /* NONLIN_FRSURF */
99    
100     RETURN
101     END

  ViewVC Help
Powered by ViewVC 1.1.22