pkg/profiles/profiles_init_ncfile.F

24462d2fa8 Patr*0001 #include "PROFILES_OPTIONS.h"
13ce79fe94 Ivan*0002 #include "AD_CONFIG.h"
6a770e0a24 Patr*0003
13ce79fe94 Ivan*0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP
                0006 C !ROUTINE: PROFILES_INIT_NCFILE
6a770e0a24 Patr*0007
13ce79fe94 Ivan*0008 C !INTERFACE:
                0009       SUBROUTINE PROFILES_INIT_NCFILE(
                0010      & num_file,fid1,file2,fid2,length,Zlength,bi,bj,myThid)
6a770e0a24 Patr*0011
13ce79fe94 Ivan*0012 C     !DESCRIPTION:
                0013 C     Initialization of model counterparts files
                0014 C     for netcdf profiles data
                0015 C     Started: Gael Forget 15-March-2006
6a770e0a24 Patr*0016
13ce79fe94 Ivan*0017 C     !USES:
                0018       IMPLICIT NONE
                0019 C     == Global variables ===
6a770e0a24 Patr*0020 #include "EEPARAMS.h"
                0021 #include "SIZE.h"
                0022 #include "GRID.h"
                0023 #include "DYNVARS.h"
d28c90138c Patr*0024 #ifdef ALLOW_PROFILES
6328b73337 Gael*0025 # include "PROFILES_SIZE.h"
6e4c90fea3 Patr*0026 # include "profiles.h"
                0027 # include "netcdf.inc"
                0028 #endif
6a770e0a24 Patr*0029
13ce79fe94 Ivan*0030 C     !INPUT/OUTPUT PARAMETERS:
                0031 C     myThid: my thread ID number
                0032       INTEGER num_file, fid1
                0033       CHARACTER*(*) file2
                0034       INTEGER fid2, length, Zlength
                0035       INTEGER bi, bj, myThid
                0036 CEOP
