Changeset 9788
- Timestamp:
- 2018-06-13T12:12:50+02:00 (5 years ago)
- Location:
- NEMO/trunk/src
- Files:
-
- 13 edited
-
NST/agrif_top_interp.F90 (modified) (6 diffs)
-
NST/agrif_user.F90 (modified) (1 diff)
-
TOP/PISCES/P2Z/p2zexp.F90 (modified) (1 diff)
-
TOP/PISCES/P2Z/p2zopt.F90 (modified) (1 diff)
-
TOP/PISCES/P2Z/p2zsed.F90 (modified) (1 diff)
-
TOP/PISCES/P4Z/p4zche.F90 (modified) (1 diff)
-
TOP/PISCES/P4Z/p5zice.F90 (modified) (1 diff)
-
TOP/PISCES/P4Z/p5zmeso.F90 (modified) (1 diff)
-
TOP/PISCES/P4Z/p5zmicro.F90 (modified) (1 diff)
-
TOP/PISCES/P4Z/p5zmort.F90 (modified) (1 diff)
-
TOP/PISCES/P4Z/p5zprod.F90 (modified) (1 diff)
-
TOP/TRP/trcrad.F90 (modified) (1 diff)
-
TOP/trcbc.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/NST/agrif_top_interp.F90
r9598 r9788 48 48 END SUBROUTINE Agrif_trc 49 49 50 51 50 SUBROUTINE interptrn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 52 51 !!---------------------------------------------------------------------- 53 !! 52 !! *** ROUTINE interptrn *** 54 53 !!---------------------------------------------------------------------- 55 54 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab … … 57 56 LOGICAL , INTENT(in ) :: before 58 57 INTEGER , INTENT(in ) :: nb , ndir 59 !! 60 INTEGER :: ji, jj, jk, jn ! dummy loop indices 61 INTEGER :: imin, imax, jmin, jmax 62 LOGICAL :: ll_west, ll_east, ll_north, ll_south 58 ! 59 INTEGER :: ji, jj, jk, jn, iref, jref, ibdy, jbdy ! dummy loop indices 60 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 63 61 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 64 !!----------------------------------------------------------------------65 !66 INTEGER :: ji, jj, jk, jn ! dummy loop indices67 INTEGER :: imin, imax, jmin, jmax, N_in, N_out68 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha369 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha770 62 LOGICAL :: western_side, eastern_side,northern_side,southern_side 71 63 ! vertical interpolation: … … 73 65 REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin 74 66 REAL(wp), DIMENSION(k1:k2) :: h_in 75 REAL(wp), DIMENSION(1:jpk) :: h_out(1:jpk) 76 REAL(wp) :: h_diff, zrhoxy 77 78 zrhoxy = Agrif_rhox()*Agrif_rhoy() 79 IF (before) THEN 80 DO jn = 1,jpts 67 REAL(wp), DIMENSION(1:jpk) :: h_out 68 REAL(wp) :: h_diff 69 70 IF( before ) THEN 71 DO jn = 1,jptra 81 72 DO jk=k1,k2 82 73 DO jj=j1,j2 … … 84 75 ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 85 76 END DO 86 END DO 87 END DO 88 END DO 77 END DO 78 END DO 79 END DO 80 89 81 # if defined key_vertical 90 82 DO jk=k1,k2 91 83 DO jj=j1,j2 92 84 DO ji=i1,i2 93 ptab(ji,jj,jk,jpt s+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk)85 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 94 86 END DO 95 87 END DO 96 88 END DO 97 89 # endif 98 99 ELSE 100 ! 101 western_side = (nb == 1).AND.(ndir == 1) 102 eastern_side = (nb == 1).AND.(ndir == 2) 103 southern_side = (nb == 2).AND.(ndir == 1) 104 northern_side = (nb == 2).AND.(ndir == 2) 90 ELSE 91 92 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 93 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 105 94 106 95 # if defined key_vertical … … 127 116 ENDDO 128 117 IF (N_in > 0) THEN 129 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))130 118 DO jn=1,jptra 131 119 call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out) … … 137 125 ptab_child(i1:i2,j1:j2,1:jpk,1:jptra) = ptab(i1:i2,j1:j2,1:jpk,1:jptra) 138 126 # endif 139 140 127 ! 141 zrhox = Agrif_Rhox() 142 ! 143 zalpha1 = ( zrhox - 1. ) * 0.5 144 zalpha2 = 1. - zalpha1 145 ! 146 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 147 zalpha4 = 1. - zalpha3 148 ! 149 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 150 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 151 zalpha5 = 1. - zalpha6 - zalpha7 152 ! 153 imin = i1 154 imax = i2 155 jmin = j1 156 jmax = j2 157 ! 158 ! Remove CORNERS 159 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 160 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 161 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 162 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 163 ! 164 IF( eastern_side) THEN 165 DO jn = 1, jptra 166 tra(nlci,j1:j2,1:jpk,jn) = zalpha1 * ptab_child(nlci,j1:j2,1:jpk,jn) + zalpha2 * ptab_child(nlci-1,j1:j2,1:jpk,jn) 167 DO jk = 1, jpkm1 168 DO jj = jmin,jmax 169 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 170 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 171 ELSE 172 tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 173 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 174 tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 175 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 176 ENDIF 177 END DO 178 END DO 179 END DO 180 ENDDO 128 DO jn=1, jptra 129 tra(i1:i2,j1:j2,1:jpk,jn)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 130 END DO 131 132 IF ( .NOT.lk_agrif_clp ) THEN 133 ! 134 zrhox = Agrif_Rhox() 135 z1 = ( zrhox - 1. ) * 0.5 136 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 137 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 138 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 139 ! 140 z2 = 1. - z1 141 z4 = 1. - z3 142 z5 = 1. - z6 - z7 143 ! 144 imin = i1 ; imax = i2 145 jmin = j1 ; jmax = j2 146 ! 147 ! Remove CORNERS 148 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells 149 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1 150 IF((nbondi == -1).OR.(nbondi == 2)) imin = 1 + nbghostcells 151 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1 152 ! 153 IF( eastern_side ) THEN 154 ibdy = nlci-nbghostcells 155 DO jn = 1, jptra 156 tra(ibdy+1,jmin:jmax,k1:k2,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,k1:k2,jn) + z2 * ptab_child(ibdy,jmin:jmax,k1:k2,jn) 157 DO jk = 1, jpkm1 158 DO jj = jmin,jmax 159 IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN 160 tra(ibdy,jj,jk,jn) = tra(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk) 161 ELSE 162 tra(ibdy,jj,jk,jn)=(z4*tra(ibdy+1,jj,jk,jn)+z3*tra(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk) 163 IF( un(ibdy-1,jj,jk) > 0._wp ) THEN 164 tra(ibdy,jj,jk,jn)=( z6*tra(ibdy-1,jj,jk,jn)+z5*tra(ibdy+1,jj,jk,jn) & 165 + z7*tra(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 166 ENDIF 167 ENDIF 168 END DO 169 END DO 170 ! Restore ghost points: 171 tra(ibdy+1,jmin:jmax,k1:k2,jn) = ptab_child(ibdy+1,jmin:jmax,k1:k2,jn) * tmask(ibdy+1,jmin:jmax,k1:k2) 172 END DO 173 ENDIF 174 ! 175 IF( northern_side ) THEN 176 jbdy = nlcj-nbghostcells 177 DO jn = 1, jptra 178 tra(imin:imax,jbdy+1,k1:k2,jn) = z1 * ptab_child(imin:imax,jbdy+1,k1:k2,jn) + z2 * ptab_child(imin:imax,jbdy,k1:k2,jn) 179 DO jk = 1, jpkm1 180 DO ji = imin,imax 181 IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN 182 tra(ji,jbdy,jk,jn) = tra(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk) 183 ELSE 184 tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy+1,jk,jn)+z3*tra(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk) 185 IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN 186 tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy-1,jk,jn)+z5*tra(ji,jbdy+1,jk,jn) & 187 + z7*tra(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk) 188 ENDIF 189 ENDIF 190 END DO 191 END DO 192 ! Restore ghost points: 193 tra(imin:imax,jbdy+1,k1:k2,jn) = ptab_child(imin:imax,jbdy+1,k1:k2,jn) * tmask(imin:imax,jbdy+1,k1:k2) 194 END DO 195 ENDIF 196 ! 197 IF( western_side ) THEN 198 ibdy = 1+nbghostcells 199 DO jn = 1, jptra 200 tra(ibdy-1,jmin:jmax,k1:k2,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,k1:k2,jn) + z2 * ptab_child(ibdy,jmin:jmax,k1:k2,jn) 201 DO jk = 1, jpkm1 202 DO jj = jmin,jmax 203 IF( umask(ibdy,jj,jk) == 0._wp ) THEN 204 tra(ibdy,jj,jk,jn) = tra(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk) 205 ELSE 206 tra(ibdy,jj,jk,jn)=(z4*tra(ibdy-1,jj,jk,jn)+z3*tra(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk) 207 IF( un(ibdy,jj,jk) < 0._wp ) THEN 208 tra(ibdy,jj,jk,jn)=(z6*tra(ibdy+1,jj,jk,jn)+z5*tra(ibdy-1,jj,jk,jn)+z7*tra(ibdy+2,jj,jk,jn))*tmask(ibdy,jj,jk) 209 ENDIF 210 ENDIF 211 END DO 212 END DO 213 ! Restore ghost points: 214 tra(ibdy-1,jmin:jmax,k1:k2,jn) = ptab_child(ibdy-1,jmin:jmax,k1:k2,jn) * tmask(ibdy-1,jmin:jmax,k1:k2) 215 END DO 216 ENDIF 217 ! 218 IF( southern_side ) THEN 219 jbdy=1+nbghostcells 220 DO jn = 1, jptra 221 tra(imin:imax,jbdy-1,k1:k2,jn) = z1 * ptab_child(imin:imax,jbdy-1,k1:k2,jn) + z2 * ptab_child(imin:imax,jbdy,k1:k2,jn) 222 DO jk = 1, jpk 223 DO ji=imin,imax 224 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 225 tra(ji,jbdy,jk,jn)=tra(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) 226 ELSE 227 tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy-1,jk,jn)+z3*tra(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 228 IF( vn(ji,jbdy,jk) < 0._wp ) THEN 229 tra(ji,jbdy,jk,jn)=(z6*tra(ji,jbdy+1,jk,jn)+z5*tra(ji,jbdy-1,jk,jn)+z7*tra(ji,jbdy+2,jk,jn))*tmask(ji,jbdy,jk) 230 ENDIF 231 ENDIF 232 END DO 233 END DO 234 ! Restore ghost points: 235 tra(imin:imax,jbdy-1,k1:k2,jn) = tra(imin:imax,jbdy-1,k1:k2,jn) * tmask(imin:imax,jbdy-1,k1:k2) 236 END DO 237 ENDIF 238 ! 181 239 ENDIF 182 !183 IF( northern_side ) THEN184 DO jn = 1, jptra185 tra(i1:i2,nlcj,1:jpk,jn) = zalpha1 * ptab_child(i1:i2,nlcj,1:jpk,jn) + zalpha2 * ptab_child(i1:i2,nlcj-1,1:jpk,jn)186 DO jk = 1, jpkm1187 DO ji = imin,imax188 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN189 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)190 ELSE191 tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)192 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN193 tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn) &194 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)195 ENDIF196 END DO197 END DO198 END DO199 ENDDO200 ENDIF201 !202 IF( western_side) THEN203 DO jn = 1, jptra204 tra(1,j1:j2,1:jpk,jn) = zalpha1 * ptab_child(1,j1:j2,1:jpk,jn) + zalpha2 * ptab_child(2,j1:j2,1:jpk,jn)205 DO jk = 1, jpkm1206 DO jj = jmin,jmax207 IF( umask(2,jj,jk) == 0.e0 ) THEN208 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)209 ELSE210 tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)211 IF( un(2,jj,jk) < 0.e0 ) THEN212 tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)213 ENDIF214 END DO215 END DO216 END DO217 END DO218 ENDIF219 !220 IF( southern_side ) THEN221 DO jn = 1, jptra222 tra(i1:i2,1,1:jpk,jn) = zalpha1 * ptab_child(i1:i2,1,1:jpk,jn) + zalpha2 * ptab_child(i1:i2,2,1:jpk,jn)223 DO jk=1,jpkm1224 DO ji=imin,imax225 IF( vmask(ji,2,jk) == 0.e0 ) THEN226 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)227 ELSE228 tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)229 IF( vn(ji,2,jk) < 0.e0 ) THEN230 tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)231 ENDIF232 END DO233 END DO234 END DO235 ENDIF236 !237 ! Treatment of corners238 IF( ll_east .AND.((nbondj == -1).OR.(nbondj == 2)) ) tra(nlci-1, 2 ,:,:) = ptab(nlci-1, 2 ,:,:) ! East south239 IF( ll_east .AND.((nbondj == 1).OR.(nbondj == 2)) ) tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north240 IF( ll_west .AND.((nbondj == -1).OR.(nbondj == 2)) ) tra( 2 , 2 ,:,:) = ptab( 2 , 2 ,:,:) ! West south241 IF( ll_west .AND.((nbondj == 1).OR.(nbondj == 2)) ) tra( 2 ,nlcj-1,:,:) = ptab( 2 ,nlcj-1,:,:) ! West north242 !243 ENDIF244 !245 ! Treatment of corners246 !247 ! East south248 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN249 tra(nlci-1,2,:,:) = ptab_child(nlci-1,2,:,:)250 ENDIF251 ! East north252 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN253 tra(nlci-1,nlcj-1,:,:) = ptab_child(nlci-1,nlcj-1,:,:)254 ENDIF255 ! West south256 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN257 tra(2,2,:,:) = ptab_child(2,2,:,:)258 ENDIF259 ! West north260 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN261 tra(2,nlcj-1,:,:) = ptab_child(2,nlcj-1,:,:)262 ENDIF263 !264 240 ENDIF 265 241 ! -
NEMO/trunk/src/NST/agrif_user.F90
r9780 r9788 624 624 ENDIF 625 625 626 ENDIF627 626 ! Check passive tracer cell 628 627 IF( nn_dttrc .NE. 1 ) THEN -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zexp.F90
r9598 r9788 253 253 254 254 !!====================================================================== 255 END MODULE 255 END MODULE p2zexp -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zopt.F90
r9598 r9788 201 201 202 202 !!====================================================================== 203 END MODULE 203 END MODULE p2zopt -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zsed.F90
r9598 r9788 152 152 153 153 !!====================================================================== 154 END MODULE 154 END MODULE p2zsed -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zche.F90
r9598 r9788 831 831 832 832 !!====================================================================== 833 END MODULE 833 END MODULE p4zche -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zice.F90
r9598 r9788 600 600 END FUNCTION p5z_lim_alloc 601 601 !!====================================================================== 602 END MODULE 602 END MODULE p5zice -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zmeso.F90
r9598 r9788 427 427 428 428 !!====================================================================== 429 END MODULE 429 END MODULE p5zmeso -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zmicro.F90
r9598 r9788 369 369 370 370 !!====================================================================== 371 END MODULE 371 END MODULE p5zmicro -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zmort.F90
r9598 r9788 310 310 311 311 !!====================================================================== 312 END MODULE 312 END MODULE p5zmort -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zprod.F90
r9598 r9788 618 618 END FUNCTION p5z_prod_alloc 619 619 !!====================================================================== 620 END MODULE 620 END MODULE p5zprod -
NEMO/trunk/src/TOP/TRP/trcrad.F90
r9598 r9788 13 13 !! trc_rad : correction of negative concentrations 14 14 !!---------------------------------------------------------------------- 15 USE par_trc ! need jptra, number of passive tracers 15 16 USE oce_trc ! ocean dynamics and tracers variables 16 17 USE trc ! ocean passive tracers variables -
NEMO/trunk/src/TOP/trcbc.F90
r9598 r9788 39 39 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trccbc ! structure of data input CBC (file informations, fields read) 40 40 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trofac ! multiplicative factor for OBCtracer values 41 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) , TARGET:: sf_trcobc ! structure of data input OBC (file informations, fields read)41 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcobc ! structure of data input OBC (file informations, fields read) 42 42 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap 43 43
Note: See TracChangeset
for help on using the changeset viewer.
