model/src/update_r_star.F

00b29feb62 Jean*0001 #include "CPP_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: UPDATE_R_STAR
                0005 C     !INTERFACE:
72a058b866 Gael*0006       SUBROUTINE UPDATE_R_STAR( useLatest, myTime, myIter, myThid )
2c5c5e9c4a Jean*0007
00b29feb62 Jean*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
2c5c5e9c4a Jean*0010 C     | SUBROUTINE UPDATE_R_STAR
                0011 C     | o Update the thickness fractions (hFacC,W,S)
                0012 C     |   according to the surface r-position = Non-Linear FrSurf
00b29feb62 Jean*0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 C     == Global variables
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
                0023 #include "SURFACE.h"
                0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     == Routine arguments ==
2c5c5e9c4a Jean*0027 C     useLatest :: if true use rStarFacC, else use rStarFacNm1C
                0028 C     myTime    :: Current time in simulation
                0029 C     myIter    :: Current iteration number in simulation
                0030 C     myThid    :: Thread number for this instance of the routine.
72a058b866 Gael*0031       LOGICAL useLatest
00b29feb62 Jean*0032       _RL myTime
                0033       INTEGER myIter
                0034       INTEGER myThid
                0035
                0036 C     !LOCAL VARIABLES:
                0037 #ifdef NONLIN_FRSURF
                0038 C     Local variables
2c5c5e9c4a Jean*0039 C     i,j,k,bi,bj :: loop counter
00b29feb62 Jean*0040       INTEGER i,j,k,bi,bj
                0041 CEOP
                0042
                0043       DO bj=myByLo(myThid), myByHi(myThid)
2c5c5e9c4a Jean*0044        DO bi=myBxLo(myThid), myBxHi(myThid)
f36344f45a Patr*0045
00b29feb62 Jean*0046 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0047
72a058b866 Gael*0048        IF (useLatest) THEN
                0049
00b29feb62 Jean*0050         DO k=1,Nr
cab62edf37 Ou W*0051          DO j=1-OLy,sNy+OLy
                0052           DO i=1-OLx,sNx+OLx
0499e7ef48 Patr*0053 # ifndef DISABLE_RSTAR_CODE
00b29feb62 Jean*0054 C-- Update the fractional thickness hFacC , hFacW & hFacS (& "recip_hFac") :
                0055             hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
                0056      &                          *rStarFacC(i,j,bi,bj)
                0057             hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
                0058      &                          *rStarFacW(i,j,bi,bj)
                0059             hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
                0060      &                          *rStarFacS(i,j,bi,bj)
0499e7ef48 Patr*0061 #endif
                0062 C
00b29feb62 Jean*0063 #ifdef USE_MASK_AND_NO_IF
                0064             recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj)
616600b8d2 Patr*0065      &        / ( _hFacC(i,j,k,bi,bj) + (1.-maskC(i,j,k,bi,bj)) )
00b29feb62 Jean*0066             recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj)
616600b8d2 Patr*0067      &        / ( _hFacW(i,j,k,bi,bj) + (1.-maskW(i,j,k,bi,bj)) )
00b29feb62 Jean*0068             recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj)
616600b8d2 Patr*0069      &        / ( _hFacS(i,j,k,bi,bj) + (1.-maskS(i,j,k,bi,bj)) )
00b29feb62 Jean*0070 #else
                0071            IF (maskC(i,j,k,bi,bj).NE.0.)
616600b8d2 Patr*0072      &      recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / _hFacC(i,j,k,bi,bj)
00b29feb62 Jean*0073            IF (maskW(i,j,k,bi,bj).NE.0.)
616600b8d2 Patr*0074      &      recip_hFacW(i,j,k,bi,bj) = 1. _d 0 / _hFacW(i,j,k,bi,bj)
00b29feb62 Jean*0075            IF (maskS(i,j,k,bi,bj).NE.0.)
616600b8d2 Patr*0076      &      recip_hFacS(i,j,k,bi,bj) = 1. _d 0 / _hFacS(i,j,k,bi,bj)
00b29feb62 Jean*0077 #endif
                0078           ENDDO
                0079          ENDDO
                0080         ENDDO
                0081
72a058b866 Gael*0082        ELSE
                0083
                0084         DO k=1,Nr
cab62edf37 Ou W*0085          DO j=1-OLy,sNy+OLy
                0086           DO i=1-OLx,sNx+OLx
72a058b866 Gael*0087 # ifndef DISABLE_RSTAR_CODE
                0088 C-- Update the fractional thickness hFacC , hFacW & hFacS (&
                0089 C"recip_hFac") :
                0090             hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
                0091      &                          *rStarFacNm1C(i,j,bi,bj)
                0092             hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
                0093      &                          *rStarFacNm1W(i,j,bi,bj)
                0094             hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
                0095      &                          *rStarFacNm1S(i,j,bi,bj)
                0096 #endif
                0097 C
                0098 #ifdef USE_MASK_AND_NO_IF
cab62edf37 Ou W*0099             recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj) /
                0100      &        ( _hFacC(i,j,k,bi,bj) + (oneRS - maskC(i,j,k,bi,bj)) )
                0101             recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj) /
                0102      &        ( _hFacW(i,j,k,bi,bj) + (oneRS - maskW(i,j,k,bi,bj)) )
                0103             recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj) /
                0104      &        ( _hFacS(i,j,k,bi,bj) + (oneRS - maskS(i,j,k,bi,bj)) )
72a058b866 Gael*0105 #else
cab62edf37 Ou W*0106             IF ( maskC(i,j,k,bi,bj).NE.zeroRS )
                0107      &        recip_hFacC(i,j,k,bi,bj) = oneRS / _hFacC(i,j,k,bi,bj)
                0108             IF ( maskW(i,j,k,bi,bj).NE.zeroRS )
                0109      &        recip_hFacW(i,j,k,bi,bj) = oneRS / _hFacW(i,j,k,bi,bj)
                0110             IF ( maskS(i,j,k,bi,bj).NE.zeroRS )
                0111      &        recip_hFacS(i,j,k,bi,bj) = oneRS / _hFacS(i,j,k,bi,bj)
72a058b866 Gael*0112 #endif
                0113           ENDDO
                0114          ENDDO
                0115         ENDDO
                0116
                0117        ENDIF
                0118
00b29feb62 Jean*0119 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0120
                0121 C- end bi,bj loop
                0122        ENDDO
                0123       ENDDO
                0124
                0125 c     _EXCH_XYZ_RS( hFacC, myThid )
                0126 c     _EXCH_XYZ_RS( recip_hFacC, myThid )
                0127 c     CALL EXCH_UV_XYZ_RS(hFacW,hFacS,.FALSE.,myThid)
                0128 c     CALL EXCH_UV_XYZ_RS(recip_hFacW,recip_hFacS,.FALSE.,myThid)
                0129
                0130 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0131 #endif /* NONLIN_FRSURF */
                0132
                0133       RETURN
                0134       END