*COMDECK COMMENTS                                                       
C---------------------------------------------------------------------- 
C                                                                       
C  DYFESM      TWO DIMENSIONAL DYNAMIC FINITE ELEMENT STRUCTURAL        
C              ANALYSIS PROGRAM (MIXED METHOD).                         
C                                                                       
C              AHMED K. NOOR                                            
C              JEANNE M. PETERS                                         
C              GEORGE WASHINGTON UNIVERSITY GRADUATE CENTER             
C              NASA LANGLEY RESEARCH CENTER                             
C              HAMPTON, VIRGINIA 23665                                  
C              (804) 865-2516                                           
C                                                                       
C   NOTES                                                               
C   -----                                                               
C     . USES THE EXPLICIT LEAP FROG METHOD                              
C     . THERE ARE 8 STRESS DEGREES OF FREEDOM PER NODE:                 
C         N1, N2, N12, M1, M2, M12, Q1, Q2                              
C     . THERE ARE 5 DISPLACEMENT DEGREES OF FREEDOM PER NODE:           
C         U, V, W, PH1, PH2                                             
C     . USES SUBSTRUCTURING                                             
C     . STRESSES ARE DISCONTINUOUS AT THE ELEMENT LEVEL                 
C     . INVERSION SYMMETRIES ARE IMPLEMENTED (NEGATIVE NODE NUMBER      
C          IN THE ELEMENTAL CONNECTIVITIES)                             
C     . EQUATION 1 IS DONE BY ELEMENTS                                  
C     . EQUATION 2 IS SOLVED BY THE PRECONJUGATE GRADIENT METHOD        
C     . THE MULTIPLICATION OF [M0+MA] * XDD IS CURRENTLY DONE ON THE    
C          ELEMENT LEVEL BUT COULD BE DONE ON THE GLOBAL LEVEL.         
C          (THE BLOCKS OF [MA] ARE ASSEMBLED BUT NOT USED)              
C     . THE SPECIAL CASE OF 1 SUBSTRUCTURE, 0 CONJUGATE GRADIENT        
C       ITERATIONS WORKS .                                              
C                                                                       
C                                                                       
C   EQUATIONS                                                           
C   ---------                                                           
C                                                                       
C   F * H(T) = S.X(T) + 1/2*MNL.X(T).X(T)              (EQ.1)           
C   M*XDD(T) = P(T) - S.H(T) - MNL.H(T).X(T)           (EQ.2)           
C   XD(T+DELTAT/2) = XD(T-DELTAT/2) + DELTAT*XDD(T)    (EQ.3)           
C   XD(T+DELTAT/2) = XD(T=0) + DELTAT/2 * XD(T=0)      (EQ.3A) --- INITI
C   X(T+DELTAT) = X(T) + DELTAT*XD(T+DELTAT/2)         (EQ.4)           
C                                                                       
C   MARCHING IN TIME ALGORITHM                                          
C   --------------------------                                          
C                                                                       
C   INITIALIZE DISPLACEMENTS X(T) AND VELOCITIES XD(T) AT TIME T=0      
C   SOLVE FOR STRESSES H(T) USING EQUATION 1                            
C   SOLVE FOR ACCELERATIONS XDD(T) USING EQUATION 2                     
C   COMPUTE VELOCITIES XD(T+DELTAT/2) USING EQUATION 3A                 
C   COMPUTE DISPLACEMENTS X(T+DELTAT) USING EQUATION 4                  
C   LOOP OVER THE TIME STEPS                                            
C      COPY X(T+DELTAT) INTO X(T)                                       
C      COPY XD(T+DELTAT/2) INTO XD(T-DELTAT/2)                          
C      SOLVE FOR STRESSES H(T) USING EQUATION 1                         
C      SOLVE FOR ACCELERATIONS XDD(T) USING EQUATION 2                  
C      COMPUTE VELOCITIES XD(T+DELTAT/2) USING EQUATION 3               
C      COMPUTE DISPLACEMENTS X(T+DELTAT) USING EQUATION 4               
C      COMPUTE VELOCITIES XD(T) BY TAKING THE AVERAGE OF                
C         THE VELOCITIES XD(T+DELTAT/2) AND XD(T-DELTAT/2)              
C   END LOOP                                                            
C                                                                       
C   PRECONJUGATE GRADIENT ALGORITHM FOR EQUATION 3                      
C   ----------------------------------------------                      
C                                                                       
C   M * XDD = P - S.H - MNL.H.X                                         
C                                                                       
C   M = M0 + MA                                                         
C                                                                       
C         [M11  .   . ]          [ .  .   M1B]                          
C    M0 = [ .  M22  . ]     MA = [ .  .   M2B]                          
C         [ .   .  MBB]          [MB1 MB2  . ]                          
C                                                                       
C    R0 = P - S.H - MNL.H.X                                             
C    SOLVE M0 * XDD = R0                                                
C    SET Z TO 0                                                         
C    SET SCALAR YR TO 0                                                 
C    LOOP OVER THE CONJUGATE GRADIENT ITERATIONS UNTIL CONVERGENCE      
C       SET SCALAR YROLD TO YR                                          
C       R = R0 - [M0+MA]*XDD                                            
C       SOLVE M0 * Y = R                                                
C       FORM SCALAR YR = Y**T * R                                       
C       FORM SCALAR B = YR / YROLD    OR B=0 FIRST TIME                 
C       Z = Y + B*Z                                                     
C       FORM SCALAR MZZ = Z**T * [M0+MA]*Z                              
C       FORM SCALAR A = YR/MZZ                                          
C       XDD = XDD + A*Z                                                 
C       TOP = A*A* Z**T * Z                                             
C       BOT = XDD**T * XDD                                              
C       ERROR = SQRT(TOP/BOT) / NUMBER OF EQUATIONS                     
C       IF ERROR IS SMALL ENOUGH THEN QUIT                              
C    END LOOP                                                           
C                                                                       
C---------------------------------------------------------------------  
*DECK                                            DYFESM                 
      PROGRAM DYFESM                                                    
C-----------------------------------------------------------------------
C FILES:                                                                
C           SDI5         - PROBLEM INPUT DATA FILE (INPUT)              
C           SDO7         - PROBLEM OUTPUT FILE (OUTPUT)                 
C           SDO14        - RESULTS AT A PARTICULAR NODE (OUTPUT)        
C           SDO6         - INFORMATIVE AND ERROR MESSAGES (OUTPUT)      
C           SDO1         - SOLUTION USED FOR RESTART RUN (OUTPUT)       
C-----------------------------------------------------------------------
C                                                                       
      REAL T1,T2,T3,T4                                                  
CX00001 CALL MAINIX (1)                                                 
CY00001 CALL MAINIY (1)                                                 
CX60000 CALL CNTINX ()                                                  
CY60000 CALL CNTINY ()                                                  
C                                                                       
      OPEN(UNIT=5, FILE='SDI5')                                         
      OPEN(UNIT=9, FILE='SDO9')                                         
      OPEN(UNIT=14,FILE='SDO14')                                        
      OPEN(UNIT=15,FILE='SDV')                                          
      OPEN(UNIT=6, FILE='SDO6')                                         
      OPEN(UNIT=1, FILE='SDO1')                                         
C                                                                       
C     . ALLOW FILE REPLACEMENT FOR CRAY XMP .                           
C     CALL FILEREP *COMMENTED OUT*                                      
C                                                                       
C.....CALL TIMING ROUTINES                                              
C                                                                       
      CALL CPUTIM(T1)                                                   
      CALL ELAPSE(T2)                                                   
C                                                                       
C     . INPUT DATA .                                                    
C     CALL REMARK(' INIT')                                              
      WRITE(6,*)  ' ********** INIT ********** '                        
      CALL INIT                                                         
C                                                                       
C     . INITIAL SET UP .                                                
C     CALL REMARK(' SETUP')                                             
      WRITE(6,*)  ' ********** SETUP **********'                        
      CALL SETUP                                                        
C                                                                       
C     . FORM THE ELEMENTAL MATRICES .                                   
C     CALL REMARK(' DRELMN')                                            
      WRITE(6,*)  ' ********** DRELMN **********'                       
      CALL DRELMN                                                       
C                                                                       
C     . ASSEMBLE THE MASS MATRIX AND LOAD VECTOR .                      
C     CALL REMARK(' DRASSM')                                            
      WRITE(6,*)  ' ********** DRASSM **********'                       
      CALL DRASSM                                                       
C                                                                       
C     . APPLY BOUNDARY CONDITIONS TO THE MASS MATRIX AND                
C       ADD CONCENTRATED LOADINGS TO THE LOAD VECTORS .                 
C     CALL REMARK(' DRBC')                                              
      WRITE(6,*)  ' ********** DRBC ********** '                        
      CALL DRBC                                                         
C                                                                       
C     . FACTOR THE MASS MATRIX  .                                       
C     CALL REMARK(' DRFACT ')                                           
      WRITE(6,*)  ' ********** DRFACT ********** '                      
      CALL DRFACT                                                       
C                                                                       
C     . MARCH IN TIME .                                                 
C     CALL REMARK(' LEAP')                                              
      WRITE(6,*)  ' ********** LEAP ********** '                        
      CALL LEAP                                                         
C                                                                       
C                                                                       
C.....CALL TIMING ROUTINES                                              
C                                                                       
      CALL CPUTIM(T3)                                                   
      CALL ELAPSE(T4)                                                   
C                                                                       
      WRITE(15,*)                                                       
      WRITE(15,*) 'ELAPSED CPU TIME IN SECONDS: ',T3-T1                 
C MFLOPS = MFLOP 1 CPU CRAY X-MP/CPU                                    
      WRITE(15,*) 'MFLOPS RATE: ', 552.096/(T3-T1)                      
      WRITE(15,*) 'ELAPSED WALLCLOCK TIME IN SECONDS: ',                
     *            MOD(T4-T2+1000000.0,1000000.0)                        
C                                                                       
      WRITE(6,*) ' ********** ALL DONE ********** '                     
CX70000 CALL CNTOTX ()                                                  
CY70000 CALL CNTOTY ()                                                  
CX50000 CALL MAINOX ()                                                  
CY50000 CALL MAINOY ()                                                  
      STOP                                                              
      END                                                               
                                                                        
*DECK                                            ABC                    
      SUBROUTINE ABC(BLOCK, BIGNO, NROWS, NBC, NBCN, IFLAG, BCVAL)      
C********************************************************************** 
C     APPLY BOUNDARY CONDITIONS TO A DIAGONAL BLOCK                     
C                                                                       
C     IF FLAG=1 THEN PUT A LARGE NUMBER ON THE DIAGONAL OF THE BLOCK    
C                                                                       
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK WHERE                                                          
      COMMON /WHERE/ IWHERD(ZNND,2)                                     
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
      DIMENSION BLOCK(NROWS,NROWS), NBCN(NBC), IFLAG(NDDF,NBC),         
     *          BCVAL(NDDF,NBC)                                         
CX30003 CALL SBINX (3)                                                  
CY30003 CALL SBINY (3)                                                  
CX10501 CALL DOINX( 501 )                                               
CY10501 CALL DOINY( 501 )                                               
C                                                                       
C     . LOOP OVER THE BOUNDARY NODES .                                  
      DO 10 IBN = 1, NBC                                                
         NODE = NBCN(IBN)                                               
         IREL = IWHERD(NODE,2)                                          
                                                                        
C        . LOOP OVER THE DEGREES OF FREEDOM PER NODE .                  
         DO 5 IDOF = 1, NDDF                                            
            IF (IFLAG(IDOF,IBN).EQ.1) THEN                              
               ILOC = IREL - 1 + IDOF                                   
               BLOCK(ILOC,ILOC) = BIGNO                                 
            ENDIF                                                       
   5     CONTINUE                                                       
  10  CONTINUE                                                          
CX20502 CALL DOOUTX( 502 )                                              
CY20502 CALL DOOUTY( 502 )                                              
CX40004 CALL SBOUTX (4)                                                 
CY40004 CALL SBOUTY (4)                                                 
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            ADDCON                 
      SUBROUTINE ADDCON(IBLOCK, PBLOCK)                                 
C********************************************************************** 
C     ADD IN CONCENTRATED LOADINGS TO BLOCK                             
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK WHERE                                                          
      COMMON /WHERE/ IWHERD(ZNND,2)                                     
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
*COMDECK LOADD                                                          
C---------------                                                        
      COMMON /LOADD/ PXYZ(3,ZNND),                                      
     *               NCONC, NODCON(ZNCONC), PCONC(3,ZNCONC)             
C                                                                       
C PXYZ    - GLOBAL NODAL LOADS                                          
C NODCON,PCONC - CONCENTRATED LOAD DATA                                 
C                                                                       
C            APPLY CONCENTRATED LOADINGS OF PCONC(1,I),                 
C            PCONC(2,I), AND PCONC(3,I) TO NODE NUMBER NODCON(I)        
C                                                                       
      DIMENSION PBLOCK(*)                                               
CX30005 CALL SBINX (5)                                                  
CY30005 CALL SBINY (5)                                                  
CX10503 CALL DOINX( 503 )                                               
CY10503 CALL DOINY( 503 )                                               
C                                                                       
C     . LOOP OVER ALL OF THE CONCENTRATED LOADS .                       
      DO 20 IC = 1, NCONC                                               
         NODE = NODCON(IC)                                              
         IH = IWHERD(NODE,1)                                            
         IF (IBLOCK.EQ.IH) THEN                                         
C           . NODE LIES WITHIN THIS BLOCK SO ADD IT IN .                
            IREL = IWHERD(NODE,2)                                       
            PX = PCONC(1,IC)                                            
            PY = PCONC(2,IC)                                            
            PZ = PCONC(3,IC)                                            
            PBLOCK(IREL  ) = PBLOCK(IREL  ) + PX                        
            PBLOCK(IREL+1) = PBLOCK(IREL+1) + PY                        
            PBLOCK(IREL+2) = PBLOCK(IREL+2) + PZ                        
         ENDIF                                                          
  20  CONTINUE                                                          
CX20504 CALL DOOUTX( 504 )                                              
CY20504 CALL DOOUTY( 504 )                                              
CX40006 CALL SBOUTX (6)                                                 
CY40006 CALL SBOUTY (6)                                                 
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            ADDIN                  
      SUBROUTINE ADDIN (A, NRA, NCA, B, NRB, NCB, M, N)                 
C********************************************************************** 
C ADD A[NRA,NCA] INTO B[NRB,NCB] AT LOCATION (M,N)                      
C********************************************************************** 
      DIMENSION A(NRA,NCA), B(NRB,NCB)                                  
CX30007 CALL SBINX (7)                                                  
CY30007 CALL SBINY (7)                                                  
CX10505 CALL DOINX( 505 )                                               
CY10505 CALL DOINY( 505 )                                               
      DO 200 J = 1, NCA                                                 
        DO 100 I = 1, NRA                                               
          B(M-1+I,N-1+J) = B(M-1+I,N-1+J) + A(I,J)                      
 100    CONTINUE                                                        
 200  CONTINUE                                                          
CX20506 CALL DOOUTX( 506 )                                              
CY20506 CALL DOOUTY( 506 )                                              
CX40008 CALL SBOUTX (8)                                                 
CY40008 CALL SBOUTY (8)                                                 
      RETURN                                                            
      END                                                               
*DECK                                            ADDOTP                 
      SUBROUTINE ADDOTP(A,B,C,N)                                        
C********************************************************************** 
C     THIS SUBROUTINE ADDS THE DOT PRODUCT OF  A  AND  B  TO THE        
C        SCALAR  C.   A  AND  B  EACH HAVE LENGTH N.                    
C********************************************************************** 
      DIMENSION A(N),B(N)                                               
CX30009 CALL SBINX (9)                                                  
CY30009 CALL SBINY (9)                                                  
CX10507 CALL DOINX( 507 )                                               
CY10507 CALL DOINY( 507 )                                               
C                                                                       
C                                                                       
      DO 1 I=1,N                                                        
         C = C + A(I)*B(I)                                              
 1    CONTINUE                                                          
CX20508 CALL DOOUTX( 508 )                                              
CY20508 CALL DOOUTY( 508 )                                              
CX40010 CALL SBOUTX (10)                                                
CY40010 CALL SBOUTY (10)                                                
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            ASSEMM                 
      SUBROUTINE ASSEMM(ID, ME, MII, MIB, MBB, NEQI, NEQB)              
C********************************************************************** 
C ASSEMBLE MASS MATRIX [ME] FOR ELEMENT NUMBER "ID" INTO                
C   [MII], [MIB], AND [MBB].  NOTE THAT BLOCKS [MII] AND [MIB]          
C   WILL BE COMPLETED BUT BLOCK [MBB] WILL NOT BE DONE UNTIL            
C   ALL THE SUBSTRUCTURES HAVE FINISHED.                                
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK WHERE                                                          
      COMMON /WHERE/ IWHERD(ZNND,2)                                     
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
*COMDECK CONN                                                           
C---------------                                                        
      COMMON /CONN/ ICONS(ZNNPES,ZNE), ICOND(ZNNPED,ZNE)                
C                                                                       
C ICONS   - STRESS ELEMENTAL CONNECTIVITY VECTORS                       
C ICOND   - DISPL. ELEMENTAL CONNECTIVITY VECTORS                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      REAL MII(NEQI,NEQI), MIB(NEQI,NEQB), MBB(NEQB,NEQB)               
      REAL ME(NDDF,NNPED,NDDF,NNPED)                                    
      DIMENSION SUU(NDDF,NDDF)                                          
CX30011 CALL SBINX (11)                                                 
CY30011 CALL SBINY (11)                                                 
CX10509 CALL DOINX( 509 )                                               
CY10509 CALL DOINY( 509 )                                               
C                                                                       
CCC   PRINT *, ' SUBROUTINE ASSEMM'                                     
C                                                                       
C     . LOOP OVER THE NODES PER ELEMENT .                               
      DO 40 IN = 1, NNPED                                               
         I = ABS(ICOND(IN,ID))                                          
         IBLOCK  = IWHERD(I,1)                                          
         IREL    = IWHERD(I,2)                                          
CCC      PRINT *, ' I, IBLOCK, IREL = ',I,IBLOCK,IREL                   
         DO 35 JN = 1, NNPED                                            
            J = ABS(ICOND(JN,ID))                                       
            JBLOCK  = IWHERD(J,1)                                       
            JREL    = IWHERD(J,2)                                       
CCC         PRINT *, ' J, JBLOCK, JREL = ',J,JBLOCK,JREL                
C                                                                       
C           . DETERMINE WHICH BLOCK THE NODAL PARTITION LIES WITHIN     
C             AND ADD IT INTO THE APPROPRIATE BLOCK .                   
            IF (IBLOCK.EQ.NBLOCK .AND. JBLOCK.EQ.NBLOCK) THEN           
C              . [MBB] .                                                
CCC            PRINT *, ' MBB '                                         
               CALL GETSUU(SUU, ID, IN, JN, ME)                         
               CALL ADDIN(SUU,NDDF,NDDF,MBB,NEQB,NEQB,IREL,JREL)        
            ELSE IF (JBLOCK.EQ.NBLOCK) THEN                             
C              . [MIB] .                                                
CCC            PRINT *, ' MIB '                                         
               CALL GETSUU(SUU, ID, IN, JN, ME)                         
               CALL ADDIN(SUU,NDDF,NDDF,MIB,NEQI,NEQB,IREL,JREL)        
            ELSE IF (IBLOCK.NE.NBLOCK) THEN                             
C              . [MII] .                                                
CCC            PRINT *, ' MII '                                         
               CALL GETSUU(SUU, ID, IN, JN, ME)                         
               CALL ADDIN(SUU,NDDF,NDDF,MII,NEQI,NEQI,IREL,JREL)        
            ENDIF                                                       
  35     CONTINUE                                                       
  40  CONTINUE                                                          
CX20510 CALL DOOUTX( 510 )                                              
CY20510 CALL DOOUTY( 510 )                                              
CX40012 CALL SBOUTX (12)                                                
CY40012 CALL SBOUTY (12)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            ASSEMR                 
      SUBROUTINE ASSEMR(ID, RHSE, RHSI, RHSB)                           
C********************************************************************** 
C ASSEMBLE ELEMENT OF RIGHT HAND SIDE INTO BLOCKS (RHSI) AND (RHSB)     
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK WHERE                                                          
      COMMON /WHERE/ IWHERD(ZNND,2)                                     
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
*COMDECK CONN                                                           
C---------------                                                        
      COMMON /CONN/ ICONS(ZNNPES,ZNE), ICOND(ZNNPED,ZNE)                
C                                                                       
C ICONS   - STRESS ELEMENTAL CONNECTIVITY VECTORS                       
C ICOND   - DISPL. ELEMENTAL CONNECTIVITY VECTORS                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DIMENSION RHSI(*), RHSB(*), RHSE(NDDF,NNPED)                      
CX30013 CALL SBINX (13)                                                 
CY30013 CALL SBINY (13)                                                 
C                                                                       
CCC   PRINT *, ' SUBROUTINE ASSEMR '                                    
C                                                                       
C     . APPLY INVERSION SYMMETRY TRANSFORMATIONS .                      
      IF (NSYMM.EQ.1) CALL TRNRHS(ID, RHSE)                             
CX10511 CALL DOINX( 511 )                                               
CY10511 CALL DOINY( 511 )                                               
C                                                                       
C     . LOOP OVER THE NODES PER ELEMENT .                               
      DO 40 IN = 1, NNPED                                               
         NODE = ABS(ICOND(IN,ID))                                       
         IBLOCK  = IWHERD(NODE,1)                                       
         IREL    = IWHERD(NODE,2)                                       
         IF (IBLOCK.EQ.NBLOCK) THEN                                     
C           . ADD NODAL PARTITION TO THE RHSB BLOCK .                   
            DO 10 I = 1, NDDF                                           
               RHSB(IREL+I-1) = RHSB(IREL+I-1) + RHSE(I,IN)             
  10        CONTINUE                                                    
         ELSE                                                           
C           . ADD NODAL PARTITION TO THE RHSI BLOCK .                   
            DO 20 I = 1, NDDF                                           
               RHSI(IREL+I-1) = RHSI(IREL+I-1) + RHSE(I,IN)             
  20        CONTINUE                                                    
         ENDIF                                                          
  40  CONTINUE                                                          
CX20512 CALL DOOUTX( 512 )                                              
CY20512 CALL DOOUTY( 512 )                                              
CX40014 CALL SBOUTX (14)                                                
CY40014 CALL SBOUTY (14)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            BLKDAT                 
      BLOCK DATA BLKDAT                                                 
C********************************************************************** 
C     BLOCK DATA                                                        
C********************************************************************** 
*COMDECK FORCE                                                          
C---------------                                                        
      COMMON /FORCE/ NLP,ILAST,TLP(10),FLP(10)                          
C                                                                       
C NLP     - NUMBER OF LOAD POINTS FOR THE LOADING                       
C ILAST   - LAST LOAD POINT USED                                        
C TLP     - TIME POINTS OF THE LOADING FUNCTION                         
C FLP     - FACTORS OR THE CORRESPONDING TIME POINTS                    
C                                                                       
      DATA ILAST /1/                                                    
      END                                                               
                                                                        
*DECK                                            BLCKMX                 
      SUBROUTINE BLCKMX(ISS, MXI, MXB, X, NEQI, NEQB)                   
C********************************************************************** 
C     FORM THE COMPLETE INTERNAL BLOCK (MXI) BY LOOPING OVER            
C     ALL THE ELEMENTS WHICH LIE IN THIS SUBSTRUCTURE AND ASSEMBLING.   
C                                                                       
C     AT THE SAME TIME ADD IN ANY CONTRIBUTIONS TO MXB.  THIS BLOCK     
C     WILL NOT BE COMPLETE UNTIL ALL THE SUBSTRUCTURES HAVE COMPLETED.  
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK EDESCR                                                         
C---------------                                                        
      COMMON /EDESCR/ IESMNO(ZNE), IEGEOM(ZNE), IECURV(ZNE)             
C                                                                       
C IESMNO  - DISTINCT ELEMENTAL STIFFNESS MATRIX NUMBERS                 
C IEGEOM  - ELEMENTAL GEOMETRY FLAGS (0=ARBITRARY, 1=RECTANGULAR)       
C IECURV  - ELEMENTAL CURVATURE FLAGS                                   
C                                                                       
*COMDECK ELMNTS                                                         
C---------------                                                        
      REAL ME, MNLE                                                     
      COMMON /ELMNTS/ FE(ZNUMF,ZNDE), SE(ZNUMS,ZNDE), ME(ZNUMM,ZNDE),   
     *                PE(ZNUMP,ZNE), MNLE(ZNUMNL,ZNDE), IDEDON(ZNDE)    
C                                                                       
C FE      - DISTINCT ELEMENTS OF [F]                                    
C SE      - DISTINCT ELEMENTS OF [S]                                    
C ME      - DISTINCT ELEMENTS OF [M]                                    
C PE      - ALL ELEMENT OF THE LOAD VECTOR                              
C MNLE    - DISTINCT ELEMENTS OF [MNL]                                  
C IDEDON  - 1 IF DISTINCT ELEMENT HAS BEEN FORMED.  0 IF NOT YET FORMED 
C                                                                       
      REAL MXI(*), MXB(*), X(*), MXE(ZNDFE), XE(ZNDFE)                  
CX30015 CALL SBINX (15)                                                 
CY30015 CALL SBINY (15)                                                 
C                                                                       
CCC   PRINT *, ' SUBROUTINE BLCKMX '                                    
C                                                                       
C     . ZERO OUT THE MXI BLOCK .                                        
      CALL ZEROV(MXI, NEQI)                                             
CX10513 CALL DOINX( 513 )                                               
CY10513 CALL DOINY( 513 )                                               
C                                                                       
C     . LOOP OVER THE ELEMENTS WHICH LIE IN THIS SUBSTRUCTURE .         
      DO 10 K = 1, NEPSS(ISS)                                           
         ID = IDBEGS(ISS) + K - 1                                       
         IDE = IESMNO(ID)                                               
CCC      PRINT *, ' ID = ',ID,' IDE = ',IDE                             
C                                                                       
C        . EXTRACT THE ELEMENTAL SOLUTION .                             
         CALL GETEU(ID, XE, X)                                          
C                                                                       
C        . FORM THE ELEMENT OF MX .                                     
CCC      PRINT *, ' CALL MATMUL '                                       
         CALL MATMUL(ME(1,IDE), XE, MXE, NDFE, NDFE, 1)                 
C                                                                       
C        . ASSEMBLE THE ELEMENT INTO THE MXI AND MXB BLOCKS .           
CCC      PRINT *, ' CALL ASSEMR '                                       
         CALL ASSEMR(ID, MXE, MXI, MXB)                                 
  10  CONTINUE                                                          
CX20514 CALL DOOUTX( 514 )                                              
CY20514 CALL DOOUTY( 514 )                                              
CX40016 CALL SBOUTX (16)                                                
CY40016 CALL SBOUTY (16)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            BLCKR0                 
      SUBROUTINE BLCKR0(ISS, R0I, R0B, NEQI, NEQB)                      
C********************************************************************** 
C     FORM THE COMPLETE INTERNAL BLOCK (R0I) BY LOOPING OVER            
C     ALL THE ELEMENTS WHICH LIE IN THIS SUBSTRUCTURE AND ASSEMBLING.   
C                                                                       
C     AT THE SAME TIME ADD IN ANY CONTRIBUTIONS TO R0B.  THIS BLOCK     
C     WILL NOT BE COMPLETE UNTIL ALL THE SUBSTRUCTURES HAVE FINISHED.   
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK EDESCR                                                         
C---------------                                                        
      COMMON /EDESCR/ IESMNO(ZNE), IEGEOM(ZNE), IECURV(ZNE)             
C                                                                       
C IESMNO  - DISTINCT ELEMENTAL STIFFNESS MATRIX NUMBERS                 
C IEGEOM  - ELEMENTAL GEOMETRY FLAGS (0=ARBITRARY, 1=RECTANGULAR)       
C IECURV  - ELEMENTAL CURVATURE FLAGS                                   
C                                                                       
*COMDECK ELMNTS                                                         
C---------------                                                        
      REAL ME, MNLE                                                     
      COMMON /ELMNTS/ FE(ZNUMF,ZNDE), SE(ZNUMS,ZNDE), ME(ZNUMM,ZNDE),   
     *                PE(ZNUMP,ZNE), MNLE(ZNUMNL,ZNDE), IDEDON(ZNDE)    
C                                                                       
C FE      - DISTINCT ELEMENTS OF [F]                                    
C SE      - DISTINCT ELEMENTS OF [S]                                    
C ME      - DISTINCT ELEMENTS OF [M]                                    
C PE      - ALL ELEMENT OF THE LOAD VECTOR                              
C MNLE    - DISTINCT ELEMENTS OF [MNL]                                  
C IDEDON  - 1 IF DISTINCT ELEMENT HAS BEEN FORMED.  0 IF NOT YET FORMED 
C                                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
      DIMENSION R0I(*), R0B(*), R0E(ZNDFE), XE(ZNDFE)                   
CX30017 CALL SBINX (17)                                                 
CY30017 CALL SBINY (17)                                                 
CX10515 CALL DOINX( 515 )                                               
CY10515 CALL DOINY( 515 )                                               
C                                                                       
CCC   PRINT *, ' SUBROUTINE BLCKR0 '                                    
C                                                                       
C     . LOOP OVER THE ELEMENTS WHICH LIE IN THIS SUBSTRUCTURE .         
      DO 10 K = 1, NEPSS(ISS)                                           
         ID = IDBEGS(ISS) + K - 1                                       
         IDE = IESMNO(ID)                                               
CCC      PRINT *, ' ID ',ID,' IDE = ',IDE                               
C                                                                       
C        . EXTRACT THE ELEMENTAL SOLUTION .                             
         CALL GETEU(ID, XE, X)                                          
C                                                                       
C        . FORM THE ELEMENT OF R0 .                                     
CCC      PRINT *, ' CALL FRMR0E '                                       
         CALL FRMR0E(SE(1,IDE), MNLE(1,IDE), HE(1,ID), XE, R0E)         
C                                                                       
C        . ASSEMBLE THE ELEMENT INTO THE R0I AND R0B BLOCKS .           
CCC      PRINT *, ' CALL ASSEMR '                                       
         CALL ASSEMR(ID, R0E, R0I, R0B)                                 
  10  CONTINUE                                                          
CX20516 CALL DOOUTX( 516 )                                              
CY20516 CALL DOOUTY( 516 )                                              
CX40018 CALL SBOUTX (18)                                                
CY40018 CALL SBOUTY (18)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            CHOFAC                 
      SUBROUTINE CHOFAC(A, N, IERR)                                     
C                                                                       
C***********************************************************************
C                                                                       
C     FACTOR [A] USING CHOLESKY DECOMPOSITION                           
C                                                                       
C     IERR  - ON OUTPUT IS SET TO 1 IF [A] IS SINGULAR; 0 IF NO ERROR   
C                                                                       
C***********************************************************************
C                                                                       
      DIMENSION A(N,N)                                                  
CX30019 CALL SBINX (19)                                                 
CY30019 CALL SBINY (19)                                                 
C                                                                       
      IERR = 1                                                          
      IF (A(1,1).EQ.0.) THEN                                            
CX40020 CALL SBOUTX (20)                                                
CY40020 CALL SBOUTY (20)                                                
      RETURN                                                            
      ENDIF                                                             
      DI = 1./A(1,1)                                                    
CX10517 CALL DOINX( 517 )                                               
CY10517 CALL DOINY( 517 )                                               
      DO 10 J=2,N                                                       
         A(1,J) = A(1,J)*DI                                             
  10  CONTINUE                                                          
CX20518 CALL DOOUTX( 518 )                                              
CY20518 CALL DOOUTY( 518 )                                              
CX10519 CALL DOINX( 519 )                                               
CY10519 CALL DOINY( 519 )                                               
C                                                                       
      DO 40 I=2,N                                                       
         SUM = 0.                                                       
         DO 20 L=1,I-1                                                  
            SUM = SUM + A(L,I)*A(L,I)*A(L,L)                            
  20     CONTINUE                                                       
         A(I,I) = A(I,I)-SUM                                            
      IF (A(I,I).EQ.0.) THEN                                            
