SUBROUTINE VAGDIRT(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PFREQ,PFBIN, 1VAGDIRT.25
% PTHETA,PMISS,PTHETM,df) VAGDIRT.26
C VAGDIRT.27
C**** *VAGDIRT* - ROUTINE TO COMPUTE MEAN WAVE DIRECTION. VAGDIRT.28
C VAGDIRT.29
C A.GUILLAUME ECMWF 13/3/92. VAGDIRT.30
C VAGDIRT.31
C VAGDIRT.32
C PURPOSE. VAGDIRT.33
C -------- VAGDIRT.34
C *VAGDIRT* CACULATES THE MEAN DIRECTIONS OF WAVE FIELD. VAGDIRT.35
C DIRECTIONS ARE GIVEN IN RADIAN. VAGDIRT.36
C VAGDIRT.37
C** INTERFACE. VAGDIRT.38
C ---------- VAGDIRT.39
C *CALL* *VAGDIRT(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PFREQ,PFBIN, VAGDIRT.40
C PTHETA,PMISS,PTHETM)* VAGDIRT.41
C VAGDIRT.42
C I/ *PSPEC* - SPECTRUM. VAGDIRT.43
C I/ *KBLO* - DIMENSION OF ONE BLOCK. VAGDIRT.44
C I/ *KJS* - INDEX OF FIRST POINT OF BLOCK TO USE. VAGDIRT.45
C I/ *KJL* - INDEX OF LAST POINT OF BLOCK TO USE. VAGDIRT.46
C I/ *KANG* - NUMBER OF DIRECTIONS. VAGDIRT.47
C I/ *KFRE* - NUMBER OF FREQUENCIES. VAGDIRT.48
C I/ *PFREQ* - FREQUENCY ARRAY. VAGDIRT.49
C I/ *PFBIN* - PFREQ(IF+1)=PFREQ(IF)*(1+PFBIN) VAGDIRT.50
C I/ *PTHETA - DIRECTIONS ARRAY. VAGDIRT.51
C I/ *PMISS - MISSING VALUE WHEN PTHETM CANNOT BE COMPUTED. VAGDIRT.52
C /O *PTHETM* - MEAN WAVE DIRECTIONS. VAGDIRT.53
C VAGDIRT.54
C METHOD. VAGDIRT.55
C ------- VAGDIRT.56
C VAGDIRT.57
C EXTERNALS. VAGDIRT.58
C ---------- VAGDIRT.59
C VAGDIRT.60
C REFERENCES. VAGDIRT.61
C ----------- VAGDIRT.62
C VAGDIRT.63
DIMENSION PSPEC(KBLO,KANG,KFRE),PTHETM(KBLO) VAGDIRT.64
DIMENSION PFREQ(KFRE), PTHETA(KANG),df(kfre) VAGDIRT.65
C WORKING ARRAYS VAGDIRT.66
DIMENSION ZXX(KBLO),ZYY(KBLO),ZZZ(KBLO) VAGDIRT.67
C* *PARAMETER* OF GLOBAL CONSTANTS. VAGDIRT.68
C VAGDIRT.69
CCC PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000., VAGDIRT.70
CCc 1 ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI, VAGDIRT.71
CCC 2 R = CIRC/ZPI) VAGDIRT.72
VAGDIRT.73
*CALL C_G 
VAGDIRT.74
*CALL C_PI VAGDIRT.75
VAGDIRT.76
ZPI=2.*PI VAGDIRT.77
RAD=PI_OVER_180 VAGDIRT.78
DEG=RECIP_PI_OVER_180 VAGDIRT.79
VAGDIRT.80
DO 1 J=KJS,KJL VAGDIRT.81
ZXX(J)=0. VAGDIRT.82
ZYY(J)=0. VAGDIRT.83
PTHETM(J)=PMISS VAGDIRT.84
1 CONTINUE VAGDIRT.85
DO 2 JANG=1,KANG VAGDIRT.86
DO 3 J=KJS,KJL VAGDIRT.87
ZZZ(J)=0. VAGDIRT.88
3 CONTINUE VAGDIRT.89
DO 4 JFRE=1,KFRE VAGDIRT.90
DO 4 J=KJS,KJL VAGDIRT.91
VAGDIRT.92
CCC ZZZ(J)=ZZZ(J)+PSPEC(J,JANG,JFRE) VAGDIRT.93
CCC % *PFREQ(JFRE)*(1.+1./(1.+PFBIN)) VAGDIRT.94
zzz(j)=zzz(j)+pspec(j,jang,jfre)*df(jfre) VAGDIRT.95
4 CONTINUE VAGDIRT.96
DO 6 J=KJS,KJL VAGDIRT.97
ZXX(J)=ZXX(J)+ZZZ(J)*COS(PTHETA(JANG)) VAGDIRT.98
ZYY(J)=ZYY(J)+ZZZ(J)*SIN(PTHETA(JANG)) VAGDIRT.99
6 CONTINUE VAGDIRT.100
2 CONTINUE VAGDIRT.101
DO 7 J=KJS,KJL VAGDIRT.102
ZZZ(J)=SQRT(AMAX1(ZXX(J)*ZXX(J)+ZYY(J)*ZYY(J),0.)) VAGDIRT.103
7 CONTINUE VAGDIRT.104
DO 8 J=KJS,KJL VAGDIRT.105
IF(ZZZ(J).EQ.0.) GO TO 8 VAGDIRT.106
PTHETM(J)=ACOS(AMIN1(1.,(AMAX1(-1.,ZXX(J)/ZZZ(J))))) VAGDIRT.107
C IN COMMENT, NON VECTORIALISED CODE OF THE NEXT TWO LINES. VAGDIRT.108
C IF(ZYY.LE.0.) PTHETM(IGR)=-PTHETM(IGR)+2*PI VAGDIRT.109
ZXX(J)=AMAX1(0.,SIGN(1.,ZYY(J))) VAGDIRT.110
PTHETM(J)=PTHETM(J)*ZXX(J)+(-PTHETM(J)+2*PI)*(1-ZXX(J)) VAGDIRT.111
8 CONTINUE VAGDIRT.112
RETURN VAGDIRT.113
END VAGDIRT.114
*ENDIF VAGDIRT.115