c$Header: /weru/cvs/weps/weps.src/manage/old.src/dooper.for.keep,v 1.1.1.1 1999-03-12 17:05:28 wagner Exp $ c c subroutine dooper i (sr) c c + + + PURPOSE + + + c Dooper is called when an operation line is found by the prfind c subroutine. Dooper reads in any coefficients associated with the c operation. Dooper then makes a call to a subroutine which, in turn, c modifies the state variables to mimic the effects of doing the c operation. c c + + + KEYWORDS + + + c tillage, operation, management c c + + + PARAMETERS AND COMMON BLOCKS + + + *$noereference include 'p1werm.inc' include 'm1flag.inc' include 's1layr.inc' include 'c1db1.inc' include 'd1glob.inc' include 'd1mass.inc' include 'manage/man.inc' include 'manage/oper.inc' *$reference c c + + + ARGUMENT DECLARATIONS + + + integer sr c c + + + ARGUMENT DEFINITIONS + + + c sr - the subregion number c c + + + LOCAL VARIABLES + + + integer rtn c c rtn - assigned to the return value from the getr function c c + + + SUBROUTINES CALLED + + + c prfind - PRocess FIND is called after all operation info is gathered c c + + + FUNCTION DECLARATONS + + + integer tillay, getr c c + + + DATA INITIALIZATIONS + + + c c + + + END SPECIFICATIONS + + + c mpos should always be pointing to the 2nd char of mline here rtn = getr(opcode,opcode,opcode,1,'i') rtn = getr(opname,opname,opname,1,'c') c print*, 'SR',sr,' Processing operation:', c & opcode,' ',opname c c fortran version of a case statement...blech! goto (01, 02, 03, 04, 05, 06, 07, 08, 09) , opcode c c default case print*, 'SR',sr,' Operation: ', opcode, ' code not found.' go to 1000 c c-----START tillage operation (operation code 01) 01 continue c get operation parameters rtn=getr(speed,speed,speed,1,'r') rtn=getr(depth,depth,depth,1,'r') rtn=getr(tdir,tdir,tdir,1,'c') c expected last parameter for operation, thus mlpos==0 if (getr(impl,impl,impl,1,'c').gt.0) then print*,'ERROR in dooper ',opcode stop endif c pre-operation stuff tlayer = tillay(depth, aszlyt(1,sr), nslay(sr)) c print*,opname, ' ',impl c print*,'speed, depth, dir, layers: ',speed,depth,' ',tdir,tlayer c do operation (usually just processes or other operations) call prfind(sr) c post-operation stuff go to 1000 c-----END tillage operation (operation code 01) c-----START cultivate operation (operation code 02) 02 continue c get operation parameters c expected last parameter for operation, thus mlpos==0 if (getr(pertil,pertil,pertil,1,'r').gt.0) then print*,'ERROR in dooper ',opcode stop endif c pre-operation stuff c print*,opname, ' Percent of surface tilled:',pertil c do operation (should include a tillage operation) call prfind(sr) c post-operation stuff go to 1000 c-----END cultivate operation (operation code 02) c-----START plant operation (operation code 03) 03 continue c get operation parameters c rtn=getr(cropno,cropno,cropno,1,'i') c expected last parameter for operation, thus mlpos==0 c if (getr(crnam,crnam,crnam,1,'c').gt.0) then c print*,'ERROR in dooper' c stop c endif c pre-operation stuff c get crop parameters - jt c call cinput c do operation (should include a tillage operation & plant process) call prfind(sr) c post-operation stuff go to 1000 c-----END plant operation (operation code 03) c-----START harvest operation (operation code 04) 04 continue c get operation parameters c rtn=getr(adzhht(1,sr),adzhht(1,sr),adzhht(1,sr),1,'r') c rtn=getr(addstm(1,sr),addstm(1,sr),addstm(1,sr),1,'r') c rtn=getr(admst(1,sr),admst(1,sr),admst(1,sr),1,'r') c rtn=getr(admf(1,sr),admf(1,sr),admf(1,sr),1,'r') c rtn=getr(admb(1,1,sr),admb(1,1,sr),admb(1,1,sr),nslay(sr),'r') c rtn=getr(admr(1,1,sr),admr(1,1,sr),admr(1,1,sr),nslay(sr),'r') c expected last parameter for operation, thus mlpos==0 c if (getr(admr(1,1,sr),admr(1,1,sr),admr(1,1,sr),nslay(sr),'r') c & .gt.0) then c print*,'ERROR in dooper ',opcode c stop c endif c pre-operation stuff c print*,opname, ' Harvesting height:',cutht c print*,opname, ' Harvesting height:',adzhht(1,sr) c call dechrv(sr) ! now called at killing c pre-operation stuff c do operation (could include a tillage operation) call prfind(sr) c post-operation stuff go to 1000 c-----END harvest operation (operation code 04) c-----START irrigate operation (operation code 05) 05 continue c get operation parameters c expected last parameter for operation, thus mlpos==0 c if (getr(nstack,nstack,nstack,4,'r').gt.0) then if (getr(nstack,nstack,nstack,1,'r').gt.0) then print*,'ERROR in dooper ',opcode stop endif c pre-operation stuff c print*, opname, ' Irrigation parameters: ',nstack c & nstack(1), nstack(2), nstack(3), nstack(4) c do operation call prfind(sr) c post-operation stuff go to 1000 c-----END irrigate operation (operation code 05) c-----START fertilize operation (operation code 06) 06 continue c get operation parameters c pre-operation stuff c do operation (probably includes a tillage operation) call prfind(sr) c post-operation stuff go to 1000 c-----END fertilize operation (operation code 06) c-----START burning operation (operation code 07) 07 continue c get operation parameters c pre-operation stuff c do operation call prfind(sr) c post-operation stuff go to 1000 c-----END burning operation (operation code 07) c-----START grazing operation (operation code 08) 08 continue c get operation parameters c pre-operation stuff c do operation call prfind(sr) c post-operation stuff go to 1000 c-----END grazing operation (operation code 08) c-----START xxx operation (operation code 09) c 09 print*, 'SR',sr,' Process:',prcode,' is ',prname c print*, 'Not implemented yet' c pre-operation stuff c do operation (usually just processes or other operations) 09 call prfind(sr) c post-operation stuff go to 1000 c-----END xxx operation (operation code 01) c 1000 return end