SUBROUTINE SDISSIP (F, FL, IJS, IJL, ishallo, 1SDISSIP.4
*CALL ARGWVAL 
SDISSIP.5
*CALL ARGWVFD SDISSIP.6
*CALL ARGWVMN SDISSIP.7
*CALL ARGWVSH SDISSIP.8
*CALL ARGWVSR SDISSIP.9
& icode) SDISSIP.10
SDISSIP.11
*CALL PARWVSH SDISSIP.12
*CALL PARCONS SDISSIP.13
PARAMETER (CDIS = 4.5) SDISSIP.14
PARAMETER (CONSD = -0.5*CDIS*ZPI**9/G**4) SDISSIP.15
PARAMETER (CONSS = -0.5*CDIS*ZPI) SDISSIP.16
SDISSIP.17
*CALL TYPWVFD SDISSIP.18
*CALL TYPWVMN SDISSIP.19
*CALL TYPWVSH SDISSIP.20
*CALL TYPWVSR SDISSIP.21
*CALL TYPWVAL SDISSIP.22
SDISSIP.23
C ---------------------------------------------------------------------- SDISSIP.24
C SDISSIP.25
C**** *SDISSIP* - COMPUTATION OF DISSIPATION SOURCE FUNCTION. SDISSIP.26
C SDISSIP.27
C S.D.HASSELMANN. SDISSIP.28
C MODIFIED TO SHALLOW WATER : G. KOMEN , P. JANSSEN SDISSIP.29
C OPTIMIZATION : L. ZAMBRESKY SDISSIP.30
C SDISSIP.31
C* PURPOSE. SDISSIP.32
C -------- SDISSIP.33
C COMPUTE DISSIPATION SOURCE FUNCTION AND STORE ADDITIVELY INTO SDISSIP.34
C NET SOURCE FUNCTION ARRAY. ALSO COMPUTE FUNCTIONAL DERIVATIVE SDISSIP.35
C OF DISSIPATION SOURCE FUNCTION. SDISSIP.36
C SDISSIP.37
C** INTERFACE. SDISSIP.38
C ---------- SDISSIP.39
C SDISSIP.40
C *CALL* *SDISSIP (F, FL, IJS, IJL)* SDISSIP.41
C *F* - SPECTRUM. SDISSIP.42
C *FL* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE SDISSIP.43
C *IJS* - INDEX OF FIRST GRIDPOINT SDISSIP.44
C *IJL* - INDEX OF LAST GRIDPOINT SDISSIP.45
C SDISSIP.46
C METHOD. SDISSIP.47
C ------- SDISSIP.48
C SDISSIP.49
C SEE REFERENCES. SDISSIP.50
C SDISSIP.51
C EXTERNALS. SDISSIP.52
C ---------- SDISSIP.53
C SDISSIP.54
C NONE. SDISSIP.55
C SDISSIP.56
C REFERENCE. SDISSIP.57
C ---------- SDISSIP.58
C SDISSIP.59
C G.KOMEN, S. HASSELMANN AND K. HASSELMANN, ON THE EXISTENCE SDISSIP.60
C OF A FULLY DEVELOPED WINDSEA SPECTRUM, JGR, 1984. SDISSIP.61
C SDISSIP.62
C ---------------------------------------------------------------------- SDISSIP.63
C SDISSIP.64
DIMENSION TEMP1(NIBLO), SDS(NIBLO) SDISSIP.65
C SDISSIP.66
C ---------------------------------------------------------------------- SDISSIP.67
C SDISSIP.68
DIMENSION F(0:NIBLO,NANG,NFRE), FL(0:NIBLO,NANG,NFRE) SDISSIP.69
C ---------------------------------------------------------------------- SDISSIP.70
C SDISSIP.71
C* 1. ADDING DISSIPATION AND ITS FUNCTIONAL DERIVATIVE TO NET SOURCE SDISSIP.72
C* FUNCTION AND NET SOURCE FUNCTION DERIVATIVE. SDISSIP.73
C -------------------------------------------------------------- SDISSIP.74
C SDISSIP.75
2000 CONTINUE SDISSIP.76
IF (ISHALLO.EQ.1) THEN SDISSIP.77
DO 2001 IJ=IJS,IJL SDISSIP.78
SDS(IJ) = CONSD*EMEAN(IJ)**2*FMEAN(IJ)**9 SDISSIP.79
2001 CONTINUE SDISSIP.80
SDISSIP.81
DO 2002 M=1,NFRE SDISSIP.82
DO 2003 IJ=IJS,IJL SDISSIP.83
X = (FR(M)/FMEAN(IJ))**2 SDISSIP.84
TEMP1(IJ) = SDS(IJ)*( X + X**2) SDISSIP.85
2003 CONTINUE SDISSIP.86
DO 2004 K=1,NANG SDISSIP.87
DO 2005 IJ=IJS,IJL SDISSIP.88
SL(IJ,K,M) = SL(IJ,K,M)+TEMP1(IJ)*F(IJ,K,M) SDISSIP.89
FL(IJ,K,M) = FL(IJ,K,M)+TEMP1(IJ) SDISSIP.90
2005 CONTINUE SDISSIP.91
2004 CONTINUE SDISSIP.92
2002 CONTINUE SDISSIP.93
ELSE SDISSIP.94
CSHALLOW SDISSIP.95
DO 2101 IJ=IJS,IJL SDISSIP.96
SDS(IJ) = CONSS*FMEAN(IJ)*EMEAN(IJ)**2*AKMEAN(IJ)**4 SDISSIP.97
2101 CONTINUE SDISSIP.98
SDISSIP.99
DO 2102 M=1,NFRE SDISSIP.100
DO 2103 IJ=IJS,IJL SDISSIP.101
X = TFAK(INDEP(IJ),M)/AKMEAN(IJ) SDISSIP.102
TEMP1(IJ) = SDS(IJ)*( X + X**2) SDISSIP.103
2103 CONTINUE SDISSIP.104
DO 2104 K=1,NANG SDISSIP.105
DO 2105 IJ=IJS,IJL SDISSIP.106
SL(IJ,K,M) = SL(IJ,K,M)+TEMP1(IJ)*F(IJ,K,M) SDISSIP.107
FL(IJ,K,M) = FL(IJ,K,M)+TEMP1(IJ) SDISSIP.108
2105 CONTINUE SDISSIP.109
2104 CONTINUE SDISSIP.110
2102 CONTINUE SDISSIP.111
CSHALLOW SDISSIP.112
ENDIF SDISSIP.113
C SDISSIP.114
RETURN SDISSIP.115
END SDISSIP.116
*ENDIF SDISSIP.117