SUBROUTINE SINPUT (F, FL, IJS, IJL, IG, ishallo, 1SINPUT.4
*CALL ARGWVAL 
SINPUT.5
*CALL ARGWVCP SINPUT.6
*CALL ARGWVFD SINPUT.7
*CALL ARGWVMN SINPUT.8
*CALL ARGWVSH SINPUT.9
*CALL ARGWVSR SINPUT.10
*CALL ARGWVWD SINPUT.11
& icode) SINPUT.12
SINPUT.13
*CALL PARWVSH SINPUT.14
*CALL PARCONS SINPUT.15
*CALL PARWVSTR SINPUT.16
SINPUT.17
*CALL TYPWVCP SINPUT.18
*CALL TYPWVFD SINPUT.19
*CALL TYPWVMN SINPUT.20
*CALL TYPWVSH SINPUT.21
*CALL TYPWVSR SINPUT.22
*CALL TYPWVWD SINPUT.23
*CALL TYPWVAL SINPUT.24
SINPUT.25
C ---------------------------------------------------------------------- SINPUT.26
C SINPUT.27
C**** *SINPUT* - COMPUTATION OF INPUT SOURCE FUNCTION. SINPUT.28
C SINPUT.29
C P.A.E.M. JANSSEN KNMI AUGUST 1990 SINPUT.30
C SINPUT.31
C OPTIMIZED BY : H. GUENTHER SINPUT.32
C SINPUT.33
C* PURPOSE. SINPUT.34
C --------- SINPUT.35
C SINPUT.36
C COMPUTE INPUT SOURCE FUNCTION AND STORE ADDITIVELY INTO NET SINPUT.37
C SOURCE FUNCTION ARRAY, ALSO COMPUTE FUNCTIONAL DERIVATIVE OF SINPUT.38
C INPUT SOURCE FUNCTION. SINPUT.39
C SINPUT.40
C** INTERFACE. SINPUT.41
C ---------- SINPUT.42
C SINPUT.43
C *CALL* *SINPUT (F, FL, IJS, IJL, IG)* SINPUT.44
C *F* - SPECTRUM. SINPUT.45
C *FL* - DIAGONAL MATRIX OF FUNCTIONAL DERIVATIVE. SINPUT.46
C *IJS* - INDEX OF FIRST GRIDPOINT. SINPUT.47
C *IJL* - INDEX OF LAST GRIDPOINT. SINPUT.48
C *IG* - BLOCK NUMBER. SINPUT.49
C SINPUT.50
C METHOD. SINPUT.51
C ------- SINPUT.52
C SINPUT.53
C SEE REFERENCE. SINPUT.54
C SINPUT.55
C EXTERNALS. SINPUT.56
C ---------- SINPUT.57
C SINPUT.58
C NONE. SINPUT.59
C SINPUT.60
C REFERENCE. SINPUT.61
C ---------- SINPUT.62
C SINPUT.63
C P. JANSSEN, J.P.O., 1989. SINPUT.64
C P. JANSSEN, J.P.O., 1991 SINPUT.65
C SINPUT.66
C ---------------------------------------------------------------------- SINPUT.67
Ccc what to do about this ?? SINPUT.68
CDIR$ VFUNCTION EXPHF SINPUT.69
CDIR$ VFUNCTION ALOGHF SINPUT.70
C SINPUT.71
C ---------------------------------------------------------------------- SINPUT.72
C SINPUT.73
DIMENSION F(0:NIBLO,NANG,NFRE), FL(0:NIBLO,NANG,NFRE) SINPUT.74
C SINPUT.75
C ---------------------------------------------------------------------- SINPUT.76
C SINPUT.77
DIMENSION TEMP(NIBLO,NANG), TEMP1(NIBLO,NANG), SINPUT.78
1 UCO(NIBLO), ZCO(NIBLO), UCN(NIBLO), ZCN(NIBLO), SINPUT.79
2 UFAC1(NIBLO), UFAC2(NIBLO), CM(NIBLO) SINPUT.80
C SINPUT.81
C ---------------------------------------------------------------------- SINPUT.82
C SINPUT.83
C* 1. PRECALCULATED ANGULAR DEPENDENCE. SINPUT.84
C --------------------------------- SINPUT.85
C SINPUT.86
1000 CONTINUE SINPUT.87
DO 1001 K=1,NANG SINPUT.88
TKD=TH(K) SINPUT.89
DO 1002 IJ=IJS,IJL SINPUT.90
TEMP (IJ,K) = COS(TKD-THWOLD(IJ,IG)) SINPUT.91
TEMP1(IJ,K) = COS(TKD-THWNEW(IJ,ig)) SINPUT.92
1002 CONTINUE SINPUT.93
1001 CONTINUE SINPUT.94
C SINPUT.95
C ---------------------------------------------------------------------- SINPUT.96
C SINPUT.97
C* 2. LOOP OVER FREQUENCIES. SINPUT.98
C ---------------------- SINPUT.99
C SINPUT.100
CONST1 = XEPS*BETAMAX/XKAPPA**2 SINPUT.101
SINPUT.102
DO 2001 M=1,NFRE SINPUT.103
FAC = ZPI*FR(M) SINPUT.104
CONST=FAC*CONST1 SINPUT.105
C SINPUT.106
C* INVERSE OF PHASE VELOCITIES. SINPUT.107
C ---------------------------- SINPUT.108
C SINPUT.109
IF (ISHALLO.EQ.1) THEN SINPUT.110
DO 2002 IJ=IJS,IJL SINPUT.111
CM(IJ) = FAC/G SINPUT.112
2002 CONTINUE SINPUT.113
ELSE SINPUT.114
DO 2003 IJ=IJS,IJL SINPUT.115
CM(IJ) = TFAK(INDEP(IJ),M)/FAC SINPUT.116
2003 CONTINUE SINPUT.117
END IF SINPUT.118
C SINPUT.119
C* PRECALCULATE FREQUENCY DEPENDENCE. SINPUT.120
C ---------------------------------- SINPUT.121
C SINPUT.122
DO 2004 IJ=IJS,IJL SINPUT.123
UCO(IJ) = USOLD(IJ,IG)*CM(IJ) + ZALP SINPUT.124
ZCO(IJ) = ALOG(G*Z0OLD(IJ,IG)*CM(IJ)**2) SINPUT.125
UCN(IJ) = USNEW(IJ,ig)*CM(IJ) + ZALP SINPUT.126
ZCN(IJ) = ALOG(G*Z0NEW(IJ,ig)*CM(IJ)**2) SINPUT.127
2004 CONTINUE SINPUT.128
C SINPUT.129
C* 2.1 LOOP OVER DIRECTIONS. SINPUT.130
C --------------------- SINPUT.131
C SINPUT.132
DO 2101 K=1,NANG SINPUT.133
DO 2102 IJ=IJS,IJL SINPUT.134
UFAC1(IJ) = 0. SINPUT.135
UFAC2(IJ) = 0. SINPUT.136
2102 CONTINUE SINPUT.137
DO 2103 IJ=IJS,IJL SINPUT.138
IF (TEMP(IJ,K).GT.0.01) THEN SINPUT.139
X = TEMP(IJ,K)*UCO(IJ) SINPUT.140
ZARG = XKAPPA/X SINPUT.141
ZLOG = ZCO(IJ) + ZARG SINPUT.142
IF (ZLOG.LT.0.) THEN SINPUT.143
UFAC1(IJ) = CONST*EXP(ZLOG)*ZLOG**4*X**2 SINPUT.144
ENDIF SINPUT.145
ENDIF SINPUT.146
2103 CONTINUE SINPUT.147
C SINPUT.148
DO 2104 IJ=IJS,IJL SINPUT.149
IF (TEMP1(IJ,K).GT.0.01) THEN SINPUT.150
X = TEMP1(IJ,K)*UCN(IJ) SINPUT.151
ZARG = XKAPPA/X SINPUT.152
ZLOG = ZCN(IJ) + ZARG SINPUT.153
IF (ZLOG.LT.0.) THEN SINPUT.154
UFAC2(IJ) = CONST*EXP(ZLOG)*ZLOG**4*X**2 SINPUT.155
ENDIF SINPUT.156
ENDIF SINPUT.157
2104 CONTINUE SINPUT.158
C SINPUT.159
C* 2.2 ADDING INPUT SOURCE TERM TO NET SOURCE FUNCTION. SINPUT.160
C ------------------------------------------------ SINPUT.161
C SINPUT.162
DO 2201 IJ=IJS,IJL SINPUT.163
SL(IJ,K,M) = 0.5*(UFAC1(IJ)+UFAC2(IJ))*F(IJ,K,M) SINPUT.164
FL(IJ,K,M) = UFAC2(IJ) SINPUT.165
2201 CONTINUE SINPUT.166
2101 CONTINUE SINPUT.167
2001 CONTINUE SINPUT.168
SINPUT.169
RETURN SINPUT.170
END SINPUT.171
*ENDIF SINPUT.172