- Timestamp:
- 2017-11-17T17:19:55+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r6140 r8741 33 33 CONTAINS 34 34 35 SUBROUTINE Agrif_Update_Trc( kt)35 SUBROUTINE Agrif_Update_Trc( ) 36 36 !!---------------------------------------------------------------------- 37 37 !! *** ROUTINE Agrif_Update_Trc *** 38 38 !!---------------------------------------------------------------------- 39 INTEGER, INTENT(in) :: kt40 !!----------------------------------------------------------------------41 39 ! 42 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 40 IF (Agrif_Root()) RETURN 41 ! 43 42 #if defined TWO_WAY 44 43 Agrif_UseSpecialValueInUpdate = .TRUE. … … 66 65 67 66 68 SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )67 SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 69 68 !!---------------------------------------------------------------------- 70 69 !! *** ROUTINE updateT *** … … 73 72 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 74 73 LOGICAL , INTENT(in ) :: before 74 INTEGER, INTENT(in) :: nb, ndir 75 75 !! 76 INTEGER :: ji, jj, jk, jn 77 !!---------------------------------------------------------------------- 78 ! 79 IF( before ) THEN 80 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 81 ELSE 82 IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN 83 ! Add asselin part 84 DO jn = n1,n2 85 DO jk = k1, k2 86 DO jj = j1, j2 87 DO ji = i1, i2 88 IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN 89 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 90 & + atfp * ( ptab(ji,jj,jk,jn) & 91 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 92 ENDIF 93 END DO 76 LOGICAL :: western_side, eastern_side, southern_side, northern_side 77 INTEGER :: ji,jj,jk,jn 78 REAL(wp) :: ztb, ztnu, ztno 79 !!---------------------------------------------------------------------- 80 ! 81 ! 82 IF (before) THEN 83 DO jn = n1,n2 84 DO jk=k1,k2 85 DO jj=j1,j2 86 DO ji=i1,i2 87 !> jc tmp 88 tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) 89 ! tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) 90 !< jc tmp 94 91 END DO 95 92 END DO 96 93 END DO 94 END DO 95 ELSE 96 !> jc tmp 97 DO jn = n1,n2 98 tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 99 & * tmask(i1:i2,j1:j2,k1:k2) 100 ENDDO 101 !< jc tmp 102 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 103 ! Add asselin part 104 DO jn = n1,n2 105 DO jk=k1,k2 106 DO jj=j1,j2 107 DO ji=i1,i2 108 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 109 ztb = trb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 110 ztnu = tabres(ji,jj,jk,jn) 111 ztno = trn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 112 trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 113 & * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 114 ENDIF 115 ENDDO 116 ENDDO 117 ENDDO 118 ENDDO 97 119 ENDIF 98 DO jn = n1, 99 DO jk = k1,k2100 DO jj = j1,j2101 DO ji = i1,i2102 IF( ptab(ji,jj,jk,jn) /= 0._wp) THEN103 trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk)120 DO jn = n1,n2 121 DO jk=k1,k2 122 DO jj=j1,j2 123 DO ji=i1,i2 124 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 125 trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_n(ji,jj,jk) 104 126 END IF 105 127 END DO … … 107 129 END DO 108 130 END DO 131 ! 132 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 133 trb(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 134 ENDIF 135 ! 136 ! 137 # if defined DECAL_FEEDBACK 138 IF (.NOT.ln_linssh) THEN 139 western_side = (nb == 1).AND.(ndir == 1) 140 eastern_side = (nb == 1).AND.(ndir == 2) 141 southern_side = (nb == 2).AND.(ndir == 1) 142 northern_side = (nb == 2).AND.(ndir == 2) 143 ! 144 ! Asselin correction 145 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 146 IF (southern_side) THEN 147 DO jn = n1,n2 148 DO jk=k1,k2 149 DO ji=i1,i2 150 ztb = trb(ji,j1-1,jk,jn) * e3t_b(ji,j1-1,jk) ! fse3t_b prior update should be used 151 ztnu = trn(ji,j1-1,jk,jn) * e3t_n(ji,j1-1,jk) 152 ztno = trn(ji,j1-1,jk,jn) * e3t_a(ji,j1-1,jk) 153 trb(ji,j1-1,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 154 & * tmask(ji,j1-1,jk) / e3t_b(ji,j1-1,jk) 155 END DO 156 ENDDO 157 ENDDO 158 ENDIF 159 IF (northern_side) THEN 160 DO jn = n1,n2 161 DO jk=k1,k2 162 DO ji=i1,i2 163 ztb = trb(ji,j2+1,jk,jn) * e3t_b(ji,j2+1,jk) ! fse3t_b prior update should be used 164 ztnu = trn(ji,j2+1,jk,jn) * e3t_n(ji,j2+1,jk) 165 ztno = trn(ji,j2+1,jk,jn) * e3t_a(ji,j2+1,jk) 166 trb(ji,j2+1,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 167 & * tmask(ji,j2+1,jk) / e3t_b(ji,j2+1,jk) 168 END DO 169 ENDDO 170 ENDDO 171 ENDIF 172 IF (western_side) THEN 173 DO jn = n1,n2 174 DO jk=k1,k2 175 DO jj=j1,j2 176 ztb = trb(i1-1,jj,jk,jn) * e3t_b(i1-1,jj,jk) ! fse3t_b prior update should be used 177 ztnu = trn(i1-1,jj,jk,jn) * e3t_n(i1-1,jj,jk) 178 ztno = trn(i1-1,jj,jk,jn) * e3t_a(i1-1,jj,jk) 179 trb(i1-1,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 180 & * tmask(i1-1,jj,jk) / e3t_b(i1-1,jj,jk) 181 END DO 182 ENDDO 183 ENDDO 184 ENDIF 185 IF (eastern_side) THEN 186 DO jn = n1,n2 187 DO jk=k1,k2 188 DO jj=j1,j2 189 ztb = trb(i2+1,jj,jk,jn) * e3t_b(i2+1,jj,jk) ! fse3t_b prior update should be used 190 ztnu = trn(i2+1,jj,jk,jn) * e3t_n(i2+1,jj,jk) 191 ztno = trn(i2+1,jj,jk,jn) * e3t_a(i2+1,jj,jk) 192 trb(i2+1,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 193 & * tmask(i2+1,jj,jk) / e3t_b(i2+1,jj,jk) 194 END DO 195 ENDDO 196 ENDDO 197 ENDIF 198 ENDIF ! Asselin correction 199 200 IF (southern_side) THEN 201 DO jn = n1,n2 202 DO jk=k1,k2 203 DO ji=i1,i2 204 trn(ji,j1-1,jk,jn) = trn(ji,j1-1,jk,jn) * e3t_a(ji,j1-1,jk) / e3t_n(ji,j1-1,jk) 205 END DO 206 ENDDO 207 ENDDO 208 ENDIF 209 IF (northern_side) THEN 210 DO jn = n1,n2 211 DO jk=k1,k2 212 DO ji=i1,i2 213 trn(ji,j2+1,jk,jn) = trn(ji,j2+1,jk,jn) * e3t_a(ji,j2+1,jk) / e3t_n(ji,j2+1,jk) 214 END DO 215 ENDDO 216 ENDDO 217 ENDIF 218 IF (western_side) THEN 219 DO jn = n1,n2 220 DO jk=k1,k2 221 DO jj=j1,j2 222 trn(i1-1,jj,jk,jn) = trn(i1-1,jj,jk,jn) * e3t_a(i1-1,jj,jk) / e3t_n(i1-1,jj,jk) 223 END DO 224 ENDDO 225 ENDDO 226 ENDIF 227 IF (eastern_side) THEN 228 DO jn = n1,n2 229 DO jk=k1,k2 230 DO jj=j1,j2 231 trn(i2+1,jj,jk,jn) = trn(i2+1,jj,jk,jn) * e3t_a(i2+1,jj,jk) / e3t_n(i2+1,jj,jk) 232 END DO 233 ENDDO 234 ENDDO 235 ENDIF 236 ENDIF 237 #endif 109 238 ENDIF 110 239 !
Note: See TracChangeset
for help on using the changeset viewer.
