PROGRAM MAILBOX_B IMPLICIT NONE C****************************************************************************** C*** C*** This program is an example of using mailboxes to comunicate between C*** two process. This program MAILBOX_B, is the subprocess to MALBOX_A. C*** It reads in real arrays and negates them until the MAILBOX_A process C*** tells it to exit by sending the array dimensions as zero,zero. C*** C*** Author : Jeff Cameron C*** jcam90502@jcameron.com C*** http://www.jcameron.com/vms/ C*** C*** Modification history : C*** C*** Programmer Date Description C*** ---------------------------------------------------------------------- C*** Jeff Cameron 25-JAN-1989 Initially written C*** ---------------------------------------------------------------------- C*** C****************************************************************************** C C*** Constants INCLUDE '($SSDEF)' INCLUDE '($SYSSRVNAM)' INCLUDE '($LIBDEF)' C C*** Common blocks C C*** Local declarations INTEGER*4 STATUS REAL*4 IN_ARRAY (100,100) REAL*4 OUT_ARRAY (100,100) INTEGER*4 ROWS,COLS INTEGER*4 I,J C INTEGER*4 A2B /11/, B2A /12/ ! Fortran LUNS for mailboxes C C*** Externals C C*** Formats C------------------------------------------------------------------------------ C C*** Begining of executable code. C*** Open the file for unformatted reads from A OPEN (UNIT=A2B,FILE='A_TO_B',STATUS='NEW',FORM='UNFORMATTED',IOSTAT=STATUS) IF (STATUS .NE. 0) STOP 'OPEN ATOB' C C*** Now open file for unformatted writes back to A OPEN (UNIT=B2A,FILE='B_TO_A',STATUS='NEW',FORM='UNFORMATTED',IOSTAT=STATUS) IF (STATUS .NE. 0) STOP 'OPEN BTOA' C C*** READ THE ARRAY DIMENSIONS 10 READ (A2B) ROWS,COLS IF ((ROWS .LE. 0) .OR. (COLS .LE. 0)) GO TO 1000 C DO J = 1,ROWS READ (A2B) (IN_ARRAY(I,J),I=1,COLS) END DO C C*** NEGATE IT DO J = 1,ROWS DO I = 1,COLS OUT_ARRAY (I,J) = -1.0 * IN_ARRAY (I,J) END DO END DO C C*** Write back to the other process DO J = 1,ROWS WRITE (B2A) (OUT_ARRAY(I,J),I=1,COLS) END DO C GO TO 10 C C*** CLOSE THE FORTRAN MAILBOX FILES 1000 CLOSE (UNIT=A2B) CLOSE (UNIT=B2A) C C*** All done CALL EXIT END