*IF DEF,W08_1A GLW1F404.43
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.15796
C GTS2F400.15797
C Use, duplication or disclosure of this code is subject to the GTS2F400.15798
C restrictions as set forth in the contract. GTS2F400.15799
C GTS2F400.15800
C Meteorological Office GTS2F400.15801
C London Road GTS2F400.15802
C BRACKNELL GTS2F400.15803
C Berkshire UK GTS2F400.15804
C RG12 2SZ GTS2F400.15805
C GTS2F400.15806
C If no contract has been raised with this copy of the code, the use, GTS2F400.15807
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.15808
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.15809
C Modelling at the above address. GTS2F400.15810
C ******************************COPYRIGHT****************************** GTS2F400.15811
C GTS2F400.15812
MTABS.3
SUBROUTINE MTABS (ml,kl, 1,1MTABS.4
*CALL ARGWVAL
MTABS.5
*CALL ARGWVSH
MTABS.6
*CALL ARGWVFD
MTABS.7
& icode) MTABS.8
MTABS.9
*CALL PARWVSH
MTABS.10
*CALL PARCONS
MTABS.11
MTABS.12
*CALL TYPWVSH
MTABS.13
*CALL TYPWVFD
MTABS.14
*CALL TYPWVAL
MTABS.15
MTABS.16
iu06=6 MTABS.17
C ---------------------------------------------------------------------- MTABS.18
C MTABS.19
C**** *MTABS* - ROUTINE TO COMPUTE TABLES USED FOR SHALLOW WATER. MTABS.20
C MTABS.21
C H.GUNTHER ECMWF 04/04/1990 MTABS.22
C MTABS.23
C* PURPOSE. MTABS.24
C ------- MTABS.25
C MTABS.26
C TO COMPUTE TABLES USED FOR SHALLOW WATER. MTABS.27
C MTABS.28
C** INTERFACE. MTABS.29
C ---------- MTABS.30
C MTABS.31
C *CALL* *MTABS (ML, KL)* MTABS.32
C *ML* - NUMBER OF FREQUENCIES. MTABS.33
C *KL* - NUMBER OF DIRECTIONS. MTABS.34
C MTABS.35
C METHOD. MTABS.36
C ------- MTABS.37
C MTABS.38
C TABLES FOR GROUP VELOCITY, WAVE NUMBER AND OMEGA/SINH(2KD) MTABS.39
C ARE COMPUTED AT ALL FREQUENCIES AND FOR A DEPTH TABLE MTABS.40
C OF LENGTH NDEPTH, STARTING AT DEPTHA METERS AND INCREMENTED MTABS.41
C BY DEPTHD METRES. MTABS.42
C MTABS.43
C EXTERNALS. MTABS.44
C ---------- MTABS.45
C MTABS.46
C *AKI* - FUNCTION TO COMPUTE WAVE NUMBER. MTABS.47
C MTABS.48
C REFERENCE. MTABS.49
C ---------- MTABS.50
C MTABS.51
C NONE. MTABS.52
C MTABS.53
C ---------------------------------------------------------------------- MTABS.54
C MTABS.55
DEPTHA = 5. MTABS.56
DEPTHD = 1.1 MTABS.57
C MTABS.58
C ---------------------------------------------------------------------- MTABS.59
C MTABS.60
C* 1. GROUP VELOCITY AND WAVE NUMBER. MTABS.61
C ------------------------------- MTABS.62
C MTABS.63
1000 CONTINUE MTABS.64
C MTABS.65
C* 1.1 LOOP OVER FREQUENCIES. MTABS.66
C ---------------------- MTABS.67
C MTABS.68
1100 CONTINUE MTABS.69
GH = G/(4.*PI) MTABS.70
DO 1101 M=1,ML MTABS.71
OM=ZPI*FR(M) MTABS.72
C MTABS.73
C* 1.1.1 LOOP OVER DEPTH. MTABS.74
C ----------------- MTABS.75
C MTABS.76
1110 CONTINUE MTABS.77
DO 1111 JD=1,NDEPTH MTABS.78
AD=DEPTHA*DEPTHD**(JD-1) MTABS.79
AK=AKI
(OM,AD) MTABS.80
TFAK(JD,M)=AK MTABS.81
AKD=AK*AD MTABS.82
IF(AKD.LE.10.0) THEN MTABS.83
TCGOND(JD,M) = 0.5*SQRT(G*TANH(AKD)/AK)* MTABS.84
1 (1.0+2.0*AKD/SINH(2.*AKD)) MTABS.85
TSIHKD(JD,M) = OM/SINH(2.*AKD) MTABS.86
ELSE MTABS.87
TCGOND(JD,M) = GH/FR(M) MTABS.88
TSIHKD(JD,M) = 0. MTABS.89
ENDIF MTABS.90
1111 CONTINUE MTABS.91
1101 CONTINUE MTABS.92
C MTABS.93
C ---------------------------------------------------------------------- MTABS.94
C MTABS.95
C* 2. PRINT TABLES. MTABS.96
C ------------- MTABS.97
C MTABS.98
2000 CONTINUE MTABS.99
NAN = 10 MTABS.100
NSTP = NDEPTH/NAN MTABS.101
NSTP = MAX(NSTP,1) MTABS.102
DEPTHE = DEPTHA*DEPTHD**(NDEPTH-1) MTABS.103
WRITE (IU06,'(1H1, '' SHALLOW WATER TABLES:'',/)') MTABS.104
WRITE (IU06,'('' LOGARITHMIC DEPTH FROM: DEPTHA = '',F5.1, MTABS.105
1 '' TO DEPTHE = '',F5.1, ''IN STEPS OF DEPTHD = '',F5.1)') MTABS.106
2 DEPTHA, DEPTHE, DEPTHD MTABS.107
WRITE (IU06,'('' PRINTED IN STEPS OF '',I3,'' ENTRIES'',/)') NSTP MTABS.108
DO 2001 JD=1,NDEPTH,NSTP MTABS.109
AD=DEPTHA*DEPTHD**(JD-1) MTABS.110
WRITE (IU06,'(1X,''DEPTH = '',F7.1,'' METRES '')') AD MTABS.111
WRITE (IU06,'(1X,''GROUP VELOCITY IN METRES/SECOND'')') MTABS.112
WRITE (IU06,'(1x,13F10.5)') (TCGOND(JD,M),M=1,ML) MTABS.113
WRITE (IU06,'(1X,''WAVE NUMBER IN 1./METRES'')') MTABS.114
WRITE (IU06,'(1x,13F10.5)') (TFAK(JD,M),M=1,ML) MTABS.115
WRITE (IU06,'(1X,''OMEGA/SINH(2KD) IN 1./SECOND'')') MTABS.116
WRITE (IU06,'(1x,13F10.5)') (TSIHKD(JD,M),M=1,ML) MTABS.117
2001 CONTINUE MTABS.118
MTABS.119
RETURN MTABS.120
END MTABS.121
C MTABS.122
REAL FUNCTION AKI (OM, BETA) 1MTABS.123
MTABS.124
C ---------------------------------------------------------------------- MTABS.125
C MTABS.126
C**** *AKI* - FUNCTION TO COMPUTE WAVE NUMBER. MTABS.127
C MTABS.128
C G. KOMEN, P. JANSSEN KNMI 01/06/1986 MTABS.129
C MTABS.130
C* PURPOSE. MTABS.131
C ------- MTABS.132
C MTABS.133
C *AKI* COMPUTES THE WAVE NUMBER AS FUNCTION OF MTABS.134
C CIRCULAR FREQUENCY AND WATER DEPTH. MTABS.135
C MTABS.136
C** INTERFACE. MTABS.137
C ---------- MTABS.138
C MTABS.139
C *FUNCTION* *AKI (OM, BETA)* MTABS.140
C *OM* - CIRCULAR FREQUENCY. MTABS.141
C *BETA* - WATER DEPTH. MTABS.142
C MTABS.143
C METHOD. MTABS.144
C ------- MTABS.145
C MTABS.146
C NEWTONS METHOD TO SOLVE THE DISPERSION RELATION IN SHALLOW MTABS.147
C WATER. MTABS.148
C MTABS.149
C EXTERNALS. MTABS.150
C ---------- MTABS.151
C MTABS.152
C NONE. MTABS.153
C MTABS.154
C REFERENCE. MTABS.155
C ---------- MTABS.156
C MTABS.157
C NONE. MTABS.158
C MTABS.159
C ---------------------------------------------------------------------- MTABS.160
C MTABS.161
*CALL PARCONS
MTABS.162
C MTABS.163
C* *PARAMETER* RELATIVE ERROR LIMIT OF NEWTON'S METHOD. MTABS.164
C MTABS.165
PARAMETER (EBS = 0.0001) MTABS.166
C MTABS.167
C ---------------------------------------------------------------------- MTABS.168
C MTABS.169
C* 1. START VALUE: MAXIMUM FROM DEEP AND EXTREM SHALLOW WATER MTABS.170
C WAVE NUMBER. MTABS.171
C --------------------------------------------------------- MTABS.172
C MTABS.173
1000 CONTINUE MTABS.174
AKM1=OM**2/(4.*G) MTABS.175
AKM2=OM/(2.*SQRT(G*BETA)) MTABS.176
AO=AMAX1(AKM1,AKM2) MTABS.177
C MTABS.178
C ---------------------------------------------------------------------- MTABS.179
C MTABS.180
C* 2. ITERATION LOOP. MTABS.181
C --------------- MTABS.182
C MTABS.183
2000 CONTINUE MTABS.184
AKP = AO MTABS.185
BO = BETA*AO MTABS.186
IF (BO.GT.60.) THEN MTABS.187
AKI = OM**2/G MTABS.188
ELSE MTABS.189
TH = G*AO*TANH(BO) MTABS.190
STH = SQRT(TH) MTABS.191
AO = AO+(OM-STH)*STH*2./(TH/AO+G*BO/COSH(BO)**2) MTABS.192
IF (ABS(AKP-AO).GT.EBS*AO) GO TO 2000 MTABS.193
AKI = AO MTABS.194
ENDIF MTABS.195
MTABS.196
RETURN MTABS.197
END MTABS.198
*ENDIF MTABS.199