Back to home page

darwin3
 
 

    

File indexing completed on 2025-09-13 12:07:56 UTC

view on githubraw file Latest commit d4a066fa on 2025-09-10 18:05:35 UTC
d3172737dc aver*0001 #include "PROFILES_OPTIONS.h"
                0002 
13ce79fe94 Ivan*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d3172737dc aver*0004 CBOP
13ce79fe94 Ivan*0005 C !ROUTINE: PROFILES_MAKE_NCFILE
                0006 
                0007 C !INTERFACE:
d3172737dc aver*0008       SUBROUTINE PROFILES_MAKE_NCFILE( myThid )
                0009 
13ce79fe94 Ivan*0010 C     !DESCRIPTION:
                0011 C     Combine tiled files into one global netcdf file of
                0012 C     model-equivalent profiles
d3172737dc aver*0013 
13ce79fe94 Ivan*0014 C     !USES:
d3172737dc aver*0015       IMPLICIT NONE
13ce79fe94 Ivan*0016 C     == Global variables ===
d3172737dc aver*0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "EESUPPORT.h"
                0020 #include "PARAMS.h"
                0021 #include "PROFILES_SIZE.h"
                0022 #include "profiles.h"
                0023 #include "netcdf.inc"
                0024 
                0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     myThid  :: my Thread Id number
                0027       INTEGER myThid
13ce79fe94 Ivan*0028 CEOP
d3172737dc aver*0029 
13ce79fe94 Ivan*0030 C     !FUNCTIONS:
d3172737dc aver*0031       INTEGER  ILNBLNK
                0032       EXTERNAL ILNBLNK
                0033 
13ce79fe94 Ivan*0034 C     !LOCAL VARIABLES:
                0035       INTEGER kLev, kProf, k
d4a066fa68 Jean*0036       INTEGER num_file, num_var, prof_num
                0037       INTEGER bi, bj
                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
                0043       INTEGER vec_start(2), vec_count(2)
d3172737dc aver*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 C Set new netcdf variables names
13ce79fe94 Ivan*0058       DO num_file = 1, NFILESPROFMAX
                0059         DO num_var = 1, NVARMAX
                0060           IL = ILNBLNK( prof_names(num_file,num_var) )
                0061           WRITE(prof_namesequi(num_file,num_var),'(2A)')
                0062      &     prof_names(num_file,num_var)(1:IL),'model'
                0063         ENDDO
d3172737dc aver*0064       ENDDO
                0065 
                0066 C Initialize buffers
13ce79fe94 Ivan*0067       DO num_var = 1, NVARMAX
                0068         DO prof_num = 1, NOBSGLOB
                0069           DO kLev = 1, NLEVELMAX
                0070             prof_buff(num_var,kLev,prof_num) = 0.
                0071             prof_mask_buff(num_var,kLev,prof_num) = 0.
                0072           ENDDO
d3172737dc aver*0073         ENDDO
                0074       ENDDO
                0075 
                0076 C Loop over files
13ce79fe94 Ivan*0077       DO num_file = 1, NFILESPROFMAX
d3172737dc aver*0078 
13ce79fe94 Ivan*0079         _BEGIN_MASTER( myThid )
d3172737dc aver*0080 C File maintenance
13ce79fe94 Ivan*0081         DO bj = 1, nSy
                0082           DO bi = 1, nSx
                0083             IF ( (ProfNo(num_file,bi,bj).GT.0).AND.
                0084      &           (profilesDoNcOutput) ) THEN
                0085 C Need to close file so that data is not lost when run finishes
                0086               err = NF_SYNC( fidforward(num_file,bi,bj) )
                0087               CALL PROFILES_NF_ERROR(
                0088      &             'MAKE_NCFILE: NF_SYNC fidforward',
                0089      &             err,bi,bj,myThid )
                0090             ENDIF
d3172737dc aver*0091 
                0092 C Loop over variables
13ce79fe94 Ivan*0093             DO num_var = 1, NVARMAX
                0094               IF (vec_quantities(num_file,num_var,bi,bj)) THEN
d3172737dc aver*0095 C Loop over profiles
13ce79fe94 Ivan*0096                 DO prof_num = 1, NOBSGLOB
                0097                   IF (prof_num.LE.ProfNo(num_file,bi,bj)) THEN
d3172737dc aver*0098 C Initialize
13ce79fe94 Ivan*0099                     DO kLev = 1, NLEVELMAX
                0100                       prof_traj1D(kLev) = 0.
                0101                       prof_mask1D(kLev) = 0.
                0102                       prof_buff(num_var,kLev,prof_num) = 0.
                0103                       prof_mask_buff(num_var,kLev,prof_num) = 0.
                0104                     ENDDO
