C C ADCIRC - SUBDOMAIN MODELING PREPROCESSING MODULE C C ======================================================================== C | | C | This file contains the subroutines required by Subdomain Modeling, | C | an approach to reduce the total runtime of a series of hurricane | C | storm surge simulations on a smaller grid, a subdomain grid, | C | extracted from the original grid. | C | | C | Written by Alper Altuntas, aaltunt@ncsu.edu | C | North Carolina State University, | C | 2013 | C | | C ======================================================================== module subprep use sizes, only : sz use global, only : DEBUG, ECHO, INFO, WARNING, ERROR, & openFileForRead, scratchMessage, logMessage, allMessage, & setMessageSource, unsetMessageSource C NCSU Subdomain Modeling variables: logical :: subdomainOn integer :: enforceBN integer :: psbtiminc, pncbn, pnobn, pnibn real(sz) :: pebn,pubn,pvbn integer,allocatable :: pcbn(:),pncbnp(:) integer,allocatable :: pobn(:),pnobnp(:) integer,allocatable :: pibn(:),pnibnp(:) integer :: pwdbn logical :: found_sm_nml contains SUBROUTINE readFort015prep() implicit none integer :: dummy integer :: ioerror ! zero if the fort.15 file was opened namelist /subdomainModeling/ subdomainOn FOUND_SM_NML = .false. call setMessageSource("readFort015prep") #if defined(SUBPREP_TRACE) || defined(ALL_TRACE) call allMessage(DEBUG,"Enter.") #endif ioerror = 0 ! ! Look for the subdomainModeling namelist in the fort.15 file ! and if it is found, read the value of subdomainOn. call openFileForRead(15,'fort.15',ioerror) if (ioerror.ne.0) then call allMessage(ERROR,'Failed to open fort.15 file.') stop endif ! ! jgf51.42: Add a namelist for the user to control subdomain ! modeling. READ(UNIT=15,NML=subdomainModeling,IOSTAT=ioerror) IF (ioerror.gt.0) THEN call logMessage(INFO, & 'The subdomainModeling namelist was not found.') else if(ioerror.eq.0) then FOUND_SM_NML = .true. endif if ((ioerror.gt.0).or.(subdomainOn.eqv..false.)) then call logMessage(INFO, & 'The subdomainModeling capability is not active.') endif write(scratchMessage,*) "subdomainOn=",subdomainOn call logMessage(ECHO,trim(scratchMessage)) close(15) if (subdomainOn) then call openFileForRead(1015,'fort.015',ioerror) if (ioerror.eq.0) then print *, "Subdomain Active" open(1015, file='fort.015') read(1015,*) dummy read(1015,*) dummy read(1015,*) enforceBN close(1015) else call allMessage(ERROR,'The fort.015 file was not found.') stop endif endif #if defined(SUBPREP_TRACE) || defined(ALL_TRACE) call allMessage(DEBUG,"Return.") #endif call unsetMessageSource() END SUBROUTINE readFort015prep SUBROUTINE openFort019prep() Use PRE_GLOBAL, only : nproc, itotproc, imap_nod_gl2 implicit none integer :: i,j,n,node,iproc integer :: gn,p,totalProc,itemp,procTemp open(1019, file='fort.019') read(1019,*) read(1019,*) psbtiminc, pncbn allocate( pcbn(pncbn) ) allocate( pncbnp(nproc) ) do i=1,pncbn read(1019,*) pcbn(i) enddo do i=1,nproc pncbnp(i) = 0 enddo do i=1,pncbn gn = pcbn(i) totalProc = itotproc(gn) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gn) pncbnp(procTemp) = pncbnp(procTemp) + 1 enddo enddo END SUBROUTINE openFort019prep SUBROUTINE subPrep019() Use PRE_GLOBAL, only : nproc, itotproc, imap_nod_gl2 implicit none integer :: iproc,i,n,tstep,gnode,lnode integer :: totalProc,p,itemp,proctemp,gn,lntemp integer sdu(nproc) logical success call openFort019prep() call subOpenPrep(19,'subdomain boundary conditions ', & 1,nproc, SDU, Success) do iproc=1,nproc write(sdu(iproc),*) 'subdomain boundary conditions ' write(sdu(iproc),*) psbtiminc,pncbnp(iproc) enddo do i=1,pncbn gnode = pcbn(i) totalProc = itotproc(gnode) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gnode) lnTemp = IMAP_NOD_GL2(itemp+1,gnode) write(sdu(procTemp),*) lnTemp enddo enddo 1000 CONTINUE read(1019,*,end=1905) tstep do iproc=1,nproc write(sdu(iproc),*) tstep enddo do i=1,pncbn read(1019,*) gnode,pebn,pubn read(1019,*) pvbn,pwdbn totalProc = itotproc(gnode) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gnode) lnTemp = IMAP_NOD_GL2(itemp+1,gnode) write(sdu(procTemp),*) lnTemp,pebn,pubn write(sdu(procTemp),*) pvbn,pwdbn enddo enddo go to 1000 1905 close(1019) do iproc=1,nproc close(sdu(iproc)) enddo END SUBROUTINE subPrep019 SUBROUTINE openFort020prep() Use PRE_GLOBAL, only : nproc, itotproc, imap_nod_gl2 implicit none integer :: i,j,n,node,iproc integer :: gn,p, totalProc, itemp,procTemp open(1020, file='fort.020') read(1020,*) read(1020,*) psbtiminc, pnobn allocate( pobn(pnobn) ) allocate( pnobnp(nproc) ) do i=1,pnobn read(1020,*) pobn(i) enddo do i=1,nproc pnobnp(i) = 0 enddo do i=1,pnobn gn = pobn(i) totalProc = itotproc(gn) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gn) !lnTemp = IMAP_NOD_GL2(itemp+1,gn) pnobnp(procTemp) = pnobnp(procTemp) + 1 enddo enddo do i=1,nproc print *, i, pnobnp(i) enddo END SUBROUTINE openFort020prep SUBROUTINE subPrep020() use pre_global, only : nproc, itotproc, imap_nod_gl2 implicit none integer :: iproc,i,n,tstep,gnode,lnode integer :: totalProc,p,itemp,proctemp,gn,lntemp integer sdu(nproc) logical success call openFort020prep() call subOpenPrep(20,'subdomain boundary conditions ', & 1,nproc, SDU, Success) do iproc=1,nproc write(sdu(iproc),*) 'subdomain boundary conditions ' write(sdu(iproc),*) psbtiminc,pnobnp(iproc) enddo do i=1,pnobn gnode = pobn(i) totalProc = itotproc(gnode) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gnode) lnTemp = IMAP_NOD_GL2(itemp+1,gnode) write(sdu(procTemp),*) lnTemp enddo enddo 1000 CONTINUE read(1020,*,end=1905) tstep do iproc=1,nproc write(sdu(iproc),*) tstep enddo ! do i=1,pnobn ! read(1020,*) gnode,pebn,pubn ! read(1020,*) pvbn,pwdbn ! iproc = IMAP_NOD_GL(1,gnode) ! lnode = IMAP_NOD_GL(2,gnode) ! write(sdu(iproc),*) lnode,pebn,pubn ! write(sdu(iproc),*) pvbn,pwdbn ! enddo do i=1,pnobn read(1020,*) gnode,pebn,pubn read(1020,*) pvbn,pwdbn totalProc = itotproc(gnode) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gnode) lnTemp = IMAP_NOD_GL2(itemp+1,gnode) write(sdu(procTemp),*) lnTemp,pebn,pubn write(sdu(procTemp),*) pvbn,pwdbn enddo enddo go to 1000 1905 close(1020) do iproc=1,nproc close(sdu(iproc)) enddo END SUBROUTINE subPrep020 SUBROUTINE openFort021prep() Use PRE_GLOBAL, only : nproc, itotproc, imap_nod_gl2 implicit none integer :: i,j,n,node,iproc integer :: gn,p, totalProc, itemp,procTemp open(1021, file='fort.021') read(1021,*) read(1021,*) psbtiminc, pnibn allocate( pibn(pnibn) ) allocate( pnibnp(nproc) ) do i=1,pnibn read(1021,*) pibn(i) enddo do i=1,nproc pnibnp(i) = 0 enddo do i=1,pnibn gn = pibn(i) totalProc = itotproc(gn) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gn) !lnTemp = IMAP_NOD_GL2(itemp+1,gn) pnibnp(procTemp) = pnibnp(procTemp) + 1 enddo enddo END SUBROUTINE openFort021prep SUBROUTINE subPrep021() use PRE_GLOBAL, only : nproc, itotproc, imap_nod_gl2 implicit none integer :: iproc,i,n,tstep,gnode,lnode integer :: totalProc,p,itemp,proctemp,gn,lntemp integer sdu(nproc) logical success call openFort021prep() call subOpenPrep(21,'subdomain boundary conditions ', & 1,nproc, SDU, Success) do iproc=1,nproc write(sdu(iproc),*) 'subdomain boundary conditions ' write(sdu(iproc),*) psbtiminc,pnibnp(iproc) enddo do i=1,pnibn gnode = pibn(i) totalProc = itotproc(gnode) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gnode) lnTemp = IMAP_NOD_GL2(itemp+1,gnode) write(sdu(procTemp),*) lnTemp enddo enddo 1000 CONTINUE read(1021,*,end=1905) tstep do iproc=1,nproc write(sdu(iproc),*) tstep enddo ! do i=1,pnibn ! read(1021,*) gnode,pebn ! iproc = IMAP_NOD_GL(1,gnode) ! lnode = IMAP_NOD_GL(2,gnode) ! write(sdu(iproc),*) lnode,pebn ! enddo do i=1,pnibn read(1021,*) gnode,pebn totalProc = itotproc(gnode) do p=1,totalProc itemp = (p-1)*2+1 procTemp = IMAP_NOD_GL2(itemp,gnode) lnTemp = IMAP_NOD_GL2(itemp+1,gnode) write(sdu(procTemp),*) lnTemp,pebn enddo enddo go to 1000 1905 close(1021) do iproc=1,nproc close(sdu(iproc)) enddo END SUBROUTINE subPrep021 C This subroutine is copied from prep.F (OpenPrepFiles) and is modified to C open subdomain modeling b.c. files SUBROUTINE subOpenPrep(UnitNumber, Description, & startProc, endProc, SDU, Success) C NCSU SUBDOMAIN: modified to handle "fort.019" C--------------------------------------------------------------------------- USE PRE_GLOBAL, only : nproc IMPLICIT NONE INTEGER :: UnitNumber ! i/o unit number to open CHARACTER(len=30), intent(in) :: Description ! description of file INTEGER, intent(in) :: startProc ! subdomains to start with INTEGER, intent(in) :: endProc ! subdomain to end on INTEGER, intent(out), dimension(nproc) :: SDU ! Subdomain unit numbers LOGICAL, intent(out):: Success ! .true. if files opened w/o errors LOGICAL Found !.true. if the full domain file exists CHARACTER(len=80) FileName ! name of full domain file CHARACTER(len=8) DefaultName! default name of full domain file !NCSU SUBDOMAIN INTEGER ErrorIO ! zero if file opened successfully INTEGER iproc ! subdomain index CHARACTER(len=15) sdFileName ! subdomain file name !NCSU SUBDOMAIN Found = .false. Success = .false. ErrorIO = 1 ! NCSU Subdomain: if (UnitNumber.eq.19) then DefaultName= 'fort.019' FileName = 'fort.019' UnitNumber = 1019 else if (UnitNumber.eq.20) then DefaultName= 'fort.020' FileName = 'fort.020' UnitNumber = 1020 else if (UnitNumber.eq.21) then DefaultName= 'fort.021' FileName = 'fort.021' UnitNumber = 1021 endif C C Determine if full domain file exists INQUIRE(FILE=FileName,EXIST=FOUND) C C If it does exist, open it IF ( FOUND ) THEN WRITE(*,1011) FileName !found OPEN(UNIT=UnitNumber, FILE=FileName, IOSTAT=ErrorIO) Success = .true. IF ( ErrorIO .GT. 0 ) THEN WRITE(*,*) "ERROR: Full domain file exists but" WRITE(*,*) "cannot be opened." Success = .false. ENDIF ENDIF C If (.not.Success) RETURN ! failed to open full domain file C DO iproc = startProc, endProc sdu(iproc) = 105 + (iproc-1) sdFileName(1:7) = 'PE0000/' sdFileName(8:15) = DefaultName !NCSU SUBDOMAIN #ifdef ADCSWAN sdFileName = 'PE0000/'//FileName #endif CALL IWRITE(sdFileName, 3, 6, iproc-1) OPEN (UNIT=SDU(iproc), FILE=sdFileName, IOSTAT=ErrorIO) Success = .true. IF ( ErrorIO .GT. 0 ) THEN WRITE(*,*) "ERROR: Subdomain file cannot be opened." Success = .false. RETURN ! failed to open at least one subdomain file ENDIF ENDDO 2 FORMAT(I2) 30 FORMAT(A30) 1010 FORMAT('File ',A8,/,' WAS NOT FOUND! Try again or type "skip"',/) 1011 FORMAT('File ',A8,/,' WAS FOUND! Opening & Processing file.',/) RETURN C--------------------------------------------------------------------------- END SUBROUTINE subOpenPrep C--------------------------------------------------------------------------- end module subprep