pkg/profiles/profiles_init_fixed.F

24462d2fa8 Patr*0001 #include "PROFILES_OPTIONS.h"
57c22ecc45 Jean*0002 #include "AD_CONFIG.h"
6a770e0a24 Patr*0003
c9bf163375 Ivan*0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
6a770e0a24 Patr*0005
                0006       SUBROUTINE profiles_init_fixed( myThid )
c9bf163375 Ivan*0007 C     *==========================================================*
                0008 C     | SUBROUTINE profiles_init_fixed                           |
                0009 C     | o initialization for netcdf profiles data                |
                0010 C     *==========================================================*
                0011       IMPLICIT NONE
6a770e0a24 Patr*0012
c9bf163375 Ivan*0013 C     === Global variables ===
6a770e0a24 Patr*0014 #include "SIZE.h"
                0015 #include "EEPARAMS.h"
                0016 #include "PARAMS.h"
                0017 #include "GRID.h"
                0018 #include "DYNVARS.h"
d28c90138c Patr*0019 #ifdef ALLOW_CAL
6a770e0a24 Patr*0020 #include "cal.h"
d28c90138c Patr*0021 #endif
24462d2fa8 Patr*0022 #ifdef ALLOW_PROFILES
6328b73337 Gael*0023 # include "PROFILES_SIZE.h"
6e4c90fea3 Patr*0024 # include "profiles.h"
                0025 # include "netcdf.inc"
                0026 #endif
39ce977435 Gael*0027
c9bf163375 Ivan*0028 C     === Routine arguments ===
                0029 C     myThid -  Number of this instances
                0030       INTEGER myThid
39ce977435 Gael*0031
c9bf163375 Ivan*0032 c     == external functions ==
                0033       INTEGER ILNBLNK
                0034       EXTERNAL ILNBLNK
                0035       INTEGER MDS_RECLEN
                0036       EXTERNAL MDS_RECLEN
6a770e0a24 Patr*0037
39ce977435 Gael*0038 #ifdef ALLOW_PROFILES
c9bf163375 Ivan*0039 C     === Local variables ===
                0040       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0041       INTEGER i,j,k,l,m,bi,bj,iG,jG,num_file,ProfNo_tile
                0042       INTEGER stopProfiles
                0043       INTEGER fid, dimid, varid1, varid1a, varid1b
                0044       INTEGER varid2,varid3
6a770e0a24 Patr*0045       _RL tmpyymmdd(1000),tmphhmmss(1000),diffsecs
5042c05de8 Gael*0046       _RL yymmddMin,yymmddMax
                0047       _RL hhmmssMin,hhmmssMax
                0048
c9bf163375 Ivan*0049       INTEGER tmpdate(4),tmpdiff(4),profIsInRunTime
39ce977435 Gael*0050       _RL  tmp_lon, tmp_lon2(1000), tmp_lat2(1000), lon_cur, lat_cur
                0051       _RL lon_1, lon_2, lat_1, lat_2
2767dff983 Jean*0052       _RL lon_tmp1, lon_tmp2
39ce977435 Gael*0053       _RL lat_fac, lon_fac
c9bf163375 Ivan*0054       INTEGER prof_i, prof_j
                0055       INTEGER vec_start(2), vec_count(2), profno_div1000, kk
                0056       CHARACTER*(MAX_LEN_FNAM) profilesfile, fnamedatanc
                0057       CHARACTER*(MAX_LEN_FNAM) fnameequinc
                0058       CHARACTER*(MAX_LEN_FNAM) adfnameequinc, tlfnameequinc
                0059       INTEGER IL, JL, KL, err
                0060       LOGICAL  exst
                0061
                0062       INTEGER varid_intp1, varid_intp2, varid_intp11 , varid_intp22
                0063       INTEGER varid_intp3, varid_intp4, varid_intp5, q, iINTERP
ba63501b4c Gael*0064       _RL tmp_i(1000,NUM_INTERP_POINTS)
                0065       _RL tmp_j(1000,NUM_INTERP_POINTS)
                0066       _RL tmp_weights(1000,NUM_INTERP_POINTS),tmp_sum_weights
                0067       _RL tmp_xC11(1000),tmp_yC11(1000)
                0068       _RL tmp_xCNINJ(1000),tmp_yCNINJ(1000)
c9bf163375 Ivan*0069       INTEGER stopGenericGrid
ba63501b4c Gael*0070       Real*8 xy_buffer_r8(0:sNx+1,0:sNy+1)
c9bf163375 Ivan*0071       INTEGER vec_start2(2), vec_count2(2)
                0072       INTEGER hh, ProfNo_hh
6b2230d510 Ou W*0073 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
c9bf163375 Ivan*0074       INTEGER varid4
6b2230d510 Ou W*0075       _RL tmp_avgbin(1000)
                0076 #endif
ba63501b4c Gael*0077
c9bf163375 Ivan*0078       WRITE(msgBuf,'(a)') ' '
                0079       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0080      &                    SQUEEZE_RIGHT, myThid )
                0081       WRITE(msgBuf,'(a)')
f0e4bffe35 Gael*0082      &'// ======================================================='
c9bf163375 Ivan*0083       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0084      &                    SQUEEZE_RIGHT, myThid )
                0085       WRITE(msgBuf,'(a)')
f0e4bffe35 Gael*0086      &'// insitu profiles model sampling >>> START <<<'
c9bf163375 Ivan*0087       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0088      &                    SQUEEZE_RIGHT, myThid )
                0089       WRITE(msgBuf,'(a)')
f0e4bffe35 Gael*0090      &'// ======================================================='
c9bf163375 Ivan*0091       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0092      &                    SQUEEZE_RIGHT, myThid )
                0093       WRITE(msgBuf,'(a)') ' '
                0094       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0095      &                    SQUEEZE_RIGHT, myThid )
f0e4bffe35 Gael*0096
c9c84c2afb Gael*0097       stopProfiles=0
                0098       stopGenericGrid=0
f0e4bffe35 Gael*0099
                0100       IF ( (.NOT.profilesDoGenGrid).AND.
                0101      &     (.NOT.usingSphericalPolarGrid .OR. rotateGrid) ) THEN
                0102         WRITE(msgBuf,'(2A)') 'PROFILES_INIT_FIXED: ',
                0103      &  'profilesDoGenGrid=.true. is required'
                0104         CALL PRINT_ERROR( msgBuf , myThid )
                0105         WRITE(msgBuf,'(2A)') 'PROFILES_INIT_FIXED: ',
                0106      &  'unless usingSphericalGrid=.TRUE. and rotateGrid=.FALSE.'
                0107         CALL PRINT_ERROR( msgBuf , myThid )
b00d6c1700 Gael*0108         CALL ALL_PROC_DIE( myThid )
f0e4bffe35 Gael*0109         STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
                0110       ENDIF
                0111
c9bf163375 Ivan*0112       WRITE(msgBuf,'(a)') ' '
                0113       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0114      &                    SQUEEZE_RIGHT, myThid )
                0115       WRITE(msgBuf,'(a)') 'general packages parameters :'
f0e4bffe35 Gael*0116       JL  = ILNBLNK( profilesDir )
c9bf163375 Ivan*0117       IF (JL.NE.0) THEN
0e6a4460e5 Ivan*0118         WRITE(msgBuf,'(2a)') '  profilesDir ',profilesDir(1:JL)
c9bf163375 Ivan*0119       ELSE
0e6a4460e5 Ivan*0120         WRITE(msgBuf,'(2a)') '  profilesDir ','./'
c9bf163375 Ivan*0121       ENDIF
                0122       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0123      &                    SQUEEZE_RIGHT, myThid )
                0124       WRITE(msgBuf,'(a,l5)') '  profilesDoGenGrid  ',profilesDoGenGrid
                0125       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0126      &                    SQUEEZE_RIGHT, myThid )
                0127       WRITE(msgBuf,'(a,l5)') '  profilesDoNcOutput ',profilesDoNcOutput
                0128       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0129      &                    SQUEEZE_RIGHT, myThid )
                0130       WRITE(msgBuf,'(a)') ' '
                0131       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0132      &                    SQUEEZE_RIGHT, myThid )
                0133
                0134       _BEGIN_MASTER( myThid )
