C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/obcs/obcs_apply_r_star.F,v 1.1 2003/01/30 00:05:30 jmc Exp $ C $Name: checkpoint51l_post $ #include "OBCS_OPTIONS.h" SUBROUTINE OBCS_APPLY_R_STAR( I bi, bj, ksurfC, ksurfW, ksurfS, U rStarFldC, rStarFldW, rStarFldS, I myTime, myIter, myThid ) C *==========================================================* C | S/R OBCS_APPLY_R_STAR C *==========================================================* IMPLICIT NONE C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "GRID.h" #include "OBCS.h" C == Routine Arguments == INTEGER bi,bj INTEGER ksurfC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) INTEGER ksurfW(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) INTEGER ksurfS(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL rStarFldC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL rStarFldW(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL rStarFldS(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL myTime INTEGER myIter, myThid #ifdef ALLOW_OBCS #ifdef NONLIN_FRSURF C == Local variables == INTEGER i,j C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| C- Set model rStar_Factor to OB values on North/South Boundaries DO i=1-Olx,sNx+Olx C Northern boundary j = OB_Jn(i,bi,bj) IF (j.NE.0) THEN rStarFldS(i,j,bi,bj) = 1. _d 0 IF (ksurfS(i,j,bi,bj).LE.Nr) THEN rStarFldS(i,j,bi,bj) = 1. _d 0 & + OBNeta(i,bi,bj) & *MAX(recip_Rcol(i,j-1,bi,bj),recip_Rcol(i,j,bi,bj)) ENDIF ENDIF C Southern boundary j = OB_Js(i,bi,bj) IF (j.NE.0) THEN rStarFldS(i,j+1,bi,bj) = 1. _d 0 IF (ksurfS(i,j+1,bi,bj).LE.Nr) THEN rStarFldS(i,j+1,bi,bj) = 1. _d 0 & + OBSeta(i,bi,bj) & *MAX(recip_Rcol(i,j+1,bi,bj),recip_Rcol(i,j,bi,bj)) ENDIF ENDIF ENDDO C- Set model rStar_Factor to OB values on East/West Boundaries DO j=1-Oly,sNy+Oly C Eastern boundary i = OB_Ie(J,bi,bj) IF (i.NE.0) THEN rStarFldW(i,j,bi,bj) = 1. _d 0 IF (ksurfW(i,j,bi,bj).LE.Nr) THEN rStarFldW(i,j,bi,bj) = 1. _d 0 & + OBEeta(i,bi,bj) & *MAX(recip_Rcol(i-1,j,bi,bj),recip_Rcol(i,j,bi,bj)) ENDIF ENDIF C Western boundary i = OB_Iw(j,bi,bj) IF (i.NE.0) THEN rStarFldW(i+1,j,bi,bj) = 1. _d 0 IF (ksurfW(i+1,j,bi,bj).LE.Nr) THEN rStarFldW(i+1,j,bi,bj) = 1. _d 0 & + OBWeta(i,bi,bj) & *MAX(recip_Rcol(i+1,j,bi,bj),recip_Rcol(i,j,bi,bj)) ENDIF ENDIF ENDDO C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| #endif /* NONLIN_FRSURF */ #endif /* ALLOW_OBCS */ RETURN END