displ_mod.f90

   1 MODULE DISPL_CALC
   2
   3   IMPLICIT NONE
   4
   5 CONTAINS
   6
   7    SUBROUTINE DSPLISO(EESUM,EEDIF,UUZZ,CHI)
   8         Use Input_Data
   9      IMPLICIT NONE
  10      REAL, INTENT(IN   ) :: CHI
  11      REAL, INTENT(  OUT) :: EESUM,EEDIF,UUZZ
  12
  13      DOUBLE PRECISION :: AASUM,AADIF,AAZZ
  14
  15      !!! COMMON
  16      REAL :: RHO,ZETA,ETA
  17      COMMON /QAGON/RHO,ZETA,ETA
  18
  19      ETA=1.E0
  20      CALL DPREST(AASUM,AADIF,AAZZ)
  21
  22      EESUM = - BIAUX*(AASUM+CHI)
  23      EEDIF = BIAUX*(AADIF-CHI)
  24      UUZZ  = -BIAUX*AAZZ
  25
  26    END SUBROUTINE DSPLISO
  27
  28    SUBROUTINE DSPLANISO(EESUM,EEDIF,UUZ,CHI)
  29         Use Input_Data
  30      IMPLICIT NONE
  31      REAL, INTENT(IN   ) :: CHI
  32      REAL, INTENT(  OUT) :: EESUM,EEDIF,UUZ
  33
  34      DOUBLE PRECISION :: AASUM1,AADIF1,AAZ1,&
  35                          AASUM2,AADIF2,AAZ2
  36
  37      !!! COMMON
  38      REAL :: RHO,ZETA,ETA
  39      COMMON /QAGON/RHO,ZETA,ETA
  40
  41      ETA=ETA1
  42      CALL DPREST(AASUM1,AADIF1,AAZ1)
  43      ETA=ETA2
  44      CALL DPREST(AASUM2,AADIF2,AAZ2)
  45
  46      EESUM =  CN1_2G*CHI + & !(2.E0*EPSA + CN1_2G)*CHI + &
  47              (CN02_1*AASUM2 - CN02_2*AASUM1)/ETA_DIF
  48      EEDIF = +CN1_2G*CHI - &
  49              (CN02_1*AADIF2 - CN02_2*AADIF1)/ETA_DIF
  50      UUZ  =  & !(EPSC*CHI)*ZETA + &
  51              (U1*AAZ2 - U2*AAZ1)/ETA_DIF
  52
  53 !    WRITE(12,'(10(E15.8,1X))')ZETA,RHO,AASUM1,AASUM2,AADIF1,AADIF2
  54
  55      RETURN
  56
  57    END SUBROUTINE DSPLANISO
  58
  59    SUBROUTINE DPREST(AASUM,AADIF,AAZ)
  60
  61       Use Input_Data, ONLY: RD,RC,ZC
  62
  63    IMPLICIT NONE
  64
  65 !! 'dummy' and local variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  66
  67    DOUBLE PRECISION AASUM,AADIF,AAZ,RO,ZE
  68
  69 !! GAG Variables  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  70
  71    INTEGER, PARAMETER :: LIMITE=100
  72    DOUBLE PRECISION AL,AU,ABSERR,EPSABS,EPSREL,WORK(4*LIMITE)
  73    INTEGER IER,IWORK(LIMITE),KEY,LAST,LENW,LIMIT,NEVAL
  74
  75    DOUBLE PRECISION, EXTERNAL :: I_FA00,I_FA20,I_FI00
  76
  77    !!! COMMON
  78    REAL :: RHO,ZETA,ETA
  79    COMMON /QAGON/RHO,ZETA,ETA
  80
  81 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  82
  83     RO=RHO
  84     ZE=ZETA
  85     AL=0.D0
  86     AU=DBLE(RD)
  87
  88     EPSABS=0.D0
  89     EPSREL=1.D-4
  90     KEY=6
  91     LIMIT=LIMITE
  92     LENW=LIMIT*4
  93
  94     CALL DQAG(I_FA00,AL,AU,EPSABS,EPSREL,KEY,AASUM,ABSERR,NEVAL, &
  95              IER,LIMIT,LENW,LAST,IWORK,WORK)
  96
  97     IF (IER.NE.0) &
  98        CALL DQAG_CHECK("FA00","AASUM",AASUM,ABSERR,RO*RC,ZE*ZC,NEVAL,IER,LAST)
  99
 100        CALL DQAG(I_FA20,AL,AU,EPSABS,EPSREL,KEY,AADIF,ABSERR,NEVAL, &
 101              IER,LIMIT,LENW,LAST,IWORK,WORK)
 102
 103     IF (IER.NE.0) &
 104        CALL DQAG_CHECK("FA20","AADIF",AADIF,ABSERR,RO*RC,ZE*ZC,NEVAL,IER,LAST)
 105
 106        CALL DQAG(I_FI00,AL,AU,EPSABS,EPSREL,KEY,AAZ,ABSERR,NEVAL, &
 107                 IER,LIMIT,LENW,LAST,IWORK,WORK)
 108     IF (IER.NE.0) &
 109        CALL DQAG_CHECK("FI00","UUZ",AAZ,ABSERR,RO*RC,ZE*ZC,NEVAL,IER,LAST)
 110
 111    RETURN
 112    END SUBROUTINE DPREST
 113
 114    SUBROUTINE DQAG_CHECK(FUNC,RESNAME,RES,ABSERR,RO,ZE,NEVAL,IER,LAST)
 115    IMPLICIT NONE
 116    CHARACTER(LEN=*)    :: FUNC,RESNAME
 117    DOUBLE PRECISION    :: RES,ABSERR,RO,ZE
 118    INTEGER             :: NEVAL,IER,LAST
 119      WRITE(6,*)"ERROR AT: RHO: ",RO," ZETA: ",ZE
 120      WRITE(6,*)"QAG ",TRIM(FUNC)," ",TRIM(RESNAME)," RESULT=",RES
 121      WRITE(6,*)"QAG ABSERR=",ABSERR
 122      WRITE(6,*)"QAG NEVAL=",NEVAL
 123      WRITE(6,*)"QAG IER=",IER
 124      WRITE(6,*)"QAG LAST=",LAST
 125
 126      RETURN
 127    END SUBROUTINE DQAG_CHECK
 128
 129 END MODULE DISPL_CALC