b00d6c1700 Gael*0135
ba63501b4c Gael*0136       DO bj=1,nSy
64278b1175 Jean*0137       DO bi=1,nSx
71a5587721 Gael*0138
a377358620 Patr*0139         profiles_curfile_buff(bi,bj)=0
5042c05de8 Gael*0140         yymmddMin=modelstartdate(1)
                0141         yymmddMax=modelenddate(1)
                0142         hhmmssMin=modelstartdate(2)
                0143         hhmmssMax=modelenddate(2)
6e4c90fea3 Patr*0144
c9bf163375 Ivan*0145         DO m=1,NLEVELMAX
                0146          DO l=1,1000
                0147           DO k=1,NVARMAX
c9c84c2afb Gael*0148            profiles_data_buff(m,l,k,bi,bj)=0. _d 0
                0149            profiles_weight_buff(m,l,k,bi,bj)=0. _d 0
c9bf163375 Ivan*0150           ENDDO
                0151          ENDDO
                0152         ENDDO
d5aa75d39a Jean*0153
c9bf163375 Ivan*0154         DO num_file=1,NFILESPROFMAX
6a770e0a24 Patr*0155
a996b8bdc0 Gael*0156       ProfNo_hh=0
                0157
38287224dd Gael*0158       profilesfile=' '
6a770e0a24 Patr*0159       IL  = ILNBLNK( profilesfiles(num_file) )
c9bf163375 Ivan*0160       IF (IL.NE.0) THEN
0e6a4460e5 Ivan*0161         WRITE(profilesfile,'(a)')
ce2e1d3cd5 Patr*0162      &     profilesfiles(num_file)(1:IL)
c9bf163375 Ivan*0163         WRITE(msgBuf,'(a)') ' '
                0164         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0165      &                      SQUEEZE_RIGHT, myThid )
0e6a4460e5 Ivan*0166         WRITE(msgBuf,'(a,i3,2a)')
a996b8bdc0 Gael*0167      &     'profiles file #',num_file,' is ', profilesfile(1:IL)
c9bf163375 Ivan*0168         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0169      &                      SQUEEZE_RIGHT, myThid )
                0170       ENDIF
6a770e0a24 Patr*0171
                0172       IL  = ILNBLNK( profilesfile )
c9bf163375 Ivan*0173       IF (IL.NE.0) THEN
6a770e0a24 Patr*0174
                0175 C===========================================================
ba63501b4c Gael*0176 c open data files and read information
6a770e0a24 Patr*0177 C===========================================================
                0178
c9bf163375 Ivan*0179       WRITE(fnamedatanc,'(2a)') profilesfile(1:IL),'.nc'
71a5587721 Gael*0180       err = NF_OPEN(fnamedatanc, 0, fiddata(num_file,bi,bj))
6a770e0a24 Patr*0181
                0182 c1)  read the number of profiles :
71a5587721 Gael*0183       fid=fiddata(num_file,bi,bj)
6a770e0a24 Patr*0184       err = NF_INQ_DIMID(fid,'iPROF', dimid )
71a5587721 Gael*0185       err = NF_INQ_DIMLEN(fid, dimid, ProfNo(num_file,bi,bj) )
6a770e0a24 Patr*0186       err = NF_INQ_DIMID(fid,'iDEPTH', dimid )
c9bf163375 Ivan*0187       IF (err.NE.NF_NOERR) THEN
ce2e1d3cd5 Patr*0188         err = NF_INQ_DIMID(fid,'Z', dimid )
c9bf163375 Ivan*0189       ENDIF
71a5587721 Gael*0190       err = NF_INQ_DIMLEN(fid, dimid, ProfDepthNo(num_file,bi,bj) )
38287224dd Gael*0191       err = NF_INQ_DIMID(fid,'iINTERP', dimid )
c9bf163375 Ivan*0192       IF (err.EQ.NF_NOERR) THEN
38287224dd Gael*0193         err = NF_INQ_DIMLEN(fid, dimid, iINTERP )
c9bf163375 Ivan*0194       ELSE
38287224dd Gael*0195         iINTERP=NUM_INTERP_POINTS
c9bf163375 Ivan*0196       ENDIF
f0e4bffe35 Gael*0197
0e6a4460e5 Ivan*0198       WRITE(msgBuf,'(2(a,i4))')
a996b8bdc0 Gael*0199      &   '  current tile is bi,bj                      =',
                0200      &   bi,',',bj
c9bf163375 Ivan*0201       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0202      &                    SQUEEZE_RIGHT, myThid )
                0203       WRITE(msgBuf,'(a,i9)')
a996b8bdc0 Gael*0204      &   '  # of depth levels in file                  =',
                0205      &   ProfDepthNo(num_file,bi,bj)
c9bf163375 Ivan*0206       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0207      &                    SQUEEZE_RIGHT, myThid )
                0208       WRITE(msgBuf,'(a,i9)')
a996b8bdc0 Gael*0209      &   '  # of profiles in file                      =',
                0210      &   ProfNo(num_file,bi,bj)
c9bf163375 Ivan*0211       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0212      &                    SQUEEZE_RIGHT, myThid )
6a770e0a24 Patr*0213
                0214 c2) read the dates and positions :
b632e3ba1b Gael*0215       err = NF_INQ_VARID(fid,'prof_depth', varid1a )
c9bf163375 Ivan*0216       IF (err.NE.NF_NOERR) THEN
b632e3ba1b Gael*0217 c       if no prof_depth is found, then try old variable name:
                0218         err = NF_INQ_VARID(fid,'depth', varid1a )
c9bf163375 Ivan*0219       ENDIF
                0220       IF (err.NE.NF_NOERR) THEN
b632e3ba1b Gael*0221 c       if neither is found, then stop
f0e4bffe35 Gael*0222         IL  = ILNBLNK( profilesfile )
                0223         WRITE(msgBuf,'(3A)')
                0224      & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0225      & '.nc is not in the pkg/profiles format (no prof_depth etc.)'
                0226         CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0227         stopProfiles=1
c9bf163375 Ivan*0228       ENDIF
b632e3ba1b Gael*0229
c9bf163375 Ivan*0230       DO k=1,ProfDepthNo(num_file,bi,bj)
6a770e0a24 Patr*0231       err = NF_GET_VAR1_DOUBLE(fid,varid1a,k,
71a5587721 Gael*0232      & prof_depth(num_file,k,bi,bj))
c9bf163375 Ivan*0233       ENDDO
6a770e0a24 Patr*0234
                0235       err = NF_INQ_VARID(fid,'prof_YYYYMMDD', varid1a )
                0236       err = NF_INQ_VARID(fid,'prof_HHMMSS', varid1b )
                0237       err = NF_INQ_VARID(fid,'prof_lon', varid2 )
                0238       err = NF_INQ_VARID(fid,'prof_lat', varid3 )
6b2230d510 Ou W*0239 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0240       err = NF_INQ_VARID(fid,'prof_bin_id_a', varid4 )
                0241 #endif
6a770e0a24 Patr*0242
c9bf163375 Ivan*0243       IF (err.NE.NF_NOERR) THEN
f0e4bffe35 Gael*0244         IL  = ILNBLNK( profilesfile )
                0245         WRITE(msgBuf,'(3A)')
                0246      & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0247      & '.nc is not in the pkg/profiles format (no prof_YYYYMMDD etc.)'
                0248         CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0249       stopProfiles=1
c9bf163375 Ivan*0250       ENDIF
ba63501b4c Gael*0251
c9bf163375 Ivan*0252       IF (profilesDoGenGrid) THEN
d5aa75d39a Jean*0253 c3) read interpolattion information (grid points, coeffs, etc.)
ba63501b4c Gael*0254            err = NF_INQ_VARID(fid,'prof_interp_XC11',varid_intp1)
                0255            err = NF_INQ_VARID(fid,'prof_interp_YC11',varid_intp2)
                0256            err = NF_INQ_VARID(fid,'prof_interp_XCNINJ',varid_intp11)
                0257            err = NF_INQ_VARID(fid,'prof_interp_YCNINJ',varid_intp22)
                0258            err = NF_INQ_VARID(fid,'prof_interp_weights',varid_intp3)
                0259            err = NF_INQ_VARID(fid,'prof_interp_i',varid_intp4)
                0260            err = NF_INQ_VARID(fid,'prof_interp_j',varid_intp5)
