pkg/ecco/cost_readsssfields.F

C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_readsssfields.F,v 1.3 2005/03/28 23:49:49 heimbach Exp $

#include "COST_CPPOPTIONS.h"


      subroutine cost_ReadSSSFields(
     I                               irec,
     I                               mythid
     &                             )

c     ==================================================================
c     SUBROUTINE cost_ReadSSSFields
c     ==================================================================
c
c     o Read a given record of the SST data.
c
c     started: Christian Eckert eckert@mit.edu 25-May-1999
c
c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000
c
c              - Restructured the code in order to create a package
c                for the MITgcmUV.
c
c     ==================================================================
c     SUBROUTINE cost_ReadSSSFields
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "GRID.h"

#include "cal.h"
#include "ecco_cost.h"

c     == routine arguments ==

      integer irec
      integer mythid 

c     == local variables ==

      integer bi,bj
      integer i,j,k
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
      integer nobs
      integer sssrec
      integer beginsss
      integer beginrun

      _RL spval
      _RL vartile

cnew(
      integer  il
      integer mody, modm
      integer iyear, imonth
      character*(80) fnametmp
      logical exst
cnew)

c     == external functions ==

      integer  ilnblnk
      external ilnblnk

c     == end of interface ==

      parameter (spval = 25.0 ) 
ce    --> there is certainly a better place for this.

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid) 
      ithi = mybxhi(mythid)
      jmin = 1
      jmax = sny
      imin = 1
      imax = snx

c      beginsss = sssstartdate(1)/10000
c      beginrun = modelstartdate(1)/10000
c      if ( beginsss .eq. beginrun ) then
c        sssrec = mod(modelstartdate(1)/100,100) -
c     &           mod(sssstartdate(1)/100,100) + irec
c      else
c        sssrec = ( beginrun - beginsss - 1)*nmonthyear +
c     &           (nmonthyear - mod(sssstartdate(1)/100,100) +
c     &            1) + mod(modelstartdate(1)/100,100) - 1 + irec
c      endif

cnew(
      mody = modelstartdate(1)/10000
      modm = modelstartdate(1)/100 - mody*100
      iyear = mody + INT((modm-1+irec-1)/12)
      imonth = 1 + MOD(modm-1+irec-1,12)

      il=ilnblnk(sssdatfile)
      write(fnametmp(1:80),'(2a,i4)') 
     &     sssdatfile(1:il), '_', iyear
      inquire( file=fnametmp, exist=exst )
      if (.NOT. exst) then
         write(fnametmp(1:80),'(a)') sssdatfile(1:il)
         imonth = irec
      endif

      call mdsreadfield( fnametmp, cost_iprec, cost_yftype, 1, sssdat,
     &                   imonth, mythid )
cnew)

      return
      end

1	heimbach	1.4	C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_readsssfields.F,v 1.3 2005/03/28 23:49:49 heimbach Exp $
2	heimbach	1.1
3			#include "COST_CPPOPTIONS.h"
4
5
6			subroutine cost_ReadSSSFields(
7			I irec,
8			I mythid
9			& )
10
11			c ==================================================================
12			c SUBROUTINE cost_ReadSSSFields
13			c ==================================================================
14			c
15			c o Read a given record of the SST data.
16			c
17			c started: Christian Eckert eckert@mit.edu 25-May-1999
18			c
19			c changed: Christian Eckert eckert@mit.edu 25-Feb-2000
20			c
21			c - Restructured the code in order to create a package
22			c for the MITgcmUV.
23			c
24			c ==================================================================
25			c SUBROUTINE cost_ReadSSSFields
26			c ==================================================================
27
28			implicit none
29
30			c == global variables ==
31
32			#include "EEPARAMS.h"
33			#include "SIZE.h"
34			#include "PARAMS.h"
35			#include "GRID.h"
36
37			#include "cal.h"
38			#include "ecco_cost.h"
39
40			c == routine arguments ==
41
42			integer irec
43			integer mythid
44
45			c == local variables ==
46
47			integer bi,bj
48			integer i,j,k
49			integer itlo,ithi
50			integer jtlo,jthi
51			integer jmin,jmax
52			integer imin,imax
53			integer nobs
54			integer sssrec
55			integer beginsss
56			integer beginrun
57
58			_RL spval
59			_RL vartile
60
61	heimbach	1.2	cnew(
62			integer il
63			integer mody, modm
64			integer iyear, imonth
65			character*(80) fnametmp
66			logical exst
67			cnew)
68
69			c == external functions ==
70
71			integer ilnblnk
72			external ilnblnk
73
74	heimbach	1.1	c == end of interface ==
75
76	heimbach	1.2	parameter (spval = 25.0 )
77	heimbach	1.1	ce --> there is certainly a better place for this.
78
79			jtlo = mybylo(mythid)
80			jthi = mybyhi(mythid)
81			itlo = mybxlo(mythid)
82			ithi = mybxhi(mythid)
83			jmin = 1
84			jmax = sny
85			imin = 1
86			imax = snx
87
88	heimbach	1.2	c beginsss = sssstartdate(1)/10000
89			c beginrun = modelstartdate(1)/10000
90			c if ( beginsss .eq. beginrun ) then
91			c sssrec = mod(modelstartdate(1)/100,100) -
92			c & mod(sssstartdate(1)/100,100) + irec
93			c else
94			c sssrec = ( beginrun - beginsss - 1)*nmonthyear +
95			c & (nmonthyear - mod(sssstartdate(1)/100,100) +
96			c & 1) + mod(modelstartdate(1)/100,100) - 1 + irec
97			c endif
98
99			cnew(
100			mody = modelstartdate(1)/10000
101			modm = modelstartdate(1)/100 - mody*100
102			iyear = mody + INT((modm-1+irec-1)/12)
103			imonth = 1 + MOD(modm-1+irec-1,12)
104
105			il=ilnblnk(sssdatfile)
106			write(fnametmp(1:80),'(2a,i4)')
107			& sssdatfile(1:il), '_', iyear
108			inquire( file=fnametmp, exist=exst )
109			if (.NOT. exst) then
110			write(fnametmp(1:80),'(a)') sssdatfile(1:il)
111			imonth = irec
112	heimbach	1.1	endif
113
114	heimbach	1.2	call mdsreadfield( fnametmp, cost_iprec, cost_yftype, 1, sssdat,
115			& imonth, mythid )
116			cnew)
117	heimbach	1.1
118			return
119			end
120