pkg/ecco/cost_sla_read_yd.F

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