Changeset 14048 for NEMO/branches/2020
- Timestamp:
- 2020-12-03T13:17:01+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_top_update.F90
r12489 r14048 40 40 IF (Agrif_Root()) RETURN 41 41 ! 42 Agrif_UseSpecialValueInUpdate = .TRUE. 42 l_vremap = ln_vert_remap 43 Agrif_UseSpecialValueInUpdate = .NOT.l_vremap 43 44 Agrif_SpecialValueFineGrid = 0._wp 45 44 46 ! 45 47 # if ! defined DECAL_FEEDBACK … … 52 54 ! 53 55 Agrif_UseSpecialValueInUpdate = .FALSE. 56 l_vremap = .FALSE. 54 57 ! 55 58 END SUBROUTINE Agrif_Update_Trc 56 59 57 #ifdef key_vertical58 60 SUBROUTINE updateTRC( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 59 !!--------------------------------------------- 60 !! *** ROUTINE updateT *** 61 !!--------------------------------------------- 61 62 62 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 63 63 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 72 72 REAL(wp) :: tabin(k1:k2,1:jptra) 73 73 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: tabres_child 74 !!--------------------------------------------- 75 ! 74 76 75 IF (before) THEN 77 AGRIF_SpecialValue = -999._wp 78 DO jn = n1,n2-1 76 IF ( l_vremap ) THEN 77 DO jn = n1,n2-1 78 DO jk=k1,k2 79 DO jj=j1,j2 80 DO ji=i1,i2 81 tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) 82 END DO 83 END DO 84 END DO 85 END DO 79 86 DO jk=k1,k2 80 87 DO jj=j1,j2 81 88 DO ji=i1,i2 82 tabres(ji,jj,jk,jn) = (tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) & 83 * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp 84 END DO 85 END DO 86 END DO 87 END DO 88 DO jk=k1,k2 89 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 90 END DO 91 END DO 92 END DO 93 ELSE 94 DO jn = 1,jptra 95 DO jk=k1,k2 96 DO jj=j1,j2 97 DO ji=i1,i2 98 tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk) 99 END DO 100 END DO 101 END DO 102 END DO 103 104 ENDIF 105 ELSE 106 IF ( l_vremap ) THEN 107 tabres_child(:,:,:,:) = 0._wp 108 AGRIF_SpecialValue = 0._wp 89 109 DO jj=j1,j2 90 110 DO ji=i1,i2 91 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) &92 + (tmask(ji,jj,jk)-1)*999._wp93 END DO94 END DO95 END DO96 ELSE97 tabres_child(:,:,:,:) = 0.98 AGRIF_SpecialValue = 0._wp99 DO jj=j1,j2100 DO ji=i1,i2101 N_in = 0102 DO jk=k1,k2 !k2 = jpk of child grid103 IF (tabres(ji,jj,jk,n2) == 0 ) EXIT104 N_in = N_in + 1105 tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2)106 h_in(N_in) = tabres(ji,jj,jk,n2)111 N_in = 0 112 DO jk=k1,k2 !k2 = jpk of child grid 113 IF (tabres(ji,jj,jk,n2) <= 1.e-6_wp ) EXIT 114 N_in = N_in + 1 115 tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 116 h_in(N_in) = tabres(ji,jj,jk,n2) 117 ENDDO 118 N_out = 0 119 DO jk=1,jpk ! jpk of parent grid 120 IF (tmask(ji,jj,jk) == 0 ) EXIT ! TODO: Will not work with ISF 121 N_out = N_out + 1 122 h_out(N_out) = e3t(ji,jj,jk,Kmm_a) 123 ENDDO 124 IF (N_in*N_out > 0) THEN !Remove this? 125 CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),h_out(1:N_out),N_in,N_out,jptra) 126 ENDIF 107 127 ENDDO 108 N_out = 0109 DO jk=1,jpk ! jpk of parent grid110 IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF111 N_out = N_out + 1112 h_out(N_out) = e3t(ji,jj,jk,Kmm_a) !Parent grid scale factors. Could multiply by e1e2t here instead of division above113 ENDDO114 IF (N_in > 0) THEN !Remove this?115 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))116 IF (h_diff < -1.e-4) THEN117 print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out))118 print *,h_in(1:N_in)119 print *,h_out(1:N_out)120 STOP121 ENDIF122 CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jptra),h_out(1:N_out),N_in,N_out,jptra)123 ENDIF124 128 ENDDO 125 ENDDO 126 ! 127 IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 128 ! Add asselin part 129 DO jn = 1,jptra 130 DO jk=1,jpkm1 129 130 IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 131 ! Add asselin part 132 DO jn = 1,jptra 133 DO jk = 1, jpkm1 134 DO jj = j1, j2 135 DO ji = i1, i2 136 IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 137 ztb = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 138 ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a) 139 ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 140 tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) & 141 & * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 142 ENDIF 143 END DO 144 END DO 145 END DO 146 END DO 147 ENDIF 148 DO jn = 1,jptra 149 DO jk = 1, jpkm1 150 DO jj = j1, j2 151 DO ji = i1, i2 152 IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 153 tr(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn) 154 END IF 155 END DO 156 END DO 157 END DO 158 END DO 159 ELSE 160 DO jn = 1,jptra 161 tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 162 & * tmask(i1:i2,j1:j2,k1:k2) 163 ENDDO 164 IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 165 ! Add asselin part 166 DO jn = 1,jptra 167 DO jk = k1, k2 168 DO jj = j1, j2 169 DO ji = i1, i2 170 IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 171 ztb = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 172 ztnu = tabres(ji,jj,jk,jn) 173 ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 174 tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) & 175 & * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 176 ENDIF 177 END DO 178 END DO 179 END DO 180 END DO 181 ENDIF 182 DO jn = 1,jptra 183 DO jk=k1,k2 131 184 DO jj=j1,j2 132 185 DO ji=i1,i2 133 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 134 ztb = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 135 ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a) 136 ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 137 tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) & 138 & * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 139 ENDIF 140 ENDDO 141 ENDDO 142 ENDDO 143 ENDDO 186 IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 187 tr(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a) 188 END IF 189 END DO 190 END DO 191 END DO 192 END DO 193 ! 144 194 ENDIF 145 DO jn = 1,jptra146 DO jk=1,jpkm1147 DO jj=j1,j2148 DO ji=i1,i2149 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN150 tr(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn)151 END IF152 END DO153 END DO154 END DO155 END DO156 !157 195 IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN 158 196 tr(i1:i2,j1:j2,1:jpkm1,1:jptra,Kbb_a) = tr(i1:i2,j1:j2,1:jpkm1,1:jptra,Kmm_a) 159 197 ENDIF 160 !161 162 198 ENDIF 163 ! 199 ! 164 200 END SUBROUTINE updateTRC 165 166 167 #else168 SUBROUTINE updateTRC( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )169 !!----------------------------------------------------------------------170 !! *** ROUTINE updateTRC ***171 !!----------------------------------------------------------------------172 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2173 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres174 LOGICAL , INTENT(in ) :: before175 !!176 INTEGER :: ji,jj,jk,jn177 REAL(wp) :: ztb, ztnu, ztno178 !!----------------------------------------------------------------------179 !180 !181 IF (before) THEN182 DO jn = n1,n2183 DO jk=k1,k2184 DO jj=j1,j2185 DO ji=i1,i2186 !> jc tmp187 tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk)188 ! tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a)189 !< jc tmp190 END DO191 END DO192 END DO193 END DO194 ELSE195 !> jc tmp196 DO jn = n1,n2197 tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) &198 & * tmask(i1:i2,j1:j2,k1:k2)199 ENDDO200 !< jc tmp201 IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN202 ! Add asselin part203 DO jn = n1,n2204 DO jk=k1,k2205 DO jj=j1,j2206 DO ji=i1,i2207 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN208 ztb = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used209 ztnu = tabres(ji,jj,jk,jn)210 ztno = tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a)211 tr(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) ) &212 & * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)213 ENDIF214 ENDDO215 ENDDO216 ENDDO217 ENDDO218 ENDIF219 DO jn = n1,n2220 DO jk=k1,k2221 DO jj=j1,j2222 DO ji=i1,i2223 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN224 tr(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a)225 END IF226 END DO227 END DO228 END DO229 END DO230 !231 IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN232 tr(i1:i2,j1:j2,k1:k2,n1:n2,Kbb_a) = tr(i1:i2,j1:j2,k1:k2,n1:n2,Kmm_a)233 ENDIF234 !235 ENDIF236 !237 END SUBROUTINE updateTRC238 #endif239 201 240 202 #else
Note: See TracChangeset
for help on using the changeset viewer.
