SUBROUTINE CALCFVN ( 1,2CALCFVN.3
C CALCFVN.4
CLL==================================================================== CALCFVN.5
CLL CALCFVN.6
CLL Subroutine : CALCFVN CALCFVN.7
CLL CALCFVN.8
CLL Author : R.Hill CALCFVN.9
CLL CALCFVN.10
CLL Date : 01.09.94 CALCFVN.11
CLL CALCFVN.12
CLL Reviewer : CALCFVN.13
CLL CALCFVN.14
CLL Version : 3.4 CALCFVN.15
! Modification History: ORH1F305.4328
! Version Date Details ORH1F305.4329
! ------- ------- ------------------------------------------ ORH1F305.4330
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.4331
! 4.3 01.02.97 Recode FX calculation forcing order using ORH3F403.215
! brackets since the Cray compiler fails to ORH3F403.216
! perform the calculation left-right contrary ORH3F403.217
! to Cray's own documentation. R.Hill ORH3F403.218
CLL 4.3 15/06/97 Use barotropic velocities to calculate external ORL1F404.834
CLL mode for free surface case. ORL1F404.835
CLL Introduce the new flux solution scheme based on ORL1F404.836
CLL 'scheme D',see: ORL1F404.837
CLL 'Velocity Fluxes next to topography in the ORL1F404.838
CLL Bryan-Cox Ocean Model', M.J.Bell 1996 ORL1F404.839
CLL for further details. R.Lenton ORL1F404.840
CLL 4.5 3.11.98 Added brackets to SFV calc for bit-reprod OOM3F405.872
CLL M. Roberts OOM3F405.873
!LL 4.5 17/09/98 Update calls to timer, required because of GPB8F405.76
!LL new barrier inside timer. P.Burton GPB8F405.77
CLL CALCFVN.16
CLL Purpose: Carries out the computation of FVN CALCFVN.17
CLL CALCFVN.18
CLL Calling Routine : BLOKINIT CALCFVN.19
CLL CALCFVN.20
C======================================================================= CALCFVN.21
C*L Argument list CALCFVN.22
*CALL ARGSIZE 
CALCFVN.23
*CALL ARGD1 CALCFVN.24
*CALL ARGDUMO CALCFVN.25
*CALL ARGPTRO CALCFVN.26
*CALL ARGOCALL CALCFVN.27
*CALL COCAROWS CALCFVN.28
& ,J CALCFVN.29
& ,LL_ASS_BTRP,DV_ASS_BTRP CALCFVN.31
& ,KMUP,KMU ORL1F404.958
& ,FVN,VP,VCLIN CALCFVN.33
&,JMT_GLOBAL ORH6F402.86
& ) CALCFVN.34
C CALCFVN.35
IMPLICIT NONE CALCFVN.36
C CALCFVN.37
C--------------------------------------------------------------------- CALCFVN.38
C DEFINE GLOBAL DATA CALCFVN.39
C--------------------------------------------------------------------- CALCFVN.40
C CALCFVN.41
INTEGER PXORDER.6
& JMT_GLOBAL ! IN full JMT value for MPP dimesions PXORDER.7
*CALL OARRYSIZ ORH6F401.30
*CALL TYPSIZE CALCFVN.42
*CALL TYPD1 CALCFVN.43
*CALL TYPDUMO CALCFVN.44
*CALL TYPPTRO CALCFVN.45
*CALL TYPOCALL CALCFVN.46
*CALL COCTROWS CALCFVN.47
*CALL CNTLOCN ORH1F305.4332
*CALL OTIMER ORH1F305.4334
C CALCFVN.48
REAL CALCFVN.49
& VP(IMT,KM) ! In Velocity at J + 1 CALCFVN.50
&,VCLIN(IMT,KM) ! In Velocity at J CALCFVN.51
&,FVN (IMT,KM) ! Out CALCFVN.52
C CALCFVN.53
INTEGER CALCFVN.54
& J ! In Row index CALCFVN.55
&,KMUP(IMT), KMU(IMT) ! IN lowest levels on rows J+1 and J ORL1F404.959
C CALCFVN.56
REAL CALCFVN.58
& DV_ASS_BTRP(IMT_ASM,JMT_ASM) ! IN ORH1F305.4335
LOGICAL CALCFVN.60
& LL_ASS_BTRP ! In CALCFVN.61
C CALCFVN.63
C*L ------------------------------------------------------------------ CALCFVN.64
C DEFINE LOCAL VARIABLES CALCFVN.65
C--------------------------------------------------------------------- CALCFVN.66
REAL CALCFVN.67
& FX ! Multiplication constant CALCFVN.68
&, SFV(IMT) CALCFVN.69
CALCFVN.70
C CALCFVN.71
INTEGER CALCFVN.72
& I ! Grid point index (Zonal) CALCFVN.73
&, K ! Grid point index (Vertical) CALCFVN.74
C CALCFVN.75
C======================================================================= CALCFVN.76
C BEGIN EXECUTABLE CODE CALCFVN.77
C======================================================================= CALCFVN.78
IF (L_OTIMER) THEN ORH1F305.4336
CALL TIMER('CALCFVN',103) GPB8F405.78
ENDIF ORH1F305.4338
C CALCFVN.82
C CALCFVN.83
IF (.NOT.L_ONOCLIN) THEN ORH1F305.4339
ORL1F404.841
IF (L_OFREESFC) THEN ORL1F404.842
DO I=1,IMTM1 ORL1F404.843
SFV(I)= 0.5*( VBT(I,J+1) + VBT(I,J) ) ORL1F404.844
ENDDO ORL1F404.845
SFV(IMT)=0.0 ORL1F404.846
ELSE IF ((.NOT.L_OFREESFC).AND.(.NOT.L_FLUXD)) THEN ORL1F404.847
DO I=1,IMTM1 CALCFVN.85
SFV(I)=((P(I+1,J+1)-P(I,J+1))*DXUR(I))* OOM3F405.874
& (MIN(HR(I,J+1),HR(I,J))*CSTR(J+1)) OOM3F405.875
ENDDO ! Over I CALCFVN.88
SFV(IMT)=0.0 CALCFVN.89
ORL1F404.960
ELSE ORL1F404.961
ORL1F404.962
C use the new 'version D' method to calculate fluxes at the faces ORL1F404.963
ORL1F404.964
DO I=1,IMTM1 ORL1F404.965
SFV(I)= (P(I+1,J+1)-P(I,J+1))*DXUR(I)*CSTR(J+1) ORL1F404.966
ENDDO ORL1F404.967
SFV(IMT)=0.0 ORL1F404.968
ORL1F404.969
ENDIF ! (L_OFREESFC) ORL1F404.848
ENDIF ORH1F305.4340
C CALCFVN.91
FX=0.5 CALCFVN.92
IF ((L_ONOCLIN).OR.((.NOT.L_ONOCLIN).AND.(.NOT.L_FLUXD))) THEN ORL1F404.970
ORL1F404.971
c follow the method used in the original COX scheme ORL1F404.972
ORL1F404.973
DO K=1,KM CALCFVN.93
DO I=2,IMT CALCFVN.94
FVN (I,K)=(VP(I,K)+VCLIN (I,K))*FX CALCFVN.95
ENDDO ! Over I CALCFVN.96
FVN (1,K)=(VP(1,K)+VCLIN(1,K))*FX CALCFVN.97
ENDDO ! Over K CALCFVN.98
ELSE ! .NOT. L_ONOCLIN ORL1F404.974
ORL1F404.975
C new 'version D' formula to calculate the fluxes ORL1F404.976
ORL1F404.977
DO K = 1, KM ORL1F404.978
ORL1F404.979
C first contributions for FVN ORL1F404.980
DO I=1,IMT ORL1F404.981
IF ( KMU(I) .GE. KAR(K) ) THEN ORL1F404.982
FVN(I,K) = 0.5 * ( VCLIN(I,K) + SFV(I)*HR(I,J) ) ORL1F404.983
ELSE ORL1F404.984
FVN(I,K) = 0.0 ORL1F404.985
END IF ORL1F404.986
END DO ORL1F404.987
ORL1F404.988
C second contributions for FVN ORL1F404.989
C no additional contributions from land points ORL1F404.990
ORL1F404.991
DO I=1,IMT ORL1F404.992
IF ( KMUP(I) .GE. KAR(K) ) THEN ORL1F404.993
FVN(I,K) = FVN(I,K) + ORL1F404.994
# 0.5 * ( VP(I,K) + SFV(I)*HR(I,J+1) ) ORL1F404.995
END IF ORL1F404.996
END DO ORL1F404.997
ORL1F404.998
END DO ! KM ORL1F404.999
ORL1F404.1000
END IF ! L_ONOCLIN ORL1F404.1001
C CALCFVN.99
IF (L_OCNASSM) THEN ORH1F305.4341
C CALCFVN.101
C Add data assimilation increments CALCFVN.102
C CALCFVN.103
IF (LL_ASS_BTRP) THEN CALCFVN.104
DO K=1,KM CALCFVN.105
DO I=1,IMT CALCFVN.106
FVN (I,K)=FVN (I,K)+(DV_ASS_BTRP(I,J+1)+ CALCFVN.107
& DV_ASS_BTRP(I,J))*FX CALCFVN.108
ENDDO ! Over I CALCFVN.109
ENDDO ! Over K CALCFVN.110
ENDIF CALCFVN.111
ENDIF ORH1F305.4342
C CALCFVN.113
C CALCFVN.114
FX=(DYU2R(J)*CSR(J))*CST(J+1) OOM3F405.876
ORL1F404.1002
IF ((.NOT.L_ONOCLIN).AND.(.NOT.L_FLUXD)) THEN ORL1F404.1003
DO K=1,KM ORL1F404.1004
DO I=1,IMT ORL1F404.1005
FVN(I,K)=(FVN(I,K)+SFV(I)) * FX ORL1F404.1006
ENDDO ! over I ORL1F404.1007
ENDDO ! over K ORL1F404.1008
ORL1F404.1009
ELSE ORL1F404.1010
ORL1F404.1011
DO K=1,KM ORL1F404.1012
DO I=1,IMT ORL1F404.1013
FVN(I,K)=FVN(I,K)*FX ORL1F404.1014
ENDDO ORL1F404.1015
ENDDO ORL1F404.1016
ORL1F404.1017
ENDIF ! (.NOT.L_ONOCLIN).AND.(.NOT.L_FLUXD) ORL1F404.1018
C CALCFVN.125
C CALCFVN.126
! NOTE: The following calculation may appear to contain ORH3F403.219
! superfluous brackets, but they are needed to force ORH3F403.220
! the order of calculation on the t3e. ORH3F403.221
FX=(CS(J)*DYU(J))*(CSR(J+1)*DYUR(J+1)) ORH3F403.222
DO K=1,KM CALCFVN.128
DO I=1,IMT CALCFVN.129
FVN(I,K)=FVN(I,K) * FX CALCFVN.130
ENDDO ! Over I CALCFVN.131
ENDDO ! Over K CALCFVN.132
C CALCFVN.133
IF (L_OTIMER) THEN ORH1F305.4356
CALL TIMER('CALCFVN',104) GPB8F405.79
ENDIF ORH1F305.4358
C CALCFVN.134
RETURN CALCFVN.135
END CALCFVN.136
C CALCFVN.137
*ENDIF CALCFVN.138