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