C $Header: /u/gcmpack/MITgcm/model/src/update_r_star.F,v 1.9 2011/05/20 01:09:37 jmc Exp $ C $Name: $ #include "CPP_OPTIONS.h" CBOP C !ROUTINE: UPDATE_R_STAR C !INTERFACE: SUBROUTINE UPDATE_R_STAR( useLatest, myTime, myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE UPDATE_R_STAR C | o Update the thickness fractions (hFacC,W,S) C | according to the surface r-position = Non-Linear FrSurf C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "GRID.h" #include "SURFACE.h" C !INPUT/OUTPUT PARAMETERS: C == Routine arguments == C useLatest :: if true use rStarFacC, else use rStarFacNm1C C myTime :: Current time in simulation C myIter :: Current iteration number in simulation C myThid :: Thread number for this instance of the routine. LOGICAL useLatest _RL myTime INTEGER myIter INTEGER myThid C !LOCAL VARIABLES: #ifdef NONLIN_FRSURF C Local variables C i,j,k,bi,bj :: loop counter INTEGER i,j,k,bi,bj CEOP DO bj=myByLo(myThid), myByHi(myThid) DO bi=myBxLo(myThid), myBxHi(myThid) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| IF (useLatest) THEN DO k=1,Nr DO j=1-Oly,sNy+Oly DO i=1-Olx,sNx+Olx # ifndef DISABLE_RSTAR_CODE C-- Update the fractional thickness hFacC , hFacW & hFacS (& "recip_hFac") : hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj) & *rStarFacC(i,j,bi,bj) hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj) & *rStarFacW(i,j,bi,bj) hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj) & *rStarFacS(i,j,bi,bj) #endif C #ifdef USE_MASK_AND_NO_IF recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj) & / ( _hFacC(i,j,k,bi,bj) + (1.-maskC(i,j,k,bi,bj)) ) recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj) & / ( _hFacW(i,j,k,bi,bj) + (1.-maskW(i,j,k,bi,bj)) ) recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj) & / ( _hFacS(i,j,k,bi,bj) + (1.-maskS(i,j,k,bi,bj)) ) #else IF (maskC(i,j,k,bi,bj).NE.0.) & recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / _hFacC(i,j,k,bi,bj) IF (maskW(i,j,k,bi,bj).NE.0.) & recip_hFacW(i,j,k,bi,bj) = 1. _d 0 / _hFacW(i,j,k,bi,bj) IF (maskS(i,j,k,bi,bj).NE.0.) & recip_hFacS(i,j,k,bi,bj) = 1. _d 0 / _hFacS(i,j,k,bi,bj) #endif ENDDO ENDDO ENDDO ELSE DO k=1,Nr DO j=1-Oly,sNy+Oly DO i=1-Olx,sNx+Olx # ifndef DISABLE_RSTAR_CODE C-- Update the fractional thickness hFacC , hFacW & hFacS (& C"recip_hFac") : hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj) & *rStarFacNm1C(i,j,bi,bj) hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj) & *rStarFacNm1W(i,j,bi,bj) hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj) & *rStarFacNm1S(i,j,bi,bj) #endif C #ifdef USE_MASK_AND_NO_IF recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj) & / ( _hFacC(i,j,k,bi,bj) + (1.-maskC(i,j,k,bi,bj)) ) recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj) & / ( _hFacW(i,j,k,bi,bj) + (1.-maskW(i,j,k,bi,bj)) ) recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj) & / ( _hFacS(i,j,k,bi,bj) + (1.-maskS(i,j,k,bi,bj)) ) #else IF (maskC(i,j,k,bi,bj).NE.0.) & recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / _hFacC(i,j,k,bi,bj) IF (maskW(i,j,k,bi,bj).NE.0.) & recip_hFacW(i,j,k,bi,bj) = 1. _d 0 / _hFacW(i,j,k,bi,bj) IF (maskS(i,j,k,bi,bj).NE.0.) & recip_hFacS(i,j,k,bi,bj) = 1. _d 0 / _hFacS(i,j,k,bi,bj) #endif ENDDO ENDDO ENDDO ENDIF C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| C- end bi,bj loop ENDDO ENDDO c _EXCH_XYZ_RS( hFacC, myThid ) c _EXCH_XYZ_RS( recip_hFacC, myThid ) c CALL EXCH_UV_XYZ_RS(hFacW,hFacS,.FALSE.,myThid) c CALL EXCH_UV_XYZ_RS(recip_hFacW,recip_hFacS,.FALSE.,myThid) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| #endif /* NONLIN_FRSURF */ RETURN END