CX40020 CALL SBOUTX (20)                                                
CY40020 CALL SBOUTY (20)                                                
      RETURN                                                            
      ENDIF                                                             
         DI = 1./A(I,I)                                                 
         DO 35 J=I+1,N                                                  
            SUM = 0.                                                    
            DO 30 L=1,I-1                                               
               SUM = SUM + A(L,I)*A(L,J)*A(L,L)                         
  30        CONTINUE                                                    
            A(I,J) = (A(I,J)-SUM)*DI                                    
  35     CONTINUE                                                       
  40  CONTINUE                                                          
CX20520 CALL DOOUTX( 520 )                                              
CY20520 CALL DOOUTY( 520 )                                              
  45  CONTINUE                                                          
CX10521 CALL DOINX( 521 )                                               
CY10521 CALL DOINY( 521 )                                               
C                                                                       
      DO 50 I=1,N                                                       
         A(I,I) = 1./A(I,I)                                             
  50  CONTINUE                                                          
CX20522 CALL DOOUTX( 522 )                                              
CY20522 CALL DOOUTY( 522 )                                              
C                                                                       
      IERR = 0                                                          
CX40020 CALL SBOUTX (20)                                                
CY40020 CALL SBOUTY (20)                                                
      RETURN                                                            
      END                                                               
*DECK                                            CHOSOL                 
      SUBROUTINE CHOSOL(A, N, B)                                        
C                                                                       
C***********************************************************************
C                                                                       
C     SOLVE [A] * (X) = (B) BY CHOLESKY DECOMPOSITION                   
C                                                                       
C     [A] HAS ALREADY BEEN FACTORED THROUGH A CALL TO CHOFAC            
C                                                                       
C***********************************************************************
C                                                                       
      DIMENSION A(N,N), B(N)                                            
CX30021 CALL SBINX (21)                                                 
CY30021 CALL SBINY (21)                                                 
CX10523 CALL DOINX( 523 )                                               
CY10523 CALL DOINY( 523 )                                               
C                                                                       
C     --- FORWARD SOLVE ---                                             
C                                                                       
      DO 53 I=2,N                                                       
         SUM = 0.                                                       
         DO 51 L=1,I-1                                                  
            SUM = SUM + A(L,I)*B(L)                                     
  51     CONTINUE                                                       
         B(I) = B(I) - SUM                                              
  53  CONTINUE                                                          
CX20524 CALL DOOUTX( 524 )                                              
CY20524 CALL DOOUTY( 524 )                                              
CX10525 CALL DOINX( 525 )                                               
CY10525 CALL DOINY( 525 )                                               
C                                                                       
C     --- DIVIDE BY DIAGONAL ---                                        
C                                                                       
      DO 55 I=1,N                                                       
         B(I) = B(I)*A(I,I)                                             
  55  CONTINUE                                                          
CX20526 CALL DOOUTX( 526 )                                              
CY20526 CALL DOOUTY( 526 )                                              
CX10527 CALL DOINX( 527 )                                               
CY10527 CALL DOINY( 527 )                                               
C                                                                       
C     --- BACK SOLVE ---                                                
C                                                                       
      DO 80 I = N-1, 1, -1                                              
         SUM = 0.                                                       
         DO 60 L=I+1,N                                                  
            SUM = SUM + A(I,L)*B(L)                                     
  60     CONTINUE                                                       
         B(I) = B(I) - SUM                                              
  80  CONTINUE                                                          
CX20528 CALL DOOUTX( 528 )                                              
CY20528 CALL DOOUTY( 528 )                                              
CX40022 CALL SBOUTX (22)                                                
CY40022 CALL SBOUTY (22)                                                
C                                                                       
      RETURN                                                            
      END                                                               
*DECK                                            COMPL                  
      SUBROUTINE COMPL                                                  
C********************************************************************** 
C THIS SUBROUTINE COMPUTES THE COMPLIANCE MATRIX FOR THE 8 STRESS       
C DEGREES OF FREEDOM SHELL ELEMENT                                      
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK LAYERS                                                         
C---------------                                                        
      COMMON /LAYERS/ NL, E1(ZNL), E2(ZNL), ANU12(ZNL), G12(ZNL),       
     .                    G13(ZNL), G23(ZNL), THET(ZNL), HZ(ZNL),       
     .                    RHOZ(ZNL)                                     
C                                                                       
C NL      - NUMBER OF LAYERS                                            
C E1, E2  - YOUNG'S MODULII                                             
C ANU12   - MAJOR POISSON RATIO                                         
C G12, G13, G23 - SHEAR MODULII                                         
C THET    - ORIENTATIONS OF LAYERS (DEGREES)                            
C HZ      - THICKNESSES OF LAYERS                                       
C RHOZ    - MASS DENSITY OF LAYERS                                      
C                                                                       
*COMDECK COMPLZ                                                         
C---------------                                                        
      COMMON /COMPLZ/ C(8,8)                                            
C                                                                       
C [C]     - COMPLIANCE MATRIX                                           
C                                                                       
      COMMON /TRANFZ/ THETA, CA(6), CL(3,3), CLS(2,2)                   
      COMMON /COMPLT/ IPIVOT(8), IWK(8,2)                               
CX30023 CALL SBINX (23)                                                 
CY30023 CALL SBINY (23)                                                 
C                                                                       
C INPUT  - E1(NL)    = YOUNGS MODULUS, X1 DIRECTION                     
C        - E2(NL)    = YOUNGS MODULUS, X2 DIRECTION                     
C        - ANU12(NL) = MAJOR POISSONS RATIO                             
C        - G12(NL)  = SHEAR MODULUS, X1-X2  PLANE                       
C        - G23(NL)   = SHEAR MODULUS, X2-X3 PLANE                       
C        - G13(NL)   = SHEAR MODULUS, X1-X3 PLANE                       
C        - THET(NL)  = FIBER ORIENTATION                                
C                      THET(I) MEASURES THE ANGLE THAT THE FIBERS       
C                         OF LAYER I MAKE WITH THE X-AXIS.  POSITIVE    
C                         DIRECTION GOES FROM X TO Y AXIS.              
C        - HZ(NL)    = LAYER THICKNESS                                  
C        - NL        = NUMBER OF LAYERS                                 
C                                                                       
C OUTPUT - C(8,8)    = COMPLIANCE MATRIX OF THE SHELL                   
C                                                                       
C LOCAL  - CA(6)     = ELASTIC STIFFNESSES OF LAYER                     
C        - CL(3,3)  = EXTENSIONAL STIFFNESSES OF LAYER                  
C        - CLS(2,2) = SHEAR STIFFNESSES OF LAYER                        
C                                                                       
C                                                                       
C COMPUTE THE COMPLIANCE MATRIX.                                        
C                                                                       
      RPD = 3.14159265358979/180.                                       
      H = 0.                                                            
      CALL ZEROV(CL, 9)                                                 
      CALL ZEROV(CLS, 4)                                                
      CALL ZEROV(C, 64)                                                 
      HT = 0.                                                           
CX10529 CALL DOINX( 529 )                                               
CY10529 CALL DOINY( 529 )                                               
      DO 20 I = 1, NL                                                   
         HT = HT + HZ(I)*0.5                                            
  20  CONTINUE                                                          
CX20530 CALL DOOUTX( 530 )                                              
CY20530 CALL DOOUTY( 530 )                                              
CX10531 CALL DOINX( 531 )                                               
CY10531 CALL DOINY( 531 )                                               
      DO 40 I = 1, NL                                                   
         H = H + HZ(I)                                                  
         THETA = THET(I)*RPD                                            
         ANU21 = ANU12(I)*E2(I)/E1(I)                                   
         AP = 1. - ANU12(I)*ANU21                                       
         CA(1) = E1(I)/AP                                               
         CA(2) = ANU21*E1(I)/AP                                         
         CA(3) = E2(I)/AP                                               
         CA(4) = G12(I)                                                 
         CA(5) = G23(I)                                                 
         CA(6) = G13(I)                                                 
         IF (THET(I) .EQ. 0.) THEN                                      
            CL(1,3) = 0.0                                               
            CL(2,3) = 0.                                                
            CL(3,1) = 0.                                                
            CL(3,2) = 0.                                                
            CL(3,3) = 0.                                                
            CLS(1,2) = 0.                                               
            CLS(2,1) = 0.                                               
            CL(1,1) = CA(1)                                             
            CL(1,2) = CA(2)                                             
            CL(2,1) = CA(2)                                             
            CL(2,2) = CA(3)                                             
            CL(3,3) = CA(4)                                             
            CLS(1,1) = CA(6)                                            
            CLS(2,2) = CA(5)                                            
         ELSE                                                           
            CALL TRANF                                                  
         ENDIF                                                          
         HB = HT - HZ(I)                                                
         AAR = HT - HB                                                  
         ACR = (HT*HT - HB*HB)*0.5                                      
         AIN = (HT*HT*HT - HB*HB*HB)/3.                                 
         DO 25 IR = 1, 3                                                
            IZ  = IR + 3                                                
            DO 25 JR = 1, 3                                             
               JZ  = JR + 3                                             
               C(IR,JR) = C(IR,JR) + AAR*CL(IR,JR)                      
               C(IR,JZ) = C(IR,JZ) + ACR*CL(IR,JR)                      
               C(IZ,JR) = C(IZ,JR) + ACR*CL(IR,JR)                      
               C(IZ,JZ) = C(IZ,JZ) + AIN*CL(IR,JR)                      
  25     CONTINUE                                                       
         DO 30 IR = 1, 2                                                
            IZS = IR + 6                                                
            DO 30 JR = 1, 2                                             
               JZS = JR + 6                                             
               C(IZS,JZS) = C(IZS,JZS) + AAR*CLS(IR,JR)                 
  30     CONTINUE                                                       
         HT = HB                                                        
  40  CONTINUE                                                          
CX20532 CALL DOOUTX( 532 )                                              
CY20532 CALL DOOUTY( 532 )                                              
      CALL MATINV(8, 8, C, 0, 0, 0, DETERM, ISCALE, IPIVOT, IWK)        
CCC   PRINT 61, DETERM, ISCALE                                          
  61  FORMAT('0COMPLIANCE MATRIX DETERM = ',E13.5,', ISCALE = ',I5)     
      IF (DETERM .EQ. 0.) CALL ERRORS(' COMPLIANCE MATRIX IS SINGULAR') 
CX40024 CALL SBOUTX (24)                                                
CY40024 CALL SBOUTY (24)                                                
      RETURN                                                            
      END                                                               
*DECK                                            COPYV                  
      SUBROUTINE COPYV(A, B, M)                                         
C********************************************************************** 
C     COPY ONE VECTOR INTO ANOTHER VECTOR                               
C********************************************************************** 
      DIMENSION A(M), B(M)                                              
CX30025 CALL SBINX (25)                                                 
CY30025 CALL SBINY (25)                                                 
CX10533 CALL DOINX( 533 )                                               
CY10533 CALL DOINY( 533 )                                               
      DO 100 I = 1, M                                                   
           B(I) = A(I)                                                  
 100  CONTINUE                                                          
CX20534 CALL DOOUTX( 534 )                                              
CY20534 CALL DOOUTY( 534 )                                              
CX40026 CALL SBOUTX (26)                                                
CY40026 CALL SBOUTY (26)                                                
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            DRASSM                 
      SUBROUTINE DRASSM                                                 
C********************************************************************** 
C     ASSEMBLE THE MASS MATRIX BLOCKS INTO M0 AND MA                    
C                                                                       
C                                                                       
C                      [M11          M1B]                               
C     MASS MATRIX =    [    M22      M2B]      N = # OF SUBSTRUCTURES   
C                      [        MNN  MNB]                               
C                      [ SYMM.       MBB]                               
C                                                                       
C     M0 BLOCKS ARE  M11, M22, ... MNN, MBB                             
C                                                                       
C     MA BLOCKS ARE  M1B, M2B, ... MNB                                  
C                                                                       
C                                                                       
C     AND ASSEMBLE THE LOAD VECTOR                                      
C********************************************************************** 
C                                                                       
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK MBLOCK                                                         
C---------------                                                        
      REAL M0, MA                                                       
      COMMON /MBLOCK/ M0(ZNEQPB*ZNEQPB,ZNBLCK), MA(ZNEQPB*ZNEQPB,ZNSS)  
C                                                                       
C M0       - DIAGONAL BLOCKS OF THE ASSEMBLED MASS MATRIX               
C MA       - OFF DIAGONAL BLOCKS OF THE ASSEMBLED MASS MATRIX           
C                                                                       
*COMDECK ELMNTS                                                         
C---------------                                                        
      REAL ME, MNLE                                                     
      COMMON /ELMNTS/ FE(ZNUMF,ZNDE), SE(ZNUMS,ZNDE), ME(ZNUMM,ZNDE),   
     *                PE(ZNUMP,ZNE), MNLE(ZNUMNL,ZNDE), IDEDON(ZNDE)    
C                                                                       
C FE      - DISTINCT ELEMENTS OF [F]                                    
C SE      - DISTINCT ELEMENTS OF [S]                                    
C ME      - DISTINCT ELEMENTS OF [M]                                    
C PE      - ALL ELEMENT OF THE LOAD VECTOR                              
C MNLE    - DISTINCT ELEMENTS OF [MNL]                                  
C IDEDON  - 1 IF DISTINCT ELEMENT HAS BEEN FORMED.  0 IF NOT YET FORMED 
C                                                                       
*COMDECK LOADV                                                          
C--------------                                                         
      COMMON /LOADV/ P0(ZNEQD)                                          
C                                                                       
C P0      - GLOBAL LOAD VECTOR                                          
C                                                                       
*COMDECK EDESCR                                                         
C---------------                                                        
      COMMON /EDESCR/ IESMNO(ZNE), IEGEOM(ZNE), IECURV(ZNE)             
C                                                                       
C IESMNO  - DISTINCT ELEMENTAL STIFFNESS MATRIX NUMBERS                 
C IEGEOM  - ELEMENTAL GEOMETRY FLAGS (0=ARBITRARY, 1=RECTANGULAR)       
C IECURV  - ELEMENTAL CURVATURE FLAGS                                   
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
CX30027 CALL SBINX (27)                                                 
CY30027 CALL SBINY (27)                                                 
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
      WRITE(6,*) ' SUBROUTINE DRASSM '                                  
C                                                                       
C     . SET UP THE HYPERMATRIX BLOCK STRUCTURE .                        
      WRITE(6,*) ' SETHM '                                              
      CALL SETHM                                                        
C                                                                       
      NEQB = IBLEN(NBLOCK)                                              
      CALL ZEROV(M0(1,NBLOCK),NEQB*NEQB)                                
      ILOCB = PPTR(NBLOCK)                                              
      CALL ZEROV(P0(ILOCB),NEQB)                                        
CX10535 CALL DOINX( 535 )                                               
CY10535 CALL DOINY( 535 )                                               
C                                                                       
C     . LOOP OVER THE SUBSTRUCTURES .                                   
      DO 20 ISS = 1, NSS                                                
CCC      PRINT *, ' ISS ',ISS                                           
         NEQI = IBLEN(ISS)                                              
         ILOC = PPTR(ISS)                                               
         CALL ZEROV(M0(1,ISS), NEQI*NEQI)                               
         CALL ZEROV(MA(1,ISS), NEQI*NEQB)                               
         CALL ZEROV(P0(ILOC), NEQI)                                     
C        . LOOP OVER THE ELEMENTS WHICH LIE IN THIS SUBSTRUCTURE .      
         DO 10 K = 1, NEPSS(ISS)                                        
            ID = IDBEGS(ISS) - 1 + K                                    
            IDE = IESMNO(ID)                                            
CCC         PRINT *, ' ID = ',ID,' IDE = ',IDE                          
C           . ASSEMBLE ELEMENT INTO BLOCKS [MII], [MIB], [MBB] .        
CCC         PRINT *, ' ASSEMM '                                         
            CALL ASSEMM(ID, ME(1,IDE), M0(1,ISS), MA(1,ISS),            
     *                  M0(1,NBLOCK), NEQI, NEQB)                       
C                                                                       
C           . ASSEMBLE THE LOAD VECTOR ELEMENT INTO BLOCKS (P0I), (P0B) 
CCC         PRINT *, ' ASSEMR '                                         
            CALL ASSEMR(ID, PE(1,ID), P0(ILOC), P0(ILOCB))              
  10     CONTINUE                                                       
  20  CONTINUE                                                          
CX20536 CALL DOOUTX( 536 )                                              
CY20536 CALL DOOUTY( 536 )                                              
C                                                                       
C     . OUTPUT THE LOAD VECTOR .                                        
CCC   WRITE (9,30) (I,(P0((I-1)*NDDF+J),J=1,NDDF),I=1,NND)              
  30  FORMAT(//' THE GLOBAL LOAD VECTOR AFTER ASSEMBLY IS '/            
     .       1X,'NODE',12X,'U',12X,'V',12X,'W',10X,'PH1',10X,'PH2'/     
     .       (I5,5E13.6))                                               
CX40028 CALL SBOUTX (28)                                                
CY40028 CALL SBOUTY (28)                                                
C                                                                       
C     . PRINT THE M0 BLOCKS .                                           
C      DO 40 I = 1, NBLOCK                                              
CCC      WRITE(9,*) ' M0 DIAGONAL BLOCK ',I,' : '                       
C         NRB = IBLEN(I)                                                
CCC      CALL OTMATX(M0(1,I), NRB, NRB, NRB, 10, 7, ' ')                
C  40  CONTINUE                                                         
C                                                                       
C     . PRINT THE MA BLOCKS .                                           
C      NCB = IBLEN(NBLOCK)                                              
C      DO 50 I = 1, NBLOCK-1                                            
CCC      WRITE(9,*) ' MA BLOCK ',I,' : '                                
C         NRB = IBLEN(I)                                                
CCC      CALL OTMATX(MA(1,I), NRB, NRB, NCB, 10, 7, ' ')                
C  50  CONTINUE                                                         
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            DRBC                   
      SUBROUTINE DRBC                                                   
C********************************************************************** 
C APPLY THE BOUNDARY CONDITIONS TO THE DIAGONAL BLOCKS OF THE MASS      
C  MATRIX AND ADD CONCENTRATED LOADINGS INTO THE LOAD VECTOR            
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
*COMDECK MBLOCK                                                         
C---------------                                                        
      REAL M0, MA                                                       
      COMMON /MBLOCK/ M0(ZNEQPB*ZNEQPB,ZNBLCK), MA(ZNEQPB*ZNEQPB,ZNSS)  
C                                                                       
C M0       - DIAGONAL BLOCKS OF THE ASSEMBLED MASS MATRIX               
C MA       - OFF DIAGONAL BLOCKS OF THE ASSEMBLED MASS MATRIX           
C                                                                       
*COMDECK LOADV                                                          
C--------------                                                         
      COMMON /LOADV/ P0(ZNEQD)                                          
C                                                                       
C P0      - GLOBAL LOAD VECTOR                                          
C                                                                       
*COMDECK BCD                                                            
C---------------                                                        
      COMMON /BCD/ NBCN(ZNBN), ALPHBC(ZNBN), IFLAGD(5,ZNBN),            
     *             BCVALD(5,ZNBN)                                       
C                                                                       
C NBCN    - BOUNDARY CONDITION NODE NUMBERS                             
C ALPHBC  - BOUNDARY CONDITION NODE ROTATION ANGLES (DEGREES) *NOTUSED* 
C IFLAGD  - NODAL DISPL. DEGREE OF FREEDOM FLAGS                        
C           (                       0 MEANS THE D.O.F. IS FREE          
C                                   1 MEANS THE D.O.F. IS PRESCRIBED)   
C BCVALD  - DISPL. PRESCRIBED VALUES  *NOTUSED*                         
C                                                                       
C                                                                       
      DATA BIGNO /1.E20/                                                
C BIGNO  - BIG NUMBER USED IN APPLYING THE DISPL. BOUNDARY CONDITIONS   
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CX30029 CALL SBINX (29)                                                 
CY30029 CALL SBINY (29)                                                 
CX10537 CALL DOINX( 537 )                                               
CY10537 CALL DOINY( 537 )                                               
CCC   PRINT *, ' SUBROUTINE DRBC '                                      
                                                                        
C     . LOOP OVER THE BLOCKS .                                          
      DO 10 IBLOCK = 1, NBLOCK                                          
CCC      PRINT *, ' IBLOCK ',IBLOCK                                     
         IBEG = IBCPTR(IBLOCK)                                          
C        . APPLY BOUNDARY CONDITIONS TO DIAGONAL BLOCKS .               
CCC      PRINT *, ' CALL ABC '                                          
         CALL ABC(M0(1,IBLOCK), BIGNO, IBLEN(IBLOCK),                   
     *            NBNPB(IBLOCK), NBCN(IBEG), IFLAGD(1,IBEG),            
     *            BCVALD(1,IBEG))                                       
C                                                                       
C        . ADD CONCENTRATED LOADINGS TO P0 BLOCK .                      
         ILOC = PPTR(IBLOCK)                                            
CCC      PRINT *, ' CALL ADDCON '                                       
         CALL ADDCON(IBLOCK, P0(ILOC))                                  
  10  CONTINUE                                                          
CX20538 CALL DOOUTX( 538 )                                              
CY20538 CALL DOOUTY( 538 )                                              
C                                                                       
C     . OUTPUT THE LOAD VECTOR .                                        
      WRITE (9,30) (I,(P0((I-1)*NDDF+J),J=1,NDDF),I=1,NND)              
  30  FORMAT(//' THE GLOBAL LOAD VECTOR IS '/                           
     .       1X,'NODE',12X,'U',12X,'V',12X,'W',10X,'PH1',10X,'PH2'/     
     .       (I5,5E13.6))                                               
CX40030 CALL SBOUTX (30)                                                
CY40030 CALL SBOUTY (30)                                                
C                                                                       
C     . PRINT THE M0 BLOCKS .                                           
C      DO 40 I = 1, NBLOCK                                              
CCC      WRITE(9,*) ' M0 DIAGONAL BLOCK ',I,' AFTER B.C.: '             
C         NRB = IBLEN(I)                                                
CCC      CALL OTMATX(M0(1,I), NRB, NRB, NRB, 10, 7, ' ')                
C  40  CONTINUE                                                         
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            DRELMN                 
      SUBROUTINE DRELMN                                                 
C********************************************************************** 
C     DRIVER FOR FORMING THE ELEMENTS                                   
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK MASSC                                                          
C---------------                                                        
      REAL M0, M1, M2                                                   
      COMMON /MASSC/ RHO(5,5), M0, M1, M2                               
C                                                                       
C RHO     - MASS STRESS STRAIN MATRIX                                   
C                                                                       
*COMDECK EDESCR                                                         
C---------------                                                        
      COMMON /EDESCR/ IESMNO(ZNE), IEGEOM(ZNE), IECURV(ZNE)             
C                                                                       
C IESMNO  - DISTINCT ELEMENTAL STIFFNESS MATRIX NUMBERS                 
C IEGEOM  - ELEMENTAL GEOMETRY FLAGS (0=ARBITRARY, 1=RECTANGULAR)       
C IECURV  - ELEMENTAL CURVATURE FLAGS                                   
C                                                                       
*COMDECK COMPLZ                                                         
C---------------                                                        
      COMMON /COMPLZ/ C(8,8)                                            
C                                                                       
C [C]     - COMPLIANCE MATRIX                                           
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK ELMNTS                                                         
C---------------                                                        
      REAL ME, MNLE                                                     
      COMMON /ELMNTS/ FE(ZNUMF,ZNDE), SE(ZNUMS,ZNDE), ME(ZNUMM,ZNDE),   
     *                PE(ZNUMP,ZNE), MNLE(ZNUMNL,ZNDE), IDEDON(ZNDE)    
CX30031 CALL SBINX (31)                                                 
CY30031 CALL SBINY (31)                                                 
C                                                                       
C FE      - DISTINCT ELEMENTS OF [F]                                    
C SE      - DISTINCT ELEMENTS OF [S]                                    
C ME      - DISTINCT ELEMENTS OF [M]                                    
C PE      - ALL ELEMENT OF THE LOAD VECTOR                              
C MNLE    - DISTINCT ELEMENTS OF [MNL]                                  
C IDEDON  - 1 IF DISTINCT ELEMENT HAS BEEN FORMED.  0 IF NOT YET FORMED 
C                                                                       
      WRITE(6,*) ' SUBROUTINE DRELMN '                                  
C                                                                       
C EVALUATE THE SHAPE FUNCTIONS (THEY ARE THE SAME FOR ALL ELEMENTS).    
C                                                                       
      ISTRES = 0                                                        
C     . NQD,NNPED,NNPES ==> SHAPE ==> N,NB,NDXI,NDETA .                 
      WRITE(6,*) ' SHAPE '                                              
      CALL SHAPE                                                        
C                                                                       
C EVALWRITE THE COMPLIANCE MATRIX (SAME FOR ALL ELEMENTS) ONCE.         
C                                                                       
      WRITE(6,*) ' COMPL '                                              
      CALL COMPL                                                        
      WRITE (9,12) C                                                    
  12  FORMAT('0COMPLIANCE MATRIX IS'/ 8(1X, 8E13.6/))                   
C                                                                       
C EVALUATE THE MASS STRAIN MATRIX                                       
C                                                                       
      WRITE(6,*) ' MASS '                                               
      CALL MASS                                                         
      WRITE(9,13) M0,M1,M2                                              
  13     FORMAT('0MASS CONSTANTS M0, M1, M2 ARE',3E13.6)                
CX10539 CALL DOINX( 539 )                                               
CY10539 CALL DOINY( 539 )                                               
C                                                                       
                                                                        
      DO 20 I = 1, NDE                                                  
         IDEDON(I) = 0                                                  
  20  CONTINUE                                                          
CX20540 CALL DOOUTX( 540 )                                              
CY20540 CALL DOOUTY( 540 )                                              
CX10541 CALL DOINX( 541 )                                               
CY10541 CALL DOINY( 541 )                                               
C                                                                       
C     . LOOP OVER THE SUBSTRUCTURES .                                   
      DO 35 ISS = 1, NSS                                                
CCC      PRINT *, ' ISS ',ISS                                           
C                                                                       
C        . LOOP OVER THE ELEMENTS IN THIS SUBSTRUCTURE .                
         DO 30 K = 1, NEPSS(ISS)                                        
C           . FORM THE ELEMENTAL ARRAYS .                               
            ID = IDBEGS(ISS) - 1 + K                                    
            IDE = IESMNO(ID)                                            
CCC         PRINT *,'ID = ',ID,' IDE = ',IDE, ' FSMP '                  
            CALL FSMP(ID, IDE)                                          
  30     CONTINUE                                                       
  35  CONTINUE                                                          
CX20542 CALL DOOUTX( 542 )                                              
CY20542 CALL DOOUTY( 542 )                                              
CX40032 CALL SBOUTX (32)                                                
CY40032 CALL SBOUTY (32)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            DRFACT                 
      SUBROUTINE DRFACT                                                 
C********************************************************************** 
C     DECOMPOSE THE DIAGONAL BLOCKS OF THE MASS MATRIX                  
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
*COMDECK MBLOCK                                                         
C---------------                                                        
      REAL M0, MA                                                       
      COMMON /MBLOCK/ M0(ZNEQPB*ZNEQPB,ZNBLCK), MA(ZNEQPB*ZNEQPB,ZNSS)  
CX30033 CALL SBINX (33)                                                 
CY30033 CALL SBINY (33)                                                 
CX10543 CALL DOINX( 543 )                                               
CY10543 CALL DOINY( 543 )                                               
C                                                                       
C M0       - DIAGONAL BLOCKS OF THE ASSEMBLED MASS MATRIX               
C MA       - OFF DIAGONAL BLOCKS OF THE ASSEMBLED MASS MATRIX           
C                                                                       
CCC   PRINT *, ' SUBROUTINE DRFACT '                                    
C                                                                       
      DO 5 IBLOCK = 1, NBLOCK                                           
CCC      PRINT *, ' IBLOCK ',IBLOCK                                     
         NRB = IBLEN(IBLOCK)                                            
         CALL CHOFAC(M0(1,IBLOCK), NRB, IERR)                           
         IF (IERR.NE.0) THEN                                            
            WRITE(6,*) ' MASS BLOCK ',IBLOCK,' IS SINGULAR '            
CX40034 CALL SBOUTX (34)                                                
CY40034 CALL SBOUTY (34)                                                
            STOP 'MASS SINGULAR '                                       
         ENDIF                                                          
   5  CONTINUE                                                          
CX20544 CALL DOOUTX( 544 )                                              
CY20544 CALL DOOUTY( 544 )                                              
CX40034 CALL SBOUTX (34)                                                
CY40034 CALL SBOUTY (34)                                                
C                                                                       
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            DRPOST                 
      SUBROUTINE DRPOST                                                 
C********************************************************************** 
C     POST PROCESS THE RESULTS                                          
C********************************************************************** 
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
CX30035 CALL SBINX (35)                                                 
CY30035 CALL SBINY (35)                                                 
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
C                                                                       
C     . COMPUTE THE KINETIC ENERGY .                                    
      CALL KNRGY                                                        
C                                                                       
C     . OUTPUT THE SOLUTION .                                           
      IF (MOD(ISTEP,IOUT).EQ.0) CALL SOLOUT                             
C                                                                       
C     . SAVE THE RESULTS .                                              
      IF (MOD(ISTEP,ISAVE).EQ.0) CALL SAVE                              
CX40036 CALL SBOUTX (36)                                                
CY40036 CALL SBOUTY (36)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            ERRORS                 
      SUBROUTINE ERRORS (MESAGE)                                        
      CHARACTER*(*) MESAGE                                              
C********************************************************************** 
C ERROR HANDLING ROUTINE.  PRINT MESSAGE, ABORT JOB.                    
C********************************************************************** 
CX30037 CALL SBINX (37)                                                 
CY30037 CALL SBINY (37)                                                 
      WRITE(6,10) MESAGE                                                
  10  FORMAT(1X,A)                                                      
CX40038 CALL SBOUTX (38)                                                
CY40038 CALL SBOUTY (38)                                                
      STOP ' ERRORS'                                                    
      END                                                               
                                                                        
*DECK                                            FORMF                  
      SUBROUTINE FORMF(F)                                               
C********************************************************************** 
C     FORM AN ELEMENT OF [F] COMPOSED OF THE STRESS-STRESS NODAL        
C     PARTITIONS. F IS SYMMETRIC.  THE (I,J) NODAL PARTITION            
C     IS THE INTEGRAL OF NB(I)*NB(J)*[C]                                
C                                                                       
C     INPUTS: NB, C, WTDET                                              
C     OUTPUT: F                                                         
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK COMPLZ                                                         
C---------------                                                        
      COMMON /COMPLZ/ C(8,8)                                            
C                                                                       
C [C]     - COMPLIANCE MATRIX                                           
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DIMENSION F(NSDF,NNPES,NSDF,NNPES), SNN(NSDF,NSDF)                
CX30039 CALL SBINX (39)                                                 
CY30039 CALL SBINY (39)                                                 
CX10545 CALL DOINX( 545 )                                               
CY10545 CALL DOINY( 545 )                                               
C                                                                       
      DO 45 J = 1, NNPES                                                
         DO 40 I = 1, J                                                 
C                                                                       
C SUM SOME QUANTITIES OVER THE QUADRATURE POINTS                        
C                                                                       
            SUMNN = 0.                                                  
            DO 10 IQ = 1, NQD                                           
               SUMNN = SUMNN + WTDET(IQ) * NB(IQ,I) * NB(IQ,J)          
  10        CONTINUE                                                    
C                                                                       
            DO 25 JDOF = 1, NSDF                                        
               DO 20 IDOF = 1, NSDF                                     
                  SNN(IDOF,JDOF) = SUMNN * C(IDOF,JDOF)                 
  20           CONTINUE                                                 
  25        CONTINUE                                                    
C                                                                       
C           . STORE NODAL PARITION .                                    
            DO 35 IDOF = 1, NSDF                                        
               DO 35 JDOF = 1, NSDF                                     
                  F(IDOF,I,JDOF,J) = SNN(IDOF,JDOF)                     
                  F(JDOF,J,IDOF,I) = SNN(IDOF,JDOF)                     
  35        CONTINUE                                                    
C                                                                       
  40     CONTINUE                                                       
  45  CONTINUE                                                          
CX20546 CALL DOOUTX( 546 )                                              
CY20546 CALL DOOUTY( 546 )                                              
CX40040 CALL SBOUTX (40)                                                
CY40040 CALL SBOUTY (40)                                                
C                                                                       
CCC   CALL OTMATX(F, NSFE, NSFE, NSFE, 10, 7, ' F :')                   
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            FORMM                  
      SUBROUTINE FORMM(M)                                               
