SUBROUTINE DUCT 2,15DUCT1A.42
1 (PSTAR,TSTAR,THETA,Q,U,V,AK,BK,AKH,BKH,LAND, DUCT1A.43
3 DUCT_HEIGHT,MAX_WAVELENGTH,P_EXNER_HALF, DUCT1A.44
4 P_LEVELS,Q_LEVELS,ROW_LENGTH,P_ROWS,U_ROWS,P_FIELD,U_FIELD) DUCT1A.45
C----------------------------------------------------------------------- DUCT1A.46
IMPLICIT NONE DUCT1A.47
C----------------------------------------------------------------------- DUCT1A.48
*CALL C_R_CP 
DUCT1A.49
C This gives R,CP and KAPPA=R/CP DUCT1A.50
*CALL C_EPSLON DUCT1A.51
C This gives EPSILON DUCT1A.52
*CALL C_0_DG_C DUCT1A.53
C This gives ZERODEGC DUCT1A.54
*CALL C_MDI DUCT1A.55
C This gives RMDI and IMDI DUCT1A.56
C----------------------------------------------------------------------- DUCT1A.57
INTEGER DUCT1A.58
* P_LEVELS ! IN No of pressure levels DUCT1A.59
*, Q_LEVELS ! IN No of humidity levels DUCT1A.60
*, ROW_LENGTH ! IN No of points in row DUCT1A.61
*, P_ROWS ! IN No of rows in pressure grid DUCT1A.62
*, U_ROWS ! IN No of rows in (u,v) grid DUCT1A.63
*, P_FIELD ! IN No of points in pressure grid DUCT1A.64
*, U_FIELD ! IN No of points in (u,v) grid DUCT1A.65
C----------------------------------------------------------------------- DUCT1A.66
REAL DUCT1A.67
* PSTAR(P_FIELD) ! IN Pressure at the surface of the earth DUCT1A.68
*, TSTAR(P_FIELD) ! IN Temperature at the surface of the earth DUCT1A.69
*, THETA(P_FIELD,P_LEVELS)! IN Potential temperature DUCT1A.70
*, P_EXNER_HALF(P_FIELD,P_LEVELS+1)! IN Exner pressure at half levs DUCT1A.71
*, U(U_FIELD,P_LEVELS) ! IN Easterly component of wind DUCT1A.72
*, V(U_FIELD,P_LEVELS) ! IN Northerly component of wind DUCT1A.73
*, Q(P_FIELD,Q_LEVELS) ! IN Specific humidity DUCT1A.74
*, DUCT_HEIGHT(P_FIELD) ! OUT evaporation duct height in metres DUCT1A.75
*, MAX_WAVELENGTH(P_FIELD)! OUT Maximum wavelength propagated by DUCT1A.76
* ! duct (duct intensity) in metres DUCT1A.77
REAL DUCT1A.78
* AK(P_LEVELS) !IN Hybrid Coords. A and B values for DUCT1A.79
*, BK(P_LEVELS) !IN model full levels DUCT1A.80
*, AKH(P_LEVELS+1) !IN Hybrid Coords. A and B values for DUCT1A.81
*, BKH(P_LEVELS+1) !IN model half levels. DUCT1A.82
C----------------------------------------------------------------------- DUCT1A.83
LOGICAL DUCT1A.84
* LAND(P_FIELD) ! IN TRUE if land; FALSE if sea DUCT1A.85
C*---------------------------------------------------------------------- DUCT1A.86
C DUCT1A.87
C*L WORKSPACE USAGE----------------------------------------------------- DUCT1A.88
C*---------------------------------------------------------------------- DUCT1A.89
C DUCT1A.90
C*L EXTERNAL SUBROUTINES CALLED----------------------------------------- DUCT1A.91
EXTERNAL STRETCH,SMOOTH,LUBATT DUCT1A.92
C*---------------------------------------------------------------------- DUCT1A.93
C DUCT1A.94
C----------------------------------------------------------------------- DUCT1A.95
C LOCAL CONSTANTS DUCT1A.96
C----------------------------------------------------------------------- DUCT1A.97
REAL DUCT1A.98
* RT ! Used in the calculation of dew point DUCT1A.99
*, R_OVER_M ! gas constant/molecular weight of water DUCT1A.100
*, RLO ! latent heat of evaporation at 0 deg C DUCT1A.101
*, RLE ! rate of change of latent heat with temp at 0 deg C DUCT1A.102
PARAMETER(RT=3.66E-3, DUCT1A.103
& R_OVER_M=461.5, DUCT1A.104
& RLO=2.5E6, DUCT1A.105
& RLE=-2.73E3) DUCT1A.106
C----------------------------------------------------------------------- DUCT1A.107
C LOCAL VARIABLES DUCT1A.108
C----------------------------------------------------------------------- DUCT1A.109
INTEGER DUCT1A.110
* I ! Loop counter DUCT1A.111
*, I1,J ! Row number/position in row for WRITE statement DUCT1A.112
*, ROW_NO,COL_NO ! temporary DUCT1A.113
REAL DUCT1A.114
* P_ON_LVL_1 ! Pressure on level 1 DUCT1A.115
*, P1,P2 ! Pressure on half levels 1 and 2 DUCT1A.116
*, P_EXNER_FULL ! Exner pressure on full model level DUCT1A.117
*, T_ON_LVL_1 ! Temperature on level 1 DUCT1A.118
*, HUMIDITY ! Specific humidity on level 1 DUCT1A.119
*, VAPOUR_PRESSURE DUCT1A.120
*, R1 ! Latent heat of evaporation DUCT1A.121
*, R2 DUCT1A.122
*, T_DEW(P_FIELD) ! dew point temperature DUCT1A.123
*, T_DRY(P_FIELD) ! dry bulb temperature DUCT1A.124
*, WSPEED(P_FIELD) ! windspeed of points on theta grid DUCT1A.125
*, T_SEA(P_FIELD) ! sea surface temperature DUCT1A.126
*, SMOOTHED_T_SEA(P_FIELD) ! smoothed sea surface temperature DUCT1A.127
*, SMOOTHED_T_DEW(P_FIELD) ! smoothed dewpoint temperature DUCT1A.128
*, SMOOTHED_T_DRY(P_FIELD) ! smoothed dry bulb temperature DUCT1A.129
*, SMOOTHED_WSPEED(P_FIELD)! smoothed windspeed DUCT1A.130
*, TEMP(P_FIELD) DUCT1A.131
C DUCT1A.132
*IF DEF,MPP GPB1F403.1520
*CALL PARVARS GPB1F403.1521
*ENDIF GPB1F403.1522
*CALL P_EXNERC DUCT1A.133
DUCT1A.134
C--- Put temperature to degree C------------------------------------- DUCT1A.135
DO I=1,P_FIELD DUCT1A.136
TEMP(I)=TSTAR(I)-ZERODEGC DUCT1A.137
ENDDO DUCT1A.138
DO 444 I=1,P_FIELD DUCT1A.139
C----------------------------------------------------------------------- DUCT1A.140
CL 2. Calculate dew point temperature DUCT1A.141
C----------------------------------------------------------------------- DUCT1A.142
P_ON_LVL_1=AK(1)+BK(1)*PSTAR(I) DUCT1A.143
HUMIDITY=Q(I,1) ! Units KG/KG also press in Pascals DUCT1A.144
IF(HUMIDITY.LE.1.0E-3) HUMIDITY=1.0E-3 DUCT1A.145
VAPOUR_PRESSURE=(HUMIDITY*PSTAR(I)/100.)/(EPSILON+HUMIDITY) DUCT1A.146
VAPOUR_PRESSURE=VAPOUR_PRESSURE/6.11 DUCT1A.147
P1 = AKH(1) + BKH(1)*PSTAR(I) DUCT1A.148
P2 = AKH(2) + BKH(2)*PSTAR(I) DUCT1A.149
P_EXNER_FULL = P_EXNER_C DUCT1A.150
+ (P_EXNER_HALF(I,2),P_EXNER_HALF(I,1),P2,P1,KAPPA) DUCT1A.151
T_ON_LVL_1 = THETA(I,1) * P_EXNER_FULL DUCT1A.152
R1=RLO+RLE*(T_ON_LVL_1-ZERODEGC) ! Latent heat for new temp DUCT1A.153
R2=RT-LOG(VAPOUR_PRESSURE)*R_OVER_M/R1 DUCT1A.154
T_DEW(I)=1.0/R2 DUCT1A.155
C----------------------------------------------------------------------- DUCT1A.156
CL 3. Store dry bulb temperature DUCT1A.157
C----------------------------------------------------------------------- DUCT1A.158
T_DRY(I)=T_ON_LVL_1 DUCT1A.159
444 CONTINUE DUCT1A.160
C----------------------------------------------------------------------- DUCT1A.161
CL 4. Calculate wind speed DUCT1A.162
C----------------------------------------------------------------------- DUCT1A.163
DO I=1,U_FIELD DUCT1A.164
TEMP(I)=SQRT(U(I,1)*U(I,1)+V(I,1)*V(I,1)) DUCT1A.165
ENDDO DUCT1A.166
CALL UV_TO_P_FULL(TEMP,WSPEED,U_FIELD,P_FIELD,ROW_LENGTH,P_ROWS) DUCT1A.167
C----------------------------------------------------------------------- DUCT1A.168
CL 5. Calculate sea surface temperature DUCT1A.169
C----------------------------------------------------------------------- DUCT1A.170
CALL STRETCH(TSTAR,T_SEA,LAND,ROW_LENGTH,P_ROWS,P_FIELD) DUCT1A.171
C----------------------------------------------------------------------- DUCT1A.172
C----------------------------------------------------------------------- DUCT1A.173
CL 6. Smooth sea surface temp, dry bulb temp, dew point temp and DUCT1A.174
CL wind speed fields DUCT1A.175
C----------------------------------------------------------------------- DUCT1A.176
*IF DEF,MPP GPB1F403.1523
CALL SWAPBOUNDS(T_SEA,ROW_LENGTH,P_ROWS,Offx,Offy,1) GPB1F403.1524
CALL SWAPBOUNDS(T_DRY,ROW_LENGTH,P_ROWS,Offx,Offy,1) GPB1F403.1525
CALL SWAPBOUNDS(T_DEW,ROW_LENGTH,P_ROWS,Offx,Offy,1) GPB1F403.1526
CALL SWAPBOUNDS(WSPEED,ROW_LENGTH,P_ROWS,Offx,Offy,1) GPB1F403.1527
*ENDIF GPB1F403.1528
WRITE(6,1011) DUCT1A.177
1011 FORMAT(' Successfully reached the start of subroutine SMOOTH') DUCT1A.178
CALL SMOOTH(T_SEA,SMOOTHED_T_SEA,ROW_LENGTH,P_ROWS,P_FIELD) DUCT1A.179
CALL SMOOTH(T_DRY,SMOOTHED_T_DRY,ROW_LENGTH,P_ROWS,P_FIELD) DUCT1A.180
CALL SMOOTH(T_DEW,SMOOTHED_T_DEW,ROW_LENGTH,P_ROWS,P_FIELD) DUCT1A.181
CALL SMOOTH(WSPEED,SMOOTHED_WSPEED,ROW_LENGTH,P_ROWS,P_FIELD) DUCT1A.182
*IF DEF,MPP GPB1F403.1529
! Ensure all smoothed variables have halos filled. GPB1F403.1530
GPB1F403.1531
CALL SWAPBOUNDS(SMOOTHED_T_SEA,ROW_LENGTH,P_ROWS,Offx,Offy,1) GPB1F403.1532
CALL SWAPBOUNDS(SMOOTHED_T_DRY,ROW_LENGTH,P_ROWS,Offx,Offy,1) GPB1F403.1533
CALL SWAPBOUNDS(SMOOTHED_T_DEW,ROW_LENGTH,P_ROWS,Offx,Offy,1) GPB1F403.1534
CALL SWAPBOUNDS(SMOOTHED_WSPEED,ROW_LENGTH,P_ROWS,Offx,Offy,1) GPB1F403.1535
*ENDIF GPB1F403.1536
GPB1F403.1537
C----------------------------------------------------------------------- DUCT1A.183
CL 7. Calculate DUCT height using smoothed parameters. DUCT1A.184
CL Set DUCT height missing over land. DUCT1A.185
C----------------------------------------------------------------------- DUCT1A.186
DO 460 I=1,P_FIELD DUCT1A.187
IF (LAND(I)) THEN DUCT1A.188
DUCT_HEIGHT(I)=RMDI DUCT1A.189
C DUCT_HEIGHT(I)=0. DUCT1A.190
MAX_WAVELENGTH(I)=RMDI DUCT1A.191
C MAX_WAVELENGTH(I)=0. DUCT1A.192
ELSE DUCT1A.193
CALL LUBATT(SMOOTHED_WSPEED(I),SMOOTHED_T_DRY(I)-ZERODEGC, DUCT1A.194
& SMOOTHED_T_SEA(I)-ZERODEGC,SMOOTHED_T_DEW(I)-ZERODEGC, DUCT1A.195
& DUCT_HEIGHT(I),MAX_WAVELENGTH(I)) DUCT1A.196
J=MOD(I,ROW_LENGTH) DUCT1A.197
I1=(I-J)/ROW_LENGTH+1 DUCT1A.198
ENDIF DUCT1A.199
460 CONTINUE DUCT1A.200
RETURN DUCT1A.201
END DUCT1A.202
C----------------------------------------------------------------------- DUCT1A.203
C*L ARGUMENTS:---------------------------------------------------------- DUCT1A.204
SUBROUTINE STRETCH 1,2DUCT1A.205
& (TSTAR,T_SEA,LAND,ROW_LENGTH,P_ROWS,P_FIELD) DUCT1A.206
C----------------------------------------------------------------------- DUCT1A.207
IMPLICIT NONE DUCT1A.208
C----------------------------------------------------------------------- DUCT1A.209
INTEGER DUCT1A.210
* ROW_LENGTH ! IN No of columns of longitude DUCT1A.211
*, P_ROWS ! IN No of rows of latitude DUCT1A.212
*, P_FIELD ! IN No of points in pressure grid DUCT1A.213
C----------------------------------------------------------------------- DUCT1A.214
REAL DUCT1A.215
* TSTAR(P_FIELD) ! IN Temperature at the surface of the earth DUCT1A.216
*, T_SEA(P_FIELD) ! OUT Sea temperature over open ocean DUCT1A.217
C----------------------------------------------------------------------- DUCT1A.218
LOGICAL DUCT1A.219
* LAND(P_FIELD) ! IN TRUE if land; FALSE if sea DUCT1A.220
C*---------------------------------------------------------------------- DUCT1A.221
C DUCT1A.222
C*L WORKSPACE USAGE----------------------------------------------------- DUCT1A.223
*IF DEF,MPP GPB1F403.1538
! Copies of input arrays but with extra large EW halos to allow the GPB1F403.1539
! fourth order "stretching" operation GPB1F403.1540
GPB1F403.1541
REAL TSTAR_COPY((ROW_LENGTH+2)*P_ROWS) GPB1F403.1542
LOGICAL LAND_COPY((ROW_LENGTH+2)*P_ROWS) GPB1F403.1543
GPB1F403.1544
*ENDIF GPB1F403.1545
C*---------------------------------------------------------------------- DUCT1A.224
C DUCT1A.225
C*L EXTERNAL SUBROUTINES CALLED----------------------------------------- DUCT1A.226
C NONE DUCT1A.227
C*---------------------------------------------------------------------- DUCT1A.228
C DUCT1A.229
*IF DEF,MPP GPB1F403.1546
*CALL PARVARS GPB1F403.1547
*ENDIF GPB1F403.1548
C----------------------------------------------------------------------- DUCT1A.230
C LOCAL VARIABLES DUCT1A.231
C----------------------------------------------------------------------- DUCT1A.232
INTEGER DUCT1A.233
* I,J ! Loop counters DUCT1A.234
&, point_src,point_set ! points of source data and to be set GPB1F403.1549
&, offset ! distance of POINT_SET from POINT_SRC GPB1F403.1550
&, max_off ! maximum distance allowed from POINT_SRC GPB1F403.1551
GPB1F403.1552
LOGICAL GPB1F403.1553
& end GPB1F403.1554
GPB1F403.1555
*IF DEF,MPP GPB1F403.1556
INTEGER GPB1F403.1557
& extended_ROW_LENGTH GPB1F403.1558
&, extended_P_FIELD GPB1F403.1559
&, extended_point_src GPB1F403.1560
&, extended_J GPB1F403.1561
GPB1F403.1562
*ENDIF GPB1F403.1563
GPB1F403.1564
max_off=2 ! Go up to two points to look for a value to use GPB1F403.1565
GPB1F403.1566
*IF DEF,MPP GPB1F403.1567
! Copy input arrays into _COPY arrays which contain larger EW halos GPB1F403.1568
GPB1F403.1569
extended_ROW_LENGTH=ROW_LENGTH+2 GPB1F403.1570
extended_P_FIELD=extended_ROW_LENGTH*P_ROWS GPB1F403.1571
GPB1F403.1572
CALL COPY_FIELD(TSTAR,TSTAR_COPY, GPB1F403.1573
& P_FIELD,extended_P_FIELD, GPB1F403.1574
& ROW_LENGTH,P_ROWS,1, GPB1F403.1575
& Offx,Offy, GPB1F403.1576
& 2,Offy,.TRUE.) GPB1F403.1577
GPB1F403.1578
CALL COPY_FIELD(LAND,LAND_COPY, GPB1F403.1579
& P_FIELD,extended_P_FIELD, GPB1F403.1580
& ROW_LENGTH,P_ROWS,1, GPB1F403.1581
& Offx,Offy, GPB1F403.1582
& 2,Offy,.TRUE.) GPB1F403.1583
GPB1F403.1584
*ENDIF GPB1F403.1585
GPB1F403.1586
*IF -DEF,MPP GPB1F403.1587
DO I=1,P_ROWS GPB1F403.1588
GPB1F403.1589
DO J=1,ROW_LENGTH GPB1F403.1590
*ELSE GPB1F403.1591
DO I=1+Offy,P_ROWS-Offy ! miss halos GPB1F403.1592
GPB1F403.1593
DO J=1+Offx,ROW_LENGTH-Offx ! miss halos GPB1F403.1594
GPB1F403.1595
extended_J=J+1 GPB1F403.1596
*ENDIF GPB1F403.1597
GPB1F403.1598
! Transfer sea temperatures 1 or 2 grid lengths westward onto GPB1F403.1599
! land points GPB1F403.1600
GPB1F403.1601
offset=0 GPB1F403.1602
end=.FALSE. GPB1F403.1603
GPB1F403.1604
point_set=(I-1)*ROW_LENGTH+J GPB1F403.1605
GPB1F403.1606
*IF DEF,GLOBAL GPB1F403.1607
DO WHILE ((offset .LE. max_off) .AND. (.NOT. end)) GPB1F403.1608
*ELSE GPB1F403.1609
DO WHILE (((offset .LE. max_off) .AND. (.NOT. end)) .AND. GPB1F403.1610
*IF -DEF,MPP GPB1F403.1611
& (J+offset .LE. ROW_LENGTH)) GPB1F403.1612
*ELSE GPB1F403.1613
& .NOT. ((atright) .AND. GPB1F403.1614
& (extended_J+offset .LE. GPB1F403.1615
& extended_ROW_LENGTH-max_off))) GPB1F403.1616
*ENDIF GPB1F403.1617
*ENDIF GPB1F403.1618
GPB1F403.1619
*IF -DEF,MPP GPB1F403.1620
point_src=(I-1)*ROW_LENGTH+ GPB1F403.1621
& MOD(J+offset-1,ROW_LENGTH)+1 GPB1F403.1622
*ELSE GPB1F403.1623
point_src=(I-1)*extended_ROW_LENGTH+ GPB1F403.1624
& MOD(extended_J+offset-1,extended_ROW_LENGTH)+1 GPB1F403.1625
*ENDIF GPB1F403.1626
GPB1F403.1627
*IF -DEF,MPP GPB1F403.1628
IF (.NOT. LAND(point_src)) THEN GPB1F403.1629
T_SEA(point_set)=TSTAR(point_src) GPB1F403.1630
*ELSE GPB1F403.1631
IF (.NOT. LAND_COPY(point_src)) THEN GPB1F403.1632
T_SEA(point_set)=TSTAR_COPY(point_src) GPB1F403.1633
*ENDIF GPB1F403.1634
end=.TRUE. GPB1F403.1635
ENDIF GPB1F403.1636
GPB1F403.1637
offset=offset+1 GPB1F403.1638
GPB1F403.1639
ENDDO GPB1F403.1640
GPB1F403.1641
IF (.NOT. end) THEN GPB1F403.1642
T_SEA(point_set)=TSTAR(point_set) GPB1F403.1643
ENDIF GPB1F403.1644
GPB1F403.1645
! Transfer sea temperatures 1 or 2 grid lengths eastwars onto GPB1F403.1646
! land points GPB1F403.1647
GPB1F403.1648
*IF DEF,GLOBAL GPB1F403.1649
IF (LAND(point_set)) THEN GPB1F403.1650
*ELSE GPB1F403.1651
*IF -DEF,MPP GPB1F403.1652
IF (LAND(point_set) .AND. (J .NE. 1)) THEN GPB1F403.1653
*ELSE GPB1F403.1654
IF (LAND(point_set) .AND. GPB1F403.1655
& .NOT.(atleft .AND. extended_J .EQ. max_off+1)) THEN GPB1F403.1656
*ENDIF GPB1F403.1657
*ENDIF GPB1F403.1658
GPB1F403.1659
offset=0 GPB1F403.1660
end=.FALSE. GPB1F403.1661
GPB1F403.1662
*IF DEF,GLOBAL GPB1F403.1663
DO WHILE ((offset .LE. max_off) .AND. (.NOT. end)) GPB1F403.1664
*ELSE GPB1F403.1665
*IF -DEF,MPP GPB1F403.1666
DO WHILE ((offset .LE. max_off) .AND. (.NOT. end) .AND. GPB1F403.1667
& (J-offset .GE. 1)) GPB1F403.1668
*ELSE GPB1F403.1669
DO WHILE (((offset .LE. max_off) .AND. (.NOT. end)) .AND. GPB1F403.1670
& .NOT.(atleft .AND. GPB1F403.1671
& (extended_J-offset .GE. max_off+1))) GPB1F403.1672
*ENDIF GPB1F403.1673
*ENDIF GPB1F403.1674
GPB1F403.1675
GPB1F403.1676
*IF -DEF,MPP GPB1F403.1677
point_src=(I-1)*ROW_LENGTH+ GPB1F403.1678
& MOD(J-offset+ROW_LENGTH-1,ROW_LENGTH)+1 GPB1F403.1679
*ELSE GPB1F403.1680
point_src=(I-1)*extended_ROW_LENGTH+ GPB1F403.1681
& MOD(extended_J-offset+extended_ROW_LENGTH-1, GPB1F403.1682
& extended_ROW_LENGTH)+1 GPB1F403.1683
*ENDIF GPB1F403.1684
GPB1F403.1685
*IF -DEF,MPP GPB1F403.1686
IF (.NOT. (LAND(point_src))) THEN GPB1F403.1687
T_SEA(point_set)=TSTAR(point_src) GPB1F403.1688
*ELSE GPB1F403.1689
IF (.NOT. (LAND_COPY(point_src))) THEN GPB1F403.1690
T_SEA(point_set)=TSTAR_COPY(point_src) GPB1F403.1691
*ENDIF GPB1F403.1692
end=.TRUE. GPB1F403.1693
ENDIF GPB1F403.1694
GPB1F403.1695
offset=offset+1 GPB1F403.1696
GPB1F403.1697
ENDDO GPB1F403.1698
GPB1F403.1699
ENDIF GPB1F403.1700
GPB1F403.1701
ENDDO ! J : loop along row GPB1F403.1702
GPB1F403.1703
ENDDO ! I : loop over rows GPB1F403.1704
RETURN DUCT1A.334
END DUCT1A.335
C----------------------------------------------------------------------- DUCT1A.336
C DUCT1A.337
C DUCT1A.338
C*L ARGUMENTS:---------------------------------------------------------- DUCT1A.339
SUBROUTINE SMOOTH 4DUCT1A.340
& (A,ABAR,ROW_LENGTH,P_ROWS,P_FIELD) DUCT1A.341
C----------------------------------------------------------------------- DUCT1A.342
IMPLICIT NONE DUCT1A.343
C----------------------------------------------------------------------- DUCT1A.344
INTEGER DUCT1A.345
* ROW_LENGTH ! IN No of points in a row DUCT1A.346
*, P_ROWS ! IN No of rows of theta grid DUCT1A.347
*, P_FIELD ! IN No of points in pressure field DUCT1A.348
C----------------------------------------------------------------------- DUCT1A.349
REAL DUCT1A.350
* A(P_FIELD) ! IN Array to be smoothed DUCT1A.351
*, ABAR(P_FIELD) ! OUT Smoothed array DUCT1A.352
C*---------------------------------------------------------------------- DUCT1A.353
C DUCT1A.354
C*L WORKSPACE USAGE----------------------------------------------------- DUCT1A.355
C*---------------------------------------------------------------------- DUCT1A.356
C DUCT1A.357
C*L EXTERNAL SUBROUTINES CALLED----------------------------------------- DUCT1A.358
C NONE DUCT1A.359
C*---------------------------------------------------------------------- DUCT1A.360
C DUCT1A.361
C----------------------------------------------------------------------- DUCT1A.362
C LOCAL VARIABLES DUCT1A.363
C----------------------------------------------------------------------- DUCT1A.364
INTEGER DUCT1A.365
* IW1,IW2,IW3,IW4,IW5,IW6 ! Weight constants DUCT1A.366
*, I,J ! Loop counters DUCT1A.367
*, POINT ! Point being smoothed DUCT1A.368
*IF DEF,MPP GPB1F403.1705
INTEGER I_start,I_end GPB1F403.1706
GPB1F403.1707
*CALL PARVARS GPB1F403.1708
*ENDIF GPB1F403.1709
C----------------------------------------------------------------------- DUCT1A.369
CL 1. Set weight constants DUCT1A.370
C----------------------------------------------------------------------- DUCT1A.371
IW1=1 DUCT1A.372
IW2=2 DUCT1A.373
IW3=8 DUCT1A.374
IW4=IW3+4*IW2+4*IW1 DUCT1A.375
C----------------------------------------------------------------------- DUCT1A.376
CL 2. Smooth interior points of grid DUCT1A.377
C----------------------------------------------------------------------- DUCT1A.378
*IF -DEF,MPP GPB1F403.1710
DO 300 I=2,P_ROWS-1 GPB1F403.1711
*ELSE GPB1F403.1712
IF (attop) THEN GPB1F403.1713
I_start=Offy+2 GPB1F403.1714
ELSE GPB1F403.1715
I_start=Offy+1 GPB1F403.1716
ENDIF GPB1F403.1717
IF (atbase) THEN GPB1F403.1718
I_end=P_ROWS-Offy-1 GPB1F403.1719
ELSE GPB1F403.1720
I_end=P_ROWS-Offy GPB1F403.1721
ENDIF GPB1F403.1722
GPB1F403.1723
DO 300 I=I_start,I_end GPB1F403.1724
*ENDIF GPB1F403.1725
DO 200 J=2,ROW_LENGTH-1 DUCT1A.380
POINT=(I-1)*ROW_LENGTH+J DUCT1A.381
ABAR(POINT)=(IW1*A(POINT-ROW_LENGTH-1)+IW2*A(POINT-ROW_LENGTH) DUCT1A.382
1 +IW1*A(POINT-ROW_LENGTH+1)+IW2*A(POINT-1)+IW3*A(POINT) DUCT1A.383
2 +IW2*A(POINT+1)+IW1*A(POINT+ROW_LENGTH-1) DUCT1A.384
3 +IW2*A(POINT+ROW_LENGTH)+IW1*A(POINT+ROW_LENGTH+1))/IW4 DUCT1A.385
200 CONTINUE DUCT1A.386
300 CONTINUE DUCT1A.387
C----------------------------------------------------------------------- DUCT1A.388
CL 3. Smooth top row (excluding the two end points) DUCT1A.389
C----------------------------------------------------------------------- DUCT1A.390
IW6=IW3+3*IW2+2*IW1 DUCT1A.391
*IF DEF,MPP GPB1F403.1726
IF (attop) THEN GPB1F403.1727
I=Offy+1 GPB1F403.1728
*ELSE GPB1F403.1729
I=1 GPB1F403.1730
*ENDIF GPB1F403.1731
DO 400 J=2,ROW_LENGTH-1 DUCT1A.393
POINT=(I-1)*ROW_LENGTH+J GPB1F403.1732
ABAR(POINT)=(IW2*A(POINT-1)+IW3*A(POINT)+IW2*A(POINT+1) DUCT1A.395
1 +IW1*A(POINT+ROW_LENGTH-1)+IW2*A(POINT+ROW_LENGTH) DUCT1A.396
2 +IW1*A(POINT+ROW_LENGTH+1))/IW6 DUCT1A.397
400 CONTINUE DUCT1A.398
*IF DEF,MPP GPB1F403.1733
ENDIF GPB1F403.1734
*ENDIF GPB1F403.1735
C----------------------------------------------------------------------- DUCT1A.399
CL 4. Smooth bottom row (excluding the two end points) DUCT1A.400
C----------------------------------------------------------------------- DUCT1A.401
*IF DEF,MPP GPB1F403.1736
IF (atbase) THEN GPB1F403.1737
I=P_ROWS-Offy GPB1F403.1738
*ELSE GPB1F403.1739
I=P_ROWS GPB1F403.1740
*ENDIF GPB1F403.1741
DO 500 J=2,ROW_LENGTH-1 DUCT1A.403
POINT=(I-1)*ROW_LENGTH+J DUCT1A.404
ABAR(POINT)=(IW1*A(POINT-ROW_LENGTH-1)+IW2*A(POINT-ROW_LENGTH) DUCT1A.405
1 +IW1*A(POINT-ROW_LENGTH+1)+IW2*A(POINT-1)+IW3*A(POINT) DUCT1A.406
2 +IW2*A(POINT+1))/IW6 DUCT1A.407
500 CONTINUE DUCT1A.408
*IF DEF,MPP GPB1F403.1742
ENDIF GPB1F403.1743
*ENDIF GPB1F403.1744
C----------------------------------------------------------------------- DUCT1A.409
CL 5. Smooth four corner grid points DUCT1A.410
C----------------------------------------------------------------------- DUCT1A.411
IW5=IW3+2*IW2+IW1 DUCT1A.412
*IF DEF,MPP GPB1F403.1745
IF (attop .AND. atleft) THEN GPB1F403.1746
POINT=Offy*ROW_LENGTH+Offx+1 GPB1F403.1747
*ELSE GPB1F403.1748
POINT=1 GPB1F403.1749
*ENDIF GPB1F403.1750
ABAR(POINT)=(IW3*A(POINT)+IW2*A(POINT+1)+IW2*A(POINT+ROW_LENGTH) DUCT1A.414
1 +IW1*A(POINT+ROW_LENGTH+1))/IW5 DUCT1A.415
*IF DEF,MPP GPB1F403.1751
ENDIF GPB1F403.1752
GPB1F403.1753
IF (attop .AND. atright) THEN GPB1F403.1754
POINT=(Offy+1)*ROW_LENGTH-Offx GPB1F403.1755
*ELSE GPB1F403.1756
POINT=ROW_LENGTH GPB1F403.1757
*ENDIF GPB1F403.1758
ABAR(POINT)=(IW2*A(POINT-1)+IW3*A(POINT) DUCT1A.417
1 +IW1*A(POINT+ROW_LENGTH-1)+IW2*A(POINT+ROW_LENGTH))/IW5 DUCT1A.418
*IF DEF,MPP GPB1F403.1759
ENDIF GPB1F403.1760
GPB1F403.1761
IF (atbase .AND. atleft) THEN GPB1F403.1762
POINT=(P_ROWS-Offy-1)*ROW_LENGTH+Offx+1 GPB1F403.1763
*ELSE GPB1F403.1764
POINT=(P_ROWS-1)*ROW_LENGTH+1 GPB1F403.1765
*ENDIF GPB1F403.1766
ABAR(POINT)=(IW2*A(POINT-ROW_LENGTH)+IW1*A(POINT-ROW_LENGTH+1) DUCT1A.420
1 +IW3*A(POINT)+IW2*A(POINT+1))/IW5 DUCT1A.421
*IF DEF,MPP GPB1F403.1767
ENDIF GPB1F403.1768
GPB1F403.1769
IF (atbase .AND. atright) THEN GPB1F403.1770
POINT=(P_ROWS-Offy)*ROW_LENGTH-Offx GPB1F403.1771
*ELSE GPB1F403.1772
POINT=P_ROWS*ROW_LENGTH GPB1F403.1773
*ENDIF GPB1F403.1774
ABAR(POINT)=(IW1*A(POINT-ROW_LENGTH-1)+IW2*A(POINT-ROW_LENGTH) DUCT1A.423
1 +IW2*A(POINT-1)+IW3*A(POINT))/IW5 DUCT1A.424
*IF DEF,MPP GPB1F403.1775
ENDIF GPB1F403.1776
*ENDIF GPB1F403.1777
C----------------------------------------------------------------------- DUCT1A.425
CL 6. Smooth left hand column DUCT1A.426
C----------------------------------------------------------------------- DUCT1A.427
*IF -DEF,MPP GPB1F403.1778
J=1 DUCT1A.428
DO 600 I=2,P_ROWS-1 DUCT1A.429
*ELSE GPB1F403.1779
IF (atleft) THEN GPB1F403.1780
GPB1F403.1781
J=Offx+1 GPB1F403.1782
IF (attop) THEN GPB1F403.1783
I_start=Offy+2 GPB1F403.1784
ELSE GPB1F403.1785
I_start=Offy+1 GPB1F403.1786
ENDIF GPB1F403.1787
GPB1F403.1788
IF (atbase) THEN GPB1F403.1789
I_end=P_ROWS-Offy-1 GPB1F403.1790
ELSE GPB1F403.1791
I_end=P_ROWS-Offy GPB1F403.1792
ENDIF GPB1F403.1793
GPB1F403.1794
DO 600 I=I_start,I_end GPB1F403.1795
*ENDIF GPB1F403.1796
POINT=(I-1)*ROW_LENGTH+J DUCT1A.430
C----------------------------------------------------------------------- DUCT1A.431
*IF -DEF,GLOBAL DUCT1A.432
C----------------------------------------------------------------------- DUCT1A.433
ABAR(POINT)=(IW2*A(POINT-ROW_LENGTH)+IW1*A(POINT-ROW_LENGTH+1) DUCT1A.434
1 +IW3*A(POINT)+IW2*A(POINT+1) DUCT1A.435
2 +IW2*A(POINT+ROW_LENGTH)+IW1*A(POINT+ROW_LENGTH+1))/IW6 DUCT1A.436
C----------------------------------------------------------------------- DUCT1A.437
*ENDIF DUCT1A.438
C DUCT1A.439
*IF DEF,GLOBAL,AND,-DEF,MPP GPB1F403.1797
C----------------------------------------------------------------------- DUCT1A.441
ABAR(POINT)=(IW1*A(POINT-1)+IW2*A(POINT-ROW_LENGTH) DUCT1A.442
1 +IW1*A(POINT-ROW_LENGTH+1)+IW2*A(POINT+ROW_LENGTH-1) DUCT1A.443
2 +IW3*A(POINT)+IW2*A(POINT+1)+IW1*A(POINT+2*ROW_LENGTH-1) DUCT1A.444
3 +IW2*A(POINT+ROW_LENGTH)+IW1*A(POINT+ROW_LENGTH+1))/IW4 DUCT1A.445
C----------------------------------------------------------------------- DUCT1A.446
*ENDIF DUCT1A.447
C----------------------------------------------------------------------- DUCT1A.448
600 CONTINUE DUCT1A.449
*IF DEF,MPP GPB1F403.1798
ENDIF GPB1F403.1799
*ENDIF GPB1F403.1800
C----------------------------------------------------------------------- DUCT1A.450
CL 7. Smooth right hand column DUCT1A.451
C----------------------------------------------------------------------- DUCT1A.452
*IF -DEF,MPP GPB1F403.1801
J=ROW_LENGTH DUCT1A.453
DO 700 I=2,P_ROWS-1 DUCT1A.454
*ELSE GPB1F403.1802
IF (atright) THEN GPB1F403.1803
GPB1F403.1804
J=ROW_LENGTH-Offx GPB1F403.1805
IF (attop) THEN GPB1F403.1806
I_start=Offy+2 GPB1F403.1807
ELSE GPB1F403.1808
I_start=Offy+1 GPB1F403.1809
ENDIF GPB1F403.1810
GPB1F403.1811
IF (atbase) THEN GPB1F403.1812
I_end=P_ROWS-Offy-1 GPB1F403.1813
ELSE GPB1F403.1814
I_end=P_ROWS-Offy GPB1F403.1815
ENDIF GPB1F403.1816
GPB1F403.1817
DO 700 I=I_start,I_end GPB1F403.1818
*ENDIF GPB1F403.1819
POINT=(I-1)*ROW_LENGTH+J DUCT1A.455
C----------------------------------------------------------------------- DUCT1A.456
*IF -DEF,GLOBAL DUCT1A.457
C----------------------------------------------------------------------- DUCT1A.458
ABAR(POINT)=(IW1*A(POINT-ROW_LENGTH-1)+IW2*A(POINT-ROW_LENGTH) DUCT1A.459
1 +IW2*A(POINT-1)+IW3*A(POINT) DUCT1A.460
2 +IW1*A(POINT+ROW_LENGTH-1)+IW2*A(POINT+ROW_LENGTH))/IW6 DUCT1A.461
C----------------------------------------------------------------------- DUCT1A.462
*ENDIF DUCT1A.463
C DUCT1A.464
*IF DEF,GLOBAL,AND,-DEF,MPP GPB1F403.1820
C----------------------------------------------------------------------- DUCT1A.466
ABAR(POINT)=(IW1*A(POINT-ROW_LENGTH-1)+IW2*A(POINT-ROW_LENGTH) DUCT1A.467
1 +IW1*A(POINT-2*ROW_LENGTH+1)+IW2*A(POINT-1)+IW3*A(POINT) DUCT1A.468
2 +IW2*A(POINT-ROW_LENGTH+1)+IW1*A(POINT+ROW_LENGTH-1) DUCT1A.469
3 +IW2*A(POINT+ROW_LENGTH)+IW1*A(POINT+1))/IW4 DUCT1A.470
C----------------------------------------------------------------------- DUCT1A.471
*ENDIF DUCT1A.472
C----------------------------------------------------------------------- DUCT1A.473
700 CONTINUE DUCT1A.474
*IF DEF,MPP GPB1F403.1821
ENDIF GPB1F403.1822
*ENDIF GPB1F403.1823
RETURN DUCT1A.475
END DUCT1A.476
C----------------------------------------------------------------------- DUCT1A.477
C DUCT1A.478
C DUCT1A.479
C*L ARGUMENTS:---------------------------------------------------------- DUCT1A.480
SUBROUTINE LUBATT 1DUCT1A.481
1 (WINDSPEED,T_DRY,T_SEA,T_DEW,DUCT_HEIGHT, DUCT1A.482
2 MAX_WAVELENGTH) DUCT1A.483
C----------------------------------------------------------------------- DUCT1A.484
IMPLICIT NONE DUCT1A.485
C----------------------------------------------------------------------- DUCT1A.486
REAL DUCT1A.487
* WINDSPEED ! IN wind speed in m/s DUCT1A.488
*, T_DRY ! IN dry bulb temperature in deg C DUCT1A.489
*, T_SEA ! IN sea surface temperature in deg C DUCT1A.490
*, T_DEW ! IN dew point temperature in deg C DUCT1A.491
*, DUCT_HEIGHT ! OUT evaporation duct height in metres DUCT1A.492
*, MAX_WAVELENGTH ! OUT Maximum wavelength propagated by duct DUCT1A.493
* ! (duct intensity) in metres DUCT1A.494
C*---------------------------------------------------------------------- DUCT1A.495
C DUCT1A.496
C*L WORKSPACE USAGE----------------------------------------------------- DUCT1A.497
INTEGER DUCT1A.498
* VSEA(6) ! values of sea temperature in table DUCT1A.499
*, VWIND(6) ! values of windspeed in table DUCT1A.500
*, VDPD(6) ! values of sea temp depression in table DUCT1A.501
*, VSTD(6) ! values of dewpoint depression in table DUCT1A.502
*, IH(6,6,6,6) DUCT1A.503
*, IW(6,6,6,6) DUCT1A.504
*, H(16) ! values of IH for upper and lower points of four DUCT1A.505
* ! dimensional space formed by intervals DUCT1A.506
*, W(16) ! As H but for IW DUCT1A.507
C----------------------------------------------------------------------- DUCT1A.508
REAL DUCT1A.509
* H2(8) ! Heights found by linear interpolation for change in DUCT1A.510
* ! sea temperature DUCT1A.511
*, H3(4) ! " " " " " " " " wind speed DUCT1A.512
*, H4(2) ! " " " " " " " " dewpoint depression DUCT1A.513
*, W2(8) ! Wavelength found by linear interpolation for change DUCT1A.514
* ! in sea temperature DUCT1A.515
*, W3(4) ! " " " " " " " " wind speed DUCT1A.516
*, W4(2) ! " " " " " " " " dewpoint depression DUCT1A.517
C*---------------------------------------------------------------------- DUCT1A.518
C DUCT1A.519
C*L EXTERNAL SUBROUTINES CALLED----------------------------------------- DUCT1A.520
C NONE DUCT1A.521
C*---------------------------------------------------------------------- DUCT1A.522
C DUCT1A.523
C----------------------------------------------------------------------- DUCT1A.524
C LOCAL CONSTANTS DUCT1A.525
C----------------------------------------------------------------------- DUCT1A.526
INTEGER DUCT1A.527
* NSEA ! No of values of sea temperature in table DUCT1A.528
*, NWIN ! No of values of windspeed in table DUCT1A.529
*, NDPD ! No of values of dewpoint depression in table DUCT1A.530
*, NSTD ! No of values of sea temp depression in table DUCT1A.531
PARAMETER(NSEA=6,NWIN=6,NDPD=6,NSTD=6) DUCT1A.532
C----------------------------------------------------------------------- DUCT1A.533
C LOCAL VARIABLES DUCT1A.534
C----------------------------------------------------------------------- DUCT1A.535
INTEGER DUCT1A.536
* NS ! lower boundary of sea temperature interval DUCT1A.537
*, NW ! lower boundary of wind interval DUCT1A.538
*, NT ! lower boundary of sea temp depression interval DUCT1A.539
*, ND ! lower boundary of dewpoint depression interval DUCT1A.540
*, I,J,K ! Loop counters for DATA statements DUCT1A.541
REAL DUCT1A.542
* STD ! sea temp depression = T_DRY - T_SEA DUCT1A.543
*, DPD ! dewpoint depression = T_DRY - T_DEW DUCT1A.544
*, RS ! =(T_SEA-VSEA(NS))/(VSEA(NS+1)-VSEA(NS)) DUCT1A.545
*, RW ! =(WINDSPEED-VWIND(NW))/(VWIND(NW+1)-VWIND(NW)) DUCT1A.546
*, RT ! =(STD-VSTD(NT))/(VSTD(NT+1)-VSTD(NT)) DUCT1A.547
*, RD ! =(DPD-VDPD(ND))/(VDPD(ND+1)-VDPD(ND)) DUCT1A.548
C----------------------------------------------------------------------- DUCT1A.549
CL 1. DATA statements for six values of sea temp, wind speed, DUCT1A.550
CL dewpoint depression and sea temp depression DUCT1A.551
C----------------------------------------------------------------------- DUCT1A.552
DATA VSEA/-2,8,16,22,26,28/ DUCT1A.553
DATA VWIND/1,3,5,8,14,20/ DUCT1A.554
DATA VDPD/0,2,4,6,8,10/ DUCT1A.555
DATA VSTD/-12,-8,-4,0,2,4/ DUCT1A.556
C----------------------------------------------------------------------- DUCT1A.557
CL 2. DATA initialisation for IH(6,6,6,6) array DUCT1A.558
C----------------------------------------------------------------------- DUCT1A.559
C first parameter 6 sea temperature depression values. DUCT1A.560
C second parameter 6 dewpoint depression values. DUCT1A.561
C third parameter 6 wind speed values. DUCT1A.562
C fourth parameter 6 sea temperature values. DUCT1A.563
C DUCT1A.564
C T_SEA -2 DUCT1A.565
C WINDSPEED 1,3,5 DUCT1A.566
C DUCT1A.567
C----------------------------------------------------------------------- DUCT1A.568
DATA (((IH(I,J,K,1),I=1,6),J=1,6),K=1,3)/ DUCT1A.569
* 1,1,1,1,0,0, DUCT1A.570
* 1,1,1,7,30,30, DUCT1A.571
* 1,1,1,10,30,30, DUCT1A.572
* 1,1,2,4,30,30, DUCT1A.573
* 1,1,2,5,30,30, DUCT1A.574
* 1,1,2,5,30,30, DUCT1A.575
C DUCT1A.576
* 1,1,1,1,0,0, DUCT1A.577
* 1,1,2,2,3,1, DUCT1A.578
* 1,2,2,3,30,30, DUCT1A.579
* 1,2,2,5,30,30, DUCT1A.580
* 1,2,3,6,30,30, DUCT1A.581
* 1,1,3,6,23,30, DUCT1A.582
C DUCT1A.583
* 1,1,1,1,0,0, DUCT1A.584
* 1,2,2,2,1,1, DUCT1A.585
* 2,2,2,3,5,30, DUCT1A.586
* 1,2,3,5,30,30, DUCT1A.587
* 1,3,3,6,30,30, DUCT1A.588
* 1,2,4,7,30,30/ DUCT1A.589
C----------------------------------------------------------------------- DUCT1A.590
C T_SEA -2 DUCT1A.591
C WINDSPEED 8,14,20 DUCT1A.592
C----------------------------------------------------------------------- DUCT1A.593
DATA (((IH(I,J,K,1),I=1,6),J=1,6),K=4,6)/ DUCT1A.594
* 1,1,1,1,0,0, DUCT1A.595
* 2,2,2,2,1,1, DUCT1A.596
* 2,3,3,3,3,3, DUCT1A.597
* 2,3,4,5,7,12, DUCT1A.598
* 1,4,4,6,12,30, DUCT1A.599
* 1,3,5,7,20,30, DUCT1A.600
C DUCT1A.601
* 1,1,1,1,0,0, DUCT1A.602
* 2,3,3,2,1,1, DUCT1A.603
* 3,3,4,4,3,3, DUCT1A.604
* 3,4,5,5,6,6, DUCT1A.605
* 3,5,6,7,8,9, DUCT1A.606
* 2,5,6,8,10,13, DUCT1A.607
C DUCT1A.608
* 1,1,1,1,0,0, DUCT1A.609
* 2,3,3,2,1,1, DUCT1A.610
* 3,4,4,4,4,3, DUCT1A.611
* 4,5,5,5,6,5, DUCT1A.612
* 4,5,6,7,7,8, DUCT1A.613
* 3,6,7,8,9,10/ DUCT1A.614
C----------------------------------------------------------------------- DUCT1A.615
C T_SEA 8 DUCT1A.616
C WINDSPEED 1,3,5 DUCT1A.617
C----------------------------------------------------------------------- DUCT1A.618
DATA (((IH(I,J,K,2),I=1,6),J=1,6),K=1,3)/ DUCT1A.619
* 1,1,1,1,0,0, DUCT1A.620
* 2,2,2,3,30,0, DUCT1A.621
* 2,2,2,5,30,30, DUCT1A.622
* 2,2,3,5,30,30, DUCT1A.623
* 2,2,3,5,30,30, DUCT1A.624
* 2,3,3,5,30,30, DUCT1A.625
C DUCT1A.626
* 2,2,2,1,0,0, DUCT1A.627
* 3,3,3,3,3,0, DUCT1A.628
* 3,3,3,6,30,30, DUCT1A.629
* 4,4,4,7,30,30, DUCT1A.630
* 4,4,4,7,30,30, DUCT1A.631
* 4,4,5,8,30,30, DUCT1A.632
C DUCT1A.633
* 2,3,2,1,0,0, DUCT1A.634
* 4,4,4,3,1,0, DUCT1A.635
* 4,4,4,6,30,30, DUCT1A.636
* 5,5,5,7,30,30, DUCT1A.637
* 5,5,6,8,30,30, DUCT1A.638
* 5,6,6,10,30,30/ DUCT1A.639
C----------------------------------------------------------------------- DUCT1A.640
C T_SEA 8 DUCT1A.641
C WINDSPEED 8,14,20 DUCT1A.642
C----------------------------------------------------------------------- DUCT1A.643
DATA (((IH(I,J,K,2),I=1,6),J=1,6),K=4,6)/ DUCT1A.644
* 3,4,3,1,0,0, DUCT1A.645
* 5,5,4,3,1,0, DUCT1A.646
* 6,6,6,6,6,3, DUCT1A.647
* 6,6,7,8,18,30, DUCT1A.648
* 6,7,7,10,30,30, DUCT1A.649
* 7,7,8,11,30,30, DUCT1A.650
C DUCT1A.651
* 4,5,4,1,0,0, DUCT1A.652
* 7,7,6,3,1,0, DUCT1A.653
* 8,8,7,6,5,3, DUCT1A.654
* 9,9,9,9,9,8, DUCT1A.655
* 9,10,10,11,14,17, DUCT1A.656
* 10,10,11,13,18,30, DUCT1A.657
C DUCT1A.658
* 4,5,4,1,0,0, DUCT1A.659
* 9,8,7,4,1,0, DUCT1A.660
* 10,9,9,7,5,3, DUCT1A.661
* 10,11,11,9,9,7, DUCT1A.662
* 11,12,12,12,13,12, DUCT1A.663
* 12,13,13,14,16,17/ DUCT1A.664
C----------------------------------------------------------------------- DUCT1A.665
C T_SEA 16 DUCT1A.666
C WINDSPEED 1,3,5 DUCT1A.667
C----------------------------------------------------------------------- DUCT1A.668
DATA (((IH(I,J,K,3),I=1,6),J=1,6),K=1,3)/ DUCT1A.669
* 2,2,2,1,0,0, DUCT1A.670
* 3,3,3,4,30,0, DUCT1A.671
* 3,3,3,4,30,30, DUCT1A.672
* 3,3,3,5,30,30, DUCT1A.673
* 3,3,4,5,30,30, DUCT1A.674
* 3,4,4,6,30,30, DUCT1A.675
C DUCT1A.676
* 4,4,3,1,0,0, DUCT1A.677
* 5,4,4,4,2,0, DUCT1A.678
* 5,5,5,6,30,30, DUCT1A.679
* 5,5,5,8,30,30, DUCT1A.680
* 6,6,6,8,30,30, DUCT1A.681
* 6,6,6,9,30,30, DUCT1A.682
C DUCT1A.683
* 5,5,4,1,0,0, DUCT1A.684
* 6,6,5,5,1,0, DUCT1A.685
* 7,6,6,7,30,30, DUCT1A.686
* 7,7,7,9,30,30, DUCT1A.687
* 7,8,8,11,30,30, DUCT1A.688
* 8,8,9,12,30,30/ DUCT1A.689
C----------------------------------------------------------------------- DUCT1A.690
C T_SEA 16 DUCT1A.691
C WINDSPEED 8,14,20 DUCT1A.692
C----------------------------------------------------------------------- DUCT1A.693
DATA (((IH(I,J,K,3),I=1,6),J=1,6),K=4,6)/ DUCT1A.694
* 5,6,5,1,0,0, DUCT1A.695
* 8,8,7,5,1,0, DUCT1A.696
* 9,8,8,8,11,3, DUCT1A.697
* 9,9,9,11,30,30, DUCT1A.698
* 10,10,10,13,30,30, DUCT1A.699
* 10,11,11,15,30,30, DUCT1A.700
C DUCT1A.701
* 8,9,6,1,0,0, DUCT1A.702
* 11,10,9,5,1,0, DUCT1A.703
* 12,12,11,9,7,3, DUCT1A.704
* 13,13,13,13,15,13, DUCT1A.705
* 14,14,15,16,23,30, DUCT1A.706
* 15,15,16,18,30,30, DUCT1A.707
C DUCT1A.708
* 9,10,7,1,0,0, DUCT1A.709
* 14,13,10,5,1,0, DUCT1A.710
* 15,15,13,10,7,3, DUCT1A.711
* 17,16,16,14,13,10, DUCT1A.712
* 18,18,18,17,19,19, DUCT1A.713
* 19,19,19,20,25,29/ DUCT1A.714
C----------------------------------------------------------------------- DUCT1A.715
C T_SEA 22 DUCT1A.716
C WINDSPEED 1,3,5 DUCT1A.717
C----------------------------------------------------------------------- DUCT1A.718
DATA (((IH(I,J,K,4),I=1,6),J=1,6),K=1,3)/ DUCT1A.719
* 3,3,2,1,0,0, DUCT1A.720
* 3,3,3,4,30,0, DUCT1A.721
* 4,4,4,5,30,30, DUCT1A.722
* 4,4,4,5,30,30, DUCT1A.723
* 4,4,5,6,30,30, DUCT1A.724
* 4,4,5,6,30,30, DUCT1A.725
C DUCT1A.726
* 5,5,4,1,0,0, DUCT1A.727
* 6,5,5,5,3,0, DUCT1A.728
* 6,6,6,7,30,30, DUCT1A.729
* 7,7,7,8,30,30, DUCT1A.730
* 7,7,7,9,30,30, DUCT1A.731
* 8,8,8,10,30,30, DUCT1A.732
C DUCT1A.733
* 7,6,5,1,0,0, DUCT1A.734
* 8,7,6,6,1,0, DUCT1A.735
* 8,8,8,9,30,30, DUCT1A.736
* 9,9,9,11,30,30, DUCT1A.737
* 9,9,10,12,30,30, DUCT1A.738
* 10,10,10,13,30,30/ DUCT1A.739
C----------------------------------------------------------------------- DUCT1A.740
C T_SEA 22 DUCT1A.741
C WINDSPEED 8,14,20 DUCT1A.742
C----------------------------------------------------------------------- DUCT1A.743
DATA (((IH(I,J,K,4),I=1,6),J=1,6),K=4,6)/ DUCT1A.744
* 9,8,6,1,0,0, DUCT1A.745
* 10,10,8,6,1,0, DUCT1A.746
* 11,11,10,10,19,4, DUCT1A.747
* 12,12,12,13,30,30, DUCT1A.748
* 13,13,13,15,30,30, DUCT1A.749
* 13,13,14,17,30,30, DUCT1A.750
C DUCT1A.751
* 11,11,8,1,0,0, DUCT1A.752
* 15,14,11,6,1,0, DUCT1A.753
* 16,15,14,12,10,3, DUCT1A.754
* 17,17,16,17,20,18, DUCT1A.755
* 18,18,18,20,30,30, DUCT1A.756
* 19,19,20,22,30,30, DUCT1A.757
C DUCT1A.758
* 14,14,9,1,0,0, DUCT1A.759
* 19,17,14,7,2,0, DUCT1A.760
* 20,19,17,13,9,3, DUCT1A.761
* 22,21,20,18,18,13, DUCT1A.762
* 23,23,23,22,26,27, DUCT1A.763
* 24,24,25,26,30,30/ DUCT1A.764
C----------------------------------------------------------------------- DUCT1A.765
C T_SEA 26 DUCT1A.766
C WINDSPEED 1,3,5 DUCT1A.767
C----------------------------------------------------------------------- DUCT1A.768
DATA (((IH(I,J,K,5),I=1,6),J=1,6),K=1,3)/ DUCT1A.769
* 4,3,3,1,0,0, DUCT1A.770
* 4,4,4,4,30,0, DUCT1A.771
* 4,4,4,5,30,30, DUCT1A.772
* 4,4,5,6,30,30, DUCT1A.773
* 5,5,5,6,30,30, DUCT1A.774
* 5,5,6,7,15,30, DUCT1A.775
C DUCT1A.776
* 6,5,4,1,0,0, DUCT1A.777
* 7,6,5,6,3,0, DUCT1A.778
* 7,7,7,8,30,30, DUCT1A.779
* 8,8,7,9,30,30, DUCT1A.780
* 8,8,8,10,30,30, DUCT1A.781
* 9,9,9,11,22,30, DUCT1A.782
C DUCT1A.783
* 8,7,5,1,0,0, DUCT1A.784
* 9,8,7,6,1,0, DUCT1A.785
* 10,9,9,10,30,30, DUCT1A.786
* 10,10,10,12,30,30, DUCT1A.787
* 11,11,11,13,30,30, DUCT1A.788
* 11,11,12,14,25,30/ DUCT1A.789
C----------------------------------------------------------------------- DUCT1A.790
C T_SEA 26 DUCT1A.791
C WINDSPEED 8,14,20 DUCT1A.792
C----------------------------------------------------------------------- DUCT1A.793
DATA (((IH(I,J,K,5),I=1,6),J=1,6),K=4,6)/ DUCT1A.794
* 11,9,7,1,0,0, DUCT1A.795
* 12,11,10,7,1,0, DUCT1A.796
* 13,12,12,12,27,4, DUCT1A.797
* 14,14,13,15,30,30, DUCT1A.798
* 15,15,15,17,30,30, DUCT1A.799
* 15,15,16,19,25,30, DUCT1A.800
C DUCT1A.801
* 14,13,9,1,0,0, DUCT1A.802
* 17,16,13,8,1,0, DUCT1A.803
* 19,18,16,14,12,4, DUCT1A.804
* 20,20,19,19,25,25, DUCT1A.805
* 21,21,21,22,30,30, DUCT1A.806
* 22,22,23,25,27,30, DUCT1A.807
C DUCT1A.808
* 18,17,11,1,0,0, DUCT1A.809
* 22,20,16,8,2,0, DUCT1A.810
* 24,23,20,15,11,4, DUCT1A.811
* 26,25,23,21,21,16, DUCT1A.812
* 27,27,26,26,30,30, DUCT1A.813
* 28,28,29,30,28,30/ DUCT1A.814
C----------------------------------------------------------------------- DUCT1A.815
C T_SEA 28 DUCT1A.816
C WINDSPEED 1,3,5 DUCT1A.817
C----------------------------------------------------------------------- DUCT1A.818
DATA (((IH(I,J,K,6),I=1,6),J=1,6),K=1,3)/ DUCT1A.819
* 4,3,3,1,0,0, DUCT1A.820
* 4,4,4,4,30,0, DUCT1A.821
* 4,4,4,5,30,30, DUCT1A.822
* 5,5,5,6,30,30, DUCT1A.823
* 5,5,5,6,13,30, DUCT1A.824
* 5,5,6,7,16,30, DUCT1A.825
C DUCT1A.826
* 7,6,4,1,0,0, DUCT1A.827
* 7,7,6,6,3,0, DUCT1A.828
* 8,8,7,8,30,30, DUCT1A.829
* 9,8,8,9,30,30, DUCT1A.830
* 9,9,9,10,20,30, DUCT1A.831
* 9,9,9,11,24,30, DUCT1A.832
C DUCT1A.833
* 9,8,6,1,0,0, DUCT1A.834
* 10,9,8,6,1,0, DUCT1A.835
* 10,10,9,10,30,30, DUCT1A.836
* 11,11,11,12,30,30, DUCT1A.837
* 12,12,12,13,22,30, DUCT1A.838
* 12,12,12,15,27,30/ DUCT1A.839
C----------------------------------------------------------------------- DUCT1A.840
C T_SEA 28 DUCT1A.841
C WINDSPEED 8,14,20 DUCT1A.842
C----------------------------------------------------------------------- DUCT1A.843
DATA (((IH(I,J,K,6),I=1,6),J=1,6),K=4,6)/ DUCT1A.844
* 12,10,7,1,0,0, DUCT1A.845
* 13,12,10,7,1,0, DUCT1A.846
* 14,13,12,12,30,4, DUCT1A.847
* 15,14,14,15,30,30, DUCT1A.848
* 16,16,16,18,30,30, DUCT1A.849
* 16,16,17,20,27,30, DUCT1A.850
C DUCT1A.851
* 17,14,10,1,0,0, DUCT1A.852
* 19,17,14,8,1,0, DUCT1A.853
* 20,19,18,15,13,4, DUCT1A.854
* 22,21,20,20,27,30, DUCT1A.855
* 23,22,22,24,30,30, DUCT1A.856
* 24,24,24,27,29,30, DUCT1A.857
C DUCT1A.858
* 20,18,12,1,0,0, DUCT1A.859
* 24,21,17,9,2,0, DUCT1A.860
* 26,24,22,16,12,4, DUCT1A.861
* 28,27,25,23,23,18, DUCT1A.862
* 29,29,28,28,30,30, DUCT1A.863
* 30,30,30,30,30,30/ DUCT1A.864
C----------------------------------------------------------------------- DUCT1A.865
CL 3. DATA initialisation for IW(6,6,6,6) array DUCT1A.866
C----------------------------------------------------------------------- DUCT1A.867
C T_SEA -2 DUCT1A.868
C WINDSPEED 1,3,5 DUCT1A.869
C----------------------------------------------------------------------- DUCT1A.870
DATA (((IW(I,J,K,1),I=1,6),J=1,6),K=1,3)/ DUCT1A.871
* 0,0,0,0,0,0, DUCT1A.872
* 0,1,1,2,41,47, DUCT1A.873
* 1,1,1,4,51,73, DUCT1A.874
* 1,1,2,3,51,77, DUCT1A.875
* 1,1,2,4,51,77, DUCT1A.876
* 1,1,2,5,50,76, DUCT1A.877
C DUCT1A.878
* 0,0,0,0,0,0, DUCT1A.879
* 1,1,1,1,1,0, DUCT1A.880
* 1,1,1,2,21,26, DUCT1A.881
* 1,1,2,4,28,37, DUCT1A.882
* 1,2,3,5,32,41, DUCT1A.883
* 1,1,3,5,25,41, DUCT1A.884
C DUCT1A.885
* 0,0,0,0,0,0, DUCT1A.886
* 1,1,1,1,0,0, DUCT1A.887
* 1,1,1,2,2,13, DUCT1A.888
* 1,1,2,4,17,22, DUCT1A.889
* 1,2,2,5,22,27, DUCT1A.890
* 1,2,4,6,25,31/ DUCT1A.891
C----------------------------------------------------------------------- DUCT1A.892
C T_SEA -2 DUCT1A.893
C WINDSPEED 8,14,20 DUCT1A.894
C----------------------------------------------------------------------- DUCT1A.895
DATA (((IW(I,J,K,1),I=1,6),J=1,6),K=4,6)/ DUCT1A.896
* 0,0,0,0,0,0, DUCT1A.897
* 1,1,1,1,0,0, DUCT1A.898
* 1,2,2,2,2,1, DUCT1A.899
* 1,2,3,4,4,6, DUCT1A.900
* 1,3,3,5,9,21, DUCT1A.901
* 1,2,4,6,16,25, DUCT1A.902
C DUCT1A.903
* 0,0,0,0,0,0, DUCT1A.904
* 1,2,2,1,0,0, DUCT1A.905
* 2,2,3,2,2,1, DUCT1A.906
* 2,3,4,4,4,4, DUCT1A.907
* 2,4,5,6,6,7, DUCT1A.908
* 1,4,5,7,8,11, DUCT1A.909
C DUCT1A.910
* 0,0,0,0,0,0, DUCT1A.911
* 1,2,2,1,0,0, DUCT1A.912
* 2,2,2,2,2,1, DUCT1A.913
* 2,3,4,3,4,3, DUCT1A.914
* 3,4,5,6,5,6, DUCT1A.915
* 2,5,6,7,8,8/ DUCT1A.916
C----------------------------------------------------------------------- DUCT1A.917
C T_SEA 8 DUCT1A.918
C WINDSPEED 1,3,5 DUCT1A.919
C----------------------------------------------------------------------- DUCT1A.920
DATA (((IW(I,J,K,2),I=1,6),J=1,6),K=1,3)/ DUCT1A.921
* 1,1,1,0,0,0, DUCT1A.922
* 2,2,2,5,41,0, DUCT1A.923
* 2,2,2,4,62,73, DUCT1A.924
* 2,2,3,5,61,83, DUCT1A.925
* 2,2,4,6,60,82, DUCT1A.926
* 2,4,4,6,60,81, DUCT1A.927
C DUCT1A.928
* 2,2,1,0,0,0, DUCT1A.929
* 3,3,3,2,1,0, DUCT1A.930
* 3,3,3,5,27,27, DUCT1A.931
* 5,5,5,7,35,42, DUCT1A.932
* 5,5,5,8,41,52, DUCT1A.933
* 5,5,6,10,45,54, DUCT1A.934
C DUCT1A.935
* 2,3,1,0,0,0, DUCT1A.936
* 4,4,3,2,0,0, DUCT1A.937
* 4,4,4,5,17,13, DUCT1A.938
* 6,6,6,7,25,26, DUCT1A.939
* 6,6,7,9,31,33, DUCT1A.940
* 6,8,8,12,35,38/ DUCT1A.941
C----------------------------------------------------------------------- DUCT1A.942
C T_SEA 8 DUCT1A.943
C WINDSPEED 8,14,20 DUCT1A.944
C----------------------------------------------------------------------- DUCT1A.945
DATA (((IW(I,J,K,2),I=1,6),J=1,6),K=4,6)/ DUCT1A.946
* 3,3,2,0,0,0, DUCT1A.947
* 5,5,3,2,0,0, DUCT1A.948
* 7,6,6,5,4,1, DUCT1A.949
* 7,7,8,8,15,21, DUCT1A.950
* 7,9,8,11,30,28, DUCT1A.951
* 9,9,10,13,34,33, DUCT1A.952
C DUCT1A.953
* 4,4,2,0,0,0, DUCT1A.954
* 7,7,5,2,0,0, DUCT1A.955
* 9,8,7,5,3,1, DUCT1A.956
* 10,10,10,9,8,6, DUCT1A.957
* 11,12,12,12,14,16, DUCT1A.958
* 13,13,14,15,20,32, DUCT1A.959
C DUCT1A.960
* 4,4,2,0,0,0, DUCT1A.961
* 9,7,6,2,0,0, DUCT1A.962
* 11,9,9,6,3,2, DUCT1A.963
* 11,12,12,9,8,5, DUCT1A.964
* 13,14,14,13,13,11, DUCT1A.965
* 15,16,16,17,18,18/ DUCT1A.966
C----------------------------------------------------------------------- DUCT1A.967
C T_SEA 16 DUCT1A.968
C WINDSPEED 1,3,5 DUCT1A.969
C----------------------------------------------------------------------- DUCT1A.970
DATA (((IW(I,J,K,3),I=1,6),J=1,6),K=1,3)/ DUCT1A.971
* 3,2,2,0,0,0, DUCT1A.972
* 4,4,3,3,41,0, DUCT1A.973
* 4,4,4,4,73,75, DUCT1A.974
* 5,4,4,6,72,90, DUCT1A.975
* 5,5,6,7,71,89, DUCT1A.976
* 5,7,7,9,70,89, DUCT1A.977
C DUCT1A.978
* 5,5,3,0,0,0, DUCT1A.979
* 7,5,5,3,1,0, DUCT1A.980
* 8,7,7,6,32,28, DUCT1A.981
* 8,8,7,10,41,48, DUCT1A.982
* 10,10,9,11,47,60, DUCT1A.983
* 11,10,10,14,51,68, DUCT1A.984
C DUCT1A.985
* 7,6,4,0,0,0, DUCT1A.986
* 9,8,6,4,0,0, DUCT1A.987
* 11,9,8,7,22,15, DUCT1A.988
* 11,11,10,11,32,31, DUCT1A.989
* 12,13,12,15,38,39, DUCT1A.990
* 14,14,15,18,43,45/ DUCT1A.991
C----------------------------------------------------------------------- DUCT1A.992
C T_SEA 16 DUCT1A.993
C WINDSPEED 8,14,20 DUCT1A.994
C----------------------------------------------------------------------- DUCT1A.995
DATA (((IW(I,J,K,3),I=1,6),J=1,6),K=4,6)/ DUCT1A.996
* 7,7,4,0,0,0, DUCT1A.997
* 12,10,8,4,0,0, DUCT1A.998
* 14,11,10,8,8,1, DUCT1A.999
* 14,14,13,13,31,26, DUCT1A.1000
* 17,16,15,18,38,34, DUCT1A.1001
* 17,19,18,23,43,40, DUCT1A.1002
C DUCT1A.1003
* 11,10,5,0,0,0, DUCT1A.1004
* 16,13,10,4,0,0, DUCT1A.1005
* 18,17,14,9,6,2, DUCT1A.1006
* 21,20,18,16,16,11, DUCT1A.1007
* 23,23,23,22,29,34, DUCT1A.1008
* 26,25,26,27,42,40, DUCT1A.1009
C DUCT1A.1010
* 12,11,6,0,0,0, DUCT1A.1011
* 20,17,11,4,0,0, DUCT1A.1012
* 23,21,16,10,6,2, DUCT1A.1013
* 27,34,22,17,14,9, DUCT1A.1014
* 30,29,27,23,24,21, DUCT1A.1015
* 33,32,31,30,35,38/ DUCT1A.1016
C----------------------------------------------------------------------- DUCT1A.1017
C T_SEA 22 DUCT1A.1018
C WINDSPEED 1,3,5 DUCT1A.1019
C----------------------------------------------------------------------- DUCT1A.1020
DATA (((IW(I,J,K,4),I=1,6),J=1,6),K=1,3)/ DUCT1A.1021
* 5,4,2,0,0,0, DUCT1A.1022
* 5,5,4,3,42,0, DUCT1A.1023
* 7,7,6,6,84,78, DUCT1A.1024
* 7,7,7,7,83,99, DUCT1A.1025
* 8,7,9,10,82,97, DUCT1A.1026
* 8,8,10,11,81,96, DUCT1A.1027
C DUCT1A.1028
* 8,7,4,0,0,0, DUCT1A.1029
* 11,8,7,4,1,0, DUCT1A.1030
* 11,10,9,8,36,29, DUCT1A.1031
* 14,13,12,12,46,53, DUCT1A.1032
* 14,14,13,15,51,66, DUCT1A.1033
* 17,16,16,18,53,75, DUCT1A.1034
C DUCT1A.1035
* 12,8,5,0,0,0, DUCT1A.1036
* 14,11,8,5,0,0, DUCT1A.1037
* 15,14,12,11,27,16, DUCT1A.1038
* 18,17,15,16,37,35, DUCT1A.1039
* 18,18,18,19,45,44, DUCT1A.1040
* 21,20,19,23,50,50/ DUCT1A.1041
C----------------------------------------------------------------------- DUCT1A.1042
C T_SEA 22 DUCT1A.1043
C WINDSPEED 8,14,20 DUCT1A.1044
C----------------------------------------------------------------------- DUCT1A.1045
DATA (((IW(I,J,K,4),I=1,6),J=1,6),K=4,6)/ DUCT1A.1046
* 15,11,6,0,0,0, DUCT1A.1047
* 18,16,10,5,0,0, DUCT1A.1048
* 21,19,15,12,17,2, DUCT1A.1049
* 24,22,20,19,37,30, DUCT1A.1050
* 26,25,24,24,44,40, DUCT1A.1051
* 27,26,27,30,50,47, DUCT1A.1052
C DUCT1A.1053
* 18,15,8,0,0,0, DUCT1A.1054
* 26,22,14,5,0,0, DUCT1A.1055
* 30,26,21,14,9,2, DUCT1A.1056
* 33,31,27,24,24,18, DUCT1A.1057
* 36,35,32,32,44,39, DUCT1A.1058
* 40,38,38,38,50,46, DUCT1A.1059
C DUCT1A.1060
* 23,19,9,0,0,0, DUCT1A.1061
* 33,27,18,6,1,0, DUCT1A.1062
* 37,32,25,15,8,2, DUCT1A.1063
* 43,38,33,25,22,13, DUCT1A.1064
* 46,44,41,35,38,35, DUCT1A.1065
* 50,48,48,45,50,46/ DUCT1A.1066
C----------------------------------------------------------------------- DUCT1A.1067
C T_SEA 26 DUCT1A.1068
C WINDSPEED 1,3,5 DUCT1A.1069
C----------------------------------------------------------------------- DUCT1A.1070
DATA (((IW(I,J,K,5),I=1,6),J=1,6),K=1,3)/ DUCT1A.1071
* 7,5,4,0,0,0, DUCT1A.1072
* 7,7,6,4,43,0, DUCT1A.1073
* 8,7,7,7,92,80, DUCT1A.1074
* 8,8,9,10,91,105, DUCT1A.1075
* 11,10,10,11,89,104, DUCT1A.1076
* 11,11,13,14,27,102, DUCT1A.1077
C DUCT1A.1078
* 11,8,5,0,0,0, DUCT1A.1079
* 14,11,7,6,1,0, DUCT1A.1080
* 15,14,12,11,38,30, DUCT1A.1081
* 18,17,13,14,48,57, DUCT1A.1082
* 18,18,16,18,52,70, DUCT1A.1083
* 21,21,19,22,40,79, DUCT1A.1084
C DUCT1A.1085
* 15,11,6,0,0,0, DUCT1A.1086
* 18,14,10,6,0,0, DUCT1A.1087
* 21,17,15,13,30,17, DUCT1A.1088
* 22,21,19,19,41,37, DUCT1A.1089
* 25,24,22,23,49,47, DUCT1A.1090
* 26,25,26,27,46,54/ DUCT1A.1091
C----------------------------------------------------------------------- DUCT1A.1092
C T_SEA 26 DUCT1A.1093
C WINDSPEED 8,14,20 DUCT1A.1094
C----------------------------------------------------------------------- DUCT1A.1095
DATA (((IW(I,J,K,5),I=1,6),J=1,6),K=4,6)/ DUCT1A.1096
* 20,14,8,0,0,0, DUCT1A.1097
* 24,20,15,7,0,0, DUCT1A.1098
* 27,23,20,15,26,2, DUCT1A.1099
* 31,29,24,24,41,33, DUCT1A.1100
* 34,33,30,30,49,44, DUCT1A.1101
* 35,34,34,37,45,51, DUCT1A.1102
C DUCT1A.1103
* 26,20,10,0,0,0, DUCT1A.1104
* 34,28,19,7,0,0, DUCT1A.1105
* 40,35,27,18,12,2, DUCT1A.1106
* 44,41,35,30,34,27, DUCT1A.1107
* 48,45,42,39,49,43, DUCT1A.1108
* 52,50,49,49,49,51, DUCT1A.1109
C DUCT1A.1110
* 33,26,12,0,0,0, DUCT1A.1111
* 43,35,23,7,1,0, DUCT1A.1112
* 50,44,33,19,11,2, DUCT1A.1113
* 57,51,43,32,29,17, DUCT1A.1114
* 61,58,52,46,49,43, DUCT1A.1115
* 66,63,62,59,51,50/ DUCT1A.1116
C----------------------------------------------------------------------- DUCT1A.1117
C T_SEA 28 DUCT1A.1118
C WINDSPEED 1,3,5 DUCT1A.1119
C----------------------------------------------------------------------- DUCT1A.1120
DATA (((IW(I,J,K,6),I=1,6),J=1,6),K=1,3)/ DUCT1A.1121
* 7,5,4,0,0,0, DUCT1A.1122
* 8,7,6,4,43,0, DUCT1A.1123
* 8,8,7,7,96,81, DUCT1A.1124
* 11,10,10,10,95,109, DUCT1A.1125
* 11,11,10,11,22,107, DUCT1A.1126
* 11,11,13,15,31,106, DUCT1A.1127
C DUCT1A.1128
* 14,10,5,0,0,0, DUCT1A.1129
* 15,13,9,6,1,0, DUCT1A.1130
* 18,16,13,11,40,31, DUCT1A.1131
* 21,18,16,15,49,59, DUCT1A.1132
* 22,21,19,19,34,72, DUCT1A.1133
* 23,22,20,23,46,80, DUCT1A.1134
C DUCT1A.1135
* 18,13,7,0,0,0, DUCT1A.1136
* 21,17,12,6,0,0, DUCT1A.1137
* 22,21,16,14,31,18, DUCT1A.1138
* 26,24,22,20,43,39, DUCT1A.1139
* 29,28,26,24,37,49, DUCT1A.1140
* 30,29,27,31,52,55/ DUCT1A.1141
C----------------------------------------------------------------------- DUCT1A.1142
C T_SEA 28 DUCT1A.1143
C WINDSPEED 8,14,20, DUCT1A.1144
C----------------------------------------------------------------------- DUCT1A.1145
DATA (((IW(I,J,K,6),I=1,6),J=1,6),K=4,6)/ DUCT1A.1146
* 23,17,9,0,0,0, DUCT1A.1147
* 27,22,15,7,0,0, DUCT1A.1148
* 31,27,21,16,31,2, DUCT1A.1149
* 35,31,27,25,43,34, DUCT1A.1150
* 39,37,34,34,51,46, DUCT1A.1151
* 40,38,38,41,52,54, DUCT1A.1152
C DUCT1A.1153
* 33,23,12,0,0,0, DUCT1A.1154
* 40,32,21,8,0,0, DUCT1A.1155
* 44,39,32,20,14,2, DUCT1A.1156
* 51,46,39,32,38,34, DUCT1A.1157
* 55,50,47,45,51,45, DUCT1A.1158
* 60,57,54,55,55,53, DUCT1A.1159
C DUCT1A.1160
* 39,30,14,0,0,0, DUCT1A.1161
* 50,39,26,9,1,0, DUCT1A.1162
* 58,49,39,22,13,2, DUCT1A.1163
* 65,58,49,37,33,20, DUCT1A.1164
* 70,66,59,51,51,45, DUCT1A.1165
* 75,72,67,61,57,53/ DUCT1A.1166
C----------------------------------------------------------------------- DUCT1A.1167
CL 4. Calculate sea temp depression and dewpoint depression DUCT1A.1168
C----------------------------------------------------------------------- DUCT1A.1169
STD = T_DRY - T_SEA DUCT1A.1170
DPD = T_DRY - T_DEW DUCT1A.1171
C----------------------------------------------------------------------- DUCT1A.1172
CL 5. Check that sea temperature lies in acceptable range DUCT1A.1173
CL Find lower boundary value of sea temperature interval DUCT1A.1174
CL for interpolation DUCT1A.1175
C----------------------------------------------------------------------- DUCT1A.1176
IF(T_SEA.LT.VSEA(1)) T_SEA = VSEA(1) DUCT1A.1177
IF(T_SEA.GT.VSEA(NSEA)) T_SEA = VSEA(NSEA) DUCT1A.1178
NS = 0 DUCT1A.1179
100 NS = NS + 1 DUCT1A.1180
IF(T_SEA.GT.VSEA(NS+1)) GO TO 100 DUCT1A.1181
C----------------------------------------------------------------------- DUCT1A.1182
CL 6. Check that wind speed lies in acceptable range DUCT1A.1183
CL Find lower boundary value of wind speed interval DUCT1A.1184
CL for interpolation DUCT1A.1185
C----------------------------------------------------------------------- DUCT1A.1186
IF(WINDSPEED.LT.VWIND(1)) WINDSPEED = VWIND(1) DUCT1A.1187
IF(WINDSPEED.GT.VWIND(NWIN)) WINDSPEED = VWIND(NWIN) DUCT1A.1188
NW = 0 DUCT1A.1189
120 NW = NW + 1 DUCT1A.1190
IF(WINDSPEED.GT.VWIND(NW+1)) GO TO 120 DUCT1A.1191
C----------------------------------------------------------------------- DUCT1A.1192
CL 7. Check that sea temperature depression lies in acceptable range DUCT1A.1193
CL Find lower boundary value of sea temperature depression DUCT1A.1194
CL for interpolation DUCT1A.1195
C----------------------------------------------------------------------- DUCT1A.1196
IF(STD.LT.VSTD(1)) STD = VSTD(1) DUCT1A.1197
IF(STD.GT.VSTD(NSTD)) THEN DUCT1A.1198
STD=VSTD(NSTD) DUCT1A.1199
ENDIF DUCT1A.1200
NT = 0 DUCT1A.1201
140 NT = NT + 1 DUCT1A.1202
IF(STD.GT.VSTD(NT+1)) GO TO 140 DUCT1A.1203
C----------------------------------------------------------------------- DUCT1A.1204
CL 8. Check that dew point depression lies in acceptable range DUCT1A.1205
CL Find lower boundary value of dew point depression DUCT1A.1206
CL for interpolation DUCT1A.1207
C----------------------------------------------------------------------- DUCT1A.1208
IF(DPD.LT.VDPD(1)) DPD = VDPD(1) DUCT1A.1209
IF(DPD.GT.VDPD(NDPD)) DPD = VDPD(NDPD) DUCT1A.1210
ND = 0 DUCT1A.1211
160 ND = ND + 1 DUCT1A.1212
IF(DPD.GT.VDPD(ND+1)) GO TO 160 DUCT1A.1213
C----------------------------------------------------------------------- DUCT1A.1214
CL 9. Four dimensional interpolation of duct height DUCT1A.1215
C----------------------------------------------------------------------- DUCT1A.1216
H(1) = IH(NT,ND,NW,NS) DUCT1A.1217
H(2) = IH(NT,ND,NW,NS+1) DUCT1A.1218
C DUCT1A.1219
H(3) = IH(NT,ND,NW+1,NS) DUCT1A.1220
H(4) = IH(NT,ND,NW+1,NS+1) DUCT1A.1221
C DUCT1A.1222
H(5) = IH(NT,ND+1,NW,NS) DUCT1A.1223
H(6) = IH(NT,ND+1,NW,NS+1) DUCT1A.1224
H(7) = IH(NT,ND+1,NW+1,NS) DUCT1A.1225
H(8) = IH(NT,ND+1,NW+1,NS+1) DUCT1A.1226
C DUCT1A.1227
H(9) = IH(NT+1,ND,NW,NS) DUCT1A.1228
H(10) =IH(NT+1,ND,NW,NS+1) DUCT1A.1229
H(11) =IH(NT+1,ND,NW+1,NS) DUCT1A.1230
H(12) =IH(NT+1,ND,NW+1,NS+1) DUCT1A.1231
H(13) =IH(NT+1,ND+1,NW,NS) DUCT1A.1232
H(14) =IH(NT+1,ND+1,NW,NS+1) DUCT1A.1233
H(15) =IH(NT+1,ND+1,NW+1,NS) DUCT1A.1234
H(16) =IH(NT+1,ND+1,NW+1,NS+1) DUCT1A.1235
C----------------------------------------------------------------------- DUCT1A.1236
C INTERPOLATE HEIGHT FOR CHANGE IN SEA TEMPERATURE DUCT1A.1237
C----------------------------------------------------------------------- DUCT1A.1238
RS = (T_SEA - VSEA(NS))/(VSEA(NS+1) - VSEA(NS)) DUCT1A.1239
H2(1) = H(1) + (H(2) - H(1)) * RS DUCT1A.1240
H2(2) = H(3) + (H(4) - H(3)) * RS DUCT1A.1241
H2(3) = H(5) + (H(6) - H(5)) * RS DUCT1A.1242
H2(4) = H(7) + (H(8) - H(7)) * RS DUCT1A.1243
H2(5) = H(9) + (H(10) - H(9)) * RS DUCT1A.1244
H2(6) = H(11) + (H(12) - H(11)) * RS DUCT1A.1245
H2(7) = H(13) + (H(14) - H(13)) * RS DUCT1A.1246
H2(8) = H(15) + (H(16) - H(15)) * RS DUCT1A.1247
C----------------------------------------------------------------------- DUCT1A.1248
C INTERPOLATE HEIGHT FOR CHANGE IN WIND SPEED DUCT1A.1249
C----------------------------------------------------------------------- DUCT1A.1250
RW = (WINDSPEED - VWIND(NW))/(VWIND(NW+1) - VWIND(NW)) DUCT1A.1251
H3(1) = H2(1) + (H2(2) - H2(1)) * RW DUCT1A.1252
H3(2) = H2(3) + (H2(4) - H2(3)) * RW DUCT1A.1253
H3(3) = H2(5) + (H2(6) - H2(5)) * RW DUCT1A.1254
H3(4) = H2(7) + (H2(8) - H2(7)) * RW DUCT1A.1255
C----------------------------------------------------------------------- DUCT1A.1256
C INTERPOLATE HEIGHT FOR CHANGE IN DEWPOINT DEPRESSION DUCT1A.1257
C----------------------------------------------------------------------- DUCT1A.1258
RD = (DPD - VDPD(ND))/(VDPD(ND+1) - VDPD(ND)) DUCT1A.1259
H4(1) = H3(1) + (H3(2) - H3(1)) * RD DUCT1A.1260
H4(2) = H3(3) + (H3(4) - H3(3)) * RD DUCT1A.1261
C----------------------------------------------------------------------- DUCT1A.1262
C INTERPOLATE HEIGHT FOR CHANGE IN SEA TEMPERATURE DEPRESSION DUCT1A.1263
C----------------------------------------------------------------------- DUCT1A.1264
RT = (STD - VSTD(NT))/(VSTD(NT+1) - VSTD(NT)) DUCT1A.1265
DUCT_HEIGHT = H4(1) + (H4(2) - H4(1)) * RT DUCT1A.1266
C----------------------------------------------------------------------- DUCT1A.1267
CL 10. Four dimensional interpolation of maximum wavelength DUCT1A.1268
C----------------------------------------------------------------------- DUCT1A.1269
W(1) = IW(NT,ND,NW,NS) DUCT1A.1270
W(2) = IW(NT,ND,NW,NS+1) DUCT1A.1271
C DUCT1A.1272
W(3) = IW(NT,ND,NW+1,NS) DUCT1A.1273
W(4) = IW(NT,ND,NW+1,NS+1) DUCT1A.1274
C DUCT1A.1275
W(5) = IW(NT,ND+1,NW,NS) DUCT1A.1276
W(6) = IW(NT,ND+1,NW,NS+1) DUCT1A.1277
W(7) = IW(NT,ND+1,NW+1,NS) DUCT1A.1278
W(8) = IW(NT,ND+1,NW+1,NS+1) DUCT1A.1279
C DUCT1A.1280
W(9) = IW(NT+1,ND,NW,NS) DUCT1A.1281
W(10) = IW(NT+1,ND,NW,NS+1) DUCT1A.1282
W(11) = IW(NT+1,ND,NW+1,NS) DUCT1A.1283
W(12) = IW(NT+1,ND,NW+1,NS+1) DUCT1A.1284
W(13) = IW(NT+1,ND+1,NW,NS) DUCT1A.1285
W(14) = IW(NT+1,ND+1,NW,NS+1) DUCT1A.1286
W(15) = IW(NT+1,ND+1,NW+1,NS) DUCT1A.1287
W(16) = IW(NT+1,ND+1,NW+1,NS+1) DUCT1A.1288
C----------------------------------------------------------------------- DUCT1A.1289
C INTERPOLATE WAVELENGTH CHANGE IN SEA TEMPERATURE DUCT1A.1290
C----------------------------------------------------------------------- DUCT1A.1291
W2(1) = W(1) + (W(2) - W(1)) * RS DUCT1A.1292
W2(2) = W(3) + (W(4) - W(3)) * RS DUCT1A.1293
W2(3) = W(5) + (W(6) - W(5)) * RS DUCT1A.1294
W2(4) = W(7) + (W(8) - W(7)) * RS DUCT1A.1295
W2(5) = W(9) + (W(10) - W(9)) * RS DUCT1A.1296
W2(6) = W(11) + (W(12) - W(11)) * RS DUCT1A.1297
W2(7) = W(13) + (W(14) - W(13)) * RS DUCT1A.1298
W2(8) = W(15) + (W(16) - W(15)) * RS DUCT1A.1299
C----------------------------------------------------------------------- DUCT1A.1300
C INTERPOLATE WAVELENGTH FOR CHANGE IN WIND SPEED DUCT1A.1301
C----------------------------------------------------------------------- DUCT1A.1302
W3(1) = W2(1) + (W2(2) - W2(1)) * RW DUCT1A.1303
W3(2) = W2(3) + (W2(4) - W2(3)) * RW DUCT1A.1304
W3(3) = W2(5) + (W2(6) - W2(5)) * RW DUCT1A.1305
W3(4) = W2(7) + (W2(8) - W2(7)) * RW DUCT1A.1306
C----------------------------------------------------------------------- DUCT1A.1307
C INTERPOLATE WAVELENGTH FOR CHANGE IN DEWPOINT DEPRESSION DUCT1A.1308
C----------------------------------------------------------------------- DUCT1A.1309
W4(1) = W3(1) + (W3(2) - W3(1)) * RD DUCT1A.1310
W4(2) = W3(3) + (W3(4) - W3(3)) * RD DUCT1A.1311
C----------------------------------------------------------------------- DUCT1A.1312
C INTERPOLATE WAVELENGTH FOR CHANGE IN SEA TEMPERATURE DEPRESSION DUCT1A.1313
C----------------------------------------------------------------------- DUCT1A.1314
MAX_WAVELENGTH = (W4(1) + (W4(2) - W4(1)) * RT)*0.01 DUCT1A.1315
RETURN DUCT1A.1316
END DUCT1A.1317
C----------------------------------------------------------------------- DUCT1A.1318
C DUCT1A.1319
*ENDIF DUCT1A.1320