LOGICAL FUNCTION OPM(ID1, ID2, W, IW) USE Numeric_Kinds_Module ! ! $RCSfile: opm.f,v $ $Revision: 1.3 $ ! $Date: 89/07/28 09:57:27 $ ! $State: Stable $ ! ! ! ********************************************************************** ! ! PURPOSE - ! ! DRIVER ROUTINE FOR THE M-MULTIPLICATION ROUTINE. COMPUTES ! VEC(ID1)=M*VEC(ID2). ! ! INPUT PARAMETERS - ! ! ID1 = IDENTIFIER OF THE RESULTING VECTOR. ! ID2 = IDENTIFIER OF THE INCOMING VECTOR. ! ! PLEASE SEE THE PROGRAMMERS GUIDE FOR INFORMATION ABOUT ! PARAMETERS NOT EXPLAINED ABOVE, AND FOR MORE DETAILS ABOUT ! THE FUNCTION OF THE ROUTINE. ! ! ! ********************************************************************** ! REAL(Kind=WP_Kind) SECOND, SMALL, ST, TIME, W(1) INTEGER AD1, AD2, ADDRSS, COUNT, D, DAFILE, DUMMY, FREE, ID1, ID2, IW(1), K, KFILE, LEN, LP, M, MAXL, N, NBADMU, & NMXRST, NOACTN, NOR, NREAD, NWRITE, READID, READK, SAEVAL, SAVE, SAVFRE, VER, WRITID, PROFIL LOGICAL ALLOC, DIAGM, F, T COMMON /STLMAC/ NOACTN, FREE, SAVE, SAVFRE COMMON /STLMAD/ ADDRSS, DAFILE, KFILE, LP, MAXL, NREAD, NWRITE COMMON /STLMDS/ K, M, D, DIAGM COMMON /STLMIO/ SAEVAL, READID, WRITID, READK, N COMMON /STLMST/ TIME(24), COUNT(24), NBADMU, NMXRST, DUMMY COMMON /STLMPF/ PROFIL COMMON /STLMTF/ T, F COMMON /STLMVR/ SMALL, VER ! DATA NOR / 14 / ! ST = SECOND(DUMMY) COUNT(NOR) = COUNT(NOR) + 1 OPM = T ! IF(VER == 3) GOTO 10 IF(.NOT. ALLOC(ID1, ID2, AD1, AD2, NOACTN, W, IW(ADDRSS))) GOTO 8888 ! IF(VER == 2) GOTO 20 CALL OPMSUB(W(AD1), W(AD2), W(M), IW(D), N, DIAGM) GOTO 9999 ! 10 CALL OPM3(ID1, ID2, W, IW, N, PROFIL, LEN) 20 IF(VER == 2) CALL OPM2(W(AD1), W(AD2), W, IW, N, PROFIL, LEN) ! IF(.NOT. LEN > 0) GOTO 9999 CALL ERROR(101, LEN) CALL ERROR(101, 101) ! 8888 OPM = F CALL ERROR(NOR, NOR) ! 9999 TIME(NOR) = TIME(NOR) + SECOND(DUMMY) - ST RETURN END