pkg/cal/cal_dayspermonth.F

6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002
                0003       subroutine cal_DaysPerMonth(
                0004      I                             myiter,
                0005      I                             mytime,
                0006      O                             ndays,
                0007      I                             mythid
                0008      &                           )
                0009
                0010 c     ==================================================================
                0011 c     SUBROUTINE cal_DaysPerMonth
                0012 c     ==================================================================
                0013 c
                0014 c     o Given the iteration number and/or the current time of integration
                0015 c       return the number of days left in the current calendar month
                0016 c       including the day belonging to iter/currenttime.
                0017 c
                0018 c     started: Christian Eckert eckert@mit.edu  30-Jun-1999
                0019 c
                0020 c     changed: Christian Eckert eckert@mit.edu  29-Dec-1999
                0021 c
                0022 c              - restructured the original version in order to have a
                0023 c                better interface to the MITgcmUV.
                0024 c
                0025 c              Christian Eckert eckert@mit.edu  03-Feb-2000
                0026 c
                0027 c              - Introduced new routine and function names, cal_<NAME>,
                0028 c                for verion 0.1.3.
                0029 c
                0030 c     ==================================================================
                0031 c     SUBROUTINE cal_DaysPerMonth
                0032 c     ==================================================================
                0033
                0034       implicit none
                0035
                0036 c     == global variables ==
                0037
                0038 #include "cal.h"
                0039
                0040 c     == routine arguments ==
                0041
                0042       integer myiter
                0043       _RL     mytime
                0044       integer ndays
                0045       integer mythid
                0046
                0047 c     == local variables ==
                0048
                0049       integer mydate(4)
                0050       integer myday
                0051       integer mymonth
                0052       integer myyear
                0053       integer finalyear
                0054       integer finalmonth
                0055       integer present
                0056       integer final
                0057       integer ierr
                0058
                0059 c     == end of interface ==
                0060
                0061       call cal_GetDate( myiter, mytime, mydate, mythid )
                0062
                0063       myday      = mod(mydate(1),100)
                0064       mymonth    = mod(mydate(1)/100,100)
                0065       myyear     = mydate(1)/10000
                0066       present    = mydate(1)/100
                0067       finalyear  = modelenddate(1)/10000
                0068       finalmonth = mod(modelenddate(1)/100,100)
                0069       final      = modelenddate(1)/100
                0070
                0071       if (myyear .lt. finalyear) then
                0072         ndays = ndaymonth(mymonth,mydate(3)) - myday + 1
                0073       else if (myyear .eq. finalyear) then
                0074         if (mymonth .eq. finalmonth) then
                0075           ndays = mod(modelenddate(1),100) - myday + 1
                0076         else
                0077           ndays = ndaymonth(mymonth,mydate(3)) - myday + 1
                0078         endif
                0079       else
                0080
                0081         ierr = 1201
                0082         call cal_PrintError( ierr, mythid )
                0083         stop ' stopped in cal_DaysPerMonth.'
                0084
                0085       endif
                0086
                0087       return
                0088       end