d3172737dc aver*0105 
                0106 C Read tiled files
13ce79fe94 Ivan*0107                     CALL ACTIVE_READ_PROFILE( num_file,
                0108      &                   ProfDepthNo(num_file,bi,bj),prof_traj1D,
                0109      &                   num_var,prof_num,.false.,optimcycle,
                0110      &                   bi,bj,myThid,
                0111      &                   profiles_dummy(num_file,num_var,bi,bj) )
d3172737dc aver*0112 
                0113 C Save model equi and masks in buffer
                0114 C Combine all threads
13ce79fe94 Ivan*0115                     irec = prof_ind_glob(num_file,prof_num,bi,bj)
d3172737dc aver*0116 
13ce79fe94 Ivan*0117                     DO kProf = 1, ProfDepthNo(num_file,bi,bj)
                0118                       prof_buff(num_var,kProf,irec) =
                0119      &                 prof_buff(num_var,kProf,irec)
                0120      &                 + prof_traj1D(kProf)
d3172737dc aver*0121 
13ce79fe94 Ivan*0122                       prof_mask_buff(num_var,kProf,irec) =
                0123      &                 prof_mask_buff(num_var,kProf,irec)
                0124      &                 + prof_mask1D_cur(kProf,bi,bj)
d3172737dc aver*0125 
13ce79fe94 Ivan*0126                     ENDDO
d3172737dc aver*0127 
13ce79fe94 Ivan*0128                   ENDIF !IF (prof_num.LE.ProfNo(num_file,bi,bj))
                0129                 ENDDO !DO prof_num
                0130               ENDIF !IF (vecquantities
                0131             ENDDO !DO num_var
d3172737dc aver*0132 
13ce79fe94 Ivan*0133           ENDDO !DO bi
                0134         ENDDO !DO bj
                0135         _END_MASTER( myThid )
d3172737dc aver*0136 
13ce79fe94 Ivan*0137 C Combine all processes
                0138         DO num_var = 1, NVARMAX
                0139           DO prof_num = 1, NOBSGLOB
                0140             DO kLev = 1, NLEVELMAX
                0141               tmpgs = prof_buff(num_var,kLev,prof_num)
                0142               _GLOBAL_SUM_RL(tmpgs, myThid)
d3172737dc aver*0143 
13ce79fe94 Ivan*0144               prof_modval_glo(num_var,kLev,prof_num) = tmpgs
                0145               tmpgs = prof_mask_buff(num_var,kLev,prof_num)
                0146               _GLOBAL_SUM_RL(tmpgs, myThid)
d3172737dc aver*0147 
13ce79fe94 Ivan*0148               prof_mask_glo(num_var,kLev,prof_num) = tmpgs
d3172737dc aver*0149 
13ce79fe94 Ivan*0150             ENDDO !DO kLev
                0151           ENDDO !DO prof_num
                0152         ENDDO !DO num_var
d3172737dc aver*0153 
13ce79fe94 Ivan*0154         _BEGIN_MASTER( myThid )
                0155         IF (myProcId.EQ.0) THEN
                0156 C Get dimensions of input file
                0157           profFile=' '
                0158           IL = ILNBLNK( profilesfiles(num_file) )
                0159           IF (IL.NE.0) THEN
                0160             WRITE(profFile,'(A)') profilesfiles(num_file)(1:IL)
                0161           ENDIF
d3172737dc aver*0162 
13ce79fe94 Ivan*0163           IL = ILNBLNK( profFile )
                0164           IF (IL.NE.0) THEN
                0165             WRITE(fnamedata,'(2A)') profFile(1:IL),'.nc'
                0166             err = NF_OPEN( fnamedata, NF_NOWRITE, fid1 )
                0167             CALL PROFILES_NF_ERROR(
                0168      &           'MAKE_NCFILE: NF_OPEN('//fnamedata(1:IL+3)//')',
                0169      &           err,bi,bj,myThid )
                0170             err = NF_INQ_DIMID( fid1,'iPROF', dimId )
                0171             CALL PROFILES_NF_ERROR(
                0172      &           'MAKE_NCFILE: NF_INQ_DIMID iPROF',
                0173      &           err,bi,bj,myThid )
                0174             err = NF_INQ_DIMLEN( fid1, dimId, length )
                0175             CALL PROFILES_NF_ERROR(
                0176      &           'MAKE_NCFILE: NF_INQ_DIMLEN length',
                0177      &           err,bi,bj,myThid )
                0178             err = NF_INQ_DIMID( fid1,'iDEPTH', dimId )
                0179             CALL PROFILES_NF_ERROR(
                0180      &           'MAKE_NCFILE: NF_INQ_DIMID iDEPTH',
                0181      &           err,bi,bj,myThid )
                0182             IF (err.NE.NF_NOERR) THEN
                0183               err = NF_INQ_DIMID( fid1,'Z', dimId )
                0184               CALL PROFILES_NF_ERROR(
                0185      &             'MAKE_NCFILE: NF_INQ_DIMID Z',
                0186      &             err,bi,bj,myThid )
                0187             ENDIF
                0188             err = NF_INQ_DIMLEN( fid1, dimId, Zlength )
                0189             CALL PROFILES_NF_ERROR(
                0190      &           'MAKE_NCFILE: NF_INQ_DIMLEN Zlength',
                0191      &           err,bi,bj,myThid )
d3172737dc aver*0192 
13ce79fe94 Ivan*0193 C Create new netcdf global file for model-equivalent
                0194             JL = ILNBLNK( profilesDir )
                0195             WRITE(fnameequinc,'(3A)')
                0196      &       profilesDir(1:JL),profFile(1:IL),'.equi.nc'
                0197 
                0198             JL = ILNBLNK( fnameequinc )
                0199             INQUIRE( FILE = fnameequinc(1:JL), EXIST = exst )
                0200             IF (.NOT.exst) THEN
                0201               err = NF_CREATE(fnameequinc(1:JL),NF_CLOBBER,fid2)
                0202               CALL PROFILES_NF_ERROR(
                0203      &             'MAKE_NCFILE: NF_CREATE('//fnameequinc(1:JL)//')',
                0204      &             err,bi,bj,myThid )
                0205               err = NF_DEF_DIM(fid2,'iDEPTH',Zlength,dimId1)
                0206               CALL PROFILES_NF_ERROR(
                0207      &             'MAKE_NCFILE: NF_DEF_DIM iDepth',
                0208      &             err,bi,bj,myThid )
                0209               err = NF_DEF_DIM(fid2,'iPROF',length,dimId2)
                0210               CALL PROFILES_NF_ERROR(
                0211      &             'MAKE_NCFILE: NF_DEF_DIM iPROF',
                0212      &             err,bi,bj,myThid )
                0213 
                0214               vecid(1)=dimId1
                0215               vecid(2)=dimId2
d3172737dc aver*0216 
13ce79fe94 Ivan*0217 C Define variables and attributes
                0218               DO num_var = 1, NVARMAX
                0219                 err = NF_INQ_VARID( fid1,
                0220      &                prof_names(num_file,num_var), varId0 )
                0221                 CALL PROFILES_NF_ERROR( 'MAKE_NCFILE: NF_INQ_VARID('
                0222      &               //prof_names(num_file,num_var)//')',
                0223      &               err,bi,bj,myThid )
                0224 
                0225                 IF (err.EQ.NF_NOERR) THEN
                0226                   err = NF_DEF_VAR( fid2,
                0227      &                  prof_namesequi(num_file,num_var),
                0228      &                  NF_DOUBLE, 2, vecid, varId1(2+(num_var-1)*2) )
                0229                   CALL PROFILES_NF_ERROR(
                0230      &                 'MAKE_NCFILE: NF_DEF_VAR prof_namesequi',
                0231      &                 err,bi,bj,myThid )
                0232                   err = NF_PUT_ATT_DOUBLE( fid2,
                0233      &                  varId1(2+(num_var-1)*2),
                0234      &                  '_FillValue', NF_DOUBLE, 1, 0. _d 0 )
                0235                   CALL PROFILES_NF_ERROR(
                0236      &                 'MAKE_NCFILE: NF_PUT_ATT_DOUBLE varId(2',
                0237      &                 err,bi,bj,myThid )
                0238 
                0239                   err = NF_DEF_VAR( fid2,
                0240      &                  prof_namesmask(num_file,num_var),
                0241      &                  NF_DOUBLE, 2, vecid, varId1(3+(num_var-1)*2) )
                0242                   CALL PROFILES_NF_ERROR(
                0243      &                 'MAKE_NCFILE: NF_DEF_VAR prof_namesmask',
                0244      &                 err,bi,bj,myThid )
                0245                   err = NF_PUT_ATT_DOUBLE( fid2,
                0246      &                  varId1(3+(num_var-1)*2),
                0247      &                  '_FillValue', NF_DOUBLE, 1, 0. _d 0 )
                0248                   CALL PROFILES_NF_ERROR(
                0249      &                 'MAKE_NCFILE: NF_PUT_ATT_DOUBLE varId(3',
                0250      &                 err,bi,bj,myThid )
                0251 
                0252                 ENDIF
                0253               ENDDO !DO num_var
                0254 
                0255               err = NF_ENDDEF( fid2 )
                0256               CALL PROFILES_NF_ERROR( 'MAKE_NCFILE: NF_ENDDEF fid2',
                0257      &             err,bi,bj,myThid )
                0258 
                0259             ELSE !IF (.NOT.exst)
                0260               JL = ILNBLNK( fnameequinc )
                0261               err = NF_OPEN( fnameequinc(1:JL), NF_WRITE, fid2 )
                0262               CALL PROFILES_NF_ERROR(
                0263      &             'MAKE_NCFILE: NF_OPEN('//fnameequinc(1:JL)//')',
                0264      &             err,bi,bj,myThid )
                0265 
                0266             ENDIF !IF (.NOT.exst)
d3172737dc aver*0267 
                0268 C Write profiles
13ce79fe94 Ivan*0269             DO num_var = 1, NVARMAX
                0270               IF (vec_quantities(num_file,num_var,1,1)) THEN
                0271                 DO prof_num = 1, NOBSGLOB
                0272                   IF (prof_num.LE.length) THEN
                0273                     DO k = 1, Zlength
                0274                       prof_traj1D(k) =
                0275      &                 prof_modval_glo(num_var,k,prof_num)
                0276 
                0277                       prof_mask1D(k) =
                0278      &                 prof_mask_glo(num_var,k,prof_num)
                0279 
                0280                     ENDDO
                0281 
                0282                     vec_start(1) = 1
                0283                     vec_start(2) = prof_num
                0284                     vec_count(1) = Zlength
                0285                     vec_count(2) = 1
                0286 
                0287                     err = NF_INQ_VARID( fid2,
                0288      &                    prof_namesequi(num_file,num_var),
                0289      &                    varId2(2+(num_var-1)*2) )
                0290                     CALL PROFILES_NF_ERROR(
                0291      &                   'MAKE_NCFILE: NF_INQ_VARID prof_namesequi',
                0292      &                   err,bi,bj,myThid )
                0293                     err = NF_PUT_VARA_DOUBLE( fid2,
                0294      &                    varId2(2+(num_var-1)*2),
                0295      &                    vec_start, vec_count, prof_traj1D )
                0296                     CALL PROFILES_NF_ERROR(
                0297      &                  'MAKE_NCFILE: NF_PUT_VARA_DOUBLE prof_traj1D',
                0298      &                  err,bi,bj,myThid )
                0299 
                0300                     err = NF_INQ_VARID( fid2,
                0301      &                    prof_namesmask(num_file,num_var),
                0302      &                    varId2(3+(num_var-1)*2) )
                0303                     CALL PROFILES_NF_ERROR(
                0304      &                   'MAKE_NCFILE: NF_INQ_VARID prof_namesmask',
                0305      &                   err,bi,bj,myThid )
                0306                     err = NF_PUT_VARA_DOUBLE( fid2,
                0307      &                    varId2(3+(num_var-1)*2),
                0308      &                    vec_start, vec_count, prof_mask1D )
                0309                     CALL PROFILES_NF_ERROR(
                0310      &                  'MAKE_NCFILE: NF_PUT_VARA_DOUBLE prof_mask1D',
                0311      &                  err,bi,bj,myThid )
                0312 
                0313                   ENDIF !IF (prof_num.LE.length)
                0314                 ENDDO !DO prof_num
                0315               ENDIF !IF vec_quantities(num_file,num_var,1,1)
                0316             ENDDO !DO num_var
                0317 
                0318             err = NF_CLOSE( fid2 )
                0319             CALL PROFILES_NF_ERROR( 'MAKE_NCFILE: NF_CLOSE fid2',
                0320      &           err,bi,bj,myThid )
                0321 
                0322           ENDIF !IF (IL.NE.0)
                0323         ENDIF !IF (myProcId.EQ.0)
                0324         _END_MASTER( myThid )
                0325 
                0326       ENDDO !DO num_file
d3172737dc aver*0327 
                0328       RETURN
                0329       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/darwinproject/darwin3 by the 2.3.7-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!