** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Wed, 10 Mar 2026 05:09:16 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/profiles/profiles_readvector.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2025-08-05 05:09:15 UTC

view on githubraw file Latest commit 13ce79fe on 2025-08-04 21:05:34 UTC
24462d2fa8 Patr*0001 #include "PROFILES_OPTIONS.h"
6a770e0a24 Patr*0002 
13ce79fe94 Ivan*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C !ROUTINE: PROFILES_READPARMS
6a770e0a24 Patr*0006 
13ce79fe94 Ivan*0007 C !INTERFACE:
                0008       SUBROUTINE PROFILES_READVECTOR( fNb, vNb, irec,
                0009      & vec_loc_length, vec_loc, bi, bj, myThid )
6a770e0a24 Patr*0010 
13ce79fe94 Ivan*0011 C     !DESCRIPTION:
                0012 C     Reads a profile from a netcdf profiles data file
                0013 C     Started: Gael Forget 15-March-2006
6a770e0a24 Patr*0014 
13ce79fe94 Ivan*0015 C     !USES:
                0016       IMPLICIT NONE
                0017 C     == Global variables ===
6a770e0a24 Patr*0018 #include "SIZE.h"
275a56dc21 Gael*0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
6a770e0a24 Patr*0021 #include "GRID.h"
                0022 #include "DYNVARS.h"
d28c90138c Patr*0023 #ifdef ALLOW_PROFILES
6328b73337 Gael*0024 # include "netcdf.inc"
                0025 # include "PROFILES_SIZE.h"
                0026 # include "profiles.h"
6e4c90fea3 Patr*0027 #endif
13ce79fe94 Ivan*0028 
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     myThid :: my Thread Id number
                0031       INTEGER vec_loc_length,vNb,bi,bj
                0032       INTEGER irec,fNb,myThid
6a770e0a24 Patr*0033       _RL vec_loc(vec_loc_length)
13ce79fe94 Ivan*0034 CEOP
6e4c90fea3 Patr*0035 
13ce79fe94 Ivan*0036 C     !LOCAL VARIABLES:
                0037       INTEGER num_var,v1,v2
                0038       INTEGER err,varId1,tmpprofno