6e4c90fea3 Patr*0037
13ce79fe94 Ivan*0038 #ifdef ALLOW_PROFILES
                0039 C     !LOCAL VARIABLES:
                0040       INTEGER k,err,vecid(2)
                0041       INTEGER irec,num_var,dimId1,dimId2,varId(2*NVARMAX),varId0
                0042       _RL tmp_vec(Zlength+1)
                0043       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0044
                0045       IF (profilesDoNcOutput) THEN
                0046 C1) Creation :
                0047         err = NF_CREATE( file2, NF_CLOBBER, fid2 )
                0048         CALL PROFILES_NF_ERROR( 'INIT_NCFILE: NF_CREATE fid2',
                0049      &       err,bi,bj,myThid )
                0050         err = NF_DEF_DIM( fid2,'iDEPTH', Zlength, dimId1 )
                0051         CALL PROFILES_NF_ERROR( 'INIT_NCFILE: NF_DEF_DIM Zlength',
                0052      &       err,bi,bj,myThid )
                0053         err = NF_DEF_DIM( fid2,'iPROF', length, dimId2 )
                0054         CALL PROFILES_NF_ERROR( 'INIT_NCFILE: NF_DEF_DIM length',
                0055      &       err,bi,bj,myThid )
                0056
                0057         vecid(1)=dimId1
                0058         vecid(2)=dimId2
                0059
                0060         err = NF_DEF_VAR( fid2, 'prof_ind_glob',
                0061      &        NF_INT, 1, vecid(2), varId(1) )
                0062         CALL PROFILES_NF_ERROR(
                0063      &       'INIT_NCFILE: NF_DEF_VAR prof_ind_glob',
                0064      &       err,bi,bj,myThid )
                0065         err = NF_PUT_ATT_INT( fid2, varId(1),
                0066      &        '_FillValue', NF_INT, 1, 0 )
                0067         CALL PROFILES_NF_ERROR(
                0068      &       'INIT_NCFILE: NF_PUT_ATT_INT varId(1)',
                0069      &       err,bi,bj,myThid )
                0070
                0071         DO num_var = 1, NVARMAX
                0072           err = NF_INQ_VARID( fid1,
                0073      &          prof_names(num_file,num_var), varId0 )
                0074           IF (err.EQ.NF_NOERR) THEN
                0075             WRITE(msgBuf,'(2A)')
                0076      &       'S/R PROFILES_INIT_NCFILE: defining new variable ',
                0077      &       prof_names(num_file,num_var)
                0078             CALL PRINT_MESSAGE( msgBuf,
                0079      &           standardMessageUnit, SQUEEZE_RIGHT, myThid )
                0080
                0081             err = NF_DEF_VAR( fid2, prof_names(num_file,num_var),
                0082      &            NF_DOUBLE, 2, vecid, varId(2+(num_var-1)*2) )
                0083             CALL PROFILES_NF_ERROR(
                0084      &           'INIT_NCFILE: NF_DEF_VAR prof_names',
                0085      &           err,bi,bj,myThid )
                0086             err = NF_PUT_ATT_DOUBLE( fid2, varId(2+(num_var-1)*2),
                0087      &           '_FillValue', NF_DOUBLE, 1, 0. _d 0 )
                0088             CALL PROFILES_NF_ERROR(
                0089      &           'INIT_NCFILE: NF_PUT_ATT_DOUBLE varId(2',
                0090      &           err,bi,bj,myThid )
                0091
                0092             err = NF_DEF_VAR( fid2, prof_namesmask(num_file,num_var),
                0093      &            NF_DOUBLE, 2, vecid, varId(3+(num_var-1)*2) )
                0094             CALL PROFILES_NF_ERROR(
                0095      &           'INIT_NCFILE: NF_DEF_VAR prof_namesmask',
                0096      &           err,bi,bj,myThid )
                0097             err = NF_PUT_ATT_DOUBLE( fid2, varId(3+(num_var-1)*2),
                0098      &            '_FillValue', NF_DOUBLE, 1, 0. _d 0 )
                0099             CALL PROFILES_NF_ERROR(
                0100      &           'INIT_NCFILE: NF_PUT_ATT_DOUBLE varId(3',
                0101      &           err,bi,bj,myThid )
                0102
                0103           ELSE
                0104             WRITE(msgBuf,'(2A)')
                0105      &          'S/R PROFILES_INIT_NCFILE: no variable ',
                0106      &          prof_names(num_file,num_var)
                0107             CALL PRINT_MESSAGE( msgBuf,
                0108      &           standardMessageUnit, SQUEEZE_RIGHT, myThid )
                0109             WRITE(msgBuf,'(2A)')
                0110      &           'INIT_NCFILE: NF_INQ_VARID prof_names = ',
                0111      &           prof_names(num_file,num_var)
                0112             CALL PROFILES_NF_ERROR( msgBuf, err, bi, bj, myThid )
                0113
                0114           ENDIF
                0115         ENDDO !DO num_var
                0116
                0117         err = NF_ENDDEF( fid2 )
                0118         CALL PROFILES_NF_ERROR( 'INIT_NCFILE: NF_ENDDEF fid2',
                0119      &       err,bi,bj,myThid )
                0120         err = NF_CLOSE( fid2 )
                0121         CALL PROFILES_NF_ERROR( 'INIT_NCFILE: NF_CLOSE fid2',
                0122      &       err,bi,bj,myThid )
                0123
                0124         err = NF_OPEN( file2, NF_WRITE, fid2 )
                0125         CALL PROFILES_NF_ERROR( 'INIT_NCFILE: NF_OPEN'//file2//')',
                0126      &       err,bi,bj,myThid )
                0127
                0128       ELSE !IF (profilesDoNcOutput)
                0129         OPEN( fid2, FILE = file2, FORM = 'unformatted',
                0130      &   STATUS = 'unknown', ACCESS = 'direct',
                0131      &   RECL = (Zlength + 1)*WORDLENGTH*2 )
                0132
                0133         DO k = 1, Zlength+1
                0134           tmp_vec(k) = zeroRL
                0135         ENDDO
                0136
                0137 # ifdef _BYTESWAPIO
                0138         CALL MDS_BYTESWAPR8(Zlength+1,tmp_vec)
                0139 # endif
                0140         DO irec = length, 1, -1
                0141           DO num_var = prof_num_var_tot(num_file,bi,bj), 1, -1
                0142             WRITE(fid2,rec=((irec-1)*prof_num_var_tot(num_file,bi,bj)
                0143      &       +num_var-1)*2 +1) tmp_vec
                0144             WRITE(fid2,rec=((irec-1)*prof_num_var_tot(num_file,bi,bj)
                0145      &       +num_var-1)*2 +2) tmp_vec
                0146           ENDDO
                0147         ENDDO
                0148
                0149       ENDIF !IF (profilesNoNcOutput)
                0150 #endif /* ALLOW_PROFILES */
                0151
                0152       RETURN
6a770e0a24 Patr*0153       END