


PGF90 (Version     12.8)          08/30/2020  00:27:55      page 1

Switches: -noasm -nodclchk -nodebug -nodlines -noline -list
          -idir ../include
          -inform warn -opt 1 -nosave -object -noonetrip
          -depchk on -nostandard     
          -nosymbol -noupcase    

Filename: GETDATE.f90

(    1) !C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
(    2)       SUBROUTINE GETDATE(iyr,imo,idy,iutc,cyr,cmon,cday,cutc)
(    3) !C-----------------------------------------------------------------
(    4)       IMPLICIT NONE
(    5)       INTEGER,INTENT(IN)                 ::iyr,imo,idy,iutc
(    6)       INTEGER, INTENT(OUT)               ::cyr,cmon,cday,cutc
(    7)       INTEGER                            ::yr,mon,day,utc
(    8)       INTEGER, DIMENSION(12)             ::monl
(    9)       INTEGER dystep,daystep
(   10) !C*
(   11)       yr=iyr
(   12)       mon=imo
(   13)       day=idy
(   14)       utc=iutc
(   15)     
(   16)     
(   17)     
(   18)     
(   19)     !  DATA monl /30,30,30,30,30,30,30,30,30,30,30,30/
(   20)     data monl /31,28,31,30,31,30,31,31,30,31,30,31/	
(   21)       dystep=0
(   22) 
(   23) !     ! daystep=0
(   24) 
(   25) !C*
(   26)       IF (mod(yr,4) .eq. 0) then  !!!
(   27)       monl(2)=29                   !!!   
(   28)       endif                      !!!!!!!!
(   29) !C      utc=m
(   30)       IF (utc.GE.24) THEN
(   31)         dystep=dystep+(utc/24)
(   32) !     ! daystep=daystep+(utc/24)
(   33)       
(   34)         utc=(MOD(utc,24))
(   35)       ENDIF
(   36)       day=day+dystep
(   37)      
(   38)    !  day=day+daystep
(   39)       DO
(   40)         IF (day.GT.monl(mon)) THEN
(   41)           day=day-monl(mon)
(   42)           mon=mon+1
(   43)           IF (mon.eq.13) THEN
(   44)             mon=1
(   45)             yr=yr+1
(   46) !C            IF (MOD(yr,4).EQ.0) monl(2)=29
(   47)           ENDIF
(   48)         ELSE
(   49)           exit
(   50)         ENDIF
(   51)       ENDDO






PGF90 (Version     12.8)          08/30/2020  00:27:55      page 2

(   52)       cyr=yr
(   53)       cmon=mon
(   54)       cday=day
(   55)       cutc=utc
(   56)       
(   57)       print*,'DAY_GETDATE=',day
(   58)       
(   59) !C      IF (mon .LT. 10) cmon(1:1)='0'
(   60) !C      IF (day .LT. 10) cday(1:1)='0'
(   61) 
(   62)       RETURN
(   63)       END SUBROUTINE GETDATE
