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"
c9bf163375 Ivan*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
5a362746b1 Gael*0005 #ifdef ALLOW_ECCO
                0006 # include "ECCO_OPTIONS.h"
                0007 #endif
c9bf163375 Ivan*0008 #ifdef ALLOW_BLING
                0009 # include "BLING_OPTIONS.h"
                0010 #endif
6a770e0a24 Patr*0011 
13ce79fe94 Ivan*0012 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
c9bf163375 Ivan*0013 CBOP
                0014 C !ROUTINE: PROFILES_INTERP
6a770e0a24 Patr*0015 
13ce79fe94 Ivan*0016 C !INTERFACE:
c9bf163375 Ivan*0017       SUBROUTINE PROFILES_INTERP(
13ce79fe94 Ivan*0018      O                            traj_cur_out,
                0019      I                            i_cur, j_cur,
                0020      I                            weights_cur,
                0021      I                            var_cur,
                0022      I                            itr_cur,
                0023      I                            file_cur,
                0024      I                            myTime,
                0025      I                            bi, bj,
                0026      I                            myThid )
                0027 
                0028 C     !DESCRIPTION:
                0029 C     3D interpolation of model counterparts for netcdf profiles data
                0030 
                0031 C     !USES:
c9bf163375 Ivan*0032       IMPLICIT NONE
                0033 C     == Global variables ===
6a770e0a24 Patr*0034 #include "EEPARAMS.h"
                0035 #include "SIZE.h"
c9bf163375 Ivan*0036 #include "PARAMS.h"
6a770e0a24 Patr*0037 #include "GRID.h"
                0038 #include "DYNVARS.h"
5a362746b1 Gael*0039 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0040 # include "ECCO_SIZE.h"
                0041 # include "ECCO.h"
24462d2fa8 Patr*0042 #endif
d28c90138c Patr*0043 #ifdef ALLOW_PROFILES
6328b73337 Gael*0044 # include "PROFILES_SIZE.h"
6e4c90fea3 Patr*0045 # include "profiles.h"
                0046 #endif
7cad2d9e22 Gael*0047 #ifdef ALLOW_PTRACERS
c9bf163375 Ivan*0048 # include "PTRACERS_SIZE.h"
                0049 # include "PTRACERS_FIELDS.h"
                0050 #endif
                0051 #ifdef ALLOW_BLING
                0052 # include "BLING_VARS.h"
7cad2d9e22 Gael*0053 #endif
c9bf163375 Ivan*0054 
13ce79fe94 Ivan*0055 C     !INPUT PARAMETERS:
                0056 C     i/j_cur     :: i/j - index arrays of model grid points
                0057 C     weights_cur :: weights array for profile data
                0058 C     var_cur     :: current variable name
                0059 C     itr_cur     :: index of current variable
                0060 C     file_cur    :: current filenumber
                0061 C     myTime      :: time counter for this thread
                0062 C     bi,bj       :: Tile indices
                0063 C     myThid      :: my thread ID number
c9bf163375 Ivan*0064 #ifdef ALLOW_PROFILES
                0065       INTEGER i_cur(NUM_INTERP_POINTS)
                0066       INTEGER j_cur(NUM_INTERP_POINTS)
                0067       _RL weights_cur(NUM_INTERP_POINTS)
                0068 #else
                0069       INTEGER i_cur, j_cur
                0070       _RL weights_cur
                0071 #endif
                0072       CHARACTER*(8) var_cur
                0073       INTEGER itr_cur
                0074       INTEGER file_cur
13d362b8c1 Ou W*0075       _RL  myTime
c9bf163375 Ivan*0076       INTEGER bi, bj
                0077       INTEGER myThid
                0078 
13ce79fe94 Ivan*0079 C     !OUTPUT PARAMETERS:
                0080 C     traj_cur_out :: profile of interpolated model data
c9bf163375 Ivan*0081 #ifdef ALLOW_PROFILES
                0082       _RL traj_cur_out(NLEVELMAX)
5a362746b1 Gael*0083 #else
c9bf163375 Ivan*0084       _RL traj_cur_out
5a362746b1 Gael*0085 #endif
13ce79fe94 Ivan*0086 CEOP
6e4c90fea3 Patr*0087 
13ce79fe94 Ivan*0088 C     !FUNCTIONS:
c9bf163375 Ivan*0089       INTEGER ILNBLNK
                0090       EXTERNAL ILNBLNK
                0091 
