← Back to branch summary

~useakat/cfmc/gg_4g_cfmc

« back to all changes in this revision

Viewing changes to hml/hml/phq2rs.f

  • Committer: useakat at gmail
  • Date: 2012-10-01 07:45:50 UTC
  • mfrom: (4.1.13 gg_3g_cfmc_dev)
  • Revision ID: useakat@gmail.com-20121001074550-zs09eu30khm4yvyx
independent ver.

Show diffs side-by-side

added added

removed removed

Lines of Context:
hml/hml/phq2rs.f
 
1
      SUBROUTINE PHQ2RS(AMSX,GAMX,GMXMIN,ENGM,QSQMN,QSQMX,Z, 
 
2
     &     QSQ,WAT)
 
3
 
 
4
      IMPLICIT NONE
 
5
 
 
6
      INCLUDE 'hmparm.inc'
 
7
 
 
8
      DOUBLE PRECISION AMSX,GAMX,QSQMN,QSQMX,Z
 
9
      DOUBLE PRECISION QSQ,WAT
 
10
 
 
11
      DOUBLE PRECISION QSQMN0,QSQMX0
 
12
 
 
13
      DOUBLE PRECISION GMXMIN,ENGM
 
14
C      PARAMETER (GMXMIN=1.D-2)
 
15
C      PARAMETER (ENGM=10.D0)
 
16
      DOUBLE PRECISION PIFACT
 
17
      PARAMETER (PIFACT=1.D0/TWOPI)
 
18
 
 
19
C     print *,'phq2rs;gamx,gmxmin = ',gamx,gmxmin
 
20
      IF(GAMX.GT.GMXMIN) THEN
 
21
         IF(AMSX-ENGM*GAMX.GT.QSQMN) THEN
 
22
            QSQMN0 = AMSX-ENGM*GAMX
 
23
         ELSE
 
24
            QSQMN0 = QSQMN
 
25
         END IF
 
26
         IF(AMSX+ENGM*GAMX.LT.QSQMX) THEN
 
27
            QSQMX0 = AMSX+ENGM*GAMX
 
28
         ELSE
 
29
            QSQMX0 = QSQMX
 
30
         END IF
 
31
C         IF(AMSX.GT.QSQMN .AND. AMSX.LT.QSQMX) THEN
 
32
C            QSQMN = MAX(QSQMN,AMSX-ENGM*GAMX)
 
33
C            QSQMX = MIN(QSQMX,AMSX+ENGM*GAMX)
 
34
C     ENDIF
 
35
C         PRINT *,'PHQ2RS;AMSX,GAMX = ',AMSX,GAMX
 
36
C         PRINT *,'      ;QSQMIN,MAX = ',QSQMN0,QSQMX0
 
37
         CALL PHQ2BW(AMSX,GAMX,QSQMN0,QSQMX0,Z,QSQ,WAT)
 
38
      ELSE
 
39
         QSQ = AMSX**2
 
40
         WAT = PI*AMSX*GAMX
 
41
      ENDIF      
 
42
 
 
43
      WAT = PIFACT*WAT
 
44
 
 
45
      RETURN
 
46
      END