C***********************************************************************
C     THIS SUBROUTINE FORMS THE SYMMETRIC ELEMENTAL MASS MATRIX.        
C                                                                       
C     EACH NODAL PARTITION (I,J) IS DIAGONAL AND IS THE INTEGRAL        
C     OF N(I)*N(J)*[RHO]                                                
C                                                                       
C     INPUTS: N, RHO, WTDET                                             
C     OUTPUT: M                                                         
C***********************************************************************
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK MASSC                                                          
C---------------                                                        
      REAL M0, M1, M2                                                   
      COMMON /MASSC/ RHO(5,5), M0, M1, M2                               
C                                                                       
C RHO     - MASS STRESS STRAIN MATRIX                                   
C                                                                       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      REAL M(NDDF,NNPED,NDDF,NNPED), SUU(NDDF,NDDF)                     
CX30041 CALL SBINX (41)                                                 
CY30041 CALL SBINY (41)                                                 
CX10547 CALL DOINX( 547 )                                               
CY10547 CALL DOINY( 547 )                                               
C                                                                       
C                                                                       
      DO 30 J = 1,NNPED                                                 
         DO 25 I = 1, J                                                 
            CALL ZEROV(SUU, NDDF*NDDF)                                  
C                                                                       
C           . SUM SOME QUANTITIES OVER THE QUADRATURE POINTS .          
            SUMNN = 0.                                                  
            DO 10 IQ = 1,NQD                                            
               SUMNN = SUMNN + WTDET(IQ)*N(IQ,I)*N(IQ,J)                
  10        CONTINUE                                                    
C                                                                       
            DO 15 JJ = 1, NDDF                                          
               SUU(JJ,JJ) = RHO(JJ,JJ)*SUMNN                            
  15        CONTINUE                                                    
C                                                                       
C           . STORE NODAL PARTITION .                                   
            DO 20 II = 1, NDDF                                          
            DO 20 JJ = 1, NDDF                                          
               M(II,I,JJ,J) = SUU(II,JJ)                                
               M(JJ,J,II,I) = SUU(II,JJ)                                
  20        CONTINUE                                                    
  25     CONTINUE                                                       
  30  CONTINUE                                                          
CX20548 CALL DOOUTX( 548 )                                              
CY20548 CALL DOOUTY( 548 )                                              
CX40042 CALL SBOUTX (42)                                                
CY40042 CALL SBOUTY (42)                                                
C                                                                       
CCC   CALL OTMATX(M, NDFE, NDFE, NDFE, 10, 7, ' M : ')                  
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            FORMNL                 
      SUBROUTINE FORMNL(MNL)                                            
C***********************************************************************
C     THIS SUBROUTINE FORMS THE NONLINEAR STRESS-DISPL.-DISPL. ELEMENT. 
C                                                                       
C     ONLY THE NONZERO NODAL PARTITIONS [1,3,3], [2,3,3], [3,3,3] ARE   
C     FORMED AND STORED.                                                
C                                                                       
C     INPUTS: NB, NDX, NDY, WTDET                                       
C     OUTPUT: MNL                                                       
C***********************************************************************
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      REAL MNL(NNPES,NNPED*(NNPED+1)/2,3)                               
CX30043 CALL SBINX (43)                                                 
CY30043 CALL SBINY (43)                                                 
C                                                                       
C     ************************************                              
C     * SPECIAL CASE LINEAR PROBLEM ONLY *                              
C     ************************************                              
      IF (KNONLN.EQ.0) THEN                                             
         CALL ZEROV(MNL, NNPES*NNPED*(NNPED+1)/2*3)                     
CX40044 CALL SBOUTX (44)                                                
CY40044 CALL SBOUTY (44)                                                
         RETURN                                                         
      ENDIF                                                             
CX10549 CALL DOINX( 549 )                                               
CY10549 CALL DOINY( 549 )                                               
                                                                        
      DO 50 I=1,NNPES                                                   
         JK = 0                                                         
         DO 45 J=1,NNPED                                                
            DO 40 K=1,J                                                 
               JK = JK + 1                                              
C                                                                       
C              . SUM SOME QUANTITIES OVER THE QUADRATURE LOOP .         
               SUMNXX = 0.                                              
               SUMNXY = 0.                                              
               SUMNYX = 0.                                              
               SUMNYY = 0.                                              
               DO 5 IQ=1,NQD                                            
                  SUMNXX= SUMNXX+WTDET(IQ)*NB(IQ,I)*NDX(IQ,J)*NDX(IQ,K) 
                  SUMNXY= SUMNXY+WTDET(IQ)*NB(IQ,I)*NDX(IQ,J)*NDY(IQ,K) 
                  SUMNYX= SUMNYX+WTDET(IQ)*NB(IQ,I)*NDY(IQ,J)*NDX(IQ,K) 
                  SUMNYY= SUMNYY+WTDET(IQ)*NB(IQ,I)*NDY(IQ,J)*NDY(IQ,K) 
  5            CONTINUE                                                 
C                                                                       
               MNL(I,JK,1) = SUMNXX                                     
               MNL(I,JK,2) = SUMNYY                                     
               MNL(I,JK,3) = SUMNXY+SUMNYX                              
  40        CONTINUE                                                    
  45     CONTINUE                                                       
  50  CONTINUE                                                          
CX20550 CALL DOOUTX( 550 )                                              
CY20550 CALL DOOUTY( 550 )                                              
CX40044 CALL SBOUTX (44)                                                
CY40044 CALL SBOUTY (44)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            FORMP                  
      SUBROUTINE FORMP(PE)                                              
C********************************************************************** 
C COMPUTE THE NODAL PARTITIONS OF THE LOAD VECTORS.                     
C                                                                       
C     INPUT: P, WTDET, N                                                
C     OUTPUT: PE                                                        
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK LOADZ                                                          
C---------------                                                        
      COMMON /LOADZ/ P(3,ZNNPED)                                        
C                                                                       
C [P]     - ELEMENTAL NODAL LOAD INTENSITIES                            
C                                                                       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DIMENSION PE(NDDF,NNPED), PU(NDDF)                                
CX30045 CALL SBINX (45)                                                 
CY30045 CALL SBINY (45)                                                 
CX10551 CALL DOINX( 551 )                                               
CY10551 CALL DOINY( 551 )                                               
C                                                                       
C DOUBLE LOOP ON THE NODAL PARTITIONS.                                  
C                                                                       
      DO 30 I = 1, NNPED                                                
C                                                                       
C ZERO OUT THE PARTITION.                                               
C                                                                       
        CALL ZEROV(PU, NDDF)                                            
        DO 20 J = 1, NNPED                                              
C                                                                       
C SUM SOME QUANTITIES OVER THE QUADRATURE POINTS.                       
C                                                                       
          SUMNN = 0.                                                    
          DO 10 IQ = 1, NQD                                             
            SUMNN = SUMNN + WTDET(IQ) * N(IQ,I) * N(IQ,J)               
  10      CONTINUE                                                      
C                                                                       
C FORM THE NODAL PARTITION.                                             
C                                                                       
          DO 15 K = 1, 3                                                
            PU(K) = PU(K) + P(K,J) * SUMNN                              
  15      CONTINUE                                                      
  20    CONTINUE                                                        
C                                                                       
C       . STORE NODAL PARTITION .                                       
        DO 25 K = 1, NDDF                                               
           PE(K,I) = PU(K)                                              
  25    CONTINUE                                                        
  30  CONTINUE                                                          
CX20552 CALL DOOUTX( 552 )                                              
CY20552 CALL DOOUTY( 552 )                                              
CX40046 CALL SBOUTX (46)                                                
CY40046 CALL SBOUTY (46)                                                
C                                                                       
CCC   CALL OTMATX(PE, 1, 1, NDFE, 10, 7, ' PE : ')                      
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            FORMR0                 
      SUBROUTINE FORMR0(R0)                                             
C********************************************************************** 
C     FORM R0 = P(T) - S.H - MNL.X.H                                    
C********************************************************************** 
      REAL R0(*)                                                        
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
*COMDECK LOADV                                                          
C--------------                                                         
      COMMON /LOADV/ P0(ZNEQD)                                          
C                                                                       
C P0      - GLOBAL LOAD VECTOR                                          
C                                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
CX30047 CALL SBINX (47)                                                 
CY30047 CALL SBINY (47)                                                 
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
CCC   PRINT *, ' SUBROUTINE FORMR0 '                                    
C                                                                       
C     . FIND THE LOAD FACTOR .                                          
CCC   PRINT *, ' CALL LDFACT '                                          
      CALL LDFACT(TIME, FACTOR)                                         
CCC   PRINT *, ' TIME = ',TIME,' FACTOR = ',FACTOR                      
C                                                                       
      ILOCB = PPTR(NBLOCK)                                              
      NEQB = IBLEN(NBLOCK)                                              
CX10553 CALL DOINX( 553 )                                               
CY10553 CALL DOINY( 553 )                                               
      DO 10 I = 1, NEQB                                                 
         R0(ILOCB+I-1) = FACTOR*P0(ILOCB+I-1)                           
  10  CONTINUE                                                          
CX20554 CALL DOOUTX( 554 )                                              
CY20554 CALL DOOUTY( 554 )                                              
CX10555 CALL DOINX( 555 )                                               
CY10555 CALL DOINY( 555 )                                               
C                                                                       
C     . LOOP OVER THE SUBSTRUCTURES .                                   
      DO 20 ISS = 1, NSS                                                
CCC      PRINT *, ' ISS ',ISS                                           
         ILOC = PPTR(ISS)                                               
         NEQI = IBLEN(ISS)                                              
C                                                                       
C        . INITIALIZE R0I BLOCK TO FACTOR*P0 .                          
         DO 15 I = 1, NEQI                                              
            R0(ILOC+I-1) = FACTOR*P0(ILOC+I-1)                          
  15     CONTINUE                                                       
C                                                                       
C        . FORM BLOCK R0I COMPLETELY ; AND PART OF R0B .                
CCC      PRINT *, ' CALL BLCKR0 '                                       
         CALL BLCKR0(ISS, R0(ILOC), R0(ILOCB), NEQI, NEQB)              
  20  CONTINUE                                                          
CX20556 CALL DOOUTX( 556 )                                              
CY20556 CALL DOOUTY( 556 )                                              
CX40048 CALL SBOUTX (48)                                                
CY40048 CALL SBOUTY (48)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            FRMR0E                 
      SUBROUTINE FRMR0E(S, MNL, H, X, R0)                               
C********************************************************************** 
C     FORM AN ELEMENT OF R0 = -S.H - MNL.X.H                            
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
      REAL S(*), MNL(*), H(*), X(*), R0(NDDF,NNPED)                     
      REAL SH(NDDF,ZNNPED), MX(ZNNPES*ZNNPED*3), MXH(ZNNPED)            
CX30049 CALL SBINX (49)                                                 
CY30049 CALL SBINY (49)                                                 
C                                                                       
CCC   PRINT *, ' SUBROUTINE FRMR0E '                                    
C                                                                       
C     S . H ==> SH                                                      
CCC   PRINT *, ' CALL MATMUT '                                          
      CALL MATMUT(S, H, SH, NDFE, NSFE, 1)                              
CCC   PRINT 1000, ' X IS ',(X(I),I=1,NDFE)                              
CCC   PRINT 1000, ' H IS ',(H(I),I=1,NSFE)                              
CCC   PRINT 1000, ' S*H IS ',((SH(I,J),I=1,NDDF),J=1,NNPED)             
1000  FORMAT(//1X,A/(3X,10E13.6))                                       
C                                                                       
C     MNL . X ==> MX                                                    
CCC   PRINT *, ' CALL MNLBYX '                                          
      CALL MNLBYX(MNL, X, MX)                                           
C                                                                       
C     MNL.X . H ==> MXH                                                 
CCC   PRINT *, ' CALL MNLX2H '                                          
      CALL MNLX2H(MX, H, MXH)                                           
CX10557 CALL DOINX( 557 )                                               
CY10557 CALL DOINY( 557 )                                               
CCC   PRINT 1000, ' MXH IS ',(MXH(I),I=1,NNPED)                         
C                                                                       
      DO 10 IDOF = 1, NDDF                                              
         DO 10 I = 1, NNPED                                             
            R0(IDOF,I) = -SH(IDOF,I)                                    
  10  CONTINUE                                                          
CX20558 CALL DOOUTX( 558 )                                              
CY20558 CALL DOOUTY( 558 )                                              
CX10559 CALL DOINX( 559 )                                               
CY10559 CALL DOINY( 559 )                                               
C                                                                       
      DO 20 I = 1, NNPED                                                
         R0(3,I) = R0(3,I) - MXH(I)                                     
  20  CONTINUE                                                          
CX20560 CALL DOOUTX( 560 )                                              
CY20560 CALL DOOUTY( 560 )                                              
CX40050 CALL SBOUTX (50)                                                
CY40050 CALL SBOUTY (50)                                                
CCC   PRINT 1000, ' R0 ELEMENT ',((R0(I,J),I=1,NDDF),J=1,NNPED)         
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            FORMS                  
      SUBROUTINE FORMS(S)                                               
C********************************************************************** 
C     FORM AN ELEMENT OF [S] COMPOSED OF THE STRESS-DISPLACEMENT NODAL  
C     PARTITIONS.                                                       
C                                                                       
C     INPUTS: NB, N, NDX, NDY, WTDET, K1, K2, K12                       
C     OUTPUTS: S                                                        
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK CURVEZ                                                         
C--------------                                                         
      REAL K1, K2, K12                                                  
      COMMON /CURVEZ/ K1, K2, K12                                       
C                                                                       
C K1,K2,K12 - CURVATURES FOR A PARTICULAR ELEMENT                       
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DIMENSION S(NSDF,NNPES,NDDF,NNPED), SNU(NSDF,NDDF)                
CX30051 CALL SBINX (51)                                                 
CY30051 CALL SBINY (51)                                                 
CX10561 CALL DOINX( 561 )                                               
CY10561 CALL DOINY( 561 )                                               
C                                                                       
      DO 80 J = 1, NNPED                                                
         DO 60 I = 1, NNPES                                             
C                                                                       
C           . SUM SOME QUANTITIES OVER THE QUADRATURE POINTS .          
            SUMNN = 0.                                                  
            SUMNNX = 0.                                                 
            SUMNNY = 0.                                                 
            DO 30 IQ = 1, NQD                                           
              SUMNN  = SUMNN  + WTDET(IQ) * NB(IQ,I) * N  (IQ,J)        
              SUMNNX = SUMNNX + WTDET(IQ) * NB(IQ,I) * NDX(IQ,J)        
              SUMNNY = SUMNNY + WTDET(IQ) * NB(IQ,I) * NDY(IQ,J)        
 30         CONTINUE                                                    
C                                                                       
            CALL ZEROV(SNU, NSDF*NDDF)                                  
            SNU(1,1) = SUMNNX                                           
            SNU(1,3) = K1 * SUMNN                                       
            SNU(2,2) = SUMNNY                                           
            SNU(2,3) = K2 * SUMNN                                       
            SNU(3,1) = SUMNNY                                           
            SNU(3,2) = SUMNNX                                           
            SNU(3,3) = (K12 + K12) * SUMNN                              
            SNU(4,4) = SUMNNX                                           
            SNU(5,5) = SUMNNY                                           
            SNU(6,4) = SUMNNY                                           
            SNU(6,5) = SUMNNX                                           
            SNU(7,3) = SUMNNX                                           
            SNU(7,4) = SUMNN                                            
            SNU(8,3) = SUMNNY                                           
            SNU(8,5) = SUMNN                                            
C                                                                       
C           . STORE NODAL PARITION .                                    
            DO 35 IDOF = 1, NSDF                                        
               DO 35 JDOF = 1, NDDF                                     
                  S(IDOF,I,JDOF,J) = SNU(IDOF,JDOF)                     
  35        CONTINUE                                                    
  60      CONTINUE                                                      
  80   CONTINUE                                                         
CX20562 CALL DOOUTX( 562 )                                              
CY20562 CALL DOOUTY( 562 )                                              
CX40052 CALL SBOUTX (52)                                                
CY40052 CALL SBOUTY (52)                                                
C                                                                       
CCC   CALL OTMATX(S, NSFE, NSFE, NDFE, 10, 7, ' S : ')                  
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            FSMP                   
      SUBROUTINE FSMP(ID, IDE)                                          
C********************************************************************** 
C     ID = ELEMENT NUMBER                                               
C     IDE = DISTINCT ELEMENT NUMBER                                     
C                                                                       
C     FORM [F], [S], [M], [MNL] FOR "IDE"                               
C        AND FORM (P) FOR "ID"                                          
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK ELMNTS                                                         
C---------------                                                        
      REAL ME, MNLE                                                     
      COMMON /ELMNTS/ FE(ZNUMF,ZNDE), SE(ZNUMS,ZNDE), ME(ZNUMM,ZNDE),   
     *                PE(ZNUMP,ZNE), MNLE(ZNUMNL,ZNDE), IDEDON(ZNDE)    
C                                                                       
C FE      - DISTINCT ELEMENTS OF [F]                                    
C SE      - DISTINCT ELEMENTS OF [S]                                    
C ME      - DISTINCT ELEMENTS OF [M]                                    
C PE      - ALL ELEMENT OF THE LOAD VECTOR                              
C MNLE    - DISTINCT ELEMENTS OF [MNL]                                  
C IDEDON  - 1 IF DISTINCT ELEMENT HAS BEEN FORMED.  0 IF NOT YET FORMED 
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK MASSC                                                          
C---------------                                                        
      REAL M0, M1, M2                                                   
      COMMON /MASSC/ RHO(5,5), M0, M1, M2                               
C                                                                       
C RHO     - MASS STRESS STRAIN MATRIX                                   
C                                                                       
*COMDECK EDESCR                                                         
C---------------                                                        
      COMMON /EDESCR/ IESMNO(ZNE), IEGEOM(ZNE), IECURV(ZNE)             
C                                                                       
C IESMNO  - DISTINCT ELEMENTAL STIFFNESS MATRIX NUMBERS                 
C IEGEOM  - ELEMENTAL GEOMETRY FLAGS (0=ARBITRARY, 1=RECTANGULAR)       
C IECURV  - ELEMENTAL CURVATURE FLAGS                                   
C                                                                       
*COMDECK LOADZ                                                          
C---------------                                                        
      COMMON /LOADZ/ P(3,ZNNPED)                                        
C                                                                       
C [P]     - ELEMENTAL NODAL LOAD INTENSITIES                            
C                                                                       
*COMDECK COMPLZ                                                         
C---------------                                                        
      COMMON /COMPLZ/ C(8,8)                                            
C                                                                       
C [C]     - COMPLIANCE MATRIX                                           
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
*COMDECK CURVE                                                          
C---------------                                                        
      COMMON /CURVE/ AK1(2), AK2(2), AK12(2)                            
C                                                                       
C AK1(NCT), AK2(NCT), AK12(NCT) - CURVATURES                            
C                                                                       
*COMDECK CURVEZ                                                         
C--------------                                                         
      REAL K1, K2, K12                                                  
      COMMON /CURVEZ/ K1, K2, K12                                       
CX30053 CALL SBINX (53)                                                 
CY30053 CALL SBINY (53)                                                 
C                                                                       
C K1,K2,K12 - CURVATURES FOR A PARTICULAR ELEMENT                       
C                                                                       
CCC   PRINT *,' SUBROUTINE FSMP '                                       
C                                                                       
C EXTRACT THE COORDINATES OF THE ELEMENT                                
C                                                                       
C     . ID ==> GETCR ==> XY IN /ECOORD/ .                               
CCC   PRINT *, ' GETCR '                                                
      CALL GETCR(ID)                                                    
C                                                                       
C FETCH THE ELEMENTAL GEOMTRY TYPE AND CURVATURES                       
C                                                                       
C     . IRECT PLACED IN /INFO/ .                                        
      IRECT = IEGEOM(ID)                                                
      ICT   = IECURV(ID)                                                
C     . K1,K2,K12 PLACED IN /CURVEZ/ .                                  
      K1    = AK1(ICT)                                                  
      K2    = AK2(ICT)                                                  
      K12   = AK12(ICT)                                                 
C                                                                       
C EVALUATE THE DERIVATIVES OF THE SHAPE FUNCTIONS.                      
C                                                                       
C     . IRECT,ISTRES,XY,NDXI,NDETA,NQD,NNPED ==>SHAPE1==> NDX,NDY,WTDET 
      ISTRES = 0                                                        
CCC   PRINT *, ' SHAPE1 '                                               
      CALL SHAPE1                                                       
C                                                                       
      IF (IDEDON(IDE).EQ.0) THEN                                        
C        . THIS DISTINCT ELEMENT HAS NOT YET BEEN FORMED SO WE WILL     
C          GO AHEAD AND FORM IT NOW .                                   
         IDEDON(IDE) = 1                                                
C                                                                       
C FORM THE LINEAR ELEMENTAL STIFFNESS MATRICES                          
C                                                                       
C        . NB, C, WTDET ==> FORMF ==> FE .                              
CCC      PRINT *, ' FORMF '                                             
         CALL FORMF(FE(1,IDE))                                          
C                                                                       
C        . DECOMPOSE F .                                                
CCC      PRINT *, ' DECOMPOSE F '                                       
         CALL CHOFAC(FE(1,IDE), NSFE, IERR)                             
         IF (IERR.NE.0) THEN                                            
            WRITE(6,*) ' F ELEMENT ',IDE,' IS SINGULAR '                
CX40054 CALL SBOUTX (54)                                                
CY40054 CALL SBOUTY (54)                                                
            STOP ' F SINGULAR '                                         
         ENDIF                                                          
C                                                                       
C        . NB, N, NDX, NDY, WTDET, K1, K2, K12 ==> FORMS ==> SE .       
CCC      PRINT *, ' FORMS '                                             
         CALL FORMS(SE(1,IDE))                                          
C                                                                       
C FORM THE ELEMENTAL MASS MATRIX                                        
C                                                                       
C        . N, RHO, WTDET ==> FORMM ==> ME .                             
CCC      PRINT *, ' FORMM '                                             
         CALL FORMM(ME(1,IDE))                                          
C                                                                       
C FORM THE NONLINEAR ELEMENTAL STIFFNESS MATRIX                         
C                                                                       
C        . NB, NDX, NDY, WTDET ==> FORMNL ==> MNLE .                    
CCC      PRINT *, ' FORMNL'                                             
         CALL FORMNL(MNLE(1,IDE))                                       
      ENDIF                                                             
C                                                                       
C FORM THE LINEAR ELEMENTAL LOAD VECTOR                                 
C                                                                       
C     . ID ==> GETLD ==> P IN /LOADZ/ .                                 
CCC   PRINT *, ' GETLD'                                                 
      CALL GETLD(ID)                                                    
C     . P, WTDET, N ==> FORMP ==> PE .                                  
CCC   PRINT *, ' FORMP'                                                 
      CALL FORMP(PE(1,ID))                                              
CX40054 CALL SBOUTX (54)                                                
CY40054 CALL SBOUTY (54)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            GETCR                  
      SUBROUTINE GETCR(K)                                               
C********************************************************************** 
C EXTRACT THE COORDINATES FOR THE ELEMENT.                              
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK CONN                                                           
C---------------                                                        
      COMMON /CONN/ ICONS(ZNNPES,ZNE), ICOND(ZNNPED,ZNE)                
C                                                                       
C ICONS   - STRESS ELEMENTAL CONNECTIVITY VECTORS                       
C ICOND   - DISPL. ELEMENTAL CONNECTIVITY VECTORS                       
*COMDECK COORD                                                          
C---------------                                                        
      COMMON /COORD/ XYG(2,ZNND)                                        
C                                                                       
C XYG     - NODAL GLOBAL COORDINATES                                    
C                                                                       
*COMDECK ECOORD                                                         
C---------------                                                        
      COMMON /ECOORD/ XY(2,ZNNPED)                                      
C                                                                       
C [XY]    - ELEMENTAL NODAL COORDINATES                                 
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      DATA PI /3.14159265358979/                                        
CX30055 CALL SBINX (55)                                                 
CY30055 CALL SBINY (55)                                                 
      IF (NSYMM.EQ.0) GO TO 100                                         
      IF (NSYMM.EQ.1) GO TO 300                                         
C                                                                       
 100  CONTINUE                                                          
CX10563 CALL DOINX( 563 )                                               
CY10563 CALL DOINY( 563 )                                               
      DO 200 I = 1, NNPED                                               
         J = ICOND(I,K)                                                 
         XY(1,I) = XYG(1,J)                                             
         XY(2,I) = XYG(2,J)                                             
 200  CONTINUE                                                          
CX20564 CALL DOOUTX( 564 )                                              
CY20564 CALL DOOUTY( 564 )                                              
CX40056 CALL SBOUTX (56)                                                
CY40056 CALL SBOUTY (56)                                                
C                                                                       
      RETURN                                                            
C                                                                       
 300  CONTINUE                                                          
CX10565 CALL DOINX( 565 )                                               
CY10565 CALL DOINY( 565 )                                               
C     . INVERSION SYMMETRIES .                                          
      DO 400 I = 1, NNPED                                               
          L = ICOND(I,K)                                                
          J = ABS(L)                                                    
          XY(1,I) = XYG(1,J)                                            
          XY(2,I) = XYG(2,J)                                            
          IF (L.LT.0) THEN                                              
             XY(1,I) = -XY(1,I)                                         
             XY(2,I) = -XY(2,I)                                         
          ENDIF                                                         
 400  CONTINUE                                                          
CX20566 CALL DOOUTX( 566 )                                              
CY20566 CALL DOOUTY( 566 )                                              
CX40056 CALL SBOUTX (56)                                                
CY40056 CALL SBOUTY (56)                                                
      RETURN                                                            
      END                                                               
*DECK                                            GETEU                  
      SUBROUTINE GETEU(K,XE,XGLOBL)                                     
C                                                                       
C***********************************************************************
C                                                                       
C     GET THE ELEMENTAL DISPL. FROM THE GLOBAL SOLUTION VECTOR          
C                                                                       
C***********************************************************************
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK CONN                                                           
C---------------                                                        
      COMMON /CONN/ ICONS(ZNNPES,ZNE), ICOND(ZNNPED,ZNE)                
C                                                                       
C ICONS   - STRESS ELEMENTAL CONNECTIVITY VECTORS                       
C ICOND   - DISPL. ELEMENTAL CONNECTIVITY VECTORS                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      DIMENSION XE(NDDF,NNPED), XGLOBL(NDDF,NND)                        
CX30057 CALL SBINX (57)                                                 
CY30057 CALL SBINY (57)                                                 
C                                                                       
      IF (NSYMM.EQ.0) GO TO 1                                           
      IF (NSYMM.EQ.1) GO TO 25                                          
C                                                                       
   1  CONTINUE                                                          
CX10567 CALL DOINX( 567 )                                               
CY10567 CALL DOINY( 567 )                                               
      DO 20 I=1,NNPED                                                   
         NODE = ICOND(I,K)                                              
         DO 15 IDOF=1,NDDF                                              
            XE(IDOF,I) = XGLOBL(IDOF,NODE)                              
  15     CONTINUE                                                       
  20  CONTINUE                                                          
CX20568 CALL DOOUTX( 568 )                                              
CY20568 CALL DOOUTY( 568 )                                              
CX40058 CALL SBOUTX (58)                                                
CY40058 CALL SBOUTY (58)                                                
C                                                                       
      RETURN                                                            
C                                                                       
  25  CONTINUE                                                          
CX10569 CALL DOINX( 569 )                                               
CY10569 CALL DOINY( 569 )                                               
C     . INVERSION SYMMETRIES .                                          
      DO 55 I = 1, NNPED                                                
         NODE = ICOND(I,K)                                              
         NODEA = ABS(NODE)                                              
         IF (NODE.LT.0) THEN                                            
            DO 45 IDOF=1,NDDF                                           
               XE(IDOF,I) = XGLOBL(IDOF,NODEA)*GX(IDOF)                 
  45        CONTINUE                                                    
         ENDIF                                                          
  55  CONTINUE                                                          
CX20570 CALL DOOUTX( 570 )                                              
CY20570 CALL DOOUTY( 570 )                                              
CX40058 CALL SBOUTX (58)                                                
CY40058 CALL SBOUTY (58)                                                
      RETURN                                                            
      END                                                               
*DECK                                            GETLD                  
      SUBROUTINE GETLD(K)                                               
C********************************************************************** 
C EXTRACT THE ELEMENTAL NODAL LOAD INTENSITIES.                         
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK CONN                                                           
C---------------                                                        
      COMMON /CONN/ ICONS(ZNNPES,ZNE), ICOND(ZNNPED,ZNE)                
C                                                                       
C ICONS   - STRESS ELEMENTAL CONNECTIVITY VECTORS                       
C ICOND   - DISPL. ELEMENTAL CONNECTIVITY VECTORS                       
*COMDECK LOADD                                                          
C---------------                                                        
      COMMON /LOADD/ PXYZ(3,ZNND),                                      
     *               NCONC, NODCON(ZNCONC), PCONC(3,ZNCONC)             
C                                                                       
C PXYZ    - GLOBAL NODAL LOADS                                          
C NODCON,PCONC - CONCENTRATED LOAD DATA                                 
C                                                                       
C            APPLY CONCENTRATED LOADINGS OF PCONC(1,I),                 
C            PCONC(2,I), AND PCONC(3,I) TO NODE NUMBER NODCON(I)        
C                                                                       
*COMDECK LOADZ                                                          
C---------------                                                        
      COMMON /LOADZ/ P(3,ZNNPED)                                        
C                                                                       
C [P]     - ELEMENTAL NODAL LOAD INTENSITIES                            
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
CX30059 CALL SBINX (59)                                                 
CY30059 CALL SBINY (59)                                                 
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      IF (NSYMM.EQ.0) GO TO 50                                          
      IF (NSYMM.EQ.1) GO TO 300                                         
C                                                                       
  50  CONTINUE                                                          
CX10571 CALL DOINX( 571 )                                               
CY10571 CALL DOINY( 571 )                                               
      DO 200 I = 1, NNPED                                               
         J = ICOND(I,K)                                                 
         DO 100 L = 1, 3                                                
            P(L,I) = PXYZ(L,J)                                          
 100     CONTINUE                                                       
 200  CONTINUE                                                          
CX20572 CALL DOOUTX( 572 )                                              
CY20572 CALL DOOUTY( 572 )                                              
CX40060 CALL SBOUTX (60)                                                
CY40060 CALL SBOUTY (60)                                                
      RETURN                                                            
C                                                                       
 300  CONTINUE                                                          
CX10573 CALL DOINX( 573 )                                               
CY10573 CALL DOINY( 573 )                                               
C     . INVERSION SYMMETRIES .                                          
      DO 500 I = 1, NNPED                                               
         L = ICOND(I,K)                                                 
         J = ABS(L)                                                     
         P(1,I) = PXYZ(1,J)                                             
         P(2,I) = PXYZ(2,J)                                             
         P(3,I) = PXYZ(3,J)                                             
         IF (L.LT.0) THEN                                               
             P(1,I) = P(1,I) * GX(1)                                    
             P(2,I) = P(2,I) * GX(2)                                    
             P(3,I) = P(3,I) * GX(3)                                    
          ENDIF                                                         
  500 CONTINUE                                                          
CX20574 CALL DOOUTX( 574 )                                              
CY20574 CALL DOOUTY( 574 )                                              
CX40060 CALL SBOUTX (60)                                                
CY40060 CALL SBOUTY (60)                                                
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            GETSUU                 
      SUBROUTINE GETSUU(SUU, ID, IN, JN, ME)                            
C********************************************************************** 
C     GET THE MASS MATRIX (IN,JN) NODAL PARITION FOR ELEMENT "ID"       
C       AND APPLY INVERSION SYMMETRIES IF NECESSARY                     
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK CONN                                                           
C---------------                                                        
      COMMON /CONN/ ICONS(ZNNPES,ZNE), ICOND(ZNNPED,ZNE)                
C                                                                       
C ICONS   - STRESS ELEMENTAL CONNECTIVITY VECTORS                       
C ICOND   - DISPL. ELEMENTAL CONNECTIVITY VECTORS                       
      REAL ME(NDDF,NNPED,NDDF,NNPED)                                    
      DIMENSION SUU(NDDF,NDDF)                                          
CX30061 CALL SBINX (61)                                                 
CY30061 CALL SBINY (61)                                                 
CX10575 CALL DOINX( 575 )                                               
CY10575 CALL DOINY( 575 )                                               
C                                                                       
      DO 5 I = 1, NDDF                                                  
         DO 5 J = 1, NDDF                                               
            SUU(I,J) = ME(I,IN,J,JN)                                    
   5  CONTINUE                                                          
CX20576 CALL DOOUTX( 576 )                                              
CY20576 CALL DOOUTY( 576 )                                              
CCC   PRINT *, IN,JN,SUU                                                
C                                                                       
C APPLY INVERSION SYMMETRIES (NSYMM=1)                                  
C                                                                       
C     ... EXIT NO SYMMETRIES                                            
      IF (NSYMM.EQ.0) THEN                                              
CX40062 CALL SBOUTX (62)                                                
CY40062 CALL SBOUTY (62)                                                
      RETURN                                                            
      ENDIF                                                             
C                                                                       
      INODE = ICOND(IN,ID)                                              
      JNODE = ICOND(JN,ID)                                              
      IF (INODE.LT.0) THEN                                              
CX10577 CALL DOINX( 577 )                                               
CY10577 CALL DOINY( 577 )                                               
         DO 10 I = 1, NDDF                                              
            DO 10 J = 1, NDDF                                           
               SUU(I,J) = SUU(I,J) * GX(I)                              
  10     CONTINUE                                                       
CX20578 CALL DOOUTX( 578 )                                              
CY20578 CALL DOOUTY( 578 )                                              
      ENDIF                                                             
      IF (JNODE.LT.0) THEN                                              
CX10579 CALL DOINX( 579 )                                               
CY10579 CALL DOINY( 579 )                                               
         DO 15 I = 1, NDDF                                              
            DO 15 J = 1, NDDF                                           
               SUU(I,J) = SUU(I,J) * GX(J)                              
  15     CONTINUE                                                       
CX20580 CALL DOOUTX( 580 )                                              
CY20580 CALL DOOUTY( 580 )                                              
      ENDIF                                                             
CX40062 CALL SBOUTX (62)                                                
CY40062 CALL SBOUTY (62)                                                
C                                                                       
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            HOP                    
      SUBROUTINE HOP                                                    
C********************************************************************** 
C     XDPLUS <== XDMINS + DELTAT*XDD                                    
C     XPLUS  <== X + DELTA*XDPLUS                                       
C     XD     <== 1/2 (XDPLUS + XDMINS)                                  
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
CX30063 CALL SBINX (63)                                                 
CY30063 CALL SBINY (63)                                                 
CX10581 CALL DOINX( 581 )                                               
CY10581 CALL DOINY( 581 )                                               
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
CCC   PRINT *, ' SUBROUTINE HOP '                                       
C                                                                       
      DO 20 IBLOCK = 1, NBLOCK                                          
CCC      PRINT *,' IBLOCK ',IBLOCK                                      
         ILOC = PPTR(IBLOCK)                                            
         DO 10 I = 1, IBLEN(IBLOCK)                                     
            XDPLUS(ILOC+I-1) = XDMINS(ILOC+I-1) + DELTAT*XDD(ILOC+I-1)  
            XPLUS(ILOC+I-1) = X(ILOC+I-1) + DELTAT*XDPLUS(ILOC+I-1)     
            XD(ILOC+I-1) = .5*XDPLUS(ILOC+I-1) + .5*XDMINS(ILOC+I-1)    
  10     CONTINUE                                                       
  20  CONTINUE                                                          
CX20582 CALL DOOUTX( 582 )                                              
CY20582 CALL DOOUTY( 582 )                                              
CX40064 CALL SBOUTX (64)                                                
CY40064 CALL SBOUTY (64)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            HOP0                   
      SUBROUTINE HOP0                                                   
C********************************************************************** 
C     XDPLUS <== XD + DELTAT/2 * XDD                                    
C     XPLUS  <== X + DELTA*XDPLUS                                       
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
CX30065 CALL SBINX (65)                                                 
CY30065 CALL SBINY (65)                                                 
CX10583 CALL DOINX( 583 )                                               
CY10583 CALL DOINY( 583 )                                               
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
CCC   PRINT *, ' SUBROUTINE HOP0 '                                      
C                                                                       
      DO 20 IBLOCK = 1, NBLOCK                                          
CCC      PRINT *, ' IBLOCK ',IBLOCK                                     
         ILOC = PPTR(IBLOCK)                                            
         DO 10 I = 1, IBLEN(IBLOCK)                                     
            XDPLUS(ILOC+I-1) = XD(ILOC+I-1) + .5*DELTAT*XDD(ILOC+I-1)   
            XPLUS(ILOC+I-1) = X(ILOC+I-1) + DELTAT*XDPLUS(ILOC+I-1)     
  10     CONTINUE                                                       
  20  CONTINUE                                                          
CX20584 CALL DOOUTX( 584 )                                              
CY20584 CALL DOOUTY( 584 )                                              
CX40066 CALL SBOUTX (66)                                                
CY40066 CALL SBOUTY (66)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            INIT                   
      SUBROUTINE INIT                                                   
C********************************************************************** 
C     READ AND ECHO THE INPUT DATA                                      
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK DATA                                                           
C---------------                                                        
*COMDECK BCD                                                            
C---------------                                                        
      COMMON /BCD/ NBCN(ZNBN), ALPHBC(ZNBN), IFLAGD(5,ZNBN),            
     *             BCVALD(5,ZNBN)                                       
C                                                                       
C NBCN    - BOUNDARY CONDITION NODE NUMBERS                             
C ALPHBC  - BOUNDARY CONDITION NODE ROTATION ANGLES (DEGREES) *NOTUSED* 
C IFLAGD  - NODAL DISPL. DEGREE OF FREEDOM FLAGS                        
C           (                       0 MEANS THE D.O.F. IS FREE          
C                                   1 MEANS THE D.O.F. IS PRESCRIBED)   
C BCVALD  - DISPL. PRESCRIBED VALUES  *NOTUSED*                         
C                                                                       
*COMDECK CONN                                                           
C---------------                                                        
      COMMON /CONN/ ICONS(ZNNPES,ZNE), ICOND(ZNNPED,ZNE)                
C                                                                       
C ICONS   - STRESS ELEMENTAL CONNECTIVITY VECTORS                       
C ICOND   - DISPL. ELEMENTAL CONNECTIVITY VECTORS                       
C                                                                       
*COMDECK CONJGC                                                         
      COMMON /CONJGC/ TOLCG, ITLMCG, ITERCG, ERORCG                     
C                                                                       
C CONJUGATE GRADIENT COMMON                                             
C                                                                       
C TOLCG   - ERROR TOLERANCE                                             
C ITLMCG  - ITERATION LIMIT                                             
C ITERCG  - CURRENT ITERATION NUMBER                                    
C ERORCG  - ERROR NORM                                                  
C                                                                       
*COMDECK COORD                                                          
C---------------                                                        
      COMMON /COORD/ XYG(2,ZNND)                                        
C                                                                       
C XYG     - NODAL GLOBAL COORDINATES                                    
C                                                                       
*COMDECK CURVE                                                          
C---------------                                                        
      COMMON /CURVE/ AK1(2), AK2(2), AK12(2)                            
C                                                                       
C AK1(NCT), AK2(NCT), AK12(NCT) - CURVATURES                            
C                                                                       
*COMDECK EDESCR                                                         
C---------------                                                        
      COMMON /EDESCR/ IESMNO(ZNE), IEGEOM(ZNE), IECURV(ZNE)             
C                                                                       
C IESMNO  - DISTINCT ELEMENTAL STIFFNESS MATRIX NUMBERS                 
C IEGEOM  - ELEMENTAL GEOMETRY FLAGS (0=ARBITRARY, 1=RECTANGULAR)       
C IECURV  - ELEMENTAL CURVATURE FLAGS                                   
C                                                                       
*COMDECK FORCE                                                          
C---------------                                                        
      COMMON /FORCE/ NLP,ILAST,TLP(10),FLP(10)                          
C                                                                       
C NLP     - NUMBER OF LOAD POINTS FOR THE LOADING                       
C ILAST   - LAST LOAD POINT USED                                        
C TLP     - TIME POINTS OF THE LOADING FUNCTION                         
C FLP     - FACTORS OR THE CORRESPONDING TIME POINTS                    
C                                                                       
*COMDECK LAYERS                                                         
C---------------                                                        
      COMMON /LAYERS/ NL, E1(ZNL), E2(ZNL), ANU12(ZNL), G12(ZNL),       
     .                    G13(ZNL), G23(ZNL), THET(ZNL), HZ(ZNL),       
     .                    RHOZ(ZNL)                                     
C                                                                       
C NL      - NUMBER OF LAYERS                                            
C E1, E2  - YOUNG'S MODULII                                             
C ANU12   - MAJOR POISSON RATIO                                         
C G12, G13, G23 - SHEAR MODULII                                         
C THET    - ORIENTATIONS OF LAYERS (DEGREES)                            
C HZ      - THICKNESSES OF LAYERS                                       
C RHOZ    - MASS DENSITY OF LAYERS                                      
C                                                                       
*COMDECK LOADD                                                          
C---------------                                                        
      COMMON /LOADD/ PXYZ(3,ZNND),                                      
     *               NCONC, NODCON(ZNCONC), PCONC(3,ZNCONC)             
C                                                                       
C PXYZ    - GLOBAL NODAL LOADS                                          
C NODCON,PCONC - CONCENTRATED LOAD DATA                                 
C                                                                       
C            APPLY CONCENTRATED LOADINGS OF PCONC(1,I),                 
C            PCONC(2,I), AND PCONC(3,I) TO NODE NUMBER NODCON(I)        
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
      COMMON /WHERE/ IWHERD(ZNND,2)                                     
CX30067 CALL SBINX (67)                                                 
CY30067 CALL SBINY (67)                                                 
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
C                                                                       
      WRITE(6,*) ' READ IN NUMBERS '                                    
      READ (5,'(A)') TITLE                                              
      READ (5,*)                                                        
      READ (5,*) NE, NNS, NND, NNPES, NNPED, NBN, NDE, NCT              
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) NQD, NSYMM, RKAPPA, KNONLN                             
C                                                                       
C  READ IN TIME INTEGRATION DATA                                        
C                                                                       
      WRITE(6,*) ' READ IN TIME INTEGRATION DATA '                      
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) ISTART, NSTEPS, DELTAT, ITLMCG, TOLCG                  
      READ (5,*)                                                        
      READ (5,*) IOUT, ISAVE, NODEM, IDOFM                              
      IF (IOUT.EQ.0) IOUT = NSTEPS+1                                    
      IF (ISAVE.EQ.0) ISAVE = NSTEPS+1                                  
