File indexing completed on 2026-08-23 05:08:50 UTC
view on githubraw file Latest commit 1827555e on 2026-08-22 17:05:12 UTC
24462d2fa8 Patr*0001 #include "PROFILES_OPTIONS.h"
57c22ecc45 Jean*0002 #include "AD_CONFIG.h"
6a770e0a24 Patr*0003
c9bf163375 Ivan*0004
13ce79fe94 Ivan*0005
0006
6a770e0a24 Patr*0007
13ce79fe94 Ivan*0008
0009 SUBROUTINE PROFILES_INIT_FIXED( myThid )
0010
0011
0012
6a770e0a24 Patr*0013
13ce79fe94 Ivan*0014
0015 IMPLICIT NONE
0016
6a770e0a24 Patr*0017 #include "SIZE.h"
0018 #include "EEPARAMS.h"
0019 #include "PARAMS.h"
0020 #include "GRID.h"
0021 #include "DYNVARS.h"
d28c90138c Patr*0022 #ifdef ALLOW_CAL
6a770e0a24 Patr*0023 #include "cal.h"
d28c90138c Patr*0024 #endif
24462d2fa8 Patr*0025 #ifdef ALLOW_PROFILES
6328b73337 Gael*0026 # include "PROFILES_SIZE.h"
6e4c90fea3 Patr*0027 # include "profiles.h"
0028 # include "netcdf.inc"
0029 #endif
39ce977435 Gael*0030
13ce79fe94 Ivan*0031
0032
c9bf163375 Ivan*0033 INTEGER myThid
13ce79fe94 Ivan*0034
39ce977435 Gael*0035
13ce79fe94 Ivan*0036 #ifdef ALLOW_PROFILES
0037
0038 INTEGER ILNBLNK
c9bf163375 Ivan*0039 EXTERNAL ILNBLNK
6a770e0a24 Patr*0040
13ce79fe94 Ivan*0041
0042
0043
0044
0045
0046
0047
0048
0049
c9bf163375 Ivan*0050 CHARACTER*(MAX_LEN_MBUF) msgBuf
13ce79fe94 Ivan*0051 INTEGER iUnit
0052 INTEGER kLev, prof_num
1827555eb3 aver*0053 INTEGER chunk, chunkProf, ic
0054 INTEGER i, j, bi, bj, iG, jG, num_file, num_var, ProfNo_tile
13ce79fe94 Ivan*0055 INTEGER fid, dimId, varId1, varId1a, varId1b
1827555eb3 aver*0056 INTEGER varId2, varId3
0057 _RL tmpyymmdd(1000), tmphhmmss(1000), diffsecs
5042c05de8 Gael*0058 _RL yymmddMin,yymmddMax
0059 _RL hhmmssMin,hhmmssMax
0060
1827555eb3 aver*0061 INTEGER tmpdate(4), tmpdiff(4), profIsInRunTime
13ce79fe94 Ivan*0062 _RL tmp_lon, tmp_lon2(1000), tmp_lat2(1000)
0063 _RL lon_cur, lat_cur
39ce977435 Gael*0064 _RL lon_1, lon_2, lat_1, lat_2
2767dff983 Jean*0065 _RL lon_tmp1, lon_tmp2
39ce977435 Gael*0066 _RL lat_fac, lon_fac
c9bf163375 Ivan*0067 INTEGER prof_i, prof_j
13ce79fe94 Ivan*0068 INTEGER vec_start(2), vec_count(2), profno_div1000
c9bf163375 Ivan*0069 CHARACTER*(MAX_LEN_FNAM) profilesfile, fnamedatanc
0070 CHARACTER*(MAX_LEN_FNAM) fnameequinc
13ce79fe94 Ivan*0071 # ifdef ALLOW_ADJOINT_RUN
0072 CHARACTER*(MAX_LEN_FNAM) adfnameequinc
0073 # endif
0074 # ifdef ALLOW_TANGENTLINEAR_RUN
0075 CHARACTER*(MAX_LEN_FNAM) tlfnameequinc
0076 # endif
0077 INTEGER IL, JL, KL, err, nerr
1827555eb3 aver*0078 LOGICAL exst, stopProfiles
0079 INTEGER stopProfiles_cnt
0080 INTEGER stopGenericGrid, stopGenericGrid_max
13ce79fe94 Ivan*0081
0082 INTEGER varId_intp1, varId_intp2, varId_intp11, varId_intp22
0083 INTEGER varId_intp3, varId_intp4, varId_intp5, iq, iINTERP
ba63501b4c Gael*0084 _RL tmp_i(1000,NUM_INTERP_POINTS)
0085 _RL tmp_j(1000,NUM_INTERP_POINTS)
1827555eb3 aver*0086 _RL tmp_weights(1000,NUM_INTERP_POINTS), tmp_sum_weights
0087 _RL tmp_xC11(1000), tmp_yC11(1000)
0088 _RL tmp_xCNINJ(1000), tmp_yCNINJ(1000)
c9bf163375 Ivan*0089 INTEGER vec_start2(2), vec_count2(2)
0090 INTEGER hh, ProfNo_hh
13ce79fe94 Ivan*0091 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0092 INTEGER m, kC, kCMax
0093 INTEGER varId4
6b2230d510 Ou W*0094 _RL tmp_avgbin(1000)
13ce79fe94 Ivan*0095 # endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0096
1827555eb3 aver*0097 stopProfiles_cnt = 0
0098 stopGenericGrid_max = 0
13ce79fe94 Ivan*0099 iUnit = standardMessageUnit
0100 WRITE(msgBuf,'(A)') ' '
0101 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0102 WRITE(msgBuf,'(A)')
0103 & '// ======================================================='
0104 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0105 WRITE(msgBuf,'(A)')
0106 & '// insitu profiles model sampling >>> START <<<'
0107 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0108 WRITE(msgBuf,'(A)')
0109 & '// ======================================================='
0110 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0111 WRITE(msgBuf,'(A)') ' '
0112 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0113
0114 IF ( (.NOT.profilesDoGenGrid) .AND.
f0e4bffe35 Gael*0115 & (.NOT.usingSphericalPolarGrid .OR. rotateGrid) ) THEN
13ce79fe94 Ivan*0116 WRITE(msgBuf,'(2A)') 'PROFILES_INIT_FIXED: ',
0117 & 'profilesDoGenGrid=.true. is required'
0118 CALL PRINT_ERROR( msgBuf , myThid )
0119 WRITE(msgBuf,'(2A)') 'PROFILES_INIT_FIXED: ',
0120 & 'unless usingSphericalGrid=.TRUE. and rotateGrid=.FALSE.'
0121 CALL PRINT_ERROR( msgBuf , myThid )
0122 CALL ALL_PROC_DIE( myThid )
0123 STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
f0e4bffe35 Gael*0124 ENDIF
0125
13ce79fe94 Ivan*0126 WRITE(msgBuf,'(A)') ' '
0127 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0128 WRITE(msgBuf,'(A)') 'general packages parameters :'
0129
0130 JL = ILNBLNK( profilesDir )
c9bf163375 Ivan*0131 IF (JL.NE.0) THEN
13ce79fe94 Ivan*0132 WRITE(msgBuf,'(2A)') ' profilesDir ', profilesDir(1:JL)
c9bf163375 Ivan*0133 ELSE
13ce79fe94 Ivan*0134 WRITE(msgBuf,'(2A)') ' profilesDir ','./'
c9bf163375 Ivan*0135 ENDIF
13ce79fe94 Ivan*0136 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0137 WRITE(msgBuf,'(A,L5)') ' profilesDoGenGrid ', profilesDoGenGrid
0138 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0139 WRITE(msgBuf,'(A,L5)') ' profilesDoNcOutput ', profilesDoNcOutput
0140 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
1827555eb3 aver*0141 WRITE(msgBuf,'(A,I5)') ' prof_dBugLevel = ', prof_dBugLevel
0142 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
13ce79fe94 Ivan*0143 WRITE(msgBuf,'(A)') ' '
0144 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
b00d6c1700 Gael*0145
13ce79fe94 Ivan*0146 _BEGIN_MASTER( myThid )
1827555eb3 aver*0147
0148
71a5587721 Gael*0149
13ce79fe94 Ivan*0150 DO bj = 1, nSy
0151 DO bi = 1, nSx
6e4c90fea3 Patr*0152
1827555eb3 aver*0153 profiles_curfile_buff(bi,bj) = 0
13ce79fe94 Ivan*0154 DO kLev = 1, NLEVELMAX
0155 DO ic = 1, 1000
0156 DO num_var = 1, NVARMAX
0157 profiles_data_buff (kLev,ic,num_var,bi,bj) = 0. _d 0
0158 profiles_weight_buff(kLev,ic,num_var,bi,bj) = 0. _d 0
c9bf163375 Ivan*0159 ENDDO
0160 ENDDO
0161 ENDDO
1827555eb3 aver*0162 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0163 DO kCMax = 1, NLEVELCOMBMAX
0164 prof_depth_comb(kCMax,bi,bj) = -999. _d 0
0165 ENDDO
0166 # endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
d5aa75d39a Jean*0167
13ce79fe94 Ivan*0168 DO num_file = 1, NFILESPROFMAX
1827555eb3 aver*0169 ProfNo(num_file,bi,bj) = 0
0170 prof_num_var_tot(num_file,bi,bj) = 0
0171 DO num_var = 1, NVARMAX
0172 prof_num_var_cur(num_file,num_var,bi,bj) = 0
0173 vec_quantities(num_file,num_var,bi,bj) = .FALSE.
0174 ENDDO
0175 DO prof_num = 1, NOBSGLOB
0176 prof_time (num_file,prof_num,bi,bj) = -999. _d 0
0177 prof_lon (num_file,prof_num,bi,bj) = -999. _d 0
0178 prof_lat (num_file,prof_num,bi,bj) = -999. _d 0
0179 prof_ind_glob (num_file,prof_num,bi,bj) = 0
0180 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0181 prof_ind_avgbin(num_file,prof_num,bi,bj) = -999
0182 # endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0183 prof_interp_xC11 (num_file,prof_num,bi,bj) = -999. _d 0
0184 prof_interp_yC11 (num_file,prof_num,bi,bj) = -999. _d 0
0185 prof_interp_xCNINJ(num_file,prof_num,bi,bj) = -999. _d 0
0186 prof_interp_yCNINJ(num_file,prof_num,bi,bj) = -999. _d 0
0187 DO iq = 1, NUM_INTERP_POINTS
0188 prof_interp_i(num_file,prof_num,iq,bi,bj) = 1
0189 prof_interp_j(num_file,prof_num,iq,bi,bj) = 1
0190 prof_interp_weights(num_file,prof_num,iq,bi,bj) = 0. _d 0
0191 ENDDO
0192 ENDDO
0193 ENDDO
0194
0195
0196 ENDDO
0197 ENDDO
0198
0199
0200
0201 yymmddMin = modelstartdate(1)
0202 yymmddMax = modelenddate(1)
0203 hhmmssMin = modelstartdate(2)
0204 hhmmssMax = modelenddate(2)
0205
0206 DO num_file = 1, NFILESPROFMAX
0207 profilesfile = profilesfiles(num_file)
0208 IL = ILNBLNK( profilesfile )
0209
0210 DO bj = 1, nSy
0211 DO bi = 1, nSx
0212 stopProfiles = .FALSE.
0213 stopGenericGrid = 0
13ce79fe94 Ivan*0214 ProfNo_hh=0
1827555eb3 aver*0215
13ce79fe94 Ivan*0216 IF (IL.NE.0) THEN
0217 WRITE(msgBuf,'(A)') ' '
0218 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0219 WRITE(msgBuf,'(A,I3,2A)') 'profiles file #', num_file,
0220 & ' is ', profilesfile(1:IL)
0221 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
6a770e0a24 Patr*0222
0223
13ce79fe94 Ivan*0224
6a770e0a24 Patr*0225
1827555eb3 aver*0226
0227
0228
0229
13ce79fe94 Ivan*0230 WRITE(fnamedatanc,'(2A)') profilesfile(1:IL),'.nc'
0231 err = NF_OPEN( fnamedatanc, NF_NOWRITE,
0232 & fiddata(num_file,bi,bj) )
0233 CALL PROFILES_NF_ERROR(
0234 & 'INIT_FIXED: NF_OPEN fiddata',err,bi,bj,myThid )
0235
0236
0237 fid = fiddata(num_file,bi,bj)
0238
0239 err = NF_INQ_DIMID( fid, 'iPROF', dimId )
0240 CALL PROFILES_NF_ERROR(
0241 & 'INIT_FIXED: NF_INQ_DIMID iPROF',err,bi,bj,myThid )
0242 err = NF_INQ_DIMLEN( fid,
0243 & dimId, ProfNo(num_file,bi,bj) )
0244 CALL PROFILES_NF_ERROR(
0245 & 'INIT_FIXED: NF_INQ_DIMLEN ProfNo',
0246 & err,bi,bj,myThid )
0247
0248 err = NF_INQ_DIMID( fid, 'iDEPTH', dimId )
0249 CALL PROFILES_NF_ERROR(
0250 & 'INIT_FIXED: NF_INQ_DIMID iDEPTH',
0251 & err,bi,bj,myThid )
0252 IF (err.NE.NF_NOERR) THEN
0253 err = NF_INQ_DIMID( fid, 'Z', dimId )
0254 CALL PROFILES_NF_ERROR(
0255 & 'INIT_FIXED: NF_INQ_DIMID Z',err,bi,bj,myThid )
0256 ENDIF
6a770e0a24 Patr*0257
13ce79fe94 Ivan*0258 err = NF_INQ_DIMLEN( fid, dimId,
0259 & ProfDepthNo(num_file,bi,bj) )
0260 CALL PROFILES_NF_ERROR(
0261 & 'INIT_FIXED: NF_INQ_DIMLEN ProfDepthNo',
0262 & err,bi,bj,myThid )
1827555eb3 aver*0263
0264 IF ( ProfDepthNo(num_file,bi,bj) .GT. NLEVELMAX ) THEN
0265 WRITE(msgBuf,'(4A,I8)')
0266 & 'PROFILES_INIT_FIXED: in: "',profilesfile(1:IL),'.nc",',
0267 & ' number of depth levels exceeds NLEVELMAX=', NLEVELMAX
0268 CALL PRINT_ERROR( msgBuf, myThid )
0269 WRITE(msgBuf,'(2A)') 'PROFILES_INIT_FIXED: ',
0270 & 'increase NLEVELMAX in PROFILES_SIZE.h and recompile'
0271 CALL PRINT_ERROR( msgBuf, myThid )
0272 stopProfiles = .TRUE.
0273 ENDIF
f0e4bffe35 Gael*0274
13ce79fe94 Ivan*0275 err = NF_INQ_DIMID( fid, 'iINTERP', dimId )
0276 IF (err.EQ.NF_NOERR) THEN
0277 err = NF_INQ_DIMLEN( fid, dimId, iINTERP )
0278 CALL PROFILES_NF_ERROR(
0279 & 'INIT_FIXED: NF_INQ_DIMLEN iINTERP',
0280 & err,bi,bj,myThid )
0281 ELSE
1827555eb3 aver*0282 IF (prof_dBugLevel .GE. debLevB) THEN
13ce79fe94 Ivan*0283 CALL PROFILES_NF_ERROR(
0284 & 'INIT_FIXED: NF_INQ_DIMID iINTERP',
0285 & err,bi,bj,myThid )
0286 WRITE(msgBuf,'(3A,I3)')
0287 & 'S/R PROFILES_INIT_FIXED: ',
0288 & 'no iINTERP dim in data file using iINTERP ',
0289 & '= NUM_INTERP_POINTS =', NUM_INTERP_POINTS
0290 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0291 ENDIF
0292 iINTERP = NUM_INTERP_POINTS
0293 ENDIF
6a770e0a24 Patr*0294
13ce79fe94 Ivan*0295 WRITE(msgBuf,'(2(A,I4))')
0296 & ' current tile is bi,bj =',
0297 & bi,',',bj
0298 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0299 WRITE(msgBuf,'(A,I9)')
0300 & ' # of depth levels in file =',
0301 & ProfDepthNo(num_file,bi,bj)
0302 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0303 WRITE(msgBuf,'(A,I9)')
0304 & ' # of profiles in file =',
0305 & ProfNo(num_file,bi,bj)
0306 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0307
0308
0309 err = NF_INQ_VARID( fid,'prof_depth', varId1a )
0310 CALL PROFILES_NF_ERROR(
0311 & 'INIT_FIXED: NF_INQ_VARID prof_depth',
0312 & err,bi,bj,myThid )
0313 IF (err.NE.NF_NOERR) THEN
0314
0315 err = NF_INQ_VARID( fid,'depth', varId1a )
0316 CALL PROFILES_NF_ERROR(
0317 & 'INIT_FIXED: NF_INQ_VARID depth',
0318 & err,bi,bj,myThid )
0319 ENDIF
ba63501b4c Gael*0320
13ce79fe94 Ivan*0321 IF (err.NE.NF_NOERR) THEN
0322
0323 IL = ILNBLNK( profilesfile )
0324 WRITE(msgBuf,'(4A)')
0325 & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
0326 & '.nc is not in the pkg/profiles format',
0327 & ' (no prof_depth etc.)'
0328 CALL PRINT_ERROR( msgBuf, myThid )
1827555eb3 aver*0329 stopProfiles = .TRUE.
13ce79fe94 Ivan*0330 ENDIF
39ce977435 Gael*0331
1827555eb3 aver*0332 IF ( .NOT.stopProfiles ) THEN
0333 DO kLev = 1, ProfDepthNo(num_file,bi,bj)
0334 err = NF_GET_VAR1_DOUBLE( fid, varId1a, kLev,
0335 & prof_depth(num_file,kLev,bi,bj) )
0336 CALL PROFILES_NF_ERROR(
0337 & 'INIT_FIXED: NF_VAR1_DOUBLE prof_depth',
0338 & err,bi,bj,myThid )
0339 ENDDO
0340 ENDIF
39ce977435 Gael*0341
13ce79fe94 Ivan*0342
0343 err = NF_INQ_VARID( fid,'prof_YYYYMMDD', varId1a )
1827555eb3 aver*0344 nerr = ABS( err - NF_NOERR )
13ce79fe94 Ivan*0345 CALL PROFILES_NF_ERROR(
0346 & 'INIT_FIXED: NF_INQ_VARID prof_YYYYMMDD',
0347 & err,bi,bj,myThid )
0348 err = NF_INQ_VARID( fid,'prof_HHMMSS', varId1b )
1827555eb3 aver*0349 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0350 CALL PROFILES_NF_ERROR(
0351 & 'INIT_FIXED: NF_INQ_VARID prof_HHMMSS',
0352 & err,bi,bj,myThid )
0353 err = NF_INQ_VARID( fid,'prof_lon', varId2 )
1827555eb3 aver*0354 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0355 CALL PROFILES_NF_ERROR(
0356 & 'INIT_FIXED: NF_INQ_VARID prof_lon',
0357 & err,bi,bj,myThid )
0358 err = NF_INQ_VARID( fid,'prof_lat', varId3 )
1827555eb3 aver*0359 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0360 CALL PROFILES_NF_ERROR(
0361 & 'INIT_FIXED: NF_INQ_VARID prof_lat',
0362 & err,bi,bj,myThid )
0363 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0364 err = NF_INQ_VARID( fid,'prof_bin_id_a', varId4 )
1827555eb3 aver*0365 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0366 CALL PROFILES_NF_ERROR(
0367 & 'INIT_FIXED: NF_INQ_VARID prof_bin_id_a',
0368 & err,bi,bj,myThid )
0369 # endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0370
1827555eb3 aver*0371 IF ( nerr.NE.0 ) THEN
13ce79fe94 Ivan*0372 IL = ILNBLNK( profilesfile )
0373 WRITE(msgBuf,'(4A)')
0374 & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
0375 & '.nc not in pkg/profiles format',
0376 & ' (no prof_YYYYMMDD etc.)'
0377 CALL PRINT_ERROR( msgBuf, myThid )
1827555eb3 aver*0378 stopProfiles = .TRUE.
13ce79fe94 Ivan*0379 ENDIF
39ce977435 Gael*0380
13ce79fe94 Ivan*0381 IF (profilesDoGenGrid) THEN
0382
0383 err = NF_INQ_VARID( fid,'prof_interp_XC11', varId_intp1 )
1827555eb3 aver*0384 nerr = ABS( err - NF_NOERR )
13ce79fe94 Ivan*0385 CALL PROFILES_NF_ERROR(
0386 & 'INIT_FIXED: NF_INQ_VARID prof_interp_XC11',
0387 & err,bi,bj,myThid )
0388 err = NF_INQ_VARID( fid,'prof_interp_YC11', varId_intp2 )
1827555eb3 aver*0389 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0390 CALL PROFILES_NF_ERROR(
0391 & 'INIT_FIXED: NF_INQ_VARID prof_interp_YC11',
0392 & err,bi,bj,myThid )
0393 err = NF_INQ_VARID( fid,'prof_interp_XCNINJ', varId_intp11 )
1827555eb3 aver*0394 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0395 CALL PROFILES_NF_ERROR(
0396 & 'INIT_FIXED: NF_INQ_VARID prof_interp_XCNINJ',
0397 & err,bi,bj,myThid )
0398 err = NF_INQ_VARID( fid,'prof_interp_YCNINJ', varId_intp22 )
1827555eb3 aver*0399 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0400 CALL PROFILES_NF_ERROR(
0401 & 'INIT_FIXED: NF_INQ_VARID prof_interp_YCNINJ',
0402 & err,bi,bj,myThid )
0403 err = NF_INQ_VARID( fid,'prof_interp_weights', varId_intp3 )
1827555eb3 aver*0404 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0405 CALL PROFILES_NF_ERROR(
0406 & 'INIT_FIXED: NF_INQ_VARID prof_interp_weights',
0407 & err,bi,bj,myThid )
0408 err = NF_INQ_VARID( fid,'prof_interp_i', varId_intp4 )
1827555eb3 aver*0409 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0410 CALL PROFILES_NF_ERROR(
0411 & 'INIT_FIXED: NF_INQ_VARID prof_interp_i',
0412 & err,bi,bj,myThid )
0413 err = NF_INQ_VARID( fid,'prof_interp_j', varId_intp5 )
1827555eb3 aver*0414 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0415 CALL PROFILES_NF_ERROR(
0416 & 'INIT_FIXED: NF_INQ_VARID prof_interp_j',
0417 & err,bi,bj,myThid )
0418
1827555eb3 aver*0419 IF ( nerr.NE.0 ) THEN
13ce79fe94 Ivan*0420 IL = ILNBLNK( profilesfile )
0421 WRITE(msgBuf,'(4A)')
0422 & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
0423 & '.nc missing interpolation information',
0424 & ' (profilesDoGenGrid)'
0425 CALL PRINT_ERROR( msgBuf, myThid )
0426 stopGenericGrid = 2
0427 ENDIF
0428 ENDIF
0429
1827555eb3 aver*0430
13ce79fe94 Ivan*0431
0432 ProfNo_tile = 0
0433 profNo_div1000 = MAX(0,INT(ProfNo(num_file,bi,bj)/1000))
0434
0435 DO chunkProf = 1, profno_div1000+1
0436
0437 chunk = 1000*(chunkProf-1)
0438
0439 IF (MIN(ProfNo(num_file,bi,bj), 1000*chunkProf).GE.
0440 & 1+chunk) THEN
0441 vec_start(1) = 1
0442 vec_start(2) = 1+chunk
0443 vec_count(1) = 1
0444 vec_count(2) = MIN(1000, ProfNo(num_file,bi,bj)-chunk)
0445
0446 IF ( (vec_count(2).LE.0) .OR.
0447 & (vec_count(2).GT.1000) .OR.
0448 & (vec_start(2).LE.0) .OR.
0449 & (vec_count(2)+vec_start(2)-1.GT.
0450 & ProfNo(num_file,bi,bj)) ) THEN
0451 IL = ILNBLNK( profilesfile )
0452 WRITE(msgBuf,'(3A)')
0453 & 'PROFILES_INIT_FIXED: file ',profilesfile(1:IL),
0454 & '.nc was not read properly (case 1).'
0455 CALL PRINT_ERROR( msgBuf, myThid )
1827555eb3 aver*0456 stopProfiles = .TRUE.
13ce79fe94 Ivan*0457 ENDIF
0458
0459 err = NF_GET_VARA_DOUBLE( fid, varId1a,
0460 & vec_start(2),vec_count(2), tmpyymmdd )
1827555eb3 aver*0461 nerr = ABS( err - NF_NOERR )
13ce79fe94 Ivan*0462 CALL PROFILES_NF_ERROR(
0463 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmpyymmdd',
0464 & err,bi,bj,myThid )
0465 err = NF_GET_VARA_DOUBLE( fid, varId1b,
0466 & vec_start(2), vec_count(2), tmphhmmss )
1827555eb3 aver*0467 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0468 CALL PROFILES_NF_ERROR(
0469 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmphhmmss',
0470 & err,bi,bj,myThid )
0471 err = NF_GET_VARA_DOUBLE( fid, varId2,
0472 & vec_start(2),vec_count(2), tmp_lon2 )
1827555eb3 aver*0473 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0474 CALL PROFILES_NF_ERROR(
0475 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_lon2',
0476 & err,bi,bj,myThid )
0477 err = NF_GET_VARA_DOUBLE( fid, varId3,
0478 & vec_start(2),vec_count(2), tmp_lat2 )
1827555eb3 aver*0479 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0480 CALL PROFILES_NF_ERROR(
0481 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_lat2',
0482 & err,bi,bj,myThid )
0483 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0484 err = NF_GET_VARA_DOUBLE( fid, varId4,
0485 & vec_start(2),vec_count(2), tmp_avgbin )
1827555eb3 aver*0486 nerr = nerr + ABS( err - NF_NOERR )
13ce79fe94 Ivan*0487 CALL PROFILES_NF_ERROR(
0488 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_avgbin',
0489 & err,bi,bj,myThid )
0490 # endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0491
1827555eb3 aver*0492 IF ( nerr.NE.0 ) THEN
13ce79fe94 Ivan*0493 WRITE(msgBuf,'(3A)')
0494 & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
0495 & '.nc get_vara_double (case 2).'
0496 CALL PRINT_ERROR( msgBuf, myThid )
1827555eb3 aver*0497 stopProfiles = .TRUE.
13ce79fe94 Ivan*0498 ENDIF
0499
0500
1827555eb3 aver*0501 IF ( profilesDoGenGrid .AND. stopGenericGrid.EQ.0 ) THEN
13ce79fe94 Ivan*0502 err = NF_GET_VARA_DOUBLE( fid, varId_intp1,
0503 & vec_start(2),vec_count(2), tmp_xC11 )
0504 CALL PROFILES_NF_ERROR(
0505 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_xC11',
0506 & err,bi,bj,myThid )
0507 err = NF_GET_VARA_DOUBLE( fid, varId_intp2,
0508 & vec_start(2),vec_count(2), tmp_yC11 )
0509 CALL PROFILES_NF_ERROR(
0510 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_yC11',
0511 & err,bi,bj,myThid )
0512 err = NF_GET_VARA_DOUBLE( fid, varId_intp11,
0513 & vec_start(2),vec_count(2), tmp_xCNINJ )
0514 CALL PROFILES_NF_ERROR(
0515 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_xCNINJ',
0516 & err,bi,bj,myThid )
0517 err = NF_GET_VARA_DOUBLE( fid, varId_intp22,
0518 & vec_start(2),vec_count(2), tmp_yCNINJ )
0519 CALL PROFILES_NF_ERROR(
0520 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_yCNINJ',
0521 & err,bi,bj,myThid )
0522
0523 DO iq = 1, iINTERP
0524 vec_start2(1) = iq
0525 vec_start2(2) = 1+chunk
0526 vec_count2(1) = 1
0527 vec_count2(2) = MIN(1000,ProfNo(num_file,bi,bj)-chunk)
0528
0529 err = NF_GET_VARA_DOUBLE( fid, varId_intp3,
0530 & vec_start2,vec_count2, tmp_weights(1,iq) )
0531 CALL PROFILES_NF_ERROR(
0532 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_weights',
0533 & err,bi,bj,myThid )
0534 err = NF_GET_VARA_DOUBLE( fid, varId_intp4,
0535 & vec_start2,vec_count2, tmp_i(1,iq) )
0536 CALL PROFILES_NF_ERROR(
0537 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_i',
0538 & err,bi,bj,myThid )
0539 err = NF_GET_VARA_DOUBLE(fid, varId_intp5,
0540 & vec_start2,vec_count2, tmp_j(1,iq) )
0541 CALL PROFILES_NF_ERROR(
0542 & 'INIT_FIXED: NF_GET_VARA_DOUBLE tmp_j',
0543 & err,bi,bj,myThid )
0544 ENDDO
0545 ENDIF
0546
0547
0548 DO ic = 1, MIN(1000,ProfNo(num_file,bi,bj)-chunk)
1827555eb3 aver*0549 IF ( .NOT.stopProfiles ) THEN
13ce79fe94 Ivan*0550
0551 profIsInRunTime = 1
0552
0553 IF (( (tmpyymmdd(ic).GT.yymmddMin).OR.
0554 & ((tmpyymmdd(ic).EQ.yymmddMin) .AND.
0555 & (tmphhmmss(ic).GT.hhmmssMin)) ) .AND.
0556 & ( (tmpyymmdd(ic).LT.yymmddMax).OR.
0557 & ((tmpyymmdd(ic).EQ.yymmddMax) .AND.
0558 & (tmphhmmss(ic).LT.hhmmssMax)) )) THEN
0559 hh = INT(tmphhmmss(ic))/10000
0560 IF (hh.LT.hoursPerDay) THEN
0561 profIsInRunTime = 1
0562
0563 CALL CAL_FULLDATE( INT(tmpyymmdd(ic)),
0564 & INT(tmphhmmss(ic)),tmpdate,myThid )
0565 CALL CAL_TIMEPASSED( modelstartdate,tmpdate,
0566 & tmpdiff,myThid )
0567 CALL CAL_TOSECONDS(
0568 & tmpdiff,diffsecs,myThid )
0569
0570 diffsecs = diffsecs+nIter0*deltaTClock
0571
0572 ELSE
0573
0574 profIsInRunTime = 0
0575 diffsecs = -deltaTClock
0576 ProfNo_hh = ProfNo_hh+1
0577 ENDIF
0578
0579 ELSE
0580
0581 profIsInRunTime = 0
0582 diffsecs = -deltaTClock
0583
0584 ENDIF
0585
0586
0587 IF ( (.NOT.profilesDoGenGrid) .AND.
0588 & (profIsInRunTime.EQ.1) ) THEN
0589 IF (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) THEN
0590 tmp_lon = xC(sNx+1,1,bi,bj)+360. _d 0
0591 ELSE
0592 tmp_lon = xC(sNx+1,1,bi,bj)
0593 ENDIF
0594
0595 IF ( (xC(1,1,bi,bj).LE.tmp_lon2(ic)) .AND.
0596 & (tmp_lon.GT.tmp_lon2(ic)) .AND.
0597 & (yC(1,1,bi,bj).LE.tmp_lat2(ic)) .AND.
0598 & (yC(1,sNy+1,bi,bj).GT.tmp_lat2(ic)) ) THEN
0599 lon_cur = tmp_lon2(ic)
0600 lat_cur = tmp_lat2(ic)
0601 ELSEIF ( (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj))
0602 & .AND. (xC(1,1,bi,bj).LE. tmp_lon2(ic)+360. _d 0)
0603 & .AND. (tmp_lon.GT.tmp_lon2(ic)+360. _d 0)
0604 & .AND. (yC(1,1,bi,bj).LE.tmp_lat2(ic))
0605 & .AND. (yC(1,sNy+1,bi,bj).GT.tmp_lat2(ic)) ) THEN
0606 lon_cur = tmp_lon2(ic)+360. _d 0
0607 lat_cur = tmp_lat2(ic)
0608 ELSE
0609 profIsInRunTime = 0
0610 ENDIF
0611
1827555eb3 aver*0612
13ce79fe94 Ivan*0613 prof_i = -10
0614 prof_j = -10
0615 lon_1 = -10
0616 lon_2 = -10
0617 lat_1 = -10
0618 lat_2 = -10
0619
0620 IF (profIsInRunTime.EQ.1) THEN
0621 DO j = 1, sNy+1
0622 DO i = 1, sNx+1
0623
0624 IF ( (yC(i,j,bi,bj).LE.lat_cur) .AND.
0625 & (yC(i,j+1,bi,bj).GT.lat_cur) ) THEN
0626 prof_j = j
0627 lat_1 = yC(i,j,bi,bj)
0628 lat_2 = yC(i,j+1,bi,bj)
0629 ENDIF
0630
0631
0632 IF (xC(i+1,j,bi,bj).LT.xC(1,j,bi,bj)) THEN
0633 lon_tmp2 = xC(i+1,j,bi,bj)+360
0634 ELSE
0635 lon_tmp2 = xC(i+1,j,bi,bj)
0636 ENDIF
0637 IF (xC(i,j,bi,bj).LT.xC(1,j,bi,bj)) THEN
0638 lon_tmp1 = xC(i,j,bi,bj)+360
0639 ELSE
0640 lon_tmp1 = xC(i,j,bi,bj)
0641 ENDIF
0642
0643 IF ( lon_tmp1.LE.lon_cur .AND.
0644 & lon_tmp2.GT.lon_cur ) THEN
0645 prof_i = i
0646 lon_1 = lon_tmp1
0647 lon_2 = lon_tmp2
0648 ENDIF
0649
0650 ENDDO
0651 ENDDO
0652 ENDIF
0653
0654 IF ((prof_i.EQ.-10).OR.(prof_j.EQ.-10)) THEN
0655 profIsInRunTime = 0
0656 ENDIF
0657
0658 IF (profIsInRunTime.EQ.1) THEN
0659
0660 ProfNo_tile = ProfNo_tile+1
0661 prof_time(num_file,ProfNo_tile,bi,bj) = diffsecs
0662 prof_lon(num_file,ProfNo_tile,bi,bj) = lon_cur
0663 prof_lat(num_file,ProfNo_tile,bi,bj) = lat_cur
0664 prof_ind_glob(num_file,ProfNo_tile,bi,bj) = ic+chunk
0665 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0666 prof_ind_avgbin(num_file,ProfNo_tile,bi,bj)
0667 & = tmp_avgbin(ic)
0668 # endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0669
0670 lon_fac = (lon_cur-lon_1)/(lon_2-lon_1)
0671 lat_fac = (lat_cur-lat_1)/(lat_2-lat_1)
0672
0673 prof_interp_weights(num_file,ProfNo_tile,1,bi,bj)
0674 & = (1-lon_fac)*(1-lat_fac)
0675 prof_interp_i(num_file,ProfNo_tile,1,bi,bj) = prof_i
0676 prof_interp_j(num_file,ProfNo_tile,1,bi,bj) = prof_j
0677
0678 prof_interp_weights(num_file,ProfNo_tile,2,bi,bj)
0679 & = lon_fac*(1-lat_fac)
0680 prof_interp_i(num_file,ProfNo_tile,2,bi,bj) = prof_i+1
0681 prof_interp_j(num_file,ProfNo_tile,2,bi,bj) = prof_j
0682
0683 prof_interp_weights(num_file,ProfNo_tile,3,bi,bj)
0684 & = (1-lon_fac)*lat_fac
0685 prof_interp_i(num_file,ProfNo_tile,3,bi,bj) = prof_i
0686 prof_interp_j(num_file,ProfNo_tile,3,bi,bj) = prof_j+1
0687
0688 prof_interp_weights(num_file,ProfNo_tile,4,bi,bj)
0689 & = lon_fac*lat_fac
0690 prof_interp_i(num_file,ProfNo_tile,4,bi,bj) = prof_i+1
0691 prof_interp_j(num_file,ProfNo_tile,4,bi,bj) = prof_j+1
0692 ENDIF
0693
0694
0695 ELSEIF (profIsInRunTime.EQ.1) THEN
0696
0697 IF (stopGenericGrid.EQ.0) THEN
0698 IF (ABS(tmp_xC11(ic)-xC(1,1,bi,bj)).LT.0.0001 _d 0
0699 & .AND.ABS(tmp_yC11(ic)-yC(1,1,bi,bj)).LT.0.0001 _d 0
0700 & .AND.ABS(tmp_xCNINJ(ic)-xC(sNx,sNy,bi,bj)).LT.0.0001 _d 0
0701 & .AND.ABS(tmp_yCNINJ(ic)-yC(sNx,sNy,bi,bj)).LT.0.0001 _d 0
0702 & .AND.profIsInRunTime.EQ.1 ) THEN
0703
0704 ProfNo_tile = ProfNo_tile+1
0705 prof_time(num_file,ProfNo_tile,bi,bj) = diffsecs
0706 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
d244ead1e5 aver*0707 prof_ind_avgbin(num_file,ProfNo_tile,bi,bj)
13ce79fe94 Ivan*0708 & = tmp_avgbin(ic)
0709 # endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0710 prof_interp_xC11(num_file,ProfNo_tile,bi,bj)
0711 & = tmp_xC11(ic)
0712 prof_interp_yC11(num_file,ProfNo_tile,bi,bj)
0713 & = tmp_yC11(ic)
0714 prof_interp_xCNINJ(num_file,ProfNo_tile,bi,bj)
0715 & = tmp_xCNINJ(ic)
0716 prof_interp_yCNINJ(num_file,ProfNo_tile,bi,bj)
0717 & = tmp_yCNINJ(ic)
0718 tmp_sum_weights = 0. _d 0
0719
0720 DO iq = 1, iINTERP
0721
0722 prof_interp_weights(num_file,ProfNo_tile,iq,bi,bj)
0723 & = tmp_weights(ic,iq)
0724 prof_interp_i(num_file,ProfNo_tile,iq,bi,bj)
0725 & = INT(tmp_i(ic,iq))
0726 prof_interp_j(num_file,ProfNo_tile,iq,bi,bj)
0727 & = INT(tmp_j(ic,iq))
0728 tmp_sum_weights = tmp_sum_weights + tmp_weights(ic,iq)
0729
0730
0731 IF ( tmp_i(ic,iq).LT.0 .OR. tmp_j(ic,iq).LT.0 .OR.
0732 & tmp_i(ic,iq).GT.sNx+1 .OR. tmp_j(ic,iq).GT.sNy+1
0733 & ) THEN
0734 WRITE(msgBuf,'(4A)')
0735 & 'PROFILES_INIT_FIXED: file ',
0736 & profilesfile(1:IL),
0737 & '.nc has inconsistent interp ',
0738 & '(profilesDoGenGrid; out of tile)'
0739 CALL PRINT_ERROR( msgBuf, myThid )
0740 stopGenericGrid = 1
0741 ENDIF
0742
0743 # ifdef ALLOW_PROFILES_EXCLUDE_CORNERS
0744 IF (tmp_weights(ic,iq).NE.0. _d 0) THEN
0745
0746
0747
0748
0749
0750
0751 IF((tmp_i(ic,iq).EQ.0.OR.tmp_i(ic,iq).EQ.sNx+1) .AND.
0752 & (tmp_j(ic,iq).EQ.0.OR.tmp_j(ic,iq).EQ.sNy+1)
0753 & ) THEN
0754 WRITE(msgBuf,'(5A)')
0755 & 'PROFILES_INIT_FIXED: file ',
0756 & profilesfile(1:IL),
0757 & '.nc has inconsistent interp',
0758 & '(profilesDoGenGrid; overlapping',
0759 & 'corner)'
0760 CALL PRINT_ERROR( msgBuf, myThid )
0761 stopGenericGrid = 1
0762 ENDIF
0763 ENDIF
0764 # endif /* ALLOW_PROFILES_EXCLUDE_CORNERS */
0765
0766 IF ( (tmp_weights(ic,iq).LT.0. _d 0) .OR.
0767 & (tmp_weights(ic,iq).GT.1. _d 0) ) THEN
0768 WRITE(msgBuf,'(5A)')
0769 & 'PROFILES_INIT_FIXED: file ',
0770 & profilesfile(1:IL),
0771 & '.nc has inconsistent interp',
0772 & 'weights (profilesDoGenGrid; ',
0773 & 'sum oustide 0-1)'
0774 CALL PRINT_ERROR( msgBuf, myThid)
0775 stopGenericGrid = 1
0776 ENDIF
0777
0778 ENDDO
0779
0780 IF (ABS(tmp_sum_weights -1. _d 0).GT. 0.0001 _d 0) THEN
0781 WRITE(msgBuf,'(4A)')
0782 & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
0783 & '.nc has inconsistent interp weights',
0784 & ' (profilesDoGenGrid; dont add to 1)'
0785 CALL PRINT_ERROR( msgBuf, myThid)
0786 stopGenericGrid = 1
0787 ENDIF
0788
0789 prof_ind_glob(num_file,ProfNo_tile,bi,bj) = ic + chunk
0790
0791 ENDIF
0792 ENDIF
0793 ENDIF
0794
0795
0796 IF (ProfNo_tile.GE.NOBSGLOB) THEN
0797 WRITE(msgBuf,'(3A)')
0798 & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
0799 & '.nc not read properly (increase NOBSGLOB).'
0800 CALL PRINT_ERROR( msgBuf, myThid)
1827555eb3 aver*0801 stopProfiles = .TRUE.
13ce79fe94 Ivan*0802 ENDIF
39ce977435 Gael*0803
1827555eb3 aver*0804 ENDIF
13ce79fe94 Ivan*0805 ENDDO
39ce977435 Gael*0806
13ce79fe94 Ivan*0807 ENDIF
0808 ENDDO
39ce977435 Gael*0809
13ce79fe94 Ivan*0810 ProfNo(num_file,bi,bj) = ProfNo_tile
39ce977435 Gael*0811
13ce79fe94 Ivan*0812 WRITE(msgBuf,'(A,I9)')
0813 & ' # of profiles with erroneous HHMMSS values =',
0814 & ProfNo_hh
0815 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
ba63501b4c Gael*0816
13ce79fe94 Ivan*0817 WRITE(msgBuf,'(A,I9)')
0818 & ' # of profiles within tile and time period =',
0819 & ProfNo(num_file,bi,bj)
0820 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
ba63501b4c Gael*0821
13ce79fe94 Ivan*0822
0823 DO num_var = 1, NVARMAX
0824 prof_num_var_cur(num_file,num_var,bi,bj) = 0
0825 ENDDO
0826 prof_num_var_tot(num_file,bi,bj) = 0
0827
0828 DO num_var = 1, NVARMAX
0829 JL = ILNBLNK( prof_names(num_file,num_var) )
0830 err = NF_INQ_VARID( fid,
0831 & prof_names(num_file,num_var)(1:JL), varId1 )
0832
0833 IF (err.EQ.NF_NOERR) THEN
0834 vec_quantities(num_file,num_var,bi,bj) = .TRUE.
0835
0836 prof_num_var_tot(num_file,bi,bj) =
0837 & prof_num_var_tot(num_file,bi,bj) + 1
0838 prof_num_var_cur(num_file,num_var,bi,bj) =
0839 & prof_num_var_tot(num_file,bi,bj)
0840 ELSE
0841 CALL PROFILES_NF_ERROR(
0842 & 'INIT_FIXED: NF_INQ_VARID prof_names = '//
0843 & prof_names(num_file,num_var)(1:JL),err,bi,bj,myThid )
1827555eb3 aver*0844 IF (prof_dBugLevel .GE. debLevB) THEN
13ce79fe94 Ivan*0845 WRITE(msgBuf,'(3A)') 'S/R PROFILES_INIT_FIXED: no ',
0846 & prof_names(num_file,num_var)(1:JL),
0847 & ', setting corresponding vec_quantities = F'
0848 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0849 ENDIF
0850 vec_quantities(num_file,num_var,bi,bj) = .FALSE.
0851 ENDIF
0852
0853 IF (vec_quantities(num_file,num_var,bi,bj)) THEN
0854 KL = ILNBLNK( prof_names(num_file,num_var) )
0855 JL = ILNBLNK( prof_namesmod(num_file,num_var) )
0856
0857 IF (prof_namesmod(num_file,num_var).EQ.'pTracer') THEN
0858 WRITE(msgBuf,'(A,I3,5A,I3)') ' variable #',
0859 & num_var,' is ' ,
0860 & prof_names(num_file,num_var)(1:KL),' and ',
0861 & prof_namesmod(num_file,num_var)(1:JL),' #',
0862 & prof_itracer(num_file,num_var)
0863 ELSE
0864 WRITE(msgBuf,'(A,I3,4A)') ' variable #',
0865 & num_var,' is ' ,
0866 & prof_names(num_file,num_var)(1:KL),' and ',
0867 & prof_namesmod(num_file,num_var)(1:JL)
0868 ENDIF
0869 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
0870 ENDIF
0871 ENDDO
6a770e0a24 Patr*0872
0873
13ce79fe94 Ivan*0874
6a770e0a24 Patr*0875
0876
13ce79fe94 Ivan*0877 IF (ProfNo(num_file,bi,bj).GT.0) THEN
0878 iG=bi+(myXGlobalLo-1)/sNx
0879 jG=bj+(myYGlobalLo-1)/sNy
0880 JL = ILNBLNK( profilesDir )
0881
0882 IF (profilesDoNcOutput) THEN
0883 WRITE(fnameequinc,'(3A,2(I3.3,A))')
0884 & profilesDir(1:JL),profilesfile(1:IL),
0885 & '.',iG,'.',jG,'.equi.nc'
0886 # ifdef ALLOW_ADJOINT_RUN
0887 WRITE(adfnameequinc,'(4A,2(I3.3,A))')
0888 & profilesDir(1:JL),'ad',profilesfile(1:IL),
0889 & '.',iG,'.',jG,'.equi.nc'
0890 # endif /* ALLOW_ADJOINT_RUN */
0891 # ifdef ALLOW_TANGENTLINEAR_RUN
0892 WRITE(tlfnameequinc,'(4A,2(I3.3,A))')
0893 & profilesDir(1:JL),'tl',profilesfile(1:IL),
0894 & '.',iG,'.',jG,'.equi.nc'
0895 # endif /* ALLOW_TANGENTLINEAR_RUN */
0896
0897 JL = ILNBLNK( fnameequinc )
0898 INQUIRE( FILE = fnameequinc(1:JL), EXIST = exst )
0899 IF (.NOT.exst) THEN
0900 CALL PROFILES_INIT_NCFILE( num_file,
0901 & fiddata(num_file,bi,bj), fnameequinc(1:JL),
0902 & fidforward(num_file,bi,bj),
0903 & ProfNo(num_file,bi,bj),
0904 & ProfDepthNo(num_file,bi,bj),
0905 & bi, bj, myThid )
0906 ELSE
0907
0908 err = NF_OPEN( fnameequinc(1:JL), NF_WRITE,
0909 & fidforward(num_file,bi,bj) )
0910 CALL PROFILES_NF_ERROR( 'INIT_FIXED: NF_OPEN fidforward',
0911 & err,bi,bj,myThid )
0912 ENDIF
0913
0914 # ifdef ALLOW_ADJOINT_RUN
0915 JL = ILNBLNK( adfnameequinc )
0916 INQUIRE( FILE = adfnameequinc(1:JL), EXIST = exst )
0917 IF (.NOT.exst) THEN
0918 CALL PROFILES_INIT_NCFILE( num_file,
0919 & fiddata(num_file,bi,bj), adfnameequinc(1:JL),
0920 & fidadjoint(num_file,bi,bj),
0921 & ProfNo(num_file,bi,bj),
0922 & ProfDepthNo(num_file,bi,bj),
0923 & bi, bj, myThid )
0924 ELSE
0925
0926 err = NF_OPEN( adfnameequinc(1:JL), NF_WRITE,
0927 & fidadjoint(num_file,bi,bj) )
0928 CALL PROFILES_NF_ERROR( 'INIT_FIXED: NF_OPEN fidadjoint',
0929 & err,bi,bj,myThid )
0930 ENDIF
0931
0932 # endif /* ALLOW_ADJOINT_RUN */
0933 # ifdef ALLOW_TANGENTLINEAR_RUN
0934 JL = ILNBLNK( tlfnameequinc )
0935 INQUIRE( FILE = tlfnameequinc(1:JL), EXIST = exst )
0936 IF (.NOT.exst) THEN
0937 CALL PROFILES_INIT_NCFILE( num_file,
0938 & fiddata(num_file,bi,bj), tlfnameequinc(1:JL),
0939 & fidtangent(num_file,bi,bj),
0940 & ProfNo(num_file,bi,bj),
0941 & ProfDepthNo(num_file,bi,bj),
0942 & bi, bj, myThid )
0943 ELSE
0944
0945 err = NF_OPEN( tlfnameequinc(1:JL), NF_WRITE,
0946 & fidtangent(num_file,bi,bj) )
0947 CALL PROFILES_NF_ERROR( 'INIT_FIXED: NF_OPEN fidtangent',
0948 & err,bi,bj,myThid )
0949 ENDIF
0950
0951 # endif /* ALLOW_TANGENTLINEAR_RUN */
0952 ELSE
0953 WRITE(fnameequinc,'(3A,2(I3.3,A))')
0954 & profilesDir(1:JL),profilesfile(1:IL),
0955 & '.',iG,'.',jG,'.equi.data'
0956
0957 # ifdef ALLOW_ADJOINT_RUN
0958 WRITE(adfnameequinc,'(4A,2(I3.3,A))')
0959 & profilesDir(1:JL),'ad',profilesfile(1:IL),
0960 & '.',iG,'.',jG,'.equi.data'
0961
0962 # endif /* ALLOW_ADJOINT_RUN */
0963 # ifdef ALLOW_TANGENTLINEAR_RUN
0964 WRITE(tlfnameequinc,'(4A,2(I3.3,A))')
0965 & profilesDir(1:JL),'tl',profilesfile(1:IL),
0966 & '.',iG,'.',jG,'.equi.data'
0967
0968 # endif /* ALLOW_TANGENTLINEAR_RUN */
0969
0970 JL = ILNBLNK( fnameequinc )
0971 INQUIRE( FILE = fnameequinc(1:JL), EXIST = exst )
0972 # ifdef PROFILES_USE_MDSFINDUNITS
0973 CALL MDSFINDUNIT( fidforward(num_file,bi,bj), myThid )
0974 # else
0975 CALL PROFILES_FINDUNIT( fidforward(num_file,bi,bj), myThid )
0976 # endif
0977 IF (.NOT.exst) THEN
0978 CALL PROFILES_INIT_NCFILE( num_file,
0979 & fiddata(num_file,bi,bj), fnameequinc(1:JL),
0980 & fidforward(num_file,bi,bj),
0981 & ProfNo(num_file,bi,bj),
0982 & ProfDepthNo(num_file,bi,bj),
0983 & bi, bj, myThid )
0984 ELSE
0985 OPEN( fidforward(num_file,bi,bj),
0986 & FILE = fnameequinc(1:JL), FORM = 'unformatted',
0987 & STATUS = 'unknown', ACCESS = 'direct',
0988 & RECL = (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
0989 ENDIF
0990
0991 # ifdef ALLOW_ADJOINT_RUN
0992 JL = ILNBLNK( adfnameequinc )
0993 INQUIRE( FILE = adfnameequinc(1:JL), EXIST = exst )
0994 # ifdef PROFILES_USE_MDSFINDUNITS
0995 CALL MDSFINDUNIT( fidadjoint(num_file,bi,bj), myThid )
0996 # else
0997 CALL PROFILES_FINDUNIT( fidadjoint(num_file,bi,bj), myThid )
0998 # endif
0999 IF (.NOT.exst) THEN
1000 CALL PROFILES_INIT_NCFILE( num_file,
1001 & fiddata(num_file,bi,bj), adfnameequinc(1:JL),
1002 & fidadjoint(num_file,bi,bj),
1003 & ProfNo(num_file,bi,bj),
1004 & ProfDepthNo(num_file,bi,bj),
1005 & bi, bj, myThid )
1006 ELSE
1007 OPEN( fidadjoint(num_file,bi,bj),
1008 & FILE = adfnameequinc(1:JL), FORM = 'unformatted',
1009 & STATUS = 'unknown', ACCESS = 'direct',
1010 & RECL = (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
1011 ENDIF
1012 # endif /* ALLOW_ADJOINT_RUN */
1827555eb3 aver*1013
13ce79fe94 Ivan*1014 # ifdef ALLOW_TANGENTLINEAR_RUN
1015 JL = ILNBLNK( tlfnameequinc )
1016 INQUIRE( FILE = tlfnameequinc(1:JL), EXIST = exst )
1017 # ifdef PROFILES_USE_MDSFINDUNITS
1018 CALL MDSFINDUNIT( fidtangent(num_file,bi,bj), myThid )
1019 # else
1020 CALL PROFILES_FINDUNIT( fidtangent(num_file,bi,bj), myThid )
1021 # endif
1022 IF (.NOT.exst) THEN
1023 CALL PROFILES_INIT_NCFILE( num_file,
1024 & fiddata(num_file,bi,bj), tlfnameequinc(1:JL),
1025 & fidtangent(num_file,bi,bj),
1026 & ProfNo(num_file,bi,bj),
1027 & ProfDepthNo(num_file,bi,bj),
1028 & bi, bj, myThid )
1029 ELSE
1030 OPEN( fidtangent(num_file,bi,bj),
1031 & FILE = tlfnameequinc(1:JL), FORM = 'unformatted',
1032 & STATUS = 'unknown', ACCESS = 'direct',
1033 & RECL = (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
1034 ENDIF
1035
1036 # endif /* ALLOW_TANGENTLINEAR_RUN */
1037
1038 ENDIF
1039
1040 ENDIF
1041
1042
1043 ENDIF
6a770e0a24 Patr*1044
1827555eb3 aver*1045 stopProfiles = stopProfiles .OR. ( stopGenericGrid.GT.0 )
1046 IF ( stopProfiles ) THEN
1047 stopProfiles_cnt = stopProfiles_cnt+1
1048 ENDIF
1049 stopGenericGrid_max = MAX( stopGenericGrid_max,
1050 & stopGenericGrid )
1051
1052
1053 ENDDO
1054 ENDDO
1055 ENDDO
6a770e0a24 Patr*1056
13ce79fe94 Ivan*1057 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
1058
6b2230d510 Ou W*1059
1827555eb3 aver*1060
1061 NLEVELCOMB = 0
1062 DO bj = 1, nSy
1063 DO bi = 1, nSx
6b2230d510 Ou W*1064
13ce79fe94 Ivan*1065 m = 1
1066 DO num_file = 1, NFILESPROFMAX
1827555eb3 aver*1067 DO kLev = 1, MIN( ProfDepthNo(num_file,bi,bj), NLEVELMAX )
13ce79fe94 Ivan*1068 IF (m.EQ.1) THEN
1069 prof_depth_comb(m,bi,bj) = prof_depth(num_file,kLev,bi,bj)
6b2230d510 Ou W*1070 m = m + 1
13ce79fe94 Ivan*1071
1072 ELSE
1073 DO kCMax = 1, NLEVELCOMBMAX-1
1074 IF (prof_depth_comb(kCMax,bi,bj) .NE. -999. _d 0) THEN
1075 IF ( prof_depth(num_file,kLev,bi,bj).LT.
1076 & prof_depth_comb(kCMax,bi,bj).AND. kCMax.EQ.1 ) THEN
1077
1078 prof_depth_comb(NLEVELCOMBMAX,bi,bj) =
1079 & prof_depth_comb(kCMax,bi,bj)
1080
1081 prof_depth_comb(kCMax,bi,bj) =
1082 & prof_depth(num_file,kLev,bi,bj)
1083
1084 DO kC = NLEVELCOMBMAX-1, kCMax+2, -1
1085 prof_depth_comb(kC,bi,bj) = prof_depth_comb(kC-1,bi,bj)
1086 ENDDO
1087
1088 prof_depth_comb(kCMax+1,bi,bj) =
1089 & prof_depth_comb(NLEVELCOMBMAX,bi,bj)
1090
1091 ELSEIF ( prof_depth(num_file,kLev,bi,bj).GT.
1092 & prof_depth_comb(kCMax,bi,bj) .AND.
1093 & prof_depth(num_file,kLev,bi,bj).LT.
1094 & prof_depth_comb(kCMax+1,bi,bj) ) THEN
1095
1096 prof_depth_comb(NLEVELCOMBMAX,bi,bj) =
1097 & prof_depth_comb(kCMax+1,bi,bj)
1098
1099 prof_depth_comb(kCMax+1,bi,bj) =
1100 & prof_depth(num_file, kLev,bi,bj)
1101
1102 DO kC = NLEVELCOMBMAX-1, kCMax+3, -1
1103 prof_depth_comb(kC,bi,bj) = prof_depth_comb(kC-1,bi,bj)
1104 ENDDO
1105
1106 prof_depth_comb(kCMax+2,bi,bj)=
1107 & prof_depth_comb(NLEVELCOMBMAX,bi,bj)
1108
1109 ELSEIF ( prof_depth(num_file,kLev,bi,bj).GT.
1110 & prof_depth_comb(kCMax,bi,bj) .AND.
1111 & prof_depth_comb(kCMax+1,bi,bj).EQ. -999. _d 0 ) THEN
1112
1113 prof_depth_comb(kCMax+1,bi,bj) =
1114 & prof_depth(num_file, kLev,bi,bj)
6b2230d510 Ou W*1115
13ce79fe94 Ivan*1116 ENDIF
1117 ENDIF
1118 ENDDO
1119
1120 ENDIF
1121
1122 IF (m.GE.NLEVELCOMBMAX-2) THEN
1123 WRITE(msgBuf,'(A)') 'increase NLEVELCOMBMAX'
1124 CALL PRINT_ERROR( msgBuf, myThid )
c9bf163375 Ivan*1125 ENDIF
13ce79fe94 Ivan*1126
1127 ENDDO
1827555eb3 aver*1128
13ce79fe94 Ivan*1129 ENDDO
1130
1131 prof_depth_comb(NLEVELCOMBMAX,bi,bj) = -999. _d 0
1132
1133
1134 DO kCMax = 1, NLEVELCOMBMAX
1135 IF ( prof_depth_comb(kCMax,bi,bj) .GE. 0. _d 0
1136 & .AND. NLEVELCOMB.LT.kCMax ) THEN
1137 NLEVELCOMB = kCMax
1138
1139 IF (kCMax.GE.NLEVELCOMBMAX-2) THEN
1140 WRITE(msgBuf,'(A,2I6)')
1141 & 'increase NLEVELCOMBMAX: kCMax, NLEVELCOMBMA ',
1142 & kCMax, NLEVELCOMBMAX
1143 CALL PRINT_ERROR( msgBuf, myThid )
1144 ENDIF
1145 ENDIF
1146 ENDDO
1147
1148 WRITE(msgBuf,'(A,I6,D20.5)') 'NLEVELCOMB = ', NLEVELCOMB
1149 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
1827555eb3 aver*1150
1151 ENDDO
1152 ENDDO
13ce79fe94 Ivan*1153 # endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
6b2230d510 Ou W*1154
6a770e0a24 Patr*1155
13ce79fe94 Ivan*1156
ba63501b4c Gael*1157
1158
13ce79fe94 Ivan*1159
1827555eb3 aver*1160 IF ( stopGenericGrid_max.EQ.2) THEN
1161 #ifdef ALLOW_DEBUG
1162 DO bj = 1, nSy
1163 DO bi = 1, nSx
13ce79fe94 Ivan*1164
1827555eb3 aver*1165 fnameequinc = 'profilesXCwithOverlap'
13ce79fe94 Ivan*1166 JL = ILNBLNK( fnameequinc )
1827555eb3 aver*1167 WRITE(iUnit,'(4A,2I4)')
13ce79fe94 Ivan*1168 & 'PROFILES_INIT_FIXED: creating grid from profiles; ',
1827555eb3 aver*1169 & 'file:', fnameequinc(1:JL), ' , bi,bj=', bi, bj
1170 CALL WRITE_FULLARRAY_RS( fnameequinc, xC(1-OLx,1-OLy,bi,bj),
1171 & 1, bi, bj, 1, -1, myThid )
1172
1173 fnameequinc = 'profilesYCwithOverlap'
13ce79fe94 Ivan*1174 JL = ILNBLNK( fnameequinc )
1827555eb3 aver*1175 WRITE(iUnit,'(4A,2I4)')
1176 & 'PROFILES_INIT_FIXED: creating grid from profiles; ',
1177 & 'file:', fnameequinc(1:JL), ' , bi,bj=', bi, bj
1178 CALL WRITE_FULLARRAY_RS( fnameequinc, yC(1-OLx,1-OLy,bi,bj),
1179 & 1, bi, bj, 1, -1, myThid )
1180 ENDDO
1181 ENDDO
1182 #endif /* ALLOW_DEBUG */
1183
1184 WRITE(msgBuf,'(2A)')
1185 & 'PROFILES_INIT_FIXED : when using profilesDoGenGrid ',
1186 & 'you have to provide interpolation coeffs etc. '
1187 CALL PRINT_ERROR( msgBuf, myThid )
1188 WRITE(msgBuf,'(2A)')
1189 & 'and some of your nc files dont have them. ',
1190 & 'You could use profiles_prep_mygrid.m and/or'
1191 CALL PRINT_ERROR( msgBuf, myThid )
1192 WRITE(msgBuf,'(2A)') 'use the grid info in ',
1193 & 'profilesXC,YCwithOverlap.xxx.yyy.data'
1194 CALL PRINT_ERROR( msgBuf, myThid )
1195
1196 ENDIF
6b2230d510 Ou W*1197
1827555eb3 aver*1198
c9bf163375 Ivan*1199 _END_MASTER( myThid )
ba63501b4c Gael*1200 _BARRIER
1201
13ce79fe94 Ivan*1202 # ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
1203 NLEVELCOMBRL = NLEVELCOMB
1204 _GLOBAL_MAX_RL( NLEVELCOMBRL, myThid )
1205 NLEVELCOMB = NLEVELCOMBRL
1206 # endif
1207
1208
1827555eb3 aver*1209 CALL GLOBAL_SUM_INT( stopProfiles_cnt, myThid )
1210 IF ( stopProfiles_cnt.GE.1) THEN
13ce79fe94 Ivan*1211 CALL ALL_PROC_DIE( myThid )
1212 STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
c9bf163375 Ivan*1213 ENDIF
ba63501b4c Gael*1214
13ce79fe94 Ivan*1215 WRITE(msgBuf,'(A)') ' '
1216 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
1217 WRITE(msgBuf,'(A)')
1218 & '// ======================================================='
1219 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
1220 WRITE(msgBuf,'(A)')
1221 & '// insitu profiles model sampling >>> END <<<'
1222 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
1223 WRITE(msgBuf,'(A)')
1224 & '// ======================================================='
1225 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
1226 WRITE(msgBuf,'(A)') ' '
1227 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
c9bf163375 Ivan*1228 #endif /* ALLOW_PROFILES */
6a770e0a24 Patr*1229
d5aa75d39a Jean*1230 RETURN
6a770e0a24 Patr*1231 END
