Commit be65fc9d authored by bjb's avatar bjb
Browse files

Constants to d

parent ae047d3a
......@@ -109,12 +109,18 @@
#define REALTYPE REAL
#define REAL_SIZE 4
#define _ZERO_ 0.0
#define _TENTH_ 0.1
#define _QUART_ 0.25
#define _HALF_ 0.5
#define _ONE_ 1.0
#else
#define REALTYPE DOUBLE PRECISION
#define MPI_REALTYPE MPI_DOUBLE_PRECISION
#define REAL_SIZE 8
#define _ZERO_ 0.0d0
#define _TENTH_ 0.1d0
#define _QUART_ 0.25d0
#define _HALF_ 0.5d0
#define _ONE_ 1.0d0
#endif
......
!$Id: bottom_friction.F90,v 1.8 2009-08-18 10:24:43 bjb Exp $
!$Id: bottom_friction.F90,v 1.9 2009-08-21 07:26:26 bjb Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -62,7 +62,7 @@
write(debug,*) 'bottom_friction() # ',Ncall
#endif
CALL tic(TIM_BOTTFRICT)
CALL tic(TIM_BOTTFRICT)
#ifdef DEBUG
if(Ncall .eq. 1) then
......@@ -109,7 +109,7 @@ CALL tic(TIM_BOTTFRICT)
do j=jmin,jmax
do i=imin,imax
if (au(i,j) .gt. 0) then
vloc(i,j)=0.25* ( V(i ,j )/DV(i ,j ) &
vloc(i,j)=_QUART_* ( V(i ,j )/DV(i ,j ) &
+V(i+1,j )/DV(i+1,j ) &
+V(i ,j-1)/DV(i ,j-1) &
+V(i+1,j-1)/DV(i+1,j-1) )
......@@ -125,12 +125,12 @@ CALL tic(TIM_BOTTFRICT)
where (au .gt. 0)
uloc=U/DU
HH=max(min_depth,DU)
ruu=(kappa/log((zub+0.5*HH)/zub))**2
ruu=(kappa/log((zub+_HALF_*HH)/zub))**2
end where
#else
uloc=U/DU
HH=max(min_depth,DU)
ruu=(zub+0.5*HH)/zub
ruu=(zub+_HALF_*HH)/zub
do j=jmin,jmax
do i=imin,imax
......@@ -150,8 +150,8 @@ CALL tic(TIM_BOTTFRICT)
if (runtype .eq. 1) then
where (au .gt. 0)
fricvel=sqrt(ruu*(uloc**2+vloc**2))
zub=min(HH,zub0+0.1*avmmol/max(avmmol,fricvel))
ruu=(zub+0.5*HH)/zub
zub=min(HH,zub0+_TENTH_*avmmol/max(avmmol,fricvel))
ruu=(zub+_HALF_*HH)/zub
ruu=(kappa/log(ruu))**2
end where
end if
......@@ -164,7 +164,7 @@ CALL tic(TIM_BOTTFRICT)
do j=jmin,jmax
do i=imin,imax
if (av(i,j) .gt. 0) then
uloc(i,j)=0.25* ( U(i ,j )/DU(i ,j ) &
uloc(i,j)=_QUART_* ( U(i ,j )/DU(i ,j ) &
+U(i-1,j )/DU(i-1,j ) &
+U(i ,j+1)/DU(i ,j+1) &
+U(i-1,j+1)/DU(i-1,j+1) )
......@@ -178,12 +178,12 @@ CALL tic(TIM_BOTTFRICT)
where (av .gt. 0)
vloc=V/DV
HH=max(min_depth,DV)
rvv=(kappa/log((zvb+0.5*HH)/zvb))**2
rvv=(kappa/log((zvb+_HALF_*HH)/zvb))**2
end where
#else
vloc=V/DV
HH=max(min_depth,DV)
rvv=(zvb+0.5*HH)/zvb
rvv=(zvb+_HALF_*HH)/zvb
do j=jmin,jmax
do i=imin,imax
......@@ -204,8 +204,8 @@ CALL tic(TIM_BOTTFRICT)
if (runtype .eq. 1) then
where (av .gt. 0)
fricvel=sqrt(rvv*(uloc**2+vloc**2))
zvb=min(HH,zvb0+0.1*avmmol/max(avmmol,fricvel))
rvv=(zvb+0.5*HH)/zvb
zvb=min(HH,zvb0+_TENTH_*avmmol/max(avmmol,fricvel))
rvv=(zvb+_HALF_*HH)/zvb
rvv=(kappa/log(rvv))**2
end where
end if
......
!$Id: depth_update.F90,v 1.10 2009-08-18 10:24:43 bjb Exp $
!$Id: depth_update.F90,v 1.11 2009-08-21 07:26:26 bjb Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -39,7 +39,7 @@
!
! !LOCAL VARIABLES:
integer :: i,j
REALTYPE :: d1,d2,x
REALTYPE :: d1,x,d2i
!EOP
!-----------------------------------------------------------------------
!BOC
......@@ -61,7 +61,7 @@
#ifdef USE_MASK
if(au(i,j) .gt. 0) then
#endif
x=max(0.25*(zo(i,j)+zo(i+1,j)+z(i,j)+z(i+1,j)),-HU(i,j)+min_depth)
x=max(_QUART_*(zo(i,j)+zo(i+1,j)+z(i,j)+z(i+1,j)),-HU(i,j)+min_depth)
zu(i,j) = x
DU(i,j) = x+HU(i,j)
#ifdef USE_MASK
......@@ -76,7 +76,7 @@
#ifdef USE_MASK
if(av(i,j) .gt. 0) then
#endif
x = max(0.25*(zo(i,j)+zo(i,j+1)+z(i,j)+z(i,j+1)),-HV(i,j)+min_depth)
x = max(_QUART_*(zo(i,j)+zo(i,j+1)+z(i,j)+z(i,j+1)),-HV(i,j)+min_depth)
zv(i,j) = x
DV(i,j) = x+HV(i,j)
#ifdef USE_MASK
......@@ -86,15 +86,15 @@
end do
d1 = 2*min_depth
d2 = crit_depth-2*min_depth
d2i = _ONE_/(crit_depth-2*min_depth)
where (az .gt. 0)
dry_z = max(_ZERO_,min(_ONE_,(D-d1/2.)/d2))
dry_z = max(_ZERO_,min(_ONE_,(D-_HALF_*d1)*d2i))
end where
where (au .gt. 0)
dry_u = max(_ZERO_,min(_ONE_,(DU-d1)/d2))
dry_u = max(_ZERO_,min(_ONE_,(DU-d1)*d2i))
end where
where (av .gt. 0)
dry_v = max(_ZERO_,min(_ONE_,(DV-d1)/d2))
dry_v = max(_ZERO_,min(_ONE_,(DV-d1)*d2i))
end where
#ifdef SLICE_MODEL
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment