Changeset 9005 for branches/2017
- Timestamp:
- 2017-12-13T11:50:27+01:00 (7 years ago)
- Location:
- branches/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r8999 r9005 676 676 ENDDO 677 677 IF (N_in > 0) THEN 678 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))679 678 DO jn=1,jpts 680 679 call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out) -
branches/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r8993 r9005 56 56 END SUBROUTINE Agrif_Update_Trc 57 57 58 58 #ifdef key_vertical 59 SUBROUTINE updateTRC( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 60 !!--------------------------------------------- 61 !! *** ROUTINE updateT *** 62 !!--------------------------------------------- 63 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 64 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 65 LOGICAL, INTENT(in) :: before 66 !! 67 INTEGER :: ji,jj,jk,jn 68 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: tabres_child 69 REAL(wp) :: h_in(k1:k2) 70 REAL(wp) :: h_out(1:jpk) 71 INTEGER :: N_in, N_out 72 REAL(wp) :: h_diff 73 REAL(wp) :: zrho_xy 74 REAL(wp) :: tabin(k1:k2,n1:n2) 75 !!--------------------------------------------- 76 ! 77 IF (before) THEN 78 AGRIF_SpecialValue = -999._wp 79 zrho_xy = Agrif_rhox() * Agrif_rhoy() 80 DO jn = n1,n2-1 81 DO jk=k1,k2 82 DO jj=j1,j2 83 DO ji=i1,i2 84 tabres(ji,jj,jk,jn) = (trn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 85 * tmask(ji,jj,jk) * zrho_xy + (tmask(ji,jj,jk)-1)*999._wp 86 END DO 87 END DO 88 END DO 89 END DO 90 DO jk=k1,k2 91 DO jj=j1,j2 92 DO ji=i1,i2 93 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) & 94 + (tmask(ji,jj,jk)-1)*999._wp 95 END DO 96 END DO 97 END DO 98 ELSE 99 tabres_child(:,:,:,:) = 0. 100 AGRIF_SpecialValue = 0._wp 101 DO jj=j1,j2 102 DO ji=i1,i2 103 N_in = 0 104 DO jk=k1,k2 !k2 = jpk of child grid 105 IF (tabres(ji,jj,jk,n2) == 0 ) EXIT 106 N_in = N_in + 1 107 tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 108 h_in(N_in) = tabres(ji,jj,jk,n2) 109 ENDDO 110 N_out = 0 111 DO jk=1,jpk ! jpk of parent grid 112 IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF 113 N_out = N_out + 1 114 h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 115 ENDDO 116 IF (N_in > 0) THEN !Remove this? 117 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 118 IF (h_diff < -1.e-4) THEN 119 print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out)) 120 print *,h_in(1:N_in) 121 print *,h_out(1:N_out) 122 STOP 123 ENDIF 124 DO jn=1,jptra 125 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) 126 ENDDO 127 ENDIF 128 ENDDO 129 ENDDO 130 131 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 132 ! Add asselin part 133 DO jn = 1,jptra 134 DO jk=1,jpk 135 DO jj=j1,j2 136 DO ji=i1,i2 137 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 138 trb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 139 & + atfp * ( tabres_child(ji,jj,jk,jn) & 140 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 141 ENDIF 142 ENDDO 143 ENDDO 144 ENDDO 145 ENDDO 146 ENDIF 147 DO jn = 1,jptra 148 DO jk=1,jpk 149 DO jj=j1,j2 150 DO ji=i1,i2 151 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 152 trn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 153 END IF 154 END DO 155 END DO 156 END DO 157 END DO 158 ENDIF 159 ! 160 END SUBROUTINE updateTRC 161 162 163 #else 59 164 SUBROUTINE updateTRC( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 60 165 !!---------------------------------------------------------------------- … … 127 232 ! 128 233 END SUBROUTINE updateTRC 234 #endif 129 235 130 236 #else
Note: See TracChangeset
for help on using the changeset viewer.