c9bf163375 Ivan*0261       IF (err.NE.NF_NOERR) THEN
f0e4bffe35 Gael*0262         IL  = ILNBLNK( profilesfile )
                0263         WRITE(msgBuf,'(3A)')
                0264      & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0265      & '.nc is missing interpolation information (profilesDoGenGrid)'
                0266         CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0267       stopGenericGrid=2
c9bf163375 Ivan*0268       ENDIF
                0269       ENDIF
ba63501b4c Gael*0270
                0271 c4) default values
c9bf163375 Ivan*0272       DO k=1,NOBSGLOB
c9c84c2afb Gael*0273       prof_time(num_file,k,bi,bj)=-999. _d 0
                0274       prof_lon(num_file,k,bi,bj)=-999. _d 0
                0275       prof_lat(num_file,k,bi,bj)=-999. _d 0
                0276       prof_ind_glob(num_file,k,bi,bj)=0
6b2230d510 Ou W*0277 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0278       prof_ind_avgbin(num_file,k,bi,bj)=-999
                0279 #endif
c9bf163375 Ivan*0280       DO q = 1,NUM_INTERP_POINTS
38287224dd Gael*0281          prof_interp_i(num_file,k,q,bi,bj) = 1
                0282          prof_interp_j(num_file,k,q,bi,bj) = 1
                0283          prof_interp_weights(num_file,k,q,bi,bj) = 0. _d 0
c9bf163375 Ivan*0284       ENDDO
c9c84c2afb Gael*0285       prof_interp_xC11(num_file,k,bi,bj)=-999. _d 0
                0286       prof_interp_yC11(num_file,k,bi,bj)=-999. _d 0
                0287       prof_interp_xCNINJ(num_file,k,bi,bj)=-999. _d 0
                0288       prof_interp_yCNINJ(num_file,k,bi,bj)=-999. _d 0
c9bf163375 Ivan*0289       ENDDO
6a770e0a24 Patr*0290
ba63501b4c Gael*0291 c5) main loop: look for profiles in this tile
a996b8bdc0 Gael*0292       ProfNo_tile=0
71a5587721 Gael*0293       profno_div1000=max(0,int(ProfNo(num_file,bi,bj)/1000))
6a770e0a24 Patr*0294
c9bf163375 Ivan*0295       DO kk=1,profno_div1000+1
6a770e0a24 Patr*0296
c9bf163375 Ivan*0297       IF (min(ProfNo(num_file,bi,bj), 1000*kk).GE.
                0298      &  1+1000*(kk-1)) THEN
6a770e0a24 Patr*0299
ba63501b4c Gael*0300 c5.1) read a chunk
6a770e0a24 Patr*0301       vec_start(1)=1
                0302       vec_start(2)=1+1000*(kk-1)
                0303       vec_count(1)=1
71a5587721 Gael*0304       vec_count(2)=min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
6a770e0a24 Patr*0305
c9bf163375 Ivan*0306       IF ( (vec_count(2).LE.0).OR.(vec_count(2).GT.1000).OR.
6a770e0a24 Patr*0307      & (vec_start(2).LE.0).OR.
d5aa75d39a Jean*0308      & (vec_count(2)+vec_start(2)-1.GT.ProfNo(num_file,bi,bj)) )
c9bf163375 Ivan*0309      & THEN
f0e4bffe35 Gael*0310         IL  = ILNBLNK( profilesfile )
                0311         WRITE(msgBuf,'(3A)')
                0312      & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0313      & '.nc was not read properly (case 1).'
                0314         CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0315       stopProfiles=1
c9bf163375 Ivan*0316       ENDIF
6a770e0a24 Patr*0317
                0318       err = NF_GET_VARA_DOUBLE(fid,varid1a,vec_start(2),
                0319      & vec_count(2), tmpyymmdd)
                0320       err = NF_GET_VARA_DOUBLE(fid,varid1b,vec_start(2),
                0321      & vec_count(2), tmphhmmss)
                0322       err = NF_GET_VARA_DOUBLE(fid,varid2,vec_start(2),
                0323      & vec_count(2), tmp_lon2)
                0324       err = NF_GET_VARA_DOUBLE(fid,varid3,vec_start(2),
                0325      & vec_count(2), tmp_lat2)
6b2230d510 Ou W*0326 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0327       err = NF_GET_VARA_DOUBLE(fid,varid4,vec_start(2),
                0328      & vec_count(2), tmp_avgbin)
                0329 #endif
6a770e0a24 Patr*0330
c9bf163375 Ivan*0331       IF (err.NE.NF_NOERR) THEN
f0e4bffe35 Gael*0332         WRITE(msgBuf,'(3A)')
                0333      & 'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0334      & '.nc was not read properly (case 2).'
                0335         CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0336       stopProfiles=1
c9bf163375 Ivan*0337       ENDIF
6a770e0a24 Patr*0338
39ce977435 Gael*0339 c if profilesDoGenGrid then also read in the interpolation coeffs and indices
c9bf163375 Ivan*0340       IF (profilesDoGenGrid) THEN
d5aa75d39a Jean*0341       err = NF_GET_VARA_DOUBLE(fid,varid_intp1,vec_start(2),
ba63501b4c Gael*0342      & vec_count(2), tmp_xC11)
d5aa75d39a Jean*0343       err = NF_GET_VARA_DOUBLE(fid,varid_intp2,vec_start(2),
ba63501b4c Gael*0344      & vec_count(2), tmp_yC11)
                0345       err = NF_GET_VARA_DOUBLE(fid,varid_intp11,vec_start(2),
                0346      & vec_count(2), tmp_xCNINJ)
d5aa75d39a Jean*0347       err = NF_GET_VARA_DOUBLE(fid,varid_intp22,vec_start(2),
ba63501b4c Gael*0348      & vec_count(2), tmp_yCNINJ)
c9bf163375 Ivan*0349       DO q=1,iINTERP
ba63501b4c Gael*0350         vec_start2(1)=q
                0351         vec_start2(2)=1+1000*(kk-1)
                0352         vec_count2(1)=1
                0353         vec_count2(2)=min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
d5aa75d39a Jean*0354         err = NF_GET_VARA_DOUBLE(fid,varid_intp3,vec_start2,
ba63501b4c Gael*0355      &  vec_count2, tmp_weights(1,q))
d5aa75d39a Jean*0356         err = NF_GET_VARA_DOUBLE(fid,varid_intp4,vec_start2,
ba63501b4c Gael*0357      &  vec_count2, tmp_i(1,q))
d5aa75d39a Jean*0358         err = NF_GET_VARA_DOUBLE(fid,varid_intp5,vec_start2,
ba63501b4c Gael*0359      &  vec_count2, tmp_j(1,q))
c9bf163375 Ivan*0360       ENDDO
                0361       ENDIF
ba63501b4c Gael*0362
                0363 c5.2) loop through this chunk
c9bf163375 Ivan*0364       DO k=1,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
6a770e0a24 Patr*0365
c9bf163375 Ivan*0366       IF ( stopProfiles .EQ. 0) THEN
ba63501b4c Gael*0367
b2a948f981 Gael*0368       profIsInRunTime=1
                0369
a996b8bdc0 Gael*0370       IF (( ( tmpyymmdd(k).GT.yymmddMin ).OR.(( tmpyymmdd(k).EQ.
5042c05de8 Gael*0371      &        yymmddMin ).AND.( tmphhmmss(k).GT.hhmmssMin ))).AND.
                0372      &    ( ( tmpyymmdd(k).LT.yymmddMax ).OR.(( tmpyymmdd(k).EQ.
a996b8bdc0 Gael*0373      &        yymmddMax ).AND.( tmphhmmss(k).LT.hhmmssMax ))) ) THEN
                0374         hh = int(tmphhmmss(k))/10000
                0375         IF ( hh.LT.hoursPerDay ) THEN
                0376           profIsInRunTime=1
c9bf163375 Ivan*0377           CALL cal_FullDate( int(tmpyymmdd(k)),int(tmphhmmss(k)),
                0378      &     tmpdate,myThid )
                0379           CALL cal_TimePassed( modelstartdate,tmpdate,tmpdiff,myThid )
                0380           CALL cal_ToSeconds (tmpdiff,diffsecs,myThid)
                0381           diffsecs=diffsecs+nIter0*deltaTClock
a996b8bdc0 Gael*0382         ELSE
                0383 c if tmphhmmss is out of range then disregard profile
                0384           profIsInRunTime=0
