SUBROUTINE AUX_FILE(NFTAUX,NFTOUT,LEN_FIXHD_OUT, 4,32UDG7F400.4
& LEN_INTHD_AUX,LEN_REALHD_AUX, UDG7F400.5
& LEN1_LEVDEPC_AUX,LEN2_LEVDEPC_AUX, UDG7F400.6
& LEN1_LOOKUP_OUT,LEN2_LOOKUP_AUX, UDG7F400.7
& LEN_DATA_AUX,FIXHD_OUT,INTHD_OUT, UDG7F400.8
& LEVDEPC_OUT,P_LEVELS_OUT,LEN1_LEVDEPC_OUT, UDG7F400.9
& N_TYPES_OUT,P_FIELD_OUT,LOOKUP_OUT, UDG7F400.10
& PP_POS_OUT,PP_ITEMC_OUT,ITEM_CODE, UDG7F400.11
& ROW_LENGTH_IN,P_ROWS_IN, UDG0F404.28
& ROW_LENGTH_OUT,P_ROWS_OUT,LPOLARCHK, UDG0F404.29
*CALL ARGPPX 
UDG7F400.12
& UP_ITEM_CODE,L_USER_PROG) UDG7F400.13
AUX_FIL1.28
IMPLICIT NONE AUX_FIL1.29
AUX_FIL1.30
INTEGER AUX_FIL1.31
& NFTAUX !IN Unit no of auxillary file AUX_FIL1.32
&,NFTOUT !IN Unit no of model output file AUX_FIL1.33
&,LEN_FIXHD_OUT !IN Length of fixed length header AUX_FIL1.34
&,LEN_INTHD_AUX !IN Length of auxillary integer header AUX_FIL1.35
&,LEN_REALHD_AUX !IN Length of auxillary real header AUX_FIL1.36
&,LEN1_LEVDEPC_OUT !IN 1st dim of output level dep consts AUX_FIL1.37
&,LEN1_LEVDEPC_AUX !IN 1st dim of auxillary level dep consts AUX_FIL1.38
&,LEN2_LEVDEPC_AUX !IN 2nd dim of auxillary level dep consts AUX_FIL1.39
&,LEN1_LOOKUP_OUT !IN 1st dim of output (& aux) lookup table AUX_FIL1.40
&,LEN2_LOOKUP_AUX !IN 2nd dim of auxillary loolup table AUX_FIL1.41
&,LEN_DATA_AUX !IN Length of auxillary data AUX_FIL1.42
&,P_LEVELS_OUT !IN No of model levels AUX_FIL1.43
&,N_TYPES_OUT !IN No of different item codes in out file AUX_FIL1.44
&,P_FIELD_OUT !IN Length of output field AUX_FIL1.45
&,ITEM_CODE !IN Item code of data required from aux file AUX_FIL1.46
! All data required if ITEM_CODE < 0 AUX_FIL1.47
! Transplant if ITEM_CODE=0 AD221292.129
&,ROW_LENGTH_IN !IN No of points E-W (input) UDG0F404.30
&,ROW_LENGTH_OUT !IN No of points E-W (output) UDG0F404.31
&,P_ROWS_IN !IN No of P-points N-S (input) UDG0F404.32
&,P_ROWS_OUT !IN No of P-points N-S (output) UDG0F404.33
&,UP_ITEM_CODE !IN Item code of user prognostic field UDG0F404.34
AUX_FIL1.48
INTEGER AUX_FIL1.49
& INTHD_OUT(*) !IN Integer header - model output file AUX_FIL1.50
&,FIXHD_OUT(*) !IN Fixed length header - model output file AUX_FIL1.51
&,LOOKUP_OUT(*) !IN Lookup - model output file AUX_FIL1.52
&,PP_POS_OUT(*) !IN Pointer to pos of each group of fields AUX_FIL1.53
&,PP_ITEMC_OUT(*) !IN Item codes on outtput file AUX_FIL1.54
AUX_FIL1.55
REAL AUX_FIL1.56
& LEVDEPC_OUT(*) !IN Level dep consts - model output file AUX_FIL1.57
AUX_FIL1.58
LOGICAL UDG4F304.206
& L_USER_PROG !IN Data time not necesarily the same for user UDG4F304.207
C prognostic ancillary files, also consistancy UDG4F304.208
C is needed at all levels. UDG4F304.209
&,LPOLARCHK !IN True if polar rows to be averaged UDG0F404.35
! after horizontal interpolation UDG0F404.36
AUX_FIL1.59
C Local arrays:--------------------------------------------------------- AUX_FIL1.60
INTEGER AUX_FIL1.61
& INTHD_AUX(LEN_INTHD_AUX) !Aux integer header AUX_FIL1.62
&,FIXHD_AUX(LEN_FIXHD_OUT) !Aux fixed length header AUX_FIL1.63
&,LOOKUP_AUX(LEN1_LOOKUP_OUT,LEN2_LOOKUP_AUX) !Aux lookup AUX_FIL1.64
&,PP_LEN_AUX(LEN2_LOOKUP_AUX) !Length ^ AUX_FIL1.65
&,PP_NUM_AUX(LEN2_LOOKUP_AUX) !No of fields^ For each AUX_FIL1.66
&,PP_POS_AUX(LEN2_LOOKUP_AUX) !Position ^ field type AUX_FIL1.67
&,PP_TYPE_AUX(LEN2_LOOKUP_AUX) !Real,int,log^ on AUX file AUX_FIL1.68
&,PP_ITEMC_AUX(LEN2_LOOKUP_AUX) !Item code ^ AUX_FIL1.69
&,PP_LS_AUX(LEN2_LOOKUP_AUX) !Land or sea AUX_FIL1.70
AUX_FIL1.71
REAL AUX_FIL1.72
& D1_IN(P_FIELD_OUT) !Data array (used in transplant) AD221292.130
&,D1_OUT(P_FIELD_OUT) !Data array AD221292.131
&,REALHD_AUX(LEN_REALHD_AUX) !Aux real header AUX_FIL1.74
&,LEVDEPC_AUX(LEN1_LEVDEPC_AUX*LEN2_LEVDEPC_AUX) ! Aux level dep co AUX_FIL1.75
AUX_FIL1.76
*CALL C_MDI AD221292.132
*CALL CSUBMODL UDG7F400.14
*CALL CPPXREF UDG7F400.15
*CALL PPXLOOK UDG7F400.17
C External subroutines called:------------------------------------------ AUX_FIL1.77
EXTERNAL SETPOS,READHEAD,ABORT_IO,ABORT,LOCATE,READFLDS AUX_FIL1.78
&,WRITFLDS,F_TYPE AUX_FIL1.79
*IF DEF,TIMER AUX_FIL1.80
&,TIMER AUX_FIL1.81
*ENDIF AUX_FIL1.82
C*---------------------------------------------------------------------- AUX_FIL1.83
C*L Local variables:--------------------------------------------------- AUX_FIL1.84
AUX_FIL1.85
REAL RP_ROW_SUM ! Sum of polar row values UDG0F404.37
INTEGER AUX_FIL1.86
& START_BLOCK AUX_FIL1.87
&,ICODE !Return code; successful=0; error >0 AUX_FIL1.88
&,DUMMY AUX_FIL1.89
&,POS_AUX,POS_OUT AUX_FIL1.90
&,K,IJ,J,I !Indices AUX_FIL1.91
&,M,N,NN !Indices AD221292.133
&,N_TYPES_AUX AUX_FIL1.92
&,N_FIELDS_AUX AUX_FIL1.93
AUX_FIL1.94
CHARACTER*80 F_TYPE_TITLE UDG7F400.18
CHARACTER*100 AUX_FIL1.95
& CMESSAGE !Error message if ICODE > 0 AUX_FIL1.96
AUX_FIL1.97
INTEGER AD221292.134
& ITEMC !Item code ^ AD221292.135
&,LEV1,LEV2 !Level range ^ Transplant data AD221292.136
&,COL1,COL2 !Column range ^ AD221292.137
&,ROW1,ROW2 !Row range ^ AD221292.138
UDG4F304.210
LOGICAL UDG4F304.211
& LFOUND ! TRUE if requested user prognostic found in UDG4F304.212
C ancillary file. UDG4F304.213
AUX_FIL1.98
NAMELIST /TRANSP/ ITEMC,LEV1,LEV2,COL1,COL2,ROW1,ROW2 AD221292.139
AUX_FIL1.99
DUMMY=0 AD221292.140
AD221292.141
LFOUND=.FALSE. UDG4F304.214
IF(.NOT.L_USER_PROG)THEN UDG4F304.215
WRITE(6,'(//,'' READING IN AUX FIELDS'')') AUX_FIL1.100
WRITE(6,'( '' ----------------------'')') AUX_FIL1.101
ENDIF UDG4F304.216
AUX_FIL1.102
CALL SETPOS(NFTAUX,0,ICODE) GTD0F400.42
AUX_FIL1.104
CALL READHEAD(NFTAUX,FIXHD_AUX,LEN_FIXHD_OUT, AUX_FIL1.105
& INTHD_AUX,LEN_INTHD_AUX, AUX_FIL1.106
& REALHD_AUX,LEN_REALHD_AUX, AUX_FIL1.107
& LEVDEPC_AUX,LEN1_LEVDEPC_AUX,LEN2_LEVDEPC_AUX, AUX_FIL1.108
& DUMMY,DUMMY,DUMMY, AUX_FIL1.109
& DUMMY,DUMMY,DUMMY, AUX_FIL1.110
& DUMMY,DUMMY,DUMMY, AUX_FIL1.111
& DUMMY,DUMMY, AUX_FIL1.112
& DUMMY,DUMMY, AUX_FIL1.113
& DUMMY,DUMMY, AUX_FIL1.114
& DUMMY,DUMMY, AUX_FIL1.115
& DUMMY,DUMMY, AUX_FIL1.116
& LOOKUP_AUX,LEN1_LOOKUP_OUT,LEN2_LOOKUP_AUX, AUX_FIL1.117
& LEN_DATA_AUX, AUX_FIL1.118
*CALL ARGPPX GDG0F401.54
& START_BLOCK,ICODE,CMESSAGE) AUX_FIL1.119
AUX_FIL1.120
IF(ICODE.NE.0)CALL ABORT_IO('AUXFILE',CMESSAGE,ICODE,NFTAUX) AUX_FIL1.121
AUX_FIL1.122
C Check data time of AUX file is same as output file AUX_FIL1.123
AUX_FIL1.124
IF(ITEM_CODE.NE.0.AND..NOT.L_USER_PROG)THEN UDG4F304.217
DO K=1,6 AUX_FIL1.125
IF(FIXHD_AUX(K+20).NE.FIXHD_OUT(K+27))THEN AUX_FIL1.126
WRITE(6,'('' *ERROR* Data time of AUX data does not match'', AUX_FIL1.127
* '' verification time of dump'',/,'' AUX'',6I6,/'' Dump'',6I6)') AUX_FIL1.128
* (FIXHD_AUX(I),I=21,26),(FIXHD_OUT(I),I=28,33) AUX_FIL1.129
CALL ABORT AUX_FIL1.130
ENDIF AUX_FIL1.131
ENDDO AUX_FIL1.132
ENDIF AD221292.143
AUX_FIL1.133
C Check resolution of AUX file is same as output resolution AUX_FIL1.134
AUX_FIL1.135
IF(INTHD_AUX(6).NE.INTHD_OUT(6).OR. AUX_FIL1.136
*INTHD_AUX(7).NE.INTHD_OUT(7))THEN AUX_FIL1.137
! Prevent code from exiting if comparison of dimensions of 10m UIE2F404.52
! u, v component of wind in the INTEGER header of AUX file and UIE2F404.53
! output dump shows that the ancilliary data has one less row. UIE2F404.54
IF(INTHD_AUX(6).EQ.INTHD_OUT(6).AND. UIE2F404.55
*INTHD_AUX(7)+1.EQ.INTHD_OUT(7))THEN UIE2F404.56
UIE2F404.57
WRITE(6,'('' *Warning* Assuming u or v component of wind as '', UIE2F404.58
* '' Dimensions of AUX file and output dump'', UIE2F404.59
* '' do not match, INTHD(7)='',2I5)') UIE2F404.60
* INTHD_AUX(7),INTHD_OUT(7) UIE2F404.61
UIE2F404.62
ELSE UIE2F404.63
WRITE(6,'('' *ERROR* Dimensions of AUX file and output dump'', AUX_FIL1.138
* '' do not match, INTHD(6)='',2I5,'' INTHD(7)='',2I5)') AUX_FIL1.139
* INTHD_AUX(6),INTHD_OUT(6) AUX_FIL1.140
* ,INTHD_AUX(7),INTHD_OUT(7) AUX_FIL1.141
CALL ABORT AUX_FIL1.142
ENDIF UIE2F404.64
ENDIF AUX_FIL1.143
AUX_FIL1.144
C Check levels of AUX file are same as top levels in output file AUX_FIL1.145
AUX_FIL1.146
IF(LEN1_LEVDEPC_AUX.LE.0)THEN UDG4F304.218
J=LEN1_LEVDEPC_AUX+1 AUX_FIL1.147
DO K=P_LEVELS_OUT,P_LEVELS_OUT-LEN1_LEVDEPC_AUX+1,-1 AUX_FIL1.148
J=J-1 AUX_FIL1.149
IF(LEVDEPC_AUX(J).LT.LEVDEPC_OUT(K)-0.001*LEVDEPC_OUT(K) AUX_FIL1.150
* .OR.LEVDEPC_AUX(J).GT.LEVDEPC_OUT(K)+0.001*LEVDEPC_OUT(K))THEN AUX_FIL1.151
WRITE(6,'('' LEVEL'',I5)')K AUX_FIL1.152
WRITE(6,'('' AUX AKS'',5E12.5)') AUX_FIL1.153
* (LEVDEPC_AUX(I),I=1,LEN1_LEVDEPC_AUX) AUX_FIL1.154
WRITE(6,'('' OUT AKS'',5E12.5)') AUX_FIL1.155
* (LEVDEPC_OUT(I),I=1,LEN1_LEVDEPC_OUT) AUX_FIL1.156
CALL ABORT AUX_FIL1.157
ENDIF AUX_FIL1.158
ENDDO AUX_FIL1.159
AUX_FIL1.160
IJ=2*LEN1_LEVDEPC_AUX+1 AUX_FIL1.161
DO K=P_LEVELS_OUT,P_LEVELS_OUT-LEN1_LEVDEPC_AUX+1,-1 AUX_FIL1.162
J=K+LEN1_LEVDEPC_OUT AUX_FIL1.163
IJ=IJ-1 AUX_FIL1.164
IF(ABS(LEVDEPC_AUX(IJ)-LEVDEPC_OUT(J)).GT.0.0001 AUX_FIL1.165
* .OR.ABS(LEVDEPC_AUX(IJ)-LEVDEPC_OUT(J)).GT.0.0001) AUX_FIL1.166
* THEN AUX_FIL1.167
WRITE(6,'('' LEVEL'',I5)')K AUX_FIL1.168
WRITE(6,'('' AUX BKS'',5E12.5)') AUX_FIL1.169
* (LEVDEPC_AUX(I+LEN1_LEVDEPC_AUX),I=1,LEN1_LEVDEPC_AUX) AUX_FIL1.170
WRITE(6,'('' OUT BKS'',5E12.5)') AUX_FIL1.171
* (LEVDEPC_OUT(I+LEN1_LEVDEPC_OUT),I=1,LEN1_LEVDEPC_OUT) AUX_FIL1.172
CALL ABORT AUX_FIL1.173
ENDIF AUX_FIL1.174
ENDDO AUX_FIL1.175
AUX_FIL1.176
ENDIF UDG4F304.219
F_TYPE_TITLE='AUX data' UDG7F400.19
CALL F_TYPE(LOOKUP_AUX,LEN2_LOOKUP_AUX,PP_NUM_AUX, UDG7F400.20
& N_TYPES_AUX,PP_LEN_AUX,PP_ITEMC_AUX,PP_TYPE_AUX, UDG7F400.21
& PP_POS_AUX,PP_LS_AUX,FIXHD_AUX, UDG7F400.22
*CALL ARGPPX UDG7F400.23
& F_TYPE_TITLE) UDG7F400.24
AUX_FIL1.180
CL Transplant of fields controlled by namelist TRANS AD221292.144
AD221292.145
IF(ITEM_CODE.EQ.0)THEN AD221292.146
REWIND(5) CW300493.1
AD221292.147
DO J=1,10000 AD221292.148
AD221292.149
READ(5,TRANSP,ERR=100,END=100) UDG0F404.38
WRITE(6,TRANSP) AD221292.151
IF(LEV1.EQ.0.OR.LEV2.EQ.0.OR.ROW1.EQ.0.OR.ROW2.EQ.0.OR. UDG0F404.39
& COL1.EQ.0.OR.COL2.EQ.0)THEN UDG0F404.40
WRITE(6,*) 'ERROR : Reconfiguration CONTROL' UDG0F404.41
WRITE(6,*) 'Namelist TRANSP has entries set to zero' UDG0F404.42
WRITE(6,*) 'LEV1 = ',LEV1,' LEV2 = ',LEV2 UDG0F404.43
WRITE(6,*) 'ROW1 = ',ROW1,' ROW2 = ',ROW2 UDG0F404.44
WRITE(6,*) 'COL1 = ',COL1,' COL2 = ',COL2 UDG0F404.45
WRITE(6,*) 'Please correct transplant data panel in the ', UDG0F404.46
& 'UMUI and reprocess' UDG0F404.47
CALL ABORT UDG0F404.48
END IF UDG0F404.49
AD221292.152
CALL LOCATE(ITEMC,PP_ITEMC_AUX,N_TYPES_AUX,POS_AUX) AD221292.153
CALL LOCATE(ITEMC,PP_ITEMC_OUT,N_TYPES_OUT,POS_OUT) AD221292.154
AD221292.155
DO I=LEV1,LEV2 AD221292.156
AD221292.157
*IF DEF,TIMER AD221292.158
CALL TIMER('READFLDS',3) AD221292.159
*ENDIF AD221292.160
AD221292.161
CALL READFLDS(NFTAUX,1,PP_POS_AUX(POS_AUX)+I-1,LOOKUP_AUX, GDG0F401.55
& LEN1_LOOKUP_OUT,D1_IN ,P_FIELD_OUT,FIXHD_AUX, GDG0F401.56
*CALL ARGPPX GDG0F401.57
& ICODE,CMESSAGE) GDG0F401.58
IF(ICODE.EQ.1501)THEN UDG0F404.75
IF(LPOLARCHK)THEN UDG0F404.76
write(6,*) 'Averaging polar rows to make them constant' UDG0F404.77
! North polar row UDG0F404.78
RP_ROW_SUM=0.0 UDG0F404.79
DO K=1,ROW_LENGTH_IN UDG0F404.80
RP_ROW_SUM=RP_ROW_SUM+D1_IN(K) UDG0F404.81
END DO UDG0F404.82
DO K=1,ROW_LENGTH_IN UDG0F404.83
D1_IN(K)=RP_ROW_SUM/ROW_LENGTH_IN UDG0F404.84
END DO UDG0F404.85
! South polar row UDG0F404.86
RP_ROW_SUM=0.0 UDG0F404.87
DO K=1,ROW_LENGTH_IN UDG0F404.88
RP_ROW_SUM= UDG0F404.89
& RP_ROW_SUM+D1_IN((P_ROWS_IN-1)*ROW_LENGTH_IN+K) UDG0F404.90
END DO UDG0F404.91
DO K=1,ROW_LENGTH_OUT UDG0F404.92
D1_IN((P_ROWS_IN)*ROW_LENGTH_IN+K)= UDG0F404.93
& RP_ROW_SUM/ROW_LENGTH_IN UDG0F404.94
END DO UDG0F404.95
END IF UDG0F404.96
ELSE IF(ICODE.NE.0)THEN UDG0F404.97
CALL ABORT_IO('AUXFILE',CMESSAGE,ICODE,NFTAUX) UDG0F404.98
END IF UDG0F404.99
AD221292.166
CALL READFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT)+I-1,LOOKUP_OUT, UDG1F405.1533
& LEN1_LOOKUP_OUT,D1_OUT ,P_FIELD_OUT,FIXHD_OUT, GDG0F401.60
*CALL ARGPPX GDG0F401.61
& ICODE,CMESSAGE) GDG0F401.62
IF(ICODE.EQ.1501)THEN UDG0F404.100
IF(LPOLARCHK)THEN UDG0F404.101
write(6,*) 'Averaging polar rows to make them constant' UDG0F404.102
! North polar row UDG0F404.103
RP_ROW_SUM=0.0 UDG0F404.104
DO K=1,ROW_LENGTH_OUT UDG0F404.105
RP_ROW_SUM=RP_ROW_SUM+D1_OUT(K) UDG0F404.106
END DO UDG0F404.107
DO K=1,ROW_LENGTH_OUT UDG0F404.108
D1_OUT(K)=RP_ROW_SUM/ROW_LENGTH_OUT UDG0F404.109
END DO UDG0F404.110
! South polar row UDG0F404.111
RP_ROW_SUM=0.0 UDG0F404.112
DO K=1,ROW_LENGTH_OUT UDG0F404.113
RP_ROW_SUM= UDG0F404.114
& RP_ROW_SUM+D1_OUT((P_ROWS_OUT-1)*ROW_LENGTH_OUT+K) UDG0F404.115
END DO UDG0F404.116
DO K=1,ROW_LENGTH_OUT UDG0F404.117
D1_OUT((P_ROWS_OUT-1)*ROW_LENGTH_OUT+K)= UDG0F404.118
& RP_ROW_SUM/ROW_LENGTH_OUT UDG0F404.119
END DO UDG0F404.120
END IF UDG0F404.121
ELSE IF(ICODE.NE.0)THEN UDG0F404.122
CALL ABORT_IO('AUXFILE',CMESSAGE,ICODE,NFTOUT) UDG0F404.123
END IF UDG0F404.124
AD221292.171
*IF DEF,TIMER AD221292.172
CALL TIMER('READFLDS',4) AD221292.173
*ENDIF AD221292.174
AD221292.175
DO M=ROW1,ROW2 AD221292.176
DO N=COL1,COL2 AD221292.177
NN=(M-1)*INTHD_OUT(6)+N AD221292.178
D1_OUT(NN)=D1_IN(NN) AD221292.179
ENDDO AD221292.180
ENDDO AD221292.181
AD221292.182
*IF DEF,TIMER AD221292.183
CALL TIMER('WRITFLDS',3) AD221292.184
*ENDIF AD221292.185
AD221292.186
CALL WRITFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT)+I-1,LOOKUP_OUT, GDG0F401.63
& LEN1_LOOKUP_OUT,D1_OUT,P_FIELD_OUT,FIXHD_OUT, GDG0F401.64
*CALL ARGPPX GDG0F401.65
& ICODE,CMESSAGE) GDG0F401.66
IF(ICODE.NE.0)CALL ABORT_IO('AUX_FILE',CMESSAGE,ICODE,NFTOUT) AD221292.190
AD221292.191
*IF DEF,TIMER AD221292.192
CALL TIMER('WRITFLDS',4) AD221292.193
*ENDIF AD221292.194
ENDDO AD221292.195
AD221292.196
ENDDO AD221292.197
AD221292.198
ELSE AD221292.199
AD221292.200
DO J=1,N_TYPES_AUX AUX_FIL1.181
AUX_FIL1.182
IF(PP_ITEMC_AUX(J).EQ.ITEM_CODE.OR.ITEM_CODE.LT.0)THEN AUX_FIL1.183
AUX_FIL1.184
CALL LOCATE(PP_ITEMC_AUX(J),PP_ITEMC_AUX,N_TYPES_AUX,POS_AUX) AUX_FIL1.185
IF(L_USER_PROG)THEN UDG4F304.220
CALL LOCATE(UP_ITEM_CODE,PP_ITEMC_OUT,N_TYPES_OUT,POS_OUT) UDG4F304.221
LFOUND=.TRUE. UDG4F304.222
ELSE UDG4F304.223
CALL LOCATE(PP_ITEMC_AUX(J),PP_ITEMC_OUT,N_TYPES_OUT,POS_OUT) UDG4F304.224
ENDIF UDG4F304.225
N_FIELDS_AUX=PP_NUM_AUX(POS_AUX) AUX_FIL1.187
AUX_FIL1.188
DO I=1,N_FIELDS_AUX AUX_FIL1.189
AUX_FIL1.190
*IF DEF,TIMER AUX_FIL1.191
CALL TIMER('READFLDS',3) AUX_FIL1.192
*ENDIF AUX_FIL1.193
AUX_FIL1.194
CALL READFLDS(NFTAUX,1,PP_POS_AUX(POS_AUX)+I-1,LOOKUP_AUX, GDG0F401.67
& LEN1_LOOKUP_OUT,D1_OUT,P_FIELD_OUT,FIXHD_AUX, GDG0F401.68
*CALL ARGPPX GDG0F401.69
& ICODE,CMESSAGE) GDG0F401.70
IF(ICODE.EQ.1501)THEN UDG0F404.50
IF(LPOLARCHK)THEN UDG0F404.51
write(6,*) 'Averaging polar rows to make them constant' UDG0F404.52
! North polar row UDG0F404.53
RP_ROW_SUM=0.0 UDG0F404.54
DO K=1,ROW_LENGTH_OUT UDG0F404.55
RP_ROW_SUM=RP_ROW_SUM+D1_OUT(K) UDG0F404.56
END DO UDG0F404.57
DO K=1,ROW_LENGTH_OUT UDG0F404.58
D1_OUT(K)=RP_ROW_SUM/ROW_LENGTH_OUT UDG0F404.59
END DO UDG0F404.60
! South polar row UDG0F404.61
RP_ROW_SUM=0.0 UDG0F404.62
DO K=1,ROW_LENGTH_OUT UDG0F404.63
RP_ROW_SUM= UDG0F404.64
& RP_ROW_SUM+D1_OUT((P_ROWS_OUT-1)*ROW_LENGTH_OUT+K) UDG0F404.65
END DO UDG0F404.66
DO K=1,ROW_LENGTH_OUT UDG0F404.67
D1_OUT((P_ROWS_OUT-1)*ROW_LENGTH_OUT+K)= UDG0F404.68
& RP_ROW_SUM/ROW_LENGTH_OUT UDG0F404.69
END DO UDG0F404.70
END IF UDG0F404.71
ELSE IF(ICODE.NE.0)THEN UDG0F404.72
CALL ABORT_IO('AUXFILE',CMESSAGE,ICODE,NFTAUX) UDG0F404.73
END IF UDG0F404.74
AUX_FIL1.199
*IF DEF,TIMER AUX_FIL1.200
CALL TIMER('READFLDS',4) AUX_FIL1.201
*ENDIF AUX_FIL1.202
AUX_FIL1.203
*IF DEF,TIMER AUX_FIL1.204
CALL TIMER('WRITFLDS',3) AUX_FIL1.205
*ENDIF AUX_FIL1.206
AUX_FIL1.207
IF(L_USER_PROG)THEN UDG4F304.226
IF(LEN1_LEVDEPC_AUX.LE.0)THEN UDG4F304.227
C Single level user prognostic field UDG4F304.228
CALL WRITFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT),LOOKUP_OUT, GDG0F401.71
& LEN1_LOOKUP_OUT,D1_OUT,P_FIELD_OUT,FIXHD_OUT, GDG0F401.72
*CALL ARGPPX GDG0F401.73
& ICODE,CMESSAGE) GDG0F401.74
IF(ICODE.NE.0)CALL ABORT_IO('AUX_FILE',CMESSAGE,ICODE,NFTAUX) UDG4F304.231
ELSE UDG4F304.232
C Multi level user prognostic field UDG4F304.233
CALL WRITFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT)+I-1,LOOKUP_OUT, GDG0F401.75
& LEN1_LOOKUP_OUT,D1_OUT,P_FIELD_OUT,FIXHD_OUT, GDG0F401.76
*CALL ARGPPX GDG0F401.77
& ICODE,CMESSAGE) GDG0F401.78
IF(ICODE.NE.0)CALL ABORT_IO('AUX_FILE',CMESSAGE,ICODE,NFTAUX) UDG4F304.236
ENDIF UDG4F304.237
ELSE UDG4F304.238
C Tracer or UARS auxillary file output top N_FIELDS_AUX only. UDG4F304.239
CALL WRITFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT)+P_LEVELS_OUT+I-1 GDG0F401.79
& -N_FIELDS_AUX,LOOKUP_OUT,LEN1_LOOKUP_OUT, GDG0F401.80
& D1_OUT,P_FIELD_OUT,FIXHD_OUT, GDG0F401.81
*CALL ARGPPX GDG0F401.82
& ICODE,CMESSAGE) GDG0F401.83
ENDIF UDG4F304.241
IF(ICODE.NE.0)CALL ABORT_IO('AUX_FILE',CMESSAGE,ICODE,NFTOUT) AUX_FIL1.211
AUX_FIL1.212
*IF DEF,TIMER AUX_FIL1.213
CALL TIMER('WRITFLDS',4) AUX_FIL1.214
*ENDIF AUX_FIL1.215
ENDDO AUX_FIL1.216
AUX_FIL1.217
ENDIF AUX_FIL1.218
AUX_FIL1.219
ENDDO AUX_FIL1.220
AUX_FIL1.221
ENDIF AD221292.201
AD221292.202
100 CONTINUE AD221292.203
IF(.NOT.LFOUND.AND.L_USER_PROG)THEN UDG4F304.242
WRITE(6, UDG4F304.243
&'('' Requested user prognostic not found in ancillary file'')') UDG4F304.244
WRITE(6,'(''Item code = '',I3)') ITEM_CODE UDG4F304.245
CALL ABORT UDG4F304.246
ENDIF UDG4F304.247
AUX_FIL1.222
RETURN AUX_FIL1.223
END AUX_FIL1.224
*ENDIF UDG4F304.248