DATABASES/madrigal Files · source/madf/geolib/monum.f

Add restart to nginx container

jespinoza - - Load All Authors

File last commit:

r0:b84e1135c2c4


                r22:1c8c96a4f254

master

Download file

             monum.f
        
                    53 lines
            
             | 1.4 KiB
            
                | text/x-fortran
            
             |
                FortranFixedLexer
            
             / source / madf / geolib / monum.f
          
                    History
                
                 |
                  Annotation
                 | Raw
                 |Copy content
                 |Copy permalink

      C     $Id: monum.f 3304 2011-01-17 15:25:59Z brideout $

      C

            SUBROUTINE MONUM(MSTR,MONTH,IER)

      C

      C     Returns Month integer from Month string (case insignificant).

      C

      C      Input:

      C         MSTR - Month string (e.g. 'January')

      C

      C      Output:

      C        MONTH - Month of year (1-12)

      C          IER - If (IER.NE.0) an error has occurred.

      C

      C     .. Scalar Arguments ..

            INTEGER IER,MONTH

            CHARACTER*(*) MSTR

      C     ..

      C     .. Local Scalars ..

            INTEGER ICH,JCH

            CHARACTER*75 MNAME

      C     ..

      C     .. Local Arrays ..

            INTEGER MCHAR(13)

      C     ..

      C     .. Intrinsic Functions ..

            INTRINSIC CHAR,ICHAR

      C     ..

      C     .. Data statements ..

            DATA MCHAR/1,8,16,21,26,29,33,37,43,52,59,67,75/

      C     ..

            MNAME = 'JANUARYFEBRUARYMARCHAPRILMAYJUNEJULYAUGUSTSEPTEMBER'//

           *        'OCTOBERNOVEMBERDECEMBER'

      C

            IER = 0

            DO 30 MONTH = 1,12

               ICH = 1

               JCH = MCHAR(MONTH)

               IF (MSTR(ICH:ICH).NE.MNAME(JCH:JCH) .AND.

           *       CHAR(ICHAR(MSTR(ICH:ICH))-32).NE.

           *       MNAME(JCH:JCH)) GO TO 30

         10    ICH = ICH + 1

               IF (ICH.EQ.4) GO TO 40

         20    JCH = JCH + 1

               IF (JCH.GE.MCHAR(MONTH+1)) GO TO 30

               IF (MSTR(ICH:ICH).NE.MNAME(JCH:JCH) .AND.

           *       CHAR(ICHAR(MSTR(ICH:ICH))-32).NE.MNAME(JCH:JCH)) GO TO 20

               GO TO 10

         30 CONTINUE

            MONTH = 0

            IER = 1

         40 RETURN

      C

            END

	Site-wide shortcuts
/	Use quick search box
g h	Goto home page
g g	Goto my private gists page
g G	Goto my public gists page
g 0-9	Goto bookmarked items from 0-9
n r	New repository page
n g	New gist page

	Repositories
g s	Goto summary page
g c	Goto changelog page
g f	Goto files page
g F	Goto files page with file search activated
g p	Goto pull requests page
g o	Goto repository settings
g O	Goto repository access permissions settings
t s	Toggle sidebar on some pages

				C $Id: monum.f 3304 2011-01-17 15:25:59Z brideout $
				C
				SUBROUTINE MONUM(MSTR,MONTH,IER)
				C
				C Returns Month integer from Month string (case insignificant).
				C
				C Input:
				C MSTR - Month string (e.g. 'January')
				C
				C Output:
				C MONTH - Month of year (1-12)
				C IER - If (IER.NE.0) an error has occurred.
				C
				C .. Scalar Arguments ..
				INTEGER IER,MONTH
				CHARACTER() MSTR
				C ..
				C .. Local Scalars ..
				INTEGER ICH,JCH
				CHARACTER*75 MNAME
				C ..
				C .. Local Arrays ..
				INTEGER MCHAR(13)
				C ..
				C .. Intrinsic Functions ..
				INTRINSIC CHAR,ICHAR
				C ..
				C .. Data statements ..
				DATA MCHAR/1,8,16,21,26,29,33,37,43,52,59,67,75/
				C ..
				MNAME = 'JANUARYFEBRUARYMARCHAPRILMAYJUNEJULYAUGUSTSEPTEMBER'//
				* 'OCTOBERNOVEMBERDECEMBER'
				C
				IER = 0
				DO 30 MONTH = 1,12
				ICH = 1
				JCH = MCHAR(MONTH)
				IF (MSTR(ICH:ICH).NE.MNAME(JCH:JCH) .AND.
				* CHAR(ICHAR(MSTR(ICH:ICH))-32).NE.
				* MNAME(JCH:JCH)) GO TO 30
				10 ICH = ICH + 1
				IF (ICH.EQ.4) GO TO 40
				20 JCH = JCH + 1
				IF (JCH.GE.MCHAR(MONTH+1)) GO TO 30
				IF (MSTR(ICH:ICH).NE.MNAME(JCH:JCH) .AND.
				* CHAR(ICHAR(MSTR(ICH:ICH))-32).NE.MNAME(JCH:JCH)) GO TO 20
				GO TO 10
				30 CONTINUE
				MONTH = 0
				IER = 1
				40 RETURN
				C
				END