*IF DEF,W08_1A GLW1F404.58
C Subroutine WAV_TO_D1 WAV_TO_D11.3
!+ Subroutine to convert blocked stress fields onto full grid and WAV_TO_D11.4
!+ place into D1 WAV_TO_D11.5
! Description: WAV_TO_D11.6
! input arrays are blocked ustar and wave induced stresses for the WAV_TO_D11.7
! timestep just completed WAV_TO_D11.8
! these are converted onto the full grid and placied into D1 WAV_TO_D11.9
! WAV_TO_D11.10
! Method: WAV_TO_D11.11
! use wind directions in thwnew to get components WAV_TO_D11.12
! call unblok to go to full grid WAV_TO_D11.13
! WAV_TO_D11.14
! Current Code Owner: Martin Holt WAV_TO_D11.15
! WAV_TO_D11.16
! History: WAV_TO_D11.17
! Version Date Comment WAV_TO_D11.18
! ------- ---- ------- WAV_TO_D11.19
! UM4.1 July 1996 Original code. M Holt WAV_TO_D11.20
! WAV_TO_D11.21
! Code Description: WAV_TO_D11.22
! Language: FORTRAN 77 + common extensions. WAV_TO_D11.23
! WAV_TO_D11.24
!- End of header WAV_TO_D11.25
Subroutine WAV_TO_D1(mdata, ,4WAV_TO_D11.26
*CALL ARGWVAL
WAV_TO_D11.27
*CALL ARGWVGD
WAV_TO_D11.28
WAV_TO_D11.29
& ustar_in, WAV_TO_D11.30
& windir_in, WAV_TO_D11.31
& tauw_in, WAV_TO_D11.32
WAV_TO_D11.33
& wvstressx_out, WAV_TO_D11.34
& wvstressy_out, WAV_TO_D11.35
& taux_out, WAV_TO_D11.36
& tauy_out, WAV_TO_D11.37
& icode,cmessage) WAV_TO_D11.38
WAV_TO_D11.39
implicit none WAV_TO_D11.40
WAV_TO_D11.41
*CALL TYPWVAL
WAV_TO_D11.42
*CALL TYPWVGD
WAV_TO_D11.43
WAV_TO_D11.44
C ARRAYS IN WAV_TO_D11.45
WAV_TO_D11.46
INTEGER mdata ! total number of data points WAV_TO_D11.47
INTEGER ICODE WAV_TO_D11.48
WAV_TO_D11.49
CHARACTER*80 CMESSAGE WAV_TO_D11.50
WAV_TO_D11.51
REAL WAV_TO_D11.52
& ustar_in(niblo,nblo) ! blocked u* values (usnew) WAV_TO_D11.53
& ,windir_in(niblo,nblo) ! blocked dir values (thwnew) WAV_TO_D11.54
& ,tauw_in(niblo,nblo) ! blocked wv stress values (tauw) WAV_TO_D11.55
WAV_TO_D11.56
WAV_TO_D11.57
C ARRAYS OUT WAV_TO_D11.58
WAV_TO_D11.59
REAL WAV_TO_D11.60
& wvstressx_out(mdata) ! x cmpt tauw D1(jwv_stressx) WAV_TO_D11.61
& ,wvstressy_out(mdata) ! y cmpt tauw D1(jwv_stressy) WAV_TO_D11.62
& ,taux_out(mdata) ! x cmpt ustar D1(jwv_taux) WAV_TO_D11.63
& ,tauy_out(mdata) ! y cmpt ustar D1(jwv_tauy) WAV_TO_D11.64
WAV_TO_D11.65
C LOCAL ARRAYS WAV_TO_D11.66
WAV_TO_D11.67
INTEGER ig,ii ! loop counters WAV_TO_D11.68
WAV_TO_D11.69
REAL WAV_TO_D11.70
& ustarx(niblo,nblo) ! to hold x comp ustar before unblocking WAV_TO_D11.71
& ,ustary(niblo,nblo) ! y back into D1 WAV_TO_D11.72
& ,tauwx(niblo,nblo) ! " tauw WAV_TO_D11.73
& ,tauwy(niblo,nblo) ! " WAV_TO_D11.74
WAV_TO_D11.75
WAV_TO_D11.76
C first get arrays of components WAV_TO_D11.77
WAV_TO_D11.78
do ig=1,nblo WAV_TO_D11.79
do ii=1,niblo WAV_TO_D11.80
ustarx(ii,ig)=0. WAV_TO_D11.81
ustary(ii,ig)=0. WAV_TO_D11.82
WAV_TO_D11.83
tauwy(ii,ig)=0. WAV_TO_D11.84
tauwx(ii,ig)=0. WAV_TO_D11.85
enddo WAV_TO_D11.86
enddo WAV_TO_D11.87
WAV_TO_D11.88
do ig=1,igl WAV_TO_D11.89
WAV_TO_D11.90
do ii=ijs(ig),ijl(ig) WAV_TO_D11.91
WAV_TO_D11.92
C note WAM direction convention has zero north increasing clockwise WAV_TO_D11.93
WAV_TO_D11.94
ustarx(ii,ig)=ustar_in(ii,ig)*sin(windir_in(ii,ig)) WAV_TO_D11.95
ustary(ii,ig)=ustar_in(ii,ig)*cos(windir_in(ii,ig)) WAV_TO_D11.96
WAV_TO_D11.97
tauwx(ii,ig)=tauw_in(ii,ig)*sin(windir_in(ii,ig)) WAV_TO_D11.98
tauwy(ii,ig)=tauw_in(ii,ig)*cos(windir_in(ii,ig)) WAV_TO_D11.99
WAV_TO_D11.100
enddo WAV_TO_D11.101
enddo WAV_TO_D11.102
WAV_TO_D11.103
CALL unblok
(wvstressx_out WAV_TO_D11.104
& ,tauwx WAV_TO_D11.105
& ,mdata, WAV_TO_D11.106
*CALL ARGWVAL
WAV_TO_D11.107
*CALL ARGWVGD
WAV_TO_D11.108
& icode) WAV_TO_D11.109
WAV_TO_D11.110
CALL unblok
(wvstressy_out WAV_TO_D11.111
& ,tauwy WAV_TO_D11.112
& ,mdata, WAV_TO_D11.113
*CALL ARGWVAL
WAV_TO_D11.114
*CALL ARGWVGD
WAV_TO_D11.115
& icode) WAV_TO_D11.116
WAV_TO_D11.117
CALL unblok
(taux_out WAV_TO_D11.118
& ,ustarx WAV_TO_D11.119
& ,mdata, WAV_TO_D11.120
*CALL ARGWVAL
WAV_TO_D11.121
*CALL ARGWVGD
WAV_TO_D11.122
& icode) WAV_TO_D11.123
WAV_TO_D11.124
CALL unblok
(tauy_out WAV_TO_D11.125
& ,ustary WAV_TO_D11.126
& ,mdata, WAV_TO_D11.127
*CALL ARGWVAL
WAV_TO_D11.128
*CALL ARGWVGD
WAV_TO_D11.129
& icode) WAV_TO_D11.130
WAV_TO_D11.131
return WAV_TO_D11.132
end WAV_TO_D11.133
*ENDIF WAV_TO_D11.134