c9bf163375 Ivan*0385           diffsecs=-deltaTClock
a996b8bdc0 Gael*0386           ProfNo_hh=ProfNo_hh+1
                0387         ENDIF
                0388       ELSE
b2a948f981 Gael*0389         profIsInRunTime=0
c9bf163375 Ivan*0390         diffsecs=-deltaTClock
a996b8bdc0 Gael*0391       ENDIF
6a770e0a24 Patr*0392
39ce977435 Gael*0393 c ==============================================================================
                0394
                0395 c 5.2a) determine whether profiles is in current tile domain (lat-lon grid case)
c9bf163375 Ivan*0396        IF ((.NOT.profilesDoGenGrid).AND.(profIsInRunTime.EQ.1)) THEN
39ce977435 Gael*0397
c9bf163375 Ivan*0398        IF (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) THEN
c9c84c2afb Gael*0399         tmp_lon=xC(sNx+1,1,bi,bj)+360. _d 0
c9bf163375 Ivan*0400        ELSE
f527c11034 Gael*0401         tmp_lon=xC(sNx+1,1,bi,bj)
c9bf163375 Ivan*0402        ENDIF
39ce977435 Gael*0403
c9bf163375 Ivan*0404        IF ((xC(1,1,bi,bj).LE.tmp_lon2(k)).AND.
f527c11034 Gael*0405      & (tmp_lon.GT.tmp_lon2(k)).AND.
                0406      & (yC(1,1,bi,bj).LE.tmp_lat2(k)).AND.
c9bf163375 Ivan*0407      & (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k)) ) THEN
39ce977435 Gael*0408          lon_cur=tmp_lon2(k)
                0409          lat_cur=tmp_lat2(k)
c9bf163375 Ivan*0410        ELSEIF ((xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)).AND.
39ce977435 Gael*0411      &  (xC(1,1,bi,bj).LE.tmp_lon2(k)+360. _d 0).AND.
c9c84c2afb Gael*0412      &  (tmp_lon.GT.tmp_lon2(k)+360. _d 0).AND.
6a770e0a24 Patr*0413      &  (yC(1,1,bi,bj).LE.tmp_lat2(k)).AND.
                0414      &  (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k))
c9bf163375 Ivan*0415      &  ) THEN
39ce977435 Gael*0416          lon_cur=tmp_lon2(k)+360. _d 0
                0417          lat_cur=tmp_lat2(k)
c9bf163375 Ivan*0418        ELSE
39ce977435 Gael*0419          profIsInRunTime=0
c9bf163375 Ivan*0420        ENDIF
39ce977435 Gael*0421
                0422 c now determine value of i,j to the south-ouest of data point
                0423        prof_i=-10
                0424        prof_j=-10
                0425        lon_1=-10
                0426        lon_2=-10
                0427        lat_1=-10
                0428        lat_2=-10
                0429
c9bf163375 Ivan*0430        IF (profIsInRunTime.EQ.1) THEN
39ce977435 Gael*0431         DO j=1,sNy+1
                0432          DO i=1,sNx+1
                0433
                0434 c value of j, south of the data point:
c9bf163375 Ivan*0435         IF ((yC(i,j,bi,bj).LE.lat_cur).AND.
                0436      &      (yC(i,j+1,bi,bj).GT.lat_cur)) THEN
39ce977435 Gael*0437           prof_j=j
                0438           lat_1=yC(i,j,bi,bj)
                0439           lat_2=yC(i,j+1,bi,bj)
c9bf163375 Ivan*0440         ENDIF
39ce977435 Gael*0441
                0442 c value of i, west of the data point:
c9bf163375 Ivan*0443          IF (xC(i+1,j,bi,bj).LT.xC(1,j,bi,bj)) THEN
39ce977435 Gael*0444            lon_tmp2=xC(i+1,j,bi,bj)+360
c9bf163375 Ivan*0445          ELSE
39ce977435 Gael*0446            lon_tmp2=xC(i+1,j,bi,bj)
c9bf163375 Ivan*0447          ENDIF
                0448          IF (xC(i,j,bi,bj).LT.xC(1,j,bi,bj)) THEN
39ce977435 Gael*0449            lon_tmp1=xC(i,j,bi,bj)+360
c9bf163375 Ivan*0450          ELSE
39ce977435 Gael*0451            lon_tmp1=xC(i,j,bi,bj)
c9bf163375 Ivan*0452          ENDIF
39ce977435 Gael*0453
c9bf163375 Ivan*0454          IF ((lon_tmp1.LE.lon_cur).AND.(lon_tmp2.GT.lon_cur)) THEN
39ce977435 Gael*0455            prof_i=i
                0456            lon_1=lon_tmp1
                0457            lon_2=lon_tmp2
c9bf163375 Ivan*0458          ENDIF
39ce977435 Gael*0459
                0460         ENDDO
                0461        ENDDO
c9bf163375 Ivan*0462       ENDIF
39ce977435 Gael*0463
c9bf163375 Ivan*0464       IF ((prof_i.EQ.-10).OR.(prof_j.EQ.-10)) profIsInRunTime=0
39ce977435 Gael*0465
c9bf163375 Ivan*0466       IF (profIsInRunTime.EQ.1) THEN
39ce977435 Gael*0467 c if yes then store prof_time and longitude and latitude:
a996b8bdc0 Gael*0468         ProfNo_tile=ProfNo_tile+1
                0469         prof_time(num_file,ProfNo_tile,bi,bj)=diffsecs
                0470         prof_lon(num_file,ProfNo_tile,bi,bj)=lon_cur
                0471         prof_lat(num_file,ProfNo_tile,bi,bj)=lat_cur
                0472         prof_ind_glob(num_file,ProfNo_tile,bi,bj)=k+1000*(kk-1)
6b2230d510 Ou W*0473 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0474         prof_ind_avgbin(num_file,ProfNo_tile,bi,bj)=tmp_avgbin(k)
                0475 #endif
39ce977435 Gael*0476 c then store interpolation coeffs and indices
                0477         lon_fac=(lon_cur-lon_1)/(lon_2-lon_1)
                0478         lat_fac=(lat_cur-lat_1)/(lat_2-lat_1)
a996b8bdc0 Gael*0479         prof_interp_weights(num_file,ProfNo_tile,1,bi,bj)=
39ce977435 Gael*0480      &     (1-lon_fac)*(1-lat_fac)
a996b8bdc0 Gael*0481         prof_interp_i(num_file,ProfNo_tile,1,bi,bj)=prof_i
                0482         prof_interp_j(num_file,ProfNo_tile,1,bi,bj)=prof_j
                0483         prof_interp_weights(num_file,ProfNo_tile,2,bi,bj)=
39ce977435 Gael*0484      &     lon_fac*(1-lat_fac)
a996b8bdc0 Gael*0485         prof_interp_i(num_file,ProfNo_tile,2,bi,bj)=prof_i+1
                0486         prof_interp_j(num_file,ProfNo_tile,2,bi,bj)=prof_j
                0487         prof_interp_weights(num_file,ProfNo_tile,3,bi,bj)=
39ce977435 Gael*0488      &     (1-lon_fac)*lat_fac
a996b8bdc0 Gael*0489         prof_interp_i(num_file,ProfNo_tile,3,bi,bj)=prof_i
                0490         prof_interp_j(num_file,ProfNo_tile,3,bi,bj)=prof_j+1
                0491         prof_interp_weights(num_file,ProfNo_tile,4,bi,bj)=
39ce977435 Gael*0492      &     lon_fac*lat_fac
a996b8bdc0 Gael*0493         prof_interp_i(num_file,ProfNo_tile,4,bi,bj)=prof_i+1
                0494         prof_interp_j(num_file,ProfNo_tile,4,bi,bj)=prof_j+1
39ce977435 Gael*0495
c9bf163375 Ivan*0496       ENDIF
39ce977435 Gael*0497
                0498 c ==============================================================================
                0499
                0500 c 5.2a) determine whether profiles is in current tile domain (generic grid case)
                0501
