Changeset 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_update.F90
- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_top_update.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_top_update.F90
r11078 r12928 1 #define TWO_WAY2 1 #undef DECAL_FEEDBACK 3 2 … … 20 19 USE par_trc 21 20 USE trc 21 USE vremap 22 22 23 23 IMPLICIT NONE … … 40 40 IF (Agrif_Root()) RETURN 41 41 ! 42 #if defined TWO_WAY43 42 Agrif_UseSpecialValueInUpdate = .TRUE. 44 43 Agrif_SpecialValueFineGrid = 0._wp … … 53 52 ! 54 53 Agrif_UseSpecialValueInUpdate = .FALSE. 55 !56 #endif57 54 ! 58 55 END SUBROUTINE Agrif_Update_Trc … … 68 65 !! 69 66 INTEGER :: ji,jj,jk,jn 70 REAL(wp) , DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: tabres_child67 REAL(wp) :: ztb, ztnu, ztno 71 68 REAL(wp) :: h_in(k1:k2) 72 69 REAL(wp) :: h_out(1:jpk) 73 70 INTEGER :: N_in, N_out 74 71 REAL(wp) :: h_diff 75 REAL(wp) :: zrho_xy76 REAL(wp) :: tabin(k1:k2,n1:n2)72 REAL(wp) :: tabin(k1:k2,1:jptra) 73 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: tabres_child 77 74 !!--------------------------------------------- 78 75 ! 79 76 IF (before) THEN 80 77 AGRIF_SpecialValue = -999._wp 81 zrho_xy = Agrif_rhox() * Agrif_rhoy()82 78 DO jn = n1,n2-1 83 79 DO jk=k1,k2 84 80 DO jj=j1,j2 85 81 DO ji=i1,i2 86 tabres(ji,jj,jk,jn) = (tr n(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) &82 tabres(ji,jj,jk,jn) = (tr(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) & 87 83 * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp 88 84 END DO … … 93 89 DO jj=j1,j2 94 90 DO ji=i1,i2 95 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t _n(ji,jj,jk) &91 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) & 96 92 + (tmask(ji,jj,jk)-1)*999._wp 97 93 END DO … … 114 110 IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF 115 111 N_out = N_out + 1 116 h_out(N_out) = e3t _n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above112 h_out(N_out) = e3t(ji,jj,jk,Kmm_a) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 117 113 ENDDO 118 114 IF (N_in > 0) THEN !Remove this? … … 124 120 STOP 125 121 ENDIF 126 DO jn=1,jptra 127 CALL reconstructandremap(tabin(1:N_in,jn),h_in(1:N_in),tabres_child(ji,jj,1:N_out,jn),h_out(1:N_out),N_in,N_out) 128 ENDDO 122 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) 129 123 ENDIF 130 124 ENDDO 131 125 ENDDO 132 133 IF (.NOT.(lk_agrif_fstep.AND.( neuler==0))) THEN126 ! 127 IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 134 128 ! Add asselin part 135 129 DO jn = 1,jptra 136 DO jk=1,jpk 130 DO jk=1,jpkm1 137 131 DO jj=j1,j2 138 132 DO ji=i1,i2 139 133 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 140 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 141 & + atfp * ( tabres_child(ji,jj,jk,jn) & 142 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 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) 143 139 ENDIF 144 140 ENDDO … … 148 144 ENDIF 149 145 DO jn = 1,jptra 150 DO jk=1,jpk 146 DO jk=1,jpkm1 151 147 DO jj=j1,j2 152 148 DO ji=i1,i2 153 149 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 154 tr n(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk)150 tr(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn) 155 151 END IF 156 152 END DO … … 158 154 END DO 159 155 END DO 156 ! 157 IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN 158 tr(i1:i2,j1:j2,1:jpkm1,1:jptra,Kbb_a) = tr(i1:i2,j1:j2,1:jpkm1,1:jptra,Kmm_a) 159 ENDIF 160 ! 161 160 162 ENDIF 161 163 ! … … 183 185 DO ji=i1,i2 184 186 !> jc tmp 185 tabres(ji,jj,jk,jn) = tr n(ji,jj,jk,jn) * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk)186 ! tabres(ji,jj,jk,jn) = tr n(ji,jj,jk,jn) * e3t_n(ji,jj,jk)187 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) 187 189 !< jc tmp 188 190 END DO … … 197 199 ENDDO 198 200 !< jc tmp 199 IF (.NOT.(lk_agrif_fstep.AND.( neuler==0))) THEN201 IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 200 202 ! Add asselin part 201 203 DO jn = n1,n2 … … 204 206 DO ji=i1,i2 205 207 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 206 ztb = tr b(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used208 ztb = tr(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 207 209 ztnu = tabres(ji,jj,jk,jn) 208 ztno = tr n(ji,jj,jk,jn) * e3t_a(ji,jj,jk)209 tr b(ji,jj,jk,jn) = ( ztb +atfp * ( ztnu - ztno) ) &210 & * tmask(ji,jj,jk) / e3t _b(ji,jj,jk)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) 211 213 ENDIF 212 214 ENDDO … … 220 222 DO ji=i1,i2 221 223 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 222 tr n(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_n(ji,jj,jk)224 tr(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a) 223 225 END IF 224 226 END DO … … 227 229 END DO 228 230 ! 229 IF (( neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN230 tr b(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)231 IF ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN 232 tr(i1:i2,j1:j2,k1:k2,n1:n2,Kbb_a) = tr(i1:i2,j1:j2,k1:k2,n1:n2,Kmm_a) 231 233 ENDIF 232 234 !
Note: See TracChangeset
for help on using the changeset viewer.