C                                                                       
C READ IN SUBSTRUCTURING DATA                                           
C                                                                       
      WRITE(6,*) ' READ IN SUBSTRUCTURING DATA '                        
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) NSS                                                    
      READ (5,*)                                                        
      READ (5,*) (NOTUSD, NEPSS(I), NNPSS(I), I = 1, NSS)               
C                                                                       
C READ IN ELEMENT DESCRIPTORS                                           
C                                                                       
      WRITE(6,*) ' READ IN ELEMENT DESCRIPTORS '                        
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) (NOTUSD, IESMNO(I), IEGEOM(I), IECURV(I), I = 1, NE)   
C                                                                       
C READ IN ELEMENTAL STRESS CONNECTIVITIES                               
C                                                                       
      WRITE(6,*) ' READ IN STRESS CONNECTIVITIES '                      
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) (NOTUSD, (ICONS(I,J), I = 1, NNPES), J = 1,NE)         
C                                                                       
C READ IN ELEMENTAL DISPLACEMENT CONNECTIVITIES                         
C                                                                       
      WRITE(6,*) ' READ IN DISPLACEMENT CONNECTIVITIES '                
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) (NOTUSD, (ICOND(I,J), I = 1, NNPED), J = 1, NE)        
C                                                                       
C MATERIAL PROPERTIES                                                   
C                                                                       
      WRITE(6,*) ' READ IN MATERIAL PROPERTIES '                        
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) NL, (E1(I), E2(I), ANU12(I), G12(I), G13(I), G23(I),   
     *                THET(I), HZ(I), RHOZ(I), I = 1, NL)               
C                                                                       
C READ IN CURVATURES                                                    
C                                                                       
      WRITE(6,*) ' READ IN CURVATURES '                                 
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) (AK1(I),AK2(I),AK12(I),I=1,NCT)                        
C                                                                       
C READ IN COORDINATES                                                   
C                                                                       
      WRITE(6,*) ' READ IN COORDINATES '                                
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) (NOTUSD, XYG(1,J), XYG(2,J), J = 1, NND)               
C                                                                       
C READ IN BOUNDARY CONDITIONS                                           
C                                                                       
      WRITE(6,*) ' READ IN BOUNDARY CONDITIONS '                        
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) (NBCN(J), (IFLAGD(I,J), I = 1, NDDF), ALPHBC(J),       
     *                     (BCVALD(I,J), I = 1, NDDF),                  
     *           J = 1, NBN)                                            
C                                                                       
C READ IN DISTRIBUTED LOAD DATA                                         
C                                                                       
      WRITE(6,*) ' READ IN DISTRIBUTED LOAD DATA '                      
      READ (5,*)                                                        
      READ (5,*)                                                        
      IT = 0                                                            
  15  CONTINUE                                                          
         READ (5,*) NUMBER, PX, PY, PZ                                  
CX10585 CALL DOINX( 585 )                                               
CY10585 CALL DOINY( 585 )                                               
         DO 16 I = 1, NUMBER                                            
            IT = IT + 1                                                 
            PXYZ(1,IT) = PX                                             
            PXYZ(2,IT) = PY                                             
            PXYZ(3,IT) = PZ                                             
  16     CONTINUE                                                       
CX20586 CALL DOOUTX( 586 )                                              
CY20586 CALL DOOUTY( 586 )                                              
      IF (IT .LT. NND) GO TO 15                                         
C                                                                       
C READ THE CONCENTRATED LOADINGS                                        
C                                                                       
      WRITE(6,*) ' READ IN CONCENTRATED LOADINGS '                      
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) NCONC                                                  
CX10587 CALL DOINX( 587 )                                               
CY10587 CALL DOINY( 587 )                                               
      DO 18 IC = 1, NCONC                                               
         READ (5,*) NODE, PX, PY, PZ                                    
         NODCON(IC) = NODE                                              
         PCONC(1,IC) = PX                                               
         PCONC(2,IC) = PY                                               
         PCONC(3,IC) = PZ                                               
  18  CONTINUE                                                          
CX20588 CALL DOOUTX( 588 )                                              
CY20588 CALL DOOUTY( 588 )                                              
C                                                                       
C READ IN THE LOAD FACTOR TABLE                                         
C                                                                       
      WRITE(6,*) ' READ IN LOAD FACTOR TABLE '                          
      READ (5,*)                                                        
      READ (5,*)                                                        
      READ (5,*) NLP                                                    
      READ (5,*) (TLP(I),FLP(I),I=1,NLP)                                
C                                                                       
C     ***********************                                           
C     * ECHO THE INPUT DATA *                                           
C     ***********************                                           
C                                                                       
      WRITE(6,*) ' ECHO THE INPUT DATA '                                
      WRITE (9,20)                                                      
      WRITE (9,25) NE, NNS, NND, NNPES, NNPED, NSDF, NDDF, NBN, NDE, NCT
      WRITE (9,30) NQD, NSYMM, RKAPPA, KNONLN                           
      WRITE (9,35) ISTART, NSTEPS, DELTAT, ITLMCG, TOLCG                
      WRITE (9,36) IOUT, ISAVE, NODEM, IDOFM                            
      WRITE (9,40) NSS,                                                 
     *             (I, NEPSS(I), NNPSS(I), I = 1, NSS)                  
      WRITE (9,45) (I, IESMNO(I), IEGEOM(I), IECURV(I), I = 1, NE)      
      WRITE (9,50)                                                      
CX10589 CALL DOINX( 589 )                                               
CY10589 CALL DOINY( 589 )                                               
      DO 51 J = 1, NE                                                   
         WRITE (9,55) J, (ICONS(I,J), I = 1, NNPES)                     
  51  CONTINUE                                                          
CX20590 CALL DOOUTX( 590 )                                              
CY20590 CALL DOOUTY( 590 )                                              
      WRITE (9,60)                                                      
CX10591 CALL DOINX( 591 )                                               
CY10591 CALL DOINY( 591 )                                               
      DO 61 J = 1, NE                                                   
         WRITE (9,55) J, (ICOND(I,J), I = 1, NNPED)                     
  61  CONTINUE                                                          
CX20592 CALL DOOUTX( 592 )                                              
CY20592 CALL DOOUTY( 592 )                                              
      WRITE (9,70) NL, (E1(I), E2(I), ANU12(I), G12(I), G13(I),         
     *                  G23(I), THET(I), HZ(I), RHOZ(I), I = 1, NL)     
      WRITE (9,75) (AK1(I),AK2(I),AK12(I),I=1,NCT)                      
      WRITE (9,80) (J, XYG(1,J), XYG(2,J), J = 1, NND)                  
      WRITE (9,85)                                                      
CX10593 CALL DOINX( 593 )                                               
CY10593 CALL DOINY( 593 )                                               
      DO 86 J = 1, NBN                                                  
          WRITE (9,90) NBCN(J), (IFLAGD(I,J), I = 1, NDDF),             
     *               ALPHBC(J), (BCVALD(I,J), I = 1, NDDF)              
  86  CONTINUE                                                          
CX20594 CALL DOOUTX( 594 )                                              
CY20594 CALL DOOUTY( 594 )                                              
      WRITE (9,95) (J, (PXYZ(I,J), I = 1, 3), J = 1, NND)               
      WRITE (9,100)                                                     
CX10595 CALL DOINX( 595 )                                               
CY10595 CALL DOINY( 595 )                                               
      DO 101 I = 1, NCONC                                               
         WRITE (9,105) NODCON(I),PCONC(1,I),PCONC(2,I),PCONC(3,I)       
 101  CONTINUE                                                          
CX20596 CALL DOOUTX( 596 )                                              
CY20596 CALL DOOUTY( 596 )                                              
CX40068 CALL SBOUTX (68)                                                
CY40068 CALL SBOUTY (68)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
C                                                                       
C FORMAT STATEMENTS.                                                    
C                                                                       
  20  FORMAT('0ECHO CHECK OF THE INPUT DATA FOR DYFESM')                
  25  FORMAT('0STRUCTURE DATA'/                                         
     .       '   NUMBER OF ELEMENTS IN THE STRUCTURE ...........', I5/  
     .       '   NUMBER OF STRESS NODES IN THE STRUCTURE........', I5/  
     .       '   NUMBER OF DISPL. NODES IN THE STRUCTURE........', I5/  
     .       '   NUMBER OF STRESS NODES PER ELEMENT.............', I5/  
     .       '   NUMBER OF DISPL. NODES PER ELEMENT.............', I5/  
     .       '   NUMBER OF STRESS DEGREES OF FREEDOM PER NODE...', I5/  
     .       '   NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE...', I5/  
     .       '   NUMBER OF BOUNDARY CONDITION NODES.............', I5/  
     .       '   NUMBER OF DISTINCT ELEMENTAL STIFFNESS MATRICES', I5/  
     .       '   NUMBER OF CURVATURE TYPES......................', I5)  
  30  FORMAT('0SOLUTION DATA'/                                          
     .       '   NUMBER OF NUM. INTEGRATION QUADRATURE POINTS...', I5/  
     .       '   INVERSION SYMMETRY (1=YES, 0=NO)...............', I5/  
     .       '   RKAPPA (1.,-1.,OR 2.)..........................',E13.6/
     .       '   NONLINEAR FLAG (0=NO, 1=YES)...................', I5)  
  35  FORMAT('0TIME INTEGRATION DATA'/                                  
     .       '   RESTART RUN FLAG(0=NO, 1=YES)..................', I5/  
     .       '   NUMBER OF STEPS................................',I5/   
     .       '   STEP SIZE......................................',E13.6/
     .       '   ITERATION LIMIT FOR PCG .......................',I5/   
     .       '   TOLERANCE FOR PCG .............................',E13.6)
  36  FORMAT('   OUTPUT RESULTS EVERY THIS MANY STEPS ..........',I5/   
     .       '   SAVE RESULTS EVERY THIS MANY STEPS ............',I5/   
     .       '   NODEM..........................................',I5/   
     .       '   IDOFM .........................................',I5)   
  40  FORMAT('0SUBSTRUCTURING DATA '/                                   
     .       '   NUMBER OF SUBSTRUCTURES........................',I5/   
     .        1X,2X,'ISS',3X,'NE',3X,'NN'/                              
     .        (1X,3I5))                                                 
  45  FORMAT('0ELEMENT DESCRIPTIONS'/                                   
     .       '   ELEMENT IDENTIFIER GEOMETRY CURVATURE'/                
     .      (5X, I5, 6X, I5, 4X, I5, 4X, I5))                           
  50  FORMAT('0STRESS ELEMENTAL CONNECTIVITY VECTORS'/                  
     .       '   ELEMENT VECTOR')                                       
  55  FORMAT(5X, I5, TL10, (15X, 10I5))                                 
  60  FORMAT('0DISPL. ELEMENTAL CONNECTIVITY VECTORS'/                  
     .       '   ELEMENT VECTOR')                                       
  70  FORMAT('0MATERIAL PROPERTIES'/                                    
     .       '   NUMBER OF LAYERS ', I5/                                
     .       1X,11X,'E1',11X,'E2',9X,'NU12',10X,'G12',10X,'G13',        
     .       10X,'G23',9X,'THET',11X,'HZ',9X,'RHOZ'/                    
     .       (1X, 9E13.6))                                              
  75  FORMAT('0CURVATURES, AK1, AK2, AK12 ', 3E13.6/(28X,3E13.6))       
  80  FORMAT('0NODAL COORDINATES'/                                      
     .       '   NODE                 X            Y'/                  
     .      (2X, I5, 5X, 2E13.6))                                       
  85  FORMAT('0BOUNDARY CONDITIONS'/                                    
     .       2X,' NODE',5X,'FLAGS',8X,'ALPHA',5X,'VALUES')              
  90  FORMAT(2X, I5, 5X, 5I1, E13.6, 5X, 5E13.6)                        
  95  FORMAT('0NODAL LOADS'/                                            
     .       2X,' NODE',5X,11X,'PX',11X,'PY',11X,'PZ'/                  
     .      (2X, I5, 5X, 3E13.6))                                       
 100  FORMAT('0CONCENTRATED LOAD DATA '/1X,'NODE',11X,'P1',11X,'P2',    
     .       11X,'P3')                                                  
 105  FORMAT(1X,I5,3E13.6)                                              
CX40068 CALL SBOUTX (68)                                                
CY40068 CALL SBOUTY (68)                                                
      END                                                               
                                                                        
*DECK                                            INITAL                 
      SUBROUTINE INITAL                                                 
C********************************************************************** 
C     INITIALIZE THE SOLUTION AND TIME                                  
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
CX30069 CALL SBINX (69)                                                 
CY30069 CALL SBINY (69)                                                 
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
      WRITE(6,*) ' SUBROUTINE INITAL '                                  
C                                                                       
      TIME = 0.                                                         
      ISTEP = 0                                                         
      CALL ZEROV(HE, ZNSFE*ZNE)                                         
      CALL ZEROV(X, NEQD)                                               
      CALL ZEROV(XD, NEQD)                                              
      IF (ISTART.EQ.1) THEN                                             
C        . RESTART RUN .                                                
         WRITE(6,*) ' RESTART RUN '                                     
         REWIND 1                                                       
         READ (1,10) TIME, (X(I),I=1,NEQD), (XD(I),I=1,NEQD)            
10       FORMAT(1X,3E25.16)                                             
                                                                        
      ENDIF                                                             
C                                                                       
C     . SOLVE FOR FORCES H AT T .                                       
      WRITE(6,*) ' SOLVH '                                              
      CALL SOLVH                                                        
C                                                                       
C     . SOLVE FOR ACCELERATIONS XDD AT T .                              
      WRITE(6,*) ' SOLXDD '                                             
      CALL SOLXDD                                                       
C                                                                       
C     . FORM VELOCITY AT T+DELTAT/2 AND DISPLACEMENTS AT T+DELTAT .     
      WRITE(6,*) ' HOP0 '                                               
      CALL HOP0                                                         
C                                                                       
C     . POST PROCESS .                                                  
      WRITE(6,*) ' CALL DRPOST '                                        
      CALL DRPOST                                                       
CX40070 CALL SBOUTX (70)                                                
CY40070 CALL SBOUTY (70)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            KNRGY                  
      SUBROUTINE KNRGY                                                  
C********************************************************************** 
C     COMPUTE THE KINETIC ENERGY                                        
C                                                                       
C     KINE = 1/2 * [M] * XD * XD                                        
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
*COMDECK ENRGYC                                                         
      REAL KINE                                                         
      COMMON /ENRGYC/ KINE                                              
C                                                                       
C KINE    - KINETIC ENERGY                                              
C                                                                       
      REAL MX(ZNEQD), MXX, MXXI                                         
CX30071 CALL SBINX (71)                                                 
CY30071 CALL SBINY (71)                                                 
C                                                                       
CCC   PRINT *, 'SUBROUTINE KNRGY '                                      
C                                                                       
C     . SET MX TO [M] * XD .                                            
CCC   PRINT *, ' CALL MXMULT '                                          
      CALL MXMULT(XD, MX)                                               
