Changeset 13337 for NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_top_interp.F90
- Timestamp:
- 2020-07-24T16:01:24+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_top_interp.F90
r13216 r13337 43 43 Agrif_SpecialValue = 0._wp 44 44 Agrif_UseSpecialValue = .TRUE. 45 l_vremap = ln_vremap 45 46 ! 46 47 CALL Agrif_Bc_variable( trn_id, procname=interptrn ) 47 48 Agrif_UseSpecialValue = .FALSE. 49 l_vremap = .FALSE. 48 50 ! 49 51 END SUBROUTINE Agrif_trc … … 57 59 LOGICAL , INTENT(in ) :: before 58 60 ! 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 61 INTEGER :: ji, jj, jk, jn ! dummy loop indices 62 INTEGER :: N_in, N_out 63 INTEGER :: item 63 64 ! vertical interpolation: 64 REAL(wp) , DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: ptab_child65 REAL(wp) :: zhtot 65 66 REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin 66 REAL(wp), DIMENSION(k1:k2) :: h_in 67 REAL(wp), DIMENSION(1:jpk) :: h_out 67 REAL(wp), DIMENSION(k1:k2) :: h_in, z_in 68 REAL(wp), DIMENSION(1:jpk) :: h_out, z_out 68 69 !!---------------------------------------------------------------------- 69 70 70 IF( before ) THEN 71 IF( before ) THEN 72 73 item = Kmm_a 74 IF( l_ini_child ) Kmm_a = Kbb_a 75 71 76 DO jn = 1,jptra 72 77 DO jk=k1,k2 … … 77 82 END DO 78 83 END DO 79 END DO84 END DO 80 85 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 86 IF( l_vremap .OR. l_ini_child) THEN 87 ! Interpolate thicknesses 88 ! Warning: these are masked, hence extrapolated prior interpolation. 89 DO jk=k1,k2 90 DO jj=j1,j2 91 DO ji=i1,i2 92 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 93 94 END DO 95 END DO 96 END DO 97 98 ! Extrapolate thicknesses in partial bottom cells: 99 ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 100 IF (ln_zps) THEN 101 DO jj=j1,j2 102 DO ji=i1,i2 103 jk = mbkt(ji,jj) 104 ptab(ji,jj,jk,jptra+1) = 0._wp 105 END DO 106 END DO 107 END IF 108 109 ! Save ssh at last level: 110 IF (.NOT.ln_linssh) THEN 111 ptab(i1:i2,j1:j2,k2,jptra+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1) 112 ELSE 113 ptab(i1:i2,j1:j2,k2,jptra+1) = 0._wp 114 END IF 115 ENDIF 116 Kmm_a = item 117 90 118 ELSE 119 item = Krhs_a 120 IF( l_ini_child ) Krhs_a = Kbb_a 91 121 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) 122 IF( l_vremap .OR. l_ini_child ) THEN 123 IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp 124 125 DO jj=j1,j2 126 DO ji=i1,i2 127 tr(ji,jj,:,:,Krhs_a) = 0. 128 N_in = mbkt_parent(ji,jj) 129 zhtot = 0._wp 130 DO jk=1,N_in !k2 = jpk of parent grid 131 IF (jk==N_in) THEN 132 h_in(jk) = ht0_parent(ji,jj) + ptab(ji,jj,k2,n2) - zhtot 133 ELSE 134 h_in(jk) = ptab(ji,jj,jk,n2) 135 ENDIF 136 zhtot = zhtot + h_in(jk) 137 tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 138 END DO 139 z_in(1) = 0.5_wp * h_in(1) - zhtot + ht0_parent(ji,jj) 140 DO jk=2,N_in 141 z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 142 END DO 143 144 N_out = 0 145 DO jk=1,jpk ! jpk of child grid 146 IF (tmask(ji,jj,jk) == 0._wp) EXIT 147 N_out = N_out + 1 148 h_out(jk) = e3t(ji,jj,jk,Krhs_a) 149 END DO 150 151 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + ht_0(ji,jj) 152 DO jk=2,N_out 153 z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 154 END DO 155 156 IF (N_in*N_out > 0) THEN 157 IF( l_ini_child ) THEN 158 CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), & 159 & z_out(1:N_out),N_in,N_out,jptra) 160 ELSE 161 CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a), & 162 & h_out(1:N_out),N_in,N_out,jptra) 163 ENDIF 164 ENDIF 102 165 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 166 END DO 167 Krhs_a = item 168 169 ELSE 170 171 DO jn=1, jptra 172 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) 173 END DO 174 ENDIF 175 121 176 ENDIF 122 177 !
Note: See TracChangeset
for help on using the changeset viewer.
