SUBROUTINE INTF_HINTC ( 2,11@DYALLOC.3942
& P_ROWSDA, U_ROWSDA, ROW_LENGTHDA, U_FIELDDA, ANF1F304.18
*CALL ARGSIZE 
@DYALLOC.3944
*CALL ARGDUMA @DYALLOC.3945
*CALL ARGINFA @DYALLOC.3946
& JINTF,LEN_INTF_P,LEN_INTF_U, @DYALLOC.3947
& ICODE,CMESSAGE,LLBOUTA) GSS1F304.11
INTFHIC1.30
IMPLICIT NONE INTFHIC1.31
INTFHIC1.32
*CALL CMAXSIZE @DYALLOC.3948
*CALL CINTFA GDR2F405.109
*CALL TYPSIZE @DYALLOC.3949
*CALL TYPDUMA @DYALLOC.3950
*CALL TYPINFA @DYALLOC.3951
@DYALLOC.3952
INTEGER INTFHIC1.33
& JINTF ! Index to interface area INTFHIC1.34
& ,LEN_INTF_P ! Length of interface p* field INTFHIC1.39
& ,LEN_INTF_U ! Length of interface u field INTFHIC1.40
& ,P_ROWSDA ! No. of p rows ANF1F304.19
& ,U_ROWSDA ! No. of u rows (wind) ANF1F304.20
& ,ROW_LENGTHDA ! No. of points in row ANF1F304.21
& ,U_FIELDDA ! No. of points in wind field ANF1F304.22
INTFHIC1.41
INTEGER INTFHIC1.42
& ICODE ! Return code INTFHIC1.43
INTFHIC1.44
CHARACTER*(80) ANF0F304.25
& CMESSAGE ! Error message INTFHIC1.46
INTFHIC1.50
LOGICAL LLBOUTA ! Replaces DEF LBOUTA GSS1F304.12
GSS1F304.13
C Local variables INTFHIC1.51
INTEGER INTFHIC1.52
& I,J,IJ, ! DO loop indices INTFHIC1.53
& IP_P,IP_U, ! Pointers to int coeffs for area JINTF INTFHIC1.54
& ROW, ! Loop index for rows in rimwidth INTFHIC1.55
& IRIM ! Rim point number INTFHIC1.56
INTFHIC1.57
LOGICAL INTFHIC1.58
& CYCLIC, ! =T, if input grid cyclic INTFHIC1.59
& ROT_IN ! =T, if input grid rotated INTFHIC1.60
INTFHIC1.61
REAL INTFHIC1.62
& AP_LAMBDA_TARG(LEN_INTF_P), ! Longitude coordinates of target INTFHIC1.63
C ! P grid in degrees using same INTFHIC1.64
C ! rotation as source grid INTFHIC1.65
& AU_LAMBDA_TARG(LEN_INTF_U), ! Longitude coordinates of target INTFHIC1.66
C ! V grid in degrees using same INTFHIC1.67
C ! rotation as source grid INTFHIC1.68
& AP_PHI_TARG(LEN_INTF_P), ! latitude coordinates of target INTFHIC1.69
C ! P grid in degrees using same INTFHIC1.70
C ! rotation as source grid INTFHIC1.71
& AU_PHI_TARG(LEN_INTF_U) ! latitude coordinates of target INTFHIC1.72
C ! V grid in degrees using same INTFHIC1.73
C ! rotation as source grid INTFHIC1.74
INTFHIC1.75
*IF DEF,ATMOS GSS1F304.14
C Use of U_ROWS and U_FIELD gives compile errors if @DYALLOC.3954
C *DEF OCEAN is activated. Needs attention when routine @DYALLOC.3955
C adapted for ocean use. @DYALLOC.3956
REAL INTFHIC1.76
* LAMBDA(LEN_INTF_P) ! INTFHIC1.77
*,PHI (LEN_INTF_P) ! INTFHIC1.78
*,AP_PHI_SRCE(P_ROWSDA) ! Model p-grid latitudes ANF1F304.23
*,AU_PHI_SRCE(U_ROWSDA) ! Model u-grid latitudes ANF1F304.24
*,AP_LAMBDA_SRCE(ROW_LENGTHDA) ! Model p-grid longitudes ANF1F304.25
*,AU_LAMBDA_SRCE(ROW_LENGTHDA) ! Model u-grid longitudes ANF1F304.26
*,LAMBDA_ROT(U_FIELDDA) ! Standard lat coords of source grid ANF1F304.27
*,LAMBDA_INN(U_FIELDDA) ! Latitude coords of source grid ANF1F304.28
*,PHI_INN(U_FIELDDA) ! Longitude coords of source grid ANF1F304.29
*ENDIF GSS1F304.15
*IF DEF,MPP ARB2F403.86
*CALL PARVARS ARB2F403.87
*ENDIF ARB2F403.88
INTFHIC1.86
C*---------------------------------------------------------------------- INTFHIC1.87
CL Subroutines called: INTFHIC1.88
EXTERNAL H_INT_CO,EQTOLL,LLTOEQ,W_COEFF INTFHIC1.89
INTFHIC1.90
CL Internal Structure INTFHIC1.91
INTFHIC1.92
*IF DEF,ATMOS GSS1F304.16
IF (LLBOUTA) THEN GSS1F304.17
INTFHIC1.94
ICODE=0 INTFHIC1.95
CMESSAGE=' ' INTFHIC1.96
INTFHIC1.97
CL 1.0 Get positions in interpolation coeff. arrays for this area INTFHIC1.98
INTFHIC1.99
IP_P = 1 INTFHIC1.100
IP_U = 1 INTFHIC1.101
IF (JINTF.GT.1) THEN INTFHIC1.102
DO J=1,JINTF-1 INTFHIC1.103
IP_P = IP_P + LEN_INTFA_P(J) INTFHIC1.104
IP_U = IP_U + LEN_INTFA_U(J) INTFHIC1.105
ENDDO INTFHIC1.106
ENDIF INTFHIC1.107
INTFHIC1.108
CL 2.0 Set up interpolation constants INTFHIC1.109
INTFHIC1.110
C Logical to indicate input grid is rotated INTFHIC1.111
ROT_IN=A_REALHD(5).NE.90..OR.A_REALHD(6).NE.0. INTFHIC1.112
INTFHIC1.113
C Logical to indicate if input data cyclic INTFHIC1.114
CYCLIC=A_FIXHD(4).LT.3 INTFHIC1.115
INTFHIC1.116
CL 2.1 Calculate coordinates of limited area P grid INTFHIC1.117
INTFHIC1.118
CL Northern points INTFHIC1.119
INTFHIC1.120
IRIM=1 INTFHIC1.121
INTFHIC1.122
DO ROW=1,INTFWIDTHA(JINTF) INTFHIC1.123
DO I=1,INTF_ROW_LENGTH(JINTF) INTFHIC1.124
LAMBDA(IRIM)=INTF_FIRSTLONG(JINTF)+(I-1)*INTF_EWSPACE(JINTF) INTFHIC1.125
PHI(IRIM)=INTF_FIRSTLAT(JINTF)-(ROW-1)*INTF_NSSPACE(JINTF) INTFHIC1.126
IRIM=IRIM+1 INTFHIC1.127
ENDDO INTFHIC1.128
ENDDO INTFHIC1.129
INTFHIC1.130
CL Eastern points INTFHIC1.131
INTFHIC1.132
DO ROW=INTFWIDTHA(JINTF)+1,INTF_P_ROWS(JINTF)-INTFWIDTHA(JINTF) INTFHIC1.133
DO I=INTF_ROW_LENGTH(JINTF)-INTFWIDTHA(JINTF)+1, INTFHIC1.134
& INTF_ROW_LENGTH(JINTF) INTFHIC1.135
LAMBDA(IRIM)=INTF_FIRSTLONG(JINTF)+(I-1)*INTF_EWSPACE(JINTF) INTFHIC1.136
PHI(IRIM)=INTF_FIRSTLAT(JINTF)-(ROW-1)*INTF_NSSPACE(JINTF) INTFHIC1.137
IRIM=IRIM+1 INTFHIC1.138
ENDDO INTFHIC1.139
ENDDO INTFHIC1.140
INTFHIC1.141
CL Southern points INTFHIC1.142
INTFHIC1.143
DO ROW=INTF_P_ROWS(JINTF)+1-INTFWIDTHA(JINTF),INTF_P_ROWS(JINTF) INTFHIC1.144
DO I=1,INTF_ROW_LENGTH(JINTF) INTFHIC1.145
LAMBDA(IRIM)=INTF_FIRSTLONG(JINTF)+(I-1)*INTF_EWSPACE(JINTF) INTFHIC1.146
PHI(IRIM)=INTF_FIRSTLAT(JINTF)-(ROW-1)*INTF_NSSPACE(JINTF) INTFHIC1.147
IRIM=IRIM+1 INTFHIC1.148
ENDDO INTFHIC1.149
ENDDO INTFHIC1.150
INTFHIC1.151
CL Western points INTFHIC1.152
INTFHIC1.153
DO ROW=INTFWIDTHA(JINTF)+1,INTF_P_ROWS(JINTF)-INTFWIDTHA(JINTF) INTFHIC1.154
DO I=1,INTFWIDTHA(JINTF) INTFHIC1.155
LAMBDA(IRIM)=INTF_FIRSTLONG(JINTF)+(I-1)*INTF_EWSPACE(JINTF) INTFHIC1.156
PHI(IRIM)=INTF_FIRSTLAT(JINTF)-(ROW-1)*INTF_NSSPACE(JINTF) INTFHIC1.157
IRIM=IRIM+1 INTFHIC1.158
ENDDO INTFHIC1.159
ENDDO INTFHIC1.160
INTFHIC1.161
CALL EQTOLL(PHI,LAMBDA,AP_PHI_TARG,AP_LAMBDA_TARG, INTFHIC1.162
& INTF_POLELAT(JINTF),INTF_POLELONG(JINTF),LEN_INTF_P) INTFHIC1.163
INTFHIC1.164
IF (ROT_IN) THEN INTFHIC1.165
INTFHIC1.166
CALL LLTOEQ (AP_PHI_TARG,AP_LAMBDA_TARG,AP_PHI_TARG, INTFHIC1.167
+ AP_LAMBDA_TARG,A_REALHD(5),A_REALHD(6),LEN_INTF_P) INTFHIC1.168
INTFHIC1.169
DO I=1,LEN_INTF_P INTFHIC1.170
IF (AP_LAMBDA_TARG(I).GT.180.) THEN INTFHIC1.171
AP_LAMBDA_TARG(I) = AP_LAMBDA_TARG(I)-360. INTFHIC1.172
ENDIF INTFHIC1.173
ENDDO INTFHIC1.174
INTFHIC1.175
ENDIF INTFHIC1.176
INTFHIC1.177
CL 2.2 Calculate coordinates of limited area U grid INTFHIC1.178
INTFHIC1.179
CL Northern points INTFHIC1.180
INTFHIC1.181
IRIM=1 INTFHIC1.182
INTFHIC1.183
DO ROW=1,INTFWIDTHA(JINTF) INTFHIC1.184
DO I=1,INTF_ROW_LENGTH(JINTF)-1 INTFHIC1.185
LAMBDA(IRIM)=INTF_FIRSTLONG(JINTF)+(I-.5)*INTF_EWSPACE(JINTF) INTFHIC1.186
PHI(IRIM)=INTF_FIRSTLAT(JINTF)-(ROW-.5)*INTF_NSSPACE(JINTF) INTFHIC1.187
IRIM=IRIM+1 INTFHIC1.188
ENDDO INTFHIC1.189
ENDDO INTFHIC1.190
INTFHIC1.191
CL Eastern points INTFHIC1.192
INTFHIC1.193
DO ROW=INTFWIDTHA(JINTF)+1,INTF_P_ROWS(JINTF)-1-INTFWIDTHA(JINTF) INTFHIC1.194
DO I=INTF_ROW_LENGTH(JINTF)-INTFWIDTHA(JINTF), INTFHIC1.195
& INTF_ROW_LENGTH(JINTF)-1 INTFHIC1.196
LAMBDA(IRIM)=INTF_FIRSTLONG(JINTF)+(I-.5)*INTF_EWSPACE(JINTF) INTFHIC1.197
PHI(IRIM)=INTF_FIRSTLAT(JINTF)-(ROW-.5)*INTF_NSSPACE(JINTF) INTFHIC1.198
IRIM=IRIM+1 INTFHIC1.199
ENDDO INTFHIC1.200
ENDDO INTFHIC1.201
INTFHIC1.202
CL Southern points INTFHIC1.203
INTFHIC1.204
DO ROW=INTF_P_ROWS(JINTF)-INTFWIDTHA(JINTF),INTF_P_ROWS(JINTF)-1 INTFHIC1.205
DO I=1,INTF_ROW_LENGTH(JINTF)-1 INTFHIC1.206
LAMBDA(IRIM)=INTF_FIRSTLONG(JINTF)+(I-.5)*INTF_EWSPACE(JINTF) INTFHIC1.207
PHI(IRIM)=INTF_FIRSTLAT(JINTF)-(ROW-.5)*INTF_NSSPACE(JINTF) INTFHIC1.208
IRIM=IRIM+1 INTFHIC1.209
ENDDO INTFHIC1.210
ENDDO INTFHIC1.211
INTFHIC1.212
CL Western points INTFHIC1.213
INTFHIC1.214
DO ROW=INTFWIDTHA(JINTF)+1,INTF_P_ROWS(JINTF)-1-INTFWIDTHA(JINTF) INTFHIC1.215
DO I=1,INTFWIDTHA(JINTF) INTFHIC1.216
LAMBDA(IRIM)=INTF_FIRSTLONG(JINTF)+(I-.5)*INTF_EWSPACE(JINTF) INTFHIC1.217
PHI(IRIM)=INTF_FIRSTLAT(JINTF)-(ROW-.5)*INTF_NSSPACE(JINTF) INTFHIC1.218
IRIM=IRIM+1 INTFHIC1.219
ENDDO INTFHIC1.220
ENDDO INTFHIC1.221
INTFHIC1.222
CALL EQTOLL(PHI,LAMBDA,AU_PHI_TARG,AU_LAMBDA_TARG, INTFHIC1.223
& INTF_POLELAT(JINTF),INTF_POLELONG(JINTF),LEN_INTF_U) INTFHIC1.224
INTFHIC1.225
CL 2.3 Calculate coefficients for rotation of winds INTFHIC1.226
INTFHIC1.227
CALL W_COEFF(COEFF1(IP_U),COEFF2(IP_U),AU_LAMBDA_TARG, INTFHIC1.228
& LAMBDA,INTF_POLELAT(JINTF),INTF_POLELONG(JINTF),LEN_INTF_U) INTFHIC1.229
INTFHIC1.230
IF (ROT_IN) THEN INTFHIC1.231
INTFHIC1.232
CALL LLTOEQ (AU_PHI_TARG,AU_LAMBDA_TARG,AU_PHI_TARG, INTFHIC1.233
+ AU_LAMBDA_TARG,A_REALHD(5),A_REALHD(6),LEN_INTF_U) INTFHIC1.234
INTFHIC1.235
DO I=1,LEN_INTF_U INTFHIC1.236
IF (AU_LAMBDA_TARG(I).GT.180.) THEN INTFHIC1.237
AU_LAMBDA_TARG(I) = AU_LAMBDA_TARG(I)-360. INTFHIC1.238
ENDIF INTFHIC1.239
ENDDO INTFHIC1.240
INTFHIC1.241
C Calculate coefficients for rotating wind from source -> lat-lon INTFHIC1.242
INTFHIC1.243
IJ=0 INTFHIC1.244
*IF DEF,MPP ARB2F403.89
! Compute coeff3/4 for the area covered by the local processor. ARB2F403.90
ARB2F403.91
do j = 1,g_lasize(2,mype) ARB2F403.92
do i = 1,g_lasize(1,mype) ARB2F403.93
IJ=IJ+1 ARB2F403.94
LAMBDA_INN(IJ)=A_REALHD(4)+A_REALHD(1)* ARB2F403.95
& (I+g_datastart(1,mype)-Offx-1.5) ARB2F403.96
PHI_INN(IJ)=A_REALHD(3)-A_REALHD(2)* ARB2F403.97
& (J+g_datastart(2,mype)-Offy-1.5) ARB2F403.98
ENDDO ARB2F403.99
ENDDO ARB2F403.100
ARB2F403.101
CALL EQTOLL(PHI_INN,LAMBDA_INN,PHI_INN,LAMBDA_ROT, ARB2F403.102
& A_REALHD(5),A_REALHD(6),IJ) ARB2F403.103
CALL W_COEFF(COEFF3,COEFF4,LAMBDA_ROT,LAMBDA_INN, ARB2F403.104
& A_REALHD(5),A_REALHD(6),IJ) ARB2F403.105
*ELSE ARB2F403.106
! Compute coeff3/4 for the full model domain. ARB2F403.107
DO J=1,U_ROWSDA APB4F401.498
DO I=1,ROW_LENGTHDA APB4F401.499
IJ=IJ+1 INTFHIC1.247
LAMBDA_INN(IJ)=A_REALHD(4)+A_REALHD(1)*(I-1+0.5) INTFHIC1.248
PHI_INN(IJ)=A_REALHD(3)-A_REALHD(2)*(J-1+0.5) INTFHIC1.249
ENDDO INTFHIC1.250
ENDDO INTFHIC1.251
INTFHIC1.252
CALL EQTOLL(PHI_INN,LAMBDA_INN,PHI_INN,LAMBDA_ROT, INTFHIC1.253
+ A_REALHD(5),A_REALHD(6),U_FIELDDA) APB4F401.500
INTFHIC1.255
CALL W_COEFF(COEFF3,COEFF4,LAMBDA_ROT,LAMBDA_INN, INTFHIC1.256
+ A_REALHD(5),A_REALHD(6),U_FIELDDA) APB4F401.501
*ENDIF ARB2F403.108
INTFHIC1.258
ENDIF INTFHIC1.259
INTFHIC1.260
C-------------------------------------------------------------------- INTFHIC1.261
INTFHIC1.262
C Source grid P-points latitude and longitude INTFHIC1.263
DO I=1,P_ROWSDA APB4F401.502
AP_PHI_SRCE(I)=A_REALHD(3)-A_REALHD(2)*(I-1) INTFHIC1.265
ENDDO INTFHIC1.266
DO I=1,ROW_LENGTHDA APB4F401.503
AP_LAMBDA_SRCE(I)=A_REALHD(4)+A_REALHD(1)*(I-1) INTFHIC1.268
ENDDO INTFHIC1.269
INTFHIC1.270
IF (ROT_IN) THEN INTFHIC1.271
DO I=1,ROW_LENGTHDA APB4F401.504
IF (AP_LAMBDA_SRCE(I).GT.180.) THEN INTFHIC1.273
AP_LAMBDA_SRCE(I) = AP_LAMBDA_SRCE(I)-360. INTFHIC1.274
ENDIF INTFHIC1.275
ENDDO INTFHIC1.276
ENDIF INTFHIC1.277
INTFHIC1.278
CL Interpolation constants for P_grid interpolation INTFHIC1.279
INTFHIC1.280
CALL H_INT_CO(AP_INDEX_B_L(IP_P), AP_INDEX_B_R(IP_P), INTFHIC1.281
& AP_WEIGHT_T_R(IP_P),AP_WEIGHT_B_R(IP_P), INTFHIC1.282
& AP_WEIGHT_T_L(IP_P),AP_WEIGHT_B_L(IP_P), INTFHIC1.283
& AP_LAMBDA_SRCE,AP_PHI_SRCE,AP_LAMBDA_TARG, INTFHIC1.284
& AP_PHI_TARG,ROW_LENGTHDA,P_ROWSDA, APB4F401.505
& LEN_INTF_P,CYCLIC) INTFHIC1.286
INTFHIC1.287
C Source grid U-points latitude and longitude INTFHIC1.288
INTFHIC1.289
DO I=1,U_ROWSDA APB4F401.506
AU_PHI_SRCE(I)=A_REALHD(3)-A_REALHD(2)*(I-1+0.5) INTFHIC1.291
ENDDO INTFHIC1.292
DO I=1,ROW_LENGTHDA APB4F401.507
AU_LAMBDA_SRCE(I)=A_REALHD(4)+A_REALHD(1)*(I-1+0.5) INTFHIC1.294
ENDDO INTFHIC1.295
INTFHIC1.296
IF (ROT_IN) THEN INTFHIC1.297
DO I=1,ROW_LENGTHDA APB4F401.508
IF (AU_LAMBDA_SRCE(I).GT.180.) THEN INTFHIC1.299
AU_LAMBDA_SRCE(I) = AU_LAMBDA_SRCE(I)-360. INTFHIC1.300
ENDIF INTFHIC1.301
ENDDO INTFHIC1.302
ENDIF INTFHIC1.303
INTFHIC1.304
CL Interpolation constants for U_grid interpolation INTFHIC1.305
INTFHIC1.306
CALL H_INT_CO(AU_INDEX_B_L(IP_U), AU_INDEX_B_R(IP_U), INTFHIC1.307
& AU_WEIGHT_T_R(IP_U),AU_WEIGHT_B_R(IP_U), INTFHIC1.308
& AU_WEIGHT_T_L(IP_U),AU_WEIGHT_B_L(IP_U), INTFHIC1.309
& AU_LAMBDA_SRCE,AU_PHI_SRCE,AU_LAMBDA_TARG, INTFHIC1.310
& AU_PHI_TARG,ROW_LENGTHDA,U_ROWSDA, APB4F401.509
& LEN_INTF_U,CYCLIC) INTFHIC1.312
INTFHIC1.313
END IF ! LLBOUTA GSS1F304.18
*ENDIF GSS1F304.19
INTFHIC1.315
*IF DEF,OCEAN INTFHIC1.316
INTFHIC1.317
C Ocean code not yet available INTFHIC1.318
INTFHIC1.319
*ENDIF INTFHIC1.320
INTFHIC1.321
CL 4 End of routine INTFHIC1.322
INTFHIC1.323
RETURN INTFHIC1.324
END INTFHIC1.325
INTFHIC1.326
*----------------------------------------------------------------------- INTFHIC1.327
INTFHIC1.328
INTFHIC1.329
*ENDIF INTFHIC1.330