SUBROUTINE VDF_CTL(U_FIELDDA,P_LEVELSDA,INT7, 1,9@DYALLOC.3847
*CALL ARGSIZE 
@DYALLOC.3848
*CALL ARGD1 @DYALLOC.3849
*CALL ARGDUMA @DYALLOC.3850
*CALL ARGDUMO @DYALLOC.3851
*CALL ARGDUMW GKR1F401.283
*CALL ARGSTS @DYALLOC.3852
*CALL ARGPTRA @DYALLOC.3853
*CALL ARGPTRO @DYALLOC.3854
*CALL ARGCONA @DYALLOC.3855
*CALL ARGPPX GKR0F305.1011
*CALL ARGFLDPT APBHF401.77
& ICODE,CMESSAGE) @DYALLOC.3856
VDF_CT1.26
IMPLICIT NONE VDF_CT1.27
C @DYALLOC.3857
*CALL CMAXSIZE @DYALLOC.3858
*CALL CSUBMODL GSS1F305.942
*CALL TYPSIZE @DYALLOC.3859
*CALL TYPD1 @DYALLOC.3860
*CALL TYPDUMA @DYALLOC.3861
*CALL TYPDUMO @DYALLOC.3862
*CALL TYPDUMW GKR1F401.284
*CALL TYPSTS @DYALLOC.3863
*CALL TYPPTRA @DYALLOC.3864
*CALL TYPPTRO @DYALLOC.3865
*CALL TYPCONA @DYALLOC.3866
*CALL PPXLOOK GKR0F305.1012
*CALL TYPFLDPT APBHF401.78
VDF_CT1.28
INTEGER VDF_CT1.29
& INT7, ! Dummy variable for STASH_MAXLEN(7) VDF_CT1.30
& U_FIELDDA, ! Extra copy of U_FIELD for dynamic alloc @DYALLOC.3867
& P_LEVELSDA, ! and P_LEVELS @DYALLOC.3868
& ICODE ! Return code : 0 Normal Exit VDF_CT1.31
C ! : >0 Error VDF_CT1.32
VDF_CT1.33
CHARACTER*(80) TS150793.209
& CMESSAGE ! Error message if return code >0 VDF_CT1.35
VDF_CT1.36
*CALL CHSUNITS RS030293.243
*CALL CCONTROL VDF_CT1.38
*CALL C_OMEGA VDF_CT1.42
*CALL CRUNTIMC ADR1F305.231
*CALL CTIME ADR1F305.232
VDF_CT1.43
CL Dynamically allocated area for stash processing VDF_CT1.44
VDF_CT1.45
REAL VDF_CT1.46
& STASHWORK(INT7) VDF_CT1.47
VDF_CT1.48
EXTERNAL VDIF_CTL,TIMER,STASH,EXTDIAG,SET_LEVELS_LIST DR151193.2
VDF_CT1.56
C Local variables VDF_CT1.57
VDF_CT1.58
INTEGER VDF_CT1.59
& I, VDF_CT1.60
& ROWS, VDF_CT1.62
& FIRST_POINT, VDF_CT1.63
& LAST_POINT, DR151193.3
& LEVELS_VD, ! No of levels VD to be applied DR151193.6
& LEVELS_FLUX, ! No of flux levels DR151193.7
& LEN_STASH_U_FLUX, ! )Dimension of workspace in STASHWORK DR151193.8
& LEN_STASH_V_FLUX, ! )for u/v vertical momentum flux DR151193.9
& POINTS_FLUX_U, ! )Dimension of diagnostic arrays DR151193.10
& POINTS_FLUX_V ! )for u/v vertical momentum flux DR151193.11
& ,IM_IDENT ! internal model identifier GRB4F305.526
& ,IM_INDEX ! internal model index for STASH arrays GRB4F305.527
VDF_CT1.65
REAL VDF_CT1.66
& COS_U_TRUE_LATITUDE(U_FIELDDA) @DYALLOC.3869
& ,SCALAR VDF_CT1.68
VDF_CT1.69
LOGICAL VDF_CT1.70
& U_LIST(P_LEVELSDA), ! Levels list for diagnostics DR151193.12
& V_LIST(P_LEVELSDA) ! Levels list for diagnostics DR151193.13
VDF_CT1.73
CL -- SECTION 7 --- VERTICAL DIFFUSION ---------------- VDF_CT1.74
CL 7.0 Initialisation VDF_CT1.75
VDF_CT1.76
C Set up internal model identifier and STASH index GRB4F305.528
im_ident = atmos_im GRB4F305.529
im_index = internal_model_index(im_ident) GRB4F305.530
GRB4F305.531
CL set true latitude VDF_CT1.77
*IF DEF,GLOBAL VDF_CT1.78
DO I=1,U_FIELD VDF_CT1.79
COS_U_TRUE_LATITUDE(I)=COS_U_LATITUDE(I) VDF_CT1.80
ENDDO VDF_CT1.81
*ELSE VDF_CT1.82
CL set from Coriolis term F3 (=2*omega*sin(lat) ) if not GLOBAL VDF_CT1.83
SCALAR=0.5/OMEGA VDF_CT1.84
DO I=1,U_FIELD VDF_CT1.85
COS_U_TRUE_LATITUDE(I)=SQRT(1.0-(SCALAR*F3(I))*(SCALAR*F3(I)) ) VDF_CT1.86
ENDDO VDF_CT1.87
*ENDIF VDF_CT1.88
VDF_CT1.89
! Set grid pointers APBHF401.79
FIRST_POINT = START_POINT_NO_HALO APBHF401.80
LAST_POINT = END_P_POINT_NO_HALO APBHF401.81
ROWS = upd_P_ROWS APBHF401.82
VDF_CT1.94
LEVELS_VD = TOP_VDIF_LEVEL - BOTTOM_VDIF_LEVEL + 1 ADR1F305.233
DR151193.17
IF(LTIMER) THEN VDF_CT1.95
CALL TIMER('VDIF_CTL',3) VDF_CT1.96
END IF VDF_CT1.97
VDF_CT1.98
LEN_STASH_U_FLUX = 1 DR151193.18
LEN_STASH_V_FLUX = 1 DR151193.19
POINTS_FLUX_U = 1 DR151193.20
POINTS_FLUX_V = 1 DR151193.21
LEVELS_FLUX = 1 DR151193.22
DR151193.23
IF (SF(0,7)) THEN DR151193.24
DR151193.25
DO I=1,INT7 DR151193.26
STASHWORK(I)=0 DR151193.27
ENDDO DR151193.28
VDF_CT1.100
CL Set levels lists for diagnostics VDF_CT1.101
VDF_CT1.102
IF(SF(201,7)) THEN VDF_CT1.103
CALL SET_LEVELS_LIST(P_LEVELS,LEN_STLIST,STLIST(1,STINDEX VDF_CT1.104
& (1,201,7,im_index)),U_LIST,STASH_LEVELS,NUM_STASH_LEVELS+1, GRB4F305.532
& ICODE,CMESSAGE) GRB4F305.533
IF( ICODE.GT.0) RETURN VDF_CT1.107
END IF VDF_CT1.108
VDF_CT1.109
IF(SF(202,7)) THEN VDF_CT1.110
CALL SET_LEVELS_LIST(P_LEVELS,LEN_STLIST,STLIST(1,STINDEX VDF_CT1.111
& (1,202,7,im_index)),V_LIST,STASH_LEVELS,NUM_STASH_LEVELS+1, GRB4F305.534
& ICODE,CMESSAGE) GRB4F305.535
IF( ICODE.GT.0) RETURN VDF_CT1.114
END IF VDF_CT1.115
VDF_CT1.116
CL Set diagnostic array dimensions DR151193.31
IF (SF(201,7)) THEN DR151193.32
LEN_STASH_U_FLUX = U_FIELD DR151193.33
POINTS_FLUX_U = ROWS*ROW_LENGTH DR151193.34
ENDIF DR151193.35
IF (SF(202,7)) THEN DR151193.36
LEN_STASH_V_FLUX = U_FIELD DR151193.37
POINTS_FLUX_V = ROWS*ROW_LENGTH DR151193.38
ENDIF DR151193.39
IF (SF(201,7) .OR. SF(202,7)) THEN DR151193.40
LEVELS_FLUX = TOP_VDIF_LEVEL - BOTTOM_VDIF_LEVEL ADR1F305.234
ENDIF DR151193.42
DR151193.43
ENDIF DR151193.44
VDF_CT1.118
CL 7.1 Call VDIF_CTL to calculate all vertical diffusion increments VDF_CT1.119
VDF_CT1.120
CALL VDIF_CTL( VDF_CT1.121
C arguments... VDF_CT1.122
C primary data in VDF_CT1.123
& D1(JPSTAR),D1(JU(1)),D1(JV(1)), VDF_CT1.124
C size and control variables VDF_CT1.125
& P_FIELD,U_FIELD,ROWS,FIRST_ROW,ROW_LENGTH, VDF_CT1.126
& BOTTOM_VDIF_LEVEL,TOP_VDIF_LEVEL,LEVELS_VD,P_LEVELS, ADR1F305.235
C level and row dependent variables VDF_CT1.128
& A_LEVDEPC(JAK),A_LEVDEPC(JBK), VDF_CT1.129
& A_LEVDEPC(JDELTA_AK),A_LEVDEPC(JDELTA_BK), VDF_CT1.130
& COS_U_TRUE_LATITUDE, VDF_CT1.131
C other constants VDF_CT1.132
& LATITUDE_BAND,VERTICAL_DIFFUSION,SECS_PER_STEPim(atmos_im), ADR1F305.236
C diagnostics DR151193.46
& STASHWORK(SI(201,7,im_index)),SF(201,7),U_LIST, GRB4F305.536
& STASHWORK(SI(202,7,im_index)),SF(202,7),V_LIST, GRB4F305.537
& LEN_STASH_U_FLUX,LEN_STASH_V_FLUX, DR151193.49
& POINTS_FLUX_U,POINTS_FLUX_V,LEVELS_FLUX, DR151193.50
& ICODE) VDF_CT1.143
VDF_CT1.144
IF(LTIMER) THEN VDF_CT1.145
CALL TIMER('VDIF_CTL',4) GRB3F400.10
END IF VDF_CT1.147
VDF_CT1.148
IF(ICODE.GT.0) THEN VDF_CT1.149
CMESSAGE='VDIF_CTL: Error in VDIF_CTL' VDF_CT1.150
RETURN VDF_CT1.151
END IF VDF_CT1.152
VDF_CT1.153
IF (SF(0,7)) THEN ! Diagnostic processing DR151193.51
VDF_CT1.155
CL Extend diagnostics to full area for STASH processing VDF_CT1.156
CL 7.2 Diagnostic processing VDF_CT1.157
VDF_CT1.158
CALL EXTDIAG(STASHWORK,SI(1,7,im_index),SF(1,7),201,202, GRB4F305.538
& INT7,ROW_LENGTH, VDF_CT1.160
& STLIST,LEN_STLIST,STINDEX(1,1,7,im_index),2,STASH_LEVELS, GRB4F305.539
& NUM_STASH_LEVELS+1, STASH_PSEUDO_LEVELS, VDF_CT1.162
& NUM_STASH_PSEUDO, GPB1F403.1516
& im_ident,7, GPB1F403.1517
*CALL ARGPPX GPB1F403.1518
& ICODE,CMESSAGE) GPB1F403.1519
VDF_CT1.164
IF(ICODE.GT.0) RETURN VDF_CT1.165
VDF_CT1.168
CL Call STASH to process output VDF_CT1.169
VDF_CT1.170
IF(LTIMER) THEN VDF_CT1.171
CALL TIMER('STASH ',3) VDF_CT1.172
END IF VDF_CT1.173
VDF_CT1.174
CALL STASH(a_sm,a_im,7,STASHWORK, GKR0F305.1013
*CALL ARGSIZE @DYALLOC.3873
*CALL ARGD1 @DYALLOC.3874
*CALL ARGDUMA @DYALLOC.3875
*CALL ARGDUMO @DYALLOC.3876
*CALL ARGDUMW GKR1F401.285
*CALL ARGSTS @DYALLOC.3877
*CALL ARGPPX GKR0F305.1014
& ICODE,CMESSAGE) @DYALLOC.3881
VDF_CT1.176
IF(LTIMER) THEN VDF_CT1.177
CALL TIMER('STASH ',4) VDF_CT1.178
END IF VDF_CT1.179
VDF_CT1.180
IF(ICODE.GT.0) RETURN VDF_CT1.181
DR151193.52
ENDIF ! End if diagnostic processing DR151193.53
VDF_CT1.182
RETURN VDF_CT1.183
END VDF_CT1.184
*ENDIF VDF_CT1.185