SUBROUTINE IMPLSCH (FL3, FL, IJS, IJL, IG, IGL, ishallo, 1,9IMPLSCH.4
& idelt, IMPLSCH.5
*CALL ARGWVAL 
IMPLSCH.6
*CALL ARGWVFD IMPLSCH.7
*CALL ARGWVMN IMPLSCH.8
*CALL ARGWVSR IMPLSCH.9
*CALL ARGWVWD IMPLSCH.10
*CALL ARGWVSH IMPLSCH.11
*CALL ARGWVCP IMPLSCH.12
*CALL ARGWVTB IMPLSCH.13
*CALL ARGWVNL IMPLSCH.14
*CALL ARGWVS2 IMPLSCH.15
& icode) IMPLSCH.16
IMPLSCH.17
*CALL PARWVSH IMPLSCH.18
*CALL PARWVTB IMPLSCH.19
*CALL PARCONS IMPLSCH.20
PARAMETER (GZPI28 = G/28./ZPI) IMPLSCH.21
IMPLSCH.22
*CALL TYPWVFD IMPLSCH.23
*CALL TYPWVMN IMPLSCH.24
*CALL TYPWVSR IMPLSCH.25
*CALL TYPWVWD IMPLSCH.26
*CALL TYPWVSH IMPLSCH.27
*CALL TYPWVCP IMPLSCH.28
*CALL TYPWVTB IMPLSCH.29
*CALL TYPWVNL IMPLSCH.30
*CALL TYPWVS2 IMPLSCH.31
*CALL TYPWVAL IMPLSCH.32
IMPLSCH.33
C ---------------------------------------------------------------------- IMPLSCH.34
C IMPLSCH.35
C**** *IMPLSCH* - IMPLICIT SCHEME FOR TIME INTEGRATION OF SOURCE IMPLSCH.36
C**** FUNCTIONS. IMPLSCH.37
C IMPLSCH.38
C S.D.HASSELMANN. MPI IMPLSCH.39
C H. GUENTHER AND L. ZAMBRESKY OPTIMIZATION PERFORMED. IMPLSCH.40
C H. GUENTHER GKSS/ECMWF OCTOBER 1989 NEW WIND FIELD IMPLSCH.41
C INTERFACE AND IMPLSCH.42
C TIME COUNTING IMPLSCH.43
C P.A.E.M. JANSSEN KNMI AUGUST 1990 COUPLED MODEL IMPLSCH.44
C H. GUENTHER GKSS/ECMWF JUNE 1991 NEW SEPARATION OF IMPLSCH.45
C DIAG- AND PROGNOSTIC IMPLSCH.46
C PART OF SPECTRUM. IMPLSCH.47
C IMPLSCH.48
C* PURPOSE. IMPLSCH.49
C -------- IMPLSCH.50
C IMPLSCH.51
C THE IMPLICIT SCHEME ENABLES THE USE OF A TIMESTEP WHICH IS IMPLSCH.52
C LARGE COMPARED WITH THE CHARACTERISTIC DYNAMIC TIME SCALE. IMPLSCH.53
C THE SCHEME IS REQUIRED FOR THE HIGH FREQUENCIES WHICH IMPLSCH.54
C RAPIDLY ADJUST TO A QUASI-EQUILIBRIUM. IMPLSCH.55
C IMPLSCH.56
C** INTERFACE. IMPLSCH.57
C ---------- IMPLSCH.58
C IMPLSCH.59
C *CALL* *IMPLSCH (FL3, FL, IJS, IJL, IG, IGL)* IMPLSCH.60
C *FL3* - FREQUENCY SPECTRUM(INPUT AND OUTPUT). IMPLSCH.61
C *FL* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE IMPLSCH.62
C *IJS* - INDEX OF FIRST GRIDPOINT IMPLSCH.63
C *IJL* - INDEX OF LAST GRIDPOINT IMPLSCH.64
C *IG* - BLOCK NUMBER IMPLSCH.65
C *IGL* - NUMBER OF BLOCKS IMPLSCH.66
C IMPLSCH.67
C METHOD. IMPLSCH.68
C ------- IMPLSCH.69
C IMPLSCH.70
C THE SPECTRUM AT TIME (TN+1) IS COMPUTED AS IMPLSCH.71
C FN+1=FN+DELT*(SN+SN+1)/2., WHERE SN IS THE TOTAL SOURCE IMPLSCH.72
C FUNCTION AT TIME TN, SN+1=SN+(DS/DF)*DF - ONLY THE DIAGONAL IMPLSCH.73
C TERMS OF THE FUNCTIONAL MATRIX DS/DF ARE COMPUTED, THE IMPLSCH.74
C NONDIAGONAL TERMS ARE NEGLIGIBLE. IMPLSCH.75
C THE ROUTINE IS CALLED AFTER PROPAGATION FOR TIME PERIOD IMPLSCH.76
C BETWEEN TWO PROPAGATION CALLS - ARRAY FL3 CONTAINS THE IMPLSCH.77
C SPECTRUM AND FL IS USED AS AN INTERMEDIATE STORAGE FOR THE IMPLSCH.78
C DIAGONAL TERM OF THE FUNCTIONAL MATRIX. IMPLSCH.79
C IMPLSCH.80
C EXTERNALS. IMPLSCH.81
C --------- IMPLSCH.82
C IMPLSCH.83
C *FEMEAN* - COMPUTATION OF MEAN FREQUENCY AT EACH GRID POINT. IMPLSCH.84
CSHALLOW IMPLSCH.85
C *SBOTTOM* - COMPUTES BOTTOM DISSIPATION SOURCE TERM AND IMPLSCH.86
C LINEAR CONTRIBUTION TO FUNCTIONAL MATRIX. IMPLSCH.87
CSHALLOW IMPLSCH.88
C *SDISSIP* - COMPUTATION OF DISSIPATION SOURCE FUNCTION IMPLSCH.89
C AND LINEAR CONTRIBUTION OF DISSIPATION TO IMPLSCH.90
C FUNCTIONAL MATRIX IN IMPLICIT SCHEME. IMPLSCH.91
C *SEMEAN* - COMPUTATION OF TOTAL ENERGY AT EACH GRID POINT. IMPLSCH.92
C *SINPUT* - COMPUTATION OF INPUT SOURCE FUNCTION, AND IMPLSCH.93
C LINEAR CONTRIBUTION OF INPUT SOURCE FUNCTION IMPLSCH.94
C TO FUNCTIONAL MATRIX IN IMPLICIT SCHEME. IMPLSCH.95
C *SNONLIN* - COMPUTATION OF NONLINEAR TRANSFER RATE AND IMPLSCH.96
C DIAGONAL LINEAR CONTRIBUTION OF NONLINEAR SOURCE IMPLSCH.97
C FUNCTION TO FUNCTIONAL MATRIX. IMPLSCH.98
C *STRESSO* - COMPUTATION NORMALISED WAVE STRESS. IMPLSCH.99
C !!!!!!! MAKE SURE THAT SINPUT IS CALLED FIRST, STRESSO IMPLSCH.100
C !!!!!!! NEXT, AND THEN THE REST OF THE SOURCE FUNCTIONS. IMPLSCH.101
C IMPLSCH.102
C REFERENCE. IMPLSCH.103
C ---------- IMPLSCH.104
C IMPLSCH.105
C S. HASSELMANN AND K. HASSELMANN, "A GLOBAL WAVE MODEL", IMPLSCH.106
C 30/6/85 (UNPUBLISHED NOTE) IMPLSCH.107
C IMPLSCH.108
C ---------------------------------------------------------------------- IMPLSCH.109
C IMPLSCH.110
DIMENSION FL(0:NIBLO,NANG,NFRE), FL3(0:NIBLO,NANG,NFRE) IMPLSCH.111
IMPLSCH.112
cc local array used when extracting source term diagnostics IMPLSCH.113
real temp2(0:niblo,nang,nfre) IMPLSCH.114
C IMPLSCH.115
C ---------------------------------------------------------------------- IMPLSCH.116
C IMPLSCH.117
DIMENSION MIJ(NIBLO), MFMF(NIBLO), GADIAG(NIBLO), IMPLSCH.118
1 TEMP(NIBLO,NFRE), DELFL(NFRE) IMPLSCH.119
IMPLSCH.120
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc IMPLSCH.121
c IMPLSCH.122
c all these are local arrays - since SL is initialised to zero in IMPLSCH.123
c this subroutine IMPLSCH.124
cc IMPLSCH.125
cc It seems that sl is been used simply as a temp IMPLSCH.126
cc work space in WAM IMPLSCH.127
cc IMPLSCH.128
cc EQUIVALENCE (SL(1,3,1), MIJ(1)) IMPLSCH.129
cc EQUIVALENCE (SL(1,5,1), MFMF(1)) IMPLSCH.130
cc EQUIVALENCE (SL(1,7,1), GADIAG(1)) IMPLSCH.131
cc EQUIVALENCE (SL(1,9,1), TEMP(1,1)) IMPLSCH.132
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc IMPLSCH.133
cc IMPLSCH.134
DELT = IDELT IMPLSCH.135
DELT5 = 0.5*DELT IMPLSCH.136
C ---------------------------------------------------------------------- IMPLSCH.137
C IMPLSCH.138
C* 1. INITIALISATION. IMPLSCH.139
C --------------- IMPLSCH.140
C IMPLSCH.141
1000 CONTINUE IMPLSCH.142
C IMPLSCH.143
C ---------------------------------------------------------------------- IMPLSCH.144
c initialisation of local diagnostic arrays IMPLSCH.145
IMPLSCH.146
do i=1,len_s2 IMPLSCH.147
sin2 (i)=0. IMPLSCH.148
snl2 (i)=0. IMPLSCH.149
sds2 (i)=0. IMPLSCH.150
sbf2 (i)=0. IMPLSCH.151
stl2 (i)=0. IMPLSCH.152
enddo IMPLSCH.153
IMPLSCH.154
C ---------------------------------------------------------------------- IMPLSCH.155
C IMPLSCH.156
C* 2. COMPUTATION OF IMPLICIT INTEGRATION. IMPLSCH.157
C ------------------------------------ IMPLSCH.158
C IMPLSCH.159
C INTEGRATION IS DONE FOR A BLOCK IMPLSCH.160
C OF LATITUDES BETWEEN PROPAGATION CALLS. IMPLSCH.161
C IMPLSCH.162
2000 CONTINUE IMPLSCH.163
C ---------------------------------------------------------------------- IMPLSCH.164
C IMPLSCH.165
C* 2.2 COMPUTE MEAN PARAMETERS. IMPLSCH.166
C ------------------------ IMPLSCH.167
C IMPLSCH.168
2200 CONTINUE IMPLSCH.169
IMPLSCH.170
CALL SEMEAN(FL3, IJS, IJL, IMPLSCH.171
*CALL ARGWVAL IMPLSCH.172
*CALL ARGWVFD IMPLSCH.173
*CALL ARGWVMN IMPLSCH.174
& icode) IMPLSCH.175
IMPLSCH.176
CALL FEMEAN(FL3, IJS, IJL, ishallo, IMPLSCH.177
*CALL ARGWVAL IMPLSCH.178
*CALL ARGWVFD IMPLSCH.179
*CALL ARGWVMN IMPLSCH.180
*CALL ARGWVSH IMPLSCH.181
& icode) IMPLSCH.182
C IMPLSCH.183
C ---------------------------------------------------------------------- IMPLSCH.184
C IMPLSCH.185
C* 2.3 COMPUTATION OF SOURCE FUNCTIONS. IMPLSCH.186
C -------------------------------- IMPLSCH.187
C IMPLSCH.188
2300 CONTINUE IMPLSCH.189
C IMPLSCH.190
C* 2.3.1 INITIALISE SOURCE FUNCTION AND DERIVATIVE ARRAY. IMPLSCH.191
C ------------------------------------------------ IMPLSCH.192
C IMPLSCH.193
DO 2311 M=1,NFRE IMPLSCH.194
DO 2311 K=1,NANG IMPLSCH.195
DO 2311 IJ=0,NIBLO IMPLSCH.196
SL(IJ,K,M) = 0. IMPLSCH.197
FL(IJ,K,M) = 0. IMPLSCH.198
2311 CONTINUE IMPLSCH.199
C IMPLSCH.200
C* 2.3.2 ADD SOURCE FUNCTIONS AND WAVE STRESS. IMPLSCH.201
C ------------------------------------- IMPLSCH.202
C IMPLSCH.203
CALL SINPUT (FL3, FL, IJS, IJL, IG, ishallo, IMPLSCH.204
*CALL ARGWVAL IMPLSCH.205
*CALL ARGWVCP IMPLSCH.206
*CALL ARGWVFD IMPLSCH.207
*CALL ARGWVMN IMPLSCH.208
*CALL ARGWVSH IMPLSCH.209
*CALL ARGWVSR IMPLSCH.210
*CALL ARGWVWD IMPLSCH.211
& icode) IMPLSCH.212
IMPLSCH.213
c extract diagnostics if required IMPLSCH.214
if(len_s2.eq.nang*nfre*niblo) then IMPLSCH.215
WRITE(6,*)'extracting diagnostics Sinput' GIE0F403.267
do l=1,nfre IMPLSCH.217
do m=1,nang IMPLSCH.218
nstart=((l-1)*nang + m-1)*niblo IMPLSCH.219
do ip=ijs,ijl IMPLSCH.220
sin2(nstart+ip)=sl(ip,m,l)*delt IMPLSCH.221
temp2(ip,m,l)=sl(ip,m,l) IMPLSCH.222
enddo IMPLSCH.223
enddo IMPLSCH.224
enddo IMPLSCH.225
endif IMPLSCH.226
IMPLSCH.227
CALL STRESSO (FL3, IJS, IJL, IG, igl, IMPLSCH.228
*CALL ARGWVAL IMPLSCH.229
*CALL ARGWVCP IMPLSCH.230
*CALL ARGWVFD IMPLSCH.231
*CALL ARGWVSR IMPLSCH.232
*CALL ARGWVTB IMPLSCH.233
*CALL ARGWVWD IMPLSCH.234
& icode) IMPLSCH.235
IMPLSCH.236
CALL SNONLIN (FL3, FL, IJS, IJL, IG, ishallo, IMPLSCH.237
*CALL ARGWVAL IMPLSCH.238
*CALL ARGWVNL IMPLSCH.239
*CALL ARGWVMN IMPLSCH.240
*CALL ARGWVSH IMPLSCH.241
*CALL ARGWVSR IMPLSCH.242
& icode) IMPLSCH.243
IMPLSCH.244
c extract diagnostics if required IMPLSCH.245
if(len_s2.eq.nang*nfre*niblo) then IMPLSCH.246
WRITE(6,*)'extracting diagnostics Snl' GIE0F403.268
do l=1,nfre IMPLSCH.248
do m=1,nang IMPLSCH.249
nstart=((l-1)*nang + m-1)*niblo IMPLSCH.250
do ip=ijs,ijl IMPLSCH.251
snl2(nstart+ip)=(sl(ip,m,l) - temp2(ip,m,l))*delt IMPLSCH.252
temp2(ip,m,l)=sl(ip,m,l) IMPLSCH.253
enddo IMPLSCH.254
enddo IMPLSCH.255
enddo IMPLSCH.256
endif IMPLSCH.257
IMPLSCH.258
CALL SDISSIP (FL3 ,FL, IJS, IJL, ishallo, IMPLSCH.259
*CALL ARGWVAL IMPLSCH.260
*CALL ARGWVFD IMPLSCH.261
*CALL ARGWVMN IMPLSCH.262
*CALL ARGWVSH IMPLSCH.263
*CALL ARGWVSR IMPLSCH.264
& icode) IMPLSCH.265
IMPLSCH.266
c extract diagnostics if required IMPLSCH.267
if(len_s2.eq.nang*nfre*niblo) then IMPLSCH.268
WRITE(6,*)'extracting diagnostics Sds' GIE0F403.269
do l=1,nfre IMPLSCH.270
do m=1,nang IMPLSCH.271
nstart=((l-1)*nang + m-1)*niblo IMPLSCH.272
do ip=ijs,ijl IMPLSCH.273
sds2(nstart+ip)=(sl(ip,m,l) - temp2(ip,m,l))*delt IMPLSCH.274
temp2(ip,m,l)=sl(ip,m,l) IMPLSCH.275
enddo IMPLSCH.276
enddo IMPLSCH.277
enddo IMPLSCH.278
endif IMPLSCH.279
IMPLSCH.280
CSHALLOW IMPLSCH.281
IF(ISHALLO.NE.1) then IMPLSCH.282
CALL SBOTTOM (FL3, FL, IJS, IJL, IG, IMPLSCH.283
*CALL ARGWVAL IMPLSCH.284
*CALL ARGWVSH IMPLSCH.285
*CALL ARGWVSR IMPLSCH.286
& icode) IMPLSCH.287
IMPLSCH.288
c extract diagnostics if required IMPLSCH.289
if(len_s2.eq.nang*nfre*niblo) then IMPLSCH.290
WRITE(6,*)'extracting diagnostics Sbf' GIE0F403.270
do l=1,nfre IMPLSCH.292
do m=1,nang IMPLSCH.293
nstart=((l-1)*nang + m-1)*niblo IMPLSCH.294
do ip=ijs,ijl IMPLSCH.295
sbf2(nstart+ip)=(sl(ip,m,l) - temp2(ip,m,l))*delt IMPLSCH.296
temp2(ip,m,l)=sl(ip,m,l) IMPLSCH.297
enddo IMPLSCH.298
enddo IMPLSCH.299
enddo IMPLSCH.300
endif IMPLSCH.301
ENDIF IMPLSCH.302
CSHALLOW IMPLSCH.303
C ---------------------------------------------------------------------- IMPLSCH.304
C IMPLSCH.305
C* 2.4 COMPUTATION OF NEW SPECTRA. IMPLSCH.306
C --------------------------- IMPLSCH.307
C IMPLSCH.308
C INCREASE OF SPECTRUM IN A TIME STEP IS LIMITED TO A FINITE IMPLSCH.309
C FRACTION OF A TYPICAL F**(-5) EQUILIBRIUM SPECTRUM. IMPLSCH.310
C IMPLSCH.311
2400 CONTINUE IMPLSCH.312
IMPLSCH.313
DO 2401 M=1,NFRE IMPLSCH.314
cc IMPLSCH.315
CCMH note this term 1200 limits delt to be a multiple of 20 mins IMPLSCH.316
CCMH or else some constant in here is hardwired to 20 minutes IMPLSCH.317
cc IMPLSCH.318
DELFL(M) = 0.62E-04*FR(M)**(-5.)*DELT/1200. IMPLSCH.319
DO 2402 K=1,NANG IMPLSCH.320
DO 2403 IJ=IJS,IJL IMPLSCH.321
GTEMP1 = MAX((1.-DELT5*FL(IJ,K,M)),1.) IMPLSCH.322
GTEMP2 = DELT*SL(IJ,K,M)/GTEMP1 IMPLSCH.323
FLHAB = ABS(GTEMP2) IMPLSCH.324
FLHAB = MIN(FLHAB,DELFL(M)) IMPLSCH.325
FL3(IJ,K,M) = FL3(IJ,K,M) + SIGN(FLHAB,GTEMP2) IMPLSCH.326
FL3(IJ,K,M) = MAX(FL3(IJ,K,M),0.) IMPLSCH.327
2403 CONTINUE IMPLSCH.328
2402 CONTINUE IMPLSCH.329
2401 CONTINUE IMPLSCH.330
C IMPLSCH.331
C ---------------------------------------------------------------------- IMPLSCH.332
C IMPLSCH.333
C* 2.5 REPLACE DIAGNOSTIC PART OF SPECTRA BY A F**(-5) TAIL. IMPLSCH.334
C ----------------------------------------------------- IMPLSCH.335
C IMPLSCH.336
2500 CONTINUE IMPLSCH.337
C IMPLSCH.338
C* 2.5.1 COMPUTE MEAN PARAMETERS. IMPLSCH.339
C ------------------------ IMPLSCH.340
C IMPLSCH.341
CALL SEMEAN(FL3, IJS, IJL, IMPLSCH.342
*CALL ARGWVAL IMPLSCH.343
*CALL ARGWVFD IMPLSCH.344
*CALL ARGWVMN IMPLSCH.345
& icode) IMPLSCH.346
IMPLSCH.347
CALL FEMEAN(FL3, IJS, IJL, ishallo, IMPLSCH.348
*CALL ARGWVAL IMPLSCH.349
*CALL ARGWVFD IMPLSCH.350
*CALL ARGWVMN IMPLSCH.351
*CALL ARGWVSH IMPLSCH.352
& icode) IMPLSCH.353
C IMPLSCH.354
C* 2.5.2 COMPUTE LAST FREQUENCY INDEX OF PROGNOSTIC PART OF SPECTRUM. IMPLSCH.355
C* FREQUENCIES LE MAX(4*F(PM) , 2.5*FMEAN). IMPLSCH.356
C ------------------------------------------------------------ IMPLSCH.357
C IMPLSCH.358
FPMH = 2.5/FR(1) IMPLSCH.359
FPM = 4.*GZPI28/FR(1) IMPLSCH.360
cc IMPLSCH.361
ccmh note from elsewhere that 24.1598 is 1./(log10(1.1)) IMPLSCH.362
cc IMPLSCH.363
DO 2521 IJ=IJS,IJL IMPLSCH.364
FPM4 = FPM/(USNEW(IJ,ig)+0.1E-9) IMPLSCH.365
MIJ(IJ) = ALOG10(FPM4)*24.1589+2. IMPLSCH.366
FPM4 = FMEAN(IJ)*FPMH IMPLSCH.367
MFMF(IJ) = ALOG10(FPM4)*24.1589+1. IMPLSCH.368
2521 CONTINUE IMPLSCH.369
IMPLSCH.370
DO 2522 IJ=IJS,IJL IMPLSCH.371
MIJ(IJ) = MAX(MFMF(IJ),MIJ(IJ)) IMPLSCH.372
MIJ(IJ) = MIN(MIJ(IJ),NFRE) IMPLSCH.373
2522 CONTINUE IMPLSCH.374
C IMPLSCH.375
C* 2.5.3 COMPUTE TAIL ENERGY RATIOS. IMPLSCH.376
C --------------------------- IMPLSCH.377
C IMPLSCH.378
DO 2531 M=1,NFRE IMPLSCH.379
DELFL(M) = (1./FR(M))**5. IMPLSCH.380
2531 CONTINUE IMPLSCH.381
DO 2532 IJ=IJS,IJL IMPLSCH.382
GADIAG(IJ) = FR(MIJ(IJ))**5. IMPLSCH.383
2532 CONTINUE IMPLSCH.384
C IMPLSCH.385
C* 2.5.4 MERGE TAIL INTO SPECTRA. IMPLSCH.386
C ------------------------ IMPLSCH.387
C IMPLSCH.388
DO 2541 M=1,NFRE IMPLSCH.389
DO 2542 IJ=IJS,IJL IMPLSCH.390
FCONST(IJ,M) = 0. IMPLSCH.391
TEMP(IJ,M) = GADIAG(IJ)*DELFL(M) IMPLSCH.392
2542 CONTINUE IMPLSCH.393
2541 CONTINUE IMPLSCH.394
DO 2543 IJ=IJS,IJL IMPLSCH.395
J = MIJ(IJ) IMPLSCH.396
DO 2544 M=1,J IMPLSCH.397
FCONST(IJ,M) = 1. IMPLSCH.398
TEMP(IJ,M) = 0. IMPLSCH.399
2544 CONTINUE IMPLSCH.400
2543 CONTINUE IMPLSCH.401
C IMPLSCH.402
DO 2545 K=1,NANG IMPLSCH.403
DO 2546 IJ=IJS,IJL IMPLSCH.404
GADIAG(IJ) = FL3(IJ,K,MIJ(IJ)) IMPLSCH.405
2546 CONTINUE IMPLSCH.406
DO 2547 M=1,NFRE IMPLSCH.407
DO 2548 IJ=IJS,IJL IMPLSCH.408
FL3(IJ,K,M) = GADIAG(IJ)*TEMP(IJ,M) IMPLSCH.409
1 + FL3(IJ,K,M)*FCONST(IJ,M) IMPLSCH.410
2548 CONTINUE IMPLSCH.411
2547 CONTINUE IMPLSCH.412
2545 CONTINUE IMPLSCH.413
IMPLSCH.414
c extract diagnostics if required IMPLSCH.415
if(len_s2.eq.nang*nfre*niblo) then IMPLSCH.416
WRITE(6,*)'extracting diagnostics Stail' GIE0F403.271
do l=1,nfre IMPLSCH.418
do m=1,nang IMPLSCH.419
nstart=((l-1)*nang + m-1)*niblo IMPLSCH.420
do ip=ijs,ijl IMPLSCH.421
stl2(nstart+ip)=(sl(ip,m,l) - temp2(ip,m,l))*delt IMPLSCH.422
enddo IMPLSCH.423
enddo IMPLSCH.424
enddo IMPLSCH.425
endif IMPLSCH.426
C IMPLSCH.427
RETURN IMPLSCH.428
END IMPLSCH.429
*ENDIF IMPLSCH.430