pkg/ecco/cost_sla_read.F

8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
087d6770fc Gael*0002
9f5240b52a Jean*0003       subroutine cost_sla_read(
025a9bb173 antn*0004      I                sla_file, sla_startdate, sla_period, use_mon,
087d6770fc Gael*0005      I                sla_intercept, sla_slope,
                0006      O                sla_obs, sla_mask,
f8e779c983 antn*0007      I                irec, myThid )
087d6770fc Gael*0008
                0009 c     ==================================================================
                0010 c     SUBROUTINE cost_sla_read
                0011 c     ==================================================================
                0012 c
                0013 c     o Read a given record of the SLA data.
                0014 c
                0015 c     started: Gael Forget 20-Oct-2009
                0016 c
025a9bb173 antn*0017 c     Apr-2023: argument use_mon, switches read daily to monthly if true
                0018 c
087d6770fc Gael*0019 c     ==================================================================
                0020 c     SUBROUTINE cost_sla_read
                0021 c     ==================================================================
                0022
                0023       implicit none
                0024
                0025 c     == global variables ==
                0026
                0027 #include "EEPARAMS.h"
                0028 #include "SIZE.h"
                0029 #include "PARAMS.h"
                0030 #include "GRID.h"
                0031
                0032 #include "cal.h"
13d362b8c1 Ou W*0033 #include "ECCO_SIZE.h"
                0034 #include "ECCO.h"
087d6770fc Gael*0035
                0036 c     == routine arguments ==
025a9bb173 antn*0037 C     use_mon :: switch from using daily to monthly data if true
9f5240b52a Jean*0038       character*(MAX_LEN_FNAM) sla_file
                0039       integer sla_startdate(4)
                0040       _RL sla_period
