File indexing completed on 2023-07-14 05:10:22 UTC
view on githubraw file Latest commit de57a2ec on 2023-07-13 16:55:13 UTC
8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
49b79243e8 Gael*0002
0003 subroutine cost_bp_read(
f8e779c983 antn*0004 I localobsfile, localstartdate,
49484c0542 Gael*0005 O localobs, localmask,
9f5240b52a Jean*0006 I irec, myThid )
49b79243e8 Gael*0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020 implicit none
0021
0022
0023
0024 #include "EEPARAMS.h"
0025 #include "SIZE.h"
0026 #include "PARAMS.h"
0027 #include "GRID.h"
0028
49484c0542 Gael*0029 #ifdef ALLOW_CAL
0030 # include "cal.h"
0031 #endif
0032 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0033 # include "ECCO_SIZE.h"
0034 # include "ECCO.h"
49484c0542 Gael*0035 #endif
49b79243e8 Gael*0036
0037
49484c0542 Gael*0038 character*(MAX_LEN_FNAM) localobsfile
0039 integer localstartdate(4)
f8e779c983 antn*0040 _RL localobs (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0041 _RL localmask (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
49b79243e8 Gael*0042 integer irec
f8e779c983 antn*0043 integer myThid
49b79243e8 Gael*0044
49484c0542 Gael*0045 #ifdef ALLOW_ECCO
9f5240b52a Jean*0046
0047 integer ilnblnk
0048 external ilnblnk
49b79243e8 Gael*0049
0050
0051 integer bi,bj
0052 integer i,j,k
0053 integer jmin,jmax
0054 integer imin,imax
0055 integer nobs
e5310f7c13 Gael*0056 INTEGER beginlocal, beginmodel, obsrec
49b79243e8 Gael*0057 _RL spval
0058
0059 integer il
0060 integer mody, modm
0061 integer iyear, imonth
de57a2ec4b Mart*0062 character*(MAX_LEN_FNAM) fnametmp
49b79243e8 Gael*0063 logical exst
0064
0065
0066
0067
0068 parameter (spval = -998. )
0069
0070
0071 jmin = 1
f8e779c983 antn*0072 jmax = sNy
49b79243e8 Gael*0073 imin = 1
f8e779c983 antn*0074 imax = sNx
e5310f7c13 Gael*0075
49484c0542 Gael*0076 beginlocal = localstartdate(1)/10000
e5310f7c13 Gael*0077 beginmodel = modelstartdate(1)/10000
0078 obsrec = ( beginmodel - beginlocal )*nmonthyear
0079 & + ( mod(modelstartdate(1)/100,100)
49484c0542 Gael*0080 & -mod(localstartdate(1)/100,100) )
e5310f7c13 Gael*0081 & + irec
0082
49b79243e8 Gael*0083 mody = modelstartdate(1)/10000
0084 modm = modelstartdate(1)/100 - mody*100
0085 iyear = mody + INT((modm-1+irec-1)/12)
0086 imonth = 1 + MOD(modm-1+irec-1,12)
0087
49484c0542 Gael*0088 il=ilnblnk(localobsfile)
de57a2ec4b Mart*0089 write(fnametmp,'(2a,i4)')
49484c0542 Gael*0090 & localobsfile(1:il), '_', iyear
49b79243e8 Gael*0091 inquire( file=fnametmp, exist=exst )
0092 if (.NOT. exst) then
de57a2ec4b Mart*0093 write(fnametmp,'(a)') localobsfile(1:il)
e5310f7c13 Gael*0094 imonth = obsrec
49b79243e8 Gael*0095 endif
0096
e5310f7c13 Gael*0097 if ( (obsrec.GT.0).AND.(imonth.GT.0) ) then
f8e779c983 antn*0098 CALL READ_REC_3D_RL( fnametmp, cost_iprec, 1,
0099 & localobs, imonth, 0, myThid )
e5310f7c13 Gael*0100 else
9f5240b52a Jean*0101 do bj = myByLo(myThid), myByHi(myThid)
0102 do bi = myBxLo(myThid), myBxHi(myThid)
e5310f7c13 Gael*0103 do j = jmin,jmax
0104 do i = imin,imax
49484c0542 Gael*0105 localobs(i,j,bi,bj) = spval
e5310f7c13 Gael*0106 enddo
0107 enddo
0108 enddo
0109 enddo
0110 endif
49b79243e8 Gael*0111
0112 nobs = 0
0113
9f5240b52a Jean*0114 do bj = myByLo(myThid), myByHi(myThid)
0115 do bi = myBxLo(myThid), myBxHi(myThid)
49b79243e8 Gael*0116 k = 1
0117 do j = jmin,jmax
0118 do i = imin,imax
a01563ca86 Gael*0119
49484c0542 Gael*0120
a01563ca86 Gael*0121
49484c0542 Gael*0122
a01563ca86 Gael*0123
49484c0542 Gael*0124 if (localobs(i,j,bi,bj) .le. spval) then
0125 localmask(i,j,bi,bj) = 0. _d 0
49b79243e8 Gael*0126 else
49484c0542 Gael*0127 localmask(i,j,bi,bj) = 1. _d 0
49b79243e8 Gael*0128 endif
49484c0542 Gael*0129 localobs(i,j,bi,bj) = localobs(i,j,bi,bj)*
0130 & localmask(i,j,bi,bj)
0131 nobs = nobs + int(localmask(i,j,bi,bj))
49b79243e8 Gael*0132 enddo
0133 enddo
0134 enddo
0135 enddo
0136
0137 #endif
0138
f8e779c983 antn*0139 RETURN
0140 END