C $Header: /u/gcmpack/MITgcm/pkg/layers/layers_thermodynamics.F,v 1.5 2015/06/15 21:34:07 jmc Exp $ C $Name: $ #include "LAYERS_OPTIONS.h" C-- File layers_thermodynamics.F: C-- Contents C-- o LAYERS_CALC_RHS CBOP 0 C !ROUTINE: LAYERS_CALC_RHS C !INTERFACE: SUBROUTINE LAYERS_CALC_RHS( I myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE LAYERS_CALC_RHS C | Recalculate the divergence of the RHS terms in T and S eqns. C | Replaces the values of layers_surfflux, layers_df? IN PLACE C | with the corresponding tendencies (same units as GT and GS) C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "GRID.h" #include "FFIELDS.h" #include "LAYERS_SIZE.h" #include "LAYERS.h" C !INPUT PARAMETERS: C myThid :: my Thread Id number INTEGER myThid CEOP #ifdef ALLOW_LAYERS #ifdef LAYERS_THERMODYNAMICS C !LOCAL VARIABLES: C bi, bj :: tile indices C i,j :: horizontal indices C k :: vertical index for model grid C kdown :: temporary placeholder C fluxfac :: scaling factor for converting surface flux to tendency C fluxfac :: scaling factor for converting diffusive flux to tendency C downfac :: mask for lower point INTEGER bi, bj INTEGER i,j,k,kdown,iTracer _RL fluxfac(2), downfac, tmpfac c CHARACTER*(MAX_LEN_MBUF) msgBuf _RL minusone PARAMETER (minusOne=-1.) #ifdef SHORTWAVE_HEATING _RL swfracb(2) #endif C -- These factors convert the units of TFLUX and SFLUX diagnostics C -- back to surfaceForcingT and surfaceForcingS units fluxfac(1) = 1.0/(HeatCapacity_Cp*rUnit2mass) fluxfac(2) = 1.0/rUnit2mass DO bj = myByLo(myThid), myByHi(myThid) DO bi = myBxLo(myThid), myBxHi(myThid) DO iTracer = 1,2 k = 1 C -- Loop for surface fluxes DO j=1-OLy,sNy+OLy DO i=1-OLx,sNx+OLx #ifdef SHORTWAVE_HEATING C -- Have to remove the shortwave from the surface flux because it is added later IF (iTracer.EQ.1) THEN layers_surfflux(i,j,k,iTracer,bi,bj) = & layers_surfflux(i,j,k,iTracer,bi,bj) C -- Sign convention for Qsw means we have to add it to subtract it & +Qsw(i,j,bi,bj) ENDIF #endif /* SHORTWAVE_HEATING */ layers_surfflux(i,j,k,iTracer,bi,bj) = & layers_surfflux(i,j,k,iTracer,bi,bj) & *recip_drF(1)*_recip_hFacC(i,j,1,bi,bj) & *fluxfac(iTracer) ENDDO ENDDO C -- Loop for diffusive fluxes C -- If done correctly, we can overwrite the flux array in place C -- with its own divergence DO k=1,Nr kdown= MIN(k+1,Nr) IF (k.EQ.Nr) THEN downfac = 0. _d 0 ELSE downfac = 1. _d 0 ENDIF DO j=1-OLy,sNy+OLy-1 DO i=1-OLx,sNx+OLx-1 C -- Diffusion tmpfac = -_recip_hFacC(i,j,k,bi,bj)*recip_drF(k) & *recip_rA(i,j,bi,bj)*recip_deepFac2C(k)*recip_rhoFacC(k) layers_dfx(i,j,k,iTracer,bi,bj) = maskInC(i,j,bi,bj) * & tmpfac * ( layers_dfx(i+1,j,k,iTracer,bi,bj) - & layers_dfx(i,j,k,iTracer,bi,bj) ) layers_dfy(i,j,k,iTracer,bi,bj) = maskInC(i,j,bi,bj) * & tmpfac * ( layers_dfy(i,j+1,k,iTracer,bi,bj) - & layers_dfy(i,j,k,iTracer,bi,bj) ) layers_dfr(i,j,k,iTracer,bi,bj) = tmpfac * rkSign * & ( layers_dfr(i,j,kdown,iTracer,bi,bj)*downfac - & layers_dfr(i,j,k,iTracer,bi,bj) ) C -- Advection layers_afx(i,j,k,iTracer,bi,bj) = maskInC(i,j,bi,bj) * & tmpfac * ( layers_afx(i+1,j,k,iTracer,bi,bj) - & layers_afx(i,j,k,iTracer,bi,bj) ) layers_afy(i,j,k,iTracer,bi,bj) = maskInC(i,j,bi,bj) * & tmpfac * ( layers_afy(i,j+1,k,iTracer,bi,bj) - & layers_afy(i,j,k,iTracer,bi,bj) ) layers_afr(i,j,k,iTracer,bi,bj) = tmpfac * rkSign * & ( layers_afr(i,j,kdown,iTracer,bi,bj)*downfac - & layers_afr(i,j,k,iTracer,bi,bj) ) #ifdef SHORTWAVE_HEATING IF (iTracer.EQ.1) THEN swfracb(1)=abs(rF(k)) swfracb(2)=abs(rF(k+1)) CALL SWFRAC( I 2, minusOne, U swfracb, I 1.0, 1, myThid ) C ----- debuggin C IF ((i.EQ.0).AND.(j.EQ.0)) THEN C WRITE(msgBuf,'(2A,I3,A,F6.2,A,F6.2)') C & 'S/R LAYERS_THERMODYNAMICS:', C & ' k=', k, C & ' swfracb(1)=', swfracb(1), C & ' swfracb(2)=', swfracb(2) C CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, C & SQUEEZE_RIGHT, myThid ) C ENDIF C --- kdown == kp1 C kp1 = k+1 IF (k.EQ.Nr) THEN C kp1 = k swfracb(2)=0. _d 0 ENDIF layers_sw(i,j,k,iTracer,bi,bj) = & layers_sw(i,j,k,iTracer,bi,bj) & -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,k,bi,bj) & -swfracb(2)*maskC(i,j,kdown,bi,bj)) & *fluxfac(1) & *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj) ENDIF #endif /* SHORTWAVE_HEATING */ ENDDO ENDDO ENDDO ENDDO ENDDO ENDDO C- TFLUX (=total heat flux, match heat-content variations, [W/m2]) C IF ( fluidIsWater .AND. C & DIAGNOSTICS_IS_ON('TFLUX ',myThid) ) THEN C DO bj = myByLo(myThid), myByHi(myThid) C DO bi = myBxLo(myThid), myBxHi(myThid) C DO j = 1,sNy C DO i = 1,sNx C tmp1k(i,j,bi,bj) = C #ifdef SHORTWAVE_HEATING C & -Qsw(i,j,bi,bj)+ C #endif C & (surfaceForcingT(i,j,bi,bj)+surfaceForcingTice(i,j,bi,bj)) C & *HeatCapacity_Cp*rUnit2mass C ENDDO C ENDDO C #ifdef NONLIN_FRSURF C IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords) C & .AND. useRealFreshWaterFlux ) THEN C DO j=1,sNy C DO i=1,sNx C tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj) C & + PmEpR(i,j,bi,bj)*theta(i,j,ks,bi,bj)*HeatCapacity_Cp C ENDDO C ENDDO C ENDIF C #endif /* NONLIN_FRSURF */ C ENDDO C ENDDO C CALL DIAGNOSTICS_FILL( tmp1k,'TFLUX ',0,1,0,1,1,myThid ) C ENDIF C C C- SFLUX (=total salt flux, match salt-content variations [g/m2/s]) C IF ( fluidIsWater .AND. C & DIAGNOSTICS_IS_ON('SFLUX ',myThid) ) THEN C DO bj = myByLo(myThid), myByHi(myThid) C DO bi = myBxLo(myThid), myBxHi(myThid) C DO j = 1,sNy C DO i = 1,sNx C tmp1k(i,j,bi,bj) = C & surfaceForcingS(i,j,bi,bj)*rUnit2mass C ENDDO C ENDDO C C #ifdef NONLIN_FRSURF C IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords) C & .AND. useRealFreshWaterFlux ) THEN C DO j=1,sNy C DO i=1,sNx C tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj) C & + PmEpR(i,j,bi,bj)*salt(i,j,ks,bi,bj) C ENDDO C ENDDO C ENDIF C #endif /* NONLIN_FRSURF */ C C ENDDO C ENDDO C CALL DIAGNOSTICS_FILL( tmp1k,'SFLUX ',0,1,0,1,1,myThid ) C ENDIF C Ocean: Add temperature surface forcing (e.g., heat-flux) in surface level C IF ( kLev .EQ. kSurface ) THEN C DO j=1,sNy C DO i=1,sNx C gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj) C & +surfaceForcingT(i,j,bi,bj) C & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj) C ENDDO C ENDDO C ELSEIF ( kSurface.EQ.-1 ) THEN C DO j=1,sNy C DO i=1,sNx C IF ( kSurfC(i,j,bi,bj).EQ.kLev ) THEN C gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj) C & +surfaceForcingT(i,j,bi,bj) C & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj) C ENDIF C ENDDO C ENDDO C ENDIF C-- Divergence of fluxes C Anelastic: scale vertical fluxes by rhoFac and leave Horizontal fluxes unchanged C for Stevens OBC: keep only vertical diffusive contribution on boundaries C DO j=1-OLy,sNy+OLy-1 C DO i=1-OLx,sNx+OLx-1 C gTracer(i,j,k,bi,bj)=gTracer(i,j,k,bi,bj) C & -_recip_hFacC(i,j,k,bi,bj)*recip_drF(k) C & *recip_rA(i,j,bi,bj)*recip_deepFac2C(k)*recip_rhoFacC(k) C & *( (fZon(i+1,j)-fZon(i,j))*maskInC(i,j,bi,bj) C & +(fMer(i,j+1)-fMer(i,j))*maskInC(i,j,bi,bj) C & +(fVerT(i,j,kDown)-fVerT(i,j,kUp))*rkSign C & -localT(i,j)*( (uTrans(i+1,j)-uTrans(i,j))*advFac C & +(vTrans(i,j+1)-vTrans(i,j))*advFac C & +(rTransKp1(i,j)-rTrans(i,j))*rAdvFac C & )*maskInC(i,j,bi,bj) C & ) C ENDDO C ENDDO #endif /* LAYERS_THERMODYNAMICS */ #endif /* USE_LAYERS */ RETURN END
C -- end of S/R LAYERS_CALC_RHS