Sources Esope | Cast3M

tipoq1
C TIPOQ1    SOURCE    CHAT      05/01/13    03:41:10     5004
      SUBROUTINE TIPOQ1(Q,NCOMP2,Q1,NC2PME)
***********
*
*     ESCLAVE DE MENISM
*
*     P.PEGON (ISPRA) AOUT 1996
*
***********
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION Q(NCOMP2,NCOMP2),Q1(NCOMP2,NC2PME)
*
      NCOMP=NCOMP2/2
      MECAN=NC2PME-NCOMP2
*
      IF(MECAN.EQ.3.AND.NCOMP.EQ.3)THEN
        CALL ZERO(Q1,NCOMP2,NC2PME)
        DO I=1,3
*         I1 simule 1,2,5
          I1=I+(I/3)*2
          DO J=1,6
            Q1(I1,J)=Q(I1,J)
          ENDDO
*         I1 simule 3,4,6
          I1=I+2+(I/3)
          Q1(I1,NCOMP2+I)=1.D0
        ENDDO
*
      ELSEIF(MECAN.EQ.2.AND.NCOMP.EQ.3)THEN
        CALL ZERO(Q1,NCOMP2,NC2PME)
        DO I=1,4
*         I1 simule 1,2,4,5
          I1=I+(I/3)
          DO J=1,6
            Q1(I1,J)=Q(I1,J)
          ENDDO
        ENDDO
        DO I=1,2
*         I1 simule 3,6
          I1=3*I
          Q1(I1,NCOMP2+I)=1.D0
        ENDDO
*
      ENDIF
*
      RETURN
      END