025a9bb173 antn*0041       logical use_mon
9f5240b52a Jean*0042       _RL sla_intercept
                0043       _RL sla_slope
                0044       _RL sla_obs (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0045       _RL sla_mask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
087d6770fc Gael*0046       integer irec
f8e779c983 antn*0047       integer myThid
087d6770fc Gael*0048
9f5240b52a Jean*0049 c     == external functions ==
                0050       integer  ilnblnk
                0051       external ilnblnk
087d6770fc Gael*0052
9f5240b52a Jean*0053 c     == local variables ==
087d6770fc Gael*0054       integer bi,bj
                0055       integer i,j,k
                0056       integer itlo,ithi
                0057       integer jtlo,jthi
                0058       integer jmin,jmax
                0059       integer imin,imax
                0060       integer sshrec
                0061       integer difftime(4)
e36a586433 Jean*0062       integer tempDate_1
087d6770fc Gael*0063       integer middate(4)
                0064       _RL diffsecs
                0065       _RL spval
                0066       _RL factor
                0067 cnew(
                0068       integer  il
025a9bb173 antn*0069       _RL obstime
                0070       integer obsiter
                0071       integer obsdate(4)
                0072       integer yobs, ymod
087d6770fc Gael*0073       integer md, dd, sd, ld, wd
de57a2ec4b Mart*0074       character*(MAX_LEN_FNAM) fnametmp
087d6770fc Gael*0075       logical exst
                0076 cnew)
025a9bb173 antn*0077       integer mody, modm
                0078       _RL daysperavgperiod
087d6770fc Gael*0079
                0080 c     == end of interface ==
                0081
f8e779c983 antn*0082       jtlo = myByLo(myThid)
                0083       jthi = myByHi(myThid)
                0084       itlo = myBxLo(myThid)
                0085       ithi = myBxHi(myThid)
087d6770fc Gael*0086       jmin = 1
f8e779c983 antn*0087       jmax = sNy
087d6770fc Gael*0088       imin = 1
f8e779c983 antn*0089       imax = sNx
087d6770fc Gael*0090
                0091       factor = 0.01
                0092       spval = -9990.
                0093
025a9bb173 antn*0094       IF (use_mon) THEN
                0095         daysperavgperiod = 30.5
                0096         mody = modelstartdate(1)/10000
                0097         modm = modelstartdate(1)/100 - mody*100
                0098         yobs = mody + INT((modm-1+irec-1)/12)
                0099         sshrec = 1 + MOD(modm-1+irec-1,12)
                0100
                0101       ELSE
                0102
                0103         daysperavgperiod = 1.0
e5310f7c13 Gael*0104 c select data record to read
025a9bb173 antn*0105         obstime = FLOAT(secondsperday*(irec-1)) + modelstart
                0106         obsiter = hoursperday*(irec-1)+modeliter0
                0107         call cal_getdate( obsiter, obstime, obsdate, myThid )
                0108         call cal_convdate( obsdate,yobs,md,dd,sd,ld,wd,myThid )
                0109         ymod = sla_startdate(1)/10000
                0110
                0111         IF ( ymod .GE. yobs ) THEN
                0112            call cal_FullDate( sla_startdate(1), 0, middate, myThid)
                0113         ELSE
                0114            tempDate_1 = yobs*10000+100+1
                0115            call cal_FullDate( tempDate_1, 0, middate, myThid)
                0116         ENDIF
                0117
                0118         call cal_TimePassed( middate, obsdate, difftime, myThid )
                0119         call cal_ToSeconds( difftime, diffsecs, myThid )
                0120 c        sshrec = floor(diffsecs/sla_period) + 1
                0121         sshrec = int(diffsecs/sla_period) + 1
                0122       ENDIF !use_mon
087d6770fc Gael*0123
                0124       il=ilnblnk(sla_file)
025a9bb173 antn*0125       WRITE(fnametmp,'(2a,i4)')
                0126      &     sla_file(1:il), '_', yobs
087d6770fc Gael*0127       inquire( file=fnametmp, exist=exst )
                0128
e5310f7c13 Gael*0129 c read data:
025a9bb173 antn*0130       IF ( (sshrec .GT. 0).AND.(exst) ) THEN
f8e779c983 antn*0131        CALL READ_REC_3D_RL( fnametmp, cost_iprec, 1,
                0132      &                      sla_obs, sshrec, 1, myThid )
025a9bb173 antn*0133       ELSE
                0134        DO bj = jtlo,jthi
                0135         DO bi = itlo,ithi
                0136          DO j = jmin,jmax
                0137           DO i = imin,imax
e5310f7c13 Gael*0138             sla_obs(i,j,bi,bj) = spval
025a9bb173 antn*0139           ENDDO
                0140          ENDDO
                0141         ENDDO
                0142        ENDDO
                0143       ENDIF
087d6770fc Gael*0144
e5310f7c13 Gael*0145 c mask data:
025a9bb173 antn*0146       DO bj = jtlo,jthi
                0147         DO bi = itlo,ithi
087d6770fc Gael*0148           k = 1
025a9bb173 antn*0149           DO j = jmin,jmax
                0150             DO i = imin,imax
                0151               IF (_hFacC(i,j,k,bi,bj) .EQ. 0.) THEN
087d6770fc Gael*0152                  sla_mask(i,j,bi,bj) = 0. _d 0
025a9bb173 antn*0153               ELSE
087d6770fc Gael*0154                  sla_mask(i,j,bi,bj) = 1. _d 0
025a9bb173 antn*0155               ENDIF
                0156               IF (sla_obs(i,j,bi,bj) .LE. spval) THEN
087d6770fc Gael*0157                 sla_mask(i,j,bi,bj) = 0. _d 0
025a9bb173 antn*0158               ENDIF
                0159               IF (abs(sla_obs(i,j,bi,bj)) .LT. 1.d-8 ) THEN
087d6770fc Gael*0160                  sla_mask(i,j,bi,bj) = 0. _d 0
025a9bb173 antn*0161               ENDIF
087d6770fc Gael*0162
70fde697ea Gael*0163 #ifndef ALLOW_SHALLOW_ALTIMETRY
025a9bb173 antn*0164               IF ( R_low(i,j,bi,bj) .GT. -200. ) THEN
087d6770fc Gael*0165                 sla_mask(i,j,bi,bj) = 0. _d 0
025a9bb173 antn*0166               ENDIF
70fde697ea Gael*0167 #endif
4e6b53b435 Gael*0168 #ifndef ALLOW_HIGHLAT_ALTIMETRY
025a9bb173 antn*0169               IF ( abs(YC(i,j,bi,bj)) .GT. 66. ) THEN
4e6b53b435 Gael*0170                 sla_mask(i,j,bi,bj) = 0. _d 0
025a9bb173 antn*0171               ENDIF
4e6b53b435 Gael*0172 #endif
087d6770fc Gael*0173
                0174               sla_mask(i,j,bi,bj) = sla_mask(i,j,bi,bj)*frame(i,j)
                0175               sla_obs(i,j,bi,bj)  = sla_mask(i,j,bi,bj)*factor*
                0176      &             ( sla_obs(i,j,bi,bj) -
025a9bb173 antn*0177      &               ( sla_intercept + sla_slope*irec*hoursperday
                0178      &                *daysperavgperiod  ) )
                0179             ENDDO
                0180           ENDDO
                0181         ENDDO
                0182       ENDDO
087d6770fc Gael*0183
f8e779c983 antn*0184       RETURN
                0185       END