cmatini4.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	cmatini4 (elbuf_str, jft, jlt, nft, nel, istrain, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, ir, is, npt, igtyp, igeo, nlay, npg, ipg)

Function/Subroutine Documentation

cmatini4()

subroutine cmatini4	(	type(elbuf_struct_), target	elbuf_str,
		integer	jft,
		integer	jlt,
		integer	nft,
		integer	nel,
		integer	istrain,
			sigsh,
		integer	nsigsh,
		integer	numel,
		integer, dimension(nix,*)	ix,
		integer	nix,
		integer	numsh,
		integer, dimension(*)	ptsh,
		integer	ir,
		integer	is,
		integer	npt,
		integer	igtyp,
		integer, dimension(npropgi,*)	igeo,
		integer	nlay,
		integer	npg,
		integer	ipg )

Definition at line 34 of file cmatini4.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "com01_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JFT,JLT,NFT,NEL,IR,IS,NPT,NUMEL,NIX,ISTRAIN,NSIGSH,NUMSH,IGTYP,IGEO(NPROPGI,*),NLAY,NPG,IPG
      INTEGER IX(NIX,*),PTSH(*)
      my_real sigsh(nsigsh,*)
      TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
C------------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      CHARACTER(LEN=NCHARTITLE) :: TITR
      INTEGER I,II,J,JJ,N,NPTI,I1,I2,PT,NPGI,NU,NUVAR,NVARS,IPT,NPI,
     .  IPID1,PID1,C1,IPT_ALL,IT,ILAY,NPTT
      TYPE(L_BUFEL_) ,POINTER :: LBUF     
C--------------------------------------------------------------
      DO i=jft,jlt
        IF (abs(isigi)/=3 .AND. abs(isigi)/=4 .AND. abs(isigi)/=5)THEN
          ii = i+nft
          n = nint(sigsh(nvshell + 1,ii))
          IF (n/=ix(nix,ii)) THEN
            jj = ii
            DO j = 1,numel
              ii= j
              n = nint(sigsh(nvshell + 1,ii))
              IF (n == 0) GOTO 200
              IF (n == ix(nix,jj)) GOTO 60
            ENDDO
 60         CONTINUE
          ENDIF
        ELSE
          jj=nft+i
          n =ix(nix,jj)
          ii=ptsh(jj)
          IF (ii == 0) GOTO 200
        ENDIF
C
        npi   = nint(sigsh(nvshell +  2,ii))
        npgi  = nint(sigsh(nvshell +  3,ii))
!!        PT=NVSHELL+3  ! wrong position, overwriting FAIL
        pt = nvshell+nushell+nortshel+nvshell1+3
C
C for IGTYP == 51, usually NPT <= NPTI (NPTI = NTPP --> for all layers)
        IF ((npgi /= npg.OR.npi /= npt) .AND. igtyp /= 51 
     .                                  .AND. igtyp /=52) THEN
          ipid1=ix(nix-1,nft+i)
          pid1=igeo(1,ipid1)
          CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
          CALL ancmsg(msgid=1215, anmode=aninfo, msgtype=msgerror, c1=titr, i1=pid1, i2=n)
C
        ELSE
          IF (npgi > 0) THEN
            IF (npi > 0) THEN
c
              ipt_all = 0
              DO ilay=1,nlay
                nptt  = elbuf_str%BUFLY(ilay)%NPTT
                DO it=1,nptt
                  ipt = ipt_all + it
 
                  lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
                  lbuf%FAC_YLD(i) = sigsh(pt+(ipg-1)*npi+ipt,ii)
                ENDDO
                ipt_all = ipt_all + nptt
              ENDDO  !  DO ILAY=1,NPT
c
            ELSE
!----------------------------------------------------------
!!  ILAY --> not initialised here
!!  SIGSH(PT, II) --> not filled within initia for NIP = 0
!----------------------------------------------------------
!!             LBUF => ELBUF_STR%BUFLY(ILAY)%LBUF(IR,IS,IT)                         
!!             LBUF%FAC_YLD(I) = SIGSH(PT+IPG, II)                                          
            ENDIF ! IF (NPI > 0)
          ELSE
          ENDIF ! IF (NPGI > 0)
        ENDIF ! IF ((NPGI /= NPG.OR.NPI /= NPT) .AND. IGTYP /= 51)
C
200    CONTINUE
C
      ENDDO ! DO I=JFT,JLT
C---
      RETURN