CCC   PRINT 1000, ' M * XD ',(MX(I),I=1,NEQD)                           
1000  FORMAT(//1X,A/(3X,10E13.6))                                       
C                                                                       
      MXX = 0.                                                          
CX10597 CALL DOINX( 597 )                                               
CY10597 CALL DOINY( 597 )                                               
      DO 10 IBLOCK = 1, NBLOCK                                          
CCC      PRINT *, ' IBLOCK ',IBLOCK                                     
         NRB = IBLEN(IBLOCK)                                            
         ILOC = PPTR(IBLOCK)                                            
         MXXI = 0.                                                      
         DO 5 I = 1, NRB                                                
            MXXI = MXXI + XD(ILOC+I-1)*MX(ILOC+I-1)                     
   5     CONTINUE                                                       
CCC      PRINT *, ' MXXI ',MXXI                                         
         MXX = MXX + MXXI                                               
  10  CONTINUE                                                          
CX20598 CALL DOOUTX( 598 )                                              
CY20598 CALL DOOUTY( 598 )                                              
C                                                                       
      KINE = .5 * MXX                                                   
CX40072 CALL SBOUTX (72)                                                
CY40072 CALL SBOUTY (72)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            LDFACT                 
       SUBROUTINE LDFACT(T,FACTOR)                                      
C********************************************************************** 
C THIS SUBROUTINE CALCULATES THE CURRENT LOAD FACTOR BASED ON           
C SPECIFIED LOAD POINTS ASSUMING A LINEAR VARIATION IN LOAD             
C BETWEEN TWO ADJACENT LOAD POINTS.                                     
C WRITTEN BY NORMAN KNIGHT                                              
C********************************************************************** 
*COMDECK FORCE                                                          
C---------------                                                        
      COMMON /FORCE/ NLP,ILAST,TLP(10),FLP(10)                          
CX30073 CALL SBINX (73)                                                 
CY30073 CALL SBINY (73)                                                 
C                                                                       
C NLP     - NUMBER OF LOAD POINTS FOR THE LOADING                       
C ILAST   - LAST LOAD POINT USED                                        
C TLP     - TIME POINTS OF THE LOADING FUNCTION                         
C FLP     - FACTORS OR THE CORRESPONDING TIME POINTS                    
C                                                                       
CCC    DATA ILAST/1/                                                    
       IF(T.LE.TLP(NLP)) GO TO 10                                       
       WRITE(9,5)                                                       
   5   FORMAT('0********ERROR********** T.GT.TLP(NLP)********')         
CX40074 CALL SBOUTX (74)                                                
CY40074 CALL SBOUTY (74)                                                
       STOP                                                             
  10   IF(T.EQ.TLP(ILAST)) GO TO 30                                     
       IF(T.LT.TLP(ILAST)) GO TO 20                                     
  15   ILAST=ILAST+1                                                    
       IF(T.LE.TLP(ILAST)) GO TO 25                                     
       GO TO 15                                                         
  20   IF(T.GT.TLP(ILAST-1)) GO TO 25                                   
        ILAST=ILAST-1                                                   
       GO TO 20                                                         
  25   FACTOR=FLP(ILAST-1)+(FLP(ILAST)-FLP(ILAST-1))*(T-TLP(ILAST-1))   
     .  /(TLP(ILAST)-TLP(ILAST-1))                                      
       GO TO 35                                                         
  30   FACTOR=FLP(ILAST)                                                
  35   CONTINUE                                                         
CX40074 CALL SBOUTX (74)                                                
CY40074 CALL SBOUTY (74)                                                
C                                                                       
C EXIT                                                                  
C                                                                       
       RETURN                                                           
       END                                                              
                                                                        
*DECK                                            LEAP                   
      SUBROUTINE LEAP                                                   
C********************************************************************** 
C     LEAP FROG                                                         
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
CX30075 CALL SBINX (75)                                                 
CY30075 CALL SBINY (75)                                                 
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
CCC   PRINT *, ' SUBROUTINE LEAP '                                      
C                                                                       
C     . GET THE INITIAL SOLUTION AND INITIAL TIME .                     
C     CALL REMARK(' INITAL')                                            
      WRITE(6,*) ' ********** INITAL ********** '                       
      CALL INITAL                                                       
CX10599 CALL DOINX( 599 )                                               
CY10599 CALL DOINY( 599 )                                               
C                                                                       
C     . LOOP OVER THE TIME STEPS .                                      
      DO 10 ISTEP = 1, NSTEPS                                           
CCC      PRINT *, ' ISTEP ',ISTEP                                       
         TIME = TIME + DELTAT                                           
CCC      PRINT *, ' TIME = ',TIME                                       
         CALL COPYV(XPLUS, X, NEQD)                                     
         CALL COPYV(XDPLUS, XDMINS, NEQD)                               
C                                                                       
C        . SOLVE FOR FORCES AT TIME T .                                 
CCC      PRINT *, ' SOLVH '                                             
         CALL SOLVH                                                     
C                                                                       
C        . SOLVE FOR ACCELERATION AT TIME T .                           
CCC      PRINT *, ' SOLXDD '                                            
         CALL SOLXDD                                                    
C                                                                       
C        . FORM VELOCITY AT T+DELTAT/2 AND DISPLACEMENTS AT T+DELTAT .  
CCC      PRINT *, ' HOP  '                                              
         CALL HOP                                                       
C                                                                       
C        . POST PROCESS THE RESULTS .                                   
CCC      PRINT *, ' DRPOST '                                            
         CALL DRPOST                                                    
  10  CONTINUE                                                          
CX20600 CALL DOOUTX( 600 )                                              
CY20600 CALL DOOUTY( 600 )                                              
CX40076 CALL SBOUTX (76)                                                
CY40076 CALL SBOUTY (76)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            MASS                   
      SUBROUTINE MASS                                                   
C********************************************************************** 
C FORM THE DIAGONAL MASS STRAIN MATRIX RHO.                             
C                                                                       
C (THE OFF DIAGONAL TERMS ARE ZERO)                                     
C                                                                       
C RHO =                                                                 
C       1--                     --1                                     
C       1 M0   0    0   M1   0    1                                     
C       1      M0   0    0  M1    1                                     
C       1          M0    0   0    1                                     
C       1 SYMM.         M2   0    1                                     
C       1                   M2    1                                     
C       1--                     --1                                     
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK LAYERS                                                         
C---------------                                                        
      COMMON /LAYERS/ NL, E1(ZNL), E2(ZNL), ANU12(ZNL), G12(ZNL),       
     .                    G13(ZNL), G23(ZNL), THET(ZNL), HZ(ZNL),       
     .                    RHOZ(ZNL)                                     
C                                                                       
C NL      - NUMBER OF LAYERS                                            
C E1, E2  - YOUNG'S MODULII                                             
C ANU12   - MAJOR POISSON RATIO                                         
C G12, G13, G23 - SHEAR MODULII                                         
C THET    - ORIENTATIONS OF LAYERS (DEGREES)                            
C HZ      - THICKNESSES OF LAYERS                                       
C RHOZ    - MASS DENSITY OF LAYERS                                      
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK MASSC                                                          
C---------------                                                        
      REAL M0, M1, M2                                                   
      COMMON /MASSC/ RHO(5,5), M0, M1, M2                               
CX30077 CALL SBINX (77)                                                 
CY30077 CALL SBINY (77)                                                 
C                                                                       
C RHO     - MASS STRESS STRAIN MATRIX                                   
C                                                                       
      CALL ZEROV(RHO,NDDF*NDDF)                                         
      HT = 0.                                                           
CX10601 CALL DOINX( 601 )                                               
CY10601 CALL DOINY( 601 )                                               
      DO 100 I = 1,NL                                                   
         HT = HT + HZ(I)                                                
 100  CONTINUE                                                          
CX20602 CALL DOOUTX( 602 )                                              
CY20602 CALL DOOUTY( 602 )                                              
      HT = .5*HT                                                        
C                                                                       
      M0 = 0.                                                           
      M1 = 0.                                                           
      M2 = 0.                                                           
CX10603 CALL DOINX( 603 )                                               
CY10603 CALL DOINY( 603 )                                               
      DO 900 I = 1,NL                                                   
         HB = HT - HZ(I)                                                
         AH1 = HT - HB                                                  
         AH2 = (HT*HT - HB*HB)*.5                                       
         AH3 = (HT*HT*HT - HB*HB*HB)/3.                                 
         M0 = M0 + RHOZ(I)*AH1                                          
         M1 = M1 + RHOZ(I)*AH2                                          
         M2 = M2 + RHOZ(I)*AH3                                          
         HT = HB                                                        
 900  CONTINUE                                                          
CX20604 CALL DOOUTX( 604 )                                              
CY20604 CALL DOOUTY( 604 )                                              
C                                                                       
      RHO(1,1) = M0                                                     
      RHO(2,2) = M0                                                     
      RHO(3,3) = M0                                                     
      RHO(4,4) = M2                                                     
      RHO(5,5) = M2                                                     
      RHO(1,4) = M1                                                     
      RHO(4,1) = M1                                                     
      RHO(2,5) = M1                                                     
      RHO(5,2) = M1                                                     
CX40078 CALL SBOUTX (78)                                                
CY40078 CALL SBOUTY (78)                                                
C                                                                       
      RETURN                                                            
      END                                                               
*DECK                                            MATADD                 
      SUBROUTINE MATADD(A, B, C, M, N)                                  
C********************************************************************** 
C MATRIX ADDITION [C] = [A] + [B]                                       
C********************************************************************** 
      DIMENSION A(M,N), B(M,N), C(M,N)                                  
CX30079 CALL SBINX (79)                                                 
CY30079 CALL SBINY (79)                                                 
CX10605 CALL DOINX( 605 )                                               
CY10605 CALL DOINY( 605 )                                               
      DO 200 J = 1, N                                                   
      DO 100 I = 1, M                                                   
      C(I,J) = A(I,J) + B(I,J)                                          
 100  CONTINUE                                                          
 200  CONTINUE                                                          
CX20606 CALL DOOUTX( 606 )                                              
CY20606 CALL DOOUTY( 606 )                                              
CX40080 CALL SBOUTX (80)                                                
CY40080 CALL SBOUTY (80)                                                
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            MATINV                 
      SUBROUTINE MATINV(MAX,N,A,M,B,IOP,DETERM,ISCALE,IPIVOT,IWK)       
C***********************************************************************
                                                                        
C                                                                       
C     PURPOSE - MATINV INVERTS A REAL SQUARE MATRIX A.                  
C               IN ADDITION THE ROUTINE SOLVES THE MATRIX               
C               EQUATION AX=B,WHERE B IS A MATRIX OF CONSTANT           
C               VECTORS. THERE IS ALSO AN OPTION TO HAVE THE            
C               DETERMINANT EVALUATED. IF THE INVERSE IS NOT            
C               NEEDED, USE GELIM TO SOLVE A SYSTEM OF SIMULTANEOUS     
C               EQUATIONS AND DETFAC TO EVALUATE A DETERMINANT          
C               FOR SAVING TIME AND STORAGE.                            
C                                                                       
C     USE     - CALL MATINV(MAX,N,A,M,B,IOP,DETERM,ISCALE,IPIVOT,IWK)   
C                                                                       
C                 MAX - THE MAXIMUM ORDER OF A AS STATED IN THE         
C                       DIMENSION STATEMENT OF THE CALLING PROGRAM.     
C                                                                       
C                 N   - THE ORDER OF A, 1.LE.N.LE.MAX.                  
C                                                                       
C                 A   - A TWO-DIMENSIONAL ARRAY OF THE COEFFICIENTS.    
C                       ON RETURN TO THE CALLING PROGRAM, A INVERSE     
C                       IS STORED IN A.                                 
C                       A MUST BE DIMENSIONED IN THE CALLING PROGRAM    
C                       WITH FIRST DIMENSION MAX AND SECOND DIMENSION   
C                       AT LEAST N.                                     
C                                                                       
C                 M   - THE NUMBER OF COLUMN VECTORS IN B.              
C                       M=0 SIGNALS THAT THE SUBROUTINE IS              
C                       USED SOLELY FOR INVERSION,HOWEVER,              
C                       IN THE CALL STATEMENT AN ENTRY CORRE-           
C                       SPONDING TO B MUST BE PRESENT.                  
C                                                                       
C                 B   - A TWO-DIMENSIONAL ARRAY OF THE CONSTANT         
C                       VECTOR B. ON RETURN TO CALLING PROGRAM,         
C                       X IS STORED IN B. B SHOULD HAVE ITS FIRST       
C                       DIMENSION MAX AND ITS SECOND AT LEAST M.        
C                                                                       
C                 IOP - COMPUTE DETERMINANT OPTION.                     
C                        IOP=0 COMPUTES THE MATRIX INVERSE AND          
C                              DETERMINANT.                             
C                        IOP=1 COMPUTES THE MATRIX INVERSE ONLY.        
C                                                                       
C               DETERM- FOR IOP=0-IN CONJUNCTION WITH ISCALE            
C                       REPRESENTS THE VALUE OF THE DETERMINANT         
C                       OF A, DET(A),AS FOLLOWS.                        
C                        DET(A)=(DETERM)(10**100(ISCALE))               
C                       THE COMPUTATION DET(A) SHOULD NOT BE            
C                       ATTEMPTED IN THE USER PROGRAM SINCE IF          
C                       THE ORDER OF A IS LARGER AND/OR THE             
C                       MAGNITUDE OF ITS ELEMENTS ARE LARGE(SMALL),     
C                       THE DET(A) CALCULATION MAY CAUSE OVERFLOW       
C                     (UNDERFLOW). DETERM SET TO ZERO FOR               
C                     SINGULAR MATRIX CONDITION, FOR EITHER             
C                     I0P=1,OR 0. SHOULD BE CHECKED BY PROGRAMER        
C                     ON RETURN TO MAIN PROGRAM.                        
C                                                                       
C             ISCALE  - A SCALE FACTOR COMPUTED BY THE                  
C                       SUBROUTINE TO AVOID OVERFLOW OR                 
C                       UNDERFLOW IN THE COMPUTATION OF                 
C                       THE QUANTITY,DETERM.                            
C                                                                       
C             IPIVOT  - A ONE DIMENSIONAL INTEGER ARRAY                 
C                       USED BY THE SUBPROGRAM TO STORE                 
C                       PIVOTOL INFORMATION. IT SHOULD BE               
C                       DIMENSIONED AT LEAST N. IN GENERAL              
C                       THE USER DOES NOT NEED TO MAKE USE              
C                       OF THIS ARRAY.                                  
C                                                                       
C                IWK  - A TWO-DIMENSIONAL INTEGER ARRAY OF              
C                       TEMPORARY STORAGE USED BY THE ROUTINE.          
C                       IWK SHOULD HAVE ITS FIRST DIMENSION             
C                       MAX, AND ITS SECOND 2.                          
C                                                                       
C     REQUIRED ROUTINES-                                                
C                                                                       
C     REFERENCE        -FOX,L, AN INTRODUCTION TO NUMERICAL             
C                              LINEAR ALGEBRA                           
C                                                                       
C     STORAGE          - 542 OCTAL LOCATIONS                            
C                                                                       
C     LANGUAGE         -FORTRAN                                         
C                                                                       
C     FORTRAN                                                           
C     LIBRARY FUNCTIONS -ABS                                            
C                                                                       
C     LATEST REVISION - JULY 1973 -CMPB                                 
C                                                                       
C     MATRIX INVERSION WITH ACCOMPANYING SOLUTION OF LINEAR EQUATIONS   
C                                                                       
      DIMENSION IPIVOT(N),A(MAX,N),B(MAX,N),IWK(MAX,2)                  
      EQUIVALENCE (IROW,JROW), (ICOLUM,JCOLUM), (AMAX, T, SWAP)         
CX30081 CALL SBINX (81)                                                 
CY30081 CALL SBINY (81)                                                 
C                                                                       
C     INITIALIZATION                                                    
C                                                                       
      ISCALE=0                                                          
C*****CHANGING EXPONENT OF R1 FOR SINGLE PRECISION ON VAX AND ALLIANT   
C     R1 = 1.E100                                                       
      R1 = 1.E30                                                        
      R2=1.0/R1                                                         
      DETERM=1.0                                                        
CX10607 CALL DOINX( 607 )                                               
CY10607 CALL DOINY( 607 )                                               
      DO 20 J=1,N                                                       
   20 IPIVOT(J)=0                                                       
CX20608 CALL DOOUTX( 608 )                                              
CY20608 CALL DOOUTY( 608 )                                              
CX10609 CALL DOINX( 609 )                                               
CY10609 CALL DOINY( 609 )                                               
      DO 550 I=1,N                                                      
C                                                                       
C     SEARCH FOR PIVOT ELEMENT                                          
C                                                                       
      AMAX=0.0                                                          
      DO 105 J=1,N                                                      
      IF (IPIVOT(J)-1) 60, 105, 60                                      
   60 CONTINUE                                                          
      DO      100      K=1,N                                            
      IF (IPIVOT(K)-1) 80, 100, 740                                     
   80 IF (ABS(AMAX)-ABS(A(J,K)))85,100,100                              
   85 IROW=J                                                            
      ICOLUM=K                                                          
      AMAX=A(J,K)                                                       
  100 CONTINUE                                                          
  105 CONTINUE                                                          
      IF (AMAX) 110,106,110                                             
  106 DETERM=0.0                                                        
      ISCALE=0                                                          
      GO TO 740                                                         
  110 IPIVOT(ICOLUM)=IPIVOT(ICOLUM)+1                                   
C                                                                       
C     INTERCHANGE ROWS TO PUT PIVOT ELEMENT ON DIAGONAL                 
C                                                                       
      IF (IROW-ICOLUM) 140, 260, 140                                    
  140 DETERM=-DETERM                                                    
      DO 200 L=1,N                                                      
      SWAP=A(IROW,L)                                                    
      A(IROW,L)=A(ICOLUM,L)                                             
  200 A(ICOLUM,L)=SWAP                                                  
      IF(M) 260, 260, 210                                               
  210 CONTINUE                                                          
      DO      250      L=1,      M                                      
      SWAP=B(IROW,L)                                                    
      B(IROW,L)=B(ICOLUM,L)                                             
  250 B(ICOLUM,L)=SWAP                                                  
  260 IWK(I,1)=IROW                                                     
      IWK(I,2)=ICOLUM                                                   
      PIVOT=A(ICOLUM,ICOLUM)                                            
      IF(IOP.EQ.1) GO TO 321                                            
      IF(PIVOT)1000,106,1000                                            
C                                                                       
C     SCALE THE DETERMINANT                                             
C                                                                       
 1000 PIVOTI=PIVOT                                                      
      IF(ABS(DETERM)-R1)1030,1010,1010                                  
 1010 DETERM=DETERM/R1                                                  
      ISCALE=ISCALE+1                                                   
      IF(ABS(DETERM)-R1)1060,1020,1020                                  
 1020 DETERM=DETERM/R1                                                  
      ISCALE=ISCALE+1                                                   
      GO TO 1060                                                        
 1030 IF(ABS(DETERM)-R2)1040,1040,1060                                  
 1040 DETERM=DETERM*R1                                                  
      ISCALE=ISCALE-1                                                   
      IF(ABS(DETERM)-R2)1050,1050,1060                                  
 1050 DETERM=DETERM*R1                                                  
      ISCALE=ISCALE-1                                                   
 1060 IF(ABS(PIVOTI)-R1)1090,1070,1070                                  
 1070 PIVOTI=PIVOTI/R1                                                  
      ISCALE=ISCALE+1                                                   
      IF(ABS(PIVOTI)-R1)320,1080,1080                                   
 1080 PIVOTI=PIVOTI/R1                                                  
      ISCALE=ISCALE+1                                                   
      GO TO 320                                                         
 1090 IF(ABS(PIVOTI)-R2)2000,2000,320                                   
 2000 PIVOTI=PIVOTI*R1                                                  
      ISCALE=ISCALE-1                                                   
      IF(ABS(PIVOTI)-R2)2010,2010,320                                   
 2010 PIVOTI=PIVOTI*R1                                                  
      ISCALE=ISCALE-1                                                   
  320 DETERM=DETERM*PIVOTI                                              
C                                                                       
C     DIVIDE PIVOT ROW BY PIVOT ELEMENT                                 
C                                                                       
  321 IF(PIVOT)330,106,330                                              
  330 A(ICOLUM,ICOLUM)=1.0                                              
      DO 350 L=1,N                                                      
  350 A(ICOLUM,L)=A(ICOLUM,L)/PIVOT                                     
      IF(M) 380, 380, 360                                               
  360 CONTINUE                                                          
      DO      370      L=1,M                                            
  370 B(ICOLUM,L)=B(ICOLUM,L)/PIVOT                                     
C                                                                       
C     REDUCE NON-PIVOT ROWS                                             
C                                                                       
  380 CONTINUE                                                          
      DO      550      L1=1,N                                           
      IF(L1-ICOLUM) 400, 550, 400                                       
  400 T=A(L1,ICOLUM)                                                    
      A(L1,ICOLUM)=0.0                                                  
      DO 450 L=1,N                                                      
  450 A(L1,L)=A(L1,L)-A(ICOLUM,L)*T                                     
      IF(M) 550, 550, 460                                               
  460 CONTINUE                                                          
      DO      500      L=1,M                                            
  500 B(L1,L)=B(L1,L)-B(ICOLUM,L)*T                                     
  550 CONTINUE                                                          
CX20610 CALL DOOUTX( 610 )                                              
CY20610 CALL DOOUTY( 610 )                                              
CX10611 CALL DOINX( 611 )                                               
CY10611 CALL DOINY( 611 )                                               
C                                                                       
C     INTERCHANGE COLUMNS                                               
C                                                                       
      DO 710 I=1,N                                                      
      L=N+1-I                                                           
      IF (IWK(L,1)-IWK(L,2))630,710,630                                 
  630 JROW=IWK(L,1)                                                     
      JCOLUM=IWK(L,2)                                                   
      DO 705 K=1,N                                                      
      SWAP=A(K,JROW)                                                    
      A(K,JROW)=A(K,JCOLUM)                                             
      A(K,JCOLUM)=SWAP                                                  
  705 CONTINUE                                                          
  710 CONTINUE                                                          
CX20612 CALL DOOUTX( 612 )                                              
CY20612 CALL DOOUTY( 612 )                                              
  740 CONTINUE                                                          
CX40082 CALL SBOUTX (82)                                                
CY40082 CALL SBOUTY (82)                                                
      RETURN                                                            
      END                                                               
*DECK                                            MATMUL                 
      SUBROUTINE MATMUL(A, B, C, L, M, N)                               
C********************************************************************** 
C MATRIX MULTIPLICATION A(I=1-L,J=1-M)*B(J=1-M,K=1-N) = C(I=1-L,K=1-N)  
C AS A LINEAR COMBINATION OF COLUMNS                                    
C********************************************************************** 
      DIMENSION A(L,M), B(M,N), C(L,N)                                  
CX30083 CALL SBINX (83)                                                 
CY30083 CALL SBINY (83)                                                 
CX10613 CALL DOINX( 613 )                                               
CY10613 CALL DOINY( 613 )                                               
      DO 400 K = 1, N                                                   
        DO 100 I = 1, L                                                 
          C(I,K) = 0.                                                   
 100    CONTINUE                                                        
        DO 300 J = 1, M                                                 
          TEMP = B(J,K)                                                 
          IF (TEMP .EQ. 0.) GOTO 300                                    
          DO 200 I = 1, L                                               
            C(I,K) = C(I,K) + A(I,J)*TEMP                               
 200      CONTINUE                                                      
 300    CONTINUE                                                        
 400  CONTINUE                                                          
CX20614 CALL DOOUTX( 614 )                                              
CY20614 CALL DOOUTY( 614 )                                              
CX40084 CALL SBOUTX (84)                                                
CY40084 CALL SBOUTY (84)                                                
      RETURN                                                            
      END                                                               
*DECK                                            MATMUT                 
      SUBROUTINE MATMUT(A, B, C, L, M, N)                               
C********************************************************************** 
C MATRIX TRANSPOSE MULTIPLICATION  [C] = [A]**T * [B]                   
C********************************************************************** 
      DIMENSION A(M,L), B(M,N), C(L,N)                                  
CX30085 CALL SBINX (85)                                                 
CY30085 CALL SBINY (85)                                                 
CX10615 CALL DOINX( 615 )                                               
CY10615 CALL DOINY( 615 )                                               
      DO 300 K = 1, N                                                   
      DO 200 I = 1, L                                                   
      SUM = 0.                                                          
      DO 100 J = 1, M                                                   
      SUM = SUM + A(J,I)*B(J,K)                                         
 100  CONTINUE                                                          
      C(I,K) = SUM                                                      
 200  CONTINUE                                                          
 300  CONTINUE                                                          
CX20616 CALL DOOUTX( 616 )                                              
CY20616 CALL DOOUTY( 616 )                                              
CX40086 CALL SBOUTX (86)                                                
CY40086 CALL SBOUTY (86)                                                
C                                                                       
C EXIT                                                                  
C                                                                       
      RETURN                                                            
      END                                                               
*DECK                                            MATSUB                 
      SUBROUTINE MATSUB(A, B, C, M, N)                                  
C********************************************************************** 
C MATRIX SUBTRACTION [C] = [A] - [B]                                    
C********************************************************************** 
      DIMENSION A(M,N), B(M,N), C(M,N)                                  
CX30087 CALL SBINX (87)                                                 
CY30087 CALL SBINY (87)                                                 
CX10617 CALL DOINX( 617 )                                               
CY10617 CALL DOINY( 617 )                                               
      DO 200 J = 1, N                                                   
      DO 100 I = 1, M                                                   
      C(I,J) = A(I,J) - B(I,J)                                          
 100  CONTINUE                                                          
 200  CONTINUE                                                          
CX20618 CALL DOOUTX( 618 )                                              
CY20618 CALL DOOUTY( 618 )                                              
CX40088 CALL SBOUTX (88)                                                
CY40088 CALL SBOUTY (88)                                                
      RETURN                                                            
      END                                                               
*DECK                                            MATTRA                 
      SUBROUTINE MATTRA(A, B, NRA, NCA)                                 
C********************************************************************** 
C  TRANSPOSE OF A INTO B                                                
C********************************************************************** 
      DIMENSION A(NRA,NCA), B(NCA, NRA)                                 
CX30089 CALL SBINX (89)                                                 
CY30089 CALL SBINY (89)                                                 
CX10619 CALL DOINX( 619 )                                               
CY10619 CALL DOINY( 619 )                                               
      DO 10 I=1,NRA                                                     
      DO 10 J=1,NCA                                                     
        B(J,I) = A(I,J)                                                 
  10  CONTINUE                                                          
CX20620 CALL DOOUTX( 620 )                                              
CY20620 CALL DOOUTY( 620 )                                              
CX40090 CALL SBOUTX (90)                                                
CY40090 CALL SBOUTY (90)                                                
      RETURN                                                            
      END                                                               
*DECK                                            MATTRN                 
      SUBROUTINE MATTRN(A, N)                                           
C********************************************************************** 
C TRANSPOSE THE SQUARE MATRIX A IN PLACE                                
C********************************************************************** 
      INTEGER N                                                         
      REAL A(N,N)                                                       
C                                                                       
      INTEGER NM1, J, JP1, I                                            
      REAL TEMP                                                         
CX30091 CALL SBINX (91)                                                 
CY30091 CALL SBINY (91)                                                 
      NM1 = N - 1                                                       
      IF (NM1 .EQ. 0) THEN                                              
CX40092 CALL SBOUTX (92)                                                
CY40092 CALL SBOUTY (92)                                                
      RETURN                                                            
      ENDIF                                                             
CX10621 CALL DOINX( 621 )                                               
CY10621 CALL DOINY( 621 )                                               
      DO 200 J = 1, NM1                                                 
      JP1 = J + 1                                                       
      DO 100 I = JP1, N                                                 
      TEMP = A(I,J)                                                     
      A(I,J) = A(J,I)                                                   
      A(J,I) = TEMP                                                     
 100  CONTINUE                                                          
 200  CONTINUE                                                          
CX20622 CALL DOOUTX( 622 )                                              
CY20622 CALL DOOUTY( 622 )                                              
CX40092 CALL SBOUTX (92)                                                
CY40092 CALL SBOUTY (92)                                                
C                                                                       
C EXIT                                                                  
C                                                                       
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            MNLBYX                 
      SUBROUTINE MNLBYX(M, X, MX)                                       
C********************************************************************** 
C     MULTIPLY THE THREE DIMENSIONAL NONLINEAR STRESS-DISPL-DISPL       
C     ARRAY BY X TO GIVE A TWO DIMENSIONAL STRESS-DISPL ARRAY.          
C     ONLY THE NONZERO NODAL PARTITIONS ARE STORED.                     
C     THE M(I,J,K) ARRAY IS SYMMETRIC UPON INTERCHANGE OF THE J AND     
C     K SUBSCRIPTS.                                                     
C                                                                       
C     M(I,J,K) * X(K) ==> MX(J,K) IS DONE FOR THE FOLLOWING             
C     NODAL PARITITONS:                                                 
C                                                                       
C     [1,3,3] * [3] ==>   [1,3]              I=STRESS NODE              
C     [2,3,3] * [3] ==>   [2,3]              J,K=DISPLACEMENT NODE      
C     [3,3,3] * [3] ==>   [3,3]                                         
C                                                                       
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK INDEX                                                          
C---------------                                                        
      COMMON /INDEX/ M1(ZNNPED)                                         
C                                                                       
C M1      - INDEX USED FOR REFERENCING SYMMETRIC MATRICES (WHERE ONLY   
C           THE UPPER TRIANGULAR PART IS STORED).                       
C           M1(J)+I   I <=J WOULD REFER TO THE (I,J) ENTRY.             
C                                                                       
      REAL M(NNPES,NNPED*(NNPED+1)/2,3), MX(NNPES,NNPED,3),             
     *     X(NDDF,NNPED)                                                
CX30093 CALL SBINX (93)                                                 
CY30093 CALL SBINY (93)                                                 
CX10623 CALL DOINX( 623 )                                               
CY10623 CALL DOINY( 623 )                                               
C                                                                       
      DO 50 N = 1, 3                                                    
         DO 40 I = 1, NNPES                                             
            DO 30 J = 1, NNPED                                          
C                                                                       
               SUM = 0.                                                 
               M1J = M1(J)                                              
               DO 10 K = 1, J                                           
                  JK = M1J+K                                            
                  SUM = SUM + M(I,JK,N) * X(3,K)                        
  10           CONTINUE                                                 
C                                                                       
               DO 20 K = J+1, NNPED                                     
                  JK = M1(K) + J                                        
                  SUM = SUM + M(I,JK,N) * X(3,K)                        
  20           CONTINUE                                                 
C                                                                       
               MX(I,J,N) = SUM                                          
  30        CONTINUE                                                    
  40     CONTINUE                                                       
  50  CONTINUE                                                          
CX20624 CALL DOOUTX( 624 )                                              
CY20624 CALL DOOUTY( 624 )                                              
CX40094 CALL SBOUTX (94)                                                
CY40094 CALL SBOUTY (94)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            MNLX2H                 
      SUBROUTINE MNLX2H(MX, H, MXH)                                     
C********************************************************************** 
C     MULTIPLY [MX] BY H TO GIVE MXH.                                   
C                                                                       
C     MX(I,J) * H(I) ==> MXH(J)     I=STRESS NODE, J=DISPL NODE         
C                                                                       
C     [1,3]*[1] + [2,3]*[2] + [3,3]*[3] ==> [3]                         
C********************************************************************** 
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
      REAL MX(NNPES,NNPED,3), H(NSDF,NNPES), MXH(NNPED)                 
CX30095 CALL SBINX (95)                                                 
CY30095 CALL SBINY (95)                                                 
CX10625 CALL DOINX( 625 )                                               
CY10625 CALL DOINY( 625 )                                               
C                                                                       
      DO 5 J = 1, NNPED                                                 
         MXH(J) = 0.                                                    
   5  CONTINUE                                                          
CX20626 CALL DOOUTX( 626 )                                              
CY20626 CALL DOOUTY( 626 )                                              
CX10627 CALL DOINX( 627 )                                               
CY10627 CALL DOINY( 627 )                                               
C                                                                       
      DO 30 N = 1, 3                                                    
         DO 20 I = 1, NNPES                                             
            DO 10 J = 1, NNPED                                          
               MXH(J) = MXH(J) + MX(I,J,N) * H(N,I)                     
  10        CONTINUE                                                    
  20     CONTINUE                                                       
  30  CONTINUE                                                          
CX20628 CALL DOOUTX( 628 )                                              
CY20628 CALL DOOUTY( 628 )                                              
CX40096 CALL SBOUTX (96)                                                
CY40096 CALL SBOUTY (96)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            MNLX2X                 
      SUBROUTINE MNLX2X(MX, X, MXX)                                     
C********************************************************************** 
C     MULTIPLY [MX] BY X TO GIVE MXX.                                   
C                                                                       
C     MX(I,J) * X(J) ==> MXX(I)     I=STRESS NODE, J=DISPL NODE         
C                                                                       
C     [1,3] * [3] ==> [1]                                               
C     [2,3] * [3] ==> [2]                                               
C     [3,3] * [3] ==> [3]                                               
C********************************************************************** 
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
      REAL MX(NNPES,NNPED,3), X(NDDF,NNPED), MXX(3,NNPES)               
CX30097 CALL SBINX (97)                                                 
CY30097 CALL SBINY (97)                                                 
CX10629 CALL DOINX( 629 )                                               
CY10629 CALL DOINY( 629 )                                               
C                                                                       
      DO 30 N = 1, 3                                                    
         DO 20 I = 1, NNPES                                             
            SUM = 0.                                                    
            DO 10 J = 1, NNPED                                          
               SUM = SUM + MX(I,J,N) * X(3,J)                           
  10        CONTINUE                                                    
            MXX(N,I) = SUM                                              
  20     CONTINUE                                                       
  30  CONTINUE                                                          
CX20630 CALL DOOUTX( 630 )                                              
CY20630 CALL DOOUTY( 630 )                                              
CX40098 CALL SBOUTX (98)                                                
CY40098 CALL SBOUTY (98)                                                
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            MXMULT                 
      SUBROUTINE MXMULT(X, MX)                                          
C********************************************************************** 
C     MULTIPLY THE MASS MATRIX BY X TO GIVE MX.  FORM BY ELEMENTS.      
C     THIS MULTIPLICATION COULD ALSO BE DONE GLOBALLY IF DESIRED.       
C********************************************************************** 
      REAL X(*), MX(*)                                                  
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
CX30099 CALL SBINX (99)                                                 
CY30099 CALL SBINY (99)                                                 
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
CCC   PRINT *, ' SUBROUTINE MXMULT '                                    
C                                                                       
C     . LOOP OVER THE SUBSTRUCTURES .                                   
      ILOCB = PPTR(NBLOCK)                                              
      NEQB = IBLEN(NBLOCK)                                              
      CALL ZEROV(MX(ILOCB), NEQB)                                       
CX10631 CALL DOINX( 631 )                                               
CY10631 CALL DOINY( 631 )                                               
      DO 10 ISS = 1, NSS                                                
CCC      PRINT *, ' ISS ',ISS                                           
         ILOC = PPTR(ISS)                                               
         NEQI = IBLEN(ISS)                                              
C        . FORM BLOCK MXI COMPLETELY ; AND PART OF MXB .                
CCC      PRINT *, ' CALL BLCKMX '                                       
         CALL BLCKMX(ISS, MX(ILOC), MX(ILOCB), X, NEQI, NEQB)           
  10  CONTINUE                                                          
CX20632 CALL DOOUTX( 632 )                                              
CY20632 CALL DOOUTY( 632 )                                              
CX40100 CALL SBOUTX (100)                                               
CY40100 CALL SBOUTY (100)                                               
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            OTMATX                 
      SUBROUTINE OTMATX(K,MNROWS,NROWS,NCOLS,NFMT,IOUTF,LABEL)          
C                                                                       
C***********************************************************************
C                                                                       
C  WRITE [K] ON FILE "IOUTF" WITH "NFMT" NUMBERS PER LINE               
C                                                                       
C***********************************************************************
C                                                                       
      REAL K(MNROWS,NCOLS)                                              
      CHARACTER*(*) LABEL                                               
CX30101 CALL SBINX (101)                                                
CY30101 CALL SBINY (101)                                                
C                                                                       
      WRITE(IOUTF,10) LABEL,NROWS,NCOLS                                 
  10  FORMAT('0',A/'   NROWS =',I5,' NCOLS=',I5)                        
      IEND = 0                                                          
      NNN = NCOLS/NFMT                                                  
      IF (MOD(NCOLS,NFMT).NE.0) NNN = NNN+1                             
CX10633 CALL DOINX( 633 )                                               
CY10633 CALL DOINY( 633 )                                               
      DO 40 II=1,NNN                                                    
         IST = IEND+1                                                   
         IEND = IST+NFMT-1                                              
         IEND = MIN(IEND,NCOLS)                                         
         WRITE(IOUTF,23) (I,I=IST,IEND)                                 
  23     FORMAT('0',5X,10I12)                                           
C                                                                       
         DO 30 IR=1,NROWS                                               
            WRITE(IOUTF,20)  IR, (K(IR,J),J=IST,IEND)                   
  20        FORMAT(I6,10E13.6)                                          
  30     CONTINUE                                                       
C                                                                       
  40  CONTINUE                                                          
CX20634 CALL DOOUTX( 634 )                                              
CY20634 CALL DOOUTY( 634 )                                              
CX40102 CALL SBOUTX (102)                                               
CY40102 CALL SBOUTY (102)                                               
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            QUAD                   
      SUBROUTINE QUAD                                                   
C********************************************************************** 
C THIS SUBROUTINE SETS UP THE NUMERICAL INTEGRATION QUADRATURE          
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
CX30103 CALL SBINX (103)                                                
CY30103 CALL SBINY (103)                                                
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      IF (NQD.EQ.25) CALL QUAD25                                        
      IF (NQD.EQ.25) THEN                                               
CX40104 CALL SBOUTX (104)                                               
CY40104 CALL SBOUTY (104)                                               
      RETURN                                                            
      ENDIF                                                             
      IF (NQD.EQ.16) CALL QUAD16                                        
      IF (NQD.EQ.16) THEN                                               
CX40104 CALL SBOUTX (104)                                               
CY40104 CALL SBOUTY (104)                                               
      RETURN                                                            
      ENDIF                                                             
      IF (NQD.EQ.9) CALL QUAD9                                          
      IF (NQD.EQ.9) THEN                                                
CX40104 CALL SBOUTX (104)                                               
CY40104 CALL SBOUTY (104)                                               
      RETURN                                                            
      ENDIF                                                             
      IF (NQD.EQ.4) CALL QUAD4                                          
      IF (NQD.EQ.4) THEN                                                
CX40104 CALL SBOUTX (104)                                               
CY40104 CALL SBOUTY (104)                                               
      RETURN                                                            
      ENDIF                                                             
      IF (NQD.EQ.1) CALL QUAD1                                          
      IF (NQD.EQ.1) THEN                                                
CX40104 CALL SBOUTX (104)                                               
CY40104 CALL SBOUTY (104)                                               
      RETURN                                                            
      ENDIF                                                             
      WRITE(6,12) NQD                                                   
  12  FORMAT('0NUMERICAL QUADRATURE ORDER OF ', I5,                     
     .       ' IS NOT IMPLEMENTED')                                     
C     CALL ERRORS                                                       
      CALL ERRORS('NO MESSAGE')                                         
CX40104 CALL SBOUTX (104)                                               
CY40104 CALL SBOUTY (104)                                               
      RETURN                                                            
      END                                                               
*DECK                                            QUAD1                  
      SUBROUTINE QUAD1                                                  
C********************************************************************** 
C THIS SUBROUTINE SETS UP THE NUMERICAL INTEGRATION QUADRATURE          
C COORDINATES AND WEIGHTS OF ORDER 1 FOR A QUADRILATERAL ELEMENT.       
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
CX30105 CALL SBINX (105)                                                
CY30105 CALL SBINY (105)                                                
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      QDCOOR(1,1) = 0.                                                  
      QDCOOR(2,1) = 0.                                                  
      QDWGHT(1)   = 4.                                                  
CX40106 CALL SBOUTX (106)                                               
CY40106 CALL SBOUTY (106)                                               
      RETURN                                                            
      END                                                               
*DECK                                            QUAD16                 
      SUBROUTINE QUAD16                                                 
C********************************************************************** 
C THIS SUBROUTINE SETS UP THE NUMERICAL INTEGRATION QUADRATURE          
C COORDINATES AND WEIGHTS OF ORDER 16 FOR A QUADRILATERAL ELEMENT.      
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      DIMENSION QDC(4), QDW(4)                                          
      DATA QDC                                                          
     ./-.861136311594053, -.339981043584856,                            
     .                     .339981043584856,                            
     .  .861136311594053/,                                              
     .     QDW                                                          
     ./ .347854845137454,  .652145154862546,                            
     .                     .652145154862546,                            
     .  .347854845137454/                                               
CX30107 CALL SBINX (107)                                                
CY30107 CALL SBINY (107)                                                
CX10635 CALL DOINX( 635 )                                               
CY10635 CALL DOINY( 635 )                                               
      DO 210 JQ = 1, 4                                                  
        DO 200 IQ = 1, 4                                                
          QDCOOR(1,JQ*4-4+IQ) = QDC(IQ)                                 
          QDCOOR(2,JQ*4-4+IQ) = QDC(JQ)                                 
          QDWGHT(  JQ*4-4+IQ) = QDW(IQ) * QDW(JQ)                       
 200    CONTINUE                                                        
 210  CONTINUE                                                          
CX20636 CALL DOOUTX( 636 )                                              
CY20636 CALL DOOUTY( 636 )                                              
CX40108 CALL SBOUTX (108)                                               
CY40108 CALL SBOUTY (108)                                               
      RETURN                                                            
      END                                                               
*DECK                                            QUAD25                 
      SUBROUTINE QUAD25                                                 
C********************************************************************** 
C THIS SUBROUTINE SETS UP THE NUMERICAL INTEGRATION QUADRATURE          
C COORDINATES AND WEIGHTS OF ORDER 25 FOR A QUADRILATERAL ELEMENT.      
C********************************************************************** 
C                                                                       
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      DIMENSION QDC(5), QDW(5)                                          
      DATA QDC                                                          
     ./-.906179845938664, -.538469310105683, .0,                        
     .                     .538469310105638,                            
     .  .906179845938664/,                                              
     .     QDW                                                          
     ./ .236926885056189,  .478628670499366, .568888888888889,          
     .                     .478628670499366,                            
     .  .236926885056189/                                               
CX30109 CALL SBINX (109)                                                
CY30109 CALL SBINY (109)                                                
CX10637 CALL DOINX( 637 )                                               
CY10637 CALL DOINY( 637 )                                               
      DO 210 JQ = 1, 5                                                  
        DO 200 IQ = 1, 5                                                
          QDCOOR(1,JQ*5-5+IQ) = QDC(IQ)                                 
          QDCOOR(2,JQ*5-5+IQ) = QDC(JQ)                                 
          QDWGHT(  JQ*5-5+IQ) = QDW(IQ) * QDW(JQ)                       
 200    CONTINUE                                                        
 210  CONTINUE                                                          
CX20638 CALL DOOUTX( 638 )                                              
CY20638 CALL DOOUTY( 638 )                                              
CX40110 CALL SBOUTX (110)                                               
CY40110 CALL SBOUTY (110)                                               
      RETURN                                                            
      END                                                               
*DECK                                            QUAD4                  
      SUBROUTINE QUAD4                                                  
C********************************************************************** 
C THIS SUBROUTINE SETS UP THE NUMERICAL INTEGRATION QUADRATURE          
C COORDINATES AND WEIGHTS OF ORDER 4 FOR A QUADRILATERAL ELEMENT.       
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      DIMENSION QDC(2), QDW(2)                                          
      DATA QDC                                                          
     ./-.577350269189626,                                               
     .  .577350269189626/,                                              
     .     QDW                                                          
     ./ 1.0,  1.0 /                                                     
CX30111 CALL SBINX (111)                                                
CY30111 CALL SBINY (111)                                                
CX10639 CALL DOINX( 639 )                                               
CY10639 CALL DOINY( 639 )                                               
      DO 210 JQ = 1, 2                                                  
        DO 200 IQ = 1, 2                                                
          QDCOOR(1,JQ*2-2+IQ) = QDC(IQ)                                 
          QDCOOR(2,JQ*2-2+IQ) = QDC(JQ)                                 
          QDWGHT(  JQ*2-2+IQ) = QDW(IQ) * QDW(JQ)                       
 200    CONTINUE                                                        
 210  CONTINUE                                                          
CX20640 CALL DOOUTX( 640 )                                              
CY20640 CALL DOOUTY( 640 )                                              
CX40112 CALL SBOUTX (112)                                               
CY40112 CALL SBOUTY (112)                                               
      RETURN                                                            
      END                                                               
*DECK                                            QUAD9                  
      SUBROUTINE QUAD9                                                  
C********************************************************************** 
C THIS SUBROUTINE SETS UP THE NUMERICAL INTEGRATION QUADRATURE          
C COORDINATES AND WEIGHTS OF ORDER 9 FOR A QUADRILATERAL ELEMENT.       
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      DIMENSION QDC(3), QDW(3)                                          
      DATA QDC                                                          
     ./-.774596669241483, .0,                                           
     .  .774596669241483/,                                              
     .     QDW                                                          
     ./ .555555555555556,  .888888888888889,                            
     .  .555555555555556/                                               
CX30113 CALL SBINX (113)                                                
CY30113 CALL SBINY (113)                                                
CX10641 CALL DOINX( 641 )                                               
CY10641 CALL DOINY( 641 )                                               
      DO 210 JQ = 1, 3                                                  
        DO 200 IQ = 1, 3                                                
          QDCOOR(1,JQ*3-3+IQ) = QDC(IQ)                                 
          QDCOOR(2,JQ*3-3+IQ) = QDC(JQ)                                 
          QDWGHT(  JQ*3-3+IQ) = QDW(IQ) * QDW(JQ)                       
 200    CONTINUE                                                        
 210  CONTINUE                                                          
CX20642 CALL DOOUTX( 642 )                                              
CY20642 CALL DOOUTY( 642 )                                              
CX40114 CALL SBOUTX (114)                                               
CY40114 CALL SBOUTY (114)                                               
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            SAVE                   
      SUBROUTINE SAVE                                                   
C                                                                       
C***********************************************************************
C                                                                       
C     SAVE THE RESULTS                                                  
C                                                                       
C***********************************************************************
C                                                                       
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK ENRGYC                                                         
      REAL KINE                                                         
      COMMON /ENRGYC/ KINE                                              
C                                                                       
C KINE    - KINETIC ENERGY                                              
                                                                        
*COMDECK CONJGC                                                         
      COMMON /CONJGC/ TOLCG, ITLMCG, ITERCG, ERORCG                     
C                                                                       
C CONJUGATE GRADIENT COMMON                                             
C                                                                       
C TOLCG   - ERROR TOLERANCE                                             
C ITLMCG  - ITERATION LIMIT                                             
C ITERCG  - CURRENT ITERATION NUMBER                                    
C ERORCG  - ERROR NORM                                                  
C                                                                       
CMWB                                                                    
      COMMON /VERIFY/ IVALID                                            
C                                                                       
      DIMENSION WK(30), LAB(30)                                         
C     CHARACTER*6 CSTEP                                                 
C                                                                       
C*****INSERTED CHARACTER DECLARATION FOR LAB                            
C                                                                       
      CHARACTER*13 LAB                                                  
C                                                                       
      DATA IREC /0/                                                     
CX30115 CALL SBINX (115)                                                
CY30115 CALL SBINY (115)                                                
C                                                                       
C     . OUTPUT THE STEP NUMBER AS A REMARK .                            
C    WRITE(CSTEP,'(1X,I5)') ISTEP                                       
C     CALL REMARK(CSTEP)                                                
      WRITE(6,*) 'ISTEP ',ISTEP                                         
C                                                                       
      IREC = IREC+1                                                     
      MM = (NODEM-1)*NDDF + IDOFM                                       
      WK(1) = TIME                                                      
      WK(2) = X(MM)                                                     
      WK(3) = XD(MM)                                                    
      WK(4) = KINE                                                      
      WK(5) = ITERCG                                                    
      WK(6) = ERORCG                                                    
C                                                                       
      LAB(1) = 'TIME'                                                   
      LAB(2) = 'X'                                                      
      LAB(3) = 'XDD'                                                    
      LAB(4) = 'KINE'                                                   
      LAB(5) = 'ITERCG'                                                 
      LAB(6) = 'ERORCG'                                                 
      LENREC = 6                                                        
C                                                                       
      IF (IREC.EQ.1) WRITE(14,2) TITLE,                                 
     *   (LAB(I),I=1,LENREC)                                            
      WRITE(14,4) IREC,(WK(I),I=1,LENREC)                               
C                                                                       
C     . SAVE THE SOLUTION FOR RESTART RUN .                             
      REWIND 1                                                          
      WRITE(1,10) TIME, (X(I),I=1,NEQD), (XD(I),I=1,NEQD)               
10    FORMAT(1X,3E25.16)                                                
C                                                                       
C*************************************************************          
CMWB 2-87-88                                                            
C                                                                       
C VERIFYING RUN FOR DATA: NE=4,NNS=16,NND=25,NSTEPS=1000                
C                         (2X2 ELEMENT GRID)                            
C                                                                       
C.....WRITE TO VERIFICATION OUTPUT FILE VERIFY                          
C     IVALID=0 -> RESULTS OK, IVALID=1 -> BAD RESULTS                   
C                                                                       
      IF(WK(1).EQ.0.0) THEN                                             
      IVALID=0                                                          
      WRITE(15,33)                                                      
33    FORMAT(1X,
     * 'OUTPUT FOR PERFECT CLUB BENCHMARK: DYFESM INSTRUMENTED VERSION'/
     *       1X,'$Revision: 1.A.1 $ $Author: psharma $'/)                    
      WRITE(15,34)                                                      
34    FORMAT(1X,'VALIDATION PARAMETERS:'/)                              
      ENDIF                                                             
C                                                                       
      IF (IREC.EQ.1) WRITE(15,3) TITLE,                                 
     *   (LAB(I),I=1,LENREC)                                            
      WRITE(15,5) IREC,(WK(I),I=1,LENREC)                               
C                                                                       
      IF(WK(1).EQ.0.0) THEN                                             
CX10643 CALL DOINX( 643 )                                               
CY10643 CALL DOINY( 643 )                                               
         DO 20 II=2,4                                                   
            IF(WK(II).NE.0.0) IVALID=1                                  
20       CONTINUE                                                       
CX20644 CALL DOOUTX( 644 )                                              
CY20644 CALL DOOUTY( 644 )                                              
      ELSE                                                              
C                                                                       
      IF(ABS((WK(2)+.787547E-03)/.787547E-03).GE.1E-2) IVALID=1         
      IF(ABS((WK(3)+.105785E+02)/.105785E+02).GE.1E-2) IVALID=1         
      IF(ABS((WK(4)-.234938E-03)/.234938E-03).GE.1E-2) IVALID=1         
C                                                                       
      ENDIF                                                             
C                                                                       
      IF(WK(1).NE.0.0) THEN                                             
         IF(IVALID.EQ.0) THEN                                           
           WRITE(15,35)                                                 
35         FORMAT(//1X,'RESULTS FOR THIS RUN ARE:   VALID')             
         ELSE                                                           
           WRITE(15,36)                                                 
36         FORMAT(//1X,'RESULTS FOR THIS RUN ARE: INVALID')             
         ENDIF                                                          
      ENDIF                                                             
CX40116 CALL SBOUTX (116)                                               
CY40116 CALL SBOUTY (116)                                               
C                                                                       
C*************************************************************          
C                                                                       
      RETURN                                                            
C                                                                       
C*****CHANGED FORMAT STMNT 2                                            
C     ADDED FORMAT STATMENTS 3 AND 5 FOR VERIFICATION FILE              
C     OUTPUT.  L. KIPP, 5-25-89                                         
C                                                                       
C  2  FORMAT('1',A/(6X,10A13))                                          
   2  FORMAT('1',A80/(6X,10A13))                                        
   3  FORMAT(1X,A70//(7X,6A12))                                         
   4  FORMAT(1X,I5,10E13.6/(6X,10E13.6))                                
   5  FORMAT(1X,I2,6E12.4/(3X,6E12.4))                                  
CX40116 CALL SBOUTX (116)                                               
CY40116 CALL SBOUTY (116)                                               
      END                                                               
*DECK                                            SCMULT                 
      SUBROUTINE SCMULT(SC,V,N)                                         
      REAL V(N)                                                         
C********************************************************************** 
CX30117 CALL SBINX (117)                                                
CY30117 CALL SBINY (117)                                                
CX10645 CALL DOINX( 645 )                                               
CY10645 CALL DOINY( 645 )                                               
C     MULTIPLY A SCALAR BY A VECTOR                                     
C********************************************************************** 
      DO 5 I=1,N                                                        
         V(I) = SC*V(I)                                                 
   5  CONTINUE                                                          
CX20646 CALL DOOUTX( 646 )                                              
CY20646 CALL DOOUTY( 646 )                                              
CX40118 CALL SBOUTX (118)                                               
CY40118 CALL SBOUTY (118)                                               
      RETURN                                                            
      END                                                               
*DECK                                            GHGX                   
      SUBROUTINE SETGX(GX, RKAPPA)                                      
      DIMENSION GX(5)                                                   
C********************************************************************** 
CX30119 CALL SBINX (119)                                                
CY30119 CALL SBINY (119)                                                
C     SET UP GX DIAGONAL TRANSFORMATION MATRIX                          
C        FOR INVERSION SYMMETRY.                                        
C********************************************************************** 
      IF (RKAPPA.EQ.1.) GO TO 1                                         
      IF (RKAPPA.EQ.-1.) GO TO 2                                        
      IF (RKAPPA.EQ.2.) GO TO 3                                         
C                                                                       
   1  CONTINUE                                                          
C     . SYMMETRIC .                                                     
      GX(1) = -1.                                                       
      GX(2) = -1.                                                       
      GX(3) = +1.                                                       
      GX(4) = -1.                                                       
      GX(5) = -1.                                                       
CX40120 CALL SBOUTX (120)                                               
CY40120 CALL SBOUTY (120)                                               
      RETURN                                                            
C                                                                       
   2  CONTINUE                                                          
C     . ANTI-SYMMETRIC .                                                
      GX(1) = +1.                                                       
      GX(2) = +1.                                                       
      GX(3) = -1.                                                       
      GX(4) = +1.                                                       
      GX(5) = +1.                                                       
CX40120 CALL SBOUTX (120)                                               
CY40120 CALL SBOUTY (120)                                               
      RETURN                                                            
C                                                                       
   3  CONTINUE                                                          
C     . SYMMETRIC IN U, V .                                             
C     . ANTI-SYMMETRIC IN W, PHI1, PHI2 .                               
      GX(1) = -1.                                                       
      GX(2) = -1.                                                       
      GX(3) = -1.                                                       
      GX(4) = +1.                                                       
      GX(5) = +1.                                                       
CX40120 CALL SBOUTX (120)                                               
CY40120 CALL SBOUTY (120)                                               
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            SETHM                  
      SUBROUTINE SETHM                                                  
C********************************************************************** 
C     SET UP THE HYPERMATRIX BLOCK STRUCTURE.                           
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK WHERE                                                          
      COMMON /WHERE/ IWHERD(ZNND,2)                                     
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
*COMDECK BCD                                                            
C---------------                                                        
      COMMON /BCD/ NBCN(ZNBN), ALPHBC(ZNBN), IFLAGD(5,ZNBN),            
     *             BCVALD(5,ZNBN)                                       
CX30121 CALL SBINX (121)                                                
CY30121 CALL SBINY (121)                                                
C                                                                       
C NBCN    - BOUNDARY CONDITION NODE NUMBERS                             
C ALPHBC  - BOUNDARY CONDITION NODE ROTATION ANGLES (DEGREES) *NOTUSED* 
C IFLAGD  - NODAL DISPL. DEGREE OF FREEDOM FLAGS                        
C           (                       0 MEANS THE D.O.F. IS FREE          
C                                   1 MEANS THE D.O.F. IS PRESCRIBED)   
C BCVALD  - DISPL. PRESCRIBED VALUES  *NOTUSED*                         
C                                                                       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                       
      WRITE(6,*) ' SUBROUTINE SETHM '                                   
C                                                                       
      NBLOCK = NSS + 1                                                  
      IF (NSS .EQ. 1) NBLOCK = 1                                        
      WRITE(6,*) ' NBLOCK = ',NBLOCK                                    
C                                                                       
C CALCULATE THE BLOCK LENGTHS                                           
C                                                                       
      ISUM = 0                                                          
CX10647 CALL DOINX( 647 )                                               
CY10647 CALL DOINY( 647 )                                               
      DO 5 I = 1, NBLOCK-1                                              
         IBLEN(I) = NNPSS(I)*NDDF                                       
         ISUM = ISUM + NNPSS(I)                                         
   5  CONTINUE                                                          
CX20648 CALL DOOUTX( 648 )                                              
CY20648 CALL DOOUTY( 648 )                                              
C     . THE LAST BLOCK CONTAINS THE NUMBER OF NODES LEFT OVER .         
      NNLEFT = NND - ISUM                                               
      IBLEN(NBLOCK) = NNLEFT*NDDF                                       
      WRITE (9,8) (IBLEN(I),I=1,NBLOCK)                                 
   8  FORMAT(//' HYPERMATRIX BLOCK LENGTHS ARE '/ (5X,20I5))            
C                                                                       
C FILL UP THE ARRAY CONTAINING THE BLOCK NUMBER AND RELATIVE LOCATION   
C WITHIN THE BLOCK                                                      
C                                                                       
      NODE = 0                                                          
CX10649 CALL DOINX( 649 )                                               
CY10649 CALL DOINY( 649 )                                               
      DO 15 ISS = 1, NBLOCK-1                                           
         IREL = 1                                                       
         DO 10 I = 1, NNPSS(ISS)                                        
            NODE = NODE + 1                                             
            IWHERD(NODE,1) = ISS                                        
            IWHERD(NODE,2) = IREL                                       
            IREL = IREL + NDDF                                          
  10     CONTINUE                                                       
  15  CONTINUE                                                          
CX20650 CALL DOOUTX( 650 )                                              
CY20650 CALL DOOUTY( 650 )                                              
C     . LAST BLOCK .                                                    
      IREL = 1                                                          
CX10651 CALL DOINX( 651 )                                               
CY10651 CALL DOINY( 651 )                                               
      DO 20 I = 1, NNLEFT                                               
         NODE = NODE + 1                                                
         IWHERD(NODE,1) = NBLOCK                                        
         IWHERD(NODE,2) = IREL                                          
         IREL = IREL + NDDF                                             
  20  CONTINUE                                                          
CX20652 CALL DOOUTX( 652 )                                              
CY20652 CALL DOOUTY( 652 )                                              
C                                                                       
      WRITE (9,25) (I, IWHERD(I,1), IWHERD(I,2), I = 1, NND)            
  25  FORMAT('0FOR EACH NODE THE HYPERMATRIX BLOCK NUMBER AND RELATIVE  
     .LOCATION ARE '/ (1X, 5(5X, 3I5)))                                 
CX10653 CALL DOINX( 653 )                                               
CY10653 CALL DOINY( 653 )                                               
C                                                                       
C SET UP THE NUMBER OF BOUNDARY NODES PER BLOCK                         
C                                                                       
      DO 30 I = 1, NBLOCK                                               
         NBNPB(I) = 0                                                   
  30  CONTINUE                                                          
CX20654 CALL DOOUTX( 654 )                                              
CY20654 CALL DOOUTY( 654 )                                              
CX10655 CALL DOINX( 655 )                                               
CY10655 CALL DOINY( 655 )                                               
      DO 35 IBN = 1, NBN                                                
         NODE = NBCN(IBN)                                               
         IBLOCK = IWHERD(NODE,1)                                        
         NBNPB(IBLOCK) = NBNPB(IBLOCK)+1                                
  35  CONTINUE                                                          
CX20656 CALL DOOUTX( 656 )                                              
CY20656 CALL DOOUTY( 656 )                                              
      WRITE(6,*) ' NBNPB ',(NBNPB(I),I=1,NBLOCK)                        
C                                                                       
C SET UP THE POINTERS TO WHERE THE BOUNDARY NODES BEGIN                 
C                                                                       
      IPTR = 1                                                          
CX10657 CALL DOINX( 657 )                                               
CY10657 CALL DOINY( 657 )                                               
      DO 40 IBLOCK = 1, NBLOCK                                          
         IBCPTR(IBLOCK) = IPTR                                          
         IPTR = IPTR + NBNPB(IBLOCK)                                    
  40  CONTINUE                                                          
CX20658 CALL DOOUTX( 658 )                                              
CY20658 CALL DOOUTY( 658 )                                              
      WRITE(6,*) ' IBCPTR IS ',(IBCPTR(I),I=1,NBLOCK)                   
C                                                                       
C     . SET UP POINTERS TO THE RIGHT HAND SIDE BLOCKS .                 
      IPTR = 1                                                          
CX10659 CALL DOINX( 659 )                                               
CY10659 CALL DOINY( 659 )                                               
      DO 50 I = 1, NBLOCK                                               
         PPTR(I) = IPTR                                                 
         IPTR = IPTR + IBLEN(I)                                         
  50  CONTINUE                                                          
CX20660 CALL DOOUTX( 660 )                                              
CY20660 CALL DOOUTY( 660 )                                              
      WRITE(6,*) ' PPTR IS ',(PPTR(I),I=1,NBLOCK)                       
CX40122 CALL SBOUTX (122)                                               
CY40122 CALL SBOUTY (122)                                               
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            SETUP                  
      SUBROUTINE SETUP                                                  
C********************************************************************** 
C     DO ANY INITIALIZATION                                             
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK INDEX                                                          
C---------------                                                        
      COMMON /INDEX/ M1(ZNNPED)                                         
C                                                                       
C M1      - INDEX USED FOR REFERENCING SYMMETRIC MATRICES (WHERE ONLY   
C           THE UPPER TRIANGULAR PART IS STORED).                       
C           M1(J)+I   I <=J WOULD REFER TO THE (I,J) ENTRY.             
C                                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
CX30123 CALL SBINX (123)                                                
CY30123 CALL SBINY (123)                                                
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
      WRITE(6,*) ' SUBROUTINE SETUP '                                   
C                                                                       
C     . SET THE NUMBER OF EQUATIONS .                                   
      NEQS = NNS*NSDF                                                   
      NEQD = NND*NDDF                                                   
      WRITE(6,*) ' NEQS = ',NEQS,' NEQD = ',NEQD                        
C                                                                       
C     . SET UP LENGTH OF ELEMENT ARRAYS .                               
      NSFE = NNPES*NSDF                                                 
      NDFE = NNPED*NDDF                                                 
      WRITE(6,*) ' NSFE = ',NSFE,' NDFE = ',NDFE                        
C                                                                       
C     . SET UP THE ARRAY USED TO REFERENCE SYMMETRIC MATRICES .         
      M1(1) = 0                                                         
CX10661 CALL DOINX( 661 )                                               
CY10661 CALL DOINY( 661 )                                               
      DO 10 I=2,NNPED                                                   
         M1(I) = M1(I-1) + I - 1                                        
  10  CONTINUE                                                          
CX20662 CALL DOOUTX( 662 )                                              
CY20662 CALL DOOUTY( 662 )                                              
      WRITE(6,15) (M1(I),I=1,NNPED)                                     
 15   FORMAT(/' ARRAY M1 IS'/(5X,16I6))                                 
C                                                                       
C     . SET UP THE BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE .     
      ID = 1                                                            
CX10663 CALL DOINX( 663 )                                               
CY10663 CALL DOINY( 663 )                                               
      DO 20 ISS = 1, NSS                                                
         IDBEGS(ISS) = ID                                               
         ID = ID + NEPSS(ISS)                                           
  20  CONTINUE                                                          
CX20664 CALL DOOUTX( 664 )                                              
CY20664 CALL DOOUTY( 664 )                                              
      WRITE(6,25) (IDBEGS(I),I=1,NSS)                                   
  25  FORMAT(/' ARRAY IDBEGS IS '/(5X,16I6))                            
C                                                                       
C     . SET UP THE NODAL TRANSFORMATION MATRIX FOR INVERSION SYMMETRIES 
      IF (NSYMM.EQ.1) CALL SETGX(GX, RKAPPA)                            
      IF (NSYMM.EQ.1) WRITE(6,*) ' GX IS ',GX                           
CX40124 CALL SBOUTX (124)                                               
CY40124 CALL SBOUTY (124)                                               
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            SHAP16                 
      SUBROUTINE SHAP16                                                 
C********************************************************************** 
C THIS SUBROUTINE CALCULATES THE SHAPE FUNCTIONS AND THE SHAPE          
C FUNCTION DERIVATIVES WITH RESPECT TO XI AND ETA FOR THE               
C SIXTEEN NODE QUADRILATERAL ELEMENT.                                   
C   ( 12 BOUNDARY NODES, 4 INTERIOR NODES )                             
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SHAPEZ                                                         
C---------------                                                        
*COMDECK XIETA                                                          
C---------------                                                        
      COMMON /XIETA/ XI, ETA                                            
C                                                                       
C XI, ETA - DIMENSIONLESS COORDINATES OF THE QUADRATURE POINTS          
C                                                                       
*COMDECK ECOORD                                                         
C---------------                                                        
      COMMON /ECOORD/ XY(2,ZNNPED)                                      
C                                                                       
C [XY]    - ELEMENTAL NODAL COORDINATES                                 
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
C LOCAL VARIABLES                                                       
C                                                                       
      REAL FXI(4),FETA(4),DFXI(4), DFETA(4)                             
      INTEGER NODE(16,2)                                                
      DATA NODE /1, 2, 3, 4, 4, 4, 4, 3, 2, 1, 1, 1, 2, 3, 2, 3,        
     $           1, 1, 1, 1, 2, 3, 4, 4, 4, 4, 3, 2, 2, 2, 3, 3/        
C                                                                       
C LAGRANGIAN INTERPOLATION FACTORS (STATEMENT FUNCTIONS)                
C                                                                       
      F1(T) = .0625*(((-9.*T + 9.)*T + 1.)*T - 1.)                      
      F2(T) = .5625*((( 3.*T - 1.)*T - 3.)*T + 1.)                      
      F3(T) = F2(-T)                                                    
      F4(T) = F1(-T)                                                    
      DF1(T) = .0625*((-27.*T + 18.)*T + 1.)                            
      DF2(T) = .5625*((  9.*T -  2.)*T - 3.)                            
      DF3(T) = -DF2(-T)                                                 
      DF4(T) = -DF1(-T)                                                 
CX30125 CALL SBINX (125)                                                
CY30125 CALL SBINY (125)                                                
C                                                                       
C SET UP THE QUADRATURE POINTS.                                         
C                                                                       
      IF (ISTRES .EQ. 0) CALL QUAD                                      
CX10665 CALL DOINX( 665 )                                               
CY10665 CALL DOINY( 665 )                                               
C                                                                       
C CALCULATE THE SHAPE FUNCTIONS AND THEIR DERIVATIVES WITH RESPECT TO   
C XI AND ETA.                                                           
C                                                                       
      DO 50 IQ=1,NQD                                                    
         IF(ISTRES.EQ.0) XI=QDCOOR(1,IQ)                                
         IF(ISTRES.EQ.0) ETA=QDCOOR(2,IQ)                               
         FXI(1)  = F1(XI)                                               
         FXI(2)  = F2(XI)                                               
         FXI(3)  = F3(XI)                                               
         FXI(4)  = F4(XI)                                               
         FETA(1) = F1(ETA)                                              
         FETA(2) = F2(ETA)                                              
         FETA(3) = F3(ETA)                                              
         FETA(4) = F4(ETA)                                              
         DFXI(1)  = DF1(XI)                                             
         DFXI(2)  = DF2(XI)                                             
         DFXI(3)  = DF3(XI)                                             
         DFXI(4)  = DF4(XI)                                             
         DFETA(1) = DF1(ETA)                                            
         DFETA(2) = DF2(ETA)                                            
         DFETA(3) = DF3(ETA)                                            
         DFETA(4) = DF4(ETA)                                            
         DO 40 I=1,16                                                   
             N(IQ,I)=FXI(NODE(I,1))*FETA(NODE(I,2))                     
             NDXI(IQ,I)=DFXI(NODE(I,1))*FETA(NODE(I,2))                 
             NDETA(IQ,I)=FXI(NODE(I,1))*DFETA(NODE(I,2))                
   40    CONTINUE                                                       
      IF(ISTRES.NE.0) THEN                                              
CX40126 CALL SBOUTX (126)                                               
CY40126 CALL SBOUTY (126)                                               
      RETURN                                                            
      ENDIF                                                             
   50 CONTINUE                                                          
CX20666 CALL DOOUTX( 666 )                                              
CY20666 CALL DOOUTY( 666 )                                              
CX40126 CALL SBOUTX (126)                                               
CY40126 CALL SBOUTY (126)                                               
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            SHAP4                  
      SUBROUTINE SHAP4                                                  
C********************************************************************** 
C  THIS SUBROUTINE CALCULATES THE SHAPE FUNCTIONS AND THEIR             
C  DERIVATIVES WITH RESPECT TO THE DIMENSIONLESS COORDINATES            
C  AT ALL QUADRATURE POINTS FOR THE FOUR NODED QUADRILATERAL ELEMENT.   
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SHAPEZ                                                         
C---------------                                                        
*COMDECK XIETA                                                          
C---------------                                                        
      COMMON /XIETA/ XI, ETA                                            
C                                                                       
C XI, ETA - DIMENSIONLESS COORDINATES OF THE QUADRATURE POINTS          
C                                                                       
*COMDECK ECOORD                                                         
C---------------                                                        
      COMMON /ECOORD/ XY(2,ZNNPED)                                      
C                                                                       
C [XY]    - ELEMENTAL NODAL COORDINATES                                 
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
      REAL XII(4), ETAI(4)                                              
      DATA XII  /-1.,  1.,  1.,   -1./,                                 
     $     ETAI /-1., -1.,  1.,  1./                                    
CX30127 CALL SBINX (127)                                                
CY30127 CALL SBINY (127)                                                
C                                                                       
C LOCAL VARIABLES                                                       
C                                                                       
C  XI      - QUADRATURE POINT                                           
C  ETA     - QUADRATURE POINT                                           
C  XII     - DIMENSIONLESS COORDINATE OF THE ELEMENTAL NODES            
C  ETAI    - DIMENSIONLESS COORDINATE OF THE ELEMENTAL NODES            
C                                                                       
C                                                                       
C SET UP THE QUADRATURE POINT COORDINATES AND WEIGHTS.                  
C                                                                       
      IF (ISTRES .EQ. 0) CALL QUAD                                      
CX10667 CALL DOINX( 667 )                                               
CY10667 CALL DOINY( 667 )                                               
C                                                                       
C LOOP OVER THE QUADRATURE POINTS.                                      
C                                                                       
      DO 310 IQ = 1, NQD                                                
         IF (ISTRES .EQ. 0) XI = QDCOOR(1,IQ)                           
         IF (ISTRES .EQ. 0) ETA = QDCOOR(2,IQ)                          
C                                                                       
C CALCULATE THE SHAPE FUNCTIONS AND THEIR DERIVATIVES W.R.T. XI AND ETA.
C                                                                       
         DO 100 I = 1, 4                                                
            N(IQ,I) = 0.25*(1. + XI*XII(I))*(1. + ETA*ETAI(I))          
            NDXI(IQ,I) = (1. + ETA*ETAI(I))*XII(I)*0.25                 
            NDETA(IQ,I) = (1. + XI*XII(I))*ETAI(I)*0.25                 
 100    CONTINUE                                                        
      IF (ISTRES .NE. 0) THEN                                           
CX40128 CALL SBOUTX (128)                                               
CY40128 CALL SBOUTY (128)                                               
      RETURN                                                            
      ENDIF                                                             
 310  CONTINUE                                                          
CX20668 CALL DOOUTX( 668 )                                              
CY20668 CALL DOOUTY( 668 )                                              
CX40128 CALL SBOUTX (128)                                               
CY40128 CALL SBOUTY (128)                                               
      RETURN                                                            
      END                                                               
*DECK                                            SHAP9                  
      SUBROUTINE SHAP9                                                  
C********************************************************************** 
C  THIS SUBROUTINE CALCULATES THE SHAPE FUNCTIONS AND THEIR             
C  DERIVATIVES WITH RESPECT TO THE DIMENSIONLESS COORDINATES            
C  AT ALL QUADRATURE POINTS FOR THE NINE NODED QUADRILATERAL ELEMENT.   
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SHAPEZ                                                         
C---------------                                                        
*COMDECK XIETA                                                          
C---------------                                                        
      COMMON /XIETA/ XI, ETA                                            
C                                                                       
C XI, ETA - DIMENSIONLESS COORDINATES OF THE QUADRATURE POINTS          
C                                                                       
*COMDECK ECOORD                                                         
C---------------                                                        
      COMMON /ECOORD/ XY(2,ZNNPED)                                      
C                                                                       
C [XY]    - ELEMENTAL NODAL COORDINATES                                 
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
CX30129 CALL SBINX (129)                                                
CY30129 CALL SBINY (129)                                                
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
C LOCAL VARIABLES                                                       
C                                                                       
C  XI      - QUADRATURE POINT                                           
C  ETA     - QUADRATURE POINT                                           
C                                                                       
C                                                                       
C SET UP THE QUADRATURE POINT COORDINATES AND WEIGHTS.                  
C                                                                       
      IF (ISTRES .EQ. 0) CALL QUAD                                      
CX10669 CALL DOINX( 669 )                                               
CY10669 CALL DOINY( 669 )                                               
C                                                                       
C LOOP OVER THE QUADRATURE POINTS.                                      
C                                                                       
      DO 310 IQ = 1, NQD                                                
         IF (ISTRES .EQ. 0) XI = QDCOOR(1,IQ)                           
         IF (ISTRES .EQ. 0) ETA = QDCOOR(2,IQ)                          
C                                                                       
C CALCULATE THE SHPAE FUNCTIONS AND THEIR DERIVATIVES W.R.T. XI AND ETA.
C                                                                       
         XISQ = XI*XI                                                   
         ETASQ = ETA*ETA                                                
         N(IQ,1) = (XI-1.)*XI*(ETA-1.)*ETA*.25                          
         N(IQ,2) = (1.-XISQ)*(ETA-1.)*ETA*.5                            
         N(IQ,3) = XI*(XI+1.)*(ETA-1.)*ETA*.25                          
         N(IQ,4) = XI*(XI+1.)*(1.-ETASQ)*.5                             
         N(IQ,5) = XI*(XI+1.)*ETA*(ETA+1.)*.25                          
         N(IQ,6) = (1.-XISQ)*ETA*(ETA+1.)*.5                            
         N(IQ,7) = (XI-1.)*XI*ETA*(ETA+1.)*.25                          
         N(IQ,8) = (XI-1.)*XI*(1.-ETASQ)*.5                             
         N(IQ,9) = (1.-XISQ)*(1.-ETASQ)                                 
C                                                                       
         NDXI(IQ,1) = XI*(ETA-1.)*ETA*.25 + (XI-1.)*(ETA-1.)*ETA*.25    
         NDXI(IQ,2) = -XI*(ETA-1.)*ETA                                  
         NDXI(IQ,3) = (XI+1.)*(ETA-1.)*ETA*.25 +  XI*(ETA-1.)*ETA*.25   
         NDXI(IQ,4) = (XI+1.)*(1.-ETASQ)*.5 + XI*(1.-ETASQ)*.5          
         NDXI(IQ,5) = (XI+1.)*ETA*(ETA+1.)*.25 + XI*ETA*(ETA+1.)*.25    
         NDXI(IQ,6) = -XI*ETA*(ETA+1.)                                  
         NDXI(IQ,7) = XI*ETA*(ETA+1.)*.25 + (XI-1.)*ETA*(ETA+1.)*.25    
         NDXI(IQ,8) = XI*(1.-ETASQ)*.5 + (XI-1.)*(1.-ETASQ)*.5          
         NDXI(IQ,9) = -2.*XI*(1.-ETASQ)                                 
C                                                                       
         NDETA(IQ,1) = (XI-1.)*XI*ETA*.25 + (XI-1.)*XI*(ETA-1.)*.25     
         NDETA(IQ,2) = (1.-XISQ)*ETA*.5 + (1.-XISQ)*(ETA-1.)*.5         
         NDETA(IQ,3) = XI*(XI+1.)*ETA*.25 + XI*(XI+1.)*(ETA-1.)*.25     
         NDETA(IQ,4) = -XI*(XI+1.)*ETA                                  
         NDETA(IQ,5) = XI*(XI+1.)*(ETA+1.)*.25 + XI*(XI+1.)*ETA*.25     
         NDETA(IQ,6) = (1.-XISQ)*(ETA+1.)*.5 + (1.-XISQ)*ETA*.5         
         NDETA(IQ,7) = (XI-1.)*XI*(ETA+1.)*.25 + (XI-1.)*XI*ETA*.25     
         NDETA(IQ,8) = -(XI-1.)*XI*ETA                                  
         NDETA(IQ,9) = -2.*(1.-XISQ)*ETA                                
C                                                                       
CCC                                                                     
CCC      . CHECK THAT THE SUM OF THE SHAPE FUNCT. IS 1 .                
CCC      SUM = 0.                                                       
CCC      DO 1 I=1,9                                                     
CCC         SUM = SUM + N(IQ,I)                                         
CCC1     CONTINUE                                                       
CCC      PRINT 2,IQ,SUM                                                 
CCC2     FORMAT(1X,'IQ=',I5,' SUM OF SHAPE FUNCT FOR 9 NODED',          
CCC  .      ' ELEMENT =',E13.6)                                         
CCC                                                                     
      IF (ISTRES .NE. 0) THEN                                           
CX40130 CALL SBOUTX (130)                                               
CY40130 CALL SBOUTY (130)                                               
      RETURN                                                            
      ENDIF                                                             
 310  CONTINUE                                                          
CX20670 CALL DOOUTX( 670 )                                              
CY20670 CALL DOOUTY( 670 )                                              
CX40130 CALL SBOUTX (130)                                               
CY40130 CALL SBOUTY (130)                                               
      RETURN                                                            
      END                                                               
*DECK                                            SHAPE                  
      SUBROUTINE SHAPE                                                  
C********************************************************************** 
C     FORM THE DISPLACEMENT SHAPE FUNCTIONS AND THE STRESS              
C     SHAPE FUNCTIONS                                                   
C********************************************************************** 
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
CX30131 CALL SBINX (131)                                                
CY30131 CALL SBINY (131)                                                
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
C                                                                       
C                                                                       
C  *** SELECT DISPLACEMENT SHAPE FUNCTIONS ***                          
C                                                                       
      IF (NNPED.EQ.9) THEN                                              
         CALL SHAP9                                                     
      ELSE IF (NNPED.EQ.4) THEN                                         
         CALL SHAP4                                                     
      ELSE IF (NNPED.EQ.16) THEN                                        
         CALL SHAP16                                                    
      ELSE                                                              
         CALL ERRORS(' NUMBER OF DISPL. NODES NOT IMPLEMENTED ')        
      ENDIF                                                             
C                                                                       
C  *** SELECT STRESS SHAPE FUNCTIONS ***                                
      ENTRY SSHAPE                                                      
CX30133 CALL SBINX (133)                                                
CY30133 CALL SBINY (133)                                                
      IF (NNPES.EQ.4) THEN                                              
         CALL SSHAP4                                                    
      ELSE IF (NNPES.EQ.1) THEN                                         
         CALL SSHAP1                                                    
      ELSE IF (NNPES.EQ.8) THEN                                         
         CALL SSHAP8                                                    
      ELSE                                                              
         CALL ERRORS(' NUMBER OF STRESS NODES NOT IMPLEMENTED YET')     
      ENDIF                                                             
CX40132 CALL SBOUTX (132)                                               
CY40132 CALL SBOUTY (132)                                               
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            SHAPE1                 
      SUBROUTINE SHAPE1                                                 
C********************************************************************** 
C THIS SUBROUTINE COMPUTES DERIVATIVES OF SHAPE FUNCTIONS W.R.T X AND Y 
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SHAPEZ                                                         
C---------------                                                        
*COMDECK XIETA                                                          
C---------------                                                        
      COMMON /XIETA/ XI, ETA                                            
C                                                                       
C XI, ETA - DIMENSIONLESS COORDINATES OF THE QUADRATURE POINTS          
C                                                                       
*COMDECK ECOORD                                                         
C---------------                                                        
      COMMON /ECOORD/ XY(2,ZNNPED)                                      
C                                                                       
C [XY]    - ELEMENTAL NODAL COORDINATES                                 
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
      REAL JAC(2,2), JI(2,2)                                            
CX30135 CALL SBINX (135)                                                
CY30135 CALL SBINY (135)                                                
                                                                        
      IF (IRECT.EQ.0) GO TO 70                                          
C                                                                       
C     *****************************************                         
C     * SPECIAL CASE OF A RECTANGULAR ELEMENT *                         
C     *****************************************                         
C                                                                       
C     . AX IS LENGTH OF THE ELEMENT IN X DIRECTION .                    
C     . AY IS LENGTH OF THE ELEMENT IN Y DIRECTION .                    
      IF (NNPED.EQ.9) THEN                                              
C            . 7 6 5 .                                                  
C            . 8 9 4 .                                                  
C            . 1 2 3 .                                                  
         AX = XY(1,3) - XY(1,1)                                         
         AY = XY(2,5) - XY(2,3)                                         
      ELSE IF (NNPED.EQ.4) THEN                                         
C            . 4 3 .                                                    
C            . 1 2 .                                                    
         AX = XY(1,2) - XY(1,1)                                         
         AY = XY(2,3) - XY(2,2)                                         
      ELSE IF (NNPED.EQ.16) THEN                                        
C            . 10  9  8  7 .                                            
C            . 11 15 16  6 .                                            
C            . 12 13 14  5 .                                            
C            .  1  2  3  4 .                                            
         AX = XY(1,4) - XY(1,1)                                         
         AY = XY(2,7) - XY(2,4)                                         
      ELSE                                                              
         CALL ERRORS(' NNPED NOT IMPLEMENTED IN SHAPE1')                
      ENDIF                                                             
      IF (AX.EQ.0.) CALL ERRORS(' AX=0 IN SHAPE1')                      
      IF (AY.EQ.0.) CALL ERRORS(' AY=0 IN SHAPE1')                      
      AXI = 2./AX                                                       
      AYI = 2./AY                                                       
CX10671 CALL DOINX( 671 )                                               
CY10671 CALL DOINY( 671 )                                               
C                                                                       
      DO 65 IQ=1,NQD                                                    
         WTDET(IQ)=AX*AY*.25 * QDWGHT(IQ)                               
         DO 60 I=1,NNPED                                                
            NDX(IQ,I)=NDXI(IQ,I)*AXI                                    
            NDY(IQ,I)=NDETA(IQ,I)*AYI                                   
   60    CONTINUE                                                       
      IF (ISTRES.NE.0) THEN                                             
CX40136 CALL SBOUTX (136)                                               
CY40136 CALL SBOUTY (136)                                               
      RETURN                                                            
      ENDIF                                                             
   65 CONTINUE                                                          
CX20672 CALL DOOUTX( 672 )                                              
CY20672 CALL DOOUTY( 672 )                                              
CX40136 CALL SBOUTX (136)                                               
CY40136 CALL SBOUTY (136)                                               
      RETURN                                                            
C                                                                       
C                                                                       
C     *********************************                                 
C     * GENERAL QUADRILATERAL ELEMENT *                                 
C     *********************************                                 
C                                                                       
   70 CONTINUE                                                          
C                                                                       
C CALCULATE THE JACOBIAN MATRIX AND ITS DETERMINANT.                    
C                                                                       
      IF (ISTRES .NE. 0) QDWGHT(1) = 1.0                                
CX10673 CALL DOINX( 673 )                                               
CY10673 CALL DOINY( 673 )                                               
      DO 90 IQ=1,NQD                                                    
         JAC(1,1) = 0.                                                  
         JAC(1,2) = 0.                                                  
         JAC(2,1) = 0.                                                  
         JAC(2,2) = 0.                                                  
         DO 80 I=1,NNPED                                                
            JAC(1,1) = JAC(1,1) + NDXI (IQ,I) * XY(1,I)                 
            JAC(1,2) = JAC(1,2) + NDXI (IQ,I) * XY(2,I)                 
            JAC(2,1) = JAC(2,1) + NDETA(IQ,I) * XY(1,I)                 
            JAC(2,2) = JAC(2,2) + NDETA(IQ,I) * XY(2,I)                 
   80    CONTINUE                                                       
         DET=JAC(1,1)*JAC(2,2)-JAC(1,2)*JAC(2,1)                        
         WTDET(IQ) = DET * QDWGHT(IQ)                                   
C                                                                       
C CALCULATE THE JACOBIAN INVERSE AND THE SHAPE FUNCTION DERIVATIVES     
C                                                                       
         DI=1./DET                                                      
         JI(1,1) =  JAC(2,2)*DI                                         
         JI(1,2) = -JAC(1,2)*DI                                         
         JI(2,1) = -JAC(2,1)*DI                                         
         JI(2,2) =  JAC(1,1)*DI                                         
         DO 85 I=1,NNPED                                                
             NDX(IQ,I)=JI(1,1)*NDXI(IQ,I)+JI(1,2)*NDETA(IQ,I)           
             NDY(IQ,I)=JI(2,1)*NDXI(IQ,I)+JI(2,2)*NDETA(IQ,I)           
   85    CONTINUE                                                       
      IF(ISTRES.NE.0) THEN                                              
CX40136 CALL SBOUTX (136)                                               
CY40136 CALL SBOUTY (136)                                               
      RETURN                                                            
      ENDIF                                                             
   90 CONTINUE                                                          
CX20674 CALL DOOUTX( 674 )                                              
CY20674 CALL DOOUTY( 674 )                                              
CX40136 CALL SBOUTX (136)                                               
CY40136 CALL SBOUTY (136)                                               
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK SOLOUT                                                            
      SUBROUTINE SOLOUT                                                 
C********************************************************************** 
C     OUTPUT THE SOLUTION AT CURRENT TIME                               
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
*COMDECK ENRGYC                                                         
      REAL KINE                                                         
      COMMON /ENRGYC/ KINE                                              
C                                                                       
C KINE    - KINETIC ENERGY                                              
                                                                        
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
CX30137 CALL SBINX (137)                                                
CY30137 CALL SBINY (137)                                                
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
      WRITE(9,10) ISTEP, TIME, KINE                                     
  10  FORMAT(//' --- STEP NUMBER ',I5, ' TIME=',E13.6/                  
     *         '    KINETIC ENERGY = ',E13.6)                           
      WRITE(9,15)                                                       
  15  FORMAT('0DISPLACEMENTS AND VELOCITIES FOLLOW '/                   
     *       1X,'NODE',12X,'U',12X,'V',12X,'W',10X,'PH1',10X,'PH2',     
     *       9X,'UDOT',9X,'VDOT',9X,'WDOT',7X,'PH1DOT',7X,'PH2DOT')     
C                                                                       
      INDEX = 0-NDDF                                                    
CX10675 CALL DOINX( 675 )                                               
CY10675 CALL DOINY( 675 )                                               
      DO 20 NODE = 1, NND                                               
         INDEX = INDEX + NDDF                                           
         WRITE (9,25) NODE, (X(INDEX+I),I=1,NDDF),(XD(INDEX+I),I=1,NDDF)
  20  CONTINUE                                                          
CX20676 CALL DOOUTX( 676 )                                              
CY20676 CALL DOOUTY( 676 )                                              
  25  FORMAT(I5,10E13.6)                                                
C                                                                       
C     . OUTPUT THE STRESSES AT THE ELEMENTS .                           
      WRITE(9,30)                                                       
  30  FORMAT(//' STRESSES AT THE ELEMENTS : '/                          
     *  3X,'ELM',1X,'NODE',11X,'N1',11X,'N2',10X,'N12',11X,'M1',        
     *  11X,'M2',10X,'M12',11X,'Q1',11X,'Q2')                           
CX10677 CALL DOINX( 677 )                                               
CY10677 CALL DOINY( 677 )                                               
      DO 50 ID = 1, NE                                                  
         INDEX = 0-NSDF                                                 
         DO 40 IN = 1, NNPES                                            
            INDEX = INDEX + NSDF                                        
            WRITE(9,35) ID, IN, (HE(INDEX+I,ID),I=1,NSDF)               
  35        FORMAT(1X,2I5,8E13.6)                                       
  40     CONTINUE                                                       
  50  CONTINUE                                                          
CX20678 CALL DOOUTX( 678 )                                              
CY20678 CALL DOOUTY( 678 )                                              
C                                                                       
C     . PRINT OUT THE VELOCITIES AT THE TIME+DELTAT/2 .                 
C       ( FOR COMPARISON WITH ANOTHER PROGRAM )                         
CCC   WRITE(9,55) TIME+.5*DELTAT                                        
  55  FORMAT(//' VELOCITIES AT TIME ',E13.6/                            
     *  1X,'NODE',9X,'UDOT',9X,'VDOT',9X,'WDOT',7X,'PH1DOT',7X,'PH2DOT')
CCC   INDEX = 0-NDDF                                                    
CCC   DO 60 NODE = 1, NND                                               
CCC      INDEX = INDEX + NDDF                                           
CCC      WRITE (9,25) NODE, (XDPLUS(INDEX+I),I=1,NDDF)                  
  60  CONTINUE                                                          
C                                                                       
C     . PRINT OUT THE ACCELERATIONS .                                   
      WRITE(9,65) TIME                                                  
  65  FORMAT(//' ACCELERATIONS AT TIME ',E13.6/                         
     *  1X,'NODE',10X,'UDD',10X,'VDD',10X,'WDD',8X,'PH1DD',8X,'PH2DD')  
      INDEX = 0-NDDF                                                    
CX10679 CALL DOINX( 679 )                                               
CY10679 CALL DOINY( 679 )                                               
      DO 70 NODE = 1, NND                                               
         INDEX = INDEX + NDDF                                           
         WRITE (9,25) NODE, (XDD(INDEX+I),I=1,NDDF)                     
  70  CONTINUE                                                          
CX20680 CALL DOOUTX( 680 )                                              
CY20680 CALL DOOUTY( 680 )                                              
CX40138 CALL SBOUTX (138)                                               
CY40138 CALL SBOUTY (138)                                               
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            SOLVH                  
      SUBROUTINE SOLVH                                                  
C********************************************************************** 
C     SOLVE FOR THE FORCES                                              
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SUBSTR                                                         
C---------------                                                        
      COMMON /SUBSTR/ NSS, NEPSS(ZNSS), NNPSS(ZNSS), IDBEGS(ZNSS)       
C                                                                       
C NSS     - NUMBER OF SUBSTRUCTURES                                     
C NEPSS   - NUMBER OF ELEMENTS IN EACH SUBSTRUCTURE                     
C NNPSS   - NUMBER OF NODES IN EACH SUBSTRUCTURE                        
C IDBEGS  - BEGINNING ELEMENT NUMBER FOR EACH SUBSTRUCTURE              
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK ELMNTS                                                         
C---------------                                                        
      REAL ME, MNLE                                                     
      COMMON /ELMNTS/ FE(ZNUMF,ZNDE), SE(ZNUMS,ZNDE), ME(ZNUMM,ZNDE),   
     *                PE(ZNUMP,ZNE), MNLE(ZNUMNL,ZNDE), IDEDON(ZNDE)    
C                                                                       
C FE      - DISTINCT ELEMENTS OF [F]                                    
C SE      - DISTINCT ELEMENTS OF [S]                                    
C ME      - DISTINCT ELEMENTS OF [M]                                    
C PE      - ALL ELEMENT OF THE LOAD VECTOR                              
C MNLE    - DISTINCT ELEMENTS OF [MNL]                                  
C IDEDON  - 1 IF DISTINCT ELEMENT HAS BEEN FORMED.  0 IF NOT YET FORMED 
C                                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
*COMDECK EDESCR                                                         
C---------------                                                        
      COMMON /EDESCR/ IESMNO(ZNE), IEGEOM(ZNE), IECURV(ZNE)             
C                                                                       
C IESMNO  - DISTINCT ELEMENTAL STIFFNESS MATRIX NUMBERS                 
C IEGEOM  - ELEMENTAL GEOMETRY FLAGS (0=ARBITRARY, 1=RECTANGULAR)       
C IECURV  - ELEMENTAL CURVATURE FLAGS                                   
C                                                                       
      DIMENSION XE(ZNDFE)                                               
CX30139 CALL SBINX (139)                                                
CY30139 CALL SBINY (139)                                                
CX10681 CALL DOINX( 681 )                                               
CY10681 CALL DOINY( 681 )                                               
C                                                                       
CCC   PRINT *, ' SUBROUTINE SOLVH'                                      
C     . LOOP OVER THE SUBSTRUCTURES .                                   
      DO 20 ISS = 1, NSS                                                
CCC      PRINT *, ' ISS ',ISS                                           
C                                                                       
C        . LOOP OVER THE ELEMENTS WHICH LIE IN THIS SUBSTRUCTURE .      
         DO 10 K = 1, NEPSS(ISS)                                        
C           . GET THE ELEMENT NUMBER AND THE DISTINCT ELEMENT NUMBER .  
            ID = IDBEGS(ISS) - 1 + K                                    
            IDE = IESMNO(ID)                                            
CCC         PRINT *, ' ID = ',ID,' IDE = ',IDE                          
C                                                                       
C           . EXTRACT AN ELEMENT OF X .                                 
CCC         PRINT *, ' GETEU '                                          
            CALL GETEU(ID, XE, X)                                       
C                                                                       
C           . SOLVE FOR THE FORCES "HE" FOR THIS ELEMENT .              
CCC         PRINT *, ' SOLVHE '                                         
            CALL SOLVHE(FE(1,IDE), SE(1,IDE), MNLE(1,IDE), HE(1,ID), XE)
  10     CONTINUE                                                       
  20  CONTINUE                                                          
CX20682 CALL DOOUTX( 682 )                                              
CY20682 CALL DOOUTY( 682 )                                              
CX40140 CALL SBOUTX (140)                                               
CY40140 CALL SBOUTY (140)                                               
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            SOLVHE                 
      SUBROUTINE SOLVHE(F, S, MNL, H, X)                                
C********************************************************************** 
C     SOLVE FOR THE FORCES AT AN ELEMENT                                
C                                                                       
C     F * H =  S.X + 1/2 MNL.X.X                                        
C                                                                       
C     STORE THE RIGHT HAND SIDE INTO H ; SOLVE BY CHOLESKY              
C     DECOMPOSITION                                                     
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
      REAL MNL, MX, MXX                                                 
      DIMENSION F(*), S(*), MNL(*), X(*), H(NSDF,ZNNPES)                
      DIMENSION MX(ZNNPES*ZNNPED*3), MXX(3,ZNNPES)                      
CX30141 CALL SBINX (141)                                                
CY30141 CALL SBINY (141)                                                
C                                                                       
CCC   PRINT *, 'SUBROUTINE SOLVHE '                                     
C                                                                       
C     S . X ==> H                                                       
CCC   PRINT *, ' CALL MATMUL '                                          
      CALL MATMUL(S, X, H, NSFE, NDFE, 1)                               
CCC   PRINT 1000, ' X ',(X(I),I=1,NDFE)                                 
CCC   PRINT 1000, ' S * X ',((H(I,J),I=1,NSDF),J=1,NNPES)               
1000  FORMAT(//1X,A/(3X,8E13.6))                                        
C                                                                       
C     MNL . X ==> MX                                                    
CCC   PRINT *, ' CALL MNLBYX '                                          
      CALL MNLBYX(MNL, X, MX)                                           
C                                                                       
C     MX . X ==> MXX                                                    
CCC   PRINT *, ' CALL MNLX2X '                                          
      CALL MNLX2X(MX, X, MXX)                                           
CX10683 CALL DOINX( 683 )                                               
CY10683 CALL DOINY( 683 )                                               
CCC   PRINT 1000, ' MXX ',((MXX(I,J),I=1,3),J=1,NNPES)                  
C                                                                       
C     . H + 1/2 MXX ==> H .                                             
      DO 5 IDOF = 1, 3                                                  
         DO 5 I = 1, NNPES                                              
            H(IDOF,I) = H(IDOF,I) + .5*MXX(IDOF,I)                      
   5  CONTINUE                                                          
CX20684 CALL DOOUTX( 684 )                                              
CY20684 CALL DOOUTY( 684 )                                              
C                                                                       
CCC   PRINT 1000, ' RHS ELEMENT FOR H ',((H(I,J),I=1,NSDF),J=1,NNPES)   
C                                                                       
C     . SOLVE .                                                         
CCC   PRINT *, ' CALL CHOSOL '                                          
      CALL CHOSOL(F, NSFE, H)                                           
CX40142 CALL SBOUTX (142)                                               
CY40142 CALL SBOUTY (142)                                               
CCC   PRINT 1000, ' H SOLUTION IS ',((H(I,J),I=1,NSDF),J=1,NNPES)       
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            SOLXDD                 
      SUBROUTINE SOLXDD                                                 
C********************************************************************** 
C     SOLVE FOR THE ACCELERATIONS XDD USING THE PRECONDITIONED          
C     CONJUGATE GRADIENT METHOD                                         
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK RESULT                                                         
C---------------                                                        
      COMMON /RESULT/ HE(ZNSFE,ZNE), X(ZNEQD), XPLUS(ZNEQD), XD(ZNEQD), 
     *                XDMINS(ZNEQD), XDPLUS(ZNEQD), XDD(ZNEQD)          
C                                                                       
C HE               - STRESS SOLUTION ELEMENTS AT TIME=T                 
C X                - DISPLACEMENT SOLUTION AT TIME=T                    
C XPLUS            - SOLUTION AT TIME=T+DELTAT                          
C XD               - VELOCITY AT TIME=T                                 
C XDMINS           - VELOCITY AT TIME=T-DELTAT/2                        
C XDPLUS           - VELOCITY AT TIME=T+DELTAT/2                        
C XDD              - ACCELERATION AT TIME=T                             
C                                                                       
*COMDECK CONJGC                                                         
      COMMON /CONJGC/ TOLCG, ITLMCG, ITERCG, ERORCG                     
C                                                                       
C CONJUGATE GRADIENT COMMON                                             
C                                                                       
C TOLCG   - ERROR TOLERANCE                                             
C ITLMCG  - ITERATION LIMIT                                             
C ITERCG  - CURRENT ITERATION NUMBER                                    
C ERORCG  - ERROR NORM                                                  
C                                                                       
*COMDECK BLOCK                                                          
C---------------                                                        
      INTEGER PPTR                                                      
      COMMON /BLOCK/ IBLEN(ZNBLCK), NBLOCK, NBNPB(ZNBLCK),              
     *               IBCPTR(ZNBLCK), PPTR(ZNBLCK)                       
C                                                                       
C IBLEN   - BLOCK LENGTHS                                               
C NBLOCK  - NUMBER OF DIAGONAL BLOCKS (=NSS+1)                          
C NBNPB   - NUMBER OF BOUNDARY NODES IN EACH BLOCK                      
C IBCPTR  - POINTERS TO WHERE THE BOUNDARY CONDITIONS BEGIN FOR EACH    
C           BLOCK                                                       
C PPTR    - POINTERS TO THE RIGHT HAND SIDE BLOCKS                      
C                                                                       
*COMDECK MBLOCK                                                         
C---------------                                                        
      REAL M0, MA                                                       
      COMMON /MBLOCK/ M0(ZNEQPB*ZNEQPB,ZNBLCK), MA(ZNEQPB*ZNEQPB,ZNSS)  
C                                                                       
C M0       - DIAGONAL BLOCKS OF THE ASSEMBLED MASS MATRIX               
C MA       - OFF DIAGONAL BLOCKS OF THE ASSEMBLED MASS MATRIX           
C                                                                       
*COMDECK TIME                                                           
C---------------                                                        
      COMMON /TIMES/ ISTART, NSTEPS, DELTAT, IOUT, ISAVE, NODEM, IDOFM, 
     *              ISTEP, TIME                                         
C                                                                       
C ISTART  - SIGNALS RESTART OF A PREVIOUS RUN (0=NO, 1=YES)             
C DELTAT  - STEP SIZE                                                   
C NSTEPS  - NUMBER OF STEPS                                             
C IOUT    - HOW OFTEN TO OUTPUT THE RESULTS                             
C ISAVE   - HOW OFTEN TO SAVE RESULTS                                   
C NODEM,IDOFM - WHICH DEGREE OF FREEDOM TO SUMMARIZE                    
C ISTEP   - CURRENT STEP NUMBER                                         
C TIME    - CURRENT TIME                                                
C                                                                       
*COMDECK WHERE                                                          
C*****HARD CODED ZNND=25 HERE                                           
      COMMON /WHERE/ IWHERD(25,2)                                       
C                                                                       
C WHERE   - BLOCK NUMBER AND RELATIVE LOCATION WITHIN THE BLOCK         
C                                                                       
      REAL MX, MZ, MZZ, MZZI                                            
      DIMENSION Z(ZNEQD), MX(ZNEQD), MZ(ZNEQD), R0(ZNEQD), R(ZNEQD)     
      DIMENSION Y(ZNEQD)                                                
CX30143 CALL SBINX (143)                                                
CY30143 CALL SBINY (143)                                                
C                                                                       
CCC   PRINT *, ' SUBROUTINE SOLXDD '                                    
C                                                                       
C                                                                       
C     ***********************                                           
C     * SOLVE M0 * XDD = R0 *                                           
C     * AND SET Z TO 0      *                                           
C     ***********************                                           
C                                                                       
CCC   PRINT *, ' CALL FORMR0 '                                          
      CALL FORMR0(R0)                                                   
CCC   PRINT 1000, 'R0 ',(R0(I),I=1,NEQD)                                
1000  FORMAT(//1X,A/(3X,10E13.6))                                       
CX10685 CALL DOINX( 685 )                                               
CY10685 CALL DOINY( 685 )                                               
C                                                                       
      DO 4 IBLOCK = 1, NBLOCK                                           
CCC      PRINT *, ' IBLOCK ',IBLOCK                                     
         ILOC = PPTR(IBLOCK)                                            
         NRB = IBLEN(IBLOCK)                                            
         CALL COPYV(R0(ILOC), XDD(ILOC), NRB)                           
C        . SOLVE FOR XDD .                                              
CCC      PRINT *, ' CALL CHOSOL '                                       
         CALL CHOSOL(M0(1,IBLOCK), NRB, XDD(ILOC))                      
C                                                                       
C        . INITIALIZE Z TO 0 .                                          
         DO 2 I = 1, NRB                                                
            Z(ILOC+I-1) = 0.                                            
   2     CONTINUE                                                       
   4  CONTINUE                                                          
CX20686 CALL DOOUTX( 686 )                                              
CY20686 CALL DOOUTY( 686 )                                              
CCC   PRINT 1000,' XDD ',(XDD(I),I=1,NEQD)                              
C                                                                       
      YR = 0.                                                           
CX10687 CALL DOINX( 687 )                                               
CY10687 CALL DOINY( 687 )                                               
C                                                                       
C     ***********************************************                   
C     * LOOP OVER THE CONJUGATE GRADIENT ITERATIONS *                   
C     ***********************************************                   
      DO 60 ITER = 1, ITLMCG                                            
CCC      PRINT *, ' --- ITERATION NUMBER --- ',ITER                     
         ITERCG = ITER                                                  
         YROLD = YR                                                     
C                                                                       
C                                                                       
C        ************************                                       
C        * SET R = R0 - M . XDD *                                       
C        * SOLVE M0 * Y = R     *                                       
C        * COMPUTE YR = Y . R   *                                       
C        ************************                                       
C                                                                       
C        . SET MX TO M * XDD .                                          
CCC      PRINT *, ' CALL MXMULT '                                       
         CALL MXMULT(XDD, MX)                                           
CCC      PRINT 1000, ' M*XDD ',(MX(I),I=1,NEQD)                         
C                                                                       
C        . LOOP OVER THE BLOCKS .                                       
         YR = 0.                                                        
         DO 10 IBLOCK = 1, NBLOCK                                       
CCC         PRINT *, ' IBLOCK ',IBLOCK                                  
            ILOC = PPTR(IBLOCK)                                         
            NRB = IBLEN(IBLOCK)                                         
            DO 5 I = 1, NRB                                             
               R(ILOC+I-1) = R0(ILOC+I-1) - MX(ILOC+I-1)                
   5        CONTINUE                                                    
            CALL COPYV(R(ILOC), Y(ILOC), NRB)                           
CCC         PRINT *, ' CHOSOL '                                         
            CALL CHOSOL(M0(1,IBLOCK), NRB, Y(ILOC))                     
CCC         PRINT *, ' COMPUTE YRI '                                    
            YRI = 0.                                                    
            DO 8 I = 1, NRB                                             
               YRI = YRI + Y(ILOC+I-1)*R(ILOC+I-1)                      
   8        CONTINUE                                                    
CCC         PRINT *, ' YRI ',YRI                                        
            YR = YR + YRI                                               
  10     CONTINUE                                                       
CCC      PRINT 1000, ' R ',(R(I),I=1,NEQD)                              
CCC      PRINT 1000, ' Y ',(Y(I),I=1,NEQD)                              
CCC      PRINT 1000, ' YR ',YR                                          
C                                                                       
C        ***********************                                        
C        * COMPUTE Z = Y + B*Z *                                        
C        ***********************                                        
C                                                                       
         IF (YROLD.EQ.0.) THEN                                          
C           . THIS IS THE FIRST ITERATION .                             
            B = 0.                                                      
         ELSE                                                           
            B = YR / YROLD                                              
         ENDIF                                                          
CCC      PRINT 1000, ' B ',B                                            
C                                                                       
C        . LOOP OVER THE BLOCKS .                                       
         DO 30 IBLOCK = 1, NBLOCK                                       
CCC         PRINT *, ' IBLOCK ',IBLOCK                                  
            ILOC = PPTR(IBLOCK)                                         
            NRB = IBLEN(IBLOCK)                                         
            DO 20 I = 1, NRB                                            
               Z(ILOC+I-1) = Y(ILOC+I-1) + B*Z(ILOC+I-1)                
  20        CONTINUE                                                    
  30     CONTINUE                                                       
CCC      PRINT 1000, ' Z ',(Z(I),I=1,NEQD)                              
C                                                                       
C                                                                       
C        *************************************                          
C        * COMPUTE A = (Y . R) / (M . Z . Z) *                          
C        *************************************                          
C                                                                       
C        . COMPUTE MZ = M . Z .                                         
CCC      PRINT *, ' M *Z '                                              
         CALL MXMULT(Z, MZ)                                             
CCC      PRINT 1000, ' MZ ',(MZ(I),I=1,NEQD)                            
C                                                                       
         MZZ = 0.                                                       
         DO 40 IBLOCK = 1, NBLOCK                                       
CCC         PRINT *, ' IBLOCK ',IBLOCK                                  
            ILOC = PPTR(IBLOCK)                                         
            NRB = IBLEN(IBLOCK)                                         
            MZZI = 0.                                                   
            DO 35 I = 1, NRB                                            
               MZZI = MZZI + MZ(ILOC+I-1)*Z(ILOC+I-1)                   
  35        CONTINUE                                                    
CCC         PRINT *, 'MZZI ',MZZI                                       
            MZZ = MZZ + MZZI                                            
  40     CONTINUE                                                       
         IF (MZZ .EQ. 0.) CALL ERRORS(' MZZ = 0 IN SOLXDD ')            
         A = YR / MZZ                                                   
CCC      PRINT *, ' MZZ ',MZZ                                           
CCC      PRINT 1000, ' A ',A                                            
C                                                                       
C        **********************************************                 
C        * UPDATE XDD AND CHECK FOR CONVERGENCE:      *                 
C        * XDD = XDD + A*Z                            *                 
C        * ERROR = SQRT(DELXDD.DELXDD / XD.XD) / NEQD *                 
C        **********************************************                 
C                                                                       
         TOP = 0.                                                       
         BOT = 0.                                                       
         DO 50 IBLOCK = 1, NBLOCK                                       
CCC         PRINT *, ' IBLOCK ',IBLOCK                                  
            ILOC = PPTR(IBLOCK)                                         
            NRB = IBLEN(IBLOCK)                                         
            TOPI = 0.                                                   
            BOTI = 0.                                                   
            DO 45 I = 1, NRB                                            
               XDD(ILOC+I-1) = XDD(ILOC+I-1) + A*Z(ILOC+I-1)            
               TOPI = TOPI + A*A*Z(ILOC+I-1)*Z(ILOC+I-1)                
               BOTI = BOTI + XDD(ILOC+I-1)*XDD(ILOC+I-1)                
  45        CONTINUE                                                    
            TOP = TOP + TOPI                                            
            BOT = BOT + BOTI                                            
  50     CONTINUE                                                       
         IF (BOT.EQ.0.) CALL ERRORS (' BOT=0 IN SOLXDD')                
         ERORCG = SQRT (TOP/BOT) / NEQD                                 
CCC      PRINT 1000, ' XDD ',(XDD(I),I=1,NEQD)                          
C                                                                       
C        *******************                                            
C        * PRODUCE SUMMARY *                                            
C        *******************                                            
C                                                                       
C         MM = (NODEM-1)*NDDF + IDOFM                                   
CCC      PRINT 55, ITER, XDD(MM), ERORCG                                
  55     FORMAT(I5,2E13.6)                                              
C                                                                       
C        ... EXIT CONVERGENCE ACHIEVED                                  
      IF (ERORCG.LT.TOLCG) THEN                                         
CX40144 CALL SBOUTX (144)                                               
CY40144 CALL SBOUTY (144)                                               
      RETURN                                                            
      ENDIF                                                             
  60  CONTINUE                                                          
CX20688 CALL DOOUTX( 688 )                                              
CY20688 CALL DOOUTY( 688 )                                              
CX40144 CALL SBOUTX (144)                                               
CY40144 CALL SBOUTY (144)                                               
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            SSHAP1                 
      SUBROUTINE SSHAP1                                                 
C                                                                       
C*******************************************************                
C                                                                       
C   THIS SUBROUTINE CALCULATES THE STRESS SHAPE FUNCTIONS               
C   FOR NNPES = 1                                                       
C                                                                       
C********************************************************               
C                                                                       
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SHAPEZ                                                         
C---------------                                                        
*COMDECK XIETA                                                          
C---------------                                                        
      COMMON /XIETA/ XI, ETA                                            
C                                                                       
C XI, ETA - DIMENSIONLESS COORDINATES OF THE QUADRATURE POINTS          
C                                                                       
*COMDECK ECOORD                                                         
C---------------                                                        
      COMMON /ECOORD/ XY(2,ZNNPED)                                      
C                                                                       
C [XY]    - ELEMENTAL NODAL COORDINATES                                 
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
CX30145 CALL SBINX (145)                                                
CY30145 CALL SBINY (145)                                                
CX10689 CALL DOINX( 689 )                                               
CY10689 CALL DOINY( 689 )                                               
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
C LOOP OVER THE QUADRATURE POINTS                                       
C                                                                       
      DO 6 IQ=1,NQD                                                     
      NB(IQ,1) = 1.0                                                    
 6    CONTINUE                                                          
CX20690 CALL DOOUTX( 690 )                                              
CY20690 CALL DOOUTY( 690 )                                              
CX40146 CALL SBOUTX (146)                                               
CY40146 CALL SBOUTY (146)                                               
      RETURN                                                            
      END                                                               
*DECK                                            SSHAP4                 
      SUBROUTINE SSHAP4                                                 
C                                                                       
C***********************************************************************
C                                                                       
C     THIS SUBROUTINE CALCULATES THE STRESS SHAPE FUNCTIONS             
C        FOR NNPES = 4                                                  
C                                                                       
C***********************************************************************
C                                                                       
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SHAPEZ                                                         
C---------------                                                        
*COMDECK XIETA                                                          
C---------------                                                        
      COMMON /XIETA/ XI, ETA                                            
C                                                                       
C XI, ETA - DIMENSIONLESS COORDINATES OF THE QUADRATURE POINTS          
C                                                                       
*COMDECK ECOORD                                                         
C---------------                                                        
      COMMON /ECOORD/ XY(2,ZNNPED)                                      
C                                                                       
C [XY]    - ELEMENTAL NODAL COORDINATES                                 
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
      DIMENSION A(4,4),B(4),AINV(4,4),IPIVOT(4),IWK(2,4)                
      EQUIVALENCE(A,AINV)                                               
      LOGICAL FIRST                                                     
      DATA FIRST /.TRUE./                                               
      DATA A / 1.,    1.,    1.,    1.,                                 
     .         -.5,   .5,   .5,   -.5,                                  
     .         -.5,  -.5,   .5,    .5,                                  
     .         .25, -.25, .25, -.25 /                                   
CX30147 CALL SBINX (147)                                                
CY30147 CALL SBINY (147)                                                
C                                                                       
C     IF (FIRST)                                                        
C     THEN                                                              
      IF (.NOT.FIRST) GO TO 3                                           
C        . PRINT A .                                                    
         WRITE(6,8)                                                     
CX10691 CALL DOINX( 691 )                                               
CY10691 CALL DOINY( 691 )                                               
         DO 1 I=1,NNPES                                                 
            WRITE(6,9) (A(I,J),J=1,NNPES)                               
   1     CONTINUE                                                       
CX20692 CALL DOOUTX( 692 )                                              
CY20692 CALL DOOUTY( 692 )                                              
C                                                                       
C        . INVERT A INTO ITSELF (NOTE THAT A IS EQUIVALENCED TO AINV) . 
         CALL MATINV(NNPES,NNPES,A,0,DUMY,1,DETERM,ISCALE,IPIVOT,IWK)   
C                                                                       
C        . PRINT AINV .                                                 
         WRITE(6,10)                                                    
CX10693 CALL DOINX( 693 )                                               
CY10693 CALL DOINY( 693 )                                               
         DO 2 I=1,NNPES                                                 
            WRITE(6,9) (AINV(I,J),J=1,NNPES)                            
   2     CONTINUE                                                       
CX20694 CALL DOOUTX( 694 )                                              
CY20694 CALL DOOUTY( 694 )                                              
         FIRST = .FALSE.                                                
   3  CONTINUE                                                          
C                                                                       
C     . SET UP QUADRATURE POINTS .                                      
      IF (ISTRES.EQ.0) CALL QUAD                                        
CX10695 CALL DOINX( 695 )                                               
CY10695 CALL DOINY( 695 )                                               
C                                                                       
C     . LOOP OVER THE QUADRATURE POINTS .                               
      DO 6 IQ=1,NQD                                                     
         IF (ISTRES.EQ.0) XI = QDCOOR(1,IQ)                             
         IF (ISTRES.EQ.0) ETA = QDCOOR(2,IQ)                            
         B(1) = 1.                                                      
         B(2) = XI                                                      
         B(3) = ETA                                                     
         B(4) = XI*ETA                                                  
C        . SHAPE FUNCTIONS = (B) * [AINV] .                             
         DO 41 I=1,NNPES                                                
            SUM = 0.                                                    
            DO 4 K=1,NNPES                                              
               SUM = SUM + B(K)*AINV(K,I)                               
   4        CONTINUE                                                    
            NB(IQ,I) = SUM                                              
   41    CONTINUE                                                       
CCC      . CHECK THAT THE SUM OF SHAPE FUNCTIONS = 1 .                  
CCC      SUMN = 0.                                                      
CCC      DO 5 I=1,NNPES                                                 
CCC         SUMN = SUMN + NB(IQ,I)                                      
CCC5     CONTINUE                                                       
CCC      . PRINT THE SHAPE FUNCTIONS .                                  
CCC      PRINT 11,IQ,SUMN,(NB(IQ,I),I=1,NNPES)                          
C                                                                       
      IF (ISTRES.NE.0) THEN                                             
CX40148 CALL SBOUTX (148)                                               
CY40148 CALL SBOUTY (148)                                               
      RETURN                                                            
      ENDIF                                                             
   6  CONTINUE                                                          
CX20696 CALL DOOUTX( 696 )                                              
CY20696 CALL DOOUTY( 696 )                                              
CX40148 CALL SBOUTX (148)                                               
CY40148 CALL SBOUTY (148)                                               
      RETURN                                                            
C                                                                       
C FORMATS                                                               
C                                                                       
   8  FORMAT('0MATRIX A IN SSHAP4 IS'/)                                 
   9  FORMAT(10E13.6)                                                   
  10  FORMAT('0MATRIX AINV IN SSHAP4 IS'/)                              
  11  FORMAT(' IQ =',I5,' SUMN = ',E10.3,' N = ',8E13.6/(10X,8E13.6))   
CX40148 CALL SBOUTX (148)                                               
CY40148 CALL SBOUTY (148)                                               
      END                                                               
*DECK                                            SSHAP8                 
      SUBROUTINE SSHAP8                                                 
C                                                                       
C***********************************************************************
C                                                                       
C     THIS SUBROUTINE CALCULATES THE STRESS SHAPE FUNCTIONS             
C        FOR NNPES = 8                                                  
C                                                                       
C***********************************************************************
C                                                                       
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK SHAPEZ                                                         
C---------------                                                        
*COMDECK XIETA                                                          
C---------------                                                        
      COMMON /XIETA/ XI, ETA                                            
C                                                                       
C XI, ETA - DIMENSIONLESS COORDINATES OF THE QUADRATURE POINTS          
C                                                                       
*COMDECK ECOORD                                                         
C---------------                                                        
      COMMON /ECOORD/ XY(2,ZNNPED)                                      
C                                                                       
C [XY]    - ELEMENTAL NODAL COORDINATES                                 
C                                                                       
*COMDECK SHAPFN                                                         
C---------------                                                        
      REAL N, NB, NDX, NDY, NDXI, NDETA                                 
      COMMON /SHAPFN/  N(ZNQD,ZNNPED), NB(ZNQD,ZNNPES),                 
     .                 NDXI(ZNQD,ZNNPED), NDETA(ZNQD,ZNNPED),           
     .                 NDX(ZNQD,ZNNPED), NDY(ZNQD,ZNNPED),              
     .                 WTDET(ZNQD)                                      
C                                                                       
C N       - ELEMENTAL NODAL SHAPE FUNCTIONS AT QUADRATURE POINTS        
C NB      - ELEMENTAL STRESS NODAL SHAPE FUNCTIONS                      
C NDXI, NDETA - DERIVATIVES OF SHAPE FUNCTIONS W.R.T. XI AND ETA        
C NDX, NDY- DERIVATIVES OF SHAPE FUNCTIONS W.R.T. X AND Y               
C WTDET   - WEIGHTED JACOBIAN DETERMINANTS AT QUADRATURE POINTS         
C                                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK QUADZ                                                          
C---------------                                                        
      COMMON /QUADZ/ QDCOOR(2,ZNQD), QDWGHT(ZNQD)                       
C                                                                       
C QDCOOR  - COORDINATES OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C QDWGHT  - WEIGHTS     OF THE NUMERICAL INTEGRATION QUADRATURE POINTS  
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK INFO                                                           
C---------------                                                        
      COMMON /INFO/ ISTRES, IRECT                                       
C                                                                       
C ISTRES  - IF 0 THEN EVALUATE THE SHAPE FUNCTIONS AND THEIR            
C           DERIVATIVES AT ALL QUADRATURE POINTS, ELSE ONLY             
C           AT (XI,ETA)                                                 
C IRECT   - IF 0 THEN THE ELEMENT IS A GENERAL QUADRILATERAL, IF 1      
C           THEN IT IS RECTANGULAR                                      
C                                                                       
      DIMENSION A(8,8),B(8),AINV(8,8),IPIVOT(8),IWK(2,8)                
      EQUIVALENCE(A,AINV)                                               
      LOGICAL FIRST                                                     
      DATA FIRST /.TRUE./                                               
      DATA A /                                                          
     .   1.,   1.,   1.,   1.,   1.,   1.,   1.,   1.,                  
     .   -.5,  0.,   .5,   .5,   .5,   0.,   -.5,  -.5,                 
     .   -.5,  -.5, -.5,   0.,    .5,   .5,   .5,   0.,                 
     .   .25,  0.,   .25,  .25,  .25,  0.,   .25,  .25,                 
     .   .25,  .25,  .25,  0.,   .25,  .25,  .25,  0.,                  
     .   .25,  0.,  -.25,  0.,   .25,  0.,  -.25,  0.,                  
     .  -.125, 0.,  -.125, 0.,   .125, 0.,   .125, 0.,                  
     .  -.125, 0.,   .125, 0.,   .125, 0.,  -.125, 0.  /                
CX30149 CALL SBINX (149)                                                
CY30149 CALL SBINY (149)                                                
C                                                                       
C     IF (FIRST)                                                        
C     THEN                                                              
                                                 IF (.NOT.FIRST) GO TO 3
C        . PRINT A .                                                    
         PRINT 8                                                        
CX10697 CALL DOINX( 697 )                                               
CY10697 CALL DOINY( 697 )                                               
         DO 1 I=1,NNPES                                                 
            WRITE(6,9) (A(I,J),J=1,NNPES)                               
   1     CONTINUE                                                       
CX20698 CALL DOOUTX( 698 )                                              
CY20698 CALL DOOUTY( 698 )                                              
C                                                                       
C        . INVERT A INTO ITSELF (NOTE THAT A IS EQUIVALENCED TO AINV) . 
         CALL MATINV(NNPES,NNPES,A,0,DUMY,1,DETERM,ISCALE,IPIVOT,IWK)   
C                                                                       
C        . PRINT AINV .                                                 
         WRITE(6,10)                                                    
CX10699 CALL DOINX( 699 )                                               
CY10699 CALL DOINY( 699 )                                               
         DO 2 I=1,NNPES                                                 
            WRITE(6,9) (AINV(I,J),J=1,NNPES)                            
   2     CONTINUE                                                       
CX20700 CALL DOOUTX( 700 )                                              
CY20700 CALL DOOUTY( 700 )                                              
         FIRST = .FALSE.                                                
   3  CONTINUE                                                          
C                                                                       
C     . SET UP QUADRATURE POINTS .                                      
      IF (ISTRES.EQ.0) CALL QUAD                                        
CX10701 CALL DOINX( 701 )                                               
CY10701 CALL DOINY( 701 )                                               
C                                                                       
C     . LOOP OVER THE QUADRATURE POINTS .                               
      DO 6 IQ=1,NQD                                                     
         IF (ISTRES.EQ.0) XI = QDCOOR(1,IQ)                             
         IF (ISTRES.EQ.0) ETA = QDCOOR(2,IQ)                            
         B(1) = 1.                                                      
         B(2) = XI                                                      
         B(3) = ETA                                                     
         B(4) = XI*XI                                                   
         B(5) = ETA*ETA                                                 
         B(6) = XI*ETA                                                  
         B(7) = XI*XI*ETA                                               
         B(8) = XI*ETA*ETA                                              
C        . SHAPE FUNCTIONS = (B) * [AINV] .                             
         DO 41 I=1,NNPES                                                
            SUM = 0.                                                    
            DO 4 K=1,NNPES                                              
               SUM = SUM + B(K)*AINV(K,I)                               
   4        CONTINUE                                                    
            NB(IQ,I) = SUM                                              
   41    CONTINUE                                                       
CCC      . CHECK THAT THE SUM OF SHAPE FUNCTIONS = 1 .                  
CCC      SUMN = 0.                                                      
CCC      DO 5 I=1,NNPES                                                 
CCC         SUMN = SUMN + NB(IQ,I)                                      
CCC5     CONTINUE                                                       
CCC      . PRINT THE SHAPE FUNCTIONS .                                  
CCC      PRINT 11,IQ,SUMN,(NB(IQ,I),I=1,NNPES)                          
C                                                                       
      IF (ISTRES.NE.0) THEN                                             
CX40150 CALL SBOUTX (150)                                               
CY40150 CALL SBOUTY (150)                                               
      RETURN                                                            
      ENDIF                                                             
   6  CONTINUE                                                          
CX20702 CALL DOOUTX( 702 )                                              
CY20702 CALL DOOUTY( 702 )                                              
CX40150 CALL SBOUTX (150)                                               
CY40150 CALL SBOUTY (150)                                               
      RETURN                                                            
C                                                                       
C FORMATS                                                               
C                                                                       
   8  FORMAT('0MATRIX A IN SSHAP4 IS'/)                                 
   9  FORMAT(10E13.6)                                                   
  10  FORMAT('0MATRIX AINV IN SSHAP4 IS'/)                              
  11  FORMAT(' IQ =',I5,' SUMN = ',E10.3,' N = ',8E13.6/(10X,8E13.6))   
CX40150 CALL SBOUTX (150)                                               
CY40150 CALL SBOUTY (150)                                               
      END                                                               
*DECK                                            TRANF                  
      SUBROUTINE TRANF                                                  
C********************************************************************** 
C THIS SUBROUTINE TRANSFORMS THE COMPLIANCE MATRIX TO GLOBAL COORDINATES
C FOR THE 8 STRESS DEGREES OF FREEDOM SHELL ELEMENT                     
C********************************************************************** 
      COMMON /TRANFZ/ THETA, CA(6), CL(3,3), CLS(2,2)                   
      COMMON /TRANFT/ TR(6,4), AS(6)                                    
CX30151 CALL SBINX (151)                                                
CY30151 CALL SBINY (151)                                                
      S = SIN(THETA)                                                    
      C = COS(THETA)                                                    
      S2 = S*S                                                          
      S3 = S2*S                                                         
      S4 = S3*S                                                         
      C2 = C*C                                                          
      C3 = C2*C                                                         
      C4 = C3*C                                                         
      SC2 = S2*C2                                                       
      TR(1,1) = C4                                                      
      TR(1,2) = 2.*SC2                                                  
      TR(1,3) = S4                                                      
      TR(1,4) = 4.*SC2                                                  
      TR(2,1) = SC2                                                     
      TR(2,2) = 1. - 2.*SC2                                             
      TR(2,3) = SC2                                                     
      TR(2,4) = -4.*SC2                                                 
      TR(3,1) = S*C3                                                    
      TR(3,2) = -S*C*(C2 - S2)                                          
      TR(3,3) = -S3*C                                                   
      TR(3,4) = -2.*S*C*(C2 - S2)                                       
      TR(4,1) = S4                                                      
      TR(4,2) = 2.*SC2                                                  
      TR(4,3) = C4                                                      
      TR(4,4) = 4.*SC2                                                  
      TR(5,1) = S3*C                                                    
      TR(5,2) = S*C*(C2 - S2)                                           
      TR(5,3) = -S*C3                                                   
      TR(5,4) = 2.*S*C*(C2 - S2)                                        
      TR(6,1) = SC2                                                     
      TR(6,2) = -2.*SC2                                                 
      TR(6,3) = SC2                                                     
      TR(6,4) = 1. - 4.*SC2                                             
CX10703 CALL DOINX( 703 )                                               
CY10703 CALL DOINY( 703 )                                               
      DO 20 I = 1, 6                                                    
         AFS = 0.                                                       
         DO 10 J = 1, 4                                                 
            AFS = AFS + TR(I,J)*CA(J)                                   
  10     CONTINUE                                                       
         AS(I) = AFS                                                    
  20  CONTINUE                                                          
CX20704 CALL DOOUTX( 704 )                                              
CY20704 CALL DOOUTY( 704 )                                              
      CL(1,1) = AS(1)                                                   
      CL(1,2) = AS(2)                                                   
      CL(1,3) = AS(3)                                                   
      CL(2,2) = AS(4)                                                   
      CL(2,3) = AS(5)                                                   
      CL(3,3) = AS(6)                                                   
CX10705 CALL DOINX( 705 )                                               
CY10705 CALL DOINY( 705 )                                               
      DO 30 I = 1, 3                                                    
      DO 30 J = 1, 3                                                    
         CL(J,I) = CL(I,J)                                              
  30  CONTINUE                                                          
CX20706 CALL DOOUTX( 706 )                                              
CY20706 CALL DOOUTY( 706 )                                              
      AI44 = 1./CA(5)                                                   
      AI55 = 1./CA(6)                                                   
      ACI44 = C2*AI44 + S2*AI55                                         
      ACI55 = S2*AI44 + C2*AI55                                         
      ACI45 =-S*C*(AI44 - AI55)                                         
      DEL = ACI44*ACI55 - ACI45*ACI45                                   
      DI = 1./DEL                                                       
      CLS(1,1) = ACI44*DI                                               
      CLS(1,2) =-ACI45*DI                                               
      CLS(2,1) = CLS(1,2)                                               
      CLS(2,2) = ACI55*DI                                               
CX40152 CALL SBOUTX (152)                                               
CY40152 CALL SBOUTY (152)                                               
      RETURN                                                            
      END                                                               
                                                                        
*DECK                                            TRNRHS                 
      SUBROUTINE TRNRHS(ID,RHSE)                                        
C********************************************************************** 
C     TRANSFORM THE RIGHT HAND SIDE FOR INVERSION SYMMETRY              
C********************************************************************** 
*COMDECK PARAMS                                                         
C---------------                                                        
      INTEGER ZNDE, ZNE, ZNNS, ZNND, ZNSS, ZNNPB, ZNBN, ZNCONC,         
     *        ZNL, ZNQD, ZNNPES, ZNNPED, ZNEQS, ZNEQD,                  
     *        ZNDFE, ZNSFE, ZNUMF, ZNUMS, ZNUMM, ZNUMNL,                
     *        ZNUMP, ZNEQPB, ZNBLCK                                     
      PARAMETER (                                                       
     *           ZNDE=1, ZNE=4, ZNNS=16, ZNND=25, ZNSS=4, ZNNPB=9,      
     *           ZNBN=16, ZNCONC=10, ZNL=30, ZNQD=25, ZNNPES=4,         
     *           ZNNPED=9                                               
     *          )                                                       
C                                                                       
C     . THE FOLLOWING PARAMETERS ARE COMPUTED FROM THE ABOVE VALUES .   
      PARAMETER (                                                       
     *           ZNEQS=8*ZNNS, ZNEQD=5*ZNND, ZNDFE=5*ZNNPED,            
     *           ZNSFE=8*ZNNPES, ZNUMF=ZNSFE*ZNSFE, ZNUMS=ZNSFE*ZNDFE,  
     *           ZNUMM=ZNDFE*ZNDFE,                                     
     *           ZNUMNL=ZNNPES*ZNNPED*(ZNNPED+1)/2*3, ZNUMP=ZNDFE,      
     *           ZNEQPB=5*ZNNPB, ZNBLCK=ZNSS+1                          
     *          )                                                       
*COMDECK NUMBER                                                         
C---------------                                                        
      PARAMETER (NSDF=8, NDDF=5)                                        
      COMMON /NUMBER/ NE, NNS, NND, NNPES, NNPED, NBN, NDE,             
     .                NCT, NEQS, NEQD, NSFE, NDFE                       
C                                                                       
C NE      - NUMBER OF ELEMENTS IN THE STRUCTURE                         
C NNS     - NUMBER OF STRESS NODES IN THE STRUCTURE                     
C NND     - NUMBER OF DISPL. NODES IN THE STRUCTURE                     
C NNPES   - NUMBER OF STRESS NODES PER ELEMENT                          
C NNPED   - NUMBER OF DISPL. NODES PER ELEMENT                          
C NSDF    - NUMBER OF STRESS DEGREES OF FREEDOM PER NODE                
C NDDF    - NUMBER OF DISPL. DEGREES OF FREEDOM PER NODE                
C NBN     - NUMBER OF NODES AT WHICH TO APPLY BOUNDARY CONDITIONS       
C NDE     - NUMBER OF ELEMENTS WITH DISTINCT STIFFNESS MATRICES         
C NCT     - NUMBER OF CURVATURE TYPES                                   
C NEQS    - NUMBER OF STRESS EQUATIONS (=NSDF*NNS)                      
C NEQD    - NUMBER OF DISPL. EQUATIONS (=NDDF*NND)                      
C NSFE    - NUMBER OF STRESS DEGREES OF FREEDOM PER ELEMENT (=NSDF*NNPES
C NDFE    - NUMBER OF DISPL. DEGREES OF FREEDOM PER ELEMENT (=NDDF*NNPED
C                                                                       
*COMDECK SOLN                                                           
C---------------                                                        
      COMMON /SOLN/ NQD, NSYMM, RKAPPA, GX(5), KNONLN                   
      CHARACTER*80 TITLE                                                
      COMMON /TITLEC/ TITLE                                             
C                                                                       
C NQD     - NUMBER OF NUMERICAL INTEGRATION QUADRATURE POINTS           
C NSYMM   - SYMMETRY FLAG (1 = YES, 0 = NO)                             
C RKAPPA  - TYPE OF INVERSION SYMMETRY                                  
C           1.  = SYMMETRIC                                             
C          -1.  = ANTI-SYMMETRIC                                        
C           2.  = SYMMETRIC IN U,V                                      
C                 ANTI-SYMMETRIC IN W,PHI1,PHI2                         
C GX      - DIAGONAL TRANSFORMATION MATRIX FOR DISPLACEMENTS            
C KNONLN  - NONLINEAR FLAG (0=LINEAR, 1=NONLINEAR)                      
C                                                                       
*COMDECK CONN                                                           
C---------------                                                        
      COMMON /CONN/ ICONS(ZNNPES,ZNE), ICOND(ZNNPED,ZNE)                
C                                                                       
C ICONS   - STRESS ELEMENTAL CONNECTIVITY VECTORS                       
C ICOND   - DISPL. ELEMENTAL CONNECTIVITY VECTORS                       
      DIMENSION RHSE(NDDF,NNPED)                                        
CX30153 CALL SBINX (153)                                                
CY30153 CALL SBINY (153)                                                
CX10707 CALL DOINX( 707 )                                               
CY10707 CALL DOINY( 707 )                                               
C                                                                       
      DO 20 IN = 1, NNPED                                               
         NODE = ICOND(IN,ID)                                            
         IF (NODE.LT.0) THEN                                            
            DO 10 IDOF = 1, NDDF                                        
               RHSE(IDOF,IN) = RHSE(IDOF,IN)*GX(IDOF)                   
  10        CONTINUE                                                    
         ENDIF                                                          
  20  CONTINUE                                                          
CX20708 CALL DOOUTX( 708 )                                              
CY20708 CALL DOOUTY( 708 )                                              
CX40154 CALL SBOUTX (154)                                               
CY40154 CALL SBOUTY (154)                                               
C                                                                       
C     ... EXIT                                                          
      RETURN                                                            
      END                                                               
*DECK                                            ZEROV                  
      SUBROUTINE ZEROV(VECTOR, LENGTH)                                  
C********************************************************************** 
C ZERO OUT A VECTOR OF A GIVEN LENGTH.                                  
C********************************************************************** 
      DIMENSION VECTOR(LENGTH)                                          
CX30155 CALL SBINX (155)                                                
CY30155 CALL SBINY (155)                                                
CX10709 CALL DOINX( 709 )                                               
CY10709 CALL DOINY( 709 )                                               
      DO 100 I = 1, LENGTH                                              
        VECTOR(I) = 0.                                                  
 100  CONTINUE                                                          
CX20710 CALL DOOUTX( 710 )                                              
CY20710 CALL DOOUTY( 710 )                                              
CX40156 CALL SBOUTX (156)                                               
CY40156 CALL SBOUTY (156)                                               
      RETURN                                                            
      END                                                               