c9bf163375 Ivan*0502        ELSEIF (profIsInRunTime.EQ.1) THEN
39ce977435 Gael*0503
c9bf163375 Ivan*0504        IF (stopGenericGrid.EQ.0) THEN
ba63501b4c Gael*0505
c9bf163375 Ivan*0506        IF ( ( abs( tmp_xC11(k) - xC(1,1,bi,bj) ).LT.0.0001 _d 0 ) .AND.
c9c84c2afb Gael*0507      & ( abs( tmp_yC11(k) - yC(1,1,bi,bj) ).LT.0.0001 _d 0) .AND.
                0508      & ( abs( tmp_xCNINJ(k) - xC(sNx,sNy,bi,bj) ).LT.0.0001 _d 0 ) .AND.
                0509      & ( abs( tmp_yCNINJ(k) - yC(sNx,sNy,bi,bj) ).LT.0.0001 _d 0 )
c9bf163375 Ivan*0510      & .AND.(profIsInRunTime.EQ.1)) THEN
ba63501b4c Gael*0511
39ce977435 Gael*0512 c if yes then store prof_time and interpolation coeffs and indices:
a996b8bdc0 Gael*0513        ProfNo_tile=ProfNo_tile+1
                0514        prof_time(num_file,ProfNo_tile,bi,bj)=diffsecs
6b2230d510 Ou W*0515 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0516          prof_ind_avgbin(num_file,ProfNo_tile,bi,bj)=tmp_avgbin(k)
                0517 #endif
a996b8bdc0 Gael*0518        prof_interp_xC11(num_file,ProfNo_tile,bi,bj)=tmp_xC11(k)
                0519        prof_interp_yC11(num_file,ProfNo_tile,bi,bj)=tmp_yC11(k)
                0520        prof_interp_xCNINJ(num_file,ProfNo_tile,bi,bj)=tmp_xCNINJ(k)
                0521        prof_interp_yCNINJ(num_file,ProfNo_tile,bi,bj)=tmp_yCNINJ(k)
ba63501b4c Gael*0522        tmp_sum_weights=0. _d 0
c9bf163375 Ivan*0523         DO q = 1,iINTERP
a996b8bdc0 Gael*0524              prof_interp_weights(num_file,ProfNo_tile,q,bi,bj)
ba63501b4c Gael*0525      &       =tmp_weights(k,q)
a996b8bdc0 Gael*0526              prof_interp_i(num_file,ProfNo_tile,q,bi,bj)
ba63501b4c Gael*0527      &       =tmp_i(k,q)
a996b8bdc0 Gael*0528              prof_interp_j(num_file,ProfNo_tile,q,bi,bj)
ba63501b4c Gael*0529      &       =tmp_j(k,q)
                0530              tmp_sum_weights=tmp_sum_weights+tmp_weights(k,q)
d5aa75d39a Jean*0531 c more test of the inputs: is the offline-computed
ba63501b4c Gael*0532 c interpolation information consistent (self and with grid)
c9bf163375 Ivan*0533        IF ( (tmp_i(k,q).LT.0).OR.(tmp_j(k,q).LT.0)
                0534      & .OR.(tmp_i(k,q).GT.sNx+1).OR.(tmp_j(k,q).GT.sNy+1) ) THEN
f0e4bffe35 Gael*0535           WRITE(msgBuf,'(4A)')
                0536      &     'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0537      &     '.nc includes inconsistent interpolation ',
                0538      &     'points (profilesDoGenGrid; out of tile)'
                0539           CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0540           stopGenericGrid=1
c9bf163375 Ivan*0541        ENDIF
4591803d6b Gael*0542 #ifdef ALLOW_PROFILES_EXCLUDE_CORNERS
c9bf163375 Ivan*0543        IF ( tmp_weights(k,q) .NE. 0. _d 0) THEN
                0544        IF ( ((tmp_i(k,q).EQ.0).AND.(tmp_j(k,q).EQ.0))
ba63501b4c Gael*0545      & .OR.((tmp_i(k,q).EQ.sNx+1).AND.(tmp_j(k,q).EQ.sNy+1))
                0546      & .OR.((tmp_i(k,q).EQ.0).AND.(tmp_j(k,q).EQ.sNy+1))
c9bf163375 Ivan*0547      & .OR.((tmp_i(k,q).EQ.sNx+1).AND.(tmp_j(k,q).EQ.0)) ) THEN
f0e4bffe35 Gael*0548           WRITE(msgBuf,'(4A)')
                0549      &     'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0550      &     '.nc includes inconsistent interpolation ',
                0551      &     'points (profilesDoGenGrid; using overlap corners)'
                0552           CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0553           stopGenericGrid=1
c9bf163375 Ivan*0554        ENDIF
                0555        ENDIF
4591803d6b Gael*0556 #endif /* ALLOW_PROFILES_EXCLUDE_CORNERS */
c9bf163375 Ivan*0557        IF ( (tmp_weights(k,q).LT.0. _d 0).OR.
                0558      &    (tmp_weights(k,q).GT.1. _d 0) ) THEN
f0e4bffe35 Gael*0559           WRITE(msgBuf,'(4A)')
                0560      &     'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0561      &     '.nc includes inconsistent interpolation ',
                0562      &     'weights (profilesDoGenGrid; sum oustide 0-1)'
                0563           CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0564           stopGenericGrid=1
c9bf163375 Ivan*0565        ENDIF
ba63501b4c Gael*0566
c9bf163375 Ivan*0567        ENDDO
ba63501b4c Gael*0568
c9bf163375 Ivan*0569        IF ( abs(tmp_sum_weights -1. _d 0 ) .GT. 0.0001 _d 0) THEN
f0e4bffe35 Gael*0570           WRITE(msgBuf,'(4A)')
                0571      &     'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0572      &     '.nc includes inconsistent interpolation ',
                0573      &     'weights (profilesDoGenGrid; dont add up to 1)'
                0574           CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0575           stopGenericGrid=1
c9bf163375 Ivan*0576        ENDIF
ba63501b4c Gael*0577
a996b8bdc0 Gael*0578          prof_ind_glob(num_file,ProfNo_tile,bi,bj)=k+1000*(kk-1)
ba63501b4c Gael*0579
c9bf163375 Ivan*0580        ENDIF
                0581        ENDIF
                0582        ENDIF   !if (.NOT.profilesDoGenGrid) THEN
39ce977435 Gael*0583
                0584 c ==============================================================================
                0585
                0586 c check that maximum size was not reached:
c9bf163375 Ivan*0587        IF (ProfNo_tile.GE.NOBSGLOB) THEN
39ce977435 Gael*0588          WRITE(msgBuf,'(3A)')
                0589      &    'PROFILES_INIT_FIXED: file ', profilesfile(1:IL),
                0590      &    '.nc was not read properly (increase NOBSGLOB).'
                0591          CALL PRINT_ERROR( msgBuf, myThid)
                0592          stopProfiles=1
c9bf163375 Ivan*0593        ENDIF
39ce977435 Gael*0594
c9bf163375 Ivan*0595       ENDIF    !if ( stopProfiles .EQ. 0) THEN
                0596       ENDDO    !do k=1,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
                0597       ENDIF    !if (min(ProfNo(num_file,bi,bj), 1000...
                0598       ENDDO    !do kk=1,profno_div1000+1
d5aa75d39a Jean*0599
a996b8bdc0 Gael*0600       ProfNo(num_file,bi,bj)=ProfNo_tile
                0601
c9bf163375 Ivan*0602       WRITE(msgBuf,'(a,i9)')
a996b8bdc0 Gael*0603      &   '  # of profiles with erroneous HHMMSS values =',
                0604      &   ProfNo_hh
c9bf163375 Ivan*0605       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0606      &                    SQUEEZE_RIGHT, myThid )
ba63501b4c Gael*0607
c9bf163375 Ivan*0608       WRITE(msgBuf,'(a,i9)')
a996b8bdc0 Gael*0609      &   '  # of profiles within tile and time period  =',
                0610      &   ProfNo(num_file,bi,bj)
c9bf163375 Ivan*0611       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0612      &                    SQUEEZE_RIGHT, myThid )
ba63501b4c Gael*0613
0e6a4460e5 Ivan*0614 c6) available variables in the data set
6a770e0a24 Patr*0615
c9bf163375 Ivan*0616       DO k=1,NVARMAX
3c8dcfdea9 Gael*0617         prof_num_var_cur(num_file,k,bi,bj)=0
c9bf163375 Ivan*0618       ENDDO
71a5587721 Gael*0619       prof_num_var_tot(num_file,bi,bj)=0
6a770e0a24 Patr*0620
c9bf163375 Ivan*0621       DO k=1,NVARMAX
cf16ba6028 Gael*0622         JL  = ILNBLNK( prof_names(num_file,k) )
                0623         err = NF_INQ_VARID(fid,prof_names(num_file,k)(1:JL), varid1 )
