model/src/update_surf_dr.F

be47244872 Jean*0001 #include "CPP_OPTIONS.h"
                0002
9366854e02 Chri*0003 CBOP
                0004 C     !ROUTINE: UPDATE_SURF_DR
                0005 C     !INTERFACE:
72a058b866 Gael*0006       SUBROUTINE UPDATE_SURF_DR( useLatest, myTime, myIter, myThid )
6c49d7f2f2 Jean*0007
9366854e02 Chri*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
6c49d7f2f2 Jean*0010 C     | SUBROUTINE UPDATE_SURF_DR
                0011 C     | o Update the surface-level thickness fraction (hFacC,W,S)
                0012 C     |   according to the surface r-position = Non-Linear FrSurf
9366854e02 Chri*0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
be47244872 Jean*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
9366854e02 Chri*0025 C     !INPUT/OUTPUT PARAMETERS:
be47244872 Jean*0026 C     == Routine arguments ==
6c49d7f2f2 Jean*0027 C     useLatest :: if true use hFac_surfC, else use hFac_surfNm1C
                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
be47244872 Jean*0032       _RL myTime
                0033       INTEGER myIter
                0034       INTEGER myThid
                0035
9366854e02 Chri*0036 C     !LOCAL VARIABLES:
be47244872 Jean*0037 #ifdef NONLIN_FRSURF
                0038 C     Local variables
7418e6b1e6 Jean*0039 C     i,j,bi,bj - loop counter
88f12b65e6 Gael*0040       INTEGER i,j,k,bi,bj
be47244872 Jean*0041       INTEGER ks
9366854e02 Chri*0042 CEOP
be47244872 Jean*0043
                0044       DO bj=myByLo(myThid), myByHi(myThid)
6c49d7f2f2 Jean*0045        DO bi=myBxLo(myThid), myBxHi(myThid)
f36344f45a Patr*0046
be47244872 Jean*0047 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8d8e492d23 Jean*0048
88f12b65e6 Gael*0049        IF (useLatest.AND.(nonlinFreeSurf.GT.0)) then
72a058b866 Gael*0050
6c49d7f2f2 Jean*0051 C-- Update the fractional thickness "hFacC" of the surface level kSurfC :
be47244872 Jean*0052         DO j=1-Oly,sNy+Oly
6c49d7f2f2 Jean*0053          DO i=1-Olx,sNx+Olx
                0054           ks = kSurfC(i,j,bi,bj)
be47244872 Jean*0055           IF (ks.LE.Nr) THEN
                0056            hFacC(i,j,ks,bi,bj) = hFac_surfC(i,j,bi,bj)
                0057            recip_hFacC(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfC(i,j,bi,bj)
                0058           ENDIF
                0059          ENDDO
                0060         ENDDO
                0061
                0062 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
6c49d7f2f2 Jean*0063 C-- Update fractional thickness "hFacW" & "hFacS" (at U and V points)
be47244872 Jean*0064
                0065         DO j=1-Oly,sNy+Oly
6c49d7f2f2 Jean*0066          DO i=2-Olx,sNx+Olx
                0067           ks = kSurfW(i,j,bi,bj)
be47244872 Jean*0068           IF (ks.LE.Nr) THEN
                0069            hFacW(i,j,ks,bi,bj) = hFac_surfW(i,j,bi,bj)
                0070            recip_hFacW(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfW(i,j,bi,bj)
                0071           ENDIF
                0072          ENDDO
                0073         ENDDO
                0074         DO j=2-Oly,sNy+Oly
6c49d7f2f2 Jean*0075          DO i=1-Olx,sNx+Olx
                0076           ks = kSurfS(i,j,bi,bj)
be47244872 Jean*0077           IF (ks.LE.Nr) THEN
                0078            hFacS(i,j,ks,bi,bj) = hFac_surfS(i,j,bi,bj)
                0079            recip_hFacS(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfS(i,j,bi,bj)
                0080           ENDIF
                0081          ENDDO
                0082         ENDDO
                0083
88f12b65e6 Gael*0084        ELSEIF (nonlinFreeSurf.GT.0) THEN
72a058b866 Gael*0085
6c49d7f2f2 Jean*0086 C-- Update the fractional thickness "hFacC" of the surface level kSurfC
72a058b866 Gael*0087 C:
                0088         DO j=1-Oly,sNy+Oly
                0089          DO i=1-Olx,sNx+Olx
6c49d7f2f2 Jean*0090           ks = kSurfC(i,j,bi,bj)
72a058b866 Gael*0091           IF (ks.LE.Nr) THEN
                0092            hFacC(i,j,ks,bi,bj) = hFac_surfNm1C(i,j,bi,bj)
                0093            recip_hFacC(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1C(i,j,bi,bj)
                0094           ENDIF
                0095          ENDDO
                0096         ENDDO
                0097
                0098 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
6c49d7f2f2 Jean*0099 C-- Update fractional thickness "hFacW" & "hFacS" (at U and V points)
72a058b866 Gael*0100
                0101         DO j=1-Oly,sNy+Oly
                0102          DO i=2-Olx,sNx+Olx
6c49d7f2f2 Jean*0103           ks = kSurfW(i,j,bi,bj)
72a058b866 Gael*0104           IF (ks.LE.Nr) THEN
                0105            hFacW(i,j,ks,bi,bj) = hFac_surfNm1W(i,j,bi,bj)
                0106            recip_hFacW(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1W(i,j,bi,bj)
                0107           ENDIF
                0108          ENDDO
                0109         ENDDO
                0110         DO j=2-Oly,sNy+Oly
                0111          DO i=1-Olx,sNx+Olx
6c49d7f2f2 Jean*0112           ks = kSurfS(i,j,bi,bj)
72a058b866 Gael*0113           IF (ks.LE.Nr) THEN
                0114            hFacS(i,j,ks,bi,bj) = hFac_surfNm1S(i,j,bi,bj)
                0115            recip_hFacS(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1S(i,j,bi,bj)
                0116           ENDIF
                0117          ENDDO
                0118         ENDDO
                0119
88f12b65e6 Gael*0120        ELSE
                0121
                0122         DO k=1,Nr
                0123          DO j=1-Oly,sNy+Oly
                0124           DO i=1-Olx,sNx+Olx
                0125            hFacC(i,j,k,bi,bj)=h0FacC(i,j,k,bi,bj)
                0126            IF (h0FacC(i,j,k,bi,bj) .NE. 0. ) THEN
                0127             recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / h0FacC(i,j,k,bi,bj)
                0128            ELSE
                0129             recip_hFacC(i,j,k,bi,bj) = 0.
                0130            ENDIF
                0131           ENDDO
                0132          ENDDO
                0133         ENDDO
                0134
72a058b866 Gael*0135        ENDIF
                0136
be47244872 Jean*0137 C- end bi,bj loop
                0138        ENDDO
                0139       ENDDO
                0140
                0141 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0142 #endif /* NONLIN_FRSURF */
                0143
                0144       RETURN
                0145       END