WAVEWATCH III  beta 0.0.1
pdlib_field_vec.F90
Go to the documentation of this file.
1 MODULE pdlib_field_vec
2  !/ +-----------------------------------+
3  !/ | WAVEWATCH III NOAA/NCEP |
4  !/ | |
5  !/ | Aron Roland (BGS IT&E GmbH) |
6  !/ | Mathieu Dutour-Sikiric (IRB) |
7  !/ | |
8  !/ | FORTRAN 90 |
9  !/ | Last update : 22-Mar-2021 |
10  !/ +-----------------------------------+
11  !/
12  !/ 01-Jan-2010 : Origination. ( version 6.04 )
13  !/ 22-Mar-2021 : Add WNMEAN, TAUOC output ( version 7.13 )
14  !/
15  !/ Copyright 2010 National Weather Service (NWS),
16  !/ National Oceanic and Atmospheric Administration. All rights
17  !/ reserved. WAVEWATCH III is a trademark of the NWS.
18  !/ No unauthorized use without permission.
19  !/
20  ! 1. Purpose : Provides parallel I/O in context of PDLIB
21  ! 2. Variables and types :
22  !
23  ! Name Type Scope Description
24  ! ----------------------------------------------------------------
25  ! ----------------------------------------------------------------
26  !
27  ! 3. Subroutines and functions :
28  !
29  ! Name Type Scope Description
30  ! ----------------------------------------------------------------
31  ! W3XXXX Subr. Public ........
32  ! ----------------------------------------------------------------
33  !
34  ! 4. Subroutines and functions used :
35  !
36  ! Name Type Module Description
37  ! ----------------------------------------------------------------
38  ! STRACE Subr. W3SERVMD Subroutine tracing.
39  ! ----------------------------------------------------------------
40  !
41  ! 5. Remarks :
42  ! 6. Switches :
43  !
44  ! !/S Enable subroutine tracing.
45  !
46  ! 7. Source code :
47  !/
48  !/ ------------------------------------------------------------------- /
49  !/
50 CONTAINS
51  !/ ------------------------------------------------------------------- /
52  !
53  SUBROUTINE get_array_size(TheSize)
54  !/
55  !/ +-----------------------------------+
56  !/ | WAVEWATCH III NOAA/NCEP |
57  !/ | |
58  !/ | Aron Roland (BGS IT&E GmbH) |
59  !/ | Mathieu Dutour-Sikiric (IRB) |
60  !/ | |
61  !/ | FORTRAN 90 |
62  !/ | Last update : 01-Mai-2018 |
63  !/ +-----------------------------------+
64  !/
65  !/ 01-Mai-2018 : Origination. ( version 6.04 )
66  !/
67  ! 1. Purpose : Estimate arrays size for communication
68  ! 2. Method :
69  ! 3. Parameters :
70  !
71  ! Parameter list
72  ! ----------------------------------------------------------------
73  ! ----------------------------------------------------------------
74  !
75  ! 4. Subroutines used :
76  !
77  ! Name Type Module Description
78  ! ----------------------------------------------------------------
79  ! STRACE Subr. W3SERVMD Subroutine tracing.
80  ! ----------------------------------------------------------------
81  !
82  ! 5. Called by :
83  !
84  ! Name Type Module Description
85  ! ----------------------------------------------------------------
86  ! ----------------------------------------------------------------
87  !
88  ! 6. Error messages :
89  ! 7. Remarks
90  ! 8. Structure :
91  ! 9. Switches :
92  !
93  ! !/S Enable subroutine tracing.
94  !
95  ! 10. Source code :
96  !
97  !/ ------------------------------------------------------------------- /
98 #ifdef W3_S
99  USE w3servmd, ONLY: strace
100 #endif
101  !
102  USE w3odatmd, ONLY: flogrd, flogr2, noswll, noextr, &
103  nogrp, ngrpp
104  USE w3gdatmd, ONLY: e3df, p2msf, nk
105  IMPLICIT NONE
106  INTEGER, INTENT(OUT) :: TheSize
107  LOGICAL :: FLGRDALL(NOGRP,NGRPP)
108  INTEGER IH, I, J, K, IK
109  !/
110  !/ ------------------------------------------------------------------- /
111  !/
112  DO j=1, nogrp
113  DO k=1, ngrpp
114  flgrdall(j,k) = (flogrd(j,k) .OR. flogr2(j,k))
115  END DO
116  END DO
117  ih = 0
118  IF ( flgrdall( 2, 1) ) THEN
119  ih = ih + 1
120  END IF
121  IF ( flgrdall( 2, 2) ) THEN
122  ih = ih + 1
123  END IF
124  IF ( flgrdall( 2, 3) ) THEN
125  ih = ih + 1
126  END IF
127  IF ( flgrdall( 2, 4) ) THEN
128  ih = ih + 1
129  END IF
130  IF ( flgrdall( 2, 5) ) THEN
131  ih = ih + 1
132  END IF
133  IF ( flgrdall( 2, 6) ) THEN
134  ih = ih + 1
135  END IF
136  IF ( flgrdall( 2, 7) ) THEN
137  ih = ih + 1
138  END IF
139  IF ( flgrdall( 2, 8) ) THEN
140  ih = ih + 1
141  END IF
142  IF ( flgrdall( 2, 9) ) THEN
143  ih = ih + 1
144  END IF
145  IF ( flgrdall( 2, 10) ) THEN
146  ih = ih + 1
147  END IF
148  IF ( flgrdall( 2, 11) ) THEN
149  ih = ih + 1
150  END IF
151  IF ( flgrdall( 2, 12) ) THEN
152  ih = ih + 1
153  END IF
154  IF ( flgrdall( 2, 13) ) THEN
155  ih = ih + 1
156  END IF
157  IF ( flgrdall( 2, 14) ) THEN
158  ih = ih + 1
159  END IF
160  IF ( flgrdall( 2, 15) ) THEN
161  ih = ih + 1
162  END IF
163  IF ( flgrdall( 2, 16) ) THEN
164  ih = ih + 1
165  END IF
166  IF ( flgrdall( 2, 17) ) THEN
167  ih = ih + 1
168  END IF
169  IF ( flgrdall( 2, 19) ) THEN
170  ih = ih + 1
171  END IF
172  IF ( flgrdall( 3, 1) ) THEN
173  DO ik=e3df(2,1),e3df(3,1)
174  ih = ih + 1
175  END DO
176  END IF
177  IF ( flgrdall( 3, 2) ) THEN
178  DO ik=e3df(2,2),e3df(3,2)
179  ih = ih + 1
180  END DO
181  END IF
182  IF ( flgrdall( 3, 3) ) THEN
183  DO ik=e3df(2,3),e3df(3,3)
184  ih = ih + 1
185  END DO
186  END IF
187  IF ( flgrdall( 3, 4) ) THEN
188  DO ik=e3df(2,4),e3df(3,4)
189  ih = ih + 1
190  END DO
191  END IF
192  IF ( flgrdall( 3, 5) ) THEN
193  DO ik=e3df(2,5),e3df(3,5)
194  ih = ih + 1
195  END DO
196  END IF
197  IF ( flgrdall( 4, 1) ) THEN
198  ih = ih + noswll + 1
199  END IF
200  IF ( flgrdall( 4, 2) ) THEN
201  ih = ih + noswll + 1
202  END IF
203  IF ( flgrdall( 4, 3) ) THEN
204  ih = ih + noswll + 1
205  END IF
206  IF ( flgrdall( 4, 4) ) THEN
207  ih = ih + noswll + 1
208  END IF
209  IF ( flgrdall( 4, 5) ) THEN
210  ih = ih + noswll + 1
211  END IF
212  IF ( flgrdall( 4, 6) ) THEN
213  ih = ih + noswll + 1
214  END IF
215  IF ( flgrdall( 4, 7) ) THEN
216  ih = ih + noswll + 1
217  END IF
218  IF ( flgrdall( 4, 8) ) THEN
219  ih = ih + noswll + 1
220  END IF
221  IF ( flgrdall( 4, 9) ) THEN
222  ih = ih + noswll + 1
223  END IF
224  IF ( flgrdall( 4,10) ) THEN
225  ih = ih + noswll + 1
226  END IF
227  IF ( flgrdall( 4,11) ) THEN
228  ih = ih + noswll + 1
229  END IF
230  IF ( flgrdall( 4,12) ) THEN
231  ih = ih + noswll + 1
232  END IF
233  IF ( flgrdall( 4,13) ) THEN
234  ih = ih + noswll + 1
235  END IF
236  IF ( flgrdall( 4,14) ) THEN
237  ih = ih + noswll + 1
238  END IF
239  IF ( flgrdall( 4,15) ) THEN
240  ih = ih + noswll + 1
241  END IF
242  IF ( flgrdall( 4,16) ) THEN
243  ih = ih + 1
244  END IF
245  IF ( flgrdall( 4,17) ) THEN
246  ih = ih + 1
247  END IF
248  IF ( flgrdall( 5, 1) ) THEN
249  ih = ih + 1
250  ih = ih + 1
251  ih = ih + 1
252  END IF
253  IF ( flgrdall( 5, 2) ) THEN
254  ih = ih + 1
255  END IF
256  IF ( flgrdall( 5, 3) ) THEN
257  ih = ih + 1
258  END IF
259  IF ( flgrdall( 5, 4) ) THEN
260  ih = ih + 1
261  END IF
262  IF ( flgrdall( 5, 5) ) THEN
263  ih = ih + 1
264  ih = ih + 1
265  END IF
266  IF ( flgrdall( 5, 6) ) THEN
267  ih = ih + 1
268  ih = ih + 1
269  END IF
270  IF ( flgrdall( 5, 7) ) THEN
271  ih = ih + 1
272  END IF
273  IF ( flgrdall( 5, 8) ) THEN
274  ih = ih + 1
275  END IF
276  IF ( flgrdall( 5, 9) ) THEN
277  ih = ih + 1
278  END IF
279  IF ( flgrdall( 5,10) ) THEN
280  ih = ih + 1
281  END IF
282  IF ( flgrdall( 6, 1) ) THEN
283  ih = ih + 1
284  ih = ih + 1
285  ih = ih + 1
286  END IF
287  IF ( flgrdall( 6, 2) ) THEN
288  ih = ih + 1
289  ih = ih + 1
290  END IF
291  IF ( flgrdall( 6, 3) ) THEN
292  ih = ih + 1
293  END IF
294  IF ( flgrdall( 6, 4) ) THEN
295  ih = ih + 1
296  END IF
297  IF ( flgrdall( 6, 5) ) THEN
298  ih = ih + 1
299  ih = ih + 1
300  END IF
301  IF ( flgrdall( 6, 6) ) THEN
302  ih = ih + 1
303  ih = ih + 1
304  END IF
305  IF ( flgrdall( 6, 7) ) THEN
306  ih = ih + 1
307  ih = ih + 1
308  END IF
309  IF ( flgrdall( 6, 8) ) THEN
310  DO ik=1,2*nk
311  ih = ih + 1
312  END DO
313  END IF
314  IF ( flgrdall( 6, 9) ) THEN
315  DO k=p2msf(2),p2msf(3)
316  ih = ih + 1
317  END DO
318  END IF
319  IF ( flgrdall( 6, 10) ) THEN
320  ih = ih + 1
321  ih = ih + 1
322  END IF
323  IF ( flgrdall( 6, 11) ) THEN
324  ih = ih + 1
325  END IF
326  IF ( flgrdall( 6, 12) ) THEN
327  DO ik=1,2*nk
328  ih = ih + 1
329  END DO
330  END IF
331  IF ( flgrdall( 6, 13) ) THEN
332  ih = ih + 1
333  ih = ih + 1
334  END IF
335  IF ( flgrdall( 7, 1) ) THEN
336  ih = ih + 1
337  ih = ih + 1
338  END IF
339  IF ( flgrdall( 7, 2) ) THEN
340  ih = ih + 1
341  ih = ih + 1
342  END IF
343  IF ( flgrdall( 7, 3) ) THEN
344  ih = ih + 1
345  ih = ih + 1
346  ih = ih + 1
347  END IF
348  IF ( flgrdall( 7, 4) ) THEN
349  ih = ih + 1
350  END IF
351  IF ( flgrdall( 7, 5) ) THEN
352  ih = ih + 1
353  ih = ih + 1
354  END IF
355  IF ( flgrdall( 8, 1) ) THEN
356  ih = ih + 1
357  ih = ih + 1
358  END IF
359  IF ( flgrdall( 8, 2) ) THEN
360  ih = ih + 1
361  ih = ih + 1
362  END IF
363  IF ( flgrdall( 8, 3) ) THEN
364  ih = ih + 1
365  END IF
366  IF ( flgrdall( 8, 4) ) THEN
367  ih = ih + 1
368  END IF
369  IF ( flgrdall( 8, 5) ) THEN
370  ih = ih + 1
371  END IF
372  IF ( flgrdall( 9, 1) ) THEN
373  ih = ih + 1
374  END IF
375  IF ( flgrdall( 9, 2) ) THEN
376  ih = ih + 1
377  END IF
378  IF ( flgrdall( 9, 3) ) THEN
379  ih = ih + 1
380  END IF
381  IF ( flgrdall( 9, 4) ) THEN
382  ih = ih + 1
383  END IF
384  IF ( flgrdall( 9, 5) ) THEN
385  ih = ih + 1
386  END IF
387  DO i=1, noextr
388  IF ( flgrdall(10, i) ) THEN
389  ih = ih + 1
390  END IF
391  END DO
392  thesize=ih
393  END SUBROUTINE get_array_size
394  !/ ------------------------------------------------------------------- /
395  SUBROUTINE unst_pdlib_read_from_file(NDREAD)
396  !/
397  !/ +-----------------------------------+
398  !/ | WAVEWATCH III NOAA/NCEP |
399  !/ | |
400  !/ | Aron Roland (BGS IT&E GmbH) |
401  !/ | Mathieu Dutour-Sikiric (IRB) |
402  !/ | |
403  !/ | FORTRAN 90 |
404  !/ | Last update : 01-Mai-2018 |
405  !/ +-----------------------------------+
406  !/
407  !/ 01-Mai-2018 : Origination. ( version 6.04 )
408  !/
409  ! 1. Purpose : PDLIB read from file
410  ! 2. Method :
411  ! 3. Parameters :
412  !
413  ! Parameter list
414  ! ----------------------------------------------------------------
415  ! ----------------------------------------------------------------
416  !
417  ! 4. Subroutines used :
418  !
419  ! Name Type Module Description
420  ! ----------------------------------------------------------------
421  ! STRACE Subr. W3SERVMD Subroutine tracing.
422  ! ----------------------------------------------------------------
423  !
424  ! 5. Called by :
425  !
426  ! Name Type Module Description
427  ! ----------------------------------------------------------------
428  ! ----------------------------------------------------------------
429  !
430  ! 6. Error messages :
431  ! 7. Remarks
432  ! 8. Structure :
433  ! 9. Switches :
434  !
435  ! !/S Enable subroutine tracing.
436  !
437  ! 10. Source code :
438  !
439  !/ ------------------------------------------------------------------- /
440 #ifdef W3_S
441  USE w3servmd, ONLY: strace
442 #endif
443  !
444 
445  use yowdatapool, only: istatus
446  USE w3gdatmd, only : nsea, nspec
447  USE w3odatmd, only : naproc, ntproc, iaproc
448  USE w3adatmd, only : mpi_comm_wave
449  USE w3parall, only : get_jsea_ibelong
450  USE w3wdatmd, ONLY : va
451  USE w3gdatmd, ONLY: nseal
452  USE w3adatmd, ONLY: nsealm
453  USE w3servmd, ONLY : extcde
454 #ifdef W3_TIMINGS
455  USE w3parall, ONLY: print_my_time
456 #endif
457  use yownodepool, only: listnp, listnpa, listiplg
458  IMPLICIT NONE
459  include "mpif.h"
460  !/
461  !/ ------------------------------------------------------------------- /
462  !/ Parameter list
463  !/
464  !/ ------------------------------------------------------------------- /
465  !/ Local PARAMETERs
466  !/
467 #ifdef W3_S
468  INTEGER, SAVE :: IENT = 0
469 #endif
470  !/
471  !/ ------------------------------------------------------------------- /
472  !/
473  !
474  INTEGER, intent(in) :: NDREAD
475  INTEGER iBlock, iFirst, iEnd, len, i, IB, iProc
476  INTEGER NREC, ISEA, JSEA, ierr
477  INTEGER nbBlock, IBELONG
478  INTEGER :: BlockSize
479  REAL, allocatable :: ArrSend(:,:)
480  REAL, allocatable :: DataRead(:,:)
481  integer(KIND=8) RPOS
482  integer LRECL
483  INTEGER, PARAMETER :: LRB = 4
484  INTEGER NBLKRSloc, RSBLKSloc
485  integer eArr(1)
486  integer IERR_MPI, istat
487  integer IPloc, IPglob, pos
488  integer NbMatch, idx
489  integer ListFirst(NAPROC)
490 #ifdef W3_S
491  CALL strace (ient, 'VA_SETUP_IOBPD')
492 #endif
493  !
494  lrecl = max( lrb*nspec , &
495  lrb*(6+(25/lrb)+(9/lrb)+(29/lrb)+(3/lrb)) )
496  IF (iaproc .gt. naproc) THEN
497  RETURN
498  END IF
499  listfirst(1)=0
500  DO iproc=2,naproc
501  listfirst(iproc) = listfirst(iproc-1) + listnpa(iproc-1)
502  END DO
503  nblkrsloc = 10
504  rsblksloc = max( 5 , nsealm/nblkrsloc )
505  IF ( nblkrsloc*rsblksloc .LT. nsealm ) rsblksloc = rsblksloc + 1
506  nblkrsloc = 1 + (nsealm-1)/rsblksloc
507  blocksize = int(real(nsea)/real(nblkrsloc))
508  !
509  nbblock=nsea / blocksize
510  IF (nbblock * blocksize .lt. nsea) THEN
511  nbblock=nbblock+1
512  END IF
513  IF (iaproc .eq. 1) THEN
514  allocate(dataread(nspec,blocksize))
515  dataread = 0.
516  END IF
517  DO iblock=1,nbblock
518  ifirst = 1 + (iblock - 1)*blocksize
519  iend = min(iblock * blocksize, nsea)
520 #ifdef W3_TIMINGS
521  CALL print_my_time("Beginning of iBlock value treatment")
522 #endif
523 
524  ! Let's try to get the indexes right.
525  ! We have 1 <= IB <= len = iEnd + 1 - iFirst
526  ! We have iFirst - 1 = (iBlock - 1)*BlockSize
527  ! and so iFirst <= IB + (iBlock - 1)*BlockSize <= iEnd
528  ! and thus iFirst <= ISEA <= iEnd
529  len=iend + 1 - ifirst
530  IF (iaproc .eq. 1) THEN
531 #ifdef W3_TIMINGS
532  CALL print_my_time("Before data reading")
533 #endif
534  DO ib=1,len
535  isea = (iblock - 1)*blocksize + ib
536  nrec = isea + 2
537  rpos = 1_8 + lrecl*(nrec-1_8)
538  READ (ndread, pos=rpos, iostat=ierr) (dataread(i,ib), i=1,nspec)
539  END DO
540 #ifdef W3_TIMINGS
541  CALL print_my_time("After data reading")
542 #endif
543  DO iproc=2,naproc
544  nbmatch=0
545  DO iploc=1,listnpa(iproc)
546  ipglob = listiplg(listfirst(iproc) + iploc)
547  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
548  nbmatch = nbmatch+1
549  END IF
550  END DO
551  IF (nbmatch .gt. 0) THEN
552  allocate(arrsend(nspec,nbmatch), stat=istat)
553  arrsend = 0.
554  idx=0
555  DO iploc=1,listnpa(iproc)
556  ipglob = listiplg(listfirst(iproc) + iploc)
557  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
558  pos = ipglob - ifirst + 1
559  idx = idx + 1
560  arrsend(:,idx) = dataread(:,pos)
561  END IF
562  END DO
563  CALL mpi_send(arrsend,nspec*nbmatch,mpi_real, iproc-1, 37, mpi_comm_wave, ierr)
564  deallocate(arrsend)
565  END IF
566  END DO
567  DO iploc=1,listnpa(1)
568  ipglob = listiplg(iploc)
569  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
570  pos = ipglob - ifirst + 1
571  va(:,iploc) = dataread(:,pos)
572  END IF
573  END DO
574 #ifdef W3_TIMINGS
575  CALL print_my_time("After the sending")
576 #endif
577  ELSE
578  nbmatch=0
579  DO iploc=1,listnpa(iaproc)
580  ipglob = listiplg(listfirst(iaproc) + iploc)
581  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
582  nbmatch = nbmatch+1
583  END IF
584  END DO
585  IF (nbmatch .gt. 0) THEN
586  allocate(arrsend(nspec,nbmatch), stat=istat)
587  CALL mpi_recv(arrsend,nspec*nbmatch,mpi_real, 0, 37, mpi_comm_wave, istatus, ierr)
588  idx=0
589  DO iploc=1,listnpa(iaproc)
590  ipglob = listiplg(listfirst(iaproc) + iploc)
591  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
592  idx = idx + 1
593  va(:,iploc) = arrsend(:,idx)
594  END IF
595  END DO
596  deallocate(arrsend)
597  END IF
598  END IF
599 #ifdef W3_TIMINGS
600  CALL print_my_time("Beginning of iBlock value treatment")
601 #endif
602  END DO
603  IF (iaproc .eq. 1) THEN
604  deallocate(dataread)
605  END IF
606  END SUBROUTINE unst_pdlib_read_from_file
607  !/ ------------------------------------------------------------------- /
608  SUBROUTINE unst_pdlib_write_to_file(NDWRITE)
609  !/
610  !/ +-----------------------------------+
611  !/ | WAVEWATCH III NOAA/NCEP |
612  !/ | |
613  !/ | Aron Roland (BGS IT&E GmbH) |
614  !/ | Mathieu Dutour-Sikiric (IRB) |
615  !/ | |
616  !/ | FORTRAN 90 |
617  !/ | Last update : 01-Mai-2018 |
618  !/ +-----------------------------------+
619  !/
620  !/ 01-Mai-2018 : Origination. ( version 6.04 )
621  !/
622  ! 1. Purpose : PDLIB write to file
623  ! 2. Method :
624  ! 3. Parameters :
625  !
626  ! Parameter list
627  ! ----------------------------------------------------------------
628  ! ----------------------------------------------------------------
629  !
630  ! 4. Subroutines used :
631  !
632  ! Name Type Module Description
633  ! ----------------------------------------------------------------
634  ! STRACE Subr. W3SERVMD Subroutine tracing.
635  ! ----------------------------------------------------------------
636  !
637  ! 5. Called by :
638  !
639  ! Name Type Module Description
640  ! ----------------------------------------------------------------
641  ! ----------------------------------------------------------------
642  !
643  ! 6. Error messages :
644  ! 7. Remarks
645  ! 8. Structure :
646  ! 9. Switches :
647  !
648  ! !/S Enable subroutine tracing.
649  !
650  ! 10. Source code :
651  !
652  !/ ------------------------------------------------------------------- /
653 #ifdef W3_S
654  USE w3servmd, ONLY: strace
655 #endif
656  !
657  use yowdatapool, only: istatus
658  USE yownodepool, only: listnp, listnpa, listiplg
659  USE w3parall, ONLY: init_get_isea
660  USE w3gdatmd, only : nsea, nspec
661  USE w3odatmd, only : naproc, ntproc, naprst, iaproc
662  USE w3adatmd, only : mpi_comm_wave
663  USE w3parall, only : get_jsea_ibelong
664  USE w3wdatmd, ONLY : va
665  USE w3gdatmd, ONLY: nseal, nx, ny
666  IMPLICIT NONE
667  include "mpif.h"
668  !/
669  !/ ------------------------------------------------------------------- /
670  !/ Parameter list
671  !/
672  !/ ------------------------------------------------------------------- /
673  !/ Local PARAMETERs
674  !/
675 #ifdef W3_S
676  INTEGER, SAVE :: IENT = 0
677 #endif
678  !/
679  !/ ------------------------------------------------------------------- /
680  !/
681  !
682  INTEGER, intent(in) :: NDWRITE
683  INTEGER, PARAMETER :: BlockSize = 100000
684  REAL :: DATAwrite(NSPEC,BlockSize)
685  REAL, allocatable :: DATArecv(:,:)
686  integer ListFirst(NAPROC)
687  integer idx, idxB
688  integer len, i, IS
689  integer iBlock, iFirst, iEnd
690  integer IPglob, IPloc, pos, ISEA, nbBlock, NPAloc
691  integer ierr, istat, JSEA, NREC, iProc
692  integer NbMatch
693  INTEGER, PARAMETER :: LRB = 4
694  INTEGER(KIND=8) RPOS
695  INTEGER LRECL
696  INTEGER IERR_MPI
697  REAL(KIND=lrb) writebuff(nspec)
698  REAL, allocatable :: DATAsend(:,:)
699 #ifdef W3_S
700  CALL strace (ient, 'VA_SETUP_IOBPD')
701 #endif
702  listfirst(1) = 0
703  DO iproc=2,naproc
704  listfirst(iproc)=listfirst(iproc-1) + listnpa(iproc-1)
705  END DO
706  !
707  lrecl = max( lrb*nspec , &
708  lrb*(6+(25/lrb)+(9/lrb)+(29/lrb)+(3/lrb)) )
709  nbblock=nsea / blocksize + 1
710  DO iblock=1,nbblock
711  ifirst= 1 + (iblock - 1)*blocksize
712  iend= min(iblock * blocksize, nsea)
713  len=iend + 1 - ifirst
714  IF (iaproc .eq. naprst) THEN
715  IF (iaproc .le. naproc) THEN
716  DO jsea=1,nseal
717  CALL init_get_isea(isea, jsea)
718  IF ((ifirst .le. isea).and.(isea .le. iend)) THEN
719  idx = isea - ifirst + 1
720  datawrite(:, idx) = va(:, jsea)
721  END IF
722  END DO
723  END IF
724  DO iproc=1,naproc
725  IF (iproc .ne. iaproc) THEN
726  npaloc=listnpa(iproc)
727  nbmatch=0
728  DO iploc=1,npaloc
729  ipglob = listiplg(listfirst(iproc) + iploc)
730  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
731  nbmatch=nbmatch+1
732  END IF
733  END DO
734  IF (nbmatch .gt. 0) THEN
735  allocate(datarecv(nspec, nbmatch), stat=istat)
736  CALL mpi_recv(datarecv,nspec*nbmatch,mpi_real, iproc-1, 101, mpi_comm_wave, istatus, ierr)
737  idx=0
738  DO iploc=1,npaloc
739  ipglob = listiplg(iploc + listfirst(iproc))
740  isea = ipglob ! Great ansatz here. False in general
741  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
742  idx=idx+1
743  pos = ipglob - ifirst + 1
744  datawrite(:, pos) = datarecv(:, idx)
745  END IF
746  END DO
747  deallocate(datarecv, stat=istat)
748  END IF
749  END IF
750  END DO
751  DO isea=ifirst,iend
752  idx = isea - ifirst + 1
753  nrec = isea + 2
754  rpos = 1_8 + lrecl*(nrec-1_8)
755  writebuff(:) = 0
756  writebuff(1:nspec) = datawrite(1:nspec, idx)
757  WRITE(ndwrite, pos=rpos) writebuff
758  END DO
759  ELSE
760  IF (iaproc .le. naproc) THEN
761  nbmatch=0
762  DO iploc=1,listnpa(iaproc)
763  ipglob = listiplg(listfirst(iaproc) + iploc)
764  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
765  nbmatch=nbmatch+1
766  END IF
767  END DO
768  IF (nbmatch .gt. 0) THEN
769  allocate(datasend(nspec,nbmatch), stat=istat)
770  idx=0
771  DO iploc=1,listnpa(iaproc)
772  ipglob = listiplg(listfirst(iaproc) + iploc)
773  IF ((ifirst .le. ipglob).and.(ipglob .le. iend)) THEN
774  idx=idx + 1
775  datasend(:,idx)=va(:,iploc)
776  END IF
777  END DO
778  CALL mpi_send(datasend,nspec*nbmatch,mpi_real, naprst-1, 101, mpi_comm_wave, ierr)
779  deallocate(datasend, stat=istat)
780  END IF
781  END IF
782  END IF
783  END DO
784  END SUBROUTINE unst_pdlib_write_to_file
785  !/ ------------------------------------------------------------------- /
786  SUBROUTINE do_output_exchanges(IMOD)
787  !/
788  !/ +-----------------------------------+
789  !/ | WAVEWATCH III NOAA/NCEP |
790  !/ | |
791  !/ | Aron Roland (BGS IT&E GmbH) |
792  !/ | Mathieu Dutour-Sikiric (IRB) |
793  !/ | |
794  !/ | FORTRAN 90 |
795  !/ | Last update : 22-Mar-2021 |
796  !/ +-----------------------------------+
797  !/
798  !/ 01-Mai-2018 : Origination. ( version 6.04 )
799  !/ 22-Mar-2021 : Add WNMEAN, TAUOC output ( version 7.13 )
800  !/
801  ! 1. Purpose : Do communication for PDLIB output
802  ! 2. Method :
803  ! 3. Parameters :
804  !
805  ! Parameter list
806  ! ----------------------------------------------------------------
807  ! ----------------------------------------------------------------
808  !
809  ! 4. Subroutines used :
810  !
811  USE w3adatmd, ONLY: w3xdma, w3seta, w3xeta, wadats
812  USE w3servmd, ONLY: extcde
813  USE w3gdatmd, ONLY: nsea
814  USE w3gdatmd, ONLY: nx, nspec, mapfs, e3df, p2msf, us3df
815  USE w3wdatmd, ONLY: va, ust, ustdir, asf, fpis
816  USE w3adatmd, ONLY: mpi_comm_wave, ww3_field_vec
817  USE w3adatmd, ONLY: hs, wlm, t02
818  USE w3adatmd, ONLY: t0m1, thm, ths, fp0, thp0, &
819  dtdyn, fcut, sppnt, aba, abd, uba, ubd,&
820  sxx, syy, sxy, usero, phs, ptp, plp, &
821  pdir, psi, pws, pwst, pnr, phiaw, &
822  phioc, tauocx, tauocy, wnmean, &
823  tusx, tusy, tauwix, tauwiy, tauox, &
824  tauoy, ussx, ussy, mssx, mssy, &
825  mscx, mscy, prms, tpms, charn, &
826  tauwnx, tauwny, bhd, cge, &
827  cflxymax, cflthmax, cflkmax, whitecap, &
828  bedforms, phibbl, taubbl, t01, &
829  p2sms, us3d, ef, th1m, sth1m, th2m, &
830  sth2m, hsig, tauice, phice, pthp0, pqp,&
831  ppe, pgw, psw, ptm1, pt1, pt2, pep, &
832  qp, mssd, mscd, stmaxe, stmaxd, hmaxe, &
833  hcmaxe, hmaxd, hcmaxd, wbt, ussp
834  USE w3gdatmd, ONLY: nk, nseal
835  USE w3odatmd, ONLY: ndst, iaproc, naproc, ntproc, flout, &
836  napfld, nappnt, naprst, napbpt, naptrk,&
837  nogrp, ngrpp
838  USE w3odatmd, ONLY: outpts, nrqgo, nrqgo2, irqgo, irqgo2, &
839  flogrd, nrqpo, nrqpo2, irqpo1, irqpo2, &
840  nopts, iptint, nrqrs, irqrs, nblkrs, &
841  rsblks, irqrss, vaaux, nrqbp, nrqbp2, &
842  irqbp1, irqbp2, nfbpo, nbo2, isbpo, &
843  abpos, nrqtr, irqtr, it0pnt, it0trk, &
844  it0prt, noswll, noextr, ndse, iostyp, &
845  flogr2
846  USE w3adatmd, ONLY: mpi_comm_wcmp
847  USE w3parall, ONLY: init_get_jsea_isproc
848  USE w3parall, ONLY: init_get_isea
849  use yowdatapool, only: istatus
850  !/
851  IMPLICIT NONE
852  !
853  include "mpif.h"
854  !/
855  !/ ------------------------------------------------------------------- /
856  !/ Parameter list
857  !/
858  INTEGER, INTENT(IN) :: IMOD
859  !/
860  !/ ------------------------------------------------------------------- /
861  !/ Local parameters
862  !/
863  INTEGER :: IK, IFJ
864  INTEGER :: IH, IT0, IROOT, IT, IERR, I0, &
865  IFROM, IX(4), IY(4), IS(4), &
866  IP(4), I, J, JSEA, ITARG, IB, &
867  JSEA0, JSEAN, NSEAB, IBOFF, &
868  ISEA, ISPROC, K, NRQMAX
869 #ifdef W3_S
870  INTEGER, SAVE :: IENT
871 #endif
872  LOGICAL :: FLGRDALL(NOGRP,NGRPP)
873  REAL, allocatable :: ARRexch(:,:), ARRexch_loc(:,:)
874  REAL, allocatable :: ARRtotal(:,:)
875  INTEGER, allocatable :: ARRpos(:), ARRpos_loc(:)
876  INTEGER :: eEnt(1), IPROC
877  INTEGER :: TheSize, NSEAL_loc
878  INTEGER, SAVE :: indexOutput
879  !/
880  !/ ------------------------------------------------------------------- /
881  !/
882  DO j=1, nogrp
883  DO k=1, ngrpp
884  flgrdall(j,k) = (flogrd(j,k) .OR. flogr2(j,k))
885  END DO
886  END DO
887  nrqgo = 0
888  nrqgo2 = 0
889  it0 = nspec
890  iroot = napfld - 1
891  IF ( flout(1) .OR. flout(7) ) THEN
892  CALL get_array_size(thesize)
893  IF ( iaproc .LE. naproc ) THEN
894  allocate(arrexch(thesize, nseal), arrpos(nseal))
895  DO jsea=1,nseal
896  CALL init_get_isea(isea, jsea)
897  arrpos(jsea)=isea
898  ih = 0
899  IF ( flgrdall( 2, 1) ) THEN
900  ih = ih + 1
901  arrexch(ih,jsea)=hs(jsea)
902  END IF
903  IF ( flgrdall( 2, 2) ) THEN
904  ih = ih + 1
905  arrexch(ih,jsea)=wlm(jsea)
906  END IF
907  IF ( flgrdall( 2, 3) ) THEN
908  ih = ih + 1
909  arrexch(ih,jsea)=t02(jsea)
910  END IF
911  IF ( flgrdall( 2, 4) ) THEN
912  ih = ih + 1
913  arrexch(ih,jsea)=t0m1(jsea)
914  END IF
915  IF ( flgrdall( 2, 5) ) THEN
916  ih = ih + 1
917  arrexch(ih,jsea)=t01(jsea)
918  END IF
919  IF ( flgrdall( 2, 6) ) THEN
920  ih = ih + 1
921  arrexch(ih,jsea)=fp0(jsea)
922  END IF
923  IF ( flgrdall( 2, 7) ) THEN
924  ih = ih + 1
925  arrexch(ih,jsea)=thm(jsea)
926  END IF
927  IF ( flgrdall( 2, 8) ) THEN
928  ih = ih + 1
929  arrexch(ih,jsea)=ths(jsea)
930  END IF
931  IF ( flgrdall( 2, 9) ) THEN
932  ih = ih + 1
933  arrexch(ih,jsea)=thp0(jsea)
934  END IF
935  IF ( flgrdall( 2, 10) ) THEN
936  ih = ih + 1
937  arrexch(ih,jsea)=hsig(jsea)
938  END IF
939  IF ( flgrdall( 2, 11) ) THEN
940  ih = ih + 1
941  arrexch(ih,jsea)=stmaxe(jsea)
942  END IF
943  IF ( flgrdall( 2, 12) ) THEN
944  ih = ih + 1
945  arrexch(ih,jsea)=stmaxd(jsea)
946  END IF
947  IF ( flgrdall( 2, 13) ) THEN
948  ih = ih + 1
949  arrexch(ih,jsea)=hmaxe(jsea)
950  END IF
951  IF ( flgrdall( 2, 14) ) THEN
952  ih = ih + 1
953  arrexch(ih,jsea)=hcmaxe(jsea)
954  END IF
955  IF ( flgrdall( 2, 15) ) THEN
956  ih = ih + 1
957  arrexch(ih,jsea)=hmaxd(jsea)
958  END IF
959  IF ( flgrdall( 2, 16) ) THEN
960  ih = ih + 1
961  arrexch(ih,jsea)=hcmaxd(jsea)
962  END IF
963  IF ( flgrdall( 2, 17) ) THEN
964  ih = ih + 1
965  arrexch(ih,jsea)=wbt(jsea)
966  END IF
967  IF ( flgrdall( 2, 19) ) THEN
968  ih = ih + 1
969  arrexch(ih,jsea)=wnmean(jsea)
970  END IF
971  IF ( flgrdall( 3, 1) ) THEN
972  DO ik=e3df(2,1),e3df(3,1)
973  ih = ih + 1
974  arrexch(ih,jsea)=ef(jsea,ik)
975  END DO
976  END IF
977  IF ( flgrdall( 3, 2) ) THEN
978  DO ik=e3df(2,2),e3df(3,2)
979  ih = ih + 1
980  arrexch(ih,jsea)=th1m(jsea,ik)
981  END DO
982  END IF
983  IF ( flgrdall( 3, 3) ) THEN
984  DO ik=e3df(2,3),e3df(3,3)
985  ih = ih + 1
986  arrexch(ih,jsea)=sth1m(jsea,ik)
987  END DO
988  END IF
989  IF ( flgrdall( 3, 4) ) THEN
990  DO ik=e3df(2,4),e3df(3,4)
991  ih = ih + 1
992  arrexch(ih,jsea)=th2m(jsea,ik)
993  END DO
994  END IF
995  IF ( flgrdall( 3, 5) ) THEN
996  DO ik=e3df(2,5),e3df(3,5)
997  ih = ih + 1
998  arrexch(ih,jsea)=sth2m(jsea,ik)
999  END DO
1000  END IF
1001  IF ( flgrdall( 4, 1) ) THEN
1002  DO ik=0, noswll
1003  ih = ih + 1
1004  arrexch(ih,jsea)=phs(jsea,ik)
1005  END DO
1006  END IF
1007  IF ( flgrdall( 4, 2) ) THEN
1008  DO ik=0, noswll
1009  ih = ih + 1
1010  arrexch(ih,jsea)=ptp(jsea,ik)
1011  END DO
1012  END IF
1013  IF ( flgrdall( 4, 3) ) THEN
1014  DO ik=0, noswll
1015  ih = ih + 1
1016  arrexch(ih,jsea)=plp(jsea,ik)
1017  END DO
1018  END IF
1019  IF ( flgrdall( 4, 4) ) THEN
1020  DO ik=0, noswll
1021  ih = ih + 1
1022  arrexch(ih,jsea)=pdir(jsea,ik)
1023  END DO
1024  END IF
1025  IF ( flgrdall( 4, 5) ) THEN
1026  DO ik=0, noswll
1027  ih = ih + 1
1028  arrexch(ih,jsea)=psi(jsea,ik)
1029  END DO
1030  END IF
1031  IF ( flgrdall( 4, 6) ) THEN
1032  DO ik=0, noswll
1033  ih = ih + 1
1034  arrexch(ih,jsea)=pws(jsea,ik)
1035  END DO
1036  END IF
1037  IF ( flgrdall( 4, 7) ) THEN
1038  DO ik=0, noswll
1039  ih = ih + 1
1040  arrexch(ih,jsea)=pthp0(jsea,ik)
1041  END DO
1042  END IF
1043  IF ( flgrdall( 4, 8) ) THEN
1044  DO ik=0, noswll
1045  ih = ih + 1
1046  arrexch(ih,jsea)=pqp(jsea,ik)
1047  END DO
1048  END IF
1049  IF ( flgrdall( 4, 9) ) THEN
1050  DO ik=0, noswll
1051  ih = ih + 1
1052  arrexch(ih,jsea)=ppe(jsea,ik)
1053  END DO
1054  END IF
1055  IF ( flgrdall( 4,10) ) THEN
1056  DO ik=0, noswll
1057  ih = ih + 1
1058  arrexch(ih,jsea)=pgw(jsea,ik)
1059  END DO
1060  END IF
1061  IF ( flgrdall( 4,11) ) THEN
1062  DO ik=0, noswll
1063  ih = ih + 1
1064  arrexch(ih,jsea)=psw(jsea,ik)
1065  END DO
1066  END IF
1067  IF ( flgrdall( 4,12) ) THEN
1068  DO ik=0, noswll
1069  ih = ih + 1
1070  arrexch(ih,jsea)=ptm1(jsea,ik)
1071  END DO
1072  END IF
1073  IF ( flgrdall( 4,13) ) THEN
1074  DO ik=0, noswll
1075  ih = ih + 1
1076  arrexch(ih,jsea)=pt1(jsea,ik)
1077  END DO
1078  END IF
1079  IF ( flgrdall( 4,14) ) THEN
1080  DO ik=0, noswll
1081  ih = ih + 1
1082  arrexch(ih,jsea)=pt2(jsea,ik)
1083  END DO
1084  END IF
1085  IF ( flgrdall( 4,15) ) THEN
1086  DO ik=0, noswll
1087  ih = ih + 1
1088  arrexch(ih,jsea)=pep(jsea,ik)
1089  END DO
1090  END IF
1091  IF ( flgrdall( 4,16) ) THEN
1092  ih = ih + 1
1093  arrexch(ih,jsea)=pwst(jsea)
1094  END IF
1095  IF ( flgrdall( 4,17) ) THEN
1096  ih = ih + 1
1097  arrexch(ih,jsea)=pnr(jsea)
1098  END IF
1099  IF ( flgrdall( 5, 1) ) THEN
1100  ih = ih + 1
1101  arrexch(ih,jsea)=ust(isea)
1102  ih = ih + 1
1103  arrexch(ih,jsea)=ustdir(isea)
1104  ih = ih + 1
1105  arrexch(ih,jsea)=asf(isea)
1106  END IF
1107  IF ( flgrdall( 5, 2) ) THEN
1108  ih = ih + 1
1109  arrexch(ih,jsea)=charn(jsea)
1110  END IF
1111  IF ( flgrdall( 5, 3) ) THEN
1112  ih = ih + 1
1113  arrexch(ih,jsea)=cge(jsea)
1114  END IF
1115  IF ( flgrdall( 5, 4) ) THEN
1116  ih = ih + 1
1117  arrexch(ih,jsea)=phiaw(jsea)
1118  END IF
1119  IF ( flgrdall( 5, 5) ) THEN
1120  ih = ih + 1
1121  arrexch(ih,jsea)=tauwix(jsea)
1122  ih = ih + 1
1123  arrexch(ih,jsea)=tauwiy(jsea)
1124  END IF
1125  IF ( flgrdall( 5, 6) ) THEN
1126  ih = ih + 1
1127  arrexch(ih,jsea)=tauwnx(jsea)
1128  ih = ih + 1
1129  arrexch(ih,jsea)=tauwny(jsea)
1130  END IF
1131  IF ( flgrdall( 5, 7) ) THEN
1132  ih = ih + 1
1133  arrexch(ih,jsea)=whitecap(jsea,1)
1134  END IF
1135  IF ( flgrdall( 5, 8) ) THEN
1136  ih = ih + 1
1137  arrexch(ih,jsea)=whitecap(jsea,2)
1138  END IF
1139  IF ( flgrdall( 5, 9) ) THEN
1140  ih = ih + 1
1141  arrexch(ih,jsea)=whitecap(jsea,3)
1142  END IF
1143  IF ( flgrdall( 5,10) ) THEN
1144  ih = ih + 1
1145  arrexch(ih,jsea)=whitecap(jsea,4)
1146  END IF
1147  IF ( flgrdall( 6, 1) ) THEN
1148  ih = ih + 1
1149  arrexch(ih,jsea)=sxx(jsea)
1150  ih = ih + 1
1151  arrexch(ih,jsea)=syy(jsea)
1152  ih = ih + 1
1153  arrexch(ih,jsea)=sxy(jsea)
1154  END IF
1155  IF ( flgrdall( 6, 2) ) THEN
1156  ih = ih + 1
1157  arrexch(ih,jsea)=tauox(jsea)
1158  ih = ih + 1
1159  arrexch(ih,jsea)=tauoy(jsea)
1160  END IF
1161  IF ( flgrdall( 6, 3) ) THEN
1162  ih = ih + 1
1163  arrexch(ih,jsea)=bhd(jsea)
1164  END IF
1165  IF ( flgrdall( 6, 4) ) THEN
1166  ih = ih + 1
1167  arrexch(ih,jsea)=phioc(jsea)
1168  END IF
1169  IF ( flgrdall( 6, 5) ) THEN
1170  ih = ih + 1
1171  arrexch(ih,jsea)=tusx(jsea)
1172  ih = ih + 1
1173  arrexch(ih,jsea)=tusy(jsea)
1174  END IF
1175  IF ( flgrdall( 6, 6) ) THEN
1176  ih = ih + 1
1177  arrexch(ih,jsea)=ussx(jsea)
1178  ih = ih + 1
1179  arrexch(ih,jsea)=ussy(jsea)
1180  END IF
1181  IF ( flgrdall( 6, 7) ) THEN
1182  ih = ih + 1
1183  arrexch(ih,jsea)=prms(jsea)
1184  ih = ih + 1
1185  arrexch(ih,jsea)=tpms(jsea)
1186  END IF
1187  IF ( flgrdall( 6, 8) ) THEN
1188  DO ik=1,2*nk
1189  ih = ih + 1
1190  arrexch(ih,jsea)=us3d(jsea,ik)
1191  END DO
1192  END IF
1193  IF ( flgrdall( 6, 9) ) THEN
1194  DO k=p2msf(2),p2msf(3)
1195  ih = ih + 1
1196  arrexch(ih,jsea)=p2sms(jsea,k)
1197  END DO
1198  END IF
1199  IF ( flgrdall( 6, 10) ) THEN
1200  ih = ih + 1
1201  arrexch(ih,jsea)=tauice(jsea,1)
1202  ih = ih + 1
1203  arrexch(ih,jsea)=tauice(jsea,2)
1204  END IF
1205  IF ( flgrdall( 6, 11) ) THEN
1206  ih = ih + 1
1207  arrexch(ih,jsea)=phice(jsea)
1208  END IF
1209  IF ( flgrdall( 6, 12) ) THEN
1210  DO ik=1,2*nk
1211  ih = ih + 1
1212  arrexch(ih,jsea)=ussp(jsea,ik)
1213  END DO
1214  END IF
1215  IF ( flgrdall( 6, 13) ) THEN
1216  ih = ih + 1
1217  arrexch(ih,jsea)=tauocx(jsea)
1218  ih = ih + 1
1219  arrexch(ih,jsea)=tauocy(jsea)
1220  END IF
1221  IF ( flgrdall( 7, 1) ) THEN
1222  ih = ih + 1
1223  arrexch(ih,jsea)=aba(jsea)
1224  ih = ih + 1
1225  arrexch(ih,jsea)=abd(jsea)
1226  END IF
1227  IF ( flgrdall( 7, 2) ) THEN
1228  ih = ih + 1
1229  arrexch(ih,jsea)=uba(jsea)
1230  ih = ih + 1
1231  arrexch(ih,jsea)=ubd(jsea)
1232  END IF
1233  IF ( flgrdall( 7, 3) ) THEN
1234  ih = ih + 1
1235  arrexch(ih,jsea)=bedforms(jsea,1)
1236  ih = ih + 1
1237  arrexch(ih,jsea)=bedforms(jsea,2)
1238  ih = ih + 1
1239  arrexch(ih,jsea)=bedforms(jsea,3)
1240  END IF
1241  IF ( flgrdall( 7, 4) ) THEN
1242  ih = ih + 1
1243  arrexch(ih,jsea)=phibbl(jsea)
1244  END IF
1245  IF ( flgrdall( 7, 5) ) THEN
1246  ih = ih + 1
1247  arrexch(ih,jsea)=taubbl(jsea,1)
1248  ih = ih + 1
1249  arrexch(ih,jsea)=taubbl(jsea,2)
1250  END IF
1251  IF ( flgrdall( 8, 1) ) THEN
1252  ih = ih + 1
1253  arrexch(ih,jsea)=mssx(jsea)
1254  ih = ih + 1
1255  arrexch(ih,jsea)=mssy(jsea)
1256  END IF
1257  IF ( flgrdall( 8, 2) ) THEN
1258  ih = ih + 1
1259  arrexch(ih,jsea)=mscx(jsea)
1260  ih = ih + 1
1261  arrexch(ih,jsea)=mscy(jsea)
1262  END IF
1263  IF ( flgrdall( 8, 3) ) THEN
1264  ih = ih + 1
1265  arrexch(ih,jsea)=mssd(jsea)
1266  END IF
1267  IF ( flgrdall( 8, 4) ) THEN
1268  ih = ih + 1
1269  arrexch(ih,jsea)=mscd(jsea)
1270  END IF
1271  IF ( flgrdall( 8, 5) ) THEN
1272  ih = ih + 1
1273  arrexch(ih,jsea)=qp(jsea)
1274  END IF
1275  IF ( flgrdall( 9, 1) ) THEN
1276  ih = ih + 1
1277  arrexch(ih,jsea)=dtdyn(jsea)
1278  END IF
1279  IF ( flgrdall( 9, 2) ) THEN
1280  ih = ih + 1
1281  arrexch(ih,jsea)=fcut(jsea)
1282  END IF
1283  IF ( flgrdall( 9, 3) ) THEN
1284  ih = ih + 1
1285  arrexch(ih,jsea)=cflxymax(jsea)
1286  END IF
1287  IF ( flgrdall( 9, 4) ) THEN
1288  ih = ih + 1
1289  arrexch(ih,jsea)=cflthmax(jsea)
1290  END IF
1291  IF ( flgrdall( 9, 5) ) THEN
1292  ih = ih + 1
1293  arrexch(ih,jsea)=cflkmax(jsea)
1294  END IF
1295  DO i=1, noextr
1296  IF ( flgrdall(10, i) ) THEN
1297  ih = ih + 1
1298  arrexch(ih,jsea)=usero(jsea,i)
1299  END IF
1300  END DO
1301  END DO
1302  END IF
1303  !
1304  ! Now synchronizing the data
1305  ! It must be possible to ensure that the output
1306  ! node is also a computational node.
1307  !
1308  IF (iaproc .eq. napfld) THEN
1309  allocate(arrtotal(thesize, nsea))
1310  IF (iaproc .le. naproc) THEN
1311  DO i=1,nseal
1312  arrtotal(:,arrpos(i)) = arrexch(:,i)
1313  END DO
1314  END IF
1315  END IF
1316  IF ((iaproc .le. naproc).and.(iaproc.ne.napfld)) THEN
1317  eent(1)=nseal
1318  CALL mpi_send(eent,1,mpi_integer, napfld-1, 23, mpi_comm_wave, ierr)
1319  CALL mpi_send(arrpos,nseal,mpi_integer, napfld-1, 29, mpi_comm_wave, ierr)
1320  CALL mpi_send(arrexch,nseal*thesize,mpi_real, napfld-1, 37, mpi_comm_wave, ierr)
1321  deallocate(arrpos, arrexch)
1322  END IF
1323  IF (iaproc .eq. napfld) THEN
1324  DO iproc=1,naproc
1325  IF (iproc .ne. iaproc) THEN
1326  CALL mpi_recv(eent,1,mpi_integer, iproc-1, 23, mpi_comm_wave, istatus, ierr)
1327  nseal_loc=eent(1)
1328  allocate(arrpos_loc(nseal_loc), arrexch_loc(thesize, nseal_loc))
1329  CALL mpi_recv(arrpos_loc,nseal_loc,mpi_integer, iproc-1, 29, mpi_comm_wave, istatus, ierr)
1330  CALL mpi_recv(arrexch_loc,nseal_loc*thesize,mpi_integer, iproc-1, 37, mpi_comm_wave, istatus, ierr)
1331  DO i=1,nseal_loc
1332  arrtotal(:,arrpos_loc(i)) = arrexch_loc(:,i)
1333  END DO
1334  deallocate(arrexch_loc, arrpos_loc)
1335  END IF
1336  END DO
1337  END IF
1338  IF ( iaproc .EQ. napfld ) THEN
1339  IF (.not. wadats(imod)%AINIT2) CALL w3xdma ( imod, ndse, ndst, flgrdall )
1340  CALL w3xeta ( imod, ndse, ndst )
1341  ih = 0
1342  IF ( flgrdall( 2, 1) ) THEN
1343  ih = ih + 1
1344  hs(1:nsea) = arrtotal(ih,:)
1345  END IF
1346  IF ( flgrdall( 2, 2) ) THEN
1347  ih = ih + 1
1348  wlm(1:nsea) = arrtotal(ih,:)
1349  END IF
1350  IF ( flgrdall( 2, 3) ) THEN
1351  ih = ih + 1
1352  t02(1:nsea) = arrtotal(ih,:)
1353  END IF
1354  IF ( flgrdall( 2, 4) ) THEN
1355  ih = ih + 1
1356  t0m1(1:nsea) = arrtotal(ih,:)
1357  END IF
1358  IF ( flgrdall( 2, 5) ) THEN
1359  ih = ih + 1
1360  t01(1:nsea) = arrtotal(ih,:)
1361  END IF
1362  IF ( flgrdall( 2, 6) ) THEN
1363  ih = ih + 1
1364  fp0(1:nsea) = arrtotal(ih,:)
1365  END IF
1366  IF ( flgrdall( 2, 7) ) THEN
1367  ih = ih + 1
1368  thm(1:nsea) = arrtotal(ih,:)
1369  END IF
1370  IF ( flgrdall( 2, 8) ) THEN
1371  ih = ih + 1
1372  ths(1:nsea) = arrtotal(ih,:)
1373  END IF
1374  IF ( flgrdall( 2, 9) ) THEN
1375  ih = ih + 1
1376  thp0(1:nsea) = arrtotal(ih,:)
1377  END IF
1378  IF ( flgrdall( 2, 10) ) THEN
1379  ih = ih + 1
1380  hsig(1:nsea) = arrtotal(ih,:)
1381  END IF
1382  IF ( flgrdall( 2, 11) ) THEN
1383  ih = ih + 1
1384  stmaxe(1:nsea) = arrtotal(ih,:)
1385  END IF
1386  IF ( flgrdall( 2, 12) ) THEN
1387  ih = ih + 1
1388  stmaxd(1:nsea) = arrtotal(ih,:)
1389  END IF
1390  IF ( flgrdall( 2, 13) ) THEN
1391  ih = ih + 1
1392  hmaxe(1:nsea) = arrtotal(ih,:)
1393  END IF
1394  IF ( flgrdall( 2, 14) ) THEN
1395  ih = ih + 1
1396  hcmaxe(1:nsea) = arrtotal(ih,:)
1397  END IF
1398  IF ( flgrdall( 2, 15) ) THEN
1399  ih = ih + 1
1400  hmaxd(1:nsea) = arrtotal(ih,:)
1401  END IF
1402  IF ( flgrdall( 2, 16) ) THEN
1403  ih = ih + 1
1404  hcmaxd(1:nsea) = arrtotal(ih,:)
1405  END IF
1406  IF ( flgrdall( 2, 17) ) THEN
1407  ih = ih + 1
1408  wbt(1:nsea) = arrtotal(ih,:)
1409  END IF
1410  IF ( flgrdall( 2, 19) ) THEN
1411  ih = ih + 1
1412  wnmean(1:nsea) = arrtotal(ih,:)
1413  END IF
1414  IF ( flgrdall( 3, 1) ) THEN
1415  DO ik=e3df(2,1),e3df(3,1)
1416  ih = ih + 1
1417  ef(1:nsea,ik) = arrtotal(ih,:)
1418  END DO
1419  END IF
1420  IF ( flgrdall( 3, 2) ) THEN
1421  DO ik=e3df(2,2),e3df(3,2)
1422  ih = ih + 1
1423  th1m(1:nsea,ik) = arrtotal(ih,:)
1424  END DO
1425  END IF
1426  IF ( flgrdall( 3, 3) ) THEN
1427  DO ik=e3df(2,3),e3df(3,3)
1428  ih = ih + 1
1429  sth1m(1:nsea,ik) = arrtotal(ih,:)
1430  END DO
1431  END IF
1432  IF ( flgrdall( 3, 4) ) THEN
1433  DO ik=e3df(2,4),e3df(3,4)
1434  ih = ih + 1
1435  th2m(1:nsea,ik) = arrtotal(ih,:)
1436  END DO
1437  END IF
1438  IF ( flgrdall( 3, 5) ) THEN
1439  DO ik=e3df(2,5),e3df(3,5)
1440  ih = ih + 1
1441  sth2m(1:nsea,ik) = arrtotal(ih,:)
1442  END DO
1443  END IF
1444  IF ( flgrdall( 4, 1) ) THEN
1445  DO k=0, noswll
1446  ih = ih + 1
1447  phs(1:nsea,k) = arrtotal(ih,:)
1448  END DO
1449  END IF
1450  IF ( flgrdall( 4, 2) ) THEN
1451  DO k=0, noswll
1452  ih = ih + 1
1453  ptp(1:nsea,k) = arrtotal(ih,:)
1454  END DO
1455  END IF
1456  IF ( flgrdall( 4, 3) ) THEN
1457  DO k=0, noswll
1458  ih = ih + 1
1459  plp(1:nsea,k) = arrtotal(ih,:)
1460  END DO
1461  END IF
1462  IF ( flgrdall( 4, 4) ) THEN
1463  DO k=0, noswll
1464  ih = ih + 1
1465  pdir(1:nsea,k) = arrtotal(ih,:)
1466  END DO
1467  END IF
1468  IF ( flgrdall( 4, 5) ) THEN
1469  DO k=0, noswll
1470  ih = ih + 1
1471  psi(1:nsea,k) = arrtotal(ih,:)
1472  END DO
1473  END IF
1474  IF ( flgrdall( 4, 6) ) THEN
1475  DO k=0, noswll
1476  ih = ih + 1
1477  pws(1:nsea,k) = arrtotal(ih,:)
1478  END DO
1479  END IF
1480  IF ( flgrdall( 4, 7) ) THEN
1481  DO k=0, noswll
1482  ih = ih + 1
1483  pthp0(1:nsea,k) = arrtotal(ih,:)
1484  END DO
1485  END IF
1486  IF ( flgrdall( 4, 8) ) THEN
1487  DO k=0, noswll
1488  ih = ih + 1
1489  pqp(1:nsea,k) = arrtotal(ih,:)
1490  END DO
1491  END IF
1492  IF ( flgrdall( 4, 9) ) THEN
1493  DO k=0, noswll
1494  ih = ih + 1
1495  ppe(1:nsea,k) = arrtotal(ih,:)
1496  END DO
1497  END IF
1498  IF ( flgrdall( 4,10) ) THEN
1499  DO k=0, noswll
1500  ih = ih + 1
1501  pgw(1:nsea,k) = arrtotal(ih,:)
1502  END DO
1503  END IF
1504  IF ( flgrdall( 4,11) ) THEN
1505  DO k=0, noswll
1506  ih = ih + 1
1507  psw(1:nsea,k) = arrtotal(ih,:)
1508  END DO
1509  END IF
1510  IF ( flgrdall( 4,12) ) THEN
1511  DO k=0, noswll
1512  ih = ih + 1
1513  ptm1(1:nsea,k) = arrtotal(ih,:)
1514  END DO
1515  END IF
1516  IF ( flgrdall( 4,13) ) THEN
1517  DO k=0, noswll
1518  ih = ih + 1
1519  pt1(1:nsea,k) = arrtotal(ih,:)
1520  END DO
1521  END IF
1522  IF ( flgrdall( 4,14) ) THEN
1523  DO k=0, noswll
1524  ih = ih + 1
1525  pt2(1:nsea,k) = arrtotal(ih,:)
1526  END DO
1527  END IF
1528  IF ( flgrdall( 4,15) ) THEN
1529  DO k=0, noswll
1530  ih = ih + 1
1531  pep(1:nsea,k) = arrtotal(ih,:)
1532  END DO
1533  END IF
1534  IF ( flgrdall( 4,16) ) THEN
1535  ih = ih + 1
1536  pwst(1:nsea) = arrtotal(ih,:)
1537  END IF
1538  IF ( flgrdall( 4,17) ) THEN
1539  ih = ih + 1
1540  pnr(1:nsea) = arrtotal(ih,:)
1541  END IF
1542  IF ( flgrdall( 5, 1) ) THEN
1543  ih = ih + 1
1544  ust(1:nsea) = arrtotal(ih,:)
1545  ih = ih + 1
1546  ustdir(1:nsea) = arrtotal(ih,:)
1547  ih = ih + 1
1548  asf(1:nsea) = arrtotal(ih,:)
1549  END IF
1550  IF ( flgrdall( 5, 2) ) THEN
1551  ih = ih + 1
1552  charn(1:nsea) = arrtotal(ih,:)
1553  END IF
1554  IF ( flgrdall( 5, 3) ) THEN
1555  ih = ih + 1
1556  cge(1:nsea) = arrtotal(ih,:)
1557  END IF
1558  IF ( flgrdall( 5, 4) ) THEN
1559  ih = ih + 1
1560  phiaw(1:nsea) = arrtotal(ih,:)
1561  END IF
1562  IF ( flgrdall( 5, 5) ) THEN
1563  ih = ih + 1
1564  tauwix(1:nsea) = arrtotal(ih,:)
1565  ih = ih + 1
1566  tauwiy(1:nsea) = arrtotal(ih,:)
1567  END IF
1568  IF ( flgrdall( 5, 6) ) THEN
1569  ih = ih + 1
1570  tauwnx(1:nsea) = arrtotal(ih,:)
1571  ih = ih + 1
1572  tauwny(1:nsea) = arrtotal(ih,:)
1573  END IF
1574  IF ( flgrdall( 5, 7) ) THEN
1575  ih = ih + 1
1576  whitecap(1:nsea,1) = arrtotal(ih,:)
1577  END IF
1578  IF ( flgrdall( 5, 8) ) THEN
1579  ih = ih + 1
1580  whitecap(1:nsea,2) = arrtotal(ih,:)
1581  END IF
1582  IF ( flgrdall( 5, 9) ) THEN
1583  ih = ih + 1
1584  whitecap(1:nsea,3) = arrtotal(ih,:)
1585  END IF
1586  IF ( flgrdall( 5,10) ) THEN
1587  ih = ih + 1
1588  whitecap(1:nsea,4) = arrtotal(ih,:)
1589  END IF
1590  IF ( flgrdall( 6, 1) ) THEN
1591  ih = ih + 1
1592  sxx(1:nsea) = arrtotal(ih,:)
1593  ih = ih + 1
1594  syy(1:nsea) = arrtotal(ih,:)
1595  ih = ih + 1
1596  sxy(1:nsea) = arrtotal(ih,:)
1597  END IF
1598  IF ( flgrdall( 6, 2) ) THEN
1599  ih = ih + 1
1600  tauox(1:nsea) = arrtotal(ih,:)
1601  ih = ih + 1
1602  tauoy(1:nsea) = arrtotal(ih,:)
1603  END IF
1604  IF ( flgrdall( 6, 3) ) THEN
1605  ih = ih + 1
1606  bhd(1:nsea) = arrtotal(ih,:)
1607  END IF
1608  IF ( flgrdall( 6, 4) ) THEN
1609  ih = ih + 1
1610  phioc(1:nsea) = arrtotal(ih,:)
1611  END IF
1612  IF ( flgrdall( 6, 5) ) THEN
1613  ih = ih + 1
1614  tusx(1:nsea) = arrtotal(ih,:)
1615  ih = ih + 1
1616  tusy(1:nsea) = arrtotal(ih,:)
1617  END IF
1618  IF ( flgrdall( 6, 6) ) THEN
1619  ih = ih + 1
1620  ussx(1:nsea) = arrtotal(ih,:)
1621  ih = ih + 1
1622  ussy(1:nsea) = arrtotal(ih,:)
1623  END IF
1624  IF ( flgrdall( 6, 7) ) THEN
1625  ih = ih + 1
1626  prms(1:nsea) = arrtotal(ih,:)
1627  ih = ih + 1
1628  tpms(1:nsea) = arrtotal(ih,:)
1629  END IF
1630  IF ( flgrdall( 6, 8) ) THEN
1631  DO ik=1,2*nk
1632  ih = ih + 1
1633  us3d(1:nsea,ik) = arrtotal(ih,:)
1634  END DO
1635  END IF
1636  IF ( flgrdall( 6, 9) ) THEN
1637  DO k=p2msf(2),p2msf(3)
1638  ih = ih + 1
1639  p2sms(1:nsea,k) = arrtotal(ih,:)
1640  END DO
1641  END IF
1642  IF ( flgrdall( 6, 10) ) THEN
1643  ih = ih + 1
1644  tauice(1:nsea,1) = arrtotal(ih,:)
1645  ih = ih + 1
1646  tauice(1:nsea,2) = arrtotal(ih,:)
1647  END IF
1648  IF ( flgrdall( 6, 11) ) THEN
1649  ih = ih + 1
1650  phice(1:nsea) = arrtotal(ih,:)
1651  END IF
1652  IF ( flgrdall( 6, 12) ) THEN
1653  DO ik=1,2*nk
1654  ih = ih + 1
1655  ussp(1:nsea,ik) = arrtotal(ih,:)
1656  END DO
1657  END IF
1658  IF ( flgrdall( 6, 13) ) THEN
1659  ih = ih + 1
1660  tauocx(1:nsea) = arrtotal(ih,:)
1661  ih = ih + 1
1662  tauocy(1:nsea) = arrtotal(ih,:)
1663  END IF
1664  IF ( flgrdall( 7, 1) ) THEN
1665  ih = ih + 1
1666  aba(1:nsea) = arrtotal(ih,:)
1667  ih = ih + 1
1668  abd(1:nsea) = arrtotal(ih,:)
1669  END IF
1670  IF ( flgrdall( 7, 2) ) THEN
1671  ih = ih + 1
1672  uba(1:nsea) = arrtotal(ih,:)
1673  ih = ih + 1
1674  ubd(1:nsea) = arrtotal(ih,:)
1675  END IF
1676  IF ( flgrdall( 7, 3) ) THEN
1677  ih = ih + 1
1678  bedforms(1:nsea,1) = arrtotal(ih,:)
1679  ih = ih + 1
1680  bedforms(1:nsea,2) = arrtotal(ih,:)
1681  ih = ih + 1
1682  bedforms(1:nsea,3) = arrtotal(ih,:)
1683  END IF
1684  IF ( flgrdall( 7, 4) ) THEN
1685  ih = ih + 1
1686  phibbl(1:nsea) = arrtotal(ih,:)
1687  END IF
1688  IF ( flgrdall( 7, 5) ) THEN
1689  ih = ih + 1
1690  taubbl(1:nsea,1) = arrtotal(ih,:)
1691  ih = ih + 1
1692  taubbl(1:nsea,2) = arrtotal(ih,:)
1693  END IF
1694  IF ( flgrdall( 8, 1) ) THEN
1695  ih = ih + 1
1696  mssx(1:nsea) = arrtotal(ih,:)
1697  ih = ih + 1
1698  mssy(1:nsea) = arrtotal(ih,:)
1699  END IF
1700  IF ( flgrdall( 8, 2) ) THEN
1701  ih = ih + 1
1702  mscx(1:nsea) = arrtotal(ih,:)
1703  ih = ih + 1
1704  mscy(1:nsea) = arrtotal(ih,:)
1705  END IF
1706  IF ( flgrdall( 8, 3) ) THEN
1707  ih = ih + 1
1708  mssd(1:nsea) = arrtotal(ih,:)
1709  END IF
1710  IF ( flgrdall( 8, 4) ) THEN
1711  ih = ih + 1
1712  mscd(1:nsea) = arrtotal(ih,:)
1713  END IF
1714  IF ( flgrdall( 8, 5) ) THEN
1715  ih = ih + 1
1716  qp(1:nsea) = arrtotal(ih,:)
1717  END IF
1718  IF ( flgrdall( 9, 1) ) THEN
1719  ih = ih + 1
1720  dtdyn(1:nsea) = arrtotal(ih,:)
1721  END IF
1722  IF ( flgrdall( 9, 2) ) THEN
1723  ih = ih + 1
1724  fcut(1:nsea) = arrtotal(ih,:)
1725  END IF
1726  IF ( flgrdall( 9, 3) ) THEN
1727  ih = ih + 1
1728  cflxymax(1:nsea) = arrtotal(ih,:)
1729  END IF
1730  IF ( flgrdall( 9, 4) ) THEN
1731  ih = ih + 1
1732  cflthmax(1:nsea) = arrtotal(ih,:)
1733  END IF
1734  IF ( flgrdall( 9, 5) ) THEN
1735  ih = ih + 1
1736  cflkmax(1:nsea) = arrtotal(ih,:)
1737  END IF
1738  DO i=1, noextr
1739  IF ( flgrdall(10, i) ) THEN
1740  ih = ih + 1
1741  usero(1:nsea,i) = arrtotal(ih,:)
1742  END IF
1743  END DO
1744  CALL w3seta ( imod, ndse, ndst )
1745  END IF
1746  END IF
1747  indexoutput=indexoutput+1
1748  END SUBROUTINE do_output_exchanges
1749  !/ ------------------------------------------------------------------- /
1750 END MODULE pdlib_field_vec
1751 !/ ------------------------------------------------------------------- /
w3adatmd::pt2
real, dimension(:,:), pointer pt2
Definition: w3adatmd.F90:597
w3adatmd::psw
real, dimension(:,:), pointer psw
Definition: w3adatmd.F90:597
w3gdatmd::nk
integer, pointer nk
Definition: w3gdatmd.F90:1230
w3odatmd::nrqbp2
integer, pointer nrqbp2
Definition: w3odatmd.F90:533
w3adatmd::hcmaxe
real, dimension(:), pointer hcmaxe
Definition: w3adatmd.F90:587
w3odatmd::iostyp
integer iostyp
Definition: w3odatmd.F90:321
pdlib_field_vec::unst_pdlib_write_to_file
subroutine unst_pdlib_write_to_file(NDWRITE)
Definition: pdlib_field_vec.F90:609
w3gdatmd::nseal
integer, pointer nseal
Definition: w3gdatmd.F90:1097
w3adatmd::phice
real, dimension(:), pointer phice
Definition: w3adatmd.F90:607
include
cmake src_list cmake include(${CMAKE_CURRENT_SOURCE_DIR}/cmake/check_switches.cmake) check_switches("$
Definition: CMakeLists.txt:15
w3adatmd::th2m
real, dimension(:,:), pointer th2m
Definition: w3adatmd.F90:594
w3odatmd::nrqpo
integer, pointer nrqpo
Definition: w3odatmd.F90:486
w3odatmd::iptint
integer, dimension(:,:,:), pointer iptint
Definition: w3odatmd.F90:488
w3adatmd::charn
real, dimension(:), pointer charn
Definition: w3adatmd.F90:603
w3adatmd::dtdyn
real, dimension(:), pointer dtdyn
Definition: w3adatmd.F90:620
w3wdatmd::fpis
real, dimension(:), pointer fpis
Definition: w3wdatmd.F90:183
w3adatmd::nsealm
integer, pointer nsealm
Definition: w3adatmd.F90:686
w3odatmd::nrqgo2
integer, pointer nrqgo2
Definition: w3odatmd.F90:475
w3adatmd
Define data structures to set up wave model auxiliary data for several models simultaneously.
Definition: w3adatmd.F90:26
w3adatmd::hcmaxd
real, dimension(:), pointer hcmaxd
Definition: w3adatmd.F90:587
w3gdatmd::nspec
integer, pointer nspec
Definition: w3gdatmd.F90:1230
w3adatmd::sth1m
real, dimension(:,:), pointer sth1m
Definition: w3adatmd.F90:594
pdlib_field_vec::get_array_size
subroutine get_array_size(TheSize)
Definition: pdlib_field_vec.F90:54
w3adatmd::ussy
real, dimension(:), pointer ussy
Definition: w3adatmd.F90:607
w3adatmd::pep
real, dimension(:,:), pointer pep
Definition: w3adatmd.F90:597
w3adatmd::mscd
real, dimension(:), pointer mscd
Definition: w3adatmd.F90:617
w3adatmd::abd
real, dimension(:), pointer abd
Definition: w3adatmd.F90:614
w3wdatmd
Define data structures to set up wave model dynamic data for several models simultaneously.
Definition: w3wdatmd.F90:18
w3gdatmd::p2msf
integer, dimension(:), pointer p2msf
Definition: w3gdatmd.F90:1098
w3adatmd::stmaxe
real, dimension(:), pointer stmaxe
Definition: w3adatmd.F90:587
w3adatmd::tauice
real, dimension(:,:), pointer tauice
Definition: w3adatmd.F90:607
w3adatmd::t02
real, dimension(:), pointer t02
Definition: w3adatmd.F90:587
w3adatmd::us3d
real, dimension(:,:), pointer us3d
Definition: w3adatmd.F90:612
w3adatmd::wadats
type(wadat), dimension(:), allocatable, target wadats
Definition: w3adatmd.F90:571
w3adatmd::cflxymax
real, dimension(:), pointer cflxymax
Definition: w3adatmd.F90:620
w3odatmd::nopts
integer, pointer nopts
Definition: w3odatmd.F90:484
w3odatmd::irqpo2
integer, dimension(:), pointer irqpo2
Definition: w3odatmd.F90:490
w3adatmd::tusx
real, dimension(:), pointer tusx
Definition: w3adatmd.F90:607
w3parall::get_jsea_ibelong
subroutine get_jsea_ibelong(ISEA, JSEA, IBELONG)
Set belongings of JSEA in context of PDLIB.
Definition: w3parall.F90:1271
w3adatmd::fcut
real, dimension(:), pointer fcut
Definition: w3adatmd.F90:620
w3odatmd::flogr2
logical, dimension(:,:), pointer flogr2
Definition: w3odatmd.F90:478
w3adatmd::tusy
real, dimension(:), pointer tusy
Definition: w3adatmd.F90:607
w3adatmd::ptp
real, dimension(:,:), pointer ptp
Definition: w3adatmd.F90:597
w3odatmd::ntproc
integer, pointer ntproc
Definition: w3odatmd.F90:457
w3adatmd::th1m
real, dimension(:,:), pointer th1m
Definition: w3adatmd.F90:594
w3adatmd::t01
real, dimension(:), pointer t01
Definition: w3adatmd.F90:587
w3adatmd::cge
real, dimension(:), pointer cge
Definition: w3adatmd.F90:603
w3odatmd::iaproc
integer, pointer iaproc
Definition: w3odatmd.F90:457
w3odatmd::ngrpp
integer, parameter ngrpp
Definition: w3odatmd.F90:324
w3adatmd::pdir
real, dimension(:,:), pointer pdir
Definition: w3adatmd.F90:597
w3adatmd::thp0
real, dimension(:), pointer thp0
Definition: w3adatmd.F90:587
w3adatmd::tauocy
real, dimension(:), pointer tauocy
Definition: w3adatmd.F90:607
w3odatmd::irqpo1
integer, dimension(:), pointer irqpo1
Definition: w3odatmd.F90:490
w3adatmd::phs
real, dimension(:,:), pointer phs
Definition: w3adatmd.F90:597
w3adatmd::hs
real, dimension(:), pointer hs
Definition: w3adatmd.F90:587
w3gdatmd::ny
integer, pointer ny
Definition: w3gdatmd.F90:1097
w3adatmd::uba
real, dimension(:), pointer uba
Definition: w3adatmd.F90:614
w3adatmd::pqp
real, dimension(:,:), pointer pqp
Definition: w3adatmd.F90:597
w3odatmd::isbpo
integer, dimension(:), pointer isbpo
Definition: w3odatmd.F90:535
w3wdatmd::va
real, dimension(:,:), pointer va
Definition: w3wdatmd.F90:183
w3odatmd::napbpt
integer, pointer napbpt
Definition: w3odatmd.F90:457
w3adatmd::tauwix
real, dimension(:), pointer tauwix
Definition: w3adatmd.F90:603
w3adatmd::pthp0
real, dimension(:,:), pointer pthp0
Definition: w3adatmd.F90:597
w3adatmd::w3xeta
subroutine w3xeta(IMOD, NDSE, NDST)
Reduced version of W3SETA to point to expended output arrays.
Definition: w3adatmd.F90:3118
w3adatmd::tauwiy
real, dimension(:), pointer tauwiy
Definition: w3adatmd.F90:603
w3adatmd::taubbl
real, dimension(:,:), pointer taubbl
Definition: w3adatmd.F90:614
w3odatmd::ndse
integer, pointer ndse
Definition: w3odatmd.F90:456
w3adatmd::ef
real, dimension(:,:), pointer ef
Definition: w3adatmd.F90:594
yownodepool::listiplg
integer, dimension(:), allocatable, target, public listiplg
Definition: yownodepool.F90:86
w3adatmd::w3seta
subroutine w3seta(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3adatmd.F90:2645
w3adatmd::tauwny
real, dimension(:), pointer tauwny
Definition: w3adatmd.F90:603
w3odatmd::abpos
real, dimension(:,:), pointer abpos
Definition: w3odatmd.F90:541
w3gdatmd::mapfs
integer, dimension(:,:), pointer mapfs
Definition: w3gdatmd.F90:1163
w3adatmd::phiaw
real, dimension(:), pointer phiaw
Definition: w3adatmd.F90:603
w3adatmd::pws
real, dimension(:,:), pointer pws
Definition: w3adatmd.F90:597
w3adatmd::plp
real, dimension(:,:), pointer plp
Definition: w3adatmd.F90:597
w3odatmd::nblkrs
integer, pointer nblkrs
Definition: w3odatmd.F90:523
w3adatmd::phibbl
real, dimension(:), pointer phibbl
Definition: w3adatmd.F90:614
yownodepool
Has data that belong to nodes.
Definition: yownodepool.F90:39
pdlib_field_vec::do_output_exchanges
subroutine do_output_exchanges(IMOD)
Definition: pdlib_field_vec.F90:787
w3adatmd::cflthmax
real, dimension(:), pointer cflthmax
Definition: w3adatmd.F90:620
w3gdatmd::nsea
integer, pointer nsea
Definition: w3gdatmd.F90:1097
w3adatmd::psi
real, dimension(:,:), pointer psi
Definition: w3adatmd.F90:597
w3adatmd::sth2m
real, dimension(:,:), pointer sth2m
Definition: w3adatmd.F90:594
w3adatmd::tpms
real, dimension(:), pointer tpms
Definition: w3adatmd.F90:607
w3servmd
Definition: w3servmd.F90:3
w3odatmd::flogrd
logical, dimension(:,:), pointer flogrd
Definition: w3odatmd.F90:478
w3adatmd::ths
real, dimension(:), pointer ths
Definition: w3adatmd.F90:587
w3adatmd::bedforms
real, dimension(:,:), pointer bedforms
Definition: w3adatmd.F90:614
w3odatmd::nrqpo2
integer, pointer nrqpo2
Definition: w3odatmd.F90:486
w3odatmd::nbo2
integer, dimension(:), pointer nbo2
Definition: w3odatmd.F90:531
pdlib_field_vec::unst_pdlib_read_from_file
subroutine unst_pdlib_read_from_file(NDREAD)
Definition: pdlib_field_vec.F90:396
w3adatmd::hmaxd
real, dimension(:), pointer hmaxd
Definition: w3adatmd.F90:587
w3adatmd::pwst
real, dimension(:), pointer pwst
Definition: w3adatmd.F90:597
w3odatmd::irqbp1
integer, dimension(:), pointer irqbp1
Definition: w3odatmd.F90:538
w3adatmd::sxy
real, dimension(:), pointer sxy
Definition: w3adatmd.F90:607
w3adatmd::tauwnx
real, dimension(:), pointer tauwnx
Definition: w3adatmd.F90:603
w3odatmd::vaaux
real, dimension(:,:,:), pointer vaaux
Definition: w3odatmd.F90:525
w3odatmd::it0prt
integer, pointer it0prt
Definition: w3odatmd.F90:512
w3odatmd
Definition: w3odatmd.F90:3
w3odatmd::rsblks
integer, pointer rsblks
Definition: w3odatmd.F90:523
w3adatmd::wbt
real, dimension(:), pointer wbt
Definition: w3adatmd.F90:587
w3odatmd::irqgo2
integer, dimension(:), pointer irqgo2
Definition: w3odatmd.F90:476
w3adatmd::bhd
real, dimension(:), pointer bhd
Definition: w3adatmd.F90:607
w3adatmd::pnr
real, dimension(:), pointer pnr
Definition: w3adatmd.F90:597
yownodepool::listnpa
integer, dimension(:), allocatable, target, public listnpa
Definition: yownodepool.F90:86
w3adatmd::hmaxe
real, dimension(:), pointer hmaxe
Definition: w3adatmd.F90:587
w3adatmd::pt1
real, dimension(:,:), pointer pt1
Definition: w3adatmd.F90:597
w3adatmd::wlm
real, dimension(:), pointer wlm
Definition: w3adatmd.F90:587
w3odatmd::nfbpo
integer, pointer nfbpo
Definition: w3odatmd.F90:530
w3odatmd::naproc
integer, pointer naproc
Definition: w3odatmd.F90:457
w3parall::print_my_time
subroutine print_my_time(string)
Print timings.
Definition: w3parall.F90:200
yownodepool::listnp
integer, dimension(:), allocatable, target, public listnp
Definition: yownodepool.F90:86
w3gdatmd::us3df
integer, dimension(:), pointer us3df
Definition: w3gdatmd.F90:1098
w3adatmd::wnmean
real, dimension(:), pointer wnmean
Definition: w3adatmd.F90:587
w3odatmd::irqtr
integer, dimension(:), pointer irqtr
Definition: w3odatmd.F90:513
w3adatmd::cflkmax
real, dimension(:), pointer cflkmax
Definition: w3adatmd.F90:620
w3odatmd::irqbp2
integer, dimension(:), pointer irqbp2
Definition: w3odatmd.F90:538
yowdatapool::istatus
integer, dimension(mpi_status_size) istatus
MPI Real Type Shpuld be MPI_REAL8.
Definition: yowdatapool.F90:74
yowdatapool
Has fancy data.
Definition: yowdatapool.F90:39
w3adatmd::phioc
real, dimension(:), pointer phioc
Definition: w3adatmd.F90:607
w3odatmd::nrqrs
integer, pointer nrqrs
Definition: w3odatmd.F90:523
w3odatmd::irqrs
integer, dimension(:), pointer irqrs
Definition: w3odatmd.F90:524
w3odatmd::naptrk
integer, pointer naptrk
Definition: w3odatmd.F90:457
w3adatmd::qp
real, dimension(:), pointer qp
Definition: w3adatmd.F90:587
w3odatmd::flout
logical, dimension(:), pointer flout
Definition: w3odatmd.F90:468
w3adatmd::stmaxd
real, dimension(:), pointer stmaxd
Definition: w3adatmd.F90:587
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
w3adatmd::whitecap
real, dimension(:,:), pointer whitecap
Definition: w3adatmd.F90:603
w3odatmd::nappnt
integer, pointer nappnt
Definition: w3odatmd.F90:457
pdlib_field_vec
Definition: pdlib_field_vec.F90:1
w3adatmd::sppnt
real, dimension(:,:,:), pointer sppnt
Definition: w3adatmd.F90:684
w3adatmd::tauox
real, dimension(:), pointer tauox
Definition: w3adatmd.F90:607
w3odatmd::noextr
integer, parameter noextr
Definition: w3odatmd.F90:328
w3adatmd::p2sms
real, dimension(:,:), pointer p2sms
Definition: w3adatmd.F90:612
w3adatmd::prms
real, dimension(:), pointer prms
Definition: w3adatmd.F90:607
w3odatmd::napfld
integer, pointer napfld
Definition: w3odatmd.F90:457
w3adatmd::usero
real, dimension(:,:), pointer usero
Definition: w3adatmd.F90:623
w3parall::init_get_jsea_isproc
subroutine init_get_jsea_isproc(ISEA, JSEA, ISPROC)
Set JSEA for all schemes.
Definition: w3parall.F90:1163
w3odatmd::it0trk
integer, pointer it0trk
Definition: w3odatmd.F90:512
w3adatmd::mssy
real, dimension(:), pointer mssy
Definition: w3adatmd.F90:617
w3odatmd::ndst
integer, pointer ndst
Definition: w3odatmd.F90:456
w3wdatmd::ust
real, dimension(:), pointer ust
Definition: w3wdatmd.F90:183
w3adatmd::mpi_comm_wave
integer, pointer mpi_comm_wave
Definition: w3adatmd.F90:676
w3adatmd::tauoy
real, dimension(:), pointer tauoy
Definition: w3adatmd.F90:607
w3odatmd::nogrp
integer, parameter nogrp
Definition: w3odatmd.F90:323
w3adatmd::fp0
real, dimension(:), pointer fp0
Definition: w3adatmd.F90:587
w3gdatmd
Definition: w3gdatmd.F90:16
w3adatmd::hsig
real, dimension(:), pointer hsig
Definition: w3adatmd.F90:587
w3adatmd::ussx
real, dimension(:), pointer ussx
Definition: w3adatmd.F90:607
w3adatmd::mssx
real, dimension(:), pointer mssx
Definition: w3adatmd.F90:617
w3servmd::extcde
subroutine extcde(IEXIT, UNIT, MSG, FILE, LINE, COMM)
Definition: w3servmd.F90:736
w3odatmd::outpts
type(output), dimension(:), allocatable, target outpts
Definition: w3odatmd.F90:452
w3adatmd::mscy
real, dimension(:), pointer mscy
Definition: w3adatmd.F90:617
w3adatmd::w3xdma
subroutine w3xdma(IMOD, NDSE, NDST, OUTFLAGS)
Version of W3DIMX for extended ouput arrays only.
Definition: w3adatmd.F90:1523
w3odatmd::irqrss
integer, dimension(:), pointer irqrss
Definition: w3odatmd.F90:524
w3wdatmd::ustdir
real, dimension(:), pointer ustdir
Definition: w3wdatmd.F90:183
w3adatmd::ww3_field_vec
integer, pointer ww3_field_vec
Definition: w3adatmd.F90:676
w3adatmd::ptm1
real, dimension(:,:), pointer ptm1
Definition: w3adatmd.F90:597
w3odatmd::noswll
integer, pointer noswll
Definition: w3odatmd.F90:460
w3adatmd::thm
real, dimension(:), pointer thm
Definition: w3adatmd.F90:587
w3adatmd::mscx
real, dimension(:), pointer mscx
Definition: w3adatmd.F90:617
w3adatmd::ppe
real, dimension(:,:), pointer ppe
Definition: w3adatmd.F90:597
w3gdatmd::nx
integer, pointer nx
Definition: w3gdatmd.F90:1097
w3adatmd::pgw
real, dimension(:,:), pointer pgw
Definition: w3adatmd.F90:597
w3adatmd::ussp
real, dimension(:,:), pointer ussp
Definition: w3adatmd.F90:612
w3odatmd::nrqbp
integer, pointer nrqbp
Definition: w3odatmd.F90:533
w3parall
Parallel routines for implicit solver.
Definition: w3parall.F90:22
w3odatmd::irqgo
integer, dimension(:), pointer irqgo
Definition: w3odatmd.F90:476
w3odatmd::it0pnt
integer, pointer it0pnt
Definition: w3odatmd.F90:512
w3adatmd::mssd
real, dimension(:), pointer mssd
Definition: w3adatmd.F90:617
w3odatmd::nrqgo
integer, pointer nrqgo
Definition: w3odatmd.F90:475
w3odatmd::naprst
integer, pointer naprst
Definition: w3odatmd.F90:457
w3gdatmd::e3df
integer, dimension(:,:), pointer e3df
Definition: w3gdatmd.F90:1098
w3adatmd::t0m1
real, dimension(:), pointer t0m1
Definition: w3adatmd.F90:587
w3adatmd::tauocx
real, dimension(:), pointer tauocx
Definition: w3adatmd.F90:607
w3parall::init_get_isea
subroutine init_get_isea(ISEA, JSEA)
Set ISEA for all schemes.
Definition: w3parall.F90:1398
w3adatmd::aba
real, dimension(:), pointer aba
Definition: w3adatmd.F90:614
w3adatmd::syy
real, dimension(:), pointer syy
Definition: w3adatmd.F90:607
w3adatmd::ubd
real, dimension(:), pointer ubd
Definition: w3adatmd.F90:614
w3adatmd::sxx
real, dimension(:), pointer sxx
Definition: w3adatmd.F90:607
w3odatmd::nrqtr
integer, pointer nrqtr
Definition: w3odatmd.F90:512
w3wdatmd::asf
real, dimension(:), pointer asf
Definition: w3wdatmd.F90:183
w3adatmd::mpi_comm_wcmp
integer, pointer mpi_comm_wcmp
Definition: w3adatmd.F90:676