subroutine drivergen use modglobal, only : ib,ie,ih,jb,je,jh,kb,ke,kh,zf,zh,dzf,dzhi,timee,btime,totavtime,rk3step,& dt,numol,iplane,lles,idriver,inletav,runavtime,Uinf,lwallfunc,linletRA,& totinletav,lstoreplane,nstore,driverstore,prandtlmoli,numol,grav,lbuoyancy,& lfixinlet,lfixutauin,tdriverstart,dtdriver,tdriverdump,lchunkread,chunkread_size,ltempeq,lmoist,nsv,lhdriver,lqdriver,lsdriver,& ibrank,iplanerank,driverid,cdriverid,runtime,lwarmstart,cdriverjobnr use modfields, only : u0,v0,w0,e120,thl0,qt0,wm,uprof,vprof use modsave, only : writerestartfiles use modmpi, only : slabsum,myid implicit none real :: inlrec ! time of last inlet record real :: elapsrec ! time elapsed in this inlet record real :: dtint ! dt for linear interpolation real, PARAMETER :: eps = 1d-4 integer i,j,k,kk,kdamp,x,xc if (idriver == 1 .and. iplanerank) then ! if (.not. (rk3step==3)) return if (.not. (timee>=tdriverstart)) return if (.not. (timee>=tdriverdump)) return if (nstepreaddriver>=driverstore) return if (nstepreaddriver==0) then ! tdriverdump = timee tdriverdump = tdriverstart ! tdriverstart = timee !Update tdriverstart to the actual recorded value if ((driverid==0) .and. (rk3step==3)) then write(6,*) '==================================================================' write(6,*) '*** Starting to write data for driver simulation ***' write(6,*) 'Driver recording variables:' write(6,'(A,F15.5,A,I8,A,F12.9)') ' Starting time: ',tdriverdump,' Stored time steps: ',driverstore,' Inlet record intervals: ',dtdriver write(6,*) '==================================================================' end if end if if(rk3step==3) then nstepreaddriver = nstepreaddriver + 1 tdriverdump = tdriverdump + dtdriver ! storetinlet(nstepreaddriver) = timee - tdriverstart call writedriverfile end if elseif (idriver == 2) then ! this gets called in modboundary when ibrank=.true., so no need for switch if (timee>(runtime+btime)) return if(driverid==0) then if (.not.(lwarmstart)) then if (runtime>maxval(storetdriver)) then write(*,'(A,F15.5,A,F15.5,A)') "Simulation will stop before runtime = ",runtime,", since last & &read driver time (",maxval(storetdriver),") is less than runtime." end if else ! if lwarmstart if (runtime+btime>maxval(storetdriver)) then write(*,'(A,F15.5,A,F15.5,A)') "Simulation will stop before runtime+btime = ",runtime+btime,", since last & &read driver time (",maxval(storetdriver),") is less than runtime+btime." end if end if end if ! if (.not. rk3step==1) return if (timee>maxval(storetdriver)) then if(driverid==0) then write(0,'(A,F15.5,A,F15.5)') 'timee: ',timee,' Final inlet driver time:',maxval(storetdriver) write(0,'(A,I8,A,I8)') 'Inlet driver step: ',nstepreaddriver,' Total inlet driver steps:',driverstore end if stop 'Time in simulation has exceeded the inlet information - no more inlet data available!' end if if (.not.(lchunkread)) then x = minloc(abs(storetdriver-timee),1) elapsrec = storetdriver(x) - timee if(myid==0) then ! if(rk3step==1) then ! write(6,*) '============ Inlet interpolating =============' ! write(6,*) 'Inlet interpolation time = ', elapsrec ! write(6,'(A,F9.4)') 'Inlet driver time stamp (x) = ', storetdriver(x) ! write(6,'(A,F9.4)') 'Inlet driver time stamp (x+1) = ', storetdriver(x+1) ! write(6,'(A,F9.4)') 'Inlet driver time stamp (x-1) = ', storetdriver(x-1) ! write(6,'(A,E20.12)') 'Reading driver velocity: storeu0driver(je,ke,x) = ', storeu0driver(je,ke,x) ! write(6,*) 'Inlet step = ',nstepreaddriver ! end if end if if (abs(elapsrec) < eps) then if ((driverid==0) .and. ((rk3step==0) .or. (rk3step==3))) then write(*,'(A,I8,A,F15.5,A)') '======= Inputs loaded from driver tstep ',x,' (at ',storetdriver(x),'s) =======' end if u0driver(:,:) = storeu0driver(:,:,x) v0driver(:,:) = storev0driver(:,:,x) w0driver(:,:) = storew0driver(:,:,x) !e120driver(:,:) = storee120driver(:,:,x) if (ltempeq .and. lhdriver) then thl0driver(:,:) = storethl0driver(:,:,x) end if if (lmoist .and. lqdriver) then qt0driver(:,:) = storeqt0driver(:,:,x) end if if (nsv>0 .and. lsdriver) then sv0driver(:,:,:) = storesv0driver(:,:,:,x) end if nstepreaddriver = x elseif ((elapsrec > 0.) .and. (x == 1)) then if ((driverid==0) .and. ((rk3step==0) .or. (rk3step==3))) then write(*,'(A,F15.5,A)') '======= Inputs loaded from the proceeding driver tstep 1 (at ',storetdriver(x),'s) =======' end if u0driver(:,:) = storeu0driver(:,:,x) v0driver(:,:) = storev0driver(:,:,x) w0driver(:,:) = storew0driver(:,:,x) ! e120driver(:,:) = storee120driver(:,:,x) if (ltempeq .and. lhdriver) then thl0driver(:,:) = storethl0driver(:,:,x) end if if (lmoist .and. lqdriver) then qt0driver(:,:) = storeqt0driver(:,:,x) end if if (nsv>0 .and. lsdriver) then sv0driver(:,:,:) = storesv0driver(:,:,:,x) end if nstepreaddriver = x elseif (elapsrec < 0.) then if ((driverid==0) .and. ((rk3step==0) .or. (rk3step==3))) then write(*,'(A,I8,A,F15.5,A,I8,A,F15.5,A)') '======= Inputs interpolated from driver tsteps ',x,' (',storetdriver(x),' s) and ',x+1,' (',storetdriver(x+1),' s) =======' end if dtint = (timee-storetdriver(x))/(storetdriver(x+1)-storetdriver(x)) ! if(myid==0) then ! write(6,'(A,I4)') 'x: ', x ! write(6,'(A,F9.4)') 'dtint: ', dtint ! write(6,'(A,E20.12)') 'storeu0driver(1,32,x): ', storeu0driver(1,32,x) ! write(6,'(A,E20.12)') 'storeu0driver(1,32,x+1): ', storeu0driver(1,32,x+1) ! write(6,'(A,E20.12)') 'u0driver(1,32): ', storeu0driver(1,32,x) + (storeu0driver(1,32,x+1)-storeu0driver(1,32,x))*dtint ! end if u0driver(:,:) = storeu0driver(:,:,x) + (storeu0driver(:,:,x+1)-storeu0driver(:,:,x))*dtint v0driver(:,:) = storev0driver(:,:,x) + (storev0driver(:,:,x+1)-storev0driver(:,:,x))*dtint w0driver(:,:) = storew0driver(:,:,x) + (storew0driver(:,:,x+1)-storew0driver(:,:,x))*dtint ! e120driver(:,:) = storee120driver(:,:,x) + (storee120driver(:,:,x+1)-storee120driver(:,:,x))*dtint if (ltempeq .and. lhdriver) then thl0driver(:,:) = storethl0driver(:,:,x) + (storethl0driver(:,:,x+1)-storethl0driver(:,:,x))*dtint end if if (lmoist .and. lqdriver) then qt0driver(:,:) = storeqt0driver(:,:,x) + (storeqt0driver(:,:,x+1)-storeqt0driver(:,:,x))*dtint end if if (nsv>0 .and. lsdriver) then sv0driver(:,:,:) = storesv0driver(:,:,:,x) + (storesv0driver(:,:,:,x+1)-storesv0driver(:,:,:,x))*dtint end if nstepreaddriver = x elseif (elapsrec > 0.) then if ((driverid==0) .and. ((rk3step==0) .or. (rk3step==3))) then write(*,'(A,I8,A,F15.5,A,I8,A,F15.5,A)') '======= Inputs interpolated from driver tsteps ',x,' (', storetdriver(x),' s) and ',x-1,' (',storetdriver(x-1),' s) =======' end if dtint = (timee-storetdriver(x-1))/(storetdriver(x)-storetdriver(x-1)) u0driver(:,:) = storeu0driver(:,:,x-1) + (storeu0driver(:,:,x)-storeu0driver(:,:,x-1))*dtint v0driver(:,:) = storev0driver(:,:,x-1) + (storev0driver(:,:,x)-storev0driver(:,:,x-1))*dtint w0driver(:,:) = storew0driver(:,:,x-1) + (storew0driver(:,:,x)-storew0driver(:,:,x-1))*dtint ! e120driver(:,:) = storee120driver(:,:,x-1) + (storee120driver(:,:,x)-storee120driver(:,:,x-1))*dtint if (ltempeq .and. lhdriver) then thl0driver(:,:) = storethl0driver(:,:,x-1) + (storethl0driver(:,:,x)-storethl0driver(:,:,x-1))*dtint end if if (lmoist .and. lqdriver) then qt0driver(:,:) = storeqt0driver(:,:,x-1) + (storeqt0driver(:,:,x)-storeqt0driver(:,:,x-1))*dtint end if if (nsv>0 .and. lsdriver) then sv0driver(:,:,:) = storesv0driver(:,:,:,x-1) + (storesv0driver(:,:,:,x)-storesv0driver(:,:,:,x-1))*dtint end if nstepreaddriver = x end if else ! if (lchunkread) x = minloc(abs(storetdriver-timee),1) xc = mod(x,chunkread_size) if (xc==0) xc = x - (chunkreadctr-2)*chunkread_size elapsrec = storetdriver(x) - timee if(myid==0) then ! if(rk3step==1) then ! write(6,*) '============ Inlet interpolating =============' ! write(6,*) 'Inlet interpolation time = ', elapsrec ! write(6,'(A,F9.4)') 'Inlet driver time stamp (x) = ', storetdriver(x) ! write(6,'(A,F9.4)') 'Inlet driver time stamp (x+1) = ', storetdriver(x+1) ! write(6,'(A,F9.4)') 'Inlet driver time stamp (x-1) = ', storetdriver(x-1) ! write(6,'(A,E20.12)') 'Reading driver velocity: storeu0driver(je,ke,x) = ', storeu0driver(je,ke,x) ! write(6,*) 'Inlet step = ',nstepreaddriver ! end if end if if (abs(elapsrec) < eps) then if ((driverid==0) .and. ((rk3step==0) .or. (rk3step==3))) then write(*,'(A,I8,A,I8,A,F15.5,A)') '======= Inputs loaded from driver tstep ',x,'(',xc,') (at ',storetdriver(x),'s) =======' end if u0driver(:,:) = storeu0driver(:,:,xc) v0driver(:,:) = storev0driver(:,:,xc) w0driver(:,:) = storew0driver(:,:,xc) !e120driver(:,:) = storee120driver(:,:,xc) if (ltempeq .and. lhdriver) then thl0driver(:,:) = storethl0driver(:,:,xc) end if if (lmoist .and. lqdriver) then qt0driver(:,:) = storeqt0driver(:,:,xc) end if if (nsv>0 .and. lsdriver) then sv0driver(:,:,:) = storesv0driver(:,:,:,xc) end if elseif ((elapsrec > 0.) .and. (x == 1)) then if ((driverid==0) .and. ((rk3step==0) .or. (rk3step==3))) then write(*,'(A,F15.5,A,I8,A,I8)') '======= Inputs loaded from the proceeding driver tstep 1 (at ',storetdriver(x),'s) =======',x,' ',xc end if u0driver(:,:) = storeu0driver(:,:,xc) v0driver(:,:) = storev0driver(:,:,xc) w0driver(:,:) = storew0driver(:,:,xc) ! e120driver(:,:) = storee120driver(:,:,xc) if (ltempeq .and. lhdriver) then thl0driver(:,:) = storethl0driver(:,:,xc) end if if (lmoist .and. lqdriver) then qt0driver(:,:) = storeqt0driver(:,:,xc) end if if (nsv>0 .and. lsdriver) then sv0driver(:,:,:) = storesv0driver(:,:,:,xc) end if elseif (elapsrec < 0.) then if ((driverid==0) .and. ((rk3step==0) .or. (rk3step==3))) then write(*,'(A,I8,A,I8,A,F15.5,A,I8,A,I8,A,F15.5,A)') '======= Inputs interpolated from driver tsteps ',x,'(',xc,') (',storetdriver(x),' s) and ',x+1,'(',xc+1,') (',storetdriver(x+1),' s) =======' end if dtint = (timee-storetdriver(x))/(storetdriver(x+1)-storetdriver(x)) ! if(myid==0) then ! write(6,'(A,I4)') 'x: ', x ! write(6,'(A,F9.4)') 'dtint: ', dtint ! write(6,'(A,E20.12)') 'storeu0driver(1,32,x): ', storeu0driver(1,32,x) ! write(6,'(A,E20.12)') 'storeu0driver(1,32,x+1): ', storeu0driver(1,32,x+1) ! write(6,'(A,E20.12)') 'u0driver(1,32): ', storeu0driver(1,32,x) + (storeu0driver(1,32,x+1)-storeu0driver(1,32,x))*dtint ! end if u0driver(:,:) = storeu0driver(:,:,xc) + (storeu0driver(:,:,xc+1)-storeu0driver(:,:,xc))*dtint v0driver(:,:) = storev0driver(:,:,xc) + (storev0driver(:,:,xc+1)-storev0driver(:,:,xc))*dtint w0driver(:,:) = storew0driver(:,:,xc) + (storew0driver(:,:,xc+1)-storew0driver(:,:,xc))*dtint ! e120driver(:,:) = storee120driver(:,:,xc) + (storee120driver(:,:,xc+1)-storee120driver(:,:,xc))*dtint if (ltempeq .and. lhdriver) then thl0driver(:,:) = storethl0driver(:,:,xc) + (storethl0driver(:,:,xc+1)-storethl0driver(:,:,xc))*dtint end if if (lmoist .and. lqdriver) then qt0driver(:,:) = storeqt0driver(:,:,xc) + (storeqt0driver(:,:,xc+1)-storeqt0driver(:,:,xc))*dtint end if if (nsv>0 .and. lsdriver) then sv0driver(:,:,:) = storesv0driver(:,:,:,xc) + (storesv0driver(:,:,:,xc+1)-storesv0driver(:,:,:,xc))*dtint end if elseif (elapsrec > 0.) then if ((driverid==0) .and. ((rk3step==0) .or. (rk3step==3))) then write(*,'(A,I8,A,I8,A,F15.5,A,I8,A,I8,A,F15.5,A)') '======= Inputs interpolated from driver tsteps ',x,'(',xc,') (', storetdriver(x),' s) and ',x-1,'(',xc-1,') (',storetdriver(x-1),' s) =======' end if dtint = (timee-storetdriver(x-1))/(storetdriver(x)-storetdriver(x-1)) u0driver(:,:) = storeu0driver(:,:,xc-1) + (storeu0driver(:,:,xc)-storeu0driver(:,:,xc-1))*dtint v0driver(:,:) = storev0driver(:,:,xc-1) + (storev0driver(:,:,xc)-storev0driver(:,:,xc-1))*dtint w0driver(:,:) = storew0driver(:,:,xc-1) + (storew0driver(:,:,xc)-storew0driver(:,:,xc-1))*dtint ! e120driver(:,:) = storee120driver(:,:,xc-1) + (storee120driver(:,:,xc)-storee120driver(:,:,xc-1))*dtint if (ltempeq .and. lhdriver) then thl0driver(:,:) = storethl0driver(:,:,xc-1) + (storethl0driver(:,:,xc)-storethl0driver(:,:,xc-1))*dtint end if if (lmoist .and. lqdriver) then qt0driver(:,:) = storeqt0driver(:,:,xc-1) + (storeqt0driver(:,:,xc)-storeqt0driver(:,:,xc-1))*dtint end if if (nsv>0 .and. lsdriver) then sv0driver(:,:,:) = storesv0driver(:,:,:,xc-1) + (storesv0driver(:,:,:,xc)-storesv0driver(:,:,:,xc-1))*dtint end if end if nstepreaddriver = x !! Not sure.. may need modification end if ! rotate u0driverrot = u0driver*cos(iangle) - v0driver*sin(iangle) v0driverrot = v0driver*cos(iangle) + u0driver*sin(iangle) u0driver = u0driverrot v0driver = v0driverrot ! if(myid==0) then ! write(6,'(A,F9.4)') 'Simulation time: ', timee ! write(6,'(A,F9.4)') 'dtint: ', dtint ! write(6,*) 'Velocities interpolated:' ! write(6,'(A,e20.12)') 'storeu0driver(je,ke,x-1): ', storeu0driver(je,ke,x-1) ! write(6,'(A,e20.12)') 'storeu0driver(je,ke,x): ', storeu0driver(je,ke,x) ! write(6,'(A,e20.12)') 'storeu0driver(je,ke,x+1): ', storeu0driver(je,ke,x+1) ! write(6,'(A,e20.12)') 'Interpolated inlet velocity (jb,20): ', u0driver(jb,20) ! write(6,*) 'Temperatures interpolated:' ! write(6,'(A,e20.12)') 'storethl0driver(je,20,x-1): ', storethl0driver(jb,20,x-1) ! write(6,'(A,e20.12)') 'storethl0driver(je,20,x): ', storethl0driver(jb,20,x) ! write(6,'(A,e20.12)') 'storethl0driver(je,20,x+1): ', storethl0driver(jb,20,x+1) ! write(6,'(A,e20.12)') 'Interpolated inlet temperature (jb,20): ', thl0driver(jb,20) ! end if ! umdriver = u0driver ! MAYBE ITS BETTER TO WRITE THE M VARIABLES TO FILE TOO AND JUST READ THEM - THOUGH CURRENTLY THIS IS NOT DONE FOR RESTART FILES?? ae1212 ! vmdriver = v0driver ! EDIT READ AND WRITE INLET FILES (AND CHECK MODBOUNDARY & MODSURFACE) TO INCLUDE M VARIABLES ! wmdriver = w0driver ! thlmdriver = thl0driver ! qtmdriver = qt0driver if (rk3step==0 .or. rk3step==3) then umdriver = u0driver vmdriver = v0driver wmdriver = w0driver !e12mdriver = e120driver if (ltempeq .and. lhdriver) then thlmdriver = thl0driver end if if (lmoist .and. lqdriver) then qtmdriver = qt0driver end if if (nsv>0 .and. lsdriver) then svmdriver = sv0driver end if end if else return end if ! idrivergen end subroutine drivergen