pkg/obsfit/obsfit_init_equifiles.F

ad59256d7d aver*0001 #include "OBSFIT_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: OBSFIT_INIT_EQUIFILES
                0005
                0006 C     !INTERFACE:
                0007       SUBROUTINE OBSFIT_INIT_EQUIFILES(
                0008      I                                  num_file,
                0009      I                                  fid1,
                0010      I                                  file2,
                0011      O                                  fid2,
                0012      I                                  length,
                0013      I                                  bi,
                0014      I                                  bj,
                0015      I                                  myThid )
                0016
                0017 C     !DESCRIPTION:
                0018 C     ==================================================================
                0019 C     | Initialization of model counterparts files
                0020 C     | for ObsFit observations
                0021 C     ==================================================================
                0022
                0023 C !USES:
                0024       IMPLICIT NONE
                0025 C     == Global variables ===
                0026 #include "EEPARAMS.h"
                0027 #include "SIZE.h"
                0028 #include "GRID.h"
                0029 #include "DYNVARS.h"
                0030 #ifdef ALLOW_OBSFIT
                0031 # include "OBSFIT_SIZE.h"
                0032 # include "OBSFIT.h"
                0033 # include "netcdf.inc"
                0034 #endif
                0035
                0036 C     !INPUT PARAMETERS:
                0037 C     myThid: my thread ID number
                0038       INTEGER num_file, length, fid1, fid2
                0039       CHARACTER*(*) file2
                0040       INTEGER bi, bj, myThid
                0041 CEOP
                0042
                0043 #ifdef ALLOW_OBSFIT
                0044 C     !LOCAL VARIABLES:
                0045       INTEGER dimid, varID(3), varID0
                0046       INTEGER irec, err
                0047       _RL tmp_vec(2)
                0048       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0049
                0050       IF (obsfitDoNcOutput) THEN
                0051
                0052 C Create a netcdf file
                0053         err = NF_CREATE( file2, NF_CLOBBER, fid2 )
                0054         CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILE: NF_CREATE fid2',
                0055      &       err,bi,bj,myThid )
                0056         err = NF_DEF_DIM( fid2, 'iSAMPLE', length, dimid )
                0057         CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILE: NF_DEF_DIM sample',
                0058      &       err,bi,bj,myThid )
                0059         err = NF_DEF_VAR( fid2, 'sample_ind_glob',
                0060      &        NF_INT, 1, dimid, varID(1) )
                0061         CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILE: NF_DEF_VAR sample',
                0062      &       err,bi,bj,myThid )
                0063         err = NF_PUT_ATT_INT( fid2, varID(1), '_FillValue',
                0064      &        NF_INT, 1, 0 )
                0065         CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILE: NF_PUT_ATT_INT sample',
                0066      &       err,bi,bj,myThid )
                0067
                0068         err = NF_INQ_VARID( fid1, obsfit_nameval, varID0 )
                0069         IF (err.EQ.NF_NOERR) THEN
                0070
                0071           err = NF_DEF_VAR( fid2, obsfit_nameequi,
                0072      &          NF_DOUBLE, 1, dimid, varID(2) )
                0073           CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILE: NF_DEF_VAR val',
                0074      &         err,bi,bj,myThid )
                0075           err = NF_PUT_ATT_DOUBLE( fid2,varID(2),
                0076      &          '_FillValue', NF_DOUBLE, 1, 0. _d 0 )
                0077           CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILE: NF_PUT_ATT_INT val',
                0078      &         err,bi,bj,myThid )
                0079
                0080           err = NF_DEF_VAR( fid2, obsfit_namemask,
                0081      &          NF_DOUBLE, 1, dimid, varID(3) )
                0082           CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILE: NF_DEF_VAR mask',
                0083      &         err,bi,bj,myThid )
                0084           err = NF_PUT_ATT_DOUBLE( fid2, varID(3),
                0085      &          '_FillValue', NF_DOUBLE, 1, 0. _d 0 )
                0086           CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILE: NF_PUT_ATT_INT mask',
                0087      &         err,bi,bj,myThid )
                0088
                0089         ELSE
                0090             WRITE( msgBuf,'(2A)' )
                0091      &          'S/R OBSFIT_INIT_EQUIFILES: no variable obs_val'
                0092             CALL PRINT_MESSAGE( msgBuf,
                0093      &           standardMessageUnit, SQUEEZE_RIGHT, myThid )
                0094             WRITE( msgBuf,'(2A)' )
                0095      &           'INIT_EQUIFILES: NF_INQ_VARID obs_val'
                0096             CALL OBSFIT_NF_ERROR( msgBuf, err, bi, bj, myThid )
                0097
                0098         ENDIF
                0099
                0100         err = NF_ENDDEF( fid2 )
                0101         CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILES: NF_ENDDEF fid2',
                0102      &       err,bi,bj,myThid )
                0103         err = NF_CLOSE( fid2 )
                0104         CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILES: NF_CLOSE fid2',
                0105      &       err,bi,bj,myThid )
                0106
                0107         err = NF_OPEN( file2,NF_WRITE,fid2 )
                0108         CALL OBSFIT_NF_ERROR( 'INIT_EQUIFILES: NF_OPEN'//file2//')',
                0109      &       err,bi,bj,myThid )
                0110
                0111       ELSE !IF (obsfitDoNcOutput)
                0112
                0113 C Create a binary file
                0114         OPEN( fid2, FILE=file2, FORM='unformatted', STATUS='unknown',
                0115      &   ACCESS='direct', RECL=2*WORDLENGTH*2 )
                0116
                0117         DO irec = 1, 2
                0118           tmp_vec(irec) = zeroRL
                0119         ENDDO
                0120 #ifdef _BYTESWAPIO
                0121         CALL MDS_BYTESWAPR8(2,tmp_vec)
                0122 #endif
                0123
                0124         DO irec = length, 1, -1
                0125           WRITE( fid2, rec=(irec*2-1) ) tmp_vec
                0126           WRITE( fid2, rec=(irec*2) ) tmp_vec
                0127         ENDDO
                0128
                0129       ENDIF !IF (obsfitDoNcOutput)
                0130
                0131 #endif
                0132
                0133       END
                0134