pkg/profiles/profiles_make_ncfile.F

d3172737dc aver*0001 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0002
                0003 #include "PROFILES_OPTIONS.h"
                0004
                0005 CBOP
                0006 C     !ROUTINE: PROFILES_MAKE_NCFILE
                0007 C     !INTERFACE:
                0008       SUBROUTINE PROFILES_MAKE_NCFILE( myThid )
                0009
                0010 C     !DESCRIPTION: \bv
                0011 C     *==================================================================
                0012 C     | S/R PROFILES_MAKE_NCFILE
                0013 C     | o combine tiled files into one global netcdf file of
                0014 C     |   model-equivalent profiles
                0015 C     *==================================================================
                0016 C     \ev
                0017
                0018       IMPLICIT NONE
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "EESUPPORT.h"
                0022 #include "PARAMS.h"
                0023 #include "PROFILES_SIZE.h"
                0024 #include "profiles.h"
                0025 #include "netcdf.inc"
                0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     myThid  :: my Thread Id number
                0029       INTEGER myThid
                0030
                0031 C !FUNCTIONS:
                0032       INTEGER  ILNBLNK
                0033       EXTERNAL ILNBLNK
                0034
                0035 C     ========= Local variables =======================
                0036       INTEGER num_file,num_var,prof_num,k
                0037       INTEGER bi,bj,iG,jG
                0038       INTEGER err,dimid,irec,fid1,fid2
                0039       INTEGER dimid1,dimid2,vecid(2)
                0040       INTEGER varid0,varid1(NVARMAX*2),varid2(NVARMAX*2)
                0041       INTEGER length,Zlength,optimcycle
                0042       INTEGER IL,JL,KL
                0043       INTEGER vec_start(2),vec_count(2)
                0044       _RL tmpgs
                0045       _RL prof_mask1D(NLEVELMAX)
                0046       _RL prof_traj1D(NLEVELMAX)
                0047       _RL prof_buff(NVARMAX,NLEVELMAX,NOBSGLOB)
                0048       _RL prof_mask_buff(NVARMAX,NLEVELMAX,NOBSGLOB)
                0049       _RL prof_modval_glo(NVARMAX,NLEVELMAX,NOBSGLOB)
                0050       _RL prof_mask_glo(NVARMAX,NLEVELMAX,NOBSGLOB)
                0051       CHARACTER*(MAX_LEN_FNAM) prof_namesequi(NFILESPROFMAX,NVARMAX)
                0052       CHARACTER*(MAX_LEN_FNAM) profFile
                0053       CHARACTER*(MAX_LEN_FNAM) fnameequinc
                0054       CHARACTER*(MAX_LEN_FNAM) fnamedata
                0055       LOGICAL exst
                0056
                0057       _BEGIN_MASTER( myThid )
                0058
                0059 C Set new netcdf variables names
                0060       DO num_file=1,NFILESPROFMAX
                0061        DO num_var=1,NVARMAX
                0062         IL = ILNBLNK( prof_names(num_file,num_var) )
                0063         WRITE(prof_namesequi(num_file,num_var),'(2A)')
                0064      &       prof_names(num_file,num_var)(1:IL),'model'
                0065        ENDDO
                0066       ENDDO
                0067
                0068 C Initialize buffers
                0069       DO num_var=1,NVARMAX
                0070        DO prof_num=1,NOBSGLOB
                0071         DO k=1,NLEVELMAX
                0072          prof_buff(num_var,k,prof_num) = 0.
                0073          prof_mask_buff(num_var,k,prof_num) = 0.
                0074         ENDDO
                0075        ENDDO
                0076       ENDDO
                0077
                0078 C Loop over files
                0079       DO num_file=1,NFILESPROFMAX
                0080
                0081 C File maintenance
                0082        DO bj=1,nSy
                0083         DO bi=1,nSx
                0084
                0085          IF ( (ProfNo(num_file,bi,bj).GT.0).AND.
                0086      &        (profilesDoNcOutput) ) THEN
                0087 C Need to close the file so that the data is not lost when run finishes
                0088           err = NF_CLOSE(fidforward(num_file,bi,bj))
                0089           iG  = bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
                0090           jG  = bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
                0091           IL  = ILNBLNK( profilesFiles(num_file) )
                0092           WRITE(profFile,'(1a)')
                0093      &    profilesFiles(num_file)(1:IL)
                0094           IL  = ILNBLNK( profFile )
                0095           JL  = ILNBLNK( profilesDir )
                0096           WRITE(fnameequinc,'(3a,i3.3,a,i3.3,a)')
                0097      &    profilesDir(1:JL),profFile(1:IL),'.',iG,'.',jG,'.equi.nc'
                0098           err = NF_OPEN(fnameequinc,NF_NOWRITE,
                0099      &    fidforward(num_file,bi,bj))
                0100          ENDIF
                0101
                0102 C Loop over variables
                0103          DO num_var=1,NVARMAX
                0104           IF (vec_quantities(num_file,num_var,bi,bj).EQV..TRUE.) THEN
                0105
                0106 C Loop over profiles
                0107            DO prof_num=1,NOBSGLOB
                0108             IF (prof_num.LE.ProfNo(num_file,bi,bj)) THEN
                0109
                0110 C Initialize
                0111              DO k=1,NLEVELMAX
                0112               prof_traj1D(k)=0.
                0113               prof_mask1D(k)=0.
                0114               prof_buff(num_var,k,prof_num)=0.
                0115               prof_mask_buff(num_var,k,prof_num)=0.
                0116              ENDDO
                0117
                0118 C Read tiled files
                0119              CALL active_read_profile(num_file,
                0120      &          ProfDepthNo(num_file,bi,bj),prof_traj1D,num_var,
                0121      &          prof_num,.false.,optimcycle,bi,bj,myThid,
                0122      &          profiles_dummy(num_file,num_var,bi,bj))
                0123
                0124 C Save model equi and masks in buffer
                0125 C Combine all threads
                0126              irec = prof_ind_glob(num_file,prof_num,bi,bj)
                0127
                0128              DO k=1,ProfDepthNo(num_file,bi,bj)
                0129               prof_buff(num_var,k,irec) = prof_buff(num_var,k,irec)
                0130      &                               +prof_traj1D(k)
                0131               prof_mask_buff(num_var,k,irec) =
                0132      &                               prof_mask_buff(num_var,k,irec)
                0133      &                               +prof_mask1D_cur(k,bi,bj)
                0134              ENDDO
                0135
                0136             ENDIF !if (prof_num.LE.ProfNo(num_file,bi,bj)) then
                0137            ENDDO !do prof_num=..
                0138           ENDIF
                0139          ENDDO !do num_var...
                0140
                0141         ENDDO !bj
                0142        ENDDO !bi
                0143
                0144 C Combine all processes
                0145        DO num_var=1,NVARMAX
                0146         DO prof_num=1,NOBSGLOB
                0147          DO k=1,NLEVELMAX
                0148
                0149           tmpgs = prof_buff(num_var,k,prof_num)
                0150           _GLOBAL_SUM_RL(tmpgs, myThid)
                0151           prof_modval_glo(num_var,k,prof_num) = tmpgs
                0152           tmpgs = prof_mask_buff(num_var,k,prof_num)
                0153           _GLOBAL_SUM_RL(tmpgs, myThid)
                0154           prof_mask_glo(num_var,k,prof_num) = tmpgs
                0155
                0156          ENDDO
                0157         ENDDO !do prof_num=..
                0158        ENDDO !do num_var=..
                0159
                0160        IF ( myProcId .EQ. 0 ) THEN
                0161
                0162 C Get dimensions of input file
                0163         profFile=' '
                0164         IL = ILNBLNK( profilesfiles(num_file) )
                0165         IF (IL.NE.0) THEN
                0166          WRITE(profFile,'(1a)')
                0167      &   profilesfiles(num_file)(1:IL)
                0168         ENDIF
                0169
                0170         IL = ILNBLNK( profFile )
                0171         IF (IL.NE.0) THEN
                0172          WRITE(fnamedata,'(2a)') profFile(1:IL),'.nc'
                0173          err = NF_OPEN(fnamedata, 0, fid1)
                0174          err = NF_INQ_DIMID(fid1,'iPROF', dimid )
                0175          err = NF_INQ_DIMLEN(fid1, dimid, length )
                0176          err = NF_INQ_DIMID(fid1,'iDEPTH', dimid )
                0177          IF (err.NE.NF_NOERR) THEN
                0178           err = NF_INQ_DIMID(fid1,'Z', dimid )
                0179          ENDIF
                0180          err = NF_INQ_DIMLEN(fid1, dimid, Zlength )
                0181
                0182 C Create new netcdf global file for model-equivalent
                0183          JL  = ILNBLNK( profilesDir )
                0184          WRITE(fnameequinc,'(3a)')
                0185      &    profilesDir(1:JL),profFile(1:IL),'.equi.nc'
                0186
                0187          inquire( file=fnameequinc, exist=exst )
                0188          IF (.NOT.exst) THEN
                0189
                0190           err = NF_CREATE(fnameequinc,NF_CLOBBER,fid2)
                0191           err = NF_DEF_DIM(fid2,'iDEPTH',Zlength,dimid1)
                0192           err = NF_DEF_DIM(fid2,'iPROF',length,dimid2)
                0193           vecid(1)=dimid1
                0194           vecid(2)=dimid2
                0195
                0196 C Define variables and attributes
                0197           DO num_var=1,NVARMAX
                0198
                0199            err = NF_INQ_VARID(fid1,prof_names(num_file,num_var),varid0)
                0200
                0201            IF (err.EQ.NF_NOERR) THEN
                0202
                0203             err = NF_DEF_VAR(fid2,prof_namesequi(num_file,num_var),
                0204      &        NF_DOUBLE,2,vecid,varid1(2+(num_var-1)*2))
                0205             err = NF_PUT_ATT_DOUBLE(fid2,varid1(2+(num_var-1)*2),
                0206      &        '_FillValue',NF_DOUBLE,1, 0. _d 0)
                0207             err = NF_DEF_VAR(fid2,prof_namesmask(num_file,num_var),
                0208      &        NF_DOUBLE, 2,vecid,varid1(3+(num_var-1)*2))
                0209             err = NF_PUT_ATT_DOUBLE(fid2,varid1(3+(num_var-1)*2),
                0210      &        '_FillValue',NF_DOUBLE,1, 0. _d 0)
                0211
                0212            ENDIF
                0213           ENDDO
                0214
                0215           err = NF_ENDDEF(fid2)
                0216
                0217          ELSE
                0218           err = NF_OPEN(fnameequinc, NF_WRITE, fid2)
                0219          ENDIF
                0220
                0221 C Write profiles
                0222          DO num_var=1,NVARMAX
                0223           IF (vec_quantities(num_file,num_var,1,1).EQV..TRUE.) THEN
                0224            DO prof_num=1,NOBSGLOB
                0225             IF (prof_num.LE.length) THEN
                0226
                0227              DO k=1,Zlength
                0228               prof_traj1D(k)=prof_modval_glo(num_var,k,prof_num)
                0229               prof_mask1D(k)=prof_mask_glo(num_var,k,prof_num)
                0230              ENDDO
                0231
                0232              vec_start(1)=1
                0233              vec_start(2)=prof_num
                0234              vec_count(1)=Zlength
                0235              vec_count(2)=1
                0236
                0237              err = NF_INQ_VARID(fid2,prof_namesequi(num_file,num_var),
                0238      &         varid2(2+(num_var-1)*2) )
                0239              err = NF_PUT_VARA_DOUBLE(fid2, varid2(2+(num_var-1)*2),
                0240      &         vec_start, vec_count, prof_traj1D)
                0241              err = NF_INQ_VARID(fid2,prof_namesmask(num_file,
                0242      &         num_var), varid2(3+(num_var-1)*2) )
                0243              err = NF_PUT_VARA_DOUBLE(fid2, varid2(3+(num_var-1)*2),
                0244      &         vec_start, vec_count, prof_mask1D)
                0245
                0246             ENDIF !if (vec_quantities(num_file,num_var,1,1).EQV..TRUE.)
                0247            ENDDO !do prof_num=..
                0248           ENDIF !if (prof_num.LE.length)
                0249          ENDDO !do num_var=..
                0250
                0251          err = NF_CLOSE(fid2)
                0252         ENDIF
                0253        ENDIF
                0254       ENDDO
                0255
                0256       _END_MASTER( myThid )
                0257
                0258 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0259
                0260       RETURN
                0261       END