*IF DEF,A06_1A,OR,DEF,A06_2A GWVICT1A.2
C ******************************COPYRIGHT****************************** GTS2F400.3745
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3746
C GTS2F400.3747
C Use, duplication or disclosure of this code is subject to the GTS2F400.3748
C restrictions as set forth in the contract. GTS2F400.3749
C GTS2F400.3750
C Meteorological Office GTS2F400.3751
C London Road GTS2F400.3752
C BRACKNELL GTS2F400.3753
C Berkshire UK GTS2F400.3754
C RG12 2SZ GTS2F400.3755
C GTS2F400.3756
C If no contract has been raised with this copy of the code, the use, GTS2F400.3757
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3758
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3759
C Modelling at the above address. GTS2F400.3760
C ******************************COPYRIGHT****************************** GTS2F400.3761
C GTS2F400.3762
!+ Interfaces GWAV_CTL to versions 1A & 2A of gravity wave drag scheme. GWVICT1A.3
! GWVICT1A.4
SUBROUTINE GWAV_INTCTL 1,2GWVICT1A.5
1 (PSTAR,PEXNER,THETA,Q,U,V,P_FIELD,U_FIELD, GWVICT1A.6
2 ROWS_P,ROW_LENGTH,START_LEVEL,LEVELS,Q_LEVELS, GWVICT1A.7
*CALL ARGFLDPT 
APBEF401.19
3 AK,BK,AKH,BKH,DELTA_AK,DELTA_BK,SD_OROG_LAND, GWVICT1A.8
4 OROG_GRAD_XX_LAND,OROG_GRAD_XY_LAND,OROG_GRAD_YY_LAND, GWVICT1A.9
5 LAND_INDEX,LAND_POINTS,TIMESTEP,KAY,KAY_LEE, ASW1F403.20
6 STRESS_UD,LEN_STRESS_UD,STRESS_UD_ON,U_LIST1,POINTS_STRESS_UD, GWVICT1A.11
7 STRESS_VD,LEN_STRESS_VD,STRESS_VD_ON,V_LIST1,POINTS_STRESS_VD, GWVICT1A.12
8 DU_DT_SATN,LEN_DU_DT_SATN,DU_DT_SATN_ON, GWVICT1A.13
9 U_LIST2,POINTS_DU_DT_SATN, GWVICT1A.14
& DV_DT_SATN,LEN_DV_DT_SATN,DV_DT_SATN_ON, GWVICT1A.15
& V_LIST2,POINTS_DV_DT_SATN, GWVICT1A.16
& DU_DT_JUMP,LEN_DU_DT_JUMP,DU_DT_JUMP_ON, GWVICT1A.17
& U_LIST3,POINTS_DU_DT_JUMP, GWVICT1A.18
& DV_DT_JUMP,LEN_DV_DT_JUMP,DV_DT_JUMP_ON, GWVICT1A.19
& V_LIST3,POINTS_DV_DT_JUMP, GWVICT1A.20
& DU_DT_LEE,LEN_DU_DT_LEE,DU_DT_LEE_ON,U_LIST4,POINTS_DU_DT_LEE, GWVICT1A.21
& DV_DT_LEE,LEN_DV_DT_LEE,DV_DT_LEE_ON,V_LIST4,POINTS_DV_DT_LEE, GWVICT1A.22
& TRANS_D,LEN_TRANS_D,TRANS_D_ON,POINTS_TRANS_D,IRET, GWVICT1A.23
& LFROUDE,LGWLINP) GWVICT1A.24
GWVICT1A.25
IMPLICIT NONE GWVICT1A.26
! GWVICT1A.27
! Description: GWVICT1A.28
! Is called with all possible arguments for all versions of gravity GWVICT1A.29
! wave drag scheme, and according to *IF DEF (A06_1A or A06_2A in this GWVICT1A.30
! case) calls corresponding actual G_WAVE routine with only those GWVICT1A.31
! arguments it requires. GWVICT1A.32
! GWVICT1A.33
! Current Code Owner: R.T.H.Barnes. GWVICT1A.34
! GWVICT1A.35
! History: GWVICT1A.36
! Version Date Comment GWVICT1A.37
! ------- ---- ------- GWVICT1A.38
! 3.4 22/11/94 Original code. R.T.H.Barnes. GWVICT1A.39
!LL 4.3 13/02/97 Stop main code being called if no land points GPB3F403.91
!LL P.Burton GPB3F403.92
! 4.3 22/04/97 KAY_LEE passed in from namelist. S.Webster ASW1F403.21
! GWVICT1A.40
! Code Description: GWVICT1A.41
! Language: FORTRAN 77 + common extensions. GWVICT1A.42
! This code is written to UMDP3 v6 programming standards. GWVICT1A.43
! System component covered: GWVICT1A.44
! System Task: GWVICT1A.45
! GWVICT1A.46
! Global variables (*CALLed COMDECKs etc...): GWVICT1A.47
GWVICT1A.48
! Subroutine arguments GWVICT1A.49
GWVICT1A.50
INTEGER GWVICT1A.51
& P_FIELD !IN 1ST DIMENSION OF FIELD OF PSTAR GWVICT1A.52
&, U_FIELD !IN 1ST DIMENSION OF FIELD OF U,V GWVICT1A.53
&, ROWS_P !IN NUMBER OF ROWS of P grid GWVICT1A.54
&, ROW_LENGTH !IN NUMBER OF POINTS PER ROW GWVICT1A.55
&, START_LEVEL !IN START OF WAVE-BREAKING TEST GWVICT1A.56
&, LEVELS !IN NUMBER OF MODEL LEVELS GWVICT1A.57
&, Q_LEVELS !IN NUMBER OF WET LEVELS GWVICT1A.58
&, LAND_POINTS !IN NUMBER OF LAND POINTS GWVICT1A.59
&, LAND_INDEX((ROWS_P)*ROW_LENGTH) ! INDEX FOR LAND POINTS GWVICT1A.60
&, IRET ! RETURN CODE : IRET=0 NORMAL EXIT GWVICT1A.61
! ! RETURN CODE : IRET=1 ????? GWVICT1A.62
&, LEN_STRESS_UD !IN ) Dimension of diagnostic arrays GWVICT1A.63
&, LEN_STRESS_VD !IN ) for GW stress - u and v GWVICT1A.64
&, POINTS_STRESS_UD !IN ) No of land points in diagnostic GWVICT1A.65
&, POINTS_STRESS_VD !IN ) arrays for GW stress - u and v GWVICT1A.66
&, LEN_DU_DT_SATN !IN ) Dimension of diagnostic arrays GWVICT1A.67
&, LEN_DV_DT_SATN !IN ) for GW satn - du and dv GWVICT1A.68
&, POINTS_DU_DT_SATN !IN ) No of land points in diagnostic GWVICT1A.69
&, POINTS_DV_DT_SATN !IN ) arrays for GW satn - du and dv GWVICT1A.70
&, LEN_DU_DT_JUMP !IN ) Dimension of diagnostic arrays GWVICT1A.71
&, LEN_DV_DT_JUMP !IN ) for GW satn - du and dv GWVICT1A.72
&, POINTS_DU_DT_JUMP !IN ) No of land points in diagnostic GWVICT1A.73
&, POINTS_DV_DT_JUMP !IN ) arrays for GW satn - du and dv GWVICT1A.74
&, LEN_DU_DT_LEE !IN ) Dimension of diagnostic arrays GWVICT1A.75
&, LEN_DV_DT_LEE !IN ) for GW lee - du and dv GWVICT1A.76
&, POINTS_DU_DT_LEE !IN ) No of land points in diagnostic GWVICT1A.77
&, POINTS_DV_DT_LEE !IN ) arrays for GW lee - du and dv GWVICT1A.78
&, LEN_TRANS_D !IN Dimension of diag for trans. coeff. GWVICT1A.79
&, POINTS_TRANS_D !IN No. of land points for trans. coeff. GWVICT1A.80
C GWVICT1A.81
C GWVICT1A.82
! All TYPFLDPT variables are Intent IN APBEF401.20
*CALL TYPFLDPT APBEF401.21
GWVICT1A.83
REAL GWVICT1A.84
& PSTAR(P_FIELD) !IN PRIMARY MODEL ARRAY FOR PSTAR FIELD GWVICT1A.85
&,PEXNER(P_FIELD,LEVELS+1) !IN ARRAY FOR EXNER PRESSURE FIELD GWVICT1A.86
&,THETA(P_FIELD,LEVELS) !IN PRIMARY MODEL ARRAY FOR THETA FIELD GWVICT1A.87
&,Q(P_FIELD,Q_LEVELS) !IN SPECIFIC HUMIDITY AT FULL LEVELS GWVICT1A.88
&,U(U_FIELD,LEVELS) !INOUT PRIMARY MODEL ARRAY FOR U FIELD GWVICT1A.89
&,V(U_FIELD,LEVELS) !INOUT PRIMARY MODEL ARRAY FOR V FIELD GWVICT1A.90
C AK,BK DEFINE HYBRID VERTICAL COORDINATES P=A+BP*, GWVICT1A.91
C DELTA_AK,DELTA_BK DEFINE LAYER PRESSURE THICKNESS PD=AD+BDP*, GWVICT1A.92
GWVICT1A.93
REAL GWVICT1A.94
& DELTA_AK(LEVELS) !IN LAYER THICKNESS GWVICT1A.95
&,DELTA_BK(LEVELS) !IN LAYER THICKNESS GWVICT1A.96
&,AK (LEVELS) !IN VALUE AT LAYER CENTRE GWVICT1A.97
&,BK (LEVELS) !IN VALUE AT LAYER CENTRE GWVICT1A.98
&,AKH(LEVELS+1) !IN VALUE AT LAYER BOUNDARY GWVICT1A.99
&,BKH(LEVELS+1) !IN VALUE AT LAYER BOUNDARY GWVICT1A.100
&,SD_OROG_LAND(LAND_POINTS) !IN STANDARD DEVIATION OF OROGRAPHY GWVICT1A.101
&,OROG_GRAD_XX_LAND(LAND_POINTS) GWVICT1A.102
! !IN DH/DX SQUARED GRADIENT OROGRAPHY GWVICT1A.103
&,OROG_GRAD_XY_LAND(LAND_POINTS) GWVICT1A.104
! !IN (DH/DX)(DH/DY) GRADIENT OROGRAPHY GWVICT1A.105
&,OROG_GRAD_YY_LAND(LAND_POINTS) GWVICT1A.106
! !IN DH/DY SQUARED GRADIENT OROGRAPHY GWVICT1A.107
&,TIMESTEP !IN TIMESTEP GWVICT1A.108
&,KAY !IN surface stress constant ( m-1) GWVICT1A.109
&,KAY_LEE !IN TRAPPED LEE WAVE CONSTANT ASW1F403.22
GWVICT1A.110
&,STRESS_UD(LEN_STRESS_UD,*) !U STRESS DIAGNOSTIC GWVICT1A.111
&,STRESS_VD(LEN_STRESS_VD,*) !V STRESS DIAGNOSTIC GWVICT1A.112
&,DU_DT_SATN(LEN_DU_DT_SATN,*) !U ACCELN DIAGNOSTIC (SATURATION) GWVICT1A.113
&,DV_DT_SATN(LEN_DV_DT_SATN,*) !V ACCELN DIAGNOSTIC (SATURATION) GWVICT1A.114
&,DU_DT_JUMP(LEN_DU_DT_JUMP,*) !U ACCELN DIAG (HYDRAULIC JUMP) GWVICT1A.115
&,DV_DT_JUMP(LEN_DV_DT_JUMP,*) !V ACCELN DIAG (HYDRAULIC JUMP) GWVICT1A.116
&,DU_DT_LEE(LEN_DU_DT_LEE,*) !U ACCELN DIAG (TRAPPED LEE WAVE) GWVICT1A.117
&,DV_DT_LEE(LEN_DV_DT_LEE,*) !V ACCELN DIAG (TRAPPED LEE WAVE) GWVICT1A.118
&,TRANS_D(LEN_TRANS_D) !TRANSMITTION COEFF DIAGN GWVICT1A.119
GWVICT1A.120
C WARNING: Storage will only be assigned by the calling routine for GWVICT1A.121
C for the number of levels required. GWVICT1A.122
GWVICT1A.123
LOGICAL GWVICT1A.124
& STRESS_UD_ON !U stress diagnostic switch GWVICT1A.125
&,STRESS_VD_ON !V stress diagnostic switch GWVICT1A.126
&,U_LIST1(LEVELS+1) ! Lists of levels for which stresses GWVICT1A.127
&,V_LIST1(LEVELS+1) ! required. GWVICT1A.128
&,DU_DT_SATN_ON !U accel (saturation) diagnostic switch GWVICT1A.129
&,DV_DT_SATN_ON !V accel (saturation) diagnostic switch GWVICT1A.130
&,U_LIST2(LEVELS) ! Lists of levels for which accelerations GWVICT1A.131
&,V_LIST2(LEVELS) ! required. GWVICT1A.132
&,DU_DT_JUMP_ON !U accel (hydr jump) diagnostic switch GWVICT1A.133
&,DV_DT_JUMP_ON !V accel (hydr jump) diagnostic switch GWVICT1A.134
&,U_LIST3(LEVELS) ! Lists of levels for which accelerations GWVICT1A.135
&,V_LIST3(LEVELS) ! required. GWVICT1A.136
&,DU_DT_LEE_ON !U accel (lee wave) diagnostic switch GWVICT1A.137
&,DV_DT_LEE_ON !V accel (lee wave) diagnostic switch GWVICT1A.138
&,U_LIST4(LEVELS) ! Lists of levels for which accelerations GWVICT1A.139
&,V_LIST4(LEVELS) ! required. GWVICT1A.140
&,TRANS_D_ON !Transmittion coefficient diag switch GWVICT1A.141
&,LFROUDE !Switch for Froude number limiting GWVICT1A.142
&,LGWLINP !Switch for linear stress profile GWVICT1A.143
GWVICT1A.144
! Local dynamic arrays: GWVICT1A.145
GWVICT1A.146
! Function & Subroutine calls: GWVICT1A.147
EXTERNAL G_WAVE GWVICT1A.148
GWVICT1A.149
! Local parameters: GWVICT1A.150
GWVICT1A.151
! Local scalars: GWVICT1A.152
GWVICT1A.153
C------------------------------------------------------------------- GWVICT1A.154
CL 1. Call Gravity Wave Drag Scheme versions 1A or 2A. GWVICT1A.155
C------------------------------------------------------------------- GWVICT1A.156
GWVICT1A.157
IF (LAND_POINTS .NE. 0) THEN GPB3F403.93
CALL G_WAVE GWVICT1A.158
1 (PSTAR,PEXNER,THETA,U,V,P_FIELD,U_FIELD, GWVICT1A.159
2 ROWS_P,ROW_LENGTH,START_LEVEL,LEVELS, GWVICT1A.160
*CALL ARGFLDPT APBEF401.22
3 AK,BK,AKH,BKH,DELTA_AK,DELTA_BK,SD_OROG_LAND, GWVICT1A.161
4 LAND_INDEX,LAND_POINTS, TIMESTEP,KAY, GWVICT1A.162
5 STRESS_UD,LEN_STRESS_UD,STRESS_UD_ON,U_LIST1,POINTS_STRESS_UD, GWVICT1A.163
6 STRESS_VD,LEN_STRESS_VD,STRESS_VD_ON,V_LIST1,POINTS_STRESS_VD, GWVICT1A.164
7 IRET,LFROUDE,LGWLINP) GWVICT1A.165
ENDIF ! if land_points .ne. 0 GPB3F403.94
GWVICT1A.166
RETURN GWVICT1A.167
END GWVICT1A.168
GWVICT1A.169
*ENDIF GWVICT1A.170