13ce79fe94 Ivan*0092 C     !LOCAL VARIABLES:
                0093 #ifdef ALLOW_PROFILES
                0094       INTEGER kProf, kLev
                0095       INTEGER q, k, kcur, ierr
39ce977435 Gael*0096       _RL tab_coeffs1(NUM_INTERP_POINTS)
                0097       _RL tab_coeffs3(NUM_INTERP_POINTS)
c9bf163375 Ivan*0098       _RL ponderations(NUM_INTERP_POINTS), pondsSUM
                0099       _RL traj_cur(Nr), mask_cur(Nr)
39ce977435 Gael*0100       _RL tmp_coeff
3c8dcfdea9 Gael*0101 
c9bf163375 Ivan*0102       ierr = 0
13ce79fe94 Ivan*0103 C Horizontal interpolation:
                0104       DO k = 1, Nr
                0105         pondsSUM = 0. _d 0
                0106         DO q = 1, NUM_INTERP_POINTS
                0107           IF (var_cur.EQ.'theta') THEN
                0108             tab_coeffs1(q) = theta(i_cur(q),j_cur(q),k,bi,bj)
                0109           ELSEIF (var_cur.EQ.'salt') THEN
                0110             tab_coeffs1(q) = salt(i_cur(q),j_cur(q),k,bi,bj)
                0111           ELSEIF (var_cur.EQ.'pTracer') THEN
                0112 # ifdef ALLOW_PTRACERS
                0113             tab_coeffs1(q) =
                0114      &       pTracer(i_cur(q),j_cur(q),k,bi,bj,itr_cur)
                0115 # else
                0116             tab_coeffs1(q) = 0. _d 0
                0117 # endif
                0118 # ifdef ALLOW_BLING
                0119           ELSEIF (var_cur.EQ.'PCO') THEN
                0120             tab_coeffs1(q) = pCO2(i_cur(q),j_cur(q),bi,bj)
                0121           ELSEIF (var_cur.EQ.'PH') THEN
                0122             tab_coeffs1(q) = pH(i_cur(q),j_cur(q),k,bi,bj)
                0123           ELSEIF (var_cur.EQ.'CHL') THEN
                0124             tab_coeffs1(q) = CHL(i_cur(q),j_cur(q),k,bi,bj)
                0125           ELSEIF (var_cur.EQ.'POC') THEN
                0126             tab_coeffs1(q) = POC(i_cur(q),j_cur(q),k,bi,bj)
                0127 # endif
                0128 # ifdef ALLOW_ECCO
                0129           ELSEIF (var_cur.EQ.'eta') THEN
                0130             tab_coeffs1(q) = m_eta(i_cur(q),j_cur(q),bi,bj)
                0131 # endif
                0132           ELSEIF (var_cur.EQ.'UE') THEN
                0133             tab_coeffs1(q) = m_UE(i_cur(q),j_cur(q),k,bi,bj)
                0134           ELSEIF (var_cur.EQ.'VN') THEN
                0135             tab_coeffs1(q) = m_VN(i_cur(q),j_cur(q),k,bi,bj)
                0136           ELSE
                0137             tab_coeffs1(q) = 0. _d 0
                0138           ENDIF !IF (var_cur.EQ.
                0139 
                0140           tab_coeffs3(q) = maskC(i_cur(q),j_cur(q),k,bi,bj)
                0141 
                0142           ponderations(q) = tab_coeffs3(q)*weights_cur(q)
                0143           pondsSUM = pondsSUM+ponderations(q)
                0144 
                0145         ENDDO !DO q
                0146 
                0147         IF (pondsSUM.GT.zeroRL) THEN
                0148           traj_cur(k) = 0. _d 0
                0149           mask_cur(k) = 1. _d 0
                0150           pondsSUM = 1. _d 0 / pondsSUM
                0151 
                0152           DO q = 1, NUM_INTERP_POINTS
                0153             traj_cur(k)=traj_cur(k)
                0154      &       +tab_coeffs1(q)*ponderations(q)*pondsSUM
                0155           ENDDO
                0156 
c9bf163375 Ivan*0157         ELSE
13ce79fe94 Ivan*0158           traj_cur(k) = 0. _d 0
                0159           mask_cur(k) = 0. _d 0
                0160 
                0161         ENDIF !IF (pondsSUM.GT.zeroRL)
                0162 
                0163       ENDDO !DO k
6a770e0a24 Patr*0164 
13ce79fe94 Ivan*0165 # ifdef ALLOW_AUTODIFF_TAMC
                0166 C This is necessary, because TAF does not recognise prof_mask1D_cur
                0167 C as active and does not include it in the TL-version of this
                0168 C routine leading to prof_mask1D_cur=0 and also to
                0169 C objf_profiles_tl=0.
c9bf163375 Ivan*0170 C$TAF INCOMPLETE prof_mask1D_cur
13ce79fe94 Ivan*0171 
                0172 # endif
                0173 C Vertical interpolation:
                0174       DO kLev = 1, NLEVELMAX
                0175         traj_cur_out(kLev) = 0. _d 0
                0176         prof_mask1D_cur(kLev,bi,bj) = 0. _d 0
c9bf163375 Ivan*0177       ENDDO
13ce79fe94 Ivan*0178 
                0179       DO kProf = 1, ProfDepthNo(file_cur,bi,bj)
                0180 C Case 1: above first grid center => first grid center value
                0181         IF (prof_depth(file_cur,kProf,bi,bj).LT.-rC(1)) THEN
                0182           traj_cur_out(kProf) = traj_cur(1)
                0183           prof_mask1D_cur(kProf,bi,bj) = mask_cur(1)
                0184 
                0185 C Case 2: just below last grid center => last cell value
                0186         ELSEIF (prof_depth(file_cur,kProf,bi,bj).GE.-rC(Nr)) THEN
                0187           IF ( prof_depth(file_cur,kProf,bi,bj).LT.
                0188      &         (-rC(Nr)+drC(Nr)*halfRS) ) THEN
                0189             traj_cur_out(kProf) = traj_cur(Nr)
                0190             prof_mask1D_cur(kProf,bi,bj) = mask_cur(Nr)
                0191 
                0192           ENDIF
                0193 
                0194 C Case 3: between two grid centers
                0195         ELSE
                0196           kcur = 0
                0197           DO k = 1, Nr-1
                0198             IF ( (prof_depth(file_cur,kProf,bi,bj).GE.-rC(k)).AND.
                0199      &           (prof_depth(file_cur,kProf,bi,bj).LT.-rC(k+1))) THEN
                0200               kcur = k
                0201             ENDIF
                0202           ENDDO
                0203 
                0204           IF (kcur.EQ.0) THEN
                0205             WRITE(errorMessageUnit,'(A)')
                0206      &       'ERROR in PROFILES_INTERP: unexpected case 1'
                0207 
                0208             ierr = ierr + 1
                0209 
                0210           ENDIF
                0211 
                0212           IF (mask_cur(kcur+1).EQ.oneRL) THEN
                0213 C Subcase 1: 2 wet points => linear interpolation
                0214             tmp_coeff = (prof_depth(file_cur,kProf,bi,bj)+rC(kcur))/
                0215      &       (-rC(kcur+1)+rC(kcur))
                0216 
                0217             traj_cur_out(kProf) = (1-tmp_coeff)*traj_cur(kcur)
                0218      &       +tmp_coeff*traj_cur(kcur+1)
                0219 
                0220             prof_mask1D_cur(kProf,bi,bj) = 1. _d 0
                0221 
                0222             IF (mask_cur(kcur).EQ.zeroRL) THEN
                0223               WRITE(errorMessageUnit,'(A)')
c9bf163375 Ivan*0224      &         'ERROR in PROFILES_INTERP: unexpected case 2'
                0225 
13ce79fe94 Ivan*0226               ierr = ierr + 1
                0227 
                0228             ENDIF
                0229 
                0230           ELSEIF (prof_depth(file_cur,kProf,bi,bj).LT.-rF(kcur+1))
                0231      &    THEN
                0232 C Subcase 2: only 1 wet point just above => upper cell value
                0233             traj_cur_out(kProf) = traj_cur(kcur)
                0234             prof_mask1D_cur(kProf,bi,bj) = mask_cur(kcur)
                0235 
                0236           ENDIF !IF (mask_cur(kcur+1).EQ.oneRL)
                0237 
                0238         ENDIF !IF (prof_depth(file_cur,kProf,bi,bj).LT.-rC(1))
                0239 
                0240       ENDDO !DO kProf
                0241 
                0242       IF (ierr.GT.0) STOP 'ABNORMAL END: S/R PROFILES_INTERP'
                0243 
c9bf163375 Ivan*0244 #endif /* ALLOW_PROFILES */
6a770e0a24 Patr*0245 
af9e0d08c7 Jean*0246       RETURN
                0247       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!