Page MenuHomec4science
Files F122617088

dynsolver.F
No OneTemporary
Actions

File Metadata

Created
Mon, Jul 21, 00:41

dynsolver.F
View Options

C $Header: /u/gcmpack/MITgcm/pkg/seaice/dynsolver.F,v 1.45 2015/01/07 13:27:10 mlosch Exp $
C $Name: $
#include "SEAICE_OPTIONS.h"
#ifdef ALLOW_AUTODIFF
# include "AUTODIFF_OPTIONS.h"
#endif
CStartOfInterface
SUBROUTINE DYNSOLVER( myTime, myIter, myThid )
C *==========================================================*
C | SUBROUTINE DYNSOLVER |
C | o Ice dynamics using LSR solver |
C | Zhang and Hibler, JGR, 102, 8691-8702, 1997 |
C *==========================================================*
C *==========================================================*
IMPLICIT NONE
C === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"
#include "SEAICE_SIZE.h"
#include "SEAICE_PARAMS.h"
#include "SEAICE.h"
#ifdef ALLOW_EXF
# include "EXF_OPTIONS.h"
# include "EXF_FIELDS.h"
#endif
#ifdef ALLOW_AUTODIFF_TAMC
# include "tamc.h"
#endif
C === Routine arguments ===
C myTime - Simulation time
C myIter - Simulation timestep number
C myThid - Thread no. that called this routine.
_RL myTime
INTEGER myIter
INTEGER myThid
CEndOfInterface
#ifndef SEAICE_CGRID
#ifdef EXPLICIT_SSH_SLOPE
#include "SURFACE.h"
_RL phiSurf(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
#endif
C === Local variables ===
C i,j,bi,bj - Loop counters
INTEGER i, j, bi, bj
_RL RHOICE, RHOAIR
_RL COSWIN
_RS SINWIN
_RL ECCEN, ECM2, PSTAR, AAA
_RL U1, V1
_RL COR_ICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
C-- FIRST SET UP BASIC CONSTANTS
RHOICE=SEAICE_rhoIce
RHOAIR=SEAICE_rhoAir
ECCEN=SEAICE_eccen
ECM2=ONE/(ECCEN**2)
PSTAR=SEAICE_strength
C-- introduce turning angle (default is zero)
SINWIN=SIN(SEAICE_airTurnAngle*deg2rad)
COSWIN=COS(SEAICE_airTurnAngle*deg2rad)
C-- Compute proxy for geostrophic velocity,
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO j=0,sNy+1
DO i=0,sNx+1
GWATX(I,J,bi,bj)=HALF*(uVel(i,j,KGEO(I,J,bi,bj),bi,bj)
& +uVel(i,j-1,KGEO(I,J,bi,bj),bi,bj))
GWATY(I,J,bi,bj)=HALF*(vVel(i,j,KGEO(I,J,bi,bj),bi,bj)
& +vVel(i-1,j,KGEO(I,J,bi,bj),bi,bj))
#ifdef SEAICE_DEBUG
c write(*,'(2i4,2i2,f7.1,7f12.3)')
c & ,i,j,bi,bj,UVM(I,J,bi,bj)
c & ,GWATX(I,J,bi,bj),GWATY(I,J,bi,bj)
c & ,uVel(i+1,j,3,bi,bj),uVel(i+1,j+1,3,bi,bj)
c & ,vVel(i,j+1,3,bi,bj),vVel(i+1,j+1,3,bi,bj)
#endif
ENDDO
ENDDO
ENDDO
ENDDO
C-- NOW SET UP MASS PER UNIT AREA AND CORIOLIS TERM
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
COR_ICE(i,j,bi,bj) = 0.
ENDDO
ENDDO
DO j=1,sNy
DO i=1,sNx
AMASS(I,J,bi,bj)=RHOICE*QUART*(
& HEFF(i,j ,bi,bj) + HEFF(i-1,j ,bi,bj)
& +HEFF(i,j-1,bi,bj) + HEFF(i-1,j-1,bi,bj) )
COR_ICE(I,J,bi,bj)=AMASS(I,J,bi,bj) * _fCoriG(I,J,bi,bj)
ENDDO
ENDDO
ENDDO
ENDDO
C-- NOW SET UP FORCING FIELDS
C-- Wind stress is computed on South-West B-grid U/V
C locations from wind on tracer locations
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO j=1,sNy
DO i=1,sNx
U1=QUART*(UWIND(I-1,J-1,bi,bj)+UWIND(I-1,J,bi,bj)
& +UWIND(I ,J-1,bi,bj)+UWIND(I ,J,bi,bj))
V1=QUART*(VWIND(I-1,J-1,bi,bj)+VWIND(I-1,J,bi,bj)
& +VWIND(I ,J-1,bi,bj)+VWIND(I ,J,bi,bj))
AAA=U1**2+V1**2
IF ( AAA .LE. SEAICE_EPS_SQ ) THEN
AAA=SEAICE_EPS
ELSE
AAA=SQRT(AAA)
ENDIF
C first ocean surface stress
DAIRN(I,J,bi,bj)=RHOAIR*OCEAN_drag
& *(2.70 _d 0+0.142 _d 0*AAA+0.0764 _d 0*AAA*AAA)
WINDX(I,J,bi,bj)=DAIRN(I,J,bi,bj)*
& (COSWIN*U1-SIGN(SINWIN, _fCori(I,J,bi,bj))*V1)
WINDY(I,J,bi,bj)=DAIRN(I,J,bi,bj)*
& (SIGN(SINWIN, _fCori(I,J,bi,bj))*U1+COSWIN*V1)
C now ice surface stress
IF ( YC(I,J,bi,bj) .LT. ZERO ) THEN
DAIRN(I,J,bi,bj) =
& RHOAIR*(SEAICE_drag_south*AAA*AREA(I,J,bi,bj)
& +OCEAN_drag*(2.70 _d 0+0.142 _d 0*AAA
& +0.0764 _d 0*AAA*AAA)*(ONE-AREA(I,J,bi,bj)))
ELSE
DAIRN(I,J,bi,bj) =
& RHOAIR*(SEAICE_drag*AAA*AREA(I,J,bi,bj)
& +OCEAN_drag*(2.70 _d 0+0.142 _d 0*AAA
& +0.0764 _d 0*AAA*AAA)*(ONE-AREA(I,J,bi,bj)))
ENDIF
FORCEX(I,J,bi,bj)=DAIRN(I,J,bi,bj)*
& (COSWIN*U1-SIGN(SINWIN, _fCori(I,J,bi,bj))*V1)
FORCEY(I,J,bi,bj)=DAIRN(I,J,bi,bj)*
& (SIGN(SINWIN, _fCori(I,J,bi,bj))*U1+COSWIN*V1)
ENDDO
ENDDO
ENDDO
ENDDO
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
#ifdef EXPLICIT_SSH_SLOPE
C-- Compute surface pressure at z==0:
C- use actual sea surface height for tilt computations
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
phiSurf(i,j) = Bo_surf(i,j,bi,bj)*etaN(i,j,bi,bj)
ENDDO
ENDDO
#ifdef ATMOSPHERIC_LOADING
C- add atmospheric loading and Sea-Ice loading
IF ( useRealFreshWaterFlux ) THEN
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
phiSurf(i,j) = phiSurf(i,j)
& + ( pload(i,j,bi,bj)
& +sIceLoad(i,j,bi,bj)*gravity
& )*recip_rhoConst
ENDDO
ENDDO
ELSE
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
phiSurf(i,j) = phiSurf(i,j)
& + pload(i,j,bi,bj)*recip_rhoConst
ENDDO
ENDDO
ENDIF
#endif /* ATMOSPHERIC_LOADING */
DO j=1-OLy+1,sNy+OLy
DO i=1-OLx+1,sNx+OLx
C-- NOW ADD IN TILT
FORCEX(I,J,bi,bj)=FORCEX(I,J,bi,bj)
& -AMASS(I,J,bi,bj)
& *( (phiSurf(i, j )-phiSurf(i-1, j ))*maskW(i, j ,1,bi,bj)
& +(phiSurf(i,j-1)-phiSurf(i-1,j-1))*maskW(i,j-1,1,bi,bj)
& )*HALF*_recip_dxV(I,J,bi,bj)
FORCEY(I,J,bi,bj)=FORCEY(I,J,bi,bj)
& -AMASS(I,J,bi,bj)
& *( (phiSurf( i ,j)-phiSurf( i ,j-1))*maskS( i ,j,1,bi,bj)
& +(phiSurf(i-1,j)-phiSurf(i-1,j-1))*maskS(i-1,j,1,bi,bj)
& )*HALF*_recip_dyU(I,J,bi,bj)
C NOW KEEP FORCEX0
FORCEX0(I,J,bi,bj)=FORCEX(I,J,bi,bj)
FORCEY0(I,J,bi,bj)=FORCEY(I,J,bi,bj)
ENDDO
ENDDO
#endif /* EXPLICIT_SSH_SLOPE */
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
#ifndef EXPLICIT_SSH_SLOPE
C-- NOW ADD IN TILT
FORCEX(I,J,bi,bj)=FORCEX(I,J,bi,bj)
& -COR_ICE(I,J,bi,bj)*GWATY(I,J,bi,bj)
FORCEY(I,J,bi,bj)=FORCEY(I,J,bi,bj)
& +COR_ICE(I,J,bi,bj)*GWATX(I,J,bi,bj)
C NOW KEEP FORCEX0
FORCEX0(I,J,bi,bj)=FORCEX(I,J,bi,bj)
FORCEY0(I,J,bi,bj)=FORCEY(I,J,bi,bj)
#endif /* EXPLICIT_SSH_SLOPE */
C-- NOW SET UP ICE PRESSURE AND VISCOSITIES
PRESS0(I,J,bi,bj)=PSTAR*HEFF(I,J,bi,bj)
& *EXP(-SEAICE_cStar*(ONE-AREA(i,j,bi,bj)))
CML ZMAX(I,J,bi,bj)=(5.0 _d +12/(2.0 _d +04))*PRESS0(I,J,bi,bj)
ZMAX(I,J,bi,bj)=SEAICE_zetaMaxFac*PRESS0(I,J,bi,bj)
CML ZMIN(I,J,bi,bj)=4.0 _d +08
ZMIN(I,J,bi,bj)=SEAICE_zetaMin
PRESS0(I,J,bi,bj)=PRESS0(I,J,bi,bj)*HEFFM(I,J,bi,bj)
ENDDO
ENDDO
ENDDO
ENDDO
#ifdef SEAICE_ALLOW_DYNAMICS
IF ( SEAICEuseDYNAMICS ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE uice = comlev1, key=ikey_dynamics
CADJ STORE vice = comlev1, key=ikey_dynamics
#endif /* ALLOW_AUTODIFF_TAMC */
crg what about ETA,ZETA
crg later c$taf loop = iteration uice,vice
cdm c$taf store uice,vice = comlev1_seaice_ds,
cdm c$taf& key = kii + (ikey_dynamics-1)
C NOW DO PREDICTOR TIME STEP
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
UICENM1(I,J,bi,bj)=UICE(I,J,bi,bj)
VICENM1(I,J,bi,bj)=VICE(I,J,bi,bj)
UICEC(I,J,bi,bj)=UICE(I,J,bi,bj)
VICEC(I,J,bi,bj)=VICE(I,J,bi,bj)
ENDDO
ENDDO
ENDDO
ENDDO
C NOW LSR SCHEME (ZHANG-J/HIBLER 1997)
CADJ STORE uice = comlev1, key=ikey_dynamics
CADJ STORE vice = comlev1, key=ikey_dynamics
CALL LSR( 1, myThid )
CADJ STORE uice = comlev1, key=ikey_dynamics
CADJ STORE vice = comlev1, key=ikey_dynamics
C NOW DO MODIFIED EULER STEP
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
UICE(I,J,bi,bj)=HALF*(UICE(I,J,bi,bj)+UICENM1(I,J,bi,bj))
VICE(I,J,bi,bj)=HALF*(VICE(I,J,bi,bj)+VICENM1(I,J,bi,bj))
UICEC(I,J,bi,bj)=UICE(I,J,bi,bj)
VICEC(I,J,bi,bj)=VICE(I,J,bi,bj)
ENDDO
ENDDO
ENDDO
ENDDO
C NOW LSR SCHEME (ZHANG-J/HIBLER 1997)
CALL LSR( 2, myThid )
cdm c$taf store uice,vice = comlev1, key=ikey_dynamics
ENDIF
#endif /* SEAICE_ALLOW_DYNAMICS */
#ifdef ALLOW_DIAGNOSTICS
IF ( useDiagnostics ) THEN
CALL DIAGNOSTICS_FILL(zeta ,'SIzeta ',0,1 ,0,1,1,myThid)
CALL DIAGNOSTICS_FILL(eta ,'SIeta ',0,1 ,0,1,1,myThid)
CALL DIAGNOSTICS_FILL(press ,'SIpress ',0,1 ,0,1,1,myThid)
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
C Calculate ocean surface stress
CALL OSTRES ( COR_ICE, myThid )
#ifdef SEAICE_ALLOW_DYNAMICS
#ifdef SEAICE_ALLOW_CLIPVELS
IF ( SEAICEuseDYNAMICS .AND. SEAICE_clipVelocities) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE uice = comlev1, key=ikey_dynamics
CADJ STORE vice = comlev1, key=ikey_dynamics
#endif /* ALLOW_AUTODIFF_TAMC */
c Put a cap on ice velocity
c limit velocity to 0.40 m s-1 to avoid potential CFL violations
c in open water areas (drift of zero thickness ice)
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
#ifdef SEAICE_DEBUG
c write(*,'(2i4,2i2,f7.1,7f12.3)')
c & i,j,bi,bj,UVM(I,J,bi,bj),amass(i,j,bi,bj)
c & ,gwatx(I,J,bi,bj),gwaty(i,j,bi,bj)
c & ,forcex(I,J,bi,bj),forcey(i,j,bi,bj)
c & ,uice(i,j,bi,bj)
c & ,vice(i,j,bi,bj)
#endif /* SEAICE_DEBUG */
UICE(i,j,bi,bj)=min(UICE(i,j,bi,bj),0.40 _d +00)
VICE(i,j,bi,bj)=min(VICE(i,j,bi,bj),0.40 _d +00)
ENDDO
ENDDO
ENDDO
ENDDO
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE uice = comlev1, key=ikey_dynamics
CADJ STORE vice = comlev1, key=ikey_dynamics
#endif /* ALLOW_AUTODIFF_TAMC */
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
UICE(i,j,bi,bj)=max(UICE(i,j,bi,bj),-0.40 _d +00)
VICE(i,j,bi,bj)=max(VICE(i,j,bi,bj),-0.40 _d +00)
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
#endif /* SEAICE_ALLOW_CLIPVELS */
#endif /* SEAICE_ALLOW_DYNAMICS */
#endif /* NOT SEAICE_CGRID */
RETURN
END

Event Timeline

c4science · Help