*IF DEF,A15_1A TESTDI1A.2
C ******************************COPYRIGHT****************************** GTS2F400.10153
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10154
C GTS2F400.10155
C Use, duplication or disclosure of this code is subject to the GTS2F400.10156
C restrictions as set forth in the contract. GTS2F400.10157
C GTS2F400.10158
C Meteorological Office GTS2F400.10159
C London Road GTS2F400.10160
C BRACKNELL GTS2F400.10161
C Berkshire UK GTS2F400.10162
C RG12 2SZ GTS2F400.10163
C GTS2F400.10164
C If no contract has been raised with this copy of the code, the use, GTS2F400.10165
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10166
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10167
C Modelling at the above address. GTS2F400.10168
C ******************************COPYRIGHT****************************** GTS2F400.10169
C GTS2F400.10170
CLL SUBROUTINE TESTDIAG------------------------------------------------ TESTDI1A.3
CLL TESTDI1A.4
CLL PURPOSE: CALCULATE SIMPLE TEST DIAGNOSTICS BASED ON A SIMPLE TESTDI1A.5
CLL ANALYTIC FORMULA: TESTDI1A.6
CLL VALUE=A*(LATITUDE+90.)+B*LONGITUDE+C*LEVEL+D*FORECAST_HRS TESTDI1A.7
CLL WHERE A=1.0, B=1.0E2, C=1.0E3, D=1.0E4 TESTDI1A.8
CLL AND (LAT,LONG) ARE IN DEGREES, ACTUAL POSITION (ROTATED FOR LAM), TESTDI1A.9
CLL LEVEL IS EITHER MODEL LEVEL OR TESTDI1A.10
CLL PRESSURE LEVEL IN MB., AND FORECAST_HRS IN HOURS. TESTDI1A.11
CLL THESE DIAGNOSTICS ARE TO BE USED FOR CHECKING OUTPUT PROCEDURES TESTDI1A.12
CLL AFTER VARIOUS POST-PROCESSING ROUTES. TESTDI1A.13
CLL FOUR DIAGNOSTICS CAN BE CALCULATED: TESTDI1A.14
CLL 1. SINGLE LEVEL FIELD (LEVEL=0.) AT U POINTS. TESTDI1A.15
CLL 2. SINGLE LEVEL FIELD (LEVEL=0.) AT P POINTS. TESTDI1A.16
CLL 3. MULTI- LEVEL FIELD (LEVEL=PRESS LEVEL) AT P POINTS TESTDI1A.17
CLL 4. MULTI- LEVEL FIELD (LEVEL=MODEL LEVEL) AT P POINTS TESTDI1A.18
CLL TESTDI1A.19
CLL NOT SUITABLE FOR SINGLE COLUMN USE TESTDI1A.20
CLL TESTDI1A.21
CLL MODEL MODIFICATION HISTORY: TESTDI1A.22
CLL VERSION DATE TESTDI1A.23
CLL 3.1 25/01/93 NEW DECK R.RAWLINS TESTDI1A.24
CLL TESTDI1A.25
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, TESTDI1A.26
CLL VERSION 2, DATED 18/01/90 TESTDI1A.27
CLL TESTDI1A.28
CLL SYSTEM TASK: D4 TESTDI1A.29
CLL TESTDI1A.30
CLL LOGICAL COMPONENT: TESTDI1A.31
CLL TESTDI1A.32
CLL DOCUMENTATION: UMDP NO. D7 TESTDI1A.33
CLL TESTDI1A.34
CLLEND------------------------------------------------------------------ TESTDI1A.35
C TESTDI1A.36
C*L ARGUMENTS:---------------------------------------------------------- TESTDI1A.37
SUBROUTINE TESTDIAG 1,2TESTDI1A.38
1 (P_FIELD,U_FIELD,P_ROWS,U_ROWS,ROW_LENGTH,EW_SPACE,NS_SPACE, TESTDI1A.39
2 FIRST_LAT,FIRST_LONG,ELF,PHI_POLE,LAMBDA_POLE, TESTDI1A.40
3 PRESS_LEVELS_LIST,NO_PRESS_LEVELS, TESTDI1A.41
4 MODEL_LEVELS_LIST,NO_MODEL_LEVELS,FORECAST_HRS, TESTDI1A.42
5 DIAG1,DIAG2,DIAG3,DIAG4, TESTDI1A.43
6 QDIA1,QDIA2,QDIA3,QDIA4) TESTDI1A.44
C TESTDI1A.45
IMPLICIT NONE TESTDI1A.46
C TESTDI1A.47
INTEGER TESTDI1A.48
* P_FIELD !IN FIRST DIMENSION OF FIELD OF PSTAR TESTDI1A.49
*, U_FIELD !IN FIRST DIMENSION OF (U,V) FIELD TESTDI1A.50
*, P_ROWS !IN NO. OF ROWS FOR P FIELD TESTDI1A.51
*, U_ROWS !IN NO. OF ROWS FOR U FIELD TESTDI1A.52
*, ROW_LENGTH !IN NO. OF POINTS PER ROW TESTDI1A.53
*, NO_MODEL_LEVELS !IN MODEL LEVELS FOR OUTPUT TESTDI1A.54
*, NO_PRESS_LEVELS !IN PRESS LEVELS FOR OUTPUT TESTDI1A.55
*, FORECAST_HRS !IN FORECAST HOURS T+0, ETC TESTDI1A.56
C TESTDI1A.57
LOGICAL TESTDI1A.58
* ELF !IN TRUE IF MODEL IS LAM WITH ROTATED GRID TESTDI1A.59
* ,QDIA1 !IN STASHFLAG FOR DIAG1 TESTDI1A.60
* ,QDIA2 !IN STASHFLAG FOR DIAG2 TESTDI1A.61
* ,QDIA3 !IN STASHFLAG FOR DIAG3 TESTDI1A.62
* ,QDIA4 !IN STASHFLAG FOR DIAG4 TESTDI1A.63
C TESTDI1A.64
REAL TESTDI1A.65
* EW_SPACE !IN DELTA LONGITUDE (DEGREES) TESTDI1A.66
*, NS_SPACE !IN DELTA LATITUDE (DEGREES) TESTDI1A.67
*, FIRST_LAT !IN LATITUDE OF FIRST P ROW IN DEGREES TESTDI1A.68
*, FIRST_LONG !IN LONGITUDE OF FIRST P COL IN DEGREES TESTDI1A.69
*, PHI_POLE !IN LATITUDE OF THE PSEUDO POLE TESTDI1A.70
*, LAMBDA_POLE !IN LONGITUDE OF THE PSEUDO POLE TESTDI1A.71
*, MODEL_LEVELS_LIST(NO_MODEL_LEVELS) !IN LEVELS LIST (FOR DIAG3) TESTDI1A.72
*, PRESS_LEVELS_LIST(NO_PRESS_LEVELS) !IN LEVELS LIST (FOR DIAG4) TESTDI1A.73
*, DIAG1(U_FIELD) !OUT DIAGNOSTIC 1 TESTDI1A.74
*, DIAG2(P_FIELD) !OUT DIAGNOSTIC 2 TESTDI1A.75
*, DIAG3(P_FIELD,NO_PRESS_LEVELS) !OUT DIAGNOSTIC 3 TESTDI1A.76
*, DIAG4(P_FIELD,NO_MODEL_LEVELS) !OUT DIAGNOSTIC 4 TESTDI1A.77
C TESTDI1A.78
C*---------------------------------------------------------------------- TESTDI1A.79
C TESTDI1A.80
C*L WORKSPACE USAGE----------------------------------------------------- TESTDI1A.81
C*---------------------------------------------------------------------- TESTDI1A.82
REAL TESTDI1A.83
* LATITUDE(P_FIELD) ! LATITUDE IN DEGREES TESTDI1A.84
*, LONGITUDE(P_FIELD) ! LONGITUDE IN DEGREES TESTDI1A.85
*, LAT(P_FIELD) ! LATITUDE IN DEGREES ON EQUATORIAL GRID TESTDI1A.86
*, LONG(P_FIELD) ! LONGITUDE IN DEGREES ON EQUATORIAL GRID TESTDI1A.87
C TESTDI1A.88
C*L EXTERNAL SUBROUTINES CALLED----------------------------------------- TESTDI1A.89
EXTERNAL LLTOEQ TESTDI1A.90
C*---------------------------------------------------------------------- TESTDI1A.91
C TESTDI1A.92
*CALL C_PI 
TESTDI1A.93
*CALL C_R_CP TESTDI1A.94
C TESTDI1A.95
C----------------------------------------------------------------------- TESTDI1A.96
C DEFINE LOCAL CONSTANTS TESTDI1A.97
C----------------------------------------------------------------------- TESTDI1A.98
REAL TESTDI1A.99
* A,B,C,D ! COEFFICIENTS FOR CALCULATING VALUES OF FIELD TESTDI1A.100
C TESTDI1A.101
PARAMETER(A=1.0,B=1.0E2,C=1.0E3,D=1.0E4) TESTDI1A.102
C TESTDI1A.103
C----------------------------------------------------------------------- TESTDI1A.104
C DEFINE LOCAL VARIABLES TESTDI1A.105
C----------------------------------------------------------------------- TESTDI1A.106
INTEGER TESTDI1A.107
* I,J,K ! LOOP COUNTERS TESTDI1A.108
* ,L ! LOOP INDEX TESTDI1A.109
C----------------------------------------------------------------------- TESTDI1A.110
CL 1. CALCULATE FIRST DIAGNOSTIC (U GRID SINGLE LEVEL) TESTDI1A.111
C----------------------------------------------------------------------- TESTDI1A.112
IF(QDIA1) THEN TESTDI1A.113
CL TESTDI1A.114
CL 1a. FIND EQUATORIAL LATITUDES,LONGITUDES TESTDI1A.115
CL TESTDI1A.116
DO J=1,U_ROWS TESTDI1A.117
DO I=1,ROW_LENGTH TESTDI1A.118
L= I + (J-1)*ROW_LENGTH TESTDI1A.119
LAT (L)= FIRST_LAT - NS_SPACE*(J-0.5) TESTDI1A.120
LONG(L)= FIRST_LONG + EW_SPACE*(I-0.5) TESTDI1A.121
ENDDO TESTDI1A.122
ENDDO TESTDI1A.123
CL TESTDI1A.124
CL 1b. CONVERT TO ACTUAL LATITUDE,LONGITUDE IF ELF GRID TESTDI1A.125
CL TESTDI1A.126
IF(ELF) THEN TESTDI1A.127
CALL EQTOLL(LAT,LONG,LATITUDE,LONGITUDE,PHI_POLE,LAMBDA_POLE, TESTDI1A.128
* U_FIELD) TESTDI1A.129
ELSE TESTDI1A.130
DO I=1,U_FIELD TESTDI1A.131
LATITUDE(I) =LAT(I) TESTDI1A.132
LONGITUDE(I)=LONG(I) TESTDI1A.133
ENDDO TESTDI1A.134
ENDIF TESTDI1A.135
CL TESTDI1A.136
CL 1c. CALCULATE VALUE FROM ANALYTIC FUNCTION TESTDI1A.137
CL TESTDI1A.138
TESTDI1A.139
DO I=1,U_FIELD TESTDI1A.140
DIAG1(I)=A*(LATITUDE(I)+90.0) + B*LONGITUDE(I) + TESTDI1A.141
* D*FORECAST_HRS TESTDI1A.142
ENDDO TESTDI1A.143
TESTDI1A.144
ENDIF ! END OF QDIA1 TEST TESTDI1A.145
TESTDI1A.146
C----------------------------------------------------------------------- TESTDI1A.147
CL 2. CALCULATE ACTUAL LATITUDES, LONGITUDES FOR P FIELDS (DIAG 2-4) TESTDI1A.148
C----------------------------------------------------------------------- TESTDI1A.149
IF(QDIA2.OR.QDIA3.OR.QDIA4) THEN TESTDI1A.150
CL TESTDI1A.151
CL 2a. FIND EQUATORIAL LATITUDES,LONGITUDES TESTDI1A.152
CL TESTDI1A.153
DO J=1,P_ROWS TESTDI1A.154
DO I=1,ROW_LENGTH TESTDI1A.155
L= I + (J-1)*ROW_LENGTH TESTDI1A.156
LAT (L)= FIRST_LAT - NS_SPACE*(J-1) TESTDI1A.157
LONG(L)= FIRST_LONG + EW_SPACE*(I-1) TESTDI1A.158
ENDDO TESTDI1A.159
ENDDO TESTDI1A.160
CL TESTDI1A.161
CL 2b. CONVERT TO ACTUAL LATITUDE,LONGITUDE IF ELF GRID TESTDI1A.162
CL TESTDI1A.163
IF(ELF) THEN TESTDI1A.164
CALL EQTOLL(LAT,LONG,LATITUDE,LONGITUDE,PHI_POLE,LAMBDA_POLE, TESTDI1A.165
* P_FIELD) TESTDI1A.166
ELSE TESTDI1A.167
DO I=1,P_FIELD TESTDI1A.168
LATITUDE(I) =LAT(I) TESTDI1A.169
LONGITUDE(I)=LONG(I) TESTDI1A.170
ENDDO TESTDI1A.171
ENDIF TESTDI1A.172
ENDIF ! END OF QDIA2-4 TEST TESTDI1A.173
C----------------------------------------------------------------------- TESTDI1A.174
CL 3. CALCULATE SECOND DIAGNOSTIC (P GRID SINGLE LEVEL) TESTDI1A.175
C----------------------------------------------------------------------- TESTDI1A.176
IF(QDIA2) THEN TESTDI1A.177
TESTDI1A.178
DO I=1,P_FIELD TESTDI1A.179
DIAG2(I)=A*(LATITUDE(I)+90.0) + B*LONGITUDE(I) + TESTDI1A.180
* D*FORECAST_HRS TESTDI1A.181
ENDDO TESTDI1A.182
TESTDI1A.183
ENDIF ! END OF QDIA2 TEST TESTDI1A.184
C----------------------------------------------------------------------- TESTDI1A.185
CL 4. CALCULATE THIRD DIAGNOSTIC (P GRID PRESSURE LEVELS) TESTDI1A.186
C----------------------------------------------------------------------- TESTDI1A.187
IF(QDIA3) THEN TESTDI1A.188
TESTDI1A.189
DO K=1,NO_PRESS_LEVELS TESTDI1A.190
DO I=1,P_FIELD TESTDI1A.191
DIAG3(I,K)=A*(LATITUDE(I)+90.0) + B*LONGITUDE(I) + TESTDI1A.192
* C*PRESS_LEVELS_LIST(K) + D*FORECAST_HRS TESTDI1A.193
ENDDO TESTDI1A.194
ENDDO TESTDI1A.195
TESTDI1A.196
ENDIF ! END OF QDIA3 TEST TESTDI1A.197
C----------------------------------------------------------------------- TESTDI1A.198
CL 5. CALCULATE FOURTH DIAGNOSTIC (P GRID MODEL LEVELS) TESTDI1A.199
C----------------------------------------------------------------------- TESTDI1A.200
IF(QDIA4) THEN TESTDI1A.201
TESTDI1A.202
DO K=1,NO_MODEL_LEVELS TESTDI1A.203
DO I=1,P_FIELD TESTDI1A.204
DIAG4(I,K)=A*(LATITUDE(I)+90.0) + B*LONGITUDE(I) + TESTDI1A.205
* C*MODEL_LEVELS_LIST(K) + D*FORECAST_HRS TESTDI1A.206
ENDDO TESTDI1A.207
ENDDO TESTDI1A.208
TESTDI1A.209
ENDIF ! END OF QDIA4 TEST TESTDI1A.210
C======================================================================= TESTDI1A.211
C END OF TESTDIAG TESTDI1A.212
C======================================================================= TESTDI1A.213
RETURN TESTDI1A.214
END TESTDI1A.215
C======================================================================= TESTDI1A.216
*ENDIF TESTDI1A.217