- Timestamp:
- 2017-06-28T10:02:58+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r6140 r8226 50 50 ! 51 51 INTEGER :: ji, jj, jk, jn ! dummy loop indices 52 INTEGER ::imin, imax, jmin, jmax53 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha354 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha755 LOGICAL :: western_side, eastern_side,northern_side,southern_side56 52 INTEGER :: imin, imax, jmin, jmax 53 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 54 LOGICAL :: western_side, eastern_side,northern_side,southern_side 55 !!----------------------------------------------------------------------- 56 ! 57 57 IF (before) THEN 58 58 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 59 59 ELSE 60 60 ! 61 western_side = (nb == 1).AND.(ndir == 1) 62 eastern_side = (nb == 1).AND.(ndir == 2) 63 southern_side = (nb == 2).AND.(ndir == 1) 64 northern_side = (nb == 2).AND.(ndir == 2) 65 ! 66 zrhox = Agrif_Rhox() 67 ! 68 zalpha1 = ( zrhox - 1. ) * 0.5 69 zalpha2 = 1. - zalpha1 70 ! 71 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 72 zalpha4 = 1. - zalpha3 73 ! 74 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 75 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 76 zalpha5 = 1. - zalpha6 - zalpha7 77 ! 78 imin = i1 79 imax = i2 80 jmin = j1 81 jmax = j2 82 ! 83 ! Remove CORNERS 84 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 85 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 86 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 87 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 88 ! 89 IF( eastern_side) THEN 90 DO jn = 1, jptra 91 tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 92 DO jk = 1, jpkm1 93 DO jj = jmin,jmax 94 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 95 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 96 ELSE 97 tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 98 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 99 tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 100 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 61 IF( nbghostcells > 1 ) THEN ! no smoothing 62 tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 63 ELSE ! smoothing 64 ! 65 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 66 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 67 ! 68 zrhox = Agrif_Rhox() 69 z1 = ( zrhox - 1. ) * 0.5 70 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 71 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 72 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 73 ! 74 z2 = 1. - z1 75 z4 = 1. - z3 76 z5 = 1. - z6 - z7 77 ! 78 imin = i1 ; imax = i2 79 jmin = j1 ; jmax = j2 80 ! 81 ! Remove CORNERS 82 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 83 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 84 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 85 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 86 ! 87 IF( eastern_side) THEN 88 DO jn = 1, jptra 89 tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 90 DO jk = 1, jpkm1 91 DO jj = jmin,jmax 92 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 93 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 94 ELSE 95 tra(nlci-1,jj,jk,jn)=(z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 96 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 97 tra(nlci-1,jj,jk,jn)=( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) & 98 + z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 99 ENDIF 101 100 ENDIF 102 ENDIF 101 END DO 102 END DO 103 ENDDO 104 ENDIF 105 ! 106 IF( northern_side ) THEN 107 DO jn = 1, jptra 108 tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 109 DO jk = 1, jpkm1 110 DO ji = imin,imax 111 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 112 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 113 ELSE 114 tra(ji,nlcj-1,jk,jn)=(z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 115 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 116 tra(ji,nlcj-1,jk,jn)=( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn) & 117 + z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 118 ENDIF 119 ENDIF 120 END DO 121 END DO 122 ENDDO 123 ENDIF 124 ! 125 IF( western_side) THEN 126 DO jn = 1, jptra 127 tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 128 DO jk = 1, jpkm1 129 DO jj = jmin,jmax 130 IF( umask(2,jj,jk) == 0.e0 ) THEN 131 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 132 ELSE 133 tra(2,jj,jk,jn)=(z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 134 IF( un(2,jj,jk) < 0.e0 ) THEN 135 tra(2,jj,jk,jn)=(z6*tra(3,jj,jk,jn)+z5*tra(1,jj,jk,jn)+z7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 136 ENDIF 137 ENDIF 138 END DO 103 139 END DO 104 140 END DO 105 ENDDO 141 ENDIF 142 ! 143 IF( southern_side ) THEN 144 DO jn = 1, jptra 145 tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 146 DO jk=1,jpk 147 DO ji=imin,imax 148 IF( vmask(ji,2,jk) == 0.e0 ) THEN 149 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 150 ELSE 151 tra(ji,2,jk,jn)=(z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 152 IF( vn(ji,2,jk) < 0.e0 ) THEN 153 tra(ji,2,jk,jn)=(z6*tra(ji,3,jk,jn)+z5*tra(ji,1,jk,jn)+z7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 154 ENDIF 155 ENDIF 156 END DO 157 END DO 158 ENDDO 159 ENDIF 160 ! 161 ! Treatment of corners 162 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 163 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 164 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tra(2,2,:,:) = ptab(2,2,:,:) ! West south 165 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 166 ! 106 167 ENDIF 107 !108 IF( northern_side ) THEN109 DO jn = 1, jptra110 tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)111 DO jk = 1, jpkm1112 DO ji = imin,imax113 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN114 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)115 ELSE116 tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)117 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN118 tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn) &119 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)120 ENDIF121 ENDIF122 END DO123 END DO124 ENDDO125 ENDIF126 !127 IF( western_side) THEN128 DO jn = 1, jptra129 tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)130 DO jk = 1, jpkm1131 DO jj = jmin,jmax132 IF( umask(2,jj,jk) == 0.e0 ) THEN133 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)134 ELSE135 tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)136 IF( un(2,jj,jk) < 0.e0 ) THEN137 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)138 ENDIF139 ENDIF140 END DO141 END DO142 END DO143 ENDIF144 !145 IF( southern_side ) THEN146 DO jn = 1, jptra147 tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)148 DO jk=1,jpk149 DO ji=imin,imax150 IF( vmask(ji,2,jk) == 0.e0 ) THEN151 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)152 ELSE153 tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)154 IF( vn(ji,2,jk) < 0.e0 ) THEN155 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)156 ENDIF157 ENDIF158 END DO159 END DO160 ENDDO161 ENDIF162 !163 ! Treatment of corners164 !165 ! East south166 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN167 tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)168 ENDIF169 ! East north170 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN171 tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)172 ENDIF173 ! West south174 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN175 tra(2,2,:,:) = ptab(2,2,:,:)176 ENDIF177 ! West north178 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN179 tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)180 ENDIF181 !182 168 ENDIF 183 169 !
Note: See TracChangeset
for help on using the changeset viewer.