d28c90138c Patr*0039 #ifdef ALLOW_PROFILES
13ce79fe94 Ivan*0040       INTEGER vec_start(2),vec_count(2)
6a770e0a24 Patr*0041       _RL vec_tmp1(1000*NLEVELMAX),vec_tmp2(1000*NLEVELMAX)
13ce79fe94 Ivan*0042 # ifdef ALLOW_PROFILES_CLIMMASK
6b2230d510 Ou W*0043       _RL vec_tmp3(1000*NLEVELMAX)
13ce79fe94 Ivan*0044 # endif
                0045       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0046 
                0047       IF ( (irec.LT.profiles_minind_buff(bi,bj)) .OR.
                0048      &     (irec.GT.profiles_maxind_buff(bi,bj)) .OR.
                0049      &     (profiles_curfile_buff(bi,bj).NE.fNb) ) THEN
                0050         err = NF_INQ_DIMID(fiddata(fNb,bi,bj),'iPROF', varId1)
                0051         CALL PROFILES_NF_ERROR(
                0052      &       'READVECTOR: NF_INQ_DIMID fiddata iProf',
                0053      &       err,bi,bj,myThid )
                0054         err = NF_INQ_DIMLEN( fiddata(fNb,bi,bj), varId1, tmpprofno )
                0055         CALL PROFILES_NF_ERROR( 'READVECTOR: NF_INQ_DIMLEN tmpprofno',
                0056      &       err,bi,bj,myThid )
                0057 
                0058         IF (profiles_curfile_buff(bi,bj).NE.fNb) THEN
                0059 C No asumption on whether a forward or a backward loop is calling
                0060           profiles_minind_buff(bi,bj) = MAX(1,irec-500+1)
                0061           profiles_maxind_buff(bi,bj) = MIN(tmpprofno,irec+500)
                0062 
                0063         ELSEIF (irec.LT.profiles_minind_buff(bi,bj)) THEN
                0064 C Implies that a backward loop is calling
                0065           profiles_minind_buff(bi,bj) = MAX(1,irec-999)
                0066           profiles_maxind_buff(bi,bj) = irec
                0067 
                0068         ELSE
                0069 C Implies that a forward loop is calling
                0070           profiles_minind_buff(bi,bj) = irec
                0071           profiles_maxind_buff(bi,bj) = MIN(tmpprofno,irec+999)
                0072 
                0073         ENDIF !IF (profiles_curfile_buff(bi,bj).NE.fNb)
                0074 
                0075 # ifdef ALLOW_DEBUG
                0076         IF (debugLevel.GE.debLevD) THEN
                0077           WRITE(msgBuf,'(A,5I9)')
                0078      &     'buffer readvector ',
                0079      &     profiles_minind_buff(bi,bj), profiles_maxind_buff(bi,bj),
                0080      &     irec, profNo(fNb,bi,bj), tmpprofno
                0081           CALL PRINT_MESSAGE( msgBuf,
                0082      &         standardMessageUnit, SQUEEZE_RIGHT, myThid )
                0083         ENDIF
                0084 # endif
                0085 
                0086         vec_start(1) = 1
                0087         vec_start(2) = profiles_minind_buff(bi,bj)
                0088         vec_count(1) = vec_loc_length
                0089         vec_count(2) =
                0090      &   profiles_maxind_buff(bi,bj)-profiles_minind_buff(bi,bj)+1
                0091 
                0092         DO num_var = 1, NVARMAX
                0093           IF ( vec_quantities(fNb,num_var,bi,bj) ) THEN
                0094             err = NF_INQ_VARID( fiddata(fNb,bi,bj),
                0095      &            prof_names(fNb,num_var), varId1 )
                0096             CALL PROFILES_NF_ERROR(
                0097      &           'READVECTOR: NF_INQ_VARID prof_names',
                0098      &           err,bi,bj,myThid )
                0099             err = NF_GET_VARA_DOUBLE( fiddata(fNb,bi,bj), varId1,
                0100      &            vec_start, vec_count, vec_tmp1 )
                0101             CALL PROFILES_NF_ERROR(
                0102      &           'READVECTOR: NF_GET_VARA_DOUBLE vec_tmp1',
                0103      &           err,bi,bj,myThid )
                0104 
                0105             err = NF_INQ_VARID( fiddata(fNb,bi,bj),
                0106      &            prof_namesweight(fNb,num_var), varId1 )
                0107             CALL PROFILES_NF_ERROR(
                0108      &      'READVECTOR: NF_INQ_VARID '//prof_namesweight(fNb,num_var),
                0109      &           err,bi,bj,myThid )
                0110             err = NF_GET_VARA_DOUBLE( fiddata(fNb,bi,bj),
                0111      &            varId1, vec_start, vec_count, vec_tmp2 )
                0112             CALL PROFILES_NF_ERROR(
                0113      &           'READVECTOR: NF_GET_VARA_DOUBLE vec_tmp2',
                0114      &           err,bi,bj,myThid )
                0115 
                0116 # ifdef ALLOW_PROFILES_CLIMMASK
                0117             err = NF_INQ_VARID( fiddata(fNb,bi,bj),
                0118      &            prof_namesclim(fNb,num_var),varId1 )
                0119             CALL PROFILES_NF_ERROR(
                0120      &           'READVECTOR: NF_INQ_VARID prof_namesclim',
                0121      &           err,bi,bj,myThid )
                0122             err = NF_GET_VARA_DOUBLE( fiddata(fNb,bi,bj),
                0123      &            varId1,vec_start,vec_count, vec_tmp3 )
                0124             CALL PROFILES_NF_ERROR(
                0125      &           'READVECTOR: NF_GET_VARA_DOUBLE vec_tmp3',
                0126      &           err,bi,bj,myThid )
                0127 # endif
                0128 
                0129             IF (err.NE.NF_NOERR) THEN
                0130               WRITE(errorMessageUnit,'(A)')
                0131      &         'WARNING PROFILES_READVECTOR: record not found!!'
                0132             ENDIF
                0133 
                0134             DO v1 = 1, vec_count(1)
                0135               DO v2 = 1, vec_count(2)
                0136                 profiles_data_buff(v1,v2,num_var,bi,bj) =
                0137      &           vec_tmp1((v2-1)*vec_count(1)+v1)
                0138 
                0139                 profiles_weight_buff(v1,v2,num_var,bi,bj) =
                0140      &           vec_tmp2((v2-1)*vec_count(1)+v1)
                0141 
                0142 # ifdef ALLOW_PROFILES_CLIMMAS
                0143                 IF (vec_tmp3((v2-1)*vec_count(1)+v1).LE.-990. _d 0)
                0144      &            profiles_weight_buff(v1,v2,num_var,bi,bj) = 0. _d 0
                0145 
                0146 # endif
                0147               ENDDO !DO v2
                0148             ENDDO !DO v1
                0149 
                0150           ENDIF !IF (vec_quantities
                0151         ENDDO !DO num_var
                0152 
                0153         profiles_curfile_buff(bi,bj) = fNb
                0154       ENDIF !IF ( (irec.LT.profiles_minid
                0155 
                0156 C Get vec_loc from the buffer
                0157       IF (vNb.LT.0) THEN
                0158         DO v1 = 1, vec_loc_length
                0159           vec_loc(v1) = profiles_weight_buff
                0160      &     (v1,irec-profiles_minind_buff(bi,bj)+1,-vNb,bi,bj)
                0161         ENDDO
                0162 
                0163       ELSE
                0164         DO v1 = 1, vec_loc_length
                0165           vec_loc(v1) = profiles_data_buff
                0166      &     (v1,irec-profiles_minind_buff(bi,bj)+1,vNb,bi,bj)
                0167         ENDDO
6a770e0a24 Patr*0168 
13ce79fe94 Ivan*0169       ENDIF
6a770e0a24 Patr*0170 
13ce79fe94 Ivan*0171 #endif /* ALLOW_PROFILES */
6a770e0a24 Patr*0172 
13ce79fe94 Ivan*0173       RETURN
6a770e0a24 Patr*0174       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

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

The LXR team
Valid CSS 2.1! Valid HTML 4.01!