c9bf163375 Ivan*0624         IF (err.EQ.NF_NOERR) THEN
3c8dcfdea9 Gael*0625           vec_quantities(num_file,k,bi,bj)=.TRUE.
                0626           prof_num_var_tot(num_file,bi,bj)=
                0627      &     prof_num_var_tot(num_file,bi,bj)+1
                0628           prof_num_var_cur(num_file,k,bi,bj)=
                0629      &     prof_num_var_tot(num_file,bi,bj)
c9bf163375 Ivan*0630         ELSE
3c8dcfdea9 Gael*0631           vec_quantities(num_file,k,bi,bj)=.FALSE.
c9bf163375 Ivan*0632         ENDIF
                0633       ENDDO
6a770e0a24 Patr*0634
c9bf163375 Ivan*0635       DO k=1,NVARMAX
                0636         IF (vec_quantities(num_file,k,bi,bj)) THEN
38287224dd Gael*0637           KL  = ILNBLNK( prof_names(num_file,k) )
                0638           JL  = ILNBLNK( prof_namesmod(num_file,k) )
c9bf163375 Ivan*0639           IF (prof_namesmod(num_file,k).EQ.'pTracer') THEN
                0640       WRITE(msgBuf,'(a,I3,5a,I3)') '  variable #',k,' is ' ,
38287224dd Gael*0641      & prof_names(num_file,k)(1:KL),' and ',
                0642      & prof_namesmod(num_file,k)(1:JL),' #',
                0643      & prof_itracer(num_file,k)
c9bf163375 Ivan*0644           ELSE
                0645       WRITE(msgBuf,'(a,I3,4a)') '  variable #',k,
a996b8bdc0 Gael*0646      & ' is            ' ,
38287224dd Gael*0647      & prof_names(num_file,k)(1:KL),' and ',
                0648      & prof_namesmod(num_file,k)(1:JL)
c9bf163375 Ivan*0649           ENDIF
                0650           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0651      &                        SQUEEZE_RIGHT, myThid )
                0652         ENDIF
                0653       ENDDO
6a770e0a24 Patr*0654
                0655 C===========================================================
                0656 c create files for model counterparts to observations
                0657 C===========================================================
                0658
c9bf163375 Ivan*0659            IF (ProfNo(num_file,bi,bj).GT.0) THEN
6a770e0a24 Patr*0660          iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
                0661          jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
                0662
1ff0163ead Gael*0663       JL  = ILNBLNK( profilesDir )
                0664
c9bf163375 Ivan*0665       IF (profilesDoNcOutput) THEN
d5aa75d39a Jean*0666
0e6a4460e5 Ivan*0667       WRITE(fnameequinc,'(3a,2(i3.3,a))')
1ff0163ead Gael*0668      & profilesDir(1:JL),profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc'
0e6a4460e5 Ivan*0669       WRITE(adfnameequinc,'(4a,2(i3.3,a))')
1ff0163ead Gael*0670      & profilesDir(1:JL),'ad',
6a770e0a24 Patr*0671      & profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc'
0e6a4460e5 Ivan*0672       WRITE(tlfnameequinc,'(4a,2(i3.3,a))')
c9bf163375 Ivan*0673      & profilesDir(1:JL),'tl',
                0674      & profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc'
6a770e0a24 Patr*0675
                0676       inquire( file=fnameequinc, exist=exst )
c9bf163375 Ivan*0677       IF (.NOT.exst) THEN
                0678         CALL profiles_init_ncfile(num_file,
b2a948f981 Gael*0679      &   fiddata(num_file,bi,bj),fnameequinc,
                0680      &   fidforward(num_file,bi,bj),ProfNo(num_file,bi,bj),
                0681      &   ProfDepthNo(num_file,bi,bj),
                0682      &   bi,bj,myThid)
c9bf163375 Ivan*0683       ELSE
b2a948f981 Gael*0684         err = NF_OPEN(fnameequinc,NF_WRITE,fidforward(num_file,bi,bj))
c9bf163375 Ivan*0685       ENDIF
b2a948f981 Gael*0686 #ifdef ALLOW_ADJOINT_RUN
                0687       inquire( file=adfnameequinc, exist=exst )
c9bf163375 Ivan*0688       IF (.NOT.exst) THEN
                0689         CALL profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
b2a948f981 Gael*0690      &   adfnameequinc, fidadjoint(num_file,bi,bj),
                0691      &   ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj),
                0692      & bi,bj, myThid)
c9bf163375 Ivan*0693       ELSE
b2a948f981 Gael*0694         err = NF_OPEN(adfnameequinc,NF_WRITE,fidadjoint(num_file,bi,bj))
c9bf163375 Ivan*0695       ENDIF
b2a948f981 Gael*0696 #endif
c9bf163375 Ivan*0697 #ifdef ALLOW_TANGENTLINEAR_RUN
                0698       inquire( file=tlfnameequinc, exist=exst )
                0699       IF (.NOT.exst) THEN
                0700         CALL profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
                0701      &   tlfnameequinc, fidtangent(num_file,bi,bj),
                0702      &   ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj),
                0703      & bi,bj, myThid)
                0704       ELSE
                0705         err = NF_OPEN(tlfnameequinc,NF_WRITE,fidtangent(num_file,bi,bj))
                0706       ENDIF
                0707 #endif
                0708       ELSE
6a770e0a24 Patr*0709
0e6a4460e5 Ivan*0710       WRITE(fnameequinc,'(3a,2(i3.3,a))')
1ff0163ead Gael*0711      & profilesDir(1:JL),profilesfile(1:IL),'.',iG,'.',jG,'.equi.data'
0e6a4460e5 Ivan*0712       WRITE(adfnameequinc,'(4a,2(i3.3,a))')
1ff0163ead Gael*0713      & profilesDir(1:JL),'ad',
64e4a6baa3 Jean*0714      & profilesfile(1:IL),'.',iG,'.',jG,'.equi.data'
0e6a4460e5 Ivan*0715       WRITE(tlfnameequinc,'(4a,2(i3.3,a))')
c9bf163375 Ivan*0716      & profilesDir(1:JL),'tl',
                0717      & profilesfile(1:IL),'.',iG,'.',jG,'.equi.data'
6a770e0a24 Patr*0718
                0719       inquire( file=fnameequinc, exist=exst )
4caf2dc194 Gael*0720 #ifdef PROFILES_USE_MDSFINDUNITS
c9bf163375 Ivan*0721       CALL MDSFINDUNIT( fidforward(num_file,bi,bj) , myThid )
4caf2dc194 Gael*0722 #else
c9bf163375 Ivan*0723       CALL PROFILES_FINDUNIT( fidforward(num_file,bi,bj) , myThid )
4caf2dc194 Gael*0724 #endif
c9bf163375 Ivan*0725       IF (.NOT.exst) THEN
                0726         CALL profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
b2a948f981 Gael*0727      &   fnameequinc,fidforward(num_file,bi,bj),
                0728      &   ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj),
                0729      &   bi,bj,myThid)
c9bf163375 Ivan*0730       ELSE
b2a948f981 Gael*0731          open( fidforward(num_file,bi,bj),file=fnameequinc,
                0732      &   form ='unformatted',status='unknown', access='direct',
                0733      &   recl=  (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
c9bf163375 Ivan*0734       ENDIF
51c7f9a83e Gael*0735 #ifdef ALLOW_ADJOINT_RUN
b2a948f981 Gael*0736       inquire( file=adfnameequinc, exist=exst )
4caf2dc194 Gael*0737 #ifdef PROFILES_USE_MDSFINDUNITS
c9bf163375 Ivan*0738       CALL MDSFINDUNIT( fidadjoint(num_file,bi,bj) , myThid )
4caf2dc194 Gael*0739 #else
c9bf163375 Ivan*0740       CALL PROFILES_FINDUNIT( fidadjoint(num_file,bi,bj) , myThid )
4caf2dc194 Gael*0741 #endif
c9bf163375 Ivan*0742       IF (.NOT.exst) THEN
                0743         CALL profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
b2a948f981 Gael*0744      &   adfnameequinc, fidadjoint(num_file,bi,bj),
                0745      &   ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj),
                0746      &   bi,bj, myThid)
