Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/NST/agrif_top_interp.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_top_interp.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/NST/agrif_top_interp.F90
r13216 r14789 27 27 PUBLIC Agrif_trc, interptrn 28 28 29 !! * Substitutions 30 # include "domzgr_substitute.h90" 29 31 !!---------------------------------------------------------------------- 30 32 !! NEMO/NST 4.0 , NEMO Consortium (2018) … … 43 45 Agrif_SpecialValue = 0._wp 44 46 Agrif_UseSpecialValue = .TRUE. 47 l_vremap = ln_vert_remap 45 48 ! 46 49 CALL Agrif_Bc_variable( trn_id, procname=interptrn ) 50 ! 47 51 Agrif_UseSpecialValue = .FALSE. 52 l_vremap = .FALSE. 48 53 ! 49 54 END SUBROUTINE Agrif_trc … … 57 62 LOGICAL , INTENT(in ) :: before 58 63 ! 59 INTEGER :: ji, jj, jk, jn, ibdy, jbdy ! dummy loop indices 60 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 61 REAL(wp) :: zrho, z1, z2, z3, z4, z5, z6, z7 62 64 INTEGER :: ji, jj, jk, jn ! dummy loop indices 65 INTEGER :: N_in, N_out 66 INTEGER :: item 63 67 ! vertical interpolation: 64 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: ptab_child 65 REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin 66 REAL(wp), DIMENSION(k1:k2) :: h_in 67 REAL(wp), DIMENSION(1:jpk) :: h_out 68 !!---------------------------------------------------------------------- 69 70 IF( before ) THEN 68 REAL(wp) :: zhtot, zwgt 69 REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin, tabin_i 70 REAL(wp), DIMENSION(k1:k2) :: z_in, h_in_i, z_in_i 71 REAL(wp), DIMENSION(1:jpk) :: h_out, z_out 72 !!---------------------------------------------------------------------- 73 74 IF( before ) THEN 75 76 item = Kmm_a 77 IF( l_ini_child ) Kmm_a = Kbb_a 78 71 79 DO jn = 1,jptra 72 80 DO jk=k1,k2 … … 77 85 END DO 78 86 END DO 79 END DO 80 81 # if defined key_vertical 82 DO jk=k1,k2 83 DO jj=j1,j2 84 DO ji=i1,i2 85 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 86 END DO 87 END DO 88 END DO 89 # endif 87 END DO 88 89 IF( l_vremap .OR. l_ini_child .OR. ln_zps ) THEN 90 ! Fill cell depths (i.e. gdept) to be interpolated 91 ! Warning: these are masked, hence extrapolated prior interpolation. 92 DO jj=j1,j2 93 DO ji=i1,i2 94 ptab(ji,jj,k1,jptra+1) = 0.5_wp * tmask(ji,jj,k1) * e3t(ji,jj,k1,Kmm_a) 95 DO jk=k1+1,k2 96 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * & 97 & ( ptab(ji,jj,jk-1,jptra+1) + 0.5_wp * (e3t(ji,jj,jk-1,Kmm_a)+e3t(ji,jj,jk,Kmm_a)) ) 98 END DO 99 END DO 100 END DO 101 102 ! Save ssh at last level: 103 IF (.NOT.ln_linssh) THEN 104 ptab(i1:i2,j1:j2,k2,jptra+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1) 105 END IF 106 ENDIF 107 Kmm_a = item 108 90 109 ELSE 91 92 # if defined key_vertical 93 DO jj=j1,j2 94 DO ji=i1,i2 95 ptab_child(ji,jj,:) = 0._wp 96 N_in = 0 97 DO jk=k1,k2 !k2 = jpk of parent grid 98 IF (ptab(ji,jj,jk,n2) == 0) EXIT 99 N_in = N_in + 1 100 tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 101 h_in(N_in) = ptab(ji,jj,jk,n2) 110 item = Krhs_a 111 IF( l_ini_child ) Krhs_a = Kbb_a 112 113 IF( l_vremap .OR. l_ini_child ) THEN 114 IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp 115 116 DO jj=j1,j2 117 DO ji=i1,i2 118 tr(ji,jj,:,:,Krhs_a) = 0. 119 ! 120 ! Build vertical grids: 121 N_in = mbkt_parent(ji,jj) 122 N_out = mbkt(ji,jj) 123 IF (N_in*N_out > 0) THEN 124 ! Input grid (account for partial cells if any): 125 DO jk=1,N_in 126 z_in(jk) = ptab(ji,jj,jk,n2) - ptab(ji,jj,k2,n2) 127 tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra) 128 END DO 129 130 ! Intermediate grid: 131 IF ( l_vremap ) THEN 132 DO jk = 1, N_in 133 h_in_i(jk) = e3t0_parent(ji,jj,jk) * & 134 & (1._wp + ptab(ji,jj,k2,n2)/(ht0_parent(ji,jj)*ssmask(ji,jj) + 1._wp - ssmask(ji,jj))) 135 END DO 136 z_in_i(1) = 0.5_wp * h_in_i(1) 137 DO jk=2,N_in 138 z_in_i(jk) = z_in_i(jk-1) + 0.5_wp * ( h_in_i(jk) + h_in_i(jk-1) ) 139 END DO 140 z_in_i(1:N_in) = z_in_i(1:N_in) - ptab(ji,jj,k2,n2) 141 ENDIF 142 143 ! Output (Child) grid: 144 DO jk=1,N_out 145 h_out(jk) = e3t(ji,jj,jk,Krhs_a) 146 END DO 147 z_out(1) = 0.5_wp * h_out(1) 148 DO jk=2,N_out 149 z_out(jk) = z_out(jk-1) + 0.5_wp * ( h_out(jk)+h_out(jk-1) ) 150 END DO 151 IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a) 152 153 IF( l_ini_child ) THEN 154 CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), & 155 & z_out(1:N_out),N_in,N_out,jptra) 156 ELSE 157 CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tabin_i(1:N_in,1:jptra), & 158 & z_in_i(1:N_in),N_in,N_in,jptra) 159 CALL reconstructandremap(tabin_i(1:N_in,1:jptra),h_in_i(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), & 160 & h_out(1:N_out),N_in,N_out,jptra) 161 ENDIF 162 ENDIF 102 163 END DO 103 N_out = 0 104 DO jk=1,jpk ! jpk of child grid 105 IF (tmask(ji,jj,jk) == 0) EXIT 106 N_out = N_out + 1 107 h_out(jk) = e3t(ji,jj,jk,Krhs_a) 108 ENDDO 109 IF (N_in > 0) THEN 110 CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,ptab_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra) 111 ENDIF 112 ENDDO 113 ENDDO 114 # else 115 ptab_child(i1:i2,j1:j2,1:jpk,1:jptra) = ptab(i1:i2,j1:j2,1:jpk,1:jptra) 116 # endif 117 ! 118 DO jn=1, jptra 119 tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 120 END DO 164 END DO 165 Krhs_a = item 166 167 ELSE 168 169 IF ( Agrif_Parent(ln_zps) ) THEN ! Account for partial cells 170 ! linear vertical interpolation 171 DO jj=j1,j2 172 DO ji=i1,i2 173 ! 174 N_in = mbkt(ji,jj) 175 N_out = mbkt(ji,jj) 176 z_in(1) = ptab(ji,jj,1,n2) 177 tabin(1,1:jptra) = ptab(ji,jj,1,1:jptra) 178 DO jk=2, N_in 179 z_in(jk) = ptab(ji,jj,jk,n2) 180 tabin(jk,1:jptra) = ptab(ji,jj,jk,1:jptra) 181 END DO 182 IF (.NOT.ln_linssh) z_in(1:N_in) = z_in(1:N_in) - ptab(ji,jj,k2,n2) 183 z_out(1) = 0.5_wp * e3t(ji,jj,1,Krhs_a) 184 DO jk=2, N_out 185 z_out(jk) = z_out(jk-1) + 0.5_wp * (e3t(ji,jj,jk-1,Krhs_a) + e3t(ji,jj,jk,Krhs_a)) 186 END DO 187 IF (.NOT.ln_linssh) z_out(1:N_out) = z_out(1:N_out) - ssh(ji,jj,Krhs_a) 188 CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),ptab(ji,jj,1:N_out,1:jptra), & 189 & z_out(1:N_out),N_in,N_out,jptra) 190 END DO 191 END DO 192 193 ENDIF 194 195 DO jn=1, jptra 196 tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 197 END DO 198 ENDIF 199 121 200 ENDIF 122 201 !
Note: See TracChangeset
for help on using the changeset viewer.
