SUBROUTINE WAV_FOR_STEP(ishallo, irefra, ,2WAVFRST1.21
& energy, mdata, idelt, idelpro, WAVFRST1.22
*CALL ARGWVAL 
WAVFRST1.23
*CALL ARGWVFD WAVFRST1.24
*CALL ARGWVWD WAVFRST1.25
*CALL ARGWVSH WAVFRST1.26
*CALL ARGWVCP WAVFRST1.27
*CALL ARGWVTB WAVFRST1.28
*CALL ARGWVNL WAVFRST1.29
*CALL ARGWVKL WAVFRST1.30
*CALL ARGWVGD WAVFRST1.31
*CALL ARGWVMP WAVFRST1.32
*CALL ARGWVRF WAVFRST1.33
*CALL ARGWVCU WAVFRST1.34
WAVFRST1.35
& len_pd,len_sd,len_s2,len_p2, WAVFRST1.36
& icode,cmessage) WAVFRST1.37
WAVFRST1.38
*CALL PARWVSH WAVFRST1.39
*CALL PARWVTB WAVFRST1.40
*CALL PARCONS WAVFRST1.41
WAVFRST1.42
*CALL TYPWVFD WAVFRST1.43
*CALL TYPWVMN WAVFRST1.44
*CALL TYPWVSR WAVFRST1.45
*CALL TYPWVWD WAVFRST1.46
*CALL TYPWVSH WAVFRST1.47
*CALL TYPWVCP WAVFRST1.48
*CALL TYPWVTB WAVFRST1.49
*CALL TYPWVNL WAVFRST1.50
*CALL TYPWVKL WAVFRST1.51
*CALL TYPWVGD WAVFRST1.52
*CALL TYPWVMP WAVFRST1.53
*CALL TYPWVRF WAVFRST1.54
*CALL TYPWVCU WAVFRST1.55
*CALL TYPWVSD WAVFRST1.56
*CALL TYPWVPD WAVFRST1.57
*CALL TYPWVAL WAVFRST1.58
WAVFRST1.59
real energy(mdata,nang,nfre) WAVFRST1.60
WAVFRST1.61
INTEGER ICODE ! OUT return code WAVFRST1.62
CHARACTER*80 CMESSAGE ! OUT message accompanying return code WAVFRST1.63
WAVFRST1.64
c local arrays: WAVFRST1.65
WAVFRST1.66
*CALL TYPWVF3 WAVFRST1.67
*CALL TYPWVF1 WAVFRST1.68
*CALL TYPWVS2 WAVFRST1.69
*CALL TYPWVP2 WAVFRST1.70
WAVFRST1.71
real temp(mdata) WAVFRST1.72
real over(nover,nang,nfre,nblo) ! array to hold overlapping WAVFRST1.73
C ! rows of energy at time t WAVFRST1.74
C ---------------------------------------------------------------------- WAVFRST1.75
C WAVFRST1.76
C**** *WAMODEL* - 3-G WAM MODEL - TIME INTEGRATION OF WAVE FIELDS. WAVFRST1.77
C WAVFRST1.78
C S.D. HASSELMANN MPI 1.12.85 WAVFRST1.79
C WAVFRST1.80
C G. KOMEN KNMI 6.86 MODIFIED FOR SHALLOW WATER WAVFRST1.81
C P. JANSSEN ASPECTS. WAVFRST1.82
C WAVFRST1.83
C S.D. HASSELMANN MPI 15.2.87 MODIFIED FOR CYBER 205. WAVFRST1.84
C WAVFRST1.85
C P. LIONELLO ISDGM 6.3.87 MODIFIED TO OUTPUT SWELL. WAVFRST1.86
C WAVFRST1.87
C S.D. HASSELMANN MPI 1.6.87 ALL VERSIONS COMBINED INTO WAVFRST1.88
C ONE MODEL. DEEP AND SHALLOW WAVFRST1.89
C WATER , CRAY AND CYBER 205 WAVFRST1.90
C VERSION. WAVFRST1.91
C WAVFRST1.92
C CYCLE_2 MODICIFATIONS: WAVFRST1.93
C ---------------------- WAVFRST1.94
C WAVFRST1.95
C L. ZAMBRESKY GKSS 10.87 OPTIMIZED FOR CRAY, CYBER 205 WAVFRST1.96
C H. GUNTHER WAVFRST1.97
C WAVFRST1.98
C A. SPEIDEL MPI 4.88 VARIABLE DIMENSIONS, INTERNAL WAVFRST1.99
C CHECKS (CFL-CRITERION). WAVFRST1.100
C WAVFRST1.101
C A. SPEIDEL MPI 11.88 CHANGES FOR CRAY-2. WAVFRST1.102
C WAVFRST1.103
C K. HUBBERT POL 6.89 DEPTH AND CURRENT REFRACTION. WAVFRST1.104
C PRECALCULATION OF TERMS IN WAVFRST1.105
C *PROPDOT*. WAVFRST1.106
C SOLVE WAVE ACTION EQUATION WAVFRST1.107
C FOR CURRENT REFRACTION. WAVFRST1.108
C WAVFRST1.109
C CYCLE_3 MODICIFATIONS: WAVFRST1.110
C ---------------------- WAVFRST1.111
C WAVFRST1.112
C R. PORTZ , S.D. HASSELMANN MPI 1990 WAVFRST1.113
C WAVFRST1.114
C - RESTRUCTURE MODEL TO CALL THE ACTUAL INTEGRATION IN TIME WAVFRST1.115
C AS A SUBROUTINE: WAMODEL. A SHELL PROGRAM "WAMSHELL" READS WAVFRST1.116
C OUTPUT FROM PREPROC AND COMPUTES THE WIND ARRAYS FOR THE WAVFRST1.117
C INTEGRATION PERIOD FROM PREWIND, WHICH HAS BEEN INCORPORATED WAVFRST1.118
C AS A SUBROUTINE. WAVFRST1.119
C - ALL INTERMEDIATE AND RESTART I/O IS DONE IN THE SUBROUTINE WAVFRST1.120
C WAMODEL AND INPREST. WAVFRST1.121
C - THE COMMON BLOCK IN THE PREPROCESSOR AND MODEL ARE MADE WAVFRST1.122
C COMPATIBLE. WAVFRST1.123
C - THE COMPUTATION OF SEVERAL PARAMETERS HAS BEEN TRANSFERRED WAVFRST1.124
C FROM THE MODEL TO PREPROC. WAVFRST1.125
C - DEPTH AND CURRENT REFRACTION HAS BEEN INCORPORATED INTO THE WAVFRST1.126
C MODEL. WAVFRST1.127
C - OPEN BOUNDARIES ARE INCORPORATED IN THE MODEL. WAVFRST1.128
C - SEVERAL MINOR ERRORS HAVE BEEN REMOVED. WAVFRST1.129
C - THE BUFFERED I/O FOR THE CYBER 205 HAS BEEN CHANGED INTO A WAVFRST1.130
C BINARY READ AND WRITE. WAVFRST1.131
C WAVFRST1.132
C CYCLE_4 MODICIFATIONS: WAVFRST1.133
C ---------------------- WAVFRST1.134
C WAVFRST1.135
C L. ZAMBRESKY GKSS/ECMWF 6.89 ECMWF SUB VERSION WAVFRST1.136
C BASED ON CYCLE_2. WAVFRST1.137
C WAVFRST1.138
C H. GUNTHER GKSS/ECMWF 10.89 ECMWF SUB VERSION REORGANIZED. WAVFRST1.139
C - COMMON BLOCK STRUCTURE. WAVFRST1.140
C - BLOCKING STRUCTURE. WAVFRST1.141
C - TIME COUNTING. WAVFRST1.142
C - GRIDDED OUTPUT FIELDS. WAVFRST1.143
C - HEADERS ADDED TO OUTPUT FILES. WAVFRST1.144
C - ERRORS IN PROPAGATION CORRECTED WAVFRST1.145
C WAVFRST1.146
C P.A.E.M. JANSSEN KNMI 1990 COUPLED MODEL. WAVFRST1.147
C WAVFRST1.148
C H. GUNTHER GKSS/ECMWF 8.91 LOGARITHMIC DEPTH TABLES. WAVFRST1.149
C MPI CYCLE_3 AND ECMWF VERSIONS WAVFRST1.150
C COMBINED INTO CYCLE_4. WAVFRST1.151
C WAVFRST1.152
CSHALLOW WAVFRST1.153
C DIFFERENCES FOR SHALLOW WATER RUNS TO DEEP WATER RUNS WAVFRST1.154
C ARE ENCLOSED IN COMMENT LINES : 'CSHALLOW'. WAVFRST1.155
CSHALLOW WAVFRST1.156
CNEST WAVFRST1.157
C DIFFERENCES FOR NESTED GRID RUNS TO NORMAL RUNS WAVFRST1.158
C ARE ENCLOSED IN COMMENT LINES : 'CNEST'. WAVFRST1.159
CNEST WAVFRST1.160
CREFRA WAVFRST1.161
C DIFFERENCES FOR REFRACTION RUNS TO NORMAL RUNS WAVFRST1.162
C ARE ENCLOSED IN COMMENT LINES : 'CREFRA'. WAVFRST1.163
CREFRA WAVFRST1.164
C WAVFRST1.165
C* PURPOSE. WAVFRST1.166
C -------- WAVFRST1.167
C WAVFRST1.168
C COMPUTATION OF THE 2-D FREQUENCY-DIRECTION WAVE SPECTRUM AT ALL WAVFRST1.169
C GRID POINTS FOR A GIVEN INITIAL SPECTRUM AND FORCING SURFACE WAVFRST1.170
C STRESS FIELD. WAVFRST1.171
C WAVFRST1.172
C** INTERFACE. WAVFRST1.173
C ---------- WAVFRST1.174
C WAVFRST1.175
C *CALL* *WAMODEL (NADV)* WAVFRST1.176
C *NADV* INTEGER NUMBER OF ADVECTION ITERATIONS. WAVFRST1.177
C WAVFRST1.178
C (in original WAM this is number of adsvection steps before WAVFRST1.179
C next wind input - not required by UM wave) WAVFRST1.180
C WAVFRST1.181
C METHOD. WAVFRST1.182
C ------- WAVFRST1.183
C WAVFRST1.184
C GRID POINTS ARE LAT - LONG,VECTORIZATION IS ACHIEVED BY RUNNING WAVFRST1.185
C THROUGH THE GRID POINTS IN AN INNER LOOP ORGANIZED AS 1-D ARRAY WAVFRST1.186
C IN BLOCKS,-ALL COMPUTATIONS ARE CARRIED OUT FOR ONE BLOCK AT A WAVFRST1.187
C TIME (SEE "BLOCK STRUCTURE" BELOW) WAVFRST1.188
C WAVFRST1.189
C ALL COMPONENTS OF THE SPECTRUM ARE COMPUTED PROGNOSTICALLY FROM WAVFRST1.190
C THE SPECTRAL TRANSPORT EQUATION UP TO A VARIABLE CUT-OFF WAVFRST1.191
C FREQUENCY = MAX(4*FPM,2.5*FMEAN),WHERE FPM IS THE WAVFRST1.192
C PIERSON MOSKOVITZ FREQUENCY AND FMEAN IS THE MEAN FREQUENCY, WAVFRST1.193
C BEYOND THE PROGNOSTIC CUTOFF A DIAGNOSTIC F**-5 TAIL IS ATTACHED WAVFRST1.194
C CONTINUOUSLY FOR EACH DIRECTION, WAVFRST1.195
C WAVFRST1.196
C SOURCE FUNCTIONS ARE TAKEN FROM KOMEN ET AL(1984) WAVFRST1.197
C WAVFRST1.198
C THE NONLINEAR TRANSFER IS PARAMETERIZED BY THE DISCRETE INTER- WAVFRST1.199
C ACTION APPROXIMATION OF HASSELMANN ET AL (1985B) WAVFRST1.200
C WAVFRST1.201
C THE SOURCE FUNCTION AND THE ADVECTION TERM ARE INTEGRATED ON TWO WAVFRST1.202
C DIFFERENT TIME STEP LEVELS AND WITH DIFFERENT METHODS,-THE WAVFRST1.203
C ADVECTION TIME STEP IS A MULTIPLE OF THE SOURCE FUNCTION WAVFRST1.204
C TIME STEP. WAVFRST1.205
C WAVFRST1.206
C THE SOURCE FUNCTIONS ARE INTEGRATED IMPLICITLY ACCORDING TO WAVFRST1.207
C HASSELMANN AND HASSELMANN (1985A),-THE RELEVANT FUNCTIONAL WAVFRST1.208
C DERIVATIVES OF THE INDIVIDUAL SOURCE FUNCTIONS REQUIRED FOR THE WAVFRST1.209
C SOLUTION OF THE IMPLICIT EQUATION ARE COMPUTED WITHIN THE SOURCE WAVFRST1.210
C FUNCTION SUBS,- THE TIME STEP IS TYPICALLY 20 MIN, WAVFRST1.211
C WAVFRST1.212
C THE ADVECTION IS INTEGRATED BY A FIRST ORDER UPWIND SCHEME,ALSO WAVFRST1.213
C ACCORDING TO HASSELMANN AND HASSELMANN (1985A),-THE ADVECTIVE WAVFRST1.214
C TIMESTEP IS DEPENDENT ON THE FREQUENCY AND SPATIAL GRID IN WAVFRST1.215
C ACCORDANCE WITH CFL, WAVFRST1.216
C WAVFRST1.217
C WINDS ARE READ IN EVERY WIND TIME STEP.IF THE WIND TIME STEP IS WAVFRST1.218
C GREATER THAN THE SOURCE TERM TIME STEP DELTWIND/DELTSOURCE STEPS WAVFRST1.219
C ARE INTEGRATED WITH CONSTANT WINDS, WAVFRST1.220
C WIND TIME STEP,PROPAGATION TIME STEP AND SOURCE TERM TIME STEP WAVFRST1.221
C SHOULD HAVE INTEGER RATIOS, THEY ARE GIVEN IN SECONDS AT WAVFRST1.222
C FULL MINUTES. WAVFRST1.223
C WAVFRST1.224
CNEST WAVFRST1.225
C ZERO ENERGY INFLUX IS ASSUMED AT COAST LINES. OPEN BOUNDARIES WAVFRST1.226
C ARE INCORPORATED IN THE MODEL, IF IT RUNS AS A NESTED GRID. WAVFRST1.227
CNEST WAVFRST1.228
C WAVFRST1.229
C BLOCK STRUCTURE (SEE PREPROC FOR DETAILS): WAVFRST1.230
C SEA POINTS ARE COLLECTED INTO A 1-DIMENSIONAL ARRAY. WAVFRST1.231
C BLOCKS OF MAXIMALLY NIBLO ELEMENTS. WAVFRST1.232
C SEA POINTS ARE COUNTED ALONG LINES OF LATITUDES FROM LEFT COAST WAVFRST1.233
C TO RIGHT COAST WORKING FROM SOUTH TO NORTH. WAVFRST1.234
C BLOCKS OVERLAP OVER TWO LATITUDE LINES,TO COMPUTE NORTH-SOUTH WAVFRST1.235
C ADVECTION TERMS, SEE ALSO COMMON GRIDPAR AND UBUF. WAVFRST1.236
C WAVFRST1.237
C THE WIND FILES FOR THE BLOCKED WINDS CREATED BY PREWIND ARE WAVFRST1.238
C READ AND DELETED IN SUB IMPLSCH (IU17 AND IU18). THE FILE WAVFRST1.239
c NAMES ARE CREATED IN SUB CREWFN AND AN IMPLICIT OPEN IS USED. WAVFRST1.240
C WAVFRST1.241
C THE FILE HANDLING SUBS OPENFIL, GSFILE AND CREWFN ARE COMPUTER WAVFRST1.242
C DEPENDENT AND MAY BE ADOPTED BY THE USER. WAVFRST1.243
C THE PROGRAM CLOSES AND DELETES ALL WORK FILES. WAVFRST1.244
C WAVFRST1.245
C ALL PARAMETERS HAVE TO BE THE VALUES GIVEN AT THE END OF THE WAVFRST1.246
C PREPROC OUTPUT IN COLUMN 'REQUIRED'. WAVFRST1.247
C WAVFRST1.248
C EXTERNALS. WAVFRST1.249
C ---------- WAVFRST1.250
C WAVFRST1.251
C *AIRSEA* - SURFACE LAYER STRESS. WAVFRST1.252
CREFRA WAVFRST1.253
C *DOTDC* - READ COMMON REFDOT. WAVFRST1.254
CREFRA WAVFRST1.255
C *FEMEAN* - COMPUTATION OF MEAN FREQUENCY AT EACH GRID POINT. WAVFRST1.256
C WAVFRST1.257
C *IMPLSCH* - IMPLICIT SCHEME FOR INTEGRATION OF SOURCE WAVFRST1.258
C FUNCTIONS IN TIME AND INPUT OF WINDS. WAVFRST1.259
CREFRA WAVFRST1.260
C *INTPOL* - MAP SPECTRUM FROM SIGMA TO OMEGA SPACE. WAVFRST1.261
CREFRA WAVFRST1.262
CSHALLOW WAVFRST1.263
C *SBOTTOM* - COMPUTES BOTTOM DISSIPATION SOURCE TERM AND WAVFRST1.264
C LINEAR CONTRIBUTION TO FUNCTIONAL MATRIX. WAVFRST1.265
CSHALLOW WAVFRST1.266
C *SDISSIP* - COMPUTATION OF DISSIPATION SOURCE FUNCTION WAVFRST1.267
C AND LINEAR CONTRIBUTION OF DISSIPATION TO WAVFRST1.268
C FUNCTIONAL MATRIX IN IMPLICIT SCHEME. WAVFRST1.269
C *SEMEAN* - COMPUTATION OF TOTAL ENERGY AT EACH GRID POINT. WAVFRST1.270
C WAVFRST1.271
C *SINPUT* - COMPUTATION OF INPUT SOURCE FUNCTION, AND WAVFRST1.272
C LINEAR CONTRIBUTION OF INPUT SOURCE FUNCTION WAVFRST1.273
C TO FUNCTIONAL MATRIX IN IMPLICIT SCHEME. WAVFRST1.274
C *SNONLIN* - COMPUTATION OF NONLINEAR TRANSFER RATE AND WAVFRST1.275
C DIAGONAL LINEAR CONTRIBUTION OF NONLINEAR SOURCE WAVFRST1.276
C FUNCTION TO FUNCTIONAL MATRIX. WAVFRST1.277
C WAVFRST1.278
C *STRESSO* - COMPUTATION OF WAVE STRESS. WAVFRST1.279
C WAVFRST1.280
C REFERENCE. WAVFRST1.281
C ---------- WAVFRST1.282
C WAVFRST1.283
C SNYDER, R.L., F.W. DOBSON, J.A. ELLIOT, AND R.B. LONG: WAVFRST1.284
C ARRAY MEASUREMENTS OF ATMOSPHERIC PRESSURE FLUCTUATIONS WAVFRST1.285
C ABOVE SURFACE GRAVITY WAVES. J.FLUID MECH. 102, 1-59 ,1981. WAVFRST1.286
C G. KOMEN, S. HASSELMANN, K. HASSELMANN: WAVFRST1.287
C ON THE EXISTENCE OF A FULLY DEVELOPED WIND SEA SPECTRUM. WAVFRST1.288
C JPO,1984. WAVFRST1.289
C S. HASSELMANN, K. HASSELMANN, J.H. ALLENDER, T.P. BARNETT: WAVFRST1.290
C IMPROVED METHODS OF COMPUTING AND PARAMETERIZING THE WAVFRST1.291
C NONLINEAR ENERGY TRANSFER IN A GRAVITY WAVE SPECTRUM. WAVFRST1.292
C JPO, 1985. WAVFRST1.293
C S. HASSELMANN, K. HASSELMANN: A GLOBAL WAVE MODEL, WAVFRST1.294
C WAM REPORT,JUNE,30/1985. WAVFRST1.295
C P. JANSSEN, G. KOMEN: A SHALLOW WATER EXTENSION OF THE WAVFRST1.296
C 3-G WAM-MODEL. WAM REPORT 1985. WAVFRST1.297
C THE WAMDI GROUP: THE WAM MODEL - A THIRD GENERATION OCEAN WAVFRST1.298
C WAVE PREDICTION MODEL. JPO, VOL. 18, NO. 12, 1988. WAVFRST1.299
C P.A.E.M JANSSEN: JPO, 1989 AND 1991. WAVFRST1.300
C K. HASSELMANN: TRANSPORT EQUATION OF FINITE DEPTH SURFACE WAVFRST1.301
C WAVE SPECTRUM IN TIME DPENDANT CURRENT AND DEPTH FIELD USING WAVFRST1.302
C NONCANONICAL SPACIAL (SPHERICAL) AND WAVE NUMBER (FRQUENCY- WAVFRST1.303
C DIRECTION) COORDINATES. WAM REPROT 1988. WAVFRST1.304
C WAVFRST1.305
C ---------------------------------------------------------------------- WAVFRST1.306
iu06=6 WAVFRST1.307
WAVFRST1.308
c note required to add the time controls here previously done within WAVFRST1.309
c implsch - need do over ratio idelpro to idelt. WAVFRST1.310
c WAVFRST1.311
c eg idelpro=1200 idelt=1200 says n_srce-step = 1 WAVFRST1.312
c idelpro=3600 idelt=1200 says n-srce-step = 3 WAVFRST1.313
c WAVFRST1.314
n_srce_step=int(idelpro/idelt) WAVFRST1.315
WAVFRST1.316
WAVFRST1.317
C WAVFRST1.318
C* 1.5 LOOP FOR BLOCKS OF LATITUDES. WAVFRST1.319
C ----------------------------- WAVFRST1.320
C WAVFRST1.321
if(igl.gt.1) then ! fill array of overlap energies WAVFRST1.322
nstart_ov=1 WAVFRST1.323
do ig=1,igl WAVFRST1.324
WAVFRST1.325
nend_blok=nstart_ov + ijlt(ig) -1 WAVFRST1.326
nst_ov=nend_blok - (ijlt(ig)-ijls(ig)) WAVFRST1.327
WAVFRST1.328
do m=1,nfre WAVFRST1.329
do k=1,nang WAVFRST1.330
ifill=1 WAVFRST1.331
c fill from only the first row of each block. WAVFRST1.332
do ip=nst_ov,nst_ov+ijl(ig)-ijls(ig) WAVFRST1.333
over(ifill,k,m,ig)=energy(ip,k,m) WAVFRST1.334
ifill=ifill+1 WAVFRST1.335
enddo WAVFRST1.336
enddo WAVFRST1.337
enddo WAVFRST1.338
nstart_ov=nst_ov WAVFRST1.339
enddo WAVFRST1.340
endif WAVFRST1.341
WAVFRST1.342
c initialise index for extracting blocked data from energy array WAVFRST1.343
c WAVFRST1.344
nstart=1 WAVFRST1.345
WAVFRST1.346
DO 1500 IG=1,IGL WAVFRST1.347
C WAVFRST1.348
C* 1.5.2 INPUT NEIGHBOURING GRID POINT INDICES (COMMON BLOCK UBUF). WAVFRST1.349
C ---------------------------------------------------------- WAVFRST1.350
CSHALLOW WAVFRST1.351
C WAVFRST1.352
C* 1.5.3 COMPUTE SHALLOW WATER TABLE INDICES. WAVFRST1.353
C ------------------------------------ WAVFRST1.354
C calculate indep for the present block WAVFRST1.355
c WAVFRST1.356
IF (ISHALLO.NE.1) THEN WAVFRST1.357
DO 1530 IJ=1,IJLT(IG) WAVFRST1.358
XD = LOG(DEPTH(IJ,IG)/DEPTHA)/LOG(DEPTHD)+1. WAVFRST1.359
ID = NINT(XD) WAVFRST1.360
ID = MAX(ID,1) WAVFRST1.361
INDEP(IJ) = MIN(ID,NDEPTH) WAVFRST1.362
1530 CONTINUE WAVFRST1.363
ENDIF WAVFRST1.364
CSHALLOW WAVFRST1.365
C WAVFRST1.366
C WAVFRST1.367
C* 1.5.4 COUPLING WITH NEIGHBOURING BLOCKS IG +- 1 AND START WAVFRST1.368
C* INPUT OF SPECTRA FOR BLOCK IG+1. WAVFRST1.369
C ---------------------------------------------------- WAVFRST1.370
c here fill fl1 for this block; no need to use fl2 - WAVFRST1.371
c select data from appropriate part of array 'energy' WAVFRST1.372
c FL1 requires data from 1 to ijlt in each block. WAVFRST1.373
c WAVFRST1.374
c the wam routines fillbl splitbl add on / take off WAVFRST1.375
c the overlapping rows - indexed by ijs ijl relative to WAVFRST1.376
c start of each block WAVFRST1.377
c WAVFRST1.378
CCC note if not calling propags then fill fl3 here: WAVFRST1.379
C WAVFRST1.380
c set index for end of present block on data grid WAVFRST1.381
c WAVFRST1.382
nend=nstart + ijlt(ig)-1 WAVFRST1.383
WAVFRST1.384
do l=1,nfre WAVFRST1.385
do k=1,nang WAVFRST1.386
WAVFRST1.387
do ip=1,niblo WAVFRST1.388
fl1(ip,k,l)=0. WAVFRST1.389
enddo WAVFRST1.390
WAVFRST1.391
ifill=1 WAVFRST1.392
do ip=nstart,nend WAVFRST1.393
fl1(ifill,k,l)=energy(ip,k,l) WAVFRST1.394
ifill=ifill+1 WAVFRST1.395
enddo WAVFRST1.396
enddo WAVFRST1.397
enddo WAVFRST1.398
WAVFRST1.399
c if block number greater than one then copy overlap of WAVFRST1.400
c first row values at time t. WAVFRST1.401
WAVFRST1.402
if(ig.gt.1) then WAVFRST1.403
do m=1,nfre WAVFRST1.404
do k=1,nang WAVFRST1.405
do ip=1,ijs(ig)-1 WAVFRST1.406
FL1(ip,k,m)=over(ip,k,m,ig) WAVFRST1.407
enddo WAVFRST1.408
enddo WAVFRST1.409
enddo WAVFRST1.410
endif WAVFRST1.411
WAVFRST1.412
C* 1.5.5 COMPUTATION OF PROPAGATION. WAVFRST1.413
C --------------------------- WAVFRST1.414
WAVFRST1.415
CALL PROPAGS(FL1, FL3, IG, irefra, ishallo, idelpro, WAVFRST1.416
*CALL ARGWVAL WAVFRST1.417
*CALL ARGWVFD WAVFRST1.418
*CALL ARGWVGD WAVFRST1.419
*CALL ARGWVMP WAVFRST1.420
*CALL ARGWVRF WAVFRST1.421
*CALL ARGWVSH WAVFRST1.422
*CALL ARGWVCU WAVFRST1.423
*CALL ARGWVKL WAVFRST1.424
*CALL ARGWVP2 WAVFRST1.425
& icode) WAVFRST1.426
WAVFRST1.427
WAVFRST1.428
WAVFRST1.429
C* 1.5.6 INTEGRATION OF SOURCE TERMS OVER SUB TIME STEPS BETWEEN WAVFRST1.430
C* PROPAGATION TIME STEPS. WAVFRST1.431
C ------------------------------------------------------- WAVFRST1.432
C WAVFRST1.433
do istep=1,n_srce_step WAVFRST1.434
WAVFRST1.435
CALL IMPLSCH (FL3, FL1, IJS(IG), IJL(IG), WAVFRST1.436
& IG, IGL, ishallo,idelt, WAVFRST1.437
*CALL ARGWVAL WAVFRST1.438
*CALL ARGWVFD WAVFRST1.439
*CALL ARGWVMN WAVFRST1.440
*CALL ARGWVSR WAVFRST1.441
*CALL ARGWVWD WAVFRST1.442
*CALL ARGWVSH WAVFRST1.443
*CALL ARGWVCP WAVFRST1.444
*CALL ARGWVTB WAVFRST1.445
*CALL ARGWVNL WAVFRST1.446
*CALL ARGWVS2 WAVFRST1.447
& icode) WAVFRST1.448
WAVFRST1.449
WAVFRST1.450
enddo WAVFRST1.451
WAVFRST1.452
CNEST WAVFRST1.453
C WAVFRST1.454
C original code in implsch here extracted coarse mesh boundary outputs WAVFRST1.455
c and inserted fine mesh boundary inputs. This is best done at the top WAVFRST1.456
c level. code has been removed from here. ALSO will expect to use UM WAVFRST1.457
c routines that are available in preference to WAM supplied routines WAVFRST1.458
C WAVFRST1.459
CNEST WAVFRST1.460
C WAVFRST1.461
C copy the energy for time t+dt back to main array. WAVFRST1.462
c WAVFRST1.463
c Both propags and implsch only work on points ijs to ijl WAVFRST1.464
c within each block. but propags accesses rows up to IJLT WAVFRST1.465
c using indices in klat / klon. WAVFRST1.466
c WAVFRST1.467
c ALSO note that array FL3 is the output from IMPLSCH with WAVFRST1.468
c values at t+dt WAVFRST1.469
c WAVFRST1.470
n11=nstart -1 +ijs(ig) WAVFRST1.471
n22=nstart -1 +ijl(ig) WAVFRST1.472
WAVFRST1.473
do l=1,nfre WAVFRST1.474
do k=1,nang WAVFRST1.475
c WAVFRST1.476
cc pick out from point ijs in the block not from point 1 WAVFRST1.477
c WAVFRST1.478
ifill=0 WAVFRST1.479
do ip=n11,n22 WAVFRST1.480
energy(ip,k,l)=FL3(ifill+ijs(ig),k,l) WAVFRST1.481
ifill=ifill+1 WAVFRST1.482
enddo WAVFRST1.483
enddo WAVFRST1.484
enddo WAVFRST1.485
WAVFRST1.486
WAVFRST1.487
c WAVFRST1.488
c copy blocks of diagnostics into full array WAVFRST1.489
c WAVFRST1.490
WAVFRST1.491
if(len_s2.eq.niblo*nang*nfre.and. WAVFRST1.492
& len_sd.eq.mdata*nang*nfre) then WAVFRST1.493
c WAVFRST1.494
c set istart to account for blocks already copied WAVFRST1.495
c WAVFRST1.496
istart=0 WAVFRST1.497
if(ig.gt.1) then WAVFRST1.498
do ii=1,ig-1 WAVFRST1.499
istart=istart + ijl(ii) - ijs(ii)+1 WAVFRST1.500
enddo WAVFRST1.501
endif WAVFRST1.502
WAVFRST1.503
do l=1,nfre WAVFRST1.504
do m=1,nang WAVFRST1.505
WAVFRST1.506
nstar1=((l-1)*nang + m-1)*mdata + istart - ijs(ig) +1 WAVFRST1.507
nstar2=((l-1)*nang + m-1)*niblo WAVFRST1.508
WAVFRST1.509
do ip=ijs(ig),ijl(ig) WAVFRST1.510
if(nstar2+ip.gt.len_s2)then WAVFRST1.511
WRITE(6,*)'error in nstar2 values:',len_s2,nstar2+ip GIE0F403.680
icode=99 WAVFRST1.513
cmessage='WAV_FOR_STEP error in nstar2' WAVFRST1.514
return WAVFRST1.515
endif WAVFRST1.516
if(nstar1+ip.gt.len_sd)then WAVFRST1.517
WRITE(6,*)'error in nstar1 values:',len_sd,nstar1+ip GIE0F403.681
icode=99 WAVFRST1.519
cmessage='WAV_FOR_STEP error in nstar1' WAVFRST1.520
return WAVFRST1.521
endif WAVFRST1.522
sinp(nstar1+ip) = sin2(nstar2+ip) WAVFRST1.523
snl(nstar1+ip) = snl2(nstar2+ip) WAVFRST1.524
sds(nstar1+ip) = sds2(nstar2+ip) WAVFRST1.525
sbf(nstar1+ip) = sbf2(nstar2+ip) WAVFRST1.526
stl(nstar1+ip) = stl2(nstar2+ip) WAVFRST1.527
sadv(nstar1+ip)= sadv2(nstar2+ip) WAVFRST1.528
enddo WAVFRST1.529
WAVFRST1.530
enddo WAVFRST1.531
enddo WAVFRST1.532
endif WAVFRST1.533
WAVFRST1.534
C* BRANCHING BACK TO 1.5 FOR NEXT BLOCK OF LATITUDES WAVFRST1.535
C WAVFRST1.536
C update nstart for next block: WAVFRST1.537
c WAVFRST1.538
nstart = nend - (ijlt(ig)-ijls(ig)) WAVFRST1.539
c WAVFRST1.540
WAVFRST1.541
1500 CONTINUE WAVFRST1.542
C WAVFRST1.543
RETURN WAVFRST1.544
END WAVFRST1.545
*ENDIF WAVFRST1.546