c9bf163375 Ivan*0747       ELSE
b2a948f981 Gael*0748          open( fidadjoint(num_file,bi,bj),file=adfnameequinc,
                0749      &   form ='unformatted',status='unknown', access='direct',
                0750      &   recl=  (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
c9bf163375 Ivan*0751       ENDIF
                0752 #endif
                0753 #ifdef ALLOW_TANGENTLINEAR_RUN
                0754       inquire( file=tlfnameequinc, exist=exst )
                0755 #ifdef PROFILES_USE_MDSFINDUNITS
                0756       CALL MDSFINDUNIT( fidtangent(num_file,bi,bj) , myThid )
                0757 #else
                0758       CALL PROFILES_FINDUNIT( fidtangent(num_file,bi,bj) , myThid )
                0759 #endif
                0760       IF (.NOT.exst) THEN
                0761         CALL profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
                0762      &   tlfnameequinc, fidtangent(num_file,bi,bj),
                0763      &   ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj),
                0764      &   bi,bj, myThid)
                0765       ELSE
                0766          open( fidtangent(num_file,bi,bj),file=tlfnameequinc,
                0767      &   form ='unformatted',status='unknown', access='direct',
                0768      &   recl=  (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
                0769       ENDIF
b2a948f981 Gael*0770 #endif
6a770e0a24 Patr*0771
c9bf163375 Ivan*0772       ENDIF
6a770e0a24 Patr*0773
c9bf163375 Ivan*0774            ENDIF
6a770e0a24 Patr*0775
                0776 C===========================================================
c9bf163375 Ivan*0777       ELSE
71a5587721 Gael*0778       ProfNo(num_file,bi,bj)=0
c9bf163375 Ivan*0779       DO k=1,NVARMAX
71a5587721 Gael*0780       prof_num_var_cur(num_file,k,bi,bj)=0
                0781       vec_quantities(num_file,k,bi,bj)=.FALSE.
c9bf163375 Ivan*0782       ENDDO
71a5587721 Gael*0783       prof_num_var_tot(num_file,bi,bj)=0
c9bf163375 Ivan*0784       DO k=1,NOBSGLOB
c9c84c2afb Gael*0785       prof_time(num_file,k,bi,bj)=-999. _d 0
                0786       prof_lon(num_file,k,bi,bj)=-999. _d 0
                0787       prof_lat(num_file,k,bi,bj)=-999. _d 0
                0788       prof_ind_glob(num_file,k,bi,bj)=0
6b2230d510 Ou W*0789 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0790       prof_ind_avgbin(num_file,k,bi,bj)=-999
                0791 #endif
c9bf163375 Ivan*0792       DO q = 1,NUM_INTERP_POINTS
38287224dd Gael*0793          prof_interp_i(num_file,k,q,bi,bj) = 1
                0794          prof_interp_j(num_file,k,q,bi,bj) = 1
                0795          prof_interp_weights(num_file,k,q,bi,bj) = 0. _d 0
c9bf163375 Ivan*0796       ENDDO
c9c84c2afb Gael*0797       prof_interp_xC11(num_file,k,bi,bj)=-999. _d 0
                0798       prof_interp_yC11(num_file,k,bi,bj)=-999. _d 0
                0799       prof_interp_xCNINJ(num_file,k,bi,bj)=-999. _d 0
                0800       prof_interp_yCNINJ(num_file,k,bi,bj)=-999. _d 0
c9bf163375 Ivan*0801       ENDDO
6a770e0a24 Patr*0802
c9bf163375 Ivan*0803       ENDIF !if (IL.NE.0) THEN
                0804       ENDDO !      DO num_file=1,NFILESPROFMAX
ba63501b4c Gael*0805
6b2230d510 Ou W*0806 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
c9bf163375 Ivan*0807 C Find the unique depth levels from all profile datasets
6b2230d510 Ou W*0808 C initialize prof_depth_comb
c9bf163375 Ivan*0809       if(bi.EQ.1.AND.bj.EQ.1)THEN
6b2230d510 Ou W*0810          NLEVELCOMB = 0
                0811          NLEVELCOMBRL = NLEVELCOMB
c9bf163375 Ivan*0812       ENDIF
                0813       DO m=1,NLEVELCOMBMAX
6b2230d510 Ou W*0814          prof_depth_comb(m,bi,bj)=-999. _d 0
c9bf163375 Ivan*0815       ENDDO
6b2230d510 Ou W*0816
                0817       m = 1
c9bf163375 Ivan*0818       DO num_file=1,NFILESPROFMAX
                0819        DO k=1,ProfDepthNo(num_file,bi,bj)
6b2230d510 Ou W*0820
c9bf163375 Ivan*0821           if(m.EQ.1) THEN
6b2230d510 Ou W*0822            prof_depth_comb(m,bi,bj) = prof_depth(num_file, k,bi,bj)
                0823            m = m + 1
c9bf163375 Ivan*0824           ELSE
6b2230d510 Ou W*0825 C sort
c9bf163375 Ivan*0826            DO l=1,NLEVELCOMBMAX-1
                0827             if(prof_depth_comb(l,bi,bj) .NE. -999. _d 0) THEN
6b2230d510 Ou W*0828
c9bf163375 Ivan*0829               if(prof_depth(num_file, k,bi,bj).LT.
                0830      &           prof_depth_comb(l,bi,bj).AND.
                0831      &           l.EQ.1)  THEN
6b2230d510 Ou W*0832                  prof_depth_comb(NLEVELCOMBMAX,bi,bj) =
                0833      &            prof_depth_comb(l,bi,bj)
                0834                  prof_depth_comb(l,bi,bj)=
                0835      &            prof_depth(num_file, k,bi,bj)
c9bf163375 Ivan*0836                  DO il = NLEVELCOMBMAX-1, l+2,-1
6b2230d510 Ou W*0837                     prof_depth_comb(il,bi,bj)=
                0838      &            prof_depth_comb(il-1,bi,bj)
c9bf163375 Ivan*0839                  ENDDO
6b2230d510 Ou W*0840                  prof_depth_comb(l+1,bi,bj)=
                0841      &            prof_depth_comb(NLEVELCOMBMAX,bi,bj)
c9bf163375 Ivan*0842               ELSE if(prof_depth(num_file, k,bi,bj).GT.
                0843      &           prof_depth_comb(l,bi,bj).AND.
                0844      &           prof_depth(num_file, k,bi,bj).LT.
                0845      &           prof_depth_comb(l+1,bi,bj))  THEN
6b2230d510 Ou W*0846
                0847                  prof_depth_comb(NLEVELCOMBMAX,bi,bj) =
                0848      &            prof_depth_comb(l+1,bi,bj)
                0849                  prof_depth_comb(l+1,bi,bj)=
                0850      &            prof_depth(num_file, k,bi,bj)
c9bf163375 Ivan*0851                  DO il = NLEVELCOMBMAX-1, l+3,-1
6b2230d510 Ou W*0852                     prof_depth_comb(il,bi,bj)=
                0853      &            prof_depth_comb(il-1,bi,bj)
c9bf163375 Ivan*0854                  ENDDO
6b2230d510 Ou W*0855                  prof_depth_comb(l+2,bi,bj)=
                0856      &            prof_depth_comb(NLEVELCOMBMAX,bi,bj)
c9bf163375 Ivan*0857               ELSE IF ( prof_depth(num_file, k,bi,bj).GT.
                0858      &           prof_depth_comb(l,bi,bj).AND.
                0859      &           prof_depth_comb(l+1,bi,bj).EQ.-999. _d 0)  THEN
6b2230d510 Ou W*0860                  prof_depth_comb(l+1,bi,bj) =
                0861      &              prof_depth(num_file, k,bi,bj)
c9bf163375 Ivan*0862               ENDIF
                0863              ENDIF
                0864            ENDDO
6b2230d510 Ou W*0865
c9bf163375 Ivan*0866           ENDIF
                0867           if(m.GE.NLEVELCOMBMAX-2)THEN
6b2230d510 Ou W*0868             WRITE(msgBuf,'(A)')
                0869      &      'increase NLEVELCOMBMAX'
                0870             CALL PRINT_ERROR( msgBuf, myThid)
c9bf163375 Ivan*0871            ENDIF
                0872        ENDDO ! DO k=1,ProfDepthNo(num_file,bi,bj)
                0873       ENDDO ! DO num_file=1,NFILESPROFMAX
6b2230d510 Ou W*0874       prof_depth_comb(NLEVELCOMBMAX,bi,bj) = -999. _d 0
                0875
                0876 C diagnostics output
c9bf163375 Ivan*0877       DO m=1,NLEVELCOMBMAX
6b2230d510 Ou W*0878          if(prof_depth_comb(m,bi,bj) .GE. 0. _d 0
c9bf163375 Ivan*0879      &     .AND. NLEVELCOMB.LT.m)THEN
6b2230d510 Ou W*0880            NLEVELCOMB = m
c9bf163375 Ivan*0881            if(m.GE.NLEVELCOMBMAX-2)THEN
6b2230d510 Ou W*0882             WRITE(msgBuf,'(A,2i6)')
                0883      &      'increase NLEVELCOMBMAX: m,NLEVELCOMBMA  ',
                0884      &      m, NLEVELCOMBMAX
                0885             CALL PRINT_ERROR( msgBuf, myThid)
c9bf163375 Ivan*0886            ENDIF
                0887          ENDIF
                0888       ENDDO
6b2230d510 Ou W*0889       WRITE(msgBuf,'(A, i6,d20.5)')
                0890      &      'NLEVELCOMB = ', NLEVELCOMB
c9bf163375 Ivan*0891       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0892      &                    SQUEEZE_RIGHT, myThid )
6b2230d510 Ou W*0893 #endif
                0894
6a770e0a24 Patr*0895 C===========================================================
ba63501b4c Gael*0896 C error cases:
                0897 C===========================================================
                0898
                0899 c1) you want to provide interpolation information
                0900
c9bf163375 Ivan*0901        IF ( stopGenericGrid.EQ.2) THEN
ba63501b4c Gael*0902          iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
                0903          jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
                0904 cgf XC grid
c9bf163375 Ivan*0905        CALL MDSFINDUNIT( fid , myThid )
0e6a4460e5 Ivan*0906        WRITE(fnameequinc,'(a,2(i3.3,a),2(i4.4,a))')
ba63501b4c Gael*0907      & 'profilesXCincl1PointOverlap.',iG,'.',jG,'.',sNx,'.',sNy,'.data'
c9bf163375 Ivan*0908          k=MDS_RECLEN(64,(sNx+2)*(sNy+2),myThid)
ba63501b4c Gael*0909             WRITE(standardMessageUnit,'(A,/,2A)')
                0910      & 'PROFILES_INIT_FIXED: creating grid from profiles; file:',
                0911      & fnameequinc
d5aa75d39a Jean*0912        open( fid, file= fnameequinc, form ='unformatted',
ba63501b4c Gael*0913      &      status='unknown',access='direct', recl= k)
                0914         DO m=0,sNy+1
                0915          DO l=0,sNx+1
                0916         xy_buffer_r8(l,m)=xC(l,m,bi,bj)
                0917          ENDDO
                0918         ENDDO
                0919 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0920             CALL MDS_BYTESWAPR8((sNx+2)*(sNy+2),xy_buffer_r8)
ba63501b4c Gael*0921 #endif
c9bf163375 Ivan*0922        WRITE(fid,rec=1) xy_buffer_r8
ba63501b4c Gael*0923        close(fid)
                0924 cgf YC grid
c9bf163375 Ivan*0925        CALL MDSFINDUNIT( fid , myThid )
0e6a4460e5 Ivan*0926        WRITE(fnameequinc,'(a,2(i3.3,a),2(i4.4,a))')
ba63501b4c Gael*0927      & 'profilesYCincl1PointOverlap.',iG,'.',jG,'.',sNx,'.',sNy,'.data'
c9bf163375 Ivan*0928          k=MDS_RECLEN(64,(sNx+2)*(sNy+2),myThid)
ba63501b4c Gael*0929             WRITE(standardMessageUnit,'(A,/,A)')
                0930      & 'PROFILES_INIT_FIXED: creating grid from profiles; file:',
                0931      & fnameequinc
d5aa75d39a Jean*0932        open( fid, file= fnameequinc, form ='unformatted',
ba63501b4c Gael*0933      & status='unknown', access='direct', recl= k)
                0934         DO m=0,sNy+1
                0935          DO l=0,sNx+1
                0936                 xy_buffer_r8(l,m)=yC(l,m,bi,bj)
                0937          ENDDO
                0938         ENDDO
                0939 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0940             CALL MDS_BYTESWAPR8((sNx+2)*(sNy+2),xy_buffer_r8)
ba63501b4c Gael*0941 #endif
c9bf163375 Ivan*0942        WRITE(fid,rec=1) xy_buffer_r8
ba63501b4c Gael*0943        close(fid)
f0e4bffe35 Gael*0944
                0945        WRITE(msgBuf,'(3A)')
                0946      & 'PROFILES_INIT_FIXED : ',
39ce977435 Gael*0947      & 'when using profilesDoGenGrid ',
f0e4bffe35 Gael*0948      & 'you have to provide interpolation coeffs etc. '
                0949        CALL PRINT_ERROR( msgBuf, myThid)
                0950        WRITE(msgBuf,'(2A)')
                0951      & 'and some of your nc files dont have them. ',
                0952      & 'You could use profiles_prep_mygrid.m and/or'
                0953        CALL PRINT_ERROR( msgBuf, myThid)
                0954        WRITE(msgBuf,'(A)')
                0955      & 'use the grid info in profiles*incl1PointOverlap*data'
                0956        CALL PRINT_ERROR( msgBuf, myThid)
c9c84c2afb Gael*0957        stopProfiles=1
ba63501b4c Gael*0958
c9bf163375 Ivan*0959       ENDIF
ba63501b4c Gael*0960
71a5587721 Gael*0961       ENDDO
                0962       ENDDO
                0963
6b2230d510 Ou W*0964 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
                0965       NLEVELCOMBRL = NLEVELCOMB
                0966       _GLOBAL_MAX_RL( NLEVELCOMBRL, myThid )
                0967       NLEVELCOMB = NLEVELCOMBRL
                0968 #endif
                0969
c9bf163375 Ivan*0970       _END_MASTER( myThid )
ba63501b4c Gael*0971       _BARRIER
                0972
                0973 c2) stop after other kind of errors
c9c84c2afb Gael*0974       CALL GLOBAL_SUM_INT( stopProfiles , myThid )
c9bf163375 Ivan*0975       IF ( stopProfiles.GE.1) THEN
b00d6c1700 Gael*0976         CALL ALL_PROC_DIE( myThid )
                0977         STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
c9bf163375 Ivan*0978       ENDIF
39ce977435 Gael*0979
c9c84c2afb Gael*0980       CALL GLOBAL_SUM_INT( stopGenericGrid , myThid )
c9bf163375 Ivan*0981       IF ( stopGenericGrid.GE.1) THEN
b00d6c1700 Gael*0982         CALL ALL_PROC_DIE( myThid )
                0983         STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
c9bf163375 Ivan*0984       ENDIF
ba63501b4c Gael*0985
c9bf163375 Ivan*0986       WRITE(msgBuf,'(a)') ' '
                0987       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0988      &                    SQUEEZE_RIGHT, myThid )
                0989       WRITE(msgBuf,'(a)')
f0e4bffe35 Gael*0990      &'// ======================================================='
c9bf163375 Ivan*0991       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0992      &                    SQUEEZE_RIGHT, myThid )
                0993       WRITE(msgBuf,'(a)')
f0e4bffe35 Gael*0994      &'// insitu profiles model sampling >>> END <<<'
c9bf163375 Ivan*0995       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0996      &                    SQUEEZE_RIGHT, myThid )
                0997       WRITE(msgBuf,'(a)')
f0e4bffe35 Gael*0998      &'// ======================================================='
c9bf163375 Ivan*0999       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                1000      &                    SQUEEZE_RIGHT, myThid )
                1001       WRITE(msgBuf,'(a)') ' '
                1002       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                1003      &                    SQUEEZE_RIGHT, myThid )
                1004
                1005 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                1006 #endif /* ALLOW_PROFILES */
6a770e0a24 Patr*1007
d5aa75d39a Jean*1008       RETURN
6a770e0a24 Patr*1009       END