SUBROUTINE PERTURB( 1,36UDG7F400.320
*CALL ARGPPX 
UDG7F400.321
& NFTPER,NFTOUT, UDG7F400.322
& LEN_FIXHD_OUT,LEN_INTHD_PER,LEN_REALHD_PER, UDG7F400.323
& LEN1_LEVDEPC_PER,LEN2_LEVDEPC_PER, UDG7F400.324
& LEN1_LOOKUP_OUT,LEN2_LOOKUP_PER,LEN_DATA_PER, UDG7F400.325
& FIXHD_OUT,INTHD_OUT,LEVDEPC_OUT,P_LEVELS_OUT, UDG7F400.326
& LEN1_LEVDEPC_OUT,N_TYPES_OUT,P_FIELD_OUT, UDG7F400.327
& LOOKUP_OUT,PP_POS_OUT,PP_ITEMC_OUT, UDG7F400.328
& PERTURBATION,P_ROWS_OUT,ROW_LENGTH_OUT, UDG3F405.347
& LPOLARCHK) UDG3F405.348
PERTURB1.37
IMPLICIT NONE PERTURB1.38
PERTURB1.39
INTEGER PERTURB1.40
& NFTPER !IN Unit no of perturbation file PERTURB1.41
&,NFTOUT !IN Unit no of model output file PERTURB1.42
&,LEN_FIXHD_OUT !IN Length of fixed length header PERTURB1.43
&,LEN_INTHD_PER !IN Length of perturbation integer header PERTURB1.44
&,LEN_REALHD_PER !IN Length of perturbation real header PERTURB1.45
&,LEN1_LEVDEPC_OUT !IN 1st dim of output level dep consts PERTURB1.46
&,LEN1_LEVDEPC_PER !IN 1st dim of perturbation level dep consts PERTURB1.47
&,LEN2_LEVDEPC_PER !IN 2nd dim of perturbation level dep consts PERTURB1.48
&,LEN1_LOOKUP_OUT !IN 1st dim of output (& PER) lookup table PERTURB1.49
&,LEN2_LOOKUP_PER !IN 2nd dim of perturbation lookup table PERTURB1.50
&,LEN_DATA_PER !IN Length of perturbation data PERTURB1.51
&,P_LEVELS_OUT !IN No of model levels PERTURB1.52
&,N_TYPES_OUT !IN No of different item codes in out file PERTURB1.53
&,P_FIELD_OUT !IN Length of output field PERTURB1.54
PERTURB1.55
INTEGER PERTURB1.56
& INTHD_OUT(*) !IN Integer header - model output file PERTURB1.57
&,FIXHD_OUT(*) !IN Fixed length header - model output file PERTURB1.58
&,LOOKUP_OUT(*) !IN Lookup - model output file PERTURB1.59
&,PP_POS_OUT(*) !IN Pointer to pos of each group of fields PERTURB1.60
&,PP_ITEMC_OUT(*) !IN Item codes on output file UDG3F405.349
&,ROW_LENGTH_OUT !IN No of points E-W (output) UDG3F405.350
&,P_ROWS_OUT !IN No of P-points N-S (output) UDG3F405.351
PERTURB1.62
REAL PERTURB1.63
& LEVDEPC_OUT(*) !IN Level dep consts - model output file PERTURB1.64
&,PERTURBATION !IN +1 add incs; -1 sub incs PERTURB1.65
UDG3F405.352
LOGICAL LPOLARCHK ! True if polar rows to be averaged UDG3F405.353
! after horizontal interpolation UDG3F405.354
PERTURB1.66
C Local arrays:--------------------------------------------------------- PERTURB1.67
INTEGER PERTURB1.68
& INTHD_PER(LEN_INTHD_PER) !PER integer header PERTURB1.69
&,FIXHD_PER(LEN_FIXHD_OUT) !PER fixed length header PERTURB1.70
&,LOOKUP_PER(LEN1_LOOKUP_OUT,LEN2_LOOKUP_PER) !PER lookup PERTURB1.71
&,PP_LEN_PER(LEN2_LOOKUP_PER) !Length ^ PERTURB1.72
&,PP_NUM_PER(LEN2_LOOKUP_PER) !No of fields^ For each PERTURB1.73
&,PP_POS_PER(LEN2_LOOKUP_PER) !Position ^ field type PERTURB1.74
&,PP_TYPE_PER(LEN2_LOOKUP_PER) !Real,int,log^ on PER file PERTURB1.75
&,PP_ITEMC_PER(LEN2_LOOKUP_PER) !Item code ^ PERTURB1.76
&,PP_LS_PER(LEN2_LOOKUP_PER) !Land or sea PERTURB1.77
PERTURB1.78
REAL PERTURB1.79
& D1_IN(P_FIELD_OUT) !Data array PERTURB1.80
&,D1_OUT(P_FIELD_OUT) !Data array PERTURB1.81
&,PSTAR(P_FIELD_OUT) !Pstar PERTURB1.82
&,REALHD_PER(LEN_REALHD_PER) !PER real header PERTURB1.83
&,LEVDEPC_PER(LEN1_LEVDEPC_PER*LEN2_LEVDEPC_PER) ! PER level dep co PERTURB1.84
PERTURB1.85
C External subroutines called:------------------------------------------ PERTURB1.86
EXTERNAL SETPOS,READHEAD,ABORT_IO,ABORT,LOCATE,READFLDS PERTURB1.87
&,WRITFLDS,F_TYPE PERTURB1.88
*IF DEF,TIMER PERTURB1.89
&,TIMER PERTURB1.90
*ENDIF PERTURB1.91
C*---------------------------------------------------------------------- PERTURB1.92
C*L Local variables:--------------------------------------------------- PERTURB1.93
PERTURB1.94
INTEGER PERTURB1.95
& START_BLOCK PERTURB1.96
&,ICODE !Return code; successful=0; error >0 PERTURB1.97
&,DUMMY PERTURB1.98
&,POS_PER,POS_OUT PERTURB1.99
&,PR !Pressure temporary PERTURB1.100
&,K,J,I !Indices PERTURB1.101
&,M,N !Indices PERTURB1.102
&,N_TYPES_PER PERTURB1.103
&,N_FIELDS_PER PERTURB1.104
UDG3F405.355
REAL RP_ROW_SUM ! Sum of polar row values UDG3F405.356
PERTURB1.105
CHARACTER*80 F_TYPE_TITLE UDG7F400.330
CHARACTER*100 PERTURB1.106
& CMESSAGE !Error message if ICODE > 0 PERTURB1.107
PERTURB1.108
C---------------------------------------------------------------------- PERTURB1.109
! Comdecks:---------------------------------------------------------- UDG7F400.331
*CALL CSUBMODL UDG7F400.332
*CALL CPPXREF UDG7F400.334
UDG7F400.335
*CALL PPXLOOK UDG7F400.336
*CALL C_R_CP PERTURB1.110
*CALL C_LHEAT PERTURB1.111
C---------------------------------------------------------------------- PERTURB1.112
PERTURB1.113
DUMMY=0 PERTURB1.114
PERTURB1.115
WRITE(6,'(//,'' READING IN PERTURBATION FIELDS'')') PERTURB1.116
WRITE(6,'( '' ------------------------------'')') PERTURB1.117
PERTURB1.118
CALL SETPOS(NFTPER,0,ICODE) GTD0F400.113
PERTURB1.120
CALL READHEAD(NFTPER,FIXHD_PER,LEN_FIXHD_OUT, GDG0F401.996
& INTHD_PER,LEN_INTHD_PER, GDG0F401.997
& REALHD_PER,LEN_REALHD_PER, GDG0F401.998
& LEVDEPC_PER,LEN1_LEVDEPC_PER,LEN2_LEVDEPC_PER, GDG0F401.999
& DUMMY,DUMMY,DUMMY, GDG0F401.1000
& DUMMY,DUMMY,DUMMY, GDG0F401.1001
& DUMMY,DUMMY,DUMMY, GDG0F401.1002
& DUMMY,DUMMY, GDG0F401.1003
& DUMMY,DUMMY, GDG0F401.1004
& DUMMY,DUMMY, GDG0F401.1005
& DUMMY,DUMMY, GDG0F401.1006
& DUMMY,DUMMY, GDG0F401.1007
& LOOKUP_PER,LEN1_LOOKUP_OUT,LEN2_LOOKUP_PER, GDG0F401.1008
& LEN_DATA_PER, GDG0F401.1009
*CALL ARGPPX GDG0F401.1010
& START_BLOCK,ICODE,CMESSAGE) GDG0F401.1011
PERTURB1.136
IF(ICODE.NE.0)CALL ABORT_IO('PERFILE',CMESSAGE,ICODE,NFTPER) PERTURB1.137
PERTURB1.138
C Check data time of PER file is same as output file PERTURB1.139
PERTURB1.140
DO K=1,6 PERTURB1.141
IF(FIXHD_PER(K+20).NE.FIXHD_OUT(K+27))THEN PERTURB1.142
WRITE(6,'('' *ERROR* Data time of PER data does not match'', PERTURB1.143
* '' verification time of dump'',/,'' PER'',6I6,/'' Dump'',6I6)') PERTURB1.144
* (FIXHD_PER(I),I=21,26),(FIXHD_OUT(I),I=28,33) PERTURB1.145
CALL ABORT PERTURB1.146
ENDIF PERTURB1.147
ENDDO PERTURB1.148
PERTURB1.149
C Check resolution of PER file is same as output resolution PERTURB1.150
PERTURB1.151
IF(INTHD_PER(6).NE.INTHD_OUT(6).OR. PERTURB1.152
*INTHD_PER(7).NE.INTHD_OUT(7))THEN PERTURB1.153
WRITE(6,'('' *ERROR* Dimensions of PER file and output dump'', PERTURB1.154
* '' do not match, INTHD(6)='',2I5,'' INTHD(7)='',2I5)') PERTURB1.155
* INTHD_PER(6),INTHD_OUT(6) PERTURB1.156
* ,INTHD_PER(7),INTHD_OUT(7) PERTURB1.157
CALL ABORT PERTURB1.158
ENDIF PERTURB1.159
PERTURB1.160
C Check levels of PER file are same as levels in output file PERTURB1.161
PERTURB1.162
DO K=1,P_LEVELS_OUT PERTURB1.163
IF(LEVDEPC_PER(K).LT.LEVDEPC_OUT(K)-0.001*LEVDEPC_OUT(K) PERTURB1.164
* .OR.LEVDEPC_PER(K).GT.LEVDEPC_OUT(K)+0.001*LEVDEPC_OUT(K))THEN PERTURB1.165
WRITE(6,'('' LEVEL'',I5)')K PERTURB1.166
WRITE(6,'('' PER AKS'',5E12.5)') PERTURB1.167
* (LEVDEPC_PER(I),I=1,LEN1_LEVDEPC_PER) PERTURB1.168
WRITE(6,'('' OUT AKS'',5E12.5)') PERTURB1.169
* (LEVDEPC_OUT(I),I=1,LEN1_LEVDEPC_OUT) PERTURB1.170
CALL ABORT PERTURB1.171
ENDIF PERTURB1.172
ENDDO PERTURB1.173
PERTURB1.174
DO K=P_LEVELS_OUT+1,P_LEVELS_OUT*2 PERTURB1.175
IF(ABS(LEVDEPC_PER(K)-LEVDEPC_OUT(K)).GT.0.0001 PERTURB1.176
* .OR.ABS(LEVDEPC_PER(K)-LEVDEPC_OUT(K)).GT.0.0001) PERTURB1.177
* THEN PERTURB1.178
WRITE(6,'('' LEVEL'',I5)')K PERTURB1.179
WRITE(6,'('' PER BKS'',5E12.5)') PERTURB1.180
* (LEVDEPC_PER(I+LEN1_LEVDEPC_PER),I=1,LEN1_LEVDEPC_PER) PERTURB1.181
WRITE(6,'('' OUT BKS'',5E12.5)') PERTURB1.182
* (LEVDEPC_OUT(I+LEN1_LEVDEPC_OUT),I=1,LEN1_LEVDEPC_OUT) PERTURB1.183
CALL ABORT PERTURB1.184
ENDIF PERTURB1.185
ENDDO PERTURB1.186
PERTURB1.187
F_TYPE_TITLE='ECMWF PERTURBATION data' UDG7F400.337
CALL F_TYPE(LOOKUP_PER,LEN2_LOOKUP_PER,PP_NUM_PER, UDG7F400.338
& N_TYPES_PER,PP_LEN_PER,PP_ITEMC_PER,PP_TYPE_PER, UDG7F400.339
& PP_POS_PER,PP_LS_PER,FIXHD_PER, UDG7F400.340
*CALL ARGPPX UDG7F400.341
& F_TYPE_TITLE) UDG7F400.342
PERTURB1.191
C Locate and read in ln(pstar) increment PERTURB1.192
CALL LOCATE(201,PP_ITEMC_PER,N_TYPES_PER,POS_PER) PERTURB1.193
PERTURB1.194
*IF DEF,TIMER PERTURB1.195
CALL TIMER('READFLDS',3) PERTURB1.196
*ENDIF PERTURB1.197
PERTURB1.198
CALL READFLDS(NFTPER,1,PP_POS_PER(POS_PER),LOOKUP_PER, GDG0F401.1012
& LEN1_LOOKUP_OUT,D1_IN,P_FIELD_OUT,FIXHD_PER, GDG0F401.1013
*CALL ARGPPX GDG0F401.1014
& ICODE,CMESSAGE) GDG0F401.1015
IF(ICODE.NE.0)CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTPER) PERTURB1.202
PERTURB1.203
C Locate and read in pstar PERTURB1.204
CALL LOCATE(1,PP_ITEMC_OUT,N_TYPES_OUT,POS_OUT) PERTURB1.205
PERTURB1.206
PERTURB1.207
CALL READFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT),LOOKUP_OUT, GDG0F401.1016
& LEN1_LOOKUP_OUT,PSTAR,P_FIELD_OUT,FIXHD_OUT, GDG0F401.1017
*CALL ARGPPX GDG0F401.1018
& ICODE,CMESSAGE) GDG0F401.1019
PERTURB1.211
*IF DEF,TIMER PERTURB1.212
CALL TIMER('READFLDS',4) PERTURB1.213
*ENDIF PERTURB1.214
IF(ICODE.NE.0)CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTOUT) PERTURB1.215
PERTURB1.216
C Increment pstar PERTURB1.217
PERTURB1.218
DO I=1,P_FIELD_OUT PERTURB1.219
PSTAR(I)=EXP(ALOG(PSTAR(I))+PERTURBATION*D1_IN(I)) UDG3F405.357
ENDDO PERTURB1.221
PERTURB1.222
C Write out pstar PERTURB1.223
PERTURB1.224
*IF DEF,TIMER PERTURB1.225
CALL TIMER('WRITFLDS',3) PERTURB1.226
*ENDIF PERTURB1.227
PERTURB1.228
CALL WRITFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT),LOOKUP_OUT, GDG0F401.1020
& LEN1_LOOKUP_OUT,PSTAR,P_FIELD_OUT,FIXHD_OUT, GDG0F401.1021
*CALL ARGPPX GDG0F401.1022
& ICODE,CMESSAGE) GDG0F401.1023
IF(ICODE.NE.0)CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTOUT) PERTURB1.232
PERTURB1.233
*IF DEF,TIMER PERTURB1.234
CALL TIMER('WRITFLDS',4) PERTURB1.235
*ENDIF PERTURB1.236
PERTURB1.237
UDG3F405.358
! Process T increments UDG3F405.359
UDG3F405.360
CALL LOCATE(204,PP_ITEMC_PER,N_TYPES_PER,POS_PER) UDG3F405.361
CALL LOCATE(5,PP_ITEMC_OUT,N_TYPES_OUT,POS_OUT) UDG3F405.362
N_FIELDS_PER=PP_NUM_PER(POS_PER) UDG3F405.363
UDG3F405.364
DO I=1,N_FIELDS_PER UDG3F405.365
UDG3F405.366
*IF DEF,TIMER UDG3F405.367
CALL TIMER('READFLDS',3) UDG3F405.368
*ENDIF UDG3F405.369
UDG3F405.370
CALL READFLDS(NFTPER,1,PP_POS_PER(POS_PER)+I-1,LOOKUP_PER, UDG3F405.371
& LEN1_LOOKUP_OUT,D1_IN,P_FIELD_OUT,FIXHD_PER, UDG3F405.372
*CALL ARGPPX UDG3F405.373
& ICODE,CMESSAGE) UDG3F405.374
IF(ICODE.EQ.1501)THEN UDG3F405.375
! Average polar rows if not constant UDG3F405.376
IF(LPOLARCHK)THEN UDG3F405.377
write(6,*) 'Averaging polar rows to make them constant' UDG3F405.378
! North polar row UDG3F405.379
RP_ROW_SUM=0.0 UDG3F405.380
DO K=1,ROW_LENGTH_OUT UDG3F405.381
RP_ROW_SUM=RP_ROW_SUM+D1_IN(K) UDG3F405.382
END DO UDG3F405.383
DO K=1,ROW_LENGTH_OUT UDG3F405.384
D1_IN(K)=RP_ROW_SUM/ROW_LENGTH_OUT UDG3F405.385
END DO UDG3F405.386
! South polar row UDG3F405.387
RP_ROW_SUM=0.0 UDG3F405.388
DO K=1,ROW_LENGTH_OUT UDG3F405.389
RP_ROW_SUM= UDG3F405.390
& RP_ROW_SUM+D1_IN((P_ROWS_OUT-1)*ROW_LENGTH_OUT+K) UDG3F405.391
END DO UDG3F405.392
DO K=1,ROW_LENGTH_OUT UDG3F405.393
D1_IN((P_ROWS_OUT-1)*ROW_LENGTH_OUT+K)= UDG3F405.394
& RP_ROW_SUM/ROW_LENGTH_OUT UDG3F405.395
END DO UDG3F405.396
END IF UDG3F405.397
ELSE IF(ICODE.NE.0)THEN UDG3F405.398
CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTPER) UDG3F405.399
END IF UDG3F405.400
UDG3F405.401
CALL READFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT)+I-1,LOOKUP_OUT, UDG3F405.402
& LEN1_LOOKUP_OUT,D1_OUT,P_FIELD_OUT,FIXHD_OUT, UDG3F405.403
*CALL ARGPPX UDG3F405.404
& ICODE,CMESSAGE) UDG3F405.405
IF(ICODE.EQ.1501)THEN UDG3F405.406
! Average polar rows if not constant UDG3F405.407
IF(LPOLARCHK)THEN PXDG1406.8
write(6,*) 'Averaging polar rows to make them constant' UDG3F405.409
! North polar row UDG3F405.410
RP_ROW_SUM=0.0 UDG3F405.411
DO K=1,ROW_LENGTH_OUT UDG3F405.412
RP_ROW_SUM=RP_ROW_SUM+D1_OUT(K) UDG3F405.413
END DO UDG3F405.414
DO K=1,ROW_LENGTH_OUT UDG3F405.415
D1_OUT(K)=RP_ROW_SUM/ROW_LENGTH_OUT UDG3F405.416
END DO UDG3F405.417
! South polar row UDG3F405.418
RP_ROW_SUM=0.0 UDG3F405.419
DO K=1,ROW_LENGTH_OUT UDG3F405.420
RP_ROW_SUM= UDG3F405.421
& RP_ROW_SUM+D1_OUT((P_ROWS_OUT-1)*ROW_LENGTH_OUT+K) UDG3F405.422
END DO UDG3F405.423
DO K=1,ROW_LENGTH_OUT UDG3F405.424
D1_OUT((P_ROWS_OUT-1)*ROW_LENGTH_OUT+K)= UDG3F405.425
& RP_ROW_SUM/ROW_LENGTH_OUT UDG3F405.426
END DO UDG3F405.427
END IF UDG3F405.428
ELSE IF(ICODE.NE.0)THEN UDG3F405.429
CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTOUT) UDG3F405.430
END IF UDG3F405.431
UDG3F405.432
*IF DEF,TIMER UDG3F405.433
CALL TIMER('READFLDS',4) UDG3F405.434
*ENDIF UDG3F405.435
UDG3F405.436
DO K=1,P_FIELD_OUT UDG3F405.437
PR=LEVDEPC_OUT(I)+PSTAR(K)*LEVDEPC_OUT(I+P_LEVELS_OUT) UDG3F405.438
D1_OUT(K)=D1_OUT(K)+PERTURBATION*D1_IN(K)*(PREF/PR)**KAPPA UDG3F405.439
END DO UDG3F405.440
UDG3F405.441
*IF DEF,TIMER UDG3F405.442
CALL TIMER('WRITFLDS',3) UDG3F405.443
*ENDIF UDG3F405.444
UDG3F405.445
CALL WRITFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT)+I-1,LOOKUP_OUT, UDG3F405.446
& LEN1_LOOKUP_OUT,D1_OUT,P_FIELD_OUT,FIXHD_OUT, UDG3F405.447
*CALL ARGPPX UDG3F405.448
& ICODE,CMESSAGE) UDG3F405.449
IF(ICODE.NE.0)CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTOUT) UDG3F405.450
UDG3F405.451
*IF DEF,TIMER UDG3F405.452
CALL TIMER('WRITFLDS',4) UDG3F405.453
*ENDIF UDG3F405.454
END DO UDG3F405.455
UDG3F405.456
! Process u and v increments UDG3F405.457
UDG3F405.458
DO J=202,203 UDG3F405.459
PERTURB1.241
CALL LOCATE(J,PP_ITEMC_PER,N_TYPES_PER,POS_PER) PERTURB1.242
CALL LOCATE(J-200,PP_ITEMC_OUT,N_TYPES_OUT,POS_OUT) PERTURB1.243
N_FIELDS_PER=PP_NUM_PER(POS_PER) PERTURB1.244
PERTURB1.245
DO I=1,N_FIELDS_PER PERTURB1.246
PERTURB1.247
*IF DEF,TIMER PERTURB1.248
CALL TIMER('READFLDS',3) PERTURB1.249
*ENDIF PERTURB1.250
PERTURB1.251
CALL READFLDS(NFTPER,1,PP_POS_PER(POS_PER)+I-1,LOOKUP_PER, GDG0F401.1024
& LEN1_LOOKUP_OUT,D1_IN,P_FIELD_OUT,FIXHD_PER, GDG0F401.1025
*CALL ARGPPX GDG0F401.1026
& ICODE,CMESSAGE) GDG0F401.1027
IF(ICODE.NE.0)CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTPER) PERTURB1.255
PERTURB1.256
CALL READFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT)+I-1,LOOKUP_OUT, UDG3F405.460
& LEN1_LOOKUP_OUT,D1_OUT,P_FIELD_OUT,FIXHD_OUT, GDG0F401.1029
*CALL ARGPPX GDG0F401.1030
& ICODE,CMESSAGE) GDG0F401.1031
IF(ICODE.NE.0)CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTOUT) PERTURB1.260
PERTURB1.261
*IF DEF,TIMER PERTURB1.262
CALL TIMER('READFLDS',4) PERTURB1.263
*ENDIF PERTURB1.264
PERTURB1.265
C u & v incs PERTURB1.276
DO K=1,P_FIELD_OUT PERTURB1.277
D1_OUT(K)=D1_OUT(K)+PERTURBATION*D1_IN(K) PERTURB1.278
ENDDO PERTURB1.279
PERTURB1.282
*IF DEF,TIMER PERTURB1.283
CALL TIMER('WRITFLDS',3) PERTURB1.284
*ENDIF PERTURB1.285
PERTURB1.286
CALL WRITFLDS(NFTOUT,1,PP_POS_OUT(POS_OUT)+I-1,LOOKUP_OUT, GDG0F401.1032
& LEN1_LOOKUP_OUT,D1_OUT,P_FIELD_OUT,FIXHD_OUT, GDG0F401.1033
*CALL ARGPPX GDG0F401.1034
& ICODE,CMESSAGE) GDG0F401.1035
IF(ICODE.NE.0)CALL ABORT_IO('PER_FILE',CMESSAGE,ICODE,NFTOUT) PERTURB1.290
PERTURB1.291
*IF DEF,TIMER PERTURB1.292
CALL TIMER('WRITFLDS',4) PERTURB1.293
*ENDIF PERTURB1.294
ENDDO PERTURB1.295
PERTURB1.296
ENDDO PERTURB1.297
PERTURB1.298
RETURN PERTURB1.299
END PERTURB1.300
*ENDIF PERTURB1.301