cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c LCSE Tile Driver Code using Asyncrounous IO (using SHMOD api) c c Specific to a 2D tile decomposition. c c Routines task_manager and compute_manager (alonge with all of the c c routines they call) should work AS IS for real cluster computing, c c provided that the the approprieate SHMOD api library is linked in c c replacing the code in api.c c c c c In this implementation, the main routine and the code in api.c are c c specific to one CM running on one SMP box. c c c c Author dhp c c c c 21 March 2000 Original c c 2 April 2000 Asynchronous read and write using SHMOD api c c 9 April 2000 CM calls to TM implemented c c 10 April 2000 sppm version implemented for 1 compute thread c c 15 April 2000 Multiple (2) compute threads implemented c c 15 April 2000 task_complete handshaking implemented c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Out of Core Code c c include 'penparam.h' c include 'tilebuffers.h' c integer ierr, ispawn, ntilex, ntiley c external ispawn, compute_manager c c ierr = ispawn( compute_manager, 0 ) ! start CM thread c call task_manager(0) ! start TM thread c c stop c end subroutine compute_manager( my_number, in_ntilex, in_ntiley ) implicit none include 'thingftn.h' include 'penparam.h' include 'tilebuffers.h' integer in_ntilex, in_ntiley integer iwork, jtx, jty, my_number integer i, j, k, itask(10), itsk(10, 0:1), itimep integer ntilex, ntiley, itx, ity, ip, itime, numcd, ncdump(0:1) integer ipp, in, itxp, ityp, ibuf, ibufp, icount, ko integer nthreads, ierr, ntw, ierr parameter (ntw = 6) ! number of task words character*200 filename real dx, dy, dz external tile_update common /tilelayout/ ntilex, ntiley cc call start_THING(1) ! start MM & initialize shared vars. write (0,*) 'CM',my_number,' starting' ntilex= in_ntilex ntiley= in_ntiley ! INITIALIZE AND START HELPER THREADS killthreads = 0 ! exit flag for helper threads nthreads = 1 ! number of compute threads c call init_threads(nthreads) do i=2, nthreads call f_t_create( i, tile_update, ierr ) ! start helper threads enddo c write (6,*) 'CM: helper threads started' ! INITIALIZE IO BUFFERS AND STATUS ARRAYS do ibuf = 0, 1 dddstat(1,ibuf) = 0 do i = 1, 8 bufstat(1, i, ibuf) = 0 enddo enddo ! SET RUN PARAMETERS FOR THE PROBLEM call consts_init(dx, dy, dz) ! INITIALIZE POINTERS ko = 1-NBTL ibufp = -1 ibuf = 0 itsk(1,0) = -1 itsk(1,1) = -1 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c WORK LOOP c c----------------------------------------------------------------------c c iwork = 1 : create tile files c c iwork = 2 : initialize and cdump tile c c iwork = 3 : update tile (& cdump after update if numcd > 0) c c iwork = 4 : finish all outstanding work and report it c c if there is no outstanding work sleep for 10sec c c iwork = 5 : exit c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 10 continue i = getwork_thing( 0, itask, ntw*4 ) iwork = itask(1) ip = itask(2) itx = itask(3) ity = itask(4) numcd = itask(5) itime = itask(6) write (0,999) iwork, ip, itx, ity, numcd 999 format('iwork=',i2,' ip=',i2,' itxy=',i3,i3,' numcd=',i2) ! CREATE AND FILL (WITH 0s) LOCAL MM TILE FILES FOR BOTH PASSES ! FOR SIMPLICITY, I AM ENFORCING NO OVERLAP OF WORK AND IO ! TILE_CREATE WILL NOT RETURN UNTIL THE WRITES IT SPAWNS ARE DONE ! if(iwork .eq. 1) then call tile_create(itx, ity) ierr= workDone_THING( 0, itask(1), ntw*4 ) endif ! FILL (WITH REAL DATA) LOCAL INTERIOR TILE AND NEIBORING BOUNDARIES ! FOR SIMPLICITY, I AM ENFORCING NO OVERLAP OF WORK AND IO ! if(iwork .eq. 2) then write(0,*) 'tile__init' call tile__init(itx,ity,ibuf) write(0,*) 'tile_write' call tile_write(itx,ity,ip,ibuf) if(numcd .gt. -1) then write(0,*) 'tile_cdump' call tile_cdump(itx,ity,nzt,nyt,nxt,dz,dy,dx,nbtl, 1 ddd(1,1,ko,ko,ibuf),numcd) endif c? print *, 'waiting..' c? ierr= wait_THING(bufstat(1,8,ibuf),TILDONE_THING) ierr= workDone_THING( 0, itask(1), ntw*4 ) endif ! 1) SPAWN PRE-FETCH OF DATA ! 2) UPDATE TILE OF DATA FROM PREVIOUS PRE_FETCH ! 3) SPAWN WRITES OF UPDATED DATA ! if(iwork .eq. 3) then ! SPAWN PRE-FETCH OF DATA FOR NEXT TILE INTO *(IBUF) ! NOTE: reads will be spawned AFTER all writes of *(ibuf) are finished write(0,*) 'tile_read(itx,ity,,ibuf)..', itx,ity,ibuf call tile_read(itx,ity,ip,ibuf) if(itsk(1,ibuf) .ge. 0) then ierr= workDone_THING( 0, itsk(1,ibuf), ntw*4 ) itsk(1,ibuf) = -1 endif if(ibufp .ge. 0) then ! IF THERE WAS A PREVIOUS TILE, THEN UPDATE TILE ! NOTE: tile_fill will wait for all reads of *(ibufp) to finish write(0,*) 'tile_fill(itxp,ityp,,ibufp)', itxp,ityp,ibufp call tile_fill(itxp,ityp,ipp,ibufp) icbuf = ibufp write(0,*) 'tile_update..' call tile_update(0) write(0,*) 'tile_write..' call tile_write(itxp,ityp,ipp,ibufp) itsk(1,ibufp) = 3 itsk(2,ibufp) = ipp itsk(3,ibufp) = itxp itsk(4,ibufp) = ityp itsk(5,ibufp) = ncdump(ibufp) itsk(6,ibufp) = itimep if(ncdump(ibufp) .gt. 0) then ! WRITE OUT COMPRESSED DUMP FOR TILE call tile_cdump(itxp,ityp,nzt,nyt,nxt,dz,dy,dx,nbtl, 1 ddd(1,1,ko,ko,ibufp),ncdump(ibufp)) endif endif ncdump(ibuf) = numcd itxp = itx ityp = ity ipp = ip itimep = itime ibufp = ibuf ibuf = 1 - ibuf ! ddd & io buffers toggle between 0 and 1 endif ! FINISH ANY OUTSTANDING WORK ! MAKE SURE ALL FINISHED WORK IS REPORTED ! if(iwork .eq. 4) then if(ibufp .ge. 0) then c? ierr= wait_THING(bufstat(1,8,ibuf),TILDONE_THING) if(itsk(1,ibuf) .ge. 0) then ierr= workDone_THING( 0, itsk(1,ibuf), ntw*4 ) itsk(1,ibuf) = -1 endif call tile_fill(itxp,ityp,ipp,ibufp) icbuf = ibufp call tile_update(0) call tile_write(itxp,ityp,ipp,ibufp) itsk(1,ibufp) = 3 itsk(2,ibufp) = ipp itsk(3,ibufp) = itxp itsk(4,ibufp) = ityp itsk(5,ibufp) = ncdump(ibufp) itsk(6,ibufp) = itimep if(ncdump(ibufp) .gt. 0) then call tile_cdump(itxp,ityp,nzt,nyt,nxt,dz,dy,dx,nbtl, 1 ddd(1,1,ko,ko,ibufp),ncdump(ibufp)) endif c? ierr= wait_THING(bufstat(1,8,ibufp),TILDONE_THING) ierr= workDone_THING( 0, itsk(1,ibufp), ntw*4 ) itsk(1,ibufp) = -1 ibufp = -1 ! REINITIALIZE BUFFERS ibuf = 0 ! REINITIALIZE BUFFERS else call sleep (10) endif endif if(iwork .lt. 5) go to 10 ! IWORK=5 MEANS QUIT c ! CAUSE ALL HELPER THREADS TO EXIT AND SHUT DOWN ! killthreads = 1 call tile_update(0) ierr= workDone_THING( 0, itask(1), ntw*4 ) cc call stop_THING(1) ! shut down everything c return c stop end c c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c Task Manager stuff c c----------------------------------------------------------------------c c Generate complete sequence of work to do for 2 passes c c STRATEGY: in y-direction : do 1st, last, then fill in the middle c c LIMITATION: needs at least 4 tiles in y-direction for now waits c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc subroutine task_manager( my_number, in_ntilex, in_ntiley ) include 'thingftn.h' include 'statbuffers.h' integer ierr integer in_ntilex, in_ntiley integer itask(10), itsk(10), nbytes, itypework, my_number integer maxjobs, ntdump, ipass, ntw, isalldone, iplast parameter( maxjobs = 1000 ) parameter (ntw = 6) ! number of task words integer njobs, iitx(maxjobs), iity(maxjobs), iips(maxjobs) integer icount, ntxy, itx, ity, ntilex, ntiley, initdone integer MAXTX, MAXTY parameter (MAXTX = 100) parameter (MAXTY = 100) integer isdone(0:MAXTX, 0:MAXTY, 0:1) common /tmcommon/ icount, icreatedone, initdone, itime, ntime, 1 njobs, ntxy, iitx, iity, iips common /tilelayout/ ntilex, ntiley ! SET NUMBER OF TILES IN EACH DIRECTION ntilex = in_ntilex ntiley = in_ntiley ccc call start_THING(0) ! start MM & initialize shared vars. ! INITIALIZE ISDONE ARRAY ! ! isdone(itx,ity,ipass) State of MM file ! ! -2 Not created yet ! -1 Created but not filled w/ 0s ! 0 Containes initial values (time step 0) ! i > 0 Containes values at time step i ! do ipass = 0, 1 do itx = 0, ntilex-1 do ity = 0, ntiley-1 isdone(itx, ity, ipass) = -2 enddo enddo enddo ntime = 30 ! will do ntime itterations ntdump = 1 ! will dump every ntdump itterations icreatedone = 0 initdone = 0 isalldone = 0 itime = 0 ! initialize time counter icount = 0 ! initialize TM counter ntxy = 0 ity = 0 ! pass 0 : 1st y do itx = 0, ntilex-1 ntxy = ntxy + 1 iitx(ntxy) = itx iity(ntxy) = ity iips(ntxy) = 0 enddo ity = ntiley-1 ! pass 0 : last y do itx = 0, ntilex-1 ntxy = ntxy + 1 iitx(ntxy) = itx iity(ntxy) = ity iips(ntxy) = 0 enddo do ity = 1, ntiley-2 ! pass 0 : fill in the middle do itx = 0, ntilex-1 ntxy = ntxy + 1 iitx(ntxy) = itx iity(ntxy) = ity iips(ntxy) = 0 enddo enddo do i = 1, ntxy ! pass 1 : same seqence of tiles iitx(ntxy+i) = iitx(i) iity(ntxy+i) = iity(i) iips(ntxy+i) = 1 enddo njobs = 2 * ntxy cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c TM WORK ORDER c c----------------------------------------------------------------------c c 1) create MM tiles c c 2) initialize and write out tiles c c 3) update tiles c c 4) exit after specified number of itterations c c----------------------------------------------------------------------c c iwork = 1 : create tile files c c iwork = 2 : initialize and cdump tile c c iwork = 3 : update tile (& cdump after update if numcd > 0) c c iwork = 4 : exit c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 100 continue do i = 1,6 itsk(i) = -9 enddo icm = WaitForWorker_Thing( itsk, ntw*4, icomplete, TILDONE_THING ) if(icomplete .eq. -1) go to 110 ! time out (can't happen!) if(icomplete .eq. 1) go to 120 ! task completed if(icomplete .eq. 0) go to 130 ! task requested ! SOMETHING IS VERY WRONG HERE! ! write (0,*) 'SOMETHING IS VERY WRONG HERE!' write (0,*) 'icomplete = ', icomplete stop ! WAITFORWORKER_THING HAS TIMED OUT ! 110 continue write (6,*) 'WaitForWorker_Thing has timed out!' go to 100 ! TASK COMPLETED BY icm, UPDATE TABLE ACCORDINGLY ! 120 continue write (0,999) icm, (itsk(i), i=1,ntw) 999 format('TM: cm ',i3,' says: tsk ', 6i3, ' is done!') if(itsk(1) .lt. 5) then ipass = 1 - itsk(2) itx = itsk(3) ity = itsk(4) isdone(itx, ity, ipass) = itsk(6) endif write (0,*) 'pass itx | ity= 0 1 2 3' write (0,*) '----------|-------------------------------' do ipass = 0, 1 do itx = ntilex-1, 0, -1 write (0,990) ipass,itx,(isdone(itx,ity,ipass),ity=0,ntiley-1) 990 format(2i5, ' | ', 8i5) enddo enddo if(itsk(1) .eq. 5) go to 200 ! CM is finished go to 100 ! NEW TASK REQUESTED BY icm, DISH IT OUT ! 130 continue write (0,998) icm 998 format('CM = ', i3, ' says: Give me a new task!') is_ready = 1 if(initdone .gt. 0) then ! CHECK FOR DEPENDENCIES itx0 = iitx(icount+1) ity0 = iity(icount+1) ip0 = iips(icount+1) do i = -1, 1 do j = -1, 1 itx = mod(itx0+i+ntilex, ntilex) ity = mod(ity0+j+ntiley, ntiley) if(isdone(itx,ity,ip0) .ne. itime-1) is_ready = 0 enddo enddo endif if(is_ready .eq. 1) icount = icount + 1 if(is_ready .eq. 0) then ! FINISH UP & REPORT OR SLEEP FOR 10s itask(1) = 4 ! work : just finish up itask(2) = 0 ! pass : NA itask(3) = 0 ! itx : NA itask(4) = 0 ! ity : NA itask(5) = 0 ! no cdump : NA itask(6) = 0 ! resulting state : NA write (0,*) 'TM: initdone = ', initdone write (0,*) 'TM: itime,ip0 = ', itime,ip0 do i = -1, 1 do j = -1, 1 itx = mod(itx0+i+ntilex, ntilex) ity = mod(ity0+j+ntiley, ntiley) write (0,*) 'itx,ity,isdone=',itx,ity,isdone(itx,ity,ip0) enddo enddo else if(icreatedone .ne. 1) then ! create MM tiles for pass 0 & 1 itask(1) = 1 ! work itask(2) = 0 ! pass itask(3) = iitx(icount) itask(4) = iity(icount) itask(5) = -1 ! no cdump : NA itask(6) = -1 ! resulting state : NA if(icount .ge. ntxy) then icreatedone = 1 icount = 0 endif else if(initdone .ne. 1) then ! initialize & write tiles for pass 0 itask(1) = 2 ! work itask(2) = 1 ! pass 1 (writes to pass 0) itask(3) = iitx(icount) itask(4) = iity(icount) itask(5) = itime ! write cdump of initial state itask(6) = itime ! resulting state if(icount .ge. ntxy) then initdone = 1 icount = 0 ip = 0 itime = itime + 1 endif else if(itime .le. ntime) then ! update tiles to step itime itask(1) = 3 ! do tile update itask(2) = iips(icount) ! pass itask(3) = iitx(icount) itask(4) = iity(icount) if(mod(itime, ntdump) .eq. 0) then itask(5) = itime ! do cdump for step itime else itask(5) = -1 ! dont do cdump endif itask(6) = itime ! resulting state iplast = iips(icount) if(icount .eq. ntxy) itime = itime+1 if(icount .ge. njobs) then icount = 0 itime = itime + 1 endif else ! CHECK FOR BEING COMPLETELY DONE isalldone = 1 ip0 = 1 - iplast do itx = 0, ntilex-1 do ity = 0, ntiley-1 if(isdone(itx,ity,ip0) .ne. ntime) isalldone = 0 enddo enddo write (0,*) 'TM: ip0, isalldone = ', ip0, isalldone if(isalldone .eq. 0) then ! finish up tiles itask(1) = 4 ! work: finish any outstanding work itask(2) = 0 itask(3) = 0 itask(4) = 0 itask(5) = 0 itask(6) = itime isalldone = 1 else itask(1) = 5 ! work: shut down itask(2) = 0 itask(3) = 0 itask(4) = 0 itask(5) = 0 itask(6) = itime endif endif write(0,*) "assigning to cm", icm, ntw i = assignwork_thing( icm, itask, ntw*4 ) write (0,997) icm, (itask(i), i=1,ntw) 997 format('TM: cm ',i3,' assigned task ', 10i3) go to 100 c 200 continue ! WAIT FOR ALL IO BUFFERS TO BE CLEARED (FINAL WRITES) c? ierr= wait_THING(bufstat(1,8,0),TILDONE_THING) c? ierr= wait_THING(bufstat(1,8,1),TILDONE_THING) cc call stop_THING(0) ! shut down everything return end