-
Notifications
You must be signed in to change notification settings - Fork 0
/
wwm_coupl_roms_pipe.F90
213 lines (212 loc) · 8.68 KB
/
wwm_coupl_roms_pipe.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
#include "wwm_functions.h"
#if !defined ROMS_WWM_PGMCL_COUPLING && !defined MODEL_COUPLING_ATM_WAV && !defined MODEL_COUPLING_OCN_WAV
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE INIT_PIPES_ROMS()
USE DATAPOOL
IMPLICIT NONE
!
! open pipe data files for coupling
!
LSEWL = .TRUE.
LSECU = .TRUE.
WRITE(DBG%FHNDL,'("+TRACE...",A)') 'OPEN PIPE ROMS'
FLUSH(DBG%FHNDL)
! Pipes that are read by the wave model
OPEN(1000,file='pipe/ExchRW' ,form='unformatted', action='read')
WRITE(DBG%FHNDL,*) 'WWM: open pipe ExchImport'
FLUSH(DBG%FHNDL)
! Pipes that are written by the wave modell
OPEN(101 ,file='pipe/ExchWR' ,form='unformatted', action='write')
WRITE(DBG%FHNDL,*) 'WWM: open pipe ExchExport'
FLUSH(DBG%FHNDL)
WRITE(DBG%FHNDL,'("+TRACE...",A)') 'END OPEN PIPE ROMS'
FLUSH(DBG%FHNDL)
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE TERMINATE_PIPES_ROMS()
USE DATAPOOL
IMPLICIT NONE
close(1000)
close(101)
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE PIPE_ROMS_IN(K,IFILE,IT)
USE DATAPOOL
IMPLICIT NONE
INTEGER, INTENT(IN) :: K,IFILE,IT
INTEGER :: IP
# ifdef WWM_MPI
REAL(rkind), allocatable :: WINDXY_TOT(:,:), CURTXY_TOT(:,:), WATLEV_TOT(:)
real(rkind), allocatable :: rbuf_real(:)
integer idx, iProc
# endif
LCALC=.TRUE.
IF ( K-INT(K/MAIN%ICPLT)*MAIN%ICPLT .EQ. 0 ) THEN
WATLEVOLD=WATLEV
LCALC=.TRUE.
WRITE(DBG%FHNDL,'("+TRACE...",A)') 'READING PIPE'
FLUSH(DBG%FHNDL)
# ifndef WWM_MPI
DO IP = 1, MNP
READ(1000) WINDXY(IP,1), WINDXY(IP,2), CURTXY(IP,1), CURTXY(IP,2), WATLEV(IP)
END DO
# else
allocate(WINDXY_TOT(np_global,2), CURTXY_TOT(np_global,2), WATLEV_TOT(np_global), rbuf_real(np_global*5), stat=istat)
IF (istat/=0) CALL WWM_ABORT('wwm_coupl_roms, allocate err')
IF (myrank.eq.0) THEN
DO IP = 1, np_global
READ(1000) WINDXY_TOT(IP,1), WINDXY_TOT(IP,2), CURTXY_TOT(IP,1), CURTXY_TOT(IP,2), WATLEV_TOT(IP)
END DO
DO IP=1,np_global
idx=idx+1
rbuf_real(idx)=WINDXY_TOT(IP,1)
idx=idx+1
rbuf_real(idx)=WINDXY_TOT(IP,2)
idx=idx+1
rbuf_real(idx)=CURTXY_TOT(IP,1)
idx=idx+1
rbuf_real(idx)=CURTXY_TOT(IP,2)
idx=idx+1
rbuf_real(idx)=WATLEV_TOT(IP)
END DO
DO iProc=2,nproc
CALL MPI_SEND(rbuf_real,np_global*5,MPI_REAL8, iProc-1, 196, comm, ierr)
END DO
ELSE
CALL MPI_RECV(rbuf_real,np_global*5,MPI_REAL8, 0, 196, comm, istatus, ierr)
idx=0
DO IP=1,np_global
idx=idx+1
WINDXY_TOT(IP,1)=rbuf_real(idx)
idx=idx+1
WINDXY_TOT(IP,2)=rbuf_real(idx)
idx=idx+1
CURTXY_TOT(IP,1)=rbuf_real(idx)
idx=idx+1
CURTXY_TOT(IP,2)=rbuf_real(idx)
idx=idx+1
WATLEV_TOT(IP)=rbuf_real(idx)
END DO
END IF
DO IP = 1, MNP
WINDXY(IP,:)=WINDXY_TOT(iplg(IP),:)
CURTXY(IP,:)=CURTXY_TOT(iplg(IP),:)
WATLEV(IP)=WATLEV_TOT(iplg(IP))
END DO
deallocate(rbuf_real, WINDXY_TOT, CURTXY_TOT, WATLEV_TOT)
# endif
DEPDT = (WATLEV - WATLEVOLD) / MAIN%DTCOUP
WRITE(DBG%FHNDL,'("+TRACE...",A)') 'END READING PIPE'
FLUSH(DBG%FHNDL)
END IF
IF (K == 1) CALL INITIAL_CONDITION
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE PIPE_ROMS_OUT(K)
USE DATAPOOL
IMPLICIT NONE
INTEGER, INTENT(IN) :: K
INTEGER :: IP
REAL(rkind) :: ACLOC(MSC,MDC)
REAL(rkind) :: HS,WLM,LPP,FPP,CPP,BOTEXPER
REAL(rkind) :: UBOT,TM01,TM10
REAL(rkind) :: TMBOT, KPP,DM,DSPR,ORBITAL,ETOTS,ETOTC,WNPP,TPP,CGPP
REAL(rkind) :: PEAKDSPR, PEAKDM, HSWE, HSLIM, TM02, KLM, DPEAK
REAL(rkind) :: TPPD,KPPD,CGPD,CPPD
# ifdef WWM_MPI
REAL(rkind), allocatable :: OUTT(:,:), OUTT_TOT(:,:)
REAL(rkind) :: TP
# endif
IF ( K-INT(K/MAIN%ICPLT)*MAIN%ICPLT .EQ. 0 ) THEN
# ifndef WWM_MPI
DO IP = 1, MNP
ACLOC = AC2(:,:,IP)
CALL MEAN_PARAMETER(IP,ACLOC,MSC,HS,TM01,TM02,TM10,KLM,WLM)
CALL WAVE_CURRENT_PARAMETER(IP,ACLOC,UBOT,ORBITAL,BOTEXPER,TMBOT,'PIPE_ROMS_OUT 1')
CALL MEAN_DIRECTION_AND_SPREAD(IP,ACLOC,MSC,ETOTS,ETOTC,DM,DSPR)
CALL PEAK_PARAMETER(IP,ACLOC,MSC,FPP,TPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKDM,DPEAK,TPPD,KPPD,CGPD,CPPD)
! HS, HSWE, HSLIM ! - Significant wave height (m) -- HS
! DM ! - Wave direction (degrees)
! TPP ! - Surface wave relative peak period (s) -- TP
! WLM, KME, SME ! - Average Wave Length [m] - LME
! ORBITAL(IP) ! - Wave bottom orbital velocity (m/s)
! TMBOT ! - Bottom wave period (s)
! DISSIPATION(IP) ! - Wave energy dissipation (W/m2)
! QBLOCAL(IP) ! - Percent of breakig waves (nondimensional)
! DSPR ! - directional spreading
! PEAKDSPR ! - peak directional spreading
! PEAKDM ! - Peak direction
!
!AR: what for you need this HSWE and HSLIM and so on ... what is exactly SME in your definition ...
!AR: I have deleted them ...
!
HSWE=0
HSLIM=0
WRITE(101) HS, HSWE, &
& HSLIM, DM, &
& TPP, WLM, &
& KLM, TM01, &
& ORBITAL, TMBOT, &
& DISSIPATION(IP), QBLOCAL(IP), &
& DSPR, PEAKDSPR, &
& PEAKDM, TM02
FLUSH(101)
END DO
# else
allocate(OUTT(np_global,16), OUTT_TOT(np_global,16), stat=istat)
IF (istat/=0) CALL WWM_ABORT('wwm_coupl_roms, allocate err')
OUTT=0
DO IP = 1, MNP
ACLOC = AC2(:,:,IP)
CALL MEAN_PARAMETER(IP,ACLOC,MSC,HS,TM01,TM02,TM10,KLM,WLM)
CALL WAVE_CURRENT_PARAMETER(IP,ACLOC,UBOT,ORBITAL,BOTEXPER,TMBOT,'PIPE_ROMS_OUT 2')
CALL MEAN_DIRECTION_AND_SPREAD(IP,ACLOC,MSC,ETOTS,ETOTC,DM,DSPR)
CALL PEAK_PARAMETER(IP,ACLOC,MSC,FPP,TPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKDM,DPEAK,TPPD,KPPD,CGPD,CPPD)
HSWE=0
HSLIM=0
OUTT(iplg(IP), 1)=HS
OUTT(iplg(IP), 2)=HSWE
OUTT(iplg(IP), 3)=HSLIM
OUTT(iplg(IP), 4)=DM
OUTT(iplg(IP), 5)=TPP
OUTT(iplg(IP), 6)=WLM
OUTT(iplg(IP), 7)=KLM
OUTT(iplg(IP), 8)=TM01
OUTT(iplg(IP), 9)=ORBITAL
OUTT(iplg(IP),10)=TMBOT
OUTT(iplg(IP),11)=DISSIPATION(IP)
OUTT(iplg(IP),12)=QBLOCAL(IP)
OUTT(iplg(IP),13)=DSPR
OUTT(iplg(IP),14)=PEAKDSPR
OUTT(iplg(IP),15)=PEAKDM
OUTT(iplg(IP),16)=TM02
END DO
call mpi_reduce(OUTT,OUTT_TOT,NP_GLOBAL*16,rtype,MPI_SUM,0,comm,ierr)
IF (myrank.eq.0) THEN
DO IP=1,NP_GLOBAL
OUTT_TOT(IP,:)=OUTT_TOT(IP,:)/nwild_gb(IP)
WRITE(101) OUTT_TOT(IP, 1), OUTT_TOT(IP, 2), &
& OUTT_TOT(IP, 3), OUTT_TOT(IP, 4), &
& OUTT_TOT(IP, 5), OUTT_TOT(IP, 6), &
& OUTT_TOT(IP, 7), OUTT_TOT(IP, 8), &
& OUTT_TOT(IP, 9), OUTT_TOT(IP,10), &
& OUTT_TOT(IP,11), OUTT_TOT(IP,12), &
& OUTT_TOT(IP,13), OUTT_TOT(IP,14), &
& OUTT_TOT(IP,15), OUTT_TOT(IP,16)
END DO
END IF
deallocate(OUTT, OUTT_TOT)
# endif
END IF
WRITE(DBG%FHNDL,*) 'export WWM: ending of writing data'
FLUSH(DBG%FHNDL)
END SUBROUTINE
#endif