#include "w3macros.h" !/ ------------------------------------------------------------------- / MODULE W3IORSMD !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 2003 | !/ | Last update : 09-Aug-2017 | !/ +-----------------------------------+ !/ !/ See subroutine for update log. !/ ! 1. Purpose : ! ! Read/write restart files. ! ! 2. Variables and types : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! VERINI C*10 Private Restart file version number. ! IDSTR C*26 Private Restart file UD string. ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! W3IORS Subr. Public Read/write restart files. ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SETO, W3SETG, W3SETW, W3DIMW ! Subr. W3xDATMD Manage data structures. ! STRACE Subr. W3SERVMD Subroutine tracing. (!/S) ! EXTCDE Subr. W3SERVMD Abort program with exit code. ! MPI_STARTALL, MPI_WAITALL (!/MPI) ! Subr. MPI persistent communication routines ! ---------------------------------------------------------------- ! ! 5. Remarks : ! ! 6. Switches : ! ! See also routine. ! ! 7. Source code : ! !/ ------------------------------------------------------------------- / PUBLIC !/ !/ Private parameter statements (ID strings) !/ CHARACTER(LEN=10), PARAMETER, PRIVATE :: VERINI = 'III 5.10 ' CHARACTER(LEN=26), PARAMETER, PRIVATE :: & IDSTR = 'WAVEWATCH III RESTART FILE' !/ CONTAINS !/ ------------------------------------------------------------------- / SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, INTYPE, IMOD ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 05-Jun-2018 | !/ +-----------------------------------+ !/ !/ 12-Jan-1999 : Final FORTRAN 77 ( version 1.18 ) !/ 27-Dec-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) !/ 30-Apr-2002 : Add ice for transparencies. ( version 2.20 ) !/ 13-Nov-2002 : Add stress as vector. ( version 3.00 ) !/ 19-Aug-2003 : Output server options added. ( version 3.04 ) !/ 09-Dec-2004 : Multiple grid version. ( version 3.06 ) !/ 24-Jun-2005 : Adding MAPST2. ( version 3.07 ) !/ 27-Jun-2006 : Adding file name preamble. ( version 3.09 ) !/ 05-Jul-2006 : Consolidate stress arrays. ( version 3.09 ) !/ 08-May-2007 : Starting from calm as an option. ( version 3.11 ) !/ 17-May-2007 : Adding NTPROC/NAPROC separation. ( version 3.11 ) !/ 22-Jun-2007 : Dedicated output processes. ( version 3.11 ) !/ 15-Apr-2008 : Clean up for distribution. ( version 3.14 ) !/ 21-Apr-2008 : Remove PGI bug internal files. ( version 3.14 ) !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 30-Oct-2009 : Output file name with 3 digit id. ( version 3.14 ) !/ (W. E. Rogers, NRL) !/ 14-Nov-2013 : Remove cold start init. UST(DIR). ( version 4.13 ) !/ 31-May-2016 : Optimize restart file size for un- ( version 5.10 ) !/ structured grid and restart read. !/ (M. Ward, NCI, S. Zieger, BOM) !/ 10-Mar-2017 : File access mode changed to 'STREAM'( version 6.02 ) !/ (S. Zieger, BOM) !/ 09-Aug-2017 : Bug fix for MPI restart read issue ( version 6.02 ) !/ (T. Campbell, NRL) !/ 05-Jun-2018 : Add PDLIB/TIMINGS/DEBUGIO ( version 6.04 ) !/ DEBUGINIT/MPI !/ !/ Copyright 2009-2013 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 : ! ! Reads/writes restart files. ! ! 2. Method : ! ! The file is opened within the routine, the name is pre-defined ! and the unit number is given in the parameter list. The restart ! file is written using UNFORMATTED write statements. The routine ! generates new names when called more than once. File names are : ! ! restart000.FILEXT ! restart001.FILEXT ! restart002.FILEXT etc. ! ! The file to be read thus always is unnumbered, whereas all ! written files are automatically numbered. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! INXOUT C*(*) I Test string for read/write, valid are: ! 'READ' Reading of a restart file. ! 'HOT' Writing a full restart from the model. ! 'COLD' Writing a cold start file. ! 'WIND' Initialize fields using first wind ! field. ! 'CALM' Starting from calm conditions. ! NDSR Int. I/O File unit number. ! DUMFPI Real I Dummy values for FPIS for cold start. ! INTYPE Int. O Type of input field, ! 0 : cold start, ! 1 : cold start with fetch-limited spectra, ! 2 : full restart, ! 3 : for writing file. ! 4 : starting from calm. ! IMOD Int. I Optional grid number, defaults to 1. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! See module documentation. ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3INIT Subr. W3INITMD Wave model initialization routine. ! W3WAVE Subr. W3WAVEMD Actual wave model routine. ! WW3_STRT Prog. N/A Initial conditions program. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! Tests on INXOUT, file status and on array dimensions. ! ! 7. Remarks : ! ! - MAPSTA is dumped as it contains information on inactive points. ! Note that the original MAPSTA is dumped in the model def. file ! for use in the initial conditions (and output) programs. ! - Note that MAPSTA and MAPST2 data is combinded in the file. ! - The depth is recalculated in a write to avoid floating point ! errors in W3STRT. ! - Fields and field info read by all, written by las processor ! only. ! - The MPP version of the model will perform a gather here to ! maximize hiding of communication with IO. ! ! 8. Structure : ! ! +---------------------------------------------------------------+ ! | initialisations | ! | test INXOUT | ! | open file | ! +---------------------------------------------------------------| ! | WRITE ? | ! | Y N | ! |-------------------------------|-------------------------------| ! | Write identifiers and | Write identifiers and | ! | dimensions. | dimensions. | ! | | Check ident. and dimensions. | ! +-------------------------------+-------------------------------| ! | Full restart ? | ! | Y N | ! |-------------------------------|-------------------------------| ! | read/write/test time | | ! +-------------------------------+-------------------------------| ! | WRITE ? | ! | Y N | ! |-------------------------------|-------------------------------| ! | TYPE = 'WIND' ? | TYPE = 'WIND' ? | ! | Y N | Y N | ! |---------------|---------------|---------------|---------------| ! | close file | write spectra | gen. fetch-l. | read spectra | ! | RETURN | | spectra. | | ! |---------------+---------------+---------------+---------------| ! | WRITE ? | ! | Y N | ! |-------------------------------|-------------------------------| ! | TYPE = 'FULL' ? | TYPE = 'FULL' ? | ! | Y N | Y N | ! |---------------|---------------|---------------|---------------| ! | write level & | ( prep. level | read level & | initalize l.& | ! | (ice) map & | for test | (ice) map.& | times | ! | times | output ) | times | ( no ice ) | ! +---------------+---------------+---------------+-------------- + ! ! 9. Switches : ! ! !/SEED Linear input / seeding option. ! !/LNx ! ! !/SHRD Switch for shared / distributed memory architecture. ! !/DIST Id. ! !/MPI Id. ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: W3SETG, W3SETREF USE W3ODATMD, ONLY: W3SETO !/ USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, NSPEC, MAPSTA, MAPST2, & GNAME, FILEXT, GTYPE, UNGTYPE USE W3TRIAMD, ONLY: SETUGIOBP USE W3WDATMD USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPROC, NAPERR, NAPRST, & IFILE => IFILE4, FNMPRE, NTPROC, IOSTYP !/MPI USE W3ODATMD, ONLY: NRQRS, NBLKRS, RSBLKS, IRQRS, IRQRSS, VAAUX !/MPI USE W3ADATMD, ONLY: MPI_COMM_WCMP !/ USE W3SERVMD, ONLY: EXTCDE USE CONSTANTS, only: LPDLIB USE W3PARALL, ONLY: INIT_GET_ISEA, INIT_GET_JSEA_ISPROC USE W3GDATMD, ONLY: NK, NTH !/TIMINGS USE W3PARALL, ONLY: PRINT_MY_TIME !!!!!/PDLIB USE PDLIB_FIELD_VEC!, only : UNST_PDLIB_READ_FROM_FILE, UNST_PDLIB_WRITE_TO_FILE !/PDLIB USE PDLIB_FIELD_VEC !/S USE W3SERVMD, ONLY: STRACE ! IMPLICIT NONE ! !/MPI INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER :: NDSR ! INTEGER, INTENT(IN) :: NDSR INTEGER, INTENT(IN), OPTIONAL :: IMOD INTEGER, INTENT(OUT) :: INTYPE REAL, INTENT(INOUT) :: DUMFPI CHARACTER, INTENT(IN) :: INXOUT*(*) !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER, PARAMETER :: LRB = 4 ! INTEGER :: IGRD, I, J, LRECL, NSIZE, IERR, & NSEAT, MSPEC, TTIME(2), ISEA, JSEA, & NREC, NPART, IPART, IX, IY, IXL, IP, & NPRTX2 INTEGER, ALLOCATABLE :: MAPTMP(:,:) !/S INTEGER, SAVE :: IENT = 0 !/MPI INTEGER :: IERR_MPI, IH, IB, ISEA0, ISEAN, & !/MPI NRQ, NSEAL_MIN INTEGER(KIND=8) :: RPOS !/MPI INTEGER, ALLOCATABLE :: STAT1(:,:), STAT2(:,:) !/MPI REAL, ALLOCATABLE :: VGBUFF(:), VLBUFF(:) REAL(KIND=LRB), ALLOCATABLE :: WRITEBUFF(:) LOGICAL :: WRITE, IOSFLG CHARACTER(LEN=4) :: TYPE CHARACTER(LEN=10) :: VERTST CHARACTER(LEN=21) :: FNAME CHARACTER(LEN=26) :: IDTST CHARACTER(LEN=30) :: TNAME !/ !/ ------------------------------------------------------------------- / !/ !/S CALL STRACE (IENT, 'W3IORS') ! ! ! Constant NDSR for using mpiifort in ZEUS ... paralell runs crashing ! because compiler doesn't accept reciclyng of UNIT for FORMATTED or ! UNFORMATTED files in OPEN ! ! NDSR = 525 !/DEBUGIO WRITE(740+IAPROC,*) 'Beginning of W3IORS subroutine' !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 1' !/DEBUGIO FLUSH(740+IAPROC) IOSFLG = IOSTYP .GT. 0 ! ! test parameter list input ------------------------------------------ * ! IF ( PRESENT(IMOD) ) THEN IGRD = IMOD ELSE IGRD = 1 END IF ! CALL W3SETO ( IGRD, NDSE, NDST ) CALL W3SETG ( IGRD, NDSE, NDST ) CALL W3SETW ( IGRD, NDSE, NDST ) ! IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'HOT' .AND. & INXOUT.NE.'COLD' .AND. INXOUT.NE.'WIND' .AND. & INXOUT.NE.'CALM' ) THEN IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,900) INXOUT CALL EXTCDE ( 1 ) END IF ! WRITE = INXOUT .NE. 'READ' IF ( INXOUT .EQ. 'HOT' ) THEN TYPE = 'FULL' ELSE TYPE = INXOUT END IF ! !/T WRITE (NDST,9000) INXOUT, WRITE, NTPROC, NAPROC, IAPROC, NAPRST ! ! initializations ---------------------------------------------------- * ! !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 2' !/DEBUGIO FLUSH(740+IAPROC) IF ( .NOT.DINIT ) THEN IF ( IAPROC .LE. NAPROC ) THEN CALL W3DIMW ( IMOD, NDSE, NDST ) ELSE CALL W3DIMW ( IMOD, NDSE, NDST, .FALSE. ) END IF END IF !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 3' !/DEBUGIO FLUSH(740+IAPROC) ! IF ( IAPROC .LE. NAPROC ) VA(:,0) = 0. ! LRECL = MAX ( LRB*NSPEC , & LRB*(6+(25/LRB)+(9/LRB)+(29/LRB)+(3/LRB)) ) NSIZE = LRECL / LRB !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, LRECL=', LRECL, ' NSIZE=', NSIZE !/DEBUGIO FLUSH(740+IAPROC) ! --- Allocate buffer array with zeros (used to ! fill bytes up to size LRECL). --- ALLOCATE(WRITEBUFF(NSIZE)) WRITEBUFF(:) = 0. ! ! open file ---------------------------------------------------------- * ! I = LEN_TRIM(FILEXT) J = LEN_TRIM(FNMPRE) ! IF ( IFILE.EQ.0 ) THEN FNAME = 'restart.'//FILEXT(:I) ELSE FNAME = 'restartNNN.'//FILEXT(:I) IF ( WRITE .AND. IAPROC.EQ.NAPRST ) & WRITE (FNAME(8:10),'(I3.3)') IFILE END IF IFILE = IFILE + 1 ! !/T WRITE (NDST,9001) FNAME, LRECL ! IF(NDST.EQ.NDSR)THEN IF ( IAPROC .EQ. NAPERR ) & WRITE(NDSE,'(A,I8)')'UNIT NUMBERS OF RESTART FILE AND '& //'TEST OUTPUT ARE THE SAME : ',NDST CALL EXTCDE ( 15 ) ENDIF !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 4' !/DEBUGIO FLUSH(740+IAPROC) IF ( WRITE ) THEN IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) & OPEN (NDSR,FILE=FNMPRE(:J)//FNAME,FORM='UNFORMATTED', & ACCESS='STREAM',ERR=800,IOSTAT=IERR) ELSE OPEN (NDSR,FILE=FNMPRE(:J)//FNAME,FORM='UNFORMATTED', & ACCESS='STREAM',ERR=800,IOSTAT=IERR, & STATUS='OLD',ACTION='READ') END IF ! ! test info ---------------------------------------------------------- * ! IF ( WRITE ) THEN ! IF ( IAPROC .EQ. NAPRST ) THEN ! Because data has mixed data types we do not know how many ! bytes remain to fill up to LRECL. --- ! --- Make the entire record zero --- WRITEBUFF(:) = 0. WRITE (NDSR,POS=1) WRITEBUFF ! --- Replace zeros with data --- WRITE (NDSR,POS=1) IDSTR, VERINI, GNAME, TYPE, NSEA, NSPEC END IF INTYPE = 3 ! ELSE READ (NDSR,POS=1,ERR=802,IOSTAT=IERR) & IDTST, VERTST, TNAME, TYPE, NSEAT, MSPEC ! IF ( IDTST .NE. IDSTR ) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,901) IDTST, IDSTR CALL EXTCDE ( 10 ) END IF IF ( VERTST .NE. VERINI ) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,902) VERTST, VERINI CALL EXTCDE ( 11 ) END IF IF ( TNAME .NE. GNAME ) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,903) TNAME, GNAME END IF IF (TYPE.NE.'FULL' .AND. TYPE.NE.'COLD' .AND. & TYPE.NE.'WIND' .AND. TYPE.NE.'CALM' ) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,904) TYPE CALL EXTCDE ( 12 ) END IF IF (NSEAT.NE.NSEA .OR. NSPEC.NE.MSPEC) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,905) MSPEC, NSEAT, NSPEC, NSEA CALL EXTCDE ( 13 ) END IF IF (TYPE.EQ.'FULL') THEN INTYPE = 2 ELSE IF (TYPE.EQ.'WIND') THEN INTYPE = 1 ELSE IF (TYPE.EQ.'CALM') THEN INTYPE = 4 ELSE INTYPE = 0 END IF ! END IF ! 100 CONTINUE ! !/T WRITE (NDST,9002) IDSTR, VERINI, GNAME, TYPE, & !/T NSEA, NSEAL, NSPEC ! ! TIME if required --------------------------------------------------- * ! !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 5' !/DEBUGIO FLUSH(740+IAPROC) IF (TYPE.EQ.'FULL') THEN RPOS = 1_8 + LRECL*(2-1_8) IF ( WRITE ) THEN IF ( IAPROC .EQ. NAPRST ) THEN WRITEBUFF(:) = 0. WRITE (NDSR,POS=RPOS) WRITEBUFF WRITE (NDSR,POS=RPOS) TIME END IF ELSE READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) TTIME IF (TIME(1).NE.TTIME(1) .OR. TIME(2).NE.TTIME(2)) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,906) TTIME, TIME CALL EXTCDE ( 20 ) END IF END IF ! !/T WRITE (NDST,9003) TIME !/T ELSE !/T WRITE (NDST,9004) ! END IF ! ! Spectra ------------------------------------------------------------ * ! ( Bail out if write for TYPE.EQ.'WIND' ) ! !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 6' !/DEBUGIO FLUSH(740+IAPROC) IF ( WRITE ) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, Matching WRITE statement' !/DEBUGIO FLUSH(740+IAPROC) !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, TYPE=', TYPE, ' IOSFLG=', IOSFLG !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, NAPROC=', NAPROC, ' NAPRST=', NAPRST !/DEBUGIO FLUSH(740+IAPROC) IF ( TYPE.EQ.'WIND' .OR. TYPE.EQ.'CALM' ) THEN IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) THEN CLOSE ( NDSR ) END IF !/T WRITE (NDST,9005) TYPE RETURN ELSE IF ( IAPROC.LE.NAPROC .OR. IAPROC.EQ. NAPRST ) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, Need to match 1' !/DEBUGIO FLUSH(740+IAPROC) ! ! Original non-server version writing of spectra ! IF ( .NOT.IOSFLG .OR. (NAPROC.EQ.1.AND.NAPRST.EQ.1) ) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, Need to match 2' !/DEBUGIO FLUSH(740+IAPROC) DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) NREC = ISEA + 2 RPOS = 1_8 + LRECL*(NREC-1_8) WRITEBUFF(:) = 0. WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF END DO ! ! I/O server version writing of spectra ( !/MPI ) ! !/MPI ELSE ! !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, Before test for UNST_PDLIB_WRITE_TO_FILE' !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, GTPYPE=', GTYPE, ' UNGTYPE=', UNGTYPE !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, PDLIB=', LPDLIB !/DEBUGIO FLUSH(740+IAPROC) !/MPI IF (LPDLIB .and. (GTYPE.eq.UNGTYPE)) THEN !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, Directly before call for UNST_PDLIB_WRITE_TO_FILE, NDSR=', NDSR !/DEBUGIO FLUSH(740+IAPROC) !/TIMINGS CALL PRINT_MY_TIME("Before UNST_PDLIB_WRITE_TO_FILE") !/PDLIB CALL UNST_PDLIB_WRITE_TO_FILE(NDSR) !/TIMINGS CALL PRINT_MY_TIME("After UNST_PDLIB_WRITE_TO_FILE") !/MPI ELSE !/MPI IF ( IAPROC .NE. NAPRST ) THEN !/MPI NRQ = 1 !/MPI ELSE IF ( NAPRST .LE. NAPROC ) THEN !/MPI NRQ = NAPROC - 1 !/MPI ELSE !/MPI NRQ = NAPROC !/MPI END IF ! !/MPI ALLOCATE ( STAT1(MPI_STATUS_SIZE,NRQ) ) !/MPI IF ( IAPROC .EQ. NAPRST ) CALL MPI_STARTALL & !/MPI ( NRQ, IRQRSS, IERR_MPI ) ! !/MPI DO IB=1, NBLKRS !/MPI ISEA0 = 1 + (IB-1)*RSBLKS*NAPROC !/MPI ISEAN = MIN ( NSEA , IB*RSBLKS*NAPROC ) ! !/MPI IF ( IAPROC .EQ. NAPRST ) THEN ! !/MPI IH = 1 + NRQ * (IB-1) !/MPI CALL MPI_WAITALL & !/MPI ( NRQ, IRQRSS(IH), STAT1, IERR_MPI ) !/MPI IF ( IB .LT. NBLKRS ) THEN !/MPI IH = 1 + NRQ * IB !/MPI CALL MPI_STARTALL & !/MPI ( NRQ, IRQRSS(IH), IERR_MPI ) !/MPI END IF ! !/MPI DO ISEA=ISEA0, ISEAN !/MPI NREC = ISEA + 2 !/MPI CALL INIT_GET_JSEA_ISPROC(ISEA, JSEA, IP) !/MPI RPOS = 1_8 + LRECL*(NREC-1_8) !/MPI WRITEBUFF(:) = 0. !/MPI IF ( IP .EQ. NAPRST ) THEN !/MPI WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA) !/MPI ELSE !/MPI JSEA = JSEA - 2*((IB-1)/2)*RSBLKS !/MPI WRITEBUFF(1:NSPEC) = VAAUX(1:NSPEC,JSEA,IP) !/MPI END IF !/MPI WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & !/MPI WRITEBUFF !/MPI END DO ! !/MPI ELSE ! !/MPI CALL MPI_STARTALL & !/MPI ( 1, IRQRSS(IB), IERR_MPI ) !/MPI CALL MPI_WAITALL & !/MPI ( 1, IRQRSS(IB), STAT1, IERR_MPI ) ! !/MPI END IF !/MPI END DO ! !/MPI DEALLOCATE ( STAT1 ) !/MPI END IF ! END IF ! END IF ELSE !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 7' !/DEBUGIO FLUSH(740+IAPROC) ! ! Reading spectra ! IF ( TYPE.EQ.'WIND' .OR. TYPE.EQ.'CALM' ) THEN !/T WRITE (NDST,9020) TYPE ELSE IF (LPDLIB .and. (GTYPE.eq.UNGTYPE)) THEN !/PDLIB!/DEBUGINIT WRITE(740+IAPROC,*) 'Before call to UNST_PDLIB_READ_FROM_FILE' !/PDLIB!/DEBUGINIT FLUSH(740+IAPROC) !/TIMINGS CALL PRINT_MY_TIME("Before UNST_PDLIB_READ_FROM_FILE") !/PDLIB CALL UNST_PDLIB_READ_FROM_FILE(NDSR) !/TIMINGS CALL PRINT_MY_TIME("After UNST_PDLIB_READ_FROM_FILE") !/PDLIB!/DEBUGINIT WRITE(740+IAPROC,*) ' After call to UNST_PDLIB_READ_FROM_FILE' !/PDLIB!/DEBUGINIT WRITE(740+IAPROC,*) ' min/max(VA)=', minval(VA), maxval(VA) !/PDLIB!/DEBUGINIT DO JSEA=1,NSEAL !/PDLIB!/DEBUGINIT WRITE(740+IAPROC,*) ' JSEA=', JSEA, ' sum(VA)=', sum(VA(:,JSEA)) !/PDLIB!/DEBUGINIT END DO !/PDLIB!/DEBUGINIT FLUSH(740+IAPROC) ELSE !/MPI NSEAL_MIN = 1 + (NSEA-NAPROC)/NAPROC !/MPI IF ( NAPROC.GT.1 ) THEN !/MPI!/ ----------- Large number of small-sized record reads will tend ---- * !/MPI!/ to perform badly on most file systems. We read this part !/MPI!/ using streams and scatter the results using MPI. !/MPI!/ ( M. WARD, NCI ) !/MPI! !/MPI! Begin computational proc. only section ---------------- * !/MPI IF ( IAPROC.LE.NAPROC ) THEN !/MPI! !/MPI! Main loop --------------------------------------------- * !/MPI ALLOCATE( VGBUFF( NSIZE * NAPROC ) ) !/MPI ALLOCATE( VLBUFF( NSIZE ) ) !/MPI! !/MPI DO JSEA = 1, NSEAL_MIN !/MPI! Read NAPROC records into buffer VGBUFF. ------------- * !/MPI IF ( IAPROC .EQ. NAPROC ) THEN !/MPI RPOS = 1_8 + (2 + (JSEA - 1_8) * NAPROC) * LRECL !/MPI READ(NDSR, POS=RPOS,ERR=802,IOSTAT=IERR) VGBUFF(:) !/MPI ELSE !/MPI VGBUFF(:) = 0. !/MPI END IF !/MPI! Distribute one record to each rank. !/MPI CALL MPI_SCATTER(VGBUFF, NSIZE, MPI_REAL, & !/MPI VLBUFF, NSIZE, MPI_REAL, & !/MPI NAPROC-1, MPI_COMM_WCMP, IERR ) !/MPI! Transfer the spectral content of VLBUFF to VA. ------ * !/MPI VA(1:NSPEC,JSEA) = VLBUFF(1:NSPEC) !/MPI END DO !/MPI! !/MPI! Include remainder values (switch to record format) ---- * !/MPI JSEA = NSEAL_MIN + 1 !/MPI IF ( JSEA.EQ.NSEAL ) THEN !/MPI ISEA = IAPROC + (JSEA - 1) * NAPROC !/MPI NREC = ISEA + 2 !/MPI RPOS = 1_8 + LRECL*(NREC-1_8) !/MPI READ (NDSR, POS=RPOS, ERR=802, IOSTAT=IERR) & !/MPI (VA(I,JSEA), I=1,NSPEC) !/MPI END IF !/MPI! !/MPI DEALLOCATE( VGBUFF ) !/MPI DEALLOCATE( VLBUFF ) !/MPI! !/MPI! End computational proc. only section ------------------ * !/MPI END IF !/MPI! !/MPI ELSE VA = 0. DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) NREC = ISEA + 2 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & (VA(I,JSEA),I=1,NSPEC) ENDDO !/MPI END IF END IF END IF END IF !AR: Must be checked better ... will do that when cleaning debugging switches! VA = MAX(0.,VA) ! !/T WRITE (NDST,9006) ! ! Water level etc. if required --------------------------------------- * ! ( For cold start write test output and cold start initialize ! water levels. Note that MAPSTA overwrites the one read from the ! model definition file, so that it need not be initialized. ) ! NREC = NSEA + 3 NPART = 1 + (NSEA-1)/NSIZE NPRTX2 = 1 + (NX-1)/NSIZE ! !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 8' !/DEBUGIO FLUSH(740+IAPROC) IF ( WRITE ) THEN ! IF (TYPE.EQ.'FULL') THEN ! IF ( IAPROC .EQ. NAPRST ) THEN ! !/MPI ALLOCATE ( STAT2(MPI_STATUS_SIZE,NRQRS) ) !/MPI CALL MPI_WAITALL & !/MPI ( NRQRS, IRQRS , STAT2, IERR_MPI ) !/MPI DEALLOCATE ( STAT2 ) ! RPOS = 1_8 + LRECL*(NREC-1_8) WRITEBUFF(:) = 0. WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) TLEV, TICE DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & (WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & (ICE(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO ALLOCATE ( MAPTMP(NY,NX) ) MAPTMP = MAPSTA + 8*MAPST2 DO IY=1, NY DO IPART=1,NPRTX2 NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & (MAPTMP(IY,IXL),IXL=1+(IPART-1)*NSIZE, & MIN(NX,IPART*NSIZE)) END DO END DO DEALLOCATE ( MAPTMP ) DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & (UST(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & (USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & (ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & (FPIS(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO !/T WRITE (NDST,9007) !/T ELSE !/T DO ISEA=1, NSEA !/T WLV(ISEA) = 0. !/T ICE(ISEA) = 0. !/T END DO !/T WRITE (NDST,9008) END IF END IF ELSE IF (TYPE.EQ.'FULL') THEN RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) TLEV, TICE !/DEBUGINIT WRITE(740+IAPROC,*) 'Before reading WLV' DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & (WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO !/DEBUGINIT WRITE(740+IAPROC,*) 'Before reading ICE' DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & (ICE(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO ALLOCATE ( MAPTMP(NY,NX) ) !/DEBUGINIT WRITE(740+IAPROC,*) 'Before reading MAPTMP' DO IY=1, NY DO IPART=1,NPRTX2 NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & (MAPTMP(IY,IXL),IXL=1+(IPART-1)*NSIZE, & MIN(NX,IPART*NSIZE)) END DO END DO MAPSTA = MOD(MAPTMP+2,8) - 2 MAPST2 = (MAPTMP-MAPSTA) / 8 DEALLOCATE ( MAPTMP ) ! ! Updates reflections maps: ! IF (GTYPE.EQ.UNGTYPE) THEN CALL SETUGIOBP !/REF1 ELSE !/REF1 CALL W3SETREF ENDIF ! !/DEBUGINIT WRITE(740+IAPROC,*) 'Before reading UST' DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & (UST(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO !/DEBUGINIT WRITE(740+IAPROC,*) 'Before reading USTDIR' DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & (USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO !/DEBUGINIT WRITE(740+IAPROC,*) 'Before reading ASF' DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & (ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO !/DEBUGINIT WRITE(740+IAPROC,*) 'Before reading FPIS' DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & (FPIS(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO !/T WRITE (NDST,9007) ELSE TLEV(1) = -1 TLEV(2) = 0 TICE(1) = -1 TICE(2) = 0 TIC1(1) = -1 TIC1(2) = 0 TIC5(1) = -1 TIC5(2) = 0 WLV = 0. ICE = 0. ASF = 1. FPIS = DUMFPI !/T WRITE (NDST,9008) END IF END IF ! ! Close file --------------------------------------------------------- * ! IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) THEN CLOSE ( NDSR ) END IF ! !/DEBUGIO WRITE(740+IAPROC,*) 'W3IORS, step 9' !/DEBUGIO FLUSH(740+IAPROC) ! IF (ALLOCATED(WRITEBUFF)) DEALLOCATE(WRITEBUFF) ! RETURN ! ! Escape locations read errors : ! 800 CONTINUE !/LN0 TYPE = 'WIND' !/LN0 INTYPE = 1 !/SEED TYPE = 'CALM' !/SEED INTYPE = 4 !/LN1 TYPE = 'CALM' !/LN1 INTYPE = 4 !/LNX TYPE = 'CALM' !/LNX INTYPE = 4 IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,990) TYPE, IERR GOTO 100 ! 801 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,991) CALL EXTCDE ( 30 ) ! 802 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,992) IERR CALL EXTCDE ( 31 ) ! 803 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,993) IERR, RPOS CALL EXTCDE ( 31 ) ! ! ! Formats ! 900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/ & ' ILLEGAL INXOUT VALUE: ',A/) 901 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/ & ' ILLEGAL IDSTR, READ : ',A/ & ' CHECK : ',A/) 902 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/ & ' ILLEGAL VERINI, READ : ',A/ & ' CHECK : ',A/) 903 FORMAT (/' *** WAVEWATCH III WARNING IN W3IORS :'/ & ' ILLEGAL GNAME, READ : ',A/ & ' CHECK : ',A/) 904 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/ & ' ILLEGAL TYPE : ',A/) 905 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/ & ' CONFLICTING NSPEC, NSEA GRID : ',2I8/ & ' EXPECTED : ',2I8/) 906 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/ & ' CONFLICTING TIMES: FILE : ',I10.8,I8.6/ & ' MODEL : ',I10.8,I8.6/) ! 990 FORMAT (/' *** WAVEWATCH III WARNING IN W3IORS : '/ & ' NO READABLE RESTART FILE, ', & 'INITIALIZE WITH ''',A,''' INSTEAD'/ & ' IOSTAT =',I5/) 991 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/ & ' PREMATURE END OF FILE'/) 992 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/ & ' ERROR IN READING FROM FILE'/ & ' IOSTAT =',I5/) 993 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/ & ' ERROR IN WRITING TO FILE'/ & ' IOSTAT =',I5,', POS =',I11 /) ! ! !/T 9000 FORMAT (' TEST W3IORS : TEST PARAMETERS :'/ & !/T ' INXOUT : ',A,/ & !/T ' WRITE : ',L10/ & !/T ' NTPROC : ',I10/ & !/T ' NAPROC : ',I10/ & !/T ' IAPROC : ',I10/ & !/T ' NAPRST : ',I10) !/T 9001 FORMAT (' FNAME : ',A/ & !/T ' LRECL : ',I10) !/T 9002 FORMAT (' IDSTR : ',A/ & !/T ' VERINI : ',A/ & !/T ' GNAME : ',A/ & !/T ' TYPE : ',A/ & !/T ' NSEA : ',I10/ & !/T ' NSEAL : ',I10/ & !/T ' NSPEC : ',I10) !/T 9003 FORMAT (' TEST W3IORS :',I10.8,I8.6,' UTC') !/T 9004 FORMAT (' TEST W3IORS : TIME NOT AVAILABLE ') !/T 9005 FORMAT (' TEST W3IORS : NO SPECTRA, TYPE=''',A,''' ') !/T 9006 FORMAT (' TEST W3IORS : SPECTRA PROCESSED ') !/T 9007 FORMAT (' TEST W3IORS : WATER LEVELS ETC. PROCESSED ') !/T 9008 FORMAT (' TEST W3IORS : WATER LEVELS ETC. PROCESSED (DUMMY)') ! !/T 9020 FORMAT (' TEST W3IORS : INTYPE = ',A,', PERFORMED BY W3INIT') !/ !/ End of W3IORS ----------------------------------------------------- / !/ END SUBROUTINE W3IORS !/ !/ End of module W3IORSMD -------------------------------------------- / !/ END MODULE W3IORSMD