MODULE PDLIB_FIELD_VEC !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | | !/ | Aron Roland (BGS IT&E GmbH) | !/ | Mathieu Dutour-Sikiric (IRB) | !/ | | !/ | FORTRAN 90 | !/ | Last update : 01-Jan-2010 | !/ +-----------------------------------+ !/ !/ 01-Jan-2010 : Origination. ( version 6.04 ) !/ !/ Copyright 2010 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights !/ reserved. WAVEWATCH III is a trademark of the NWS. !/ No unauthorized use without permission. !/ ! 1. Purpose : Provides parallel I/O in context of PDLIB ! 2. Variables and types : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! W3XXXX Subr. Public ........ ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Remarks : ! 6. Switches : ! ! !/S Enable subroutine tracing. ! ! 7. Source code : !/ !/ ------------------------------------------------------------------- / !/ CONTAINS !/ ------------------------------------------------------------------- / ! SUBROUTINE GET_ARRAY_SIZE(TheSize) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | | !/ | Aron Roland (BGS IT&E GmbH) | !/ | Mathieu Dutour-Sikiric (IRB) | !/ | | !/ | FORTRAN 90 | !/ | Last update : 01-Mai-2018 | !/ +-----------------------------------+ !/ !/ 01-Mai-2018 : Origination. ( version 6.04 ) !/ ! 1. Purpose : Estimate arrays size for communication ! 2. Method : ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 6. Error messages : ! 7. Remarks ! 8. Structure : ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / !/S USE W3SERVMD, ONLY: STRACE ! USE W3ODATMD, ONLY: FLOGRD, FLOGR2, NOSWLL, NOEXTR, & NOGRP, NGRPP USE W3GDATMD, ONLY: E3DF, P2MSF, NK IMPLICIT NONE INTEGER, INTENT(OUT) :: TheSize LOGICAL :: FLGRDALL(NOGRP,NGRPP) INTEGER IH, I, J, K, IK !/ !/ ------------------------------------------------------------------- / !/ DO J=1, NOGRP DO K=1, NGRPP FLGRDALL (J,K) = (FLOGRD(J,K) .OR. FLOGR2(J,K)) END DO END DO IH = 0 IF ( FLGRDALL( 2, 1) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 2) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 3) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 4) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 5) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 6) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 7) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 8) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 9) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 10) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 11) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 12) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 13) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 14) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 15) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 16) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 2, 17) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 3, 1) ) THEN DO IK=E3DF(2,1),E3DF(3,1) IH = IH + 1 END DO END IF IF ( FLGRDALL( 3, 2) ) THEN DO IK=E3DF(2,2),E3DF(3,2) IH = IH + 1 END DO END IF IF ( FLGRDALL( 3, 3) ) THEN DO IK=E3DF(2,3),E3DF(3,3) IH = IH + 1 END DO END IF IF ( FLGRDALL( 3, 4) ) THEN DO IK=E3DF(2,4),E3DF(3,4) IH = IH + 1 END DO END IF IF ( FLGRDALL( 3, 5) ) THEN DO IK=E3DF(2,5),E3DF(3,5) IH = IH + 1 END DO END IF IF ( FLGRDALL( 4, 1) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4, 2) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4, 3) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4, 4) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4, 5) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4, 6) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4, 7) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4, 8) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4, 9) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4,10) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4,11) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4,12) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4,13) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4,14) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4,15) ) THEN IH = IH + NOSWLL + 1 END IF IF ( FLGRDALL( 4,16) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 4,17) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 5, 1) ) THEN IH = IH + 1 IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 5, 2) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 5, 3) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 5, 4) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 5, 5) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 5, 6) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 5, 7) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 5, 8) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 5, 9) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 5,10) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 6, 1) ) THEN IH = IH + 1 IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 6, 2) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 6, 3) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 6, 4) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 6, 5) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 6, 6) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 6, 7) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 6, 8) ) THEN DO IK=1,2*NK IH = IH + 1 END DO END IF IF ( FLGRDALL( 6, 9) ) THEN DO K=P2MSF(2),P2MSF(3) IH = IH + 1 END DO END IF IF ( FLGRDALL( 6, 10) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 6, 11) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 7, 1) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 7, 2) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 7, 3) ) THEN IH = IH + 1 IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 7, 4) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 7, 5) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 8, 1) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 8, 2) ) THEN IH = IH + 1 IH = IH + 1 END IF IF ( FLGRDALL( 8, 3) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 8, 4) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 8, 5) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 9, 2) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 9, 3) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 9, 4) ) THEN IH = IH + 1 END IF IF ( FLGRDALL( 9, 5) ) THEN IH = IH + 1 END IF DO I=1, NOEXTR IF ( FLGRDALL(10, I) ) THEN IH = IH + 1 END IF END DO TheSize=IH END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | | !/ | Aron Roland (BGS IT&E GmbH) | !/ | Mathieu Dutour-Sikiric (IRB) | !/ | | !/ | FORTRAN 90 | !/ | Last update : 01-Mai-2018 | !/ +-----------------------------------+ !/ !/ 01-Mai-2018 : Origination. ( version 6.04 ) !/ ! 1. Purpose : PDLIB read from file ! 2. Method : ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 6. Error messages : ! 7. Remarks ! 8. Structure : ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / !/S USE W3SERVMD, ONLY: STRACE ! use yowDatapool, only: istatus USE W3GDATMD, only : NSEA, NSPEC USE W3ODATMD, only : NAPROC, NTPROC, IAPROC USE W3ADATMD, only : MPI_COMM_WAVE USE W3PARALL, only : GET_JSEA_IBELONG USE W3WDATMD, ONLY : VA USE W3GDATMD, ONLY: NSEAL USE W3ADATMD, ONLY: NSEALM USE W3SERVMD, ONLY : EXTCDE !/TIMINGS USE W3PARALL, ONLY: PRINT_MY_TIME use yowNodepool, only: ListNP, ListNPA, ListIPLG IMPLICIT NONE INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ !/ ------------------------------------------------------------------- / !/ Local PARAMETERs !/ !/S INTEGER, SAVE :: IENT = 0 !/ !/ ------------------------------------------------------------------- / !/ ! INTEGER, intent(in) :: NDREAD INTEGER iBlock, iFirst, iEnd, len, i, IB, iProc INTEGER NREC, ISEA, JSEA, ierr INTEGER nbBlock, IBELONG INTEGER :: BlockSize REAL, allocatable :: ArrSend(:,:) REAL, allocatable :: DataRead(:,:) integer(KIND=8) RPOS integer LRECL INTEGER, PARAMETER :: LRB = 4 INTEGER NBLKRSloc, RSBLKSloc integer eArr(1) integer IERR_MPI, istat integer IPloc, IPglob, pos integer NbMatch, idx integer ListFirst(NAPROC) !/S CALL STRACE (IENT, 'VA_SETUP_IOBPD') ! !/DEBUGIO WRITE(740+IAPROC,*) 'UNST_PDLIB_READ, Beginning of function' !/DEBUGIO FLUSH(740+IAPROC) LRECL = MAX ( LRB*NSPEC , & LRB*(6+(25/LRB)+(9/LRB)+(29/LRB)+(3/LRB)) ) !/DEBUGIO WRITE(740+IAPROC,*) 'UNST_PDLIB_READ, LRB=', LRB, ' LRECL=', LRECL !/DEBUGIO FLUSH(740+IAPROC) IF (IAPROC .gt. NAPROC) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'Leaving bc rank IAPROC > NAPROC=', NAPROC !/DEBUGIO FLUSH(740+IAPROC) RETURN END IF ListFirst(1)=0 DO iProc=2,NAPROC ListFirst(iProc) = ListFirst(iProc-1) + ListNPA(iProc-1) END DO NBLKRSloc = 10 RSBLKSloc = MAX ( 5 , NSEALM/NBLKRSloc ) IF ( NBLKRSloc*RSBLKSloc .LT. NSEALM ) RSBLKSloc = RSBLKSloc + 1 NBLKRSloc = 1 + (NSEALM-1)/RSBLKSloc BLOCKSIZE = INT(REAL(NSEA)/REAL(NBLKRSloc)) ! nbBlock=NSEA / BlockSize IF (nbBlock * BlockSize .lt. NSEA) THEN nbBlock=nbBlock+1 END IF IF (IAPROC .eq. 1) THEN allocate(DATAread(NSPEC,BlockSize)) DATAread = 0. END IF DO iBlock=1,nbBlock iFirst = 1 + (iBlock - 1)*BlockSize iEnd = MIN(iBlock * BlockSize, NSEA) !/TIMINGS CALL PRINT_MY_TIME("Beginning of iBlock value treatment") !/DEBUGIO WRITE(740+IAPROC,*) 'R : iBlock=', iBlock, '/', nbBlock, 'iFirst=', iFirst, 'iEnd=', iEnd !/DEBUGIO FLUSH(740+IAPROC) ! Let's try to get the indexes right. ! We have 1 <= IB <= len = iEnd + 1 - iFirst ! We have iFirst - 1 = (iBlock - 1)*BlockSize ! and so iFirst <= IB + (iBlock - 1)*BlockSize <= iEnd ! and thus iFirst <= ISEA <= iEnd len=iEnd + 1 - iFirst IF (IAPROC .eq. 1) THEN !/TIMINGS CALL PRINT_MY_TIME("Before data reading") DO IB=1,len ISEA = (iBlock - 1)*BlockSize + IB NREC = ISEA + 2 RPOS = 1_8 + LRECL*(NREC-1_8) !!/DEBUGIO WRITE(740+IAPROC,*) 'READ AT ISEA=', ISEA, ' RPOS=', RPOS !!/DEBUGIO FLUSH(740+IAPROC) READ (NDREAD, POS=RPOS, IOSTAT=IERR) (DATAread(I,IB), I=1,NSPEC) END DO !/TIMINGS CALL PRINT_MY_TIME("After data reading") !/DEBUGIO WRITE(740+IAPROC,*) 'After the block of reads' !/DEBUGIO WRITE(740+IAPROC,*) 'iBlock=', iBlock, '/', nbBlock, ' sum(DATAread)=', sum(DATAread) !/DEBUGIO FLUSH(740+IAPROC) DO iProc=2,NAPROC NbMatch=0 DO IPloc=1,ListNPA(iProc) IPglob = ListIPLG(ListFirst(iProc) + IPloc) IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN NbMatch = NbMatch+1 END IF END DO !/DEBUGIO WRITE(740+IAPROC,*) 'Sending to iProc=', iProc, ' NbMatch=', NbMatch !/DEBUGIO FLUSH(740+IAPROC) IF (NbMatch .gt. 0) THEN allocate(ArrSend(NSPEC,NbMatch), stat=istat) ArrSend = 0. idx=0 DO IPloc=1,ListNPA(iProc) IPglob = ListIPLG(ListFirst(iProc) + IPloc) IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN pos = IPglob - iFirst + 1 idx = idx + 1 ArrSend(:,idx) = DATAread(:,pos) END IF END DO CALL MPI_SEND(ArrSend,NSPEC*NbMatch,MPI_REAL, iProc-1, 37, MPI_COMM_WAVE, ierr) deallocate(ArrSend) END IF END DO DO IPloc=1,ListNPA(1) IPglob = ListIPLG(IPloc) IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN pos = IPglob - iFirst + 1 VA(:,IPloc) = DATAread(:,pos) END IF END DO !/TIMINGS CALL PRINT_MY_TIME("After the sending") ELSE NbMatch=0 DO IPloc=1,ListNPA(IAPROC) IPglob = ListIPLG(ListFirst(IAPROC) + IPloc) IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN NbMatch = NbMatch+1 END IF END DO !/DEBUGIO WRITE(740+IAPROC,*) 'Receiving NbMatch=', NbMatch !/DEBUGIO FLUSH(740+IAPROC) IF (NbMatch .gt. 0) THEN allocate(ArrSend(NSPEC,NbMatch), stat=istat) CALL MPI_RECV(ArrSend,NSPEC*NbMatch,MPI_REAL, 0, 37, MPI_COMM_WAVE, istatus, ierr) idx=0 DO IPloc=1,ListNPA(IAPROC) IPglob = ListIPLG(ListFirst(IAPROC) + IPloc) IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN idx = idx + 1 VA(:,IPloc) = ArrSend(:,idx) END IF END DO deallocate(ArrSend) END IF END IF !/TIMINGS CALL PRINT_MY_TIME("Beginning of iBlock value treatment") END DO IF (IAPROC .eq. 1) THEN deallocate(DATAread) END IF !/DEBUGIO IF (IAPROC .le. NAPROC) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'iBlock=', iBlock, '/', nbBlock, ' sum(VA)=', sum(VA) !/DEBUGIO FLUSH(740+IAPROC) !/DEBUGIO END IF !/DEBUGIO WRITE(740+IAPROC,*) 'Exiting READ_FROM_FILE' !/DEBUGIO FLUSH(740+IAPROC) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | | !/ | Aron Roland (BGS IT&E GmbH) | !/ | Mathieu Dutour-Sikiric (IRB) | !/ | | !/ | FORTRAN 90 | !/ | Last update : 01-Mai-2018 | !/ +-----------------------------------+ !/ !/ 01-Mai-2018 : Origination. ( version 6.04 ) !/ ! 1. Purpose : PDLIB write to file ! 2. Method : ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 6. Error messages : ! 7. Remarks ! 8. Structure : ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / !/S USE W3SERVMD, ONLY: STRACE ! use yowDatapool, only: istatus USE yowNodepool, only: ListNP, ListNPA, ListIPLG USE W3PARALL, ONLY: INIT_GET_ISEA USE W3GDATMD, only : NSEA, NSPEC USE W3ODATMD, only : NAPROC, NTPROC, NAPRST, IAPROC USE W3ADATMD, only : MPI_COMM_WAVE USE W3PARALL, only : GET_JSEA_IBELONG USE W3WDATMD, ONLY : VA USE W3GDATMD, ONLY: NSEAL, NX, NY IMPLICIT NONE INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ !/ ------------------------------------------------------------------- / !/ Local PARAMETERs !/ !/S INTEGER, SAVE :: IENT = 0 !/ !/ ------------------------------------------------------------------- / !/ ! INTEGER, intent(in) :: NDWRITE INTEGER, PARAMETER :: BlockSize = 100000 REAL :: DATAwrite(NSPEC,BlockSize) REAL, allocatable :: DATArecv(:,:) integer ListFirst(NAPROC) integer idx, idxB integer len, i, IS integer iBlock, iFirst, iEnd integer IPglob, IPloc, pos, ISEA, nbBlock, NPAloc integer ierr, istat, JSEA, NREC, iProc integer NbMatch INTEGER, PARAMETER :: LRB = 4 INTEGER(KIND=8) RPOS INTEGER LRECL INTEGER IERR_MPI REAL(KIND=LRB) WRITEBUFF(NSPEC) REAL, allocatable :: DATAsend(:,:) !/S CALL STRACE (IENT, 'VA_SETUP_IOBPD') !/DEBUGIO WRITE(740+IAPROC,*) 'Beginning of UNST_PDLIB_WRITE_TO_FILE IAPROC=', IAPROC, 'NAPRST=', NAPRST !/DEBUGIO FLUSH(740+IAPROC) !/DEBUGIO WRITE(740+IAPROC,*) 'sum(VA)=', sum(VA) !/DEBUGIO FLUSH(740+IAPROC) ListFirst(1) = 0 DO IPROC=2,NAPROC ListFirst(iProc)=ListFirst(iProc-1) + ListNPA(iProc-1) END DO ! !/DEBUGIO WRITE(740+IAPROC,*) 'NX=', NX, ' NY=', NY, ' NSEA=', NSEA !/DEBUGIO WRITE(740+IAPROC,*) 'NAPROC=', NAPROC, ' NTPROC=', NTPROC LRECL = MAX ( LRB*NSPEC , & LRB*(6+(25/LRB)+(9/LRB)+(29/LRB)+(3/LRB)) ) !/DEBUGIO WRITE(740+IAPROC,*) 'UNST_PDLIB_WRITE, LRB=', LRB, ' LRECL=', LRECL !/DEBUGIO WRITE(740+IAPROC,*) 'NDWRITE=', NDWRITE, 'NAPROC=', NAPROC, 'NTPROC=', NTPROC !/DEBUGIO FLUSH(740+IAPROC) nbBlock=NSEA / BlockSize + 1 !/DEBUGIO WRITE(740+IAPROC,*) 'NSEA=', NSEA, ' BlockSize=', BlockSize DO iBlock=1,nbBlock iFirst= 1 + (iBlock - 1)*BlockSize iEnd= MIN(iBlock * BlockSize, NSEA) len=iEnd + 1 - iFirst !/DEBUGIO WRITE(740+IAPROC,*) 'W : iBlock=', iBlock, '/', nbBlock, 'iFirst=', iFirst, 'iEnd=', iEnd, ' len=', len !/DEBUGIO FLUSH(740+IAPROC) IF (IAPROC .eq. NAPRST) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'The Node is a restart writing node' !/DEBUGIO FLUSH(740+IAPROC) IF (IAPROC .le. NAPROC) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'It is also a running node' !/DEBUGIO FLUSH(740+IAPROC) DO JSEA=1,NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) IF ((iFirst .le. ISEA).and.(ISEA .le. iEnd)) THEN idx = ISEA - iFirst + 1 DATAwrite(:, idx) = VA(:, JSEA) END IF END DO END IF !/DEBUGIO WRITE(740+IAPROC,*) 'Now iterating over all the nodes for RECV' !/DEBUGIO FLUSH(740+IAPROC) DO iProc=1,NAPROC !/DEBUGIO WRITE(740+IAPROC,*) 'iProc=', iProc, ' / ', NAPROC !/DEBUGIO FLUSH(740+IAPROC) IF (iProc .ne. IAPROC) THEN NPAloc=ListNPA(iProc) !/DEBUGIO WRITE(740+IAPROC,*) 'We found NPAloc=', NPAloc !/DEBUGIO FLUSH(740+IAPROC) NbMatch=0 DO IPloc=1,NPAloc IPglob = ListIPLG(ListFirst(iProc) + IPloc) IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN NbMatch=NbMatch+1 END IF END DO IF (NbMatch .gt. 0) THEN allocate(DATArecv(NSPEC, NbMatch), stat=istat) !/DEBUGIO WRITE(740+IAPROC,*) 'After allocation and before reception, istat=', istat !/DEBUGIO FLUSH(740+IAPROC) CALL MPI_RECV(DATArecv,NSPEC*NbMatch,MPI_REAL, iProc-1, 101, MPI_COMM_WAVE, istatus, ierr) !/DEBUGIO WRITE(740+IAPROC,*) 'After reception, ierr=', ierr !/DEBUGIO FLUSH(740+IAPROC) idx=0 DO IPloc=1,NPAloc IPglob = ListIPLG(IPloc + ListFirst(iProc)) ISEA = IPglob ! Great ansatz here. False in general IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN idx=idx+1 pos = IPglob - iFirst + 1 DATAwrite(:, pos) = DATArecv(:, idx) END IF END DO !/DEBUGIO WRITE(740+IAPROC,*) 'After assignation' !/DEBUGIO FLUSH(740+IAPROC) deallocate(DATArecv, stat=istat) !/DEBUGIO WRITE(740+IAPROC,*) 'After assignation istat=', istat !/DEBUGIO FLUSH(740+IAPROC) END IF END IF END DO !/DEBUGIO WRITE(740+IAPROC,*) 'Before the actual write down' !/DEBUGIO WRITE(740+IAPROC,*) 'iBlock=', iBlock, '/', nbBlock, 'Sum DATAwrite=', sum(DATAwrite) !/DEBUGIO FLUSH(740+IAPROC) DO ISEA=iFirst,iEnd idx = ISEA - iFirst + 1 NREC = ISEA + 2 RPOS = 1_8 + LRECL*(NREC-1_8) !!/DEBUGIO WRITE(740+IAPROC,*) 'WRITE AT ISEA=', ISEA, ' RPOS=', RPOS !!/DEBUGIO FLUSH(740+IAPROC) WRITEBUFF(:) = 0 WRITEBUFF(1:NSPEC) = DATAwrite(1:NSPEC, idx) WRITE(NDWRITE, POS=RPOS) WRITEBUFF END DO !/DEBUGIO WRITE(740+IAPROC,*) 'After the write down' !/DEBUGIO FLUSH(740+IAPROC) ELSE !/DEBUGIO WRITE(740+IAPROC,*) 'We are a node different from NAPRST' !/DEBUGIO FLUSH(740+IAPROC) IF (IAPROC .le. NAPROC) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'We are a computing node' !/DEBUGIO FLUSH(740+IAPROC) NbMatch=0 DO IPloc=1,ListNPA(IAPROC) IPglob = ListIPLG(ListFirst(IAPROC) + IPloc) IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN NbMatch=NbMatch+1 END IF END DO !/DEBUGIO WRITE(740+IAPROC,*) 'NbMatch=', NbMatch !/DEBUGIO FLUSH(740+IAPROC) IF (NbMatch .gt. 0) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'We are actually a computing node so we have something to send' !/DEBUGIO WRITE(740+IAPROC,*) 'Sending message of length NSEAL=', NSEAL !/DEBUGIO FLUSH(740+IAPROC) allocate(DATAsend(NSPEC,NbMatch), stat=istat) !/DEBUGIO WRITE(740+IAPROC,*) 'After allocation of DATAsend, istat=', istat !/DEBUGIO FLUSH(740+IAPROC) idx=0 DO IPloc=1,ListNPA(IAPROC) IPglob = ListIPLG(ListFirst(IAPROC) + IPloc) IF ((iFirst .le. IPglob).and.(IPglob .le. iEnd)) THEN idx=idx + 1 DATAsend(:,idx)=VA(:,IPloc) END IF END DO !/DEBUGIO WRITE(740+IAPROC,*) 'After assignation of DATAsend' !/DEBUGIO FLUSH(740+IAPROC) CALL MPI_SEND(DATAsend,NSPEC*NbMatch,MPI_REAL, NAPRST-1, 101, MPI_COMM_WAVE, ierr) !/DEBUGIO WRITE(740+IAPROC,*) 'After sending of DATAsend, ierr=', ierr !/DEBUGIO FLUSH(740+IAPROC) deallocate(DATAsend, stat=istat) !/DEBUGIO WRITE(740+IAPROC,*) 'After deallocation of DATAsend, istat=', istat !/DEBUGIO FLUSH(740+IAPROC) END IF END IF !/DEBUGIO WRITE(740+IAPROC,*) 'After the IAPROC test' !/DEBUGIO FLUSH(740+IAPROC) END IF END DO !!/DEBUGIO WRITE(740+IAPROC,*) 'Before the MPI_BARRIER' !!/DEBUGIO FLUSH(740+IAPROC) ! CALL MPI_BARRIER(MPI_COMM_WAVE, IERR_MPI) !/DEBUGIO WRITE(740+IAPROC,*) 'Exiting the UNST_PDLIB_WRITE_TO_FILE' !/DEBUGIO FLUSH(740+IAPROC) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | | !/ | Aron Roland (BGS IT&E GmbH) | !/ | Mathieu Dutour-Sikiric (IRB) | !/ | | !/ | FORTRAN 90 | !/ | Last update : 01-Mai-2018 | !/ +-----------------------------------+ !/ !/ 01-Mai-2018 : Origination. ( version 6.04 ) !/ ! 1. Purpose : Do communication for PDLIB output ! 2. Method : ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! USE W3ADATMD, ONLY: W3XDMA, W3SETA, W3XETA USE W3SERVMD, ONLY: EXTCDE USE W3GDATMD, ONLY: NSEA USE W3GDATMD, ONLY: NX, NSPEC, MAPFS, E3DF, P2MSF, US3DF USE W3WDATMD, ONLY: VA, UST, USTDIR, ASF, FPIS USE W3ADATMD, ONLY: MPI_COMM_WAVE, WW3_FIELD_VEC USE W3ADATMD, ONLY: HS, WLM, T02 USE W3ADATMD, ONLY: T0M1, THM, THS, FP0, THP0, FP1, THP1, & DTDYN, FCUT, SPPNT, ABA, ABD, UBA, UBD,& SXX, SYY, SXY, USERO, PHS, PTP, PLP, & PDIR, PSI, PWS, PWST, PNR, PHIAW, & PHIOC, & TUSX, TUSY, TAUWIX, TAUWIY, TAUOX, & TAUOY, USSX, USSY, MSSX, MSSY, & MSCX, MSCY, PRMS, TPMS, CHARN, & TAUWNX, TAUWNY, BHD, CGE, & CFLXYMAX, CFLTHMAX, CFLKMAX, WHITECAP, & BEDFORMS, PHIBBL, TAUBBL, T01, & P2SMS, US3D, EF, TH1M, STH1M, TH2M, & STH2M, HSIG, TAUICE, PHICE, PTHP0, PQP,& PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & QP, MSSD, MSCD, STMAXE, STMAXD, HMAXE, & HCMAXE, HMAXD, HCMAXD, WBT USE W3GDATMD, ONLY: NK, NSEAL USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, NTPROC, FLOUT, & NAPFLD, NAPPNT, NAPRST, NAPBPT, NAPTRK,& NOGRP, NGRPP USE W3ODATMD, ONLY: OUTPTS, NRQGO, NRQGO2, IRQGO, IRQGO2, & FLOGRD, NRQPO, NRQPO2, IRQPO1, IRQPO2, & NOPTS, IPTINT, NRQRS, IRQRS, NBLKRS, & RSBLKS, IRQRSS, VAAUX, NRQBP, NRQBP2, & IRQBP1, IRQBP2, NFBPO, NBO2, ISBPO, & ABPOS, NRQTR, IRQTR, IT0PNT, IT0TRK, & IT0PRT, NOSWLL, NOEXTR, NDSE, IOSTYP, & FLOGR2 USE W3ADATMD, ONLY: MPI_COMM_WCMP USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC USE W3PARALL, ONLY: INIT_GET_ISEA use yowDatapool, only: istatus !/ IMPLICIT NONE ! INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: IK, IFJ INTEGER :: IH, IT0, IROOT, IT, IERR, I0, & IFROM, IX(4), IY(4), IS(4), & IP(4), I, J, JSEA, ITARG, IB, & JSEA0, JSEAN, NSEAB, IBOFF, & ISEA, ISPROC, K, NRQMAX !/S INTEGER, SAVE :: IENT LOGICAL :: FLGRDALL(NOGRP,NGRPP) REAL, allocatable :: ARRexch(:,:), ARRexch_loc(:,:) REAL, allocatable :: ARRtotal(:,:) INTEGER, allocatable :: ARRpos(:), ARRpos_loc(:) INTEGER :: eEnt(1), IPROC INTEGER :: TheSize, NSEAL_loc INTEGER, SAVE :: indexOutput !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Beginning of output, indexOutput=', indexOutput !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'NAPROC=', NAPROC, ' NAPFLD=', NAPFLD !/DEBUGOUTPUT FLUSH(740+IAPROC) !/ !/ ------------------------------------------------------------------- / !/ DO J=1, NOGRP DO K=1, NGRPP FLGRDALL (J,K) = (FLOGRD(J,K) .OR. FLOGR2(J,K)) END DO END DO NRQGO = 0 NRQGO2 = 0 IT0 = NSPEC IROOT = NAPFLD - 1 !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Entering DO_OUTPUT_EXCHANGES' !/DEBUGOUTPUT FLUSH(740+IAPROC) IF ( FLOUT(1) .OR. FLOUT(7) ) THEN CALL GET_ARRAY_SIZE(TheSize) IF ( IAPROC .LE. NAPROC ) THEN !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Allocating and filling' !/DEBUGOUTPUT FLUSH(740+IAPROC) allocate(ARRexch(TheSize, NSEAL), ARRpos(NSEAL)) DO JSEA=1,NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) ARRpos(JSEA)=ISEA IH = 0 IF ( FLGRDALL( 2, 1) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=HS(JSEA) END IF IF ( FLGRDALL( 2, 2) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=WLM(JSEA) END IF IF ( FLGRDALL( 2, 3) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=T02(JSEA) END IF IF ( FLGRDALL( 2, 4) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=T0M1(JSEA) END IF IF ( FLGRDALL( 2, 5) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=T01(JSEA) END IF IF ( FLGRDALL( 2, 6) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=FP0(JSEA) END IF IF ( FLGRDALL( 2, 7) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=THM(JSEA) END IF IF ( FLGRDALL( 2, 8) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=THS(JSEA) END IF IF ( FLGRDALL( 2, 9) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=THP0(JSEA) END IF IF ( FLGRDALL( 2, 10) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=HSIG(JSEA) END IF IF ( FLGRDALL( 2, 11) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=STMAXE(JSEA) END IF IF ( FLGRDALL( 2, 12) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=STMAXD(JSEA) END IF IF ( FLGRDALL( 2, 13) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=HMAXE(JSEA) END IF IF ( FLGRDALL( 2, 14) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=HCMAXE(JSEA) END IF IF ( FLGRDALL( 2, 15) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=HMAXD(JSEA) END IF IF ( FLGRDALL( 2, 16) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=HCMAXD(JSEA) END IF IF ( FLGRDALL( 2, 17) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=WBT(JSEA) END IF IF ( FLGRDALL( 3, 1) ) THEN DO IK=E3DF(2,1),E3DF(3,1) IH = IH + 1 Arrexch(IH,JSEA)=EF(JSEA,IK) END DO END IF IF ( FLGRDALL( 3, 2) ) THEN DO IK=E3DF(2,2),E3DF(3,2) IH = IH + 1 Arrexch(IH,JSEA)=TH1M(JSEA,IK) END DO END IF IF ( FLGRDALL( 3, 3) ) THEN DO IK=E3DF(2,3),E3DF(3,3) IH = IH + 1 Arrexch(IH,JSEA)=STH1M(JSEA,IK) END DO END IF IF ( FLGRDALL( 3, 4) ) THEN DO IK=E3DF(2,4),E3DF(3,4) IH = IH + 1 Arrexch(IH,JSEA)=TH2M(JSEA,IK) END DO END IF IF ( FLGRDALL( 3, 5) ) THEN DO IK=E3DF(2,5),E3DF(3,5) IH = IH + 1 Arrexch(IH,JSEA)=STH2M(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 1) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PHS(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 2) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PTP(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 3) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PLP(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 4) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PDIR(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 5) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PSI(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 6) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PWS(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 7) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PTHP0(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 8) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PQP(JSEA,IK) END DO END IF IF ( FLGRDALL( 4, 9) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PPE(JSEA,IK) END DO END IF IF ( FLGRDALL( 4,10) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PGW(JSEA,IK) END DO END IF IF ( FLGRDALL( 4,11) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PSW(JSEA,IK) END DO END IF IF ( FLGRDALL( 4,12) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PTM1(JSEA,IK) END DO END IF IF ( FLGRDALL( 4,13) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PT1(JSEA,IK) END DO END IF IF ( FLGRDALL( 4,14) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PT2(JSEA,IK) END DO END IF IF ( FLGRDALL( 4,15) ) THEN DO IK=0, NOSWLL IH = IH + 1 Arrexch(IH,JSEA)=PEP(JSEA,IK) END DO END IF IF ( FLGRDALL( 4,16) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=PWST(JSEA) END IF IF ( FLGRDALL( 4,17) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=PNR(JSEA) END IF IF ( FLGRDALL( 5, 1) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=UST(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=USTDIR(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=ASF(JSEA) END IF IF ( FLGRDALL( 5, 2) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=CHARN(JSEA) END IF IF ( FLGRDALL( 5, 3) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=CGE(JSEA) END IF IF ( FLGRDALL( 5, 4) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=PHIAW(JSEA) END IF IF ( FLGRDALL( 5, 5) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=TAUWIX(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=TAUWIY(JSEA) END IF IF ( FLGRDALL( 5, 6) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=TAUWNX(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=TAUWNY(JSEA) END IF IF ( FLGRDALL( 5, 7) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=WHITECAP(JSEA,1) END IF IF ( FLGRDALL( 5, 8) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=WHITECAP(JSEA,2) END IF IF ( FLGRDALL( 5, 9) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=WHITECAP(JSEA,3) END IF IF ( FLGRDALL( 5,10) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=WHITECAP(JSEA,4) END IF IF ( FLGRDALL( 6, 1) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=SXX(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=SYY(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=SXY(JSEA) END IF IF ( FLGRDALL( 6, 2) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=TAUOX(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=TAUOY(JSEA) END IF IF ( FLGRDALL( 6, 3) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=BHD(JSEA) END IF IF ( FLGRDALL( 6, 4) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=PHIOC(JSEA) END IF IF ( FLGRDALL( 6, 5) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=TUSX(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=TUSY(JSEA) END IF IF ( FLGRDALL( 6, 6) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=USSX(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=USSY(JSEA) END IF IF ( FLGRDALL( 6, 7) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=PRMS(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=TPMS(JSEA) END IF IF ( FLGRDALL( 6, 8) ) THEN DO IK=1,2*NK IH = IH + 1 Arrexch(IH,JSEA)=US3D(JSEA,IK) END DO END IF IF ( FLGRDALL( 6, 9) ) THEN DO K=P2MSF(2),P2MSF(3) IH = IH + 1 Arrexch(IH,JSEA)=P2SMS(JSEA,K) END DO END IF IF ( FLGRDALL( 6, 10) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=TAUICE(JSEA,1) IH = IH + 1 Arrexch(IH,JSEA)=TAUICE(JSEA,2) END IF IF ( FLGRDALL( 6, 11) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=PHICE(JSEA) END IF IF ( FLGRDALL( 7, 1) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=ABA(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=ABD(JSEA) END IF IF ( FLGRDALL( 7, 2) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=UBA(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=UBD(JSEA) END IF IF ( FLGRDALL( 7, 3) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=BEDFORMS(JSEA,1) IH = IH + 1 Arrexch(IH,JSEA)=BEDFORMS(JSEA,2) IH = IH + 1 Arrexch(IH,JSEA)=BEDFORMS(JSEA,3) END IF IF ( FLGRDALL( 7, 4) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=PHIBBL(JSEA) END IF IF ( FLGRDALL( 7, 5) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=TAUBBL(JSEA,1) IH = IH + 1 Arrexch(IH,JSEA)=TAUBBL(JSEA,2) END IF IF ( FLGRDALL( 8, 1) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=MSSX(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=MSSY(JSEA) END IF IF ( FLGRDALL( 8, 2) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=MSCX(JSEA) IH = IH + 1 Arrexch(IH,JSEA)=MSCY(JSEA) END IF IF ( FLGRDALL( 8, 3) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=MSSD(JSEA) END IF IF ( FLGRDALL( 8, 4) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=MSCD(JSEA) END IF IF ( FLGRDALL( 8, 5) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=QP(JSEA) END IF IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=DTDYN(JSEA) END IF IF ( FLGRDALL( 9, 2) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=FCUT(JSEA) END IF IF ( FLGRDALL( 9, 3) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=CFLXYMAX(JSEA) END IF IF ( FLGRDALL( 9, 4) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=CFLTHMAX(JSEA) END IF IF ( FLGRDALL( 9, 5) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=CFLKMAX(JSEA) END IF DO I=1, NOEXTR IF ( FLGRDALL(10, I) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=USERO(JSEA,I) END IF END DO END DO END IF !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Before assigning field values' !/DEBUGOUTPUT FLUSH(740+IAPROC) ! ! Now synchronizing the data ! It must be possible to ensure that the output ! node is also a computational node. ! IF (IAPROC .eq. NAPFLD) THEN allocate(ARRtotal(TheSize, NSEA)) IF (IAPROC .le. NAPROC) THEN DO I=1,NSEAL ARRtotal(:,ARRpos(I)) = ARRexch(:,I) END DO END IF END IF !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Before ARRexch operations' !/DEBUGOUTPUT FLUSH(740+IAPROC) IF ((IAPROC .le. NAPROC).and.(IAPROC.ne.NAPFLD)) THEN !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Case 1' !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'NSEAL=', NSEAL !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'IAPROC=', IAPROC, ' NAPFLD=', NAPFLD !/DEBUGOUTPUT FLUSH(740+IAPROC) eEnt(1)=NSEAL CALL MPI_SEND(eEnt,1,MPI_INTEGER, NAPFLD-1, 23, MPI_COMM_WAVE, ierr) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'After MPI_SEND 1' !/DEBUGOUTPUT FLUSH(740+IAPROC) CALL MPI_SEND(ARRpos,NSEAL,MPI_INTEGER, NAPFLD-1, 29, MPI_COMM_WAVE, ierr) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'After MPI_SEND 2' !/DEBUGOUTPUT FLUSH(740+IAPROC) CALL MPI_SEND(ARRexch,NSEAL*TheSize,MPI_REAL, NAPFLD-1, 37, MPI_COMM_WAVE, ierr) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'After MPI_SEND 3' !/DEBUGOUTPUT FLUSH(740+IAPROC) deallocate(ARRpos, ARRexch) END IF !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Case 2' !/DEBUGOUTPUT FLUSH(740+IAPROC) IF (IAPROC .eq. NAPFLD) THEN !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Case 2a' !/DEBUGOUTPUT FLUSH(740+IAPROC) DO IPROC=1,NAPROC IF (IPROC .ne. IAPROC) THEN !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'IPROC=', IPROC !/DEBUGOUTPUT FLUSH(740+IAPROC) CALL MPI_RECV(eEnt,1,MPI_INTEGER, IPROC-1, 23, MPI_COMM_WAVE, istatus, ierr) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'After MPI_RECV 1' !/DEBUGOUTPUT FLUSH(740+IAPROC) NSEAL_loc=eEnt(1) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'NSEAL_loc=', NSEAL_loc !/DEBUGOUTPUT FLUSH(740+IAPROC) allocate(ARRpos_loc(NSEAL_loc), ARRexch_loc(TheSize, NSEAL_loc)) CALL MPI_RECV(ARRpos_loc,NSEAL_loc,MPI_INTEGER, IPROC-1, 29, MPI_COMM_WAVE, istatus, ierr) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'After MPI_RECV 2' !/DEBUGOUTPUT FLUSH(740+IAPROC) CALL MPI_RECV(ARRexch_loc,NSEAL_loc*TheSize,MPI_INTEGER, IPROC-1, 37, MPI_COMM_WAVE, istatus, ierr) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'After MPI_RECV 3' !/DEBUGOUTPUT FLUSH(740+IAPROC) DO I=1,NSEAL_loc ARRtotal(:,ARRpos_loc(I)) = ARRexch_loc(:,I) END DO deallocate(ARRexch_loc, ARRpos_loc) END IF END DO END IF !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'After ARRexch operations' !/DEBUGOUTPUT FLUSH(740+IAPROC) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'NAPFLD=', NAPFLD !/DEBUGOUTPUT FLUSH(740+IAPROC) IF ( IAPROC .EQ. NAPFLD ) THEN ! CALL W3XDMA ( IMOD, NDSE, NDST, FLGRDALL ) !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Call W3XETA from DO_OUTPUT_EXCHANGES' !/DEBUGOUTPUT FLUSH(740+IAPROC) CALL W3XETA ( IMOD, NDSE, NDST ) IH = 0 IF ( FLGRDALL( 2, 1) ) THEN IH = IH + 1 HS(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 2) ) THEN IH = IH + 1 WLM(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 3) ) THEN IH = IH + 1 T02(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 4) ) THEN IH = IH + 1 T0M1(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 5) ) THEN IH = IH + 1 T01(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 6) ) THEN IH = IH + 1 FP0(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 7) ) THEN IH = IH + 1 THM(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 8) ) THEN IH = IH + 1 THS(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 9) ) THEN IH = IH + 1 THP0(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 10) ) THEN IH = IH + 1 HSIG(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 11) ) THEN IH = IH + 1 STMAXE(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 12) ) THEN IH = IH + 1 STMAXD(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 13) ) THEN IH = IH + 1 HMAXE(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 14) ) THEN IH = IH + 1 HCMAXE(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 15) ) THEN IH = IH + 1 HMAXD(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 16) ) THEN IH = IH + 1 HCMAXD(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 2, 17) ) THEN IH = IH + 1 WBT(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 3, 1) ) THEN DO IK=E3DF(2,1),E3DF(3,1) IH = IH + 1 EF(1:NSEA,IK) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 3, 2) ) THEN DO IK=E3DF(2,2),E3DF(3,2) IH = IH + 1 TH1M(1:NSEA,IK) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 3, 3) ) THEN DO IK=E3DF(2,3),E3DF(3,3) IH = IH + 1 STH1M(1:NSEA,IK) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 3, 4) ) THEN DO IK=E3DF(2,4),E3DF(3,4) IH = IH + 1 TH2M(1:NSEA,IK) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 3, 5) ) THEN DO IK=E3DF(2,5),E3DF(3,5) IH = IH + 1 STH2M(1:NSEA,IK) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 1) ) THEN DO K=0, NOSWLL IH = IH + 1 PHS(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 2) ) THEN DO K=0, NOSWLL IH = IH + 1 PTP(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 3) ) THEN DO K=0, NOSWLL IH = IH + 1 PLP(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 4) ) THEN DO K=0, NOSWLL IH = IH + 1 PDIR(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 5) ) THEN DO K=0, NOSWLL IH = IH + 1 PSI(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 6) ) THEN DO K=0, NOSWLL IH = IH + 1 PWS(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 7) ) THEN DO K=0, NOSWLL IH = IH + 1 PTHP0(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 8) ) THEN DO K=0, NOSWLL IH = IH + 1 PQP(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4, 9) ) THEN DO K=0, NOSWLL IH = IH + 1 PPE(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4,10) ) THEN DO K=0, NOSWLL IH = IH + 1 PGW(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4,11) ) THEN DO K=0, NOSWLL IH = IH + 1 PSW(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4,12) ) THEN DO K=0, NOSWLL IH = IH + 1 PTM1(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4,13) ) THEN DO K=0, NOSWLL IH = IH + 1 PT1(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4,14) ) THEN DO K=0, NOSWLL IH = IH + 1 PT2(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4,15) ) THEN DO K=0, NOSWLL IH = IH + 1 PEP(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 4,16) ) THEN IH = IH + 1 PWST(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 4,17) ) THEN IH = IH + 1 PNR(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 1) ) THEN IH = IH + 1 UST(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 USTDIR(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 ASF(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 2) ) THEN IH = IH + 1 CHARN(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 3) ) THEN IH = IH + 1 CGE(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 4) ) THEN IH = IH + 1 PHIAW(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 5) ) THEN IH = IH + 1 TAUWIX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 TAUWIY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 6) ) THEN IH = IH + 1 TAUWNX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 TAUWNY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 7) ) THEN IH = IH + 1 WHITECAP(1:NSEA,1) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 8) ) THEN IH = IH + 1 WHITECAP(1:NSEA,2) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 9) ) THEN IH = IH + 1 WHITECAP(1:NSEA,3) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5,10) ) THEN IH = IH + 1 WHITECAP(1:NSEA,4) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 1) ) THEN IH = IH + 1 SXX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 SYY(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 SXY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 2) ) THEN IH = IH + 1 TAUOX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 TAUOY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 3) ) THEN IH = IH + 1 BHD(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 4) ) THEN IH = IH + 1 PHIOC(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 5) ) THEN IH = IH + 1 TUSX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 TUSY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 6) ) THEN IH = IH + 1 USSX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 USSY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 7) ) THEN IH = IH + 1 PRMS(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 TPMS(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 8) ) THEN DO IK=1,2*NK IH = IH + 1 US3D(1:NSEA,IK) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 6, 9) ) THEN DO K=P2MSF(2),P2MSF(3) IH = IH + 1 P2SMS(1:NSEA,K) = ARRtotal(IH,:) END DO END IF IF ( FLGRDALL( 6, 10) ) THEN IH = IH + 1 TAUICE(1:NSEA,1) = ARRtotal(IH,:) IH = IH + 1 TAUICE(1:NSEA,2) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 11) ) THEN IH = IH + 1 PHICE(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 7, 1) ) THEN IH = IH + 1 ABA(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 ABD(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 7, 2) ) THEN IH = IH + 1 UBA(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 UBD(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 7, 3) ) THEN IH = IH + 1 BEDFORMS(1:NSEA,1) = ARRtotal(IH,:) IH = IH + 1 BEDFORMS(1:NSEA,2) = ARRtotal(IH,:) IH = IH + 1 BEDFORMS(1:NSEA,3) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 7, 4) ) THEN IH = IH + 1 PHIBBL(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 7, 5) ) THEN IH = IH + 1 TAUBBL(1:NSEA,1) = ARRtotal(IH,:) IH = IH + 1 TAUBBL(1:NSEA,2) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 8, 1) ) THEN IH = IH + 1 MSSX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 MSSY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 8, 2) ) THEN IH = IH + 1 MSCX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 MSCY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 8, 3) ) THEN IH = IH + 1 MSSD(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 8, 4) ) THEN IH = IH + 1 MSCD(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 8, 5) ) THEN IH = IH + 1 QP(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 DTDYN(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 9, 2) ) THEN IH = IH + 1 FCUT(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 9, 3) ) THEN IH = IH + 1 CFLXYMAX(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 9, 4) ) THEN IH = IH + 1 CFLTHMAX(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 9, 5) ) THEN IH = IH + 1 CFLKMAX(1:NSEA) = ARRtotal(IH,:) END IF DO I=1, NOEXTR IF ( FLGRDALL(10, I) ) THEN IH = IH + 1 USERO(1:NSEA,I) = ARRtotal(IH,:) END IF END DO CALL W3SETA ( IMOD, NDSE, NDST ) END IF !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'After IAPROC = NAPFLD test' !/DEBUGOUTPUT FLUSH(740+IAPROC) END IF !/DEBUGOUTPUT WRITE(740+IAPROC,*) 'Ending of output, indexOutput=', indexOutput !/DEBUGOUTPUT FLUSH(740+IAPROC) indexOutput=indexOutput+1 END SUBROUTINE DO_OUTPUT_EXCHANGES !/ ------------------------------------------------------------------- / END MODULE PDLIB_FIELD_VEC !/ ------------------------------------------------------------------- /