findlim.f 1.78 KB
 Markus Betzinger committed Apr 26, 2016 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 `````` MODULE m_findlim c......................................................findlim c finds turning point and practical "infinity" c CONTAINS SUBROUTINE findlim( > mrad,lll,ec,vv,rc, < nmatch,nzero) IMPLICIT NONE C .. C .. Scalar Arguments .. REAL, INTENT (IN) :: ec INTEGER, INTENT (IN) :: mrad,lll INTEGER, INTENT (OUT):: nmatch,nzero C .. C .. Array Arguments .. REAL , INTENT (IN) :: rc(mrad),vv(mrad) C .. C .. Local Scalars .. REAL unend INTEGER n,nn C .. C .. Intrinsic Functions .. INTRINSIC mod C .. C .. Data statements .. DATA unend/150.0/ C .. C -------------------- C---> FIND NZERO C -------------------- DO 10 n = 1, (mrad-1) IF ((vv(n)-ec)*rc(n)**2.GT.unend) THEN IF (mod(n,2).EQ.0) THEN nzero = n + 1 ELSE nzero = n END IF GO TO 20 END IF 10 CONTINUE nzero = mrad - 1 WRITE (6,FMT= +'('' NRC='',I4,'' L='',I2, + '' NZERO SET TO (NRC-1) ='',I4)') mrad,lll,(mrad-1) 20 CONTINUE C -------------------- C---> FIND NMATCH C -------------------- n = nzero + 1 DO nn = 1,nzero n = n - 1 ! IF ( (vv(n) + lll/rc(n)**2 - ec) < 0.0 ) THEN IF ((vv(n)-ec).LT.0.0) THEN nmatch = n RETURN END IF ENDDO WRITE (6,FMT= +'(//,'' STOP IN <>'',/, + '' NRC='',I2,'' L='',I2,/, + '' NO MATCHING-RADIUS FOUND FOR EC='',F10.3)') mrad,lll,ec END SUBROUTINE findlim END